From 77084ecc92bb7a26fb4d92a57dd889418b8246d0 Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Fri, 21 May 2021 12:29:08 -0400 Subject: [PATCH 01/38] Adding Stokes forces implementation and diags. - Add Craik-Leibovich terms, vorticity and dynamic pressure components. - Add exploratory Stokes ddt version in MOM_wave_interface and MOM.F90 - Add tendency diagnostics for Stokes terms w/ control and option for diagnostic only Stokes force computation in MOM_CoriolisAdv. --- src/core/MOM.F90 | 15 ++- src/core/MOM_CoriolisAdv.F90 | 97 +++++++++++++- src/core/MOM_dynamics_split_RK2.F90 | 58 +++++++- src/user/MOM_wave_interface.F90 | 199 +++++++++++++++++++++++++++- 4 files changed, 354 insertions(+), 15 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 4659b685e5..dddfea228d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -646,12 +646,21 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS if (CS%UseWaves) then ! Update wave information, which is presently kept static over each call to step_mom call enable_averages(time_interval, Time_start + real_to_time(US%T_to_s*time_interval), CS%diag) - call Update_Stokes_Drift(G, GV, US, Waves, h, forces%ustar) + call Update_Stokes_Drift(G, GV, US, Waves, h, forces%ustar, dt) + if (Waves%Stokes_DDT) then + u(:,:,:) = u(:,:,:) + Waves%ddt_us_x(:,:,:)*dt + v(:,:,:) = v(:,:,:) + Waves%ddt_us_y(:,:,:)*dt + endif call disable_averaging(CS%diag) endif else ! not do_dyn. - if (CS%UseWaves) & ! Diagnostics are not enabled in this call. - call Update_Stokes_Drift(G, GV, US, Waves, h, fluxes%ustar) + if (CS%UseWaves) then ! Diagnostics are not enabled in this call. + call Update_Stokes_Drift(G, GV, US, Waves, h, fluxes%ustar, dt) + if (Waves%Stokes_DDT) then + u(:,:,:) = u(:,:,:) + Waves%ddt_us_x(:,:,:)*dt + v(:,:,:) = v(:,:,:) + Waves%ddt_us_y(:,:,:)*dt + endif + endif endif if (CS%debug) then diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 231b6ed058..a8ab9ed5bc 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -16,6 +16,7 @@ module MOM_CoriolisAdv use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : accel_diag_ptrs use MOM_verticalGrid, only : verticalGrid_type +use MOM_wave_interface, only : wave_parameters_CS implicit none ; private @@ -82,6 +83,7 @@ module MOM_CoriolisAdv integer :: id_h_gKEu = -1, id_h_gKEv = -1 integer :: id_h_rvxu = -1, id_h_rvxv = -1 integer :: id_intz_rvxu_2d = -1, id_intz_rvxv_2d = -1 + integer :: id_CAuS = -1, id_CAvS = -1 !>@} end type CoriolisAdv_CS @@ -117,7 +119,7 @@ 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, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) 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_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] @@ -135,10 +137,12 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv - + type(Wave_parameters_CS), optional, pointer :: Waves !< An optional pointer to Stokes drift CS + ! 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]. + qS, & ! Layer Stokes 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 [L2 ~> m2]. @@ -172,8 +176,10 @@ 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 [L2 T-1 ~> m2 s-1] + dvSdx, duSdy, & ! idem. for Stokes drift [L2 T-1 ~> m2 s-1] rel_vort, & ! Relative vorticity at q-points [T-1 ~> s-1]. abs_vort, & ! Absolute vorticity at q-points [T-1 ~> s-1]. + stk_vort, & ! Stokes 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]. @@ -182,6 +188,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)) :: & PV, & ! A diagnostic array of the potential vorticities [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. RV ! A diagnostic array of the relative vorticities [T-1 ~> s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & CAuS ! + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & CAvS ! real :: fv1, fv2, fv3, fv4 ! (f+rv)*v [L T-2 ~> m s-2]. real :: fu1, fu2, fu3, fu4 ! -(f+rv)*u [L T-2 ~> m s-2]. real :: max_fv, max_fu ! The maximum or minimum of the neighboring Coriolis @@ -220,7 +228,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) 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 - + logical :: Stokes_VF, Passive_Stokes_VF + ! Diagnostics for fractional thickness-weighted terms real, allocatable, dimension(:,:) :: & hf_gKEu_2d, hf_gKEv_2d, & ! Depth sum of hf_gKEu, hf_gKEv [L T-2 ~> m s-2]. @@ -283,6 +292,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) Area_q(i,j) = (Area_h(i,j) + Area_h(i+1,j+1)) + & (Area_h(i+1,j) + Area_h(i,j+1)) enddo ; enddo + + Stokes_VF = present(Waves) + if (Stokes_VF) Stokes_VF = associated(Waves) + if (Stokes_VF) Stokes_VF = Waves%Stokes_VF !$OMP parallel do default(private) shared(u,v,h,uh,vh,CAu,CAv,G,GV,CS,AD,Area_h,Area_q,& !$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,vol_neglect,h_tiny,OBC,eps_vel) @@ -293,6 +306,34 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! 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. + if (Stokes_VF) then + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + dvSdx(I,J) = ((-Waves%us_y(i+1,J,k))*G%dyCv(i+1,J) - & + (-Waves%us_y(i,J,k))*G%dyCv(i,J)) + duSdy(I,J) = ((-Waves%us_x(I,j+1,k))*G%dxCu(I,j+1) - & + (-Waves%us_x(I,j,k))*G%dxCu(I,j)) + enddo; enddo + endif + if (Passive_Stokes_VF) then + 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)) + enddo; enddo + else + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + dvdx(I,J) = ((v(i+1,J,k)-Waves%us_y(i+1,J,k))*G%dyCv(i+1,J) - & + (v(i,J,k)-Waves%us_y(i,J,k))*G%dyCv(i,J)) + dudy(I,J) = ((u(I,j+1,k)-Waves%us_x(I,j+1,k))*G%dxCu(I,j+1) - & + (u(I,j,k)-Waves%us_x(I,j,k))*G%dxCu(I,j)) + enddo; enddo + endif + else + 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)) + enddo; enddo + endif 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)) @@ -440,11 +481,21 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%no_slip) then do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 rel_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) - enddo ; enddo + enddo; enddo + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + stk_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvSdx(I,J) - duSdy(I,J)) * G%IareaBu(I,J) + enddo; enddo + endif else do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 rel_vort(I,J) = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) - enddo ; enddo + enddo; enddo + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + stk_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvSdx(I,J) - duSdy(I,J)) * G%IareaBu(I,J) + enddo; enddo + endif endif do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 @@ -455,7 +506,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) hArea_q = (hArea_u(I,j) + hArea_u(I,j+1)) + (hArea_v(i,J) + hArea_v(i+1,J)) Ih_q(I,J) = Area_q(I,J) / (hArea_q + vol_neglect) q(I,J) = abs_vort(I,J) * Ih_q(I,J) - enddo ; enddo + enddo; enddo + + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + qS(I,J) = stk_vort(I,J) * Ih_q(I,J) + enddo; enddo + endif if (CS%id_rv > 0) then do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 @@ -679,6 +736,15 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (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 + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + ! Computing the diagnostic Stokes contribution to CAu + do j=js,je ; do I=Isq,Ieq + CAuS(I,j,k) = 0.25 * & + (qS(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + & + qS(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j) + enddo ; enddo + endif + if (CS%bound_Coriolis) then do j=js,je ; do I=Isq,Ieq fv1 = abs_vort(I,J) * v(i+1,J,k) @@ -792,6 +858,15 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (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%id_CAuS>0 .or. CS%id_CAvS>0) then + ! Computing the diagnostic Stokes contribution to CAv + do J=Jsq,Jeq ; do i=is,ie + CAvS(I,j,k) = 0.25 * & + (qS(I,J) * (uh(I,j+1,k) + uh(I,j,k)) + & + qS(I,J-1) * (uh(I-1,j,k) + uh(I-1,j+1,k))) * G%IdyCv(i,J) + enddo; enddo + endif + if (CS%bound_Coriolis) then do J=Jsq,Jeq ; do i=is,ie fu1 = -abs_vort(I,J) * u(I,j+1,k) @@ -868,6 +943,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%id_gKEv>0) call post_data(CS%id_gKEv, AD%gradKEv, CS%diag) if (CS%id_rvxu > 0) call post_data(CS%id_rvxu, AD%rv_x_u, CS%diag) if (CS%id_rvxv > 0) call post_data(CS%id_rvxv, AD%rv_x_v, CS%diag) + if (CS%id_CAuS > 0) call post_data(CS%id_CAuS, CAuS, CS%diag) + if (CS%id_CAvS > 0) call post_data(CS%id_CAvS, CAvS, CS%diag) ! Diagnostics for terms multiplied by fractional thicknesses @@ -1274,6 +1351,14 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) 'Zonal Acceleration from Relative Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_rvxv > 0) call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) + CS%id_CAuS = register_diag_field('ocean_model', 'CAuS', diag%axesCuL, Time, & + 'Zonal Acceleration from Stokes Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) + ! add to AD + + CS%id_CAvS = register_diag_field('ocean_model', 'CAvS', diag%axesCvL, Time, & + 'Meridional Acceleration from Stokes Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) + ! add to AD + !CS%id_hf_gKEu = register_diag_field('ocean_model', 'hf_gKEu', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Acceleration from Grad. Kinetic Energy', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 07a302b2b0..34539dbea7 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -60,7 +60,7 @@ module MOM_dynamics_split_RK2 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 +use MOM_wave_interface, only: wave_parameters_CS, Stokes_PGF implicit none ; private @@ -71,11 +71,13 @@ module MOM_dynamics_split_RK2 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] + PFu_Stokes, & !< PFu_Stokes = -d/dx int_r (u_L*duS/dr) [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] + PFv_Stokes, & !< PFv_Stokes = -d/dy int_r (v_L*dvS/dr) [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 @@ -360,6 +362,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s 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. + logical :: Use_Stokes_PGF ! If true, add Stokes PGF to hydrostatic PGF !---For group halo pass logical :: showCallTree, sym @@ -454,6 +457,30 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s eta_PF_start(i,j) = CS%eta_PF(i,j) - pres_to_eta * (p_surf_begin(i,j) - p_surf_end(i,j)) enddo ; enddo endif + ! Stokes shear force contribution to pressure gradient + Use_Stokes_PGF = present(Waves) + if (Use_Stokes_PGF) then + Use_Stokes_PGF = associated(Waves) + if (Use_Stokes_PGF) Use_Stokes_PGF = Waves%Stokes_PGF + if (Use_Stokes_PGF) then + call Stokes_PGF(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) + ! We are adding Stokes_PGF to hydrostatic PGF here. The diag PFu/PFv + ! will therefore report the sum total PGF and we avoid other + ! modifications in the code. The PFu_Stokes can be output within the waves routines. + if (.not.Waves%Passive_Stokes_PGF) then + do k=1,nz + do j=js,je ; do I=Isq,Ieq + CS%PFu(I,j,k) = CS%PFu(I,j,k) + CS%PFu_Stokes(I,j,k) + enddo ; enddo + enddo + do k=1,nz + do J=Jsq,Jeq ; do i=is,ie + CS%PFv(i,J,k) = CS%PFv(i,J,k) + CS%PFv_Stokes(i,J,k) + enddo ; enddo + enddo + endif + endif + 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)") @@ -470,7 +497,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, Gv, US, CS%CoriolisAdv_CSp) + G, Gv, US, CS%CoriolisAdv_CSp, Waves=Waves) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -692,6 +719,27 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s 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) + ! Stokes shear force contribution to pressure gradient + Use_Stokes_PGF = present(Waves) + if (Use_Stokes_PGF) then + Use_Stokes_PGF = associated(Waves) + if (Use_Stokes_PGF) Use_Stokes_PGF = Waves%Stokes_PGF + if (Use_Stokes_PGF) then + call Stokes_PGF(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) + if (.not.Waves%Passive_Stokes_PGF) then + do k=1,nz + do j=js,je ; do I=Isq,Ieq + CS%PFu(I,j,k) = CS%PFu(I,j,k) + CS%PFu_Stokes(I,j,k) + enddo ; enddo + enddo + do k=1,nz + do J=Jsq,Jeq ; do i=is,ie + CS%PFv(i,J,k) = CS%PFv(i,J,k) + CS%PFv_Stokes(i,J,k) + enddo ; enddo + enddo + endif + endif + endif 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 @@ -726,7 +774,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp, Waves=Waves) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -1317,7 +1365,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 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 - + ALLOC_(CS%PFu_Stokes(IsdB:IedB,jsd:jed,nz)) ; CS%PFu_Stokes(:,:,:) = 0.0 + ALLOC_(CS%PFv_Stokes(isd:ied,JsdB:JedB,nz)) ; CS%PFv_Stokes(:,:,:) = 0.0 + MIS%diffu => CS%diffu MIS%diffv => CS%diffv MIS%PFu => CS%PFu diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index b9563f9369..fb188884e8 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -31,6 +31,7 @@ module MOM_wave_interface ! called in step_mom. public get_Langmuir_Number ! Public interface to compute Langmuir number called from ! ePBL or KPP routines. +public Stokes_PGF ! Public interface to compute Stokes-shear modifications to pressure gradient force public StokesMixing ! NOT READY - Public interface to add down-Stokes gradient ! momentum mixing (e.g. the approach of Harcourt 2013/2015) public CoriolisStokes ! NOT READY - Public interface to add Coriolis-Stokes acceleration @@ -50,6 +51,13 @@ module MOM_wave_interface ! Main surface wave options and publicly visible variables logical, public :: UseWaves = .false. !< Flag to enable surface gravity wave feature + logical, public :: Stokes_VF !< Developmental: + !! True if Stokes vortex force is used + logical, public :: Stokes_PGF !< Developmental: + !! True if Stokes shear pressure Gradient force is used + logical, public :: Passive_Stokes_PGF !< Keeps Stokes_PGF on, but doesn't affect dynamics + logical, public :: Stokes_DDT !< Developmental: + !! True if Stokes d/dt is used real, allocatable, dimension(:,:,:), public :: & Us_x !< 3d zonal Stokes drift profile [L T-1 ~> m s-1] !! Horizontal -> U points @@ -58,9 +66,18 @@ module MOM_wave_interface Us_y !< 3d meridional Stokes drift profile [L T-1 ~> m s-1] !! Horizontal -> V points !! Vertical -> Mid-points + real, allocatable, dimension(:,:,:), public :: & + ddt_Us_x !< 3d zonal Stokes drift profile [m s-1] + !! Horizontal -> U points + !! Vertical -> Mid-points + real, allocatable, dimension(:,:,:), public :: & + ddt_Us_y !< 3d meridional Stokes drift profile [m s-1] + !! Horizontal -> V points + !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & KvS !< Viscosity for Stokes Drift shear [Z2 T-1 ~> m2 s-1] + integer, public :: id_PFu_Stokes = -1 , id_PFv_Stokes = -1 ! The remainder of this control structure is private logical :: LagrangianMixing !< This feature is in development and not ready !! True if Stokes drift is present and mixing @@ -131,6 +148,7 @@ module MOM_wave_interface !>@{ Diagnostic handles integer :: id_surfacestokes_x = -1 , id_surfacestokes_y = -1 integer :: id_3dstokes_x = -1 , id_3dstokes_y = -1 + integer :: id_ddt_3dstokes_x = -1 , id_ddt_3dstokes_y = -1 integer :: id_La_turb = -1 !>@} @@ -263,6 +281,18 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) ! Force Code Intervention call MOM_error(FATAL,"Should you be enabling Coriolis-Stokes? Code not ready.") endif + call get_param(param_file, mdl, "STOKES_VF", CS%Stokes_VF, & + "Flag to use Stokes vortex force", units="", & + Default=.false.) + call get_param(param_file, mdl, "STOKES_PGF", CS%Stokes_PGF, & + "Flag to use Stokes pressure gradient force", units="", & + Default=.false.) + call get_param(param_file, mdl, "PASSIVE_STOKES_PGF", CS%Passive_Stokes_PGF, & + "Flag to make Stokes pressure gradient force diagnostic only.", units="", & + Default=.false.) + call get_param(param_file, mdl, "STOKES_DDT", CS%Stokes_DDT, & + "Flag to use Stokes d/dt", units="", & + Default=.false.) CS%g_Earth = US%L_to_Z**2*GV%g_Earth ! Get Wave Method and write to integer WaveMethod @@ -395,6 +425,12 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) CS%Us_x(:,:,:) = 0.0 allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,GV%ke)) CS%Us_y(:,:,:) = 0.0 + if (CS%Stokes_DDT) then + allocate(CS%ddt_Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke)) + CS%ddt_Us_x(:,:,:) = 0.0 + allocate(CS%ddt_Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke)) + CS%ddt_Us_y(:,:,:) = 0.0 + endif ! b. Surface Values allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed)) CS%US0_x(:,:) = 0.0 @@ -420,6 +456,14 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) CS%diag%axesCvL,Time,'3d Stokes drift (y)', 'm s-1', conversion=US%L_T_to_m_s) CS%id_3dstokes_x = register_diag_field('ocean_model','3d_stokes_x', & CS%diag%axesCuL,Time,'3d Stokes drift (x)', 'm s-1', conversion=US%L_T_to_m_s) + CS%id_ddt_3dstokes_y = register_diag_field('ocean_model','dvdt_Stokes', & + CS%diag%axesCvL,Time,'d/dt Stokes drift (meridional)','m s-2') + CS%id_ddt_3dstokes_x = register_diag_field('ocean_model','dudt_Stokes', & + CS%diag%axesCuL,Time,'d/dt Stokes drift (zonal)','m s-2') + CS%id_PFv_Stokes = register_diag_field('ocean_model','PFv_Stokes', & + CS%diag%axesCvL,Time,'PF from Stokes drift (meridional)','m s-2')!Needs conversion + CS%id_PFu_Stokes = register_diag_field('ocean_model','PFu_Stokes', & + CS%diag%axesCuL,Time,'PF from Stokes drift (zonal)','m s-2')!Needs conversion CS%id_La_turb = register_diag_field('ocean_model','La_turbulent',& CS%diag%axesT1,Time,'Surface (turbulent) Langmuir number','nondim') @@ -524,7 +568,7 @@ end subroutine Update_Surface_Waves !> Constructs the Stokes Drift profile on the model grid based on !! desired coupling options -subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) +subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -533,6 +577,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) intent(in) :: h !< Thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ustar !< Wind friction velocity [Z T-1 ~> m s-1]. + real, intent(in) :: dt !< Time-step for computing Stokes-tendency ! Local Variables real :: Top, MidPoint, Bottom ! Positions within the layer [Z ~> m] real :: one_cm ! One centimeter in the units of wavelengths [Z ~> m] @@ -544,10 +589,15 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) real :: UStokes ! A Stokes drift velocity [L T-1 ~> m s-1] real :: La ! The local Langmuir number [nondim] integer :: ii, jj, kk, b, iim1, jjm1 - + real :: idt ! 1 divided by the time step + one_cm = 0.01*US%m_to_Z min_level_thick_avg = 1.e-3*US%m_to_Z + idt = 1.0/dt + CS%ddt_us_x(:,:,:) = CS%US_x(:,:,:) + CS%ddt_us_y(:,:,:) = CS%US_y(:,:,:) + ! 1. If Test Profile Option is chosen ! Computing mid-point value from surface value and decay wavelength if (WaveMethod==TESTPROF) then @@ -772,6 +822,9 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) enddo enddo + CS%ddt_us_x(:,:,:) = (CS%US_x(:,:,:) - CS%ddt_us_x(:,:,:)) * idt + CS%ddt_us_y(:,:,:) = (CS%US_y(:,:,:) - CS%ddt_us_y(:,:,:)) * idt + ! Output any desired quantities if (CS%id_surfacestokes_y>0) & call post_data(CS%id_surfacestokes_y, CS%us0_y, CS%diag) @@ -781,6 +834,10 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) call post_data(CS%id_3dstokes_y, CS%us_y, CS%diag) if (CS%id_3dstokes_x>0) & call post_data(CS%id_3dstokes_x, CS%us_x, CS%diag) + if (CS%id_ddt_3dstokes_x>0) & + call post_data(CS%id_ddt_3dstokes_x, CS%ddt_us_x, CS%diag) + if (CS%id_ddt_3dstokes_y>0) & + call post_data(CS%id_ddt_3dstokes_y, CS%ddt_us_y, CS%diag) if (CS%id_La_turb>0) & call post_data(CS%id_La_turb, CS%La_turb, CS%diag) @@ -1323,6 +1380,144 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) end subroutine StokesMixing +!> Computes tendency due to Stokes pressure gradient force +subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) + type(ocean_grid_type), & + intent(in) :: G !< Ocean grid + type(verticalGrid_type), & + intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + 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(out) :: PFu_Stokes !< PGF Stokes-shear i-component [L T-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: PFv_Stokes !< PGF Stokes-shear j-component [m s-1] + type(Wave_parameters_CS), & + pointer :: CS !< Surface wave related control structure. + + ! Local variables + real :: P_Stokes_l, P_Stokes_r ! Contribution of Stokes shear to pressure (left/right index) [L2 T-2 ~> m2 s-2] + real :: u_l, u_r, v_l, v_r ! Velocity components + real :: dUs_dz_l, dUs_dz_r ! Vertical derivative of zonal Stokes drift (left/right index) [T-1 ~> s-1] + real :: dVs_dz_l, dVs_dz_r ! Vertical derivative of meridional Stokes drift (left/right index) [T-1 ~> s-1] + real :: z_top_l, z_top_r ! The height of the top of the cell (left/right index) [Z ~> m]. + real :: z_mid_l, z_mid_r ! The height of the middle of the cell (left/right index) [Z ~> m]. + real :: h_l, h_r ! The thickness of the cell (left/right index) [Z ~> m]. + real :: wavenum,TwoKexpL, TwoKexpR !TMP DELETE THIS + integer :: i,j,k + + ! Comput the Stokes contribution to the pressure gradient force + + PFu_Stokes(:,:,:) = 0.0 + PFv_Stokes(:,:,:) = 0.0 + + wavenum = (2.*3.14)/50. + do j = G%jsc, G%jec ; do I = G%iscB, G%iecB + if (G%mask2dCu(I,j)>0.5) then + z_top_l = 0.0 + z_top_r = 0.0 + P_Stokes_l = 0.0 + P_Stokes_r = 0.0 + do k = 1, G%ke + h_l = h(i,j,k) + h_r = h(i+1,j,k) + z_mid_l = z_top_l - 0.5*h_l + z_mid_r = z_top_r - 0.5*h_r + TwoKexpL = (2.*wavenum)*exp(2*wavenum*z_mid_l) + TwoKexpR = (2.*wavenum)*exp(2*wavenum*z_mid_r) + !UL -> I-1 & I, j + !UR -> I & I+1, j + !VL -> i, J-1 & J + !VR -> i+1, J-1 & J + dUs_dz_l = TwoKexpL*0.5 * & + (CS%Us0_x(I-1,j)*G%mask2dCu(I-1,j) + & + CS%Us0_x(I,j)*G%mask2dCu(I,j)) + dUs_dz_r = TwoKexpR*0.5 * & + (CS%Us0_x(I,j)*G%mask2dCu(I,j) + & + CS%Us0_x(I+1,j)*G%mask2dCu(I+1,j)) + dVs_dz_l = TwoKexpL*0.5 * & + (CS%Us0_y(i,J-1)*G%mask2dCv(i,J-1) + & + CS%Us0_y(i,J)*G%mask2dCv(i,J)) + dVs_dz_r = TwoKexpR*0.5 * & + (CS%Us0_y(i+1,J-1)*G%mask2dCv(i+1,J-1) + & + CS%Us0_y(i+1,J)*G%mask2dCv(i+1,J)) + u_l = 0.5*(u(I-1,j,k)*G%mask2dCu(I-1,j) + & + u(I,j,k)*G%mask2dCu(I,j)) + u_r = 0.5*(u(I,j,k)*G%mask2dCu(I,j) + & + u(I+1,j,k)*G%mask2dCu(I+1,j)) + v_l = 0.5*(v(i,J-1,k)*G%mask2dCv(i,J-1) + & + v(i,J,k)*G%mask2dCv(i,J)) + v_r = 0.5*(v(i+1,J-1,k)*G%mask2dCv(i+1,J-1) + & + v(i+1,J,k)*G%mask2dCv(i+1,J)) + if (G%mask2dT(i,j)>0.5) & + P_Stokes_l = P_Stokes_l + h_l*(dUs_dz_l*u_l+dVs_dz_l*v_l) + if (G%mask2dT(i+1,j)>0.5) & + P_Stokes_r = P_Stokes_r + h_r*(dUs_dz_r*u_r+dVs_dz_r*v_r) + PFu_Stokes(I,j,k) = (P_Stokes_r - P_Stokes_l)*G%IdxCu(I,j) + z_top_l = z_top_l - h_l + z_top_r = z_top_r - h_r + enddo + endif + enddo ; enddo + do J = G%jscB, G%jecB ; do i = G%isc, G%iec + if (G%mask2dCv(i,J)>0.5) then + z_top_l = 0.0 + z_top_r = 0.0 + P_Stokes_l = 0.0 + P_Stokes_r = 0.0 + do k = 1, G%ke + h_l = h(i,j,k) + h_r = h(i,j+1,k) + z_mid_l = z_top_l - 0.5*h_l + z_mid_r = z_top_r - 0.5*h_r + TwoKexpL = (2.*wavenum)*exp(2*wavenum*z_mid_l) + TwoKexpR = (2.*wavenum)*exp(2*wavenum*z_mid_r) + !UL -> I-1 & I, j + !UR -> I-1 & I, j+1 + !VL -> i, J & J-1 + !VR -> i, J & J+1 + dUs_dz_l = TwoKexpL*0.5 * & + (CS%Us0_x(I-1,j)*G%mask2dCu(I-1,j) + & + CS%Us0_x(I,j)*G%mask2dCu(I,j)) + dUs_dz_r = TwoKexpR*0.5 * & + (CS%Us0_x(I-1,j+1)*G%mask2dCu(I-1,j+1) + & + CS%Us0_x(I,j+1)*G%mask2dCu(I,j+1)) + dVs_dz_l = TwoKexpL*0.5 * & + (CS%Us0_y(i,J-1)*G%mask2dCv(i,J-1) + & + CS%Us0_y(i,J)*G%mask2dCv(i,J)) + dVs_dz_r = TwoKexpR*0.5 * & + (CS%Us0_y(i,J)*G%mask2dCv(i,J) + & + CS%Us0_y(i,J+1)*G%mask2dCv(i,J+1)) + u_l = 0.5*(u(I-1,j,k)*G%mask2dCu(I-1,j) + & + u(I,j,k)*G%mask2dCu(I,j)) + u_r = 0.5*(u(I-1,j+1,k)*G%mask2dCu(I-1,j+1) + & + u(I,j+1,k)*G%mask2dCu(I,j+1)) + v_l = 0.5*(v(i,J-1,k)*G%mask2dCv(i,J-1) + & + v(i,J,k)*G%mask2dCv(i,J)) + v_r = 0.5*(v(i,J,k)*G%mask2dCv(i,J) + & + v(i,J+1,k)*G%mask2dCv(i,J+1)) + if (G%mask2dT(i,j)>0.5) & + P_Stokes_l = P_Stokes_l + h_l*(dUs_dz_l*u_l+dVs_dz_l*v_l) + if (G%mask2dT(i,j+1)>0.5) & + P_Stokes_r = P_Stokes_r + h_r*(dUs_dz_r*u_r+dVs_dz_r*v_r) + PFv_Stokes(i,J,k) = (P_Stokes_r - P_Stokes_l)*G%IdyCv(i,J) + z_top_l = z_top_l - h_l + z_top_r = z_top_r - h_r + enddo + endif + enddo ; enddo + + if (CS%id_PFv_Stokes>0) & + call post_data(CS%id_PFv_Stokes, PFv_Stokes, CS%diag) + if (CS%id_PFu_Stokes>0) & + call post_data(CS%id_PFu_Stokes, PFu_Stokes, CS%diag) + +end subroutine Stokes_PGF + !> Solver to add Coriolis-Stokes to model !! Still in development and not meant for general use. !! Can be activated (with code intervention) for LES comparison From 9fbdf11ec3c5bf0b698aed7b6eca674b388d3950 Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Fri, 4 Jun 2021 13:47:21 -0400 Subject: [PATCH 02/38] Finish incomplete merge in MOM_wave_interface. --- src/user/MOM_wave_interface.F90 | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 611387c41e..71f29eb852 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -460,19 +460,15 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) CS%diag%axesCvL,Time,'3d Stokes drift (y)', 'm s-1', conversion=US%L_T_to_m_s) CS%id_3dstokes_x = register_diag_field('ocean_model','3d_stokes_x', & CS%diag%axesCuL,Time,'3d Stokes drift (x)', 'm s-1', conversion=US%L_T_to_m_s) -<<<<<<< HEAD CS%id_ddt_3dstokes_y = register_diag_field('ocean_model','dvdt_Stokes', & - CS%diag%axesCvL,Time,'d/dt Stokes drift (meridional)','m s-2') + CS%diag%axesCvL,Time,'d/dt Stokes drift (meridional)','m s-2')!Needs conversion CS%id_ddt_3dstokes_x = register_diag_field('ocean_model','dudt_Stokes', & - CS%diag%axesCuL,Time,'d/dt Stokes drift (zonal)','m s-2') + CS%diag%axesCuL,Time,'d/dt Stokes drift (zonal)','m s-2')!Needs conversion CS%id_PFv_Stokes = register_diag_field('ocean_model','PFv_Stokes', & CS%diag%axesCvL,Time,'PF from Stokes drift (meridional)','m s-2')!Needs conversion CS%id_PFu_Stokes = register_diag_field('ocean_model','PFu_Stokes', & CS%diag%axesCuL,Time,'PF from Stokes drift (zonal)','m s-2')!Needs conversion - CS%id_La_turb = register_diag_field('ocean_model','La_turbulent',& -======= CS%id_La_turb = register_diag_field('ocean_model','La_turbulent', & ->>>>>>> dev/gfdl CS%diag%axesT1,Time,'Surface (turbulent) Langmuir number','nondim') end subroutine MOM_wave_interface_init From a6de11c92a09abfc748e4970aa3aa09e7f0c98f5 Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Mon, 7 Jun 2021 13:07:33 -0400 Subject: [PATCH 03/38] Remote application of Stokes tendency on thermodynamic step - This only makes sense to add on the dynamics timestep. --- src/core/MOM.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index dddfea228d..f7167a1a52 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -656,10 +656,10 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS else ! not do_dyn. if (CS%UseWaves) then ! Diagnostics are not enabled in this call. call Update_Stokes_Drift(G, GV, US, Waves, h, fluxes%ustar, dt) - if (Waves%Stokes_DDT) then - u(:,:,:) = u(:,:,:) + Waves%ddt_us_x(:,:,:)*dt - v(:,:,:) = v(:,:,:) + Waves%ddt_us_y(:,:,:)*dt - endif + !if (Waves%Stokes_DDT) then + ! u(:,:,:) = u(:,:,:) + Waves%ddt_us_x(:,:,:)*dt + ! v(:,:,:) = v(:,:,:) + Waves%ddt_us_y(:,:,:)*dt + !endif endif endif From c5f1d442e162e28e0f9c7918a2f90d6557aa6637 Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Mon, 7 Jun 2021 13:08:43 -0400 Subject: [PATCH 04/38] Updating name of Stokes PGF routine to be more descriptive. --- src/core/MOM_dynamics_split_RK2.F90 | 6 +- src/user/MOM_wave_interface.F90 | 255 ++++++++++++++-------------- 2 files changed, 135 insertions(+), 126 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 34539dbea7..bffd07f66c 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -60,7 +60,7 @@ module MOM_dynamics_split_RK2 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, Stokes_PGF +use MOM_wave_interface, only: wave_parameters_CS, Stokes_PGF_Add_FD implicit none ; private @@ -463,7 +463,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s Use_Stokes_PGF = associated(Waves) if (Use_Stokes_PGF) Use_Stokes_PGF = Waves%Stokes_PGF if (Use_Stokes_PGF) then - call Stokes_PGF(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) + call Stokes_PGF_Add_FD(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) ! We are adding Stokes_PGF to hydrostatic PGF here. The diag PFu/PFv ! will therefore report the sum total PGF and we avoid other ! modifications in the code. The PFu_Stokes can be output within the waves routines. @@ -725,7 +725,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s Use_Stokes_PGF = associated(Waves) if (Use_Stokes_PGF) Use_Stokes_PGF = Waves%Stokes_PGF if (Use_Stokes_PGF) then - call Stokes_PGF(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) + call Stokes_PGF_Add_FD(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) if (.not.Waves%Passive_Stokes_PGF) then do k=1,nz do j=js,je ; do I=Isq,Ieq diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 71f29eb852..ca93ae0a93 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -30,7 +30,8 @@ module MOM_wave_interface ! called in step_mom. public get_Langmuir_Number ! Public interface to compute Langmuir number called from ! ePBL or KPP routines. -public Stokes_PGF ! Public interface to compute Stokes-shear modifications to pressure gradient force +public Stokes_PGF_Add_FD ! Public interface to compute Stokes-shear modifications to pressure gradient force + ! using an additive, finite difference method public StokesMixing ! NOT READY - Public interface to add down-Stokes gradient ! momentum mixing (e.g. the approach of Harcourt 2013/2015) public CoriolisStokes ! NOT READY - Public interface to add Coriolis-Stokes acceleration @@ -54,7 +55,7 @@ module MOM_wave_interface !! True if Stokes vortex force is used logical, public :: Stokes_PGF !< Developmental: !! True if Stokes shear pressure Gradient force is used - logical, public :: Passive_Stokes_PGF !< Keeps Stokes_PGF on, but doesn't affect dynamics + logical, public :: Passive_Stokes_PGF !< Keeps Stokes_PGF on, but doesn't affect dynamics logical, public :: Stokes_DDT !< Developmental: !! True if Stokes d/dt is used real, allocatable, dimension(:,:,:), public :: & @@ -461,9 +462,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) CS%id_3dstokes_x = register_diag_field('ocean_model','3d_stokes_x', & CS%diag%axesCuL,Time,'3d Stokes drift (x)', 'm s-1', conversion=US%L_T_to_m_s) CS%id_ddt_3dstokes_y = register_diag_field('ocean_model','dvdt_Stokes', & - CS%diag%axesCvL,Time,'d/dt Stokes drift (meridional)','m s-2')!Needs conversion + CS%diag%axesCvL,Time,'d/dt Stokes drift (meridional)','m s-2') CS%id_ddt_3dstokes_x = register_diag_field('ocean_model','dudt_Stokes', & - CS%diag%axesCuL,Time,'d/dt Stokes drift (zonal)','m s-2')!Needs conversion + CS%diag%axesCuL,Time,'d/dt Stokes drift (zonal)','m s-2') CS%id_PFv_Stokes = register_diag_field('ocean_model','PFv_Stokes', & CS%diag%axesCvL,Time,'PF from Stokes drift (meridional)','m s-2')!Needs conversion CS%id_PFu_Stokes = register_diag_field('ocean_model','PFu_Stokes', & @@ -565,14 +566,15 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) real :: La ! The local Langmuir number [nondim] integer :: ii, jj, kk, b, iim1, jjm1 real :: idt ! 1 divided by the time step - + one_cm = 0.01*US%m_to_Z min_level_thick_avg = 1.e-3*US%m_to_Z idt = 1.0/dt + ! Getting Stokes drift profile from previous step CS%ddt_us_x(:,:,:) = CS%US_x(:,:,:) CS%ddt_us_y(:,:,:) = CS%US_y(:,:,:) - + ! 1. If Test Profile Option is chosen ! Computing mid-point value from surface value and decay wavelength if (CS%WaveMethod==TESTPROF) then @@ -810,9 +812,11 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) enddo enddo + ! Finding tendency of Stokes drift over the time step to apply + ! as an acceleration to the models current. CS%ddt_us_x(:,:,:) = (CS%US_x(:,:,:) - CS%ddt_us_x(:,:,:)) * idt CS%ddt_us_y(:,:,:) = (CS%US_y(:,:,:) - CS%ddt_us_y(:,:,:)) * idt - + ! Output any desired quantities if (CS%id_surfacestokes_y>0) & call post_data(CS%id_surfacestokes_y, CS%us0_y, CS%diag) @@ -1422,8 +1426,56 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) end subroutine StokesMixing -!> Computes tendency due to Stokes pressure gradient force -subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) +!> Solver to add Coriolis-Stokes to model +!! Still in development and not meant for general use. +!! Can be activated (with code intervention) for LES comparison +!! CHECK THAT RIGHT TIMESTEP IS PASSED IF YOU USE THIS** +!! +!! Not accessed in the standard code. +subroutine CoriolisStokes(G, GV, dt, h, u, v, WAVES, US) + type(ocean_grid_type), & + intent(in) :: G !< Ocean grid + type(verticalGrid_type), & + intent(in) :: GV !< Ocean vertical grid + real, intent(in) :: dt !< Time step of MOM6 [T ~> s] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: u !< Velocity i-component [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: v !< Velocity j-component [L T-1 ~> m s-1] + type(Wave_parameters_CS), & + pointer :: Waves !< Surface wave related control structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + ! Local variables + real :: DVel ! A rescaled velocity change [L T-2 ~> m s-2] + integer :: i,j,k + + do k = 1, GV%ke +do j = G%jsc, G%jec + do I = G%iscB, G%iecB + DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + & + 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) + u(I,j,k) = u(I,j,k) + DVEL*dt + enddo + enddo + enddo + + do k = 1, GV%ke + do J = G%jscB, G%jecB + do i = G%isc, G%iec + DVel = 0.25*(WAVES%us_x(i+1,j,k)+WAVES%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + & + 0.25*(WAVES%us_x(i,j,k)+WAVES%us_x(i,j-1,k))*G%CoriolisBu(i,j) + v(i,J,k) = v(i,j,k) - DVEL*dt + enddo + enddo + enddo +end subroutine CoriolisStokes + + +!> Computes tendency due to Stokes pressure gradient force using an +!! additive finite difference method +subroutine Stokes_PGF_Add_FD(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) type(ocean_grid_type), & intent(in) :: G !< Ocean grid type(verticalGrid_type), & @@ -1449,17 +1501,16 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) real :: z_top_l, z_top_r ! The height of the top of the cell (left/right index) [Z ~> m]. real :: z_mid_l, z_mid_r ! The height of the middle of the cell (left/right index) [Z ~> m]. real :: h_l, h_r ! The thickness of the cell (left/right index) [Z ~> m]. - real :: wavenum,TwoKexpL, TwoKexpR !TMP DELETE THIS - integer :: i,j,k - - ! Comput the Stokes contribution to the pressure gradient force + real :: TwoKexpL, TwoKexpR + integer :: i,j,k,l + ! Compute the Stokes contribution to the pressure gradient force PFu_Stokes(:,:,:) = 0.0 PFv_Stokes(:,:,:) = 0.0 - wavenum = (2.*3.14)/50. do j = G%jsc, G%jec ; do I = G%iscB, G%iecB if (G%mask2dCu(I,j)>0.5) then + z_top_l = 0.0 z_top_r = 0.0 P_Stokes_l = 0.0 @@ -1469,37 +1520,39 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) h_r = h(i+1,j,k) z_mid_l = z_top_l - 0.5*h_l z_mid_r = z_top_r - 0.5*h_r - TwoKexpL = (2.*wavenum)*exp(2*wavenum*z_mid_l) - TwoKexpR = (2.*wavenum)*exp(2*wavenum*z_mid_r) - !UL -> I-1 & I, j - !UR -> I & I+1, j - !VL -> i, J-1 & J - !VR -> i+1, J-1 & J - dUs_dz_l = TwoKexpL*0.5 * & - (CS%Us0_x(I-1,j)*G%mask2dCu(I-1,j) + & - CS%Us0_x(I,j)*G%mask2dCu(I,j)) - dUs_dz_r = TwoKexpR*0.5 * & - (CS%Us0_x(I,j)*G%mask2dCu(I,j) + & - CS%Us0_x(I+1,j)*G%mask2dCu(I+1,j)) - dVs_dz_l = TwoKexpL*0.5 * & - (CS%Us0_y(i,J-1)*G%mask2dCv(i,J-1) + & - CS%Us0_y(i,J)*G%mask2dCv(i,J)) - dVs_dz_r = TwoKexpR*0.5 * & - (CS%Us0_y(i+1,J-1)*G%mask2dCv(i+1,J-1) + & - CS%Us0_y(i+1,J)*G%mask2dCv(i+1,J)) - u_l = 0.5*(u(I-1,j,k)*G%mask2dCu(I-1,j) + & - u(I,j,k)*G%mask2dCu(I,j)) - u_r = 0.5*(u(I,j,k)*G%mask2dCu(I,j) + & - u(I+1,j,k)*G%mask2dCu(I+1,j)) - v_l = 0.5*(v(i,J-1,k)*G%mask2dCv(i,J-1) + & - v(i,J,k)*G%mask2dCv(i,J)) - v_r = 0.5*(v(i+1,J-1,k)*G%mask2dCv(i+1,J-1) + & - v(i+1,J,k)*G%mask2dCv(i+1,J)) - if (G%mask2dT(i,j)>0.5) & - P_Stokes_l = P_Stokes_l + h_l*(dUs_dz_l*u_l+dVs_dz_l*v_l) - if (G%mask2dT(i+1,j)>0.5) & - P_Stokes_r = P_Stokes_r + h_r*(dUs_dz_r*u_r+dVs_dz_r*v_r) - PFu_Stokes(I,j,k) = (P_Stokes_r - P_Stokes_l)*G%IdxCu(I,j) + do l = 1, CS%numbands + TwoKexpL = (2.*CS%WaveNum_Cen(l))*exp(2*CS%WaveNum_Cen(l)*z_mid_l) + TwoKexpR = (2.*CS%WaveNum_Cen(l))*exp(2*CS%WaveNum_Cen(l)*z_mid_r) + !UL -> I-1 & I, j + !UR -> I & I+1, j + !VL -> i, J-1 & J + !VR -> i+1, J-1 & J + dUs_dz_l = TwoKexpL*0.5 * & + (CS%Stkx0(I-1,j,l)*G%mask2dCu(I-1,j) + & + CS%Stkx0(I,j,l)*G%mask2dCu(I,j)) + dUs_dz_r = TwoKexpR*0.5 * & + (CS%Stkx0(I,j,l)*G%mask2dCu(I,j) + & + CS%Stkx0(I+1,j,l)*G%mask2dCu(I+1,j)) + dVs_dz_l = TwoKexpL*0.5 * & + (CS%Stky0(i,J-1,l)*G%mask2dCv(i,J-1) + & + CS%Stky0(i,J,l)*G%mask2dCv(i,J)) + dVs_dz_r = TwoKexpR*0.5 * & + (CS%Stky0(i+1,J-1,l)*G%mask2dCv(i+1,J-1) + & + CS%Stky0(i+1,J,l)*G%mask2dCv(i+1,J)) + u_l = 0.5*(u(I-1,j,k)*G%mask2dCu(I-1,j) + & + u(I,j,k)*G%mask2dCu(I,j)) + u_r = 0.5*(u(I,j,k)*G%mask2dCu(I,j) + & + u(I+1,j,k)*G%mask2dCu(I+1,j)) + v_l = 0.5*(v(i,J-1,k)*G%mask2dCv(i,J-1) + & + v(i,J,k)*G%mask2dCv(i,J)) + v_r = 0.5*(v(i+1,J-1,k)*G%mask2dCv(i+1,J-1) + & + v(i+1,J,k)*G%mask2dCv(i+1,J)) + if (G%mask2dT(i,j)>0.5) & + P_Stokes_l = P_Stokes_l + h_l*(dUs_dz_l*u_l+dVs_dz_l*v_l) + if (G%mask2dT(i+1,j)>0.5) & + P_Stokes_r = P_Stokes_r + h_r*(dUs_dz_r*u_r+dVs_dz_r*v_r) + PFu_Stokes(I,j,k) = PFu_Stokes(I,j,k) + (P_Stokes_r - P_Stokes_l)*G%IdxCu(I,j) + enddo z_top_l = z_top_l - h_l z_top_r = z_top_r - h_r enddo @@ -1516,37 +1569,39 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) h_r = h(i,j+1,k) z_mid_l = z_top_l - 0.5*h_l z_mid_r = z_top_r - 0.5*h_r - TwoKexpL = (2.*wavenum)*exp(2*wavenum*z_mid_l) - TwoKexpR = (2.*wavenum)*exp(2*wavenum*z_mid_r) - !UL -> I-1 & I, j - !UR -> I-1 & I, j+1 - !VL -> i, J & J-1 - !VR -> i, J & J+1 - dUs_dz_l = TwoKexpL*0.5 * & - (CS%Us0_x(I-1,j)*G%mask2dCu(I-1,j) + & - CS%Us0_x(I,j)*G%mask2dCu(I,j)) - dUs_dz_r = TwoKexpR*0.5 * & - (CS%Us0_x(I-1,j+1)*G%mask2dCu(I-1,j+1) + & - CS%Us0_x(I,j+1)*G%mask2dCu(I,j+1)) - dVs_dz_l = TwoKexpL*0.5 * & - (CS%Us0_y(i,J-1)*G%mask2dCv(i,J-1) + & - CS%Us0_y(i,J)*G%mask2dCv(i,J)) - dVs_dz_r = TwoKexpR*0.5 * & - (CS%Us0_y(i,J)*G%mask2dCv(i,J) + & - CS%Us0_y(i,J+1)*G%mask2dCv(i,J+1)) - u_l = 0.5*(u(I-1,j,k)*G%mask2dCu(I-1,j) + & - u(I,j,k)*G%mask2dCu(I,j)) - u_r = 0.5*(u(I-1,j+1,k)*G%mask2dCu(I-1,j+1) + & - u(I,j+1,k)*G%mask2dCu(I,j+1)) - v_l = 0.5*(v(i,J-1,k)*G%mask2dCv(i,J-1) + & - v(i,J,k)*G%mask2dCv(i,J)) - v_r = 0.5*(v(i,J,k)*G%mask2dCv(i,J) + & - v(i,J+1,k)*G%mask2dCv(i,J+1)) - if (G%mask2dT(i,j)>0.5) & - P_Stokes_l = P_Stokes_l + h_l*(dUs_dz_l*u_l+dVs_dz_l*v_l) - if (G%mask2dT(i,j+1)>0.5) & - P_Stokes_r = P_Stokes_r + h_r*(dUs_dz_r*u_r+dVs_dz_r*v_r) - PFv_Stokes(i,J,k) = (P_Stokes_r - P_Stokes_l)*G%IdyCv(i,J) + do l = 1, CS%numbands + TwoKexpL = (2.*CS%WaveNum_Cen(l))*exp(2*CS%WaveNum_Cen(l)*z_mid_l) + TwoKexpR = (2.*CS%WaveNum_Cen(l))*exp(2*CS%WaveNum_Cen(l)*z_mid_r) + !UL -> I-1 & I, j + !UR -> I-1 & I, j+1 + !VL -> i, J & J-1 + !VR -> i, J & J+1 + dUs_dz_l = TwoKexpL*0.5 * & + (CS%Stkx0(I-1,j,l)*G%mask2dCu(I-1,j) + & + CS%Stkx0(I,j,l)*G%mask2dCu(I,j)) + dUs_dz_r = TwoKexpR*0.5 * & + (CS%Stkx0(I-1,j+1,l)*G%mask2dCu(I-1,j+1) + & + CS%Stkx0(I,j+1,l)*G%mask2dCu(I,j+1)) + dVs_dz_l = TwoKexpL*0.5 * & + (CS%Stky0(i,J-1,l)*G%mask2dCv(i,J-1) + & + CS%Stky0(i,J,l)*G%mask2dCv(i,J)) + dVs_dz_r = TwoKexpR*0.5 * & + (CS%Stky0(i,J,l)*G%mask2dCv(i,J) + & + CS%Stky0(i,J+1,l)*G%mask2dCv(i,J+1)) + u_l = 0.5*(u(I-1,j,k)*G%mask2dCu(I-1,j) + & + u(I,j,k)*G%mask2dCu(I,j)) + u_r = 0.5*(u(I-1,j+1,k)*G%mask2dCu(I-1,j+1) + & + u(I,j+1,k)*G%mask2dCu(I,j+1)) + v_l = 0.5*(v(i,J-1,k)*G%mask2dCv(i,J-1) + & + v(i,J,k)*G%mask2dCv(i,J)) + v_r = 0.5*(v(i,J,k)*G%mask2dCv(i,J) + & + v(i,J+1,k)*G%mask2dCv(i,J+1)) + if (G%mask2dT(i,j)>0.5) & + P_Stokes_l = P_Stokes_l + h_l*(dUs_dz_l*u_l+dVs_dz_l*v_l) + if (G%mask2dT(i,j+1)>0.5) & + P_Stokes_r = P_Stokes_r + h_r*(dUs_dz_r*u_r+dVs_dz_r*v_r) + PFv_Stokes(i,J,k) = PFv_Stokes(i,J,k) + (P_Stokes_r - P_Stokes_l)*G%IdyCv(i,J) + enddo z_top_l = z_top_l - h_l z_top_r = z_top_r - h_r enddo @@ -1558,53 +1613,7 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) if (CS%id_PFu_Stokes>0) & call post_data(CS%id_PFu_Stokes, PFu_Stokes, CS%diag) -end subroutine Stokes_PGF - -!> Solver to add Coriolis-Stokes to model -!! Still in development and not meant for general use. -!! Can be activated (with code intervention) for LES comparison -!! CHECK THAT RIGHT TIMESTEP IS PASSED IF YOU USE THIS** -!! -!! Not accessed in the standard code. -subroutine CoriolisStokes(G, GV, dt, h, u, v, WAVES, US) - type(ocean_grid_type), & - intent(in) :: G !< Ocean grid - type(verticalGrid_type), & - intent(in) :: GV !< Ocean vertical grid - real, intent(in) :: dt !< Time step of MOM6 [T ~> s] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: u !< Velocity i-component [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Velocity j-component [L T-1 ~> m s-1] - type(Wave_parameters_CS), & - pointer :: Waves !< Surface wave related control structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - ! Local variables - real :: DVel ! A rescaled velocity change [L T-2 ~> m s-2] - integer :: i,j,k - - do k = 1, GV%ke - do j = G%jsc, G%jec - do I = G%iscB, G%iecB - DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + & - 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) - u(I,j,k) = u(I,j,k) + DVEL*dt - enddo - enddo - enddo - - do k = 1, GV%ke - do J = G%jscB, G%jecB - do i = G%isc, G%iec - DVel = 0.25*(WAVES%us_x(i+1,j,k)+WAVES%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + & - 0.25*(WAVES%us_x(i,j,k)+WAVES%us_x(i,j-1,k))*G%CoriolisBu(i,j) - v(i,J,k) = v(i,j,k) - DVEL*dt - enddo - enddo - enddo -end subroutine CoriolisStokes +end subroutine Stokes_PGF_Add_FD !> Computes wind speed from ustar_air based on COARE 3.5 Cd relationship !! Probably doesn't belong in this module, but it is used here to estimate From e3d190db3ecbbd152b7db74befb051e0418a2d10 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 30 Aug 2021 09:47:48 -0600 Subject: [PATCH 05/38] In NUOPC cap, add ability to import fields with ungridded dimensions --- config_src/drivers/nuopc_cap/mom_cap.F90 | 60 +++++++++---- .../drivers/nuopc_cap/mom_cap_methods.F90 | 87 +++++++++++++++++-- 2 files changed, 125 insertions(+), 22 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 67d650aded..938f6bdfda 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -122,6 +122,8 @@ module MOM_cap_mod character(len=64) :: stdname character(len=64) :: shortname character(len=64) :: transferOffer + integer :: ungridded_lbound = 0 + integer :: ungridded_ubound = 0 end type fld_list_type integer,parameter :: fldsMax = 100 @@ -2091,25 +2093,43 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) if (present(grid)) then - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & - name=field_defs(i)%shortname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! initialize fldptr to zero - call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr2d(:,:) = 0.0 + if (field_defs(i)%ungridded_lbound > 0 .and. field_defs(i)%ungridded_ubound > 0) then + call ESMF_LogWrite(trim(subname)//": ERROR ungridded dimensions not supported in MOM6 nuopc cap when "//& + "ESMF_GEOMTYPE_GRID is used. Use ESMF_GEOMTYPE_MESH instead.", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + else + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + name=field_defs(i)%shortname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0.0 + endif else if (present(mesh)) then - field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & - name=field_defs(i)%shortname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! initialize fldptr to zero - call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0.0 + if (field_defs(i)%ungridded_lbound > 0 .and. field_defs(i)%ungridded_ubound > 0) then + field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=field_defs(i)%shortname, ungriddedLbound=(/field_defs(i)%ungridded_lbound/), & + ungriddedUbound=(/field_defs(i)%ungridded_ubound/), gridToFieldMap=(/2/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0.0 + else + field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=field_defs(i)%shortname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0.0 + endif endif @@ -2166,12 +2186,14 @@ end subroutine MOM_RealizeFields !=============================================================================== !> Set up list of field information -subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) +subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname, ungridded_lbound, ungridded_ubound) integer, intent(inout) :: num type(fld_list_type), intent(inout) :: fldlist(:) character(len=*), intent(in) :: stdname character(len=*), intent(in) :: transferOffer character(len=*), optional, intent(in) :: shortname + integer, optional, intent(in) :: ungridded_lbound + integer, optional, intent(in) :: ungridded_ubound ! local variables integer :: rc @@ -2193,6 +2215,10 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) fldlist(num)%shortname = trim(stdname) endif fldlist(num)%transferOffer = trim(transferOffer) + if (present(ungridded_lbound) .and. present(ungridded_ubound)) then + fldlist(num)%ungridded_lbound = ungridded_lbound + fldlist(num)%ungridded_ubound = ungridded_ubound + end if end subroutine fld_list_add diff --git a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 b/config_src/drivers/nuopc_cap/mom_cap_methods.F90 index bb9743bb84..f0f0c1ee46 100644 --- a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap_methods.F90 @@ -32,7 +32,11 @@ module MOM_cap_methods public :: state_diagnose public :: ChkErr -private :: State_getImport +interface State_getImport + module procedure State_getImport_2d + module procedure State_getImport_3d ! third dimension being an ungridded dimension +end interface + private :: State_setExport !> Get field pointer @@ -648,8 +652,8 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) end subroutine State_GetFldPtr_2d -!> Map import state field to output array -subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, areacor, rc) +!> Map 2d import state field to output array +subroutine State_GetImport_2d(state, fldname, isc, iec, jsc, jec, output, do_sum, areacor, rc) type(ESMF_State) , intent(in) :: state !< ESMF state character(len=*) , intent(in) :: fldname !< Field name integer , intent(in) :: isc !< The start i-index of cell centers within @@ -672,7 +676,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, a integer :: lbnd1,lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr1d(:) real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) - character(len=*) , parameter :: subname='(MOM_cap_methods:state_getimport)' + character(len=*) , parameter :: subname='(MOM_cap_methods:state_getimport_2d)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -731,7 +735,80 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, a endif -end subroutine State_GetImport +end subroutine State_GetImport_2d + +!> Map 3d import state field to output array (where 3rd dim is an ungridded dimension) +subroutine State_GetImport_3d(state, fldname, isc, iec, jsc, jec, lbd, ubd, output, do_sum, areacor, rc) + type(ESMF_State) , intent(in) :: state !< ESMF state + character(len=*) , intent(in) :: fldname !< Field name + integer , intent(in) :: isc !< The start i-index of cell centers within + !! the computational domain + integer , intent(in) :: iec !< The end i-index of cell centers within the + !! computational domain + integer , intent(in) :: jsc !< The start j-index of cell centers within + !! the computational domain + integer , intent(in) :: jec !< The end j-index of cell centers within + !! the computational domain + integer , intent(in) :: lbd !< lower bound of ungridded dimension + integer , intent(in) :: ubd !< upper bound of ungridded dimension + real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec,lbd:ubd)!< Output 3D array + logical, optional , intent(in) :: do_sum !< If true, sums the data + real (ESMF_KIND_R8), optional, intent(in) :: areacor(:) !< flux area correction factors + !! applicable to meshes + integer , intent(out) :: rc !< Return code + + ! local variables + type(ESMF_StateItem_Flag) :: itemFlag + integer :: n, i, j, i1, j1, u + integer :: lbnd1,lbnd2 + real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) + character(len=*) , parameter :: subname='(MOM_cap_methods:state_getimport_3d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then + + if (geomtype == ESMF_GEOMTYPE_MESH) then + + ! get field pointer + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! determine output array and apply area correction if present + do u = lbd, ubd ! ungridded dims + n = 0 + do j = jsc,jec + do i = isc,iec + n = n + 1 + if (present(do_sum)) then + if (present(areacor)) then + output(i,j,u) = output(i,j,u) + dataPtr2d(u,n) * areacor(n) + else + output(i,j,u) = output(i,j,u) + dataPtr2d(u,n) + end if + else + if (present(areacor)) then + output(i,j,u) = dataPtr2d(u,n) * areacor(n) + else + output(i,j,u) = dataPtr2d(u,n) + end if + endif + enddo + enddo + enddo + + else if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_LogWrite(trim(subname)//": ERROR ungridded dimensions not supported in MOM6 nuopc cap when "// & + "ESMF_GEOMTYPE_GRID is used. Use ESMF_GEOMTYPE_MESH instead.", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + endif + +end subroutine State_GetImport_3d !> Map input array to export state subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid, areacor, rc) From 6e94b699bf6008aed654480f71450f642e5d7475 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 7 Sep 2021 16:31:55 -0600 Subject: [PATCH 06/38] disable the register of tidal mixing coeff diags when they are unavailable --- .../vertical/MOM_tidal_mixing.F90 | 27 +++++++------------ 1 file changed, 9 insertions(+), 18 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 21562817c0..a162f3b0bd 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -603,12 +603,15 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, & 'Bouyancy frequency squared, at interfaces', 's-2', conversion=US%s_to_T**2) !> TODO: add units - CS%id_Simmons_coeff = register_diag_field('ocean_model','Simmons_coeff',diag%axesT1,Time, & - 'time-invariant portion of the tidal mixing coefficient using the Simmons', '') - CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTL,Time, & - 'time-invariant portion of the tidal mixing coefficient using the Schmittner', '') - CS%id_tidal_qe_md = register_diag_field('ocean_model','tidal_qe_md',diag%axesTL,Time, & - 'input tidal energy dissipated locally interpolated to model vertical coordinates', '') + if (CS%CVMix_tidal_scheme .eq. SIMMONS) then + CS%id_Simmons_coeff = register_diag_field('ocean_model','Simmons_coeff',diag%axesT1,Time, & + 'time-invariant portion of the tidal mixing coefficient using the Simmons', '') + else if (CS%CVMix_tidal_scheme .eq. SCHMITTNER) then + CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTL,Time, & + 'time-invariant portion of the tidal mixing coefficient using the Schmittner', '') + CS%id_tidal_qe_md = register_diag_field('ocean_model','tidal_qe_md',diag%axesTL,Time, & + 'input tidal energy dissipated locally interpolated to model vertical coordinates', '') + endif CS%id_vert_dep = register_diag_field('ocean_model','vert_dep',diag%axesTi,Time, & 'vertical deposition function needed for Simmons et al tidal mixing', '') @@ -1474,27 +1477,15 @@ subroutine setup_tidal_diagnostics(G, GV, CS) allocate(dd%N2_int(isd:ied,jsd:jed,nz+1)) ; dd%N2_int(:,:,:) = 0.0 endif if (CS%id_Simmons_coeff > 0) then - if (CS%CVMix_tidal_scheme .ne. SIMMONS) then - call MOM_error(FATAL, "setup_tidal_diagnostics: Simmons_coeff diagnostics is available "//& - "only when CVMix_tidal_scheme is Simmons") - endif allocate(dd%Simmons_coeff_2d(isd:ied,jsd:jed)) ; dd%Simmons_coeff_2d(:,:) = 0.0 endif if (CS%id_vert_dep > 0) then allocate(dd%vert_dep_3d(isd:ied,jsd:jed,nz+1)) ; dd%vert_dep_3d(:,:,:) = 0.0 endif if (CS%id_Schmittner_coeff > 0) then - if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then - call MOM_error(FATAL, "setup_tidal_diagnostics: Schmittner_coeff diagnostics is available "//& - "only when CVMix_tidal_scheme is Schmittner.") - endif allocate(dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz)) ; dd%Schmittner_coeff_3d(:,:,:) = 0.0 endif if (CS%id_tidal_qe_md > 0) then - if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then - call MOM_error(FATAL, "setup_tidal_diagnostics: tidal_qe_md diagnostics is available "//& - "only when CVMix_tidal_scheme is Schmittner.") - endif allocate(dd%tidal_qe_md(isd:ied,jsd:jed,nz)) ; dd%tidal_qe_md(:,:,:) = 0.0 endif end subroutine setup_tidal_diagnostics From 59a31f62c9b0c0a67753664480d530bea5ed3397 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 12 Oct 2021 15:51:23 -0600 Subject: [PATCH 07/38] remove unnecessary ampersands from variable declarations --- src/core/MOM_CoriolisAdv.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 80fe5ae1a7..89115941c7 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -188,8 +188,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)) :: & PV, & ! A diagnostic array of the potential vorticities [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. RV ! A diagnostic array of the relative vorticities [T-1 ~> s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & CAuS ! - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & CAvS ! + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: CAuS ! + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: CAvS ! real :: fv1, fv2, fv3, fv4 ! (f+rv)*v [L T-2 ~> m s-2]. real :: fu1, fu2, fu3, fu4 ! -(f+rv)*u [L T-2 ~> m s-2]. real :: max_fv, max_fu ! The maximum or minimum of the neighboring Coriolis From 824039dac63ae215463a3b6b1dfe4f384397e60e Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 15 Oct 2021 12:39:52 -0600 Subject: [PATCH 08/38] enclose stokes vorticity diag computations with Stokes_VF conditional --- src/core/MOM_CoriolisAdv.F90 | 70 ++++++++++++++++++++---------------- 1 file changed, 40 insertions(+), 30 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 89115941c7..22266fdedd 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -138,7 +138,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv type(Wave_parameters_CS), optional, pointer :: Waves !< An optional pointer to Stokes drift CS - + ! 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]. @@ -176,7 +176,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) ! 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 [L2 T-1 ~> m2 s-1] - dvSdx, duSdy, & ! idem. for Stokes drift [L2 T-1 ~> m2 s-1] + dvSdx, duSdy, & ! idem. for Stokes drift [L2 T-1 ~> m2 s-1] rel_vort, & ! Relative vorticity at q-points [T-1 ~> s-1]. abs_vort, & ! Absolute vorticity at q-points [T-1 ~> s-1]. stk_vort, & ! Stokes vorticity at q-points [T-1 ~> s-1]. @@ -229,7 +229,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) 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 logical :: Stokes_VF, Passive_Stokes_VF - + ! Diagnostics for fractional thickness-weighted terms real, allocatable, dimension(:,:) :: & hf_gKEu_2d, hf_gKEv_2d, & ! Depth sum of hf_gKEu, hf_gKEv [L T-2 ~> m s-2]. @@ -292,7 +292,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) Area_q(i,j) = (Area_h(i,j) + Area_h(i+1,j+1)) + & (Area_h(i+1,j) + Area_h(i,j+1)) enddo ; enddo - + Stokes_VF = present(Waves) if (Stokes_VF) Stokes_VF = associated(Waves) if (Stokes_VF) Stokes_VF = Waves%Stokes_VF @@ -482,20 +482,24 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 rel_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) enddo; enddo - if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then - do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - stk_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvSdx(I,J) - duSdy(I,J)) * G%IareaBu(I,J) - enddo; enddo - endif + if (Stokes_VF) then + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + stk_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvSdx(I,J) - duSdy(I,J)) * G%IareaBu(I,J) + enddo; enddo + endif + endif else do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 rel_vort(I,J) = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) enddo; enddo - if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then - do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - stk_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvSdx(I,J) - duSdy(I,J)) * G%IareaBu(I,J) - enddo; enddo - endif + if (Stokes_VF) then + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + stk_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvSdx(I,J) - duSdy(I,J)) * G%IareaBu(I,J) + enddo; enddo + endif + endif endif do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 @@ -508,10 +512,12 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) q(I,J) = abs_vort(I,J) * Ih_q(I,J) enddo; enddo - if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then - do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - qS(I,J) = stk_vort(I,J) * Ih_q(I,J) - enddo; enddo + if (Stokes_VF) then + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + qS(I,J) = stk_vort(I,J) * Ih_q(I,J) + enddo; enddo + endif endif if (CS%id_rv > 0) then @@ -736,15 +742,17 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) (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 - if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then - ! Computing the diagnostic Stokes contribution to CAu - do j=js,je ; do I=Isq,Ieq - CAuS(I,j,k) = 0.25 * & - (qS(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + & - qS(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j) - enddo ; enddo + if (Stokes_VF) then + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + ! Computing the diagnostic Stokes contribution to CAu + do j=js,je ; do I=Isq,Ieq + CAuS(I,j,k) = 0.25 * & + (qS(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + & + qS(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j) + enddo ; enddo + endif endif - + if (CS%bound_Coriolis) then do j=js,je ; do I=Isq,Ieq fv1 = abs_vort(I,J) * v(i+1,J,k) @@ -866,7 +874,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) qS(I,J-1) * (uh(I-1,j,k) + uh(I-1,j+1,k))) * G%IdyCv(i,J) enddo; enddo endif - + if (CS%bound_Coriolis) then do J=Jsq,Jeq ; do i=is,ie fu1 = -abs_vort(I,J) * u(I,j+1,k) @@ -943,8 +951,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) if (CS%id_gKEv>0) call post_data(CS%id_gKEv, AD%gradKEv, CS%diag) if (CS%id_rvxu > 0) call post_data(CS%id_rvxu, AD%rv_x_u, CS%diag) if (CS%id_rvxv > 0) call post_data(CS%id_rvxv, AD%rv_x_v, CS%diag) - if (CS%id_CAuS > 0) call post_data(CS%id_CAuS, CAuS, CS%diag) - if (CS%id_CAvS > 0) call post_data(CS%id_CAvS, CAvS, CS%diag) + if (Stokes_VF) then + if (CS%id_CAuS > 0) call post_data(CS%id_CAuS, CAuS, CS%diag) + if (CS%id_CAvS > 0) call post_data(CS%id_CAvS, CAvS, CS%diag) + endif ! Diagnostics for terms multiplied by fractional thicknesses @@ -1358,7 +1368,7 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) CS%id_CAvS = register_diag_field('ocean_model', 'CAvS', diag%axesCvL, Time, & 'Meridional Acceleration from Stokes Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) ! add to AD - + !CS%id_hf_gKEu = register_diag_field('ocean_model', 'hf_gKEu', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Acceleration from Grad. Kinetic Energy', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) From b1c3412480154b019f60fcc1f23695bbbfe5baec Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 15 Oct 2021 12:39:52 -0600 Subject: [PATCH 09/38] enclose stokes vorticity diag computations with Stokes_VF conditional --- src/core/MOM_CoriolisAdv.F90 | 86 ++++++++++++++++++++---------------- 1 file changed, 49 insertions(+), 37 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 89115941c7..2a199aca61 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -138,7 +138,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv type(Wave_parameters_CS), optional, pointer :: Waves !< An optional pointer to Stokes drift CS - + ! 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]. @@ -176,7 +176,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) ! 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 [L2 T-1 ~> m2 s-1] - dvSdx, duSdy, & ! idem. for Stokes drift [L2 T-1 ~> m2 s-1] + dvSdx, duSdy, & ! idem. for Stokes drift [L2 T-1 ~> m2 s-1] rel_vort, & ! Relative vorticity at q-points [T-1 ~> s-1]. abs_vort, & ! Absolute vorticity at q-points [T-1 ~> s-1]. stk_vort, & ! Stokes vorticity at q-points [T-1 ~> s-1]. @@ -229,7 +229,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) 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 logical :: Stokes_VF, Passive_Stokes_VF - + ! Diagnostics for fractional thickness-weighted terms real, allocatable, dimension(:,:) :: & hf_gKEu_2d, hf_gKEv_2d, & ! Depth sum of hf_gKEu, hf_gKEv [L T-2 ~> m s-2]. @@ -292,7 +292,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) Area_q(i,j) = (Area_h(i,j) + Area_h(i+1,j+1)) + & (Area_h(i+1,j) + Area_h(i,j+1)) enddo ; enddo - + Stokes_VF = present(Waves) if (Stokes_VF) Stokes_VF = associated(Waves) if (Stokes_VF) Stokes_VF = Waves%Stokes_VF @@ -482,20 +482,24 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 rel_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) enddo; enddo - if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then - do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - stk_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvSdx(I,J) - duSdy(I,J)) * G%IareaBu(I,J) - enddo; enddo - endif + if (Stokes_VF) then + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + stk_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvSdx(I,J) - duSdy(I,J)) * G%IareaBu(I,J) + enddo; enddo + endif + endif else do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 rel_vort(I,J) = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) enddo; enddo - if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then - do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - stk_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvSdx(I,J) - duSdy(I,J)) * G%IareaBu(I,J) - enddo; enddo - endif + if (Stokes_VF) then + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + stk_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvSdx(I,J) - duSdy(I,J)) * G%IareaBu(I,J) + enddo; enddo + endif + endif endif do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 @@ -508,10 +512,12 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) q(I,J) = abs_vort(I,J) * Ih_q(I,J) enddo; enddo - if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then - do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - qS(I,J) = stk_vort(I,J) * Ih_q(I,J) - enddo; enddo + if (Stokes_VF) then + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + qS(I,J) = stk_vort(I,J) * Ih_q(I,J) + enddo; enddo + endif endif if (CS%id_rv > 0) then @@ -736,15 +742,17 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) (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 - if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then - ! Computing the diagnostic Stokes contribution to CAu - do j=js,je ; do I=Isq,Ieq - CAuS(I,j,k) = 0.25 * & - (qS(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + & - qS(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j) - enddo ; enddo + if (Stokes_VF) then + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + ! Computing the diagnostic Stokes contribution to CAu + do j=js,je ; do I=Isq,Ieq + CAuS(I,j,k) = 0.25 * & + (qS(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + & + qS(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j) + enddo ; enddo + endif endif - + if (CS%bound_Coriolis) then do j=js,je ; do I=Isq,Ieq fv1 = abs_vort(I,J) * v(i+1,J,k) @@ -858,15 +866,17 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) (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%id_CAuS>0 .or. CS%id_CAvS>0) then - ! Computing the diagnostic Stokes contribution to CAv - do J=Jsq,Jeq ; do i=is,ie - CAvS(I,j,k) = 0.25 * & - (qS(I,J) * (uh(I,j+1,k) + uh(I,j,k)) + & - qS(I,J-1) * (uh(I-1,j,k) + uh(I-1,j+1,k))) * G%IdyCv(i,J) - enddo; enddo + if (Stokes_VF) then + if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then + ! Computing the diagnostic Stokes contribution to CAv + do J=Jsq,Jeq ; do i=is,ie + CAvS(I,j,k) = 0.25 * & + (qS(I,J) * (uh(I,j+1,k) + uh(I,j,k)) + & + qS(I,J-1) * (uh(I-1,j,k) + uh(I-1,j+1,k))) * G%IdyCv(i,J) + enddo; enddo + endif endif - + if (CS%bound_Coriolis) then do J=Jsq,Jeq ; do i=is,ie fu1 = -abs_vort(I,J) * u(I,j+1,k) @@ -943,8 +953,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) if (CS%id_gKEv>0) call post_data(CS%id_gKEv, AD%gradKEv, CS%diag) if (CS%id_rvxu > 0) call post_data(CS%id_rvxu, AD%rv_x_u, CS%diag) if (CS%id_rvxv > 0) call post_data(CS%id_rvxv, AD%rv_x_v, CS%diag) - if (CS%id_CAuS > 0) call post_data(CS%id_CAuS, CAuS, CS%diag) - if (CS%id_CAvS > 0) call post_data(CS%id_CAvS, CAvS, CS%diag) + if (Stokes_VF) then + if (CS%id_CAuS > 0) call post_data(CS%id_CAuS, CAuS, CS%diag) + if (CS%id_CAvS > 0) call post_data(CS%id_CAvS, CAvS, CS%diag) + endif ! Diagnostics for terms multiplied by fractional thicknesses @@ -1358,7 +1370,7 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) CS%id_CAvS = register_diag_field('ocean_model', 'CAvS', diag%axesCvL, Time, & 'Meridional Acceleration from Stokes Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) ! add to AD - + !CS%id_hf_gKEu = register_diag_field('ocean_model', 'hf_gKEu', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Acceleration from Grad. Kinetic Energy', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) From a0d1d9982afc86f77c4dae80820d7cc9ebd04ed3 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 15 Oct 2021 17:47:49 -0600 Subject: [PATCH 10/38] Do not call get_Langmuir_Number if lamult is already provided via ww3 --- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index a26f251a2b..73ebce6e54 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -1127,7 +1127,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl enddo ! k-loop finishes - if (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) then + if ( (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) .and. .not. present(lamult)) then MLD_GUESS = max( 1.*US%m_to_Z, abs(US%m_to_Z*CS%OBLdepthprev(i,j) ) ) call get_Langmuir_Number(LA, G, GV, US, MLD_guess, uStar(i,j), i, j, & H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) From eacd9d016fc28030bddad46251d22c12eb73d5a1 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 15 Oct 2021 17:48:25 -0600 Subject: [PATCH 11/38] fix doxygen errors in surfbands_refactor branch --- config_src/drivers/nuopc_cap/mom_cap.F90 | 2 +- src/core/MOM_dynamics_split_RK2.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 938f6bdfda..5384ef0778 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -2215,7 +2215,7 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname, ungridd fldlist(num)%shortname = trim(stdname) endif fldlist(num)%transferOffer = trim(transferOffer) - if (present(ungridded_lbound) .and. present(ungridded_ubound)) then + if (present(ungridded_lbound) .and. present(ungridded_ubound)) then fldlist(num)%ungridded_lbound = ungridded_lbound fldlist(num)%ungridded_ubound = ungridded_ubound end if diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index cd29fb7206..fbcfbe57c7 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1373,7 +1373,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ALLOC_(CS%v_accel_bt(isd:ied,JsdB:JedB,nz)) ; CS%v_accel_bt(:,:,:) = 0.0 ALLOC_(CS%PFu_Stokes(IsdB:IedB,jsd:jed,nz)) ; CS%PFu_Stokes(:,:,:) = 0.0 ALLOC_(CS%PFv_Stokes(isd:ied,JsdB:JedB,nz)) ; CS%PFv_Stokes(:,:,:) = 0.0 - + MIS%diffu => CS%diffu MIS%diffv => CS%diffv MIS%PFu => CS%PFu From 15c3d53de8d9fea9b7ad474ae9f10ec6a155402f Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 28 Oct 2021 17:37:02 -0600 Subject: [PATCH 12/38] changes in the nuopc cap to support arbitrary stokes bands With these changes, arbitrary number of of partitioned stokes drift components may be imported from ww3 when coupled within cesm. After the planned unification of ww3 nuopc caps of CESM and EMC, the old (fixed) approach may be removed. --- config_src/drivers/nuopc_cap/mom_cap.F90 | 36 +++-- .../drivers/nuopc_cap/mom_cap_methods.F90 | 124 +++++++++++------- src/user/MOM_wave_interface.F90 | 4 +- 3 files changed, 106 insertions(+), 58 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 5384ef0778..db9cb046d6 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -709,11 +709,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call query_ocean_state(ocean_state, use_waves=use_waves, wave_method=wave_method) if (use_waves) then - call query_ocean_state(ocean_state, NumWaveBands=Ice_ocean_boundary%num_stk_bands) if (wave_method == "EFACTOR") then allocate( Ice_ocean_boundary%lamult(isc:iec,jsc:jec) ) Ice_ocean_boundary%lamult = 0.0 - else + else if (wave_method == "SURFACE_BANDS") then + call query_ocean_state(ocean_state, NumWaveBands=Ice_ocean_boundary%num_stk_bands) allocate ( Ice_ocean_boundary% ustk0 (isc:iec,jsc:jec), & Ice_ocean_boundary% vstk0 (isc:iec,jsc:jec), & Ice_ocean_boundary% ustkb (isc:iec,jsc:jec,Ice_ocean_boundary%num_stk_bands), & @@ -724,6 +724,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call query_ocean_state(ocean_state, WaveNumbers=Ice_ocean_boundary%stk_wavenumbers, unscale=.true.) Ice_ocean_boundary%ustkb = 0.0 Ice_ocean_boundary%vstkb = 0.0 + else + call MOM_error(FATAL, "Unsupported WAVE_METHOD encountered in NUOPC cap.") endif endif ! Consider adding this: @@ -765,16 +767,26 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (use_waves) then if (wave_method == "EFACTOR") then call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") - else - if (Ice_ocean_boundary%num_stk_bands > 3) then - call MOM_error(FATAL, "Number of Stokes Bands > 3, NUOPC cap not set up for this") + else if (wave_method == "SURFACE_BANDS") then + if (cesm_coupled) then + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_pstokes_x", "will provide", & + ungridded_lbound=1, ungridded_ubound=Ice_ocean_boundary%num_stk_bands) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_pstokes_y", "will provide", & + ungridded_lbound=1, ungridded_ubound=Ice_ocean_boundary%num_stk_bands) + else ! below is the old approach of importing partitioned stokes drift components. after the planned ww3 nuopc + ! cap unification, this else block should be removed in favor of the more flexible import approach above. + if (Ice_ocean_boundary%num_stk_bands > 3) then + call MOM_error(FATAL, "Number of Stokes Bands > 3, NUOPC cap not set up for this") + endif + call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_1" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_1", "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_2" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_2", "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_3" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_3", "will provide") endif - call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_1" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_1", "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_2" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_2", "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_3" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_3", "will provide") + else + call MOM_error(FATAL, "Unsupported WAVE_METHOD encountered in NUOPC cap.") endif endif @@ -1648,7 +1660,7 @@ subroutine ModelAdvance(gcomp, rc) ! Import data !--------------- - call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) + call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, cesm_coupled, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------- diff --git a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 b/config_src/drivers/nuopc_cap/mom_cap_methods.F90 index f0f0c1ee46..b8f41eca7c 100644 --- a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap_methods.F90 @@ -72,21 +72,25 @@ end subroutine mom_set_geomtype !> This function has a few purposes: !! (1) it imports surface fluxes using data from the mediator; and !! (2) it can apply restoring in SST and SSS. -subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc) +subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, cesm_coupled, rc) type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing + logical , intent(in) :: cesm_coupled !< Flag to check if coupled with cesm integer , intent(inout) :: rc !< Return code ! Local Variables - integer :: i, j, ig, jg, n + integer :: i, j, ib, ig, jg, n integer :: isc, iec, jsc, jec + integer :: nsc ! number of stokes drift components character(len=128) :: fldname real(ESMF_KIND_R8), allocatable :: taux(:,:) real(ESMF_KIND_R8), allocatable :: tauy(:,:) real(ESMF_KIND_R8), allocatable :: stkx1(:,:),stkx2(:,:),stkx3(:,:) real(ESMF_KIND_R8), allocatable :: stky1(:,:),stky2(:,:),stky3(:,:) + real(ESMF_KIND_R8), allocatable :: stkx(:,:,:) + real(ESMF_KIND_R8), allocatable :: stky(:,:,:) character(len=*) , parameter :: subname = '(mom_import)' rc = ESMF_SUCCESS @@ -289,49 +293,81 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! Partitioned Stokes Drift Components !---- if ( associated(ice_ocean_boundary%ustkb) ) then - allocate(stkx1(isc:iec,jsc:jec)) - allocate(stky1(isc:iec,jsc:jec)) - allocate(stkx2(isc:iec,jsc:jec)) - allocate(stky2(isc:iec,jsc:jec)) - allocate(stkx3(isc:iec,jsc:jec)) - allocate(stky3(isc:iec,jsc:jec)) - - call state_getimport(importState,'eastward_partitioned_stokes_drift_1' , isc, iec, jsc, jec, stkx1,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState,'northward_partitioned_stokes_drift_1', isc, iec, jsc, jec, stky1,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState,'eastward_partitioned_stokes_drift_2' , isc, iec, jsc, jec, stkx2,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState,'northward_partitioned_stokes_drift_2', isc, iec, jsc, jec, stky2,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState,'eastward_partitioned_stokes_drift_3' , isc, iec, jsc, jec, stkx3,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState,'northward_partitioned_stokes_drift_3', isc, iec, jsc, jec, stky3,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! rotate from true zonal/meridional to local coordinates - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ice_ocean_boundary%ustkb(i,j,1) = ocean_grid%cos_rot(ig,jg)*stkx1(i,j) & - - ocean_grid%sin_rot(ig,jg)*stky1(i,j) - ice_ocean_boundary%vstkb(i,j,1) = ocean_grid%cos_rot(ig,jg)*stky1(i,j) & - + ocean_grid%sin_rot(ig,jg)*stkx1(i,j) - - ice_ocean_boundary%ustkb(i,j,2) = ocean_grid%cos_rot(ig,jg)*stkx2(i,j) & - - ocean_grid%sin_rot(ig,jg)*stky2(i,j) - ice_ocean_boundary%vstkb(i,j,2) = ocean_grid%cos_rot(ig,jg)*stky2(i,j) & - + ocean_grid%sin_rot(ig,jg)*stkx2(i,j) - - ice_ocean_boundary%ustkb(i,j,3) = ocean_grid%cos_rot(ig,jg)*stkx3(i,j) & - - ocean_grid%sin_rot(ig,jg)*stky3(i,j) - ice_ocean_boundary%vstkb(i,j,3) = ocean_grid%cos_rot(ig,jg)*stky3(i,j) & - + ocean_grid%sin_rot(ig,jg)*stkx3(i,j) - enddo - enddo - deallocate(stkx1,stkx2,stkx3,stky1,stky2,stky3) + if (cesm_coupled) then + nsc = Ice_ocean_boundary%num_stk_bands + allocate(stkx(isc:iec,jsc:jec,1:nsc)) + allocate(stky(isc:iec,jsc:jec,1:nsc)) + + call state_getimport(importState,'Sw_pstokes_x', isc, iec, jsc, jec, 1, nsc, stkx, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState,'Sw_pstokes_y', isc, iec, jsc, jec, 1, nsc, stky, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! rotate from true zonal/meridional to local coordinates + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + !rotate + do ib = 1, nsc + ice_ocean_boundary%ustkb(i,j,ib) = ocean_grid%cos_rot(ig,jg)*stkx(i,j,ib) & + - ocean_grid%sin_rot(ig,jg)*stky(i,j,ib) + ice_ocean_boundary%vstkb(i,j,ib) = ocean_grid%cos_rot(ig,jg)*stky(i,j,ib) & + + ocean_grid%sin_rot(ig,jg)*stkx(i,j,ib) + enddo + ! apply masks + ice_ocean_boundary%ustkb(i,j,:) = ice_ocean_boundary%ustkb(i,j,:) * ocean_grid%mask2dT(ig,jg) + ice_ocean_boundary%vstkb(i,j,:) = ice_ocean_boundary%vstkb(i,j,:) * ocean_grid%mask2dT(ig,jg) + enddo + enddo + deallocate(stkx,stky) + + else ! below is the old approach of importing partitioned stokes drift components. after the planned ww3 nuopc + ! cap unification, this else block should be removed in favor of the more flexible import approach above. + allocate(stkx1(isc:iec,jsc:jec)) + allocate(stky1(isc:iec,jsc:jec)) + allocate(stkx2(isc:iec,jsc:jec)) + allocate(stky2(isc:iec,jsc:jec)) + allocate(stkx3(isc:iec,jsc:jec)) + allocate(stky3(isc:iec,jsc:jec)) + + call state_getimport(importState,'eastward_partitioned_stokes_drift_1' , isc, iec, jsc, jec, stkx1,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState,'northward_partitioned_stokes_drift_1', isc, iec, jsc, jec, stky1,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState,'eastward_partitioned_stokes_drift_2' , isc, iec, jsc, jec, stkx2,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState,'northward_partitioned_stokes_drift_2', isc, iec, jsc, jec, stky2,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState,'eastward_partitioned_stokes_drift_3' , isc, iec, jsc, jec, stkx3,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState,'northward_partitioned_stokes_drift_3', isc, iec, jsc, jec, stky3,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! rotate from true zonal/meridional to local coordinates + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ice_ocean_boundary%ustkb(i,j,1) = ocean_grid%cos_rot(ig,jg)*stkx1(i,j) & + - ocean_grid%sin_rot(ig,jg)*stky1(i,j) + ice_ocean_boundary%vstkb(i,j,1) = ocean_grid%cos_rot(ig,jg)*stky1(i,j) & + + ocean_grid%sin_rot(ig,jg)*stkx1(i,j) + + ice_ocean_boundary%ustkb(i,j,2) = ocean_grid%cos_rot(ig,jg)*stkx2(i,j) & + - ocean_grid%sin_rot(ig,jg)*stky2(i,j) + ice_ocean_boundary%vstkb(i,j,2) = ocean_grid%cos_rot(ig,jg)*stky2(i,j) & + + ocean_grid%sin_rot(ig,jg)*stkx2(i,j) + + ice_ocean_boundary%ustkb(i,j,3) = ocean_grid%cos_rot(ig,jg)*stkx3(i,j) & + - ocean_grid%sin_rot(ig,jg)*stky3(i,j) + ice_ocean_boundary%vstkb(i,j,3) = ocean_grid%cos_rot(ig,jg)*stky3(i,j) & + + ocean_grid%sin_rot(ig,jg)*stkx3(i,j) + enddo + enddo + deallocate(stkx1,stkx2,stkx3,stky1,stky2,stky3) + endif endif end subroutine mom_import diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 9035415e82..900e062474 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -606,6 +606,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) integer :: ii, jj, kk, b, iim1, jjm1 real :: idt ! 1 divided by the time step + if (CS%WaveMethod==EFACTOR) return + one_cm = 0.01*US%m_to_Z min_level_thick_avg = 1.e-3*US%m_to_Z idt = 1.0/dt @@ -824,8 +826,6 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) enddo CS%DHH85_is_set = .true. endif - elseif (CS%WaveMethod==EFACTOR) then - return ! pass else! Keep this else, fallback to 0 Stokes drift do kk= 1,GV%ke do jj = G%jsd,G%jed From e7f628e17c93c6733a11a77a8718625c0e12cba3 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 7 Dec 2021 14:12:15 -0700 Subject: [PATCH 13/38] refactoring and changes to write stokes drift profile to restart file when surfbands wave coupling mode is on. --- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 4 +- src/core/MOM.F90 | 9 ++- src/user/MOM_wave_interface.F90 | 67 ++++++++++++++++--- 3 files changed, 66 insertions(+), 14 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 39e1046c1c..be60b37998 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -279,7 +279,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & input_restart_file=input_restart_file, & - diag_ptr=OS%diag, count_calls=.true.) + diag_ptr=OS%diag, count_calls=.true., waves_CSp=OS%Waves) call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, & C_p_scaled=OS%fluxes%C_p, use_temp=use_temperature) @@ -401,7 +401,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i endif ! MOM_wave_interface_init is called regardless of the value of USE_WAVES because ! it also initializes statistical waves. - call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag) + call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag, OS%restart_CSp) if (associated(OS%grid%Domain%maskmap)) then call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ba0b8fbc40..8415737881 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -133,7 +133,7 @@ module MOM use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd use MOM_verticalGrid, only : fix_restart_scaling use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units -use MOM_wave_interface, only : wave_parameters_CS, waves_end +use MOM_wave_interface, only : wave_parameters_CS, waves_end, waves_register_restarts use MOM_wave_interface, only : Update_Stokes_Drift ! ODA modules @@ -1634,7 +1634,7 @@ end subroutine step_offline !! initializing the ocean state variables, and initializing subsidiary modules subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & Time_in, offline_tracer_mode, input_restart_file, diag_ptr, & - count_calls, tracer_flow_CSp, ice_shelf_CSp) + count_calls, tracer_flow_CSp, ice_shelf_CSp, waves_CSp) type(time_type), target, intent(inout) :: Time !< model time, set in this routine type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar type(param_file_type), intent(out) :: param_file !< structure indicating parameter file to parse @@ -1656,6 +1656,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & !! calls to step_MOM instead of the number of !! dynamics timesteps. type(ice_shelf_CS), optional, pointer :: ice_shelf_CSp !< A pointer to an ice shelf control structure + type(Wave_parameters_CS), & + optional, pointer :: Waves_CSp !< An optional pointer to a wave property CS ! local variables type(ocean_grid_type), pointer :: G => NULL() ! A pointer to the metric grid use for the run type(ocean_grid_type), pointer :: G_in => NULL() ! Pointer to the input grid @@ -2348,6 +2350,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (associated(CS%OBC)) & call open_boundary_register_restarts(dg%HI, GV, CS%OBC, CS%tracer_Reg, & param_file, restart_CSp, use_temperature) + if (present(waves_CSp)) then + call waves_register_restarts(waves_CSp, dG%HI, GV, param_file, restart_CSp) + endif call callTree_waypoint("restart registration complete (initialize_MOM)") diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 900e062474..aa40f7853f 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -12,12 +12,15 @@ module MOM_wave_interface use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_forcing_type, only : mech_forcing use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type use MOM_io, only : file_exists, get_var_sizes, read_variable +use MOM_io, only : vardesc, var_desc use MOM_safe_alloc, only : safe_alloc_ptr use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, surface use MOM_verticalgrid, only : verticalGrid_type +use MOM_restart, only : register_restart_field, MOM_restart_CS, query_initialized implicit none ; private @@ -42,6 +45,7 @@ module MOM_wave_interface ! CL2 effects. public Waves_end ! public interface to deallocate and free wave related memory. public get_wave_method ! public interface to obtain the wave method string +public waves_register_restarts ! public interface to register wave restart fields ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -210,7 +214,7 @@ module MOM_wave_interface contains !> Initializes parameters related to MOM_wave_interface -subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) +subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restart_CSp) type(time_type), target, intent(in) :: Time !< Model time type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -218,6 +222,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) type(param_file_type), intent(in) :: param_file !< Input parameter structure type(wave_parameters_CS), pointer :: CS !< Wave parameter control structure type(diag_ctrl), target, intent(inout) :: diag !< Diagnostic Pointer + type(MOM_restart_CS), optional, pointer:: restart_CSp!< Restart control structure ! Local variables character(len=40) :: mdl = "MOM_wave_interface" !< This module's name. @@ -231,8 +236,8 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) logical :: StatisticalWaves ! Dummy Check - if (associated(CS)) then - call MOM_error(FATAL, "wave_interface_init called with an associated control structure.") + if (.not. associated(CS)) then + call MOM_error(FATAL, "wave_interface_init called without an associated control structure.") return endif @@ -245,9 +250,6 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) if (.not.(use_waves .or. StatisticalWaves)) return - ! Allocate CS and set pointers - allocate(CS) - CS%UseWaves = use_waves CS%diag => diag CS%Time => Time @@ -441,10 +443,6 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) ! Allocate and initialize ! a. Stokes driftProfiles - allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,GV%ke)) - CS%Us_x(:,:,:) = 0.0 - allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,GV%ke)) - CS%Us_y(:,:,:) = 0.0 if (CS%Stokes_DDT) then allocate(CS%ddt_Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke)) CS%ddt_Us_x(:,:,:) = 0.0 @@ -612,6 +610,10 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) min_level_thick_avg = 1.e-3*US%m_to_Z idt = 1.0/dt + if (allocated(CS%US_x) .and. allocated(CS%US_y)) then + call pass_vector(CS%US_x(:,:,:),CS%US_y(:,:,:), G%Domain) + endif + ! Getting Stokes drift profile from previous step CS%ddt_us_x(:,:,:) = CS%US_x(:,:,:) CS%ddt_us_y(:,:,:) = CS%US_y(:,:,:) @@ -1757,6 +1759,51 @@ subroutine Waves_end(CS) end subroutine Waves_end +!> Register wave restart fields. To be called before MOM_wave_interface_init +subroutine waves_register_restarts(CS, HI, GV, param_file, restart_CSp) + type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure + type(hor_index_type), intent(inout) :: HI !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(param_file_type), intent(in) :: param_file !< Input parameter structure + type(MOM_restart_CS), pointer :: restart_CSp !< Restart structure, data intent(inout) + ! Local variables + type(vardesc) :: vd(2) + logical :: use_waves + logical :: StatisticalWaves + character*(13) :: wave_method_str + character(len=40) :: mdl = "MOM_wave_interface" !< This module's name. + + if (associated(CS)) then + call MOM_error(FATAL, "waves_register_restarts: Called with initialized waves control structure") + endif + allocate(CS) + + call get_param(param_file, mdl, "USE_WAVES", use_waves, & + "If true, enables surface wave modules.", do_not_log=.true., default=.false.) + + ! Check if using LA_LI2016 + call get_param(param_file,mdl,"USE_LA_LI2016",StatisticalWaves, & + do_not_log=.true.,default=.false.) + + if (.not.(use_waves .or. StatisticalWaves)) return + + ! Allocate wave fields needed for restart file + allocate(CS%Us_x(HI%isdB:HI%IedB,HI%jsd:HI%jed,GV%ke)) + CS%Us_x(:,:,:) = 0.0 + allocate(CS%Us_y(HI%isd:HI%Ied,HI%jsdB:HI%jedB,GV%ke)) + CS%Us_y(:,:,:) = 0.0 + + call get_param(param_file,mdl,"WAVE_METHOD",wave_method_str, do_not_log=.true., default=NULL_STRING) + + if (trim(wave_method_str)== trim(SURFBANDS_STRING)) then + vd(1) = var_desc("US_x", "m s-1", "3d zonal Stokes drift profile") + vd(2) = var_desc("US_y", "m s-1", "3d meridional Stokes drift profile") + call register_restart_field(CS%US_x(:,:,:), vd(1), .true., restart_CSp) + call register_restart_field(CS%US_y(:,:,:), vd(2), .false., restart_CSp) + endif + +end subroutine waves_register_restarts + !> \namespace mom_wave_interface !! !! \author Brandon Reichl, 2018. From c880a156a87dca8cc1b721ebeb748b2a157dc6a4 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 7 Dec 2021 16:21:48 -0700 Subject: [PATCH 14/38] For the drivers calling MOM_wave_interface_init, add the optional waves_csp arg to initialize_MOM calls so as to ensure that the waves_csp is allocated. This commit also has several misc doxygen fixes. --- config_src/drivers/FMS_cap/ocean_model_MOM.F90 | 2 +- config_src/drivers/mct_cap/mom_ocean_model_mct.F90 | 2 +- config_src/drivers/nuopc_cap/mom_cap_methods.F90 | 2 +- config_src/drivers/solo_driver/MOM_driver.F90 | 5 +++-- src/user/MOM_wave_interface.F90 | 4 ++-- 5 files changed, 8 insertions(+), 7 deletions(-) diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index c3e13329f2..f790c041b8 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -276,7 +276,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas OS%Time = Time_in ; OS%Time_dyn = Time_in call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & - diag_ptr=OS%diag, count_calls=.true.) + diag_ptr=OS%diag, count_calls=.true., waves_CSp=OS%Waves) call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, & C_p_scaled=OS%fluxes%C_p, use_temp=use_temperature) diff --git a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 index 9b40a9e7b4..cedf2703ee 100644 --- a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 +++ b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 @@ -274,7 +274,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & input_restart_file=input_restart_file, & - diag_ptr=OS%diag, count_calls=.true.) + diag_ptr=OS%diag, count_calls=.true., waves_CSp=OS%Waves) call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, & C_p_scaled=OS%fluxes%C_p, use_temp=use_temperature) diff --git a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 b/config_src/drivers/nuopc_cap/mom_cap_methods.F90 index b8f41eca7c..fc80900758 100644 --- a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap_methods.F90 @@ -303,7 +303,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport(importState,'Sw_pstokes_y', isc, iec, jsc, jec, 1, nsc, stky, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - + ! rotate from true zonal/meridional to local coordinates do j = jsc, jec jg = j + ocean_grid%jsc - jsc diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index ebb953be93..44a2313568 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -301,11 +301,12 @@ program MOM_main if (sum(date) >= 0) then call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, & segment_start_time, offline_tracer_mode=offline_tracer_mode, & - diag_ptr=diag, tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp) + diag_ptr=diag, tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp, & + waves_CSp=Waves_CSp) else call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, & offline_tracer_mode=offline_tracer_mode, diag_ptr=diag, & - tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp) + tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp, waves_CSp=Waves_CSp) endif call get_MOM_state_elements(MOM_CSp, G=grid, GV=GV, US=US, C_p_scaled=fluxes%C_p) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index aa40f7853f..86a1d011f2 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -83,7 +83,6 @@ module MOM_wave_interface real, allocatable, dimension(:,:,:), public :: & KvS !< Viscosity for Stokes Drift shear [Z2 T-1 ~> m2 s-1] - integer, public :: id_PFu_Stokes = -1 , id_PFv_Stokes = -1 ! The remainder of this control structure is private integer :: WaveMethod = -99 !< Options for including wave information !! Valid (tested) choices are: @@ -187,6 +186,7 @@ module MOM_wave_interface !! timing of diagnostic output. !>@{ Diagnostic handles + integer, public :: id_PFu_Stokes = -1 , id_PFv_Stokes = -1 integer :: id_surfacestokes_x = -1 , id_surfacestokes_y = -1 integer :: id_3dstokes_x = -1 , id_3dstokes_y = -1 integer :: id_ddt_3dstokes_x = -1 , id_ddt_3dstokes_y = -1 @@ -1775,7 +1775,7 @@ subroutine waves_register_restarts(CS, HI, GV, param_file, restart_CSp) if (associated(CS)) then call MOM_error(FATAL, "waves_register_restarts: Called with initialized waves control structure") - endif + endif allocate(CS) call get_param(param_file, mdl, "USE_WAVES", use_waves, & From e2ab77e995adf00daa67047ad787912d758d6935 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 8 Dec 2021 11:27:53 -0700 Subject: [PATCH 15/38] initialize wave option flags to false --- src/user/MOM_wave_interface.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 86a1d011f2..ac2180df88 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -56,13 +56,13 @@ module MOM_wave_interface type, public :: wave_parameters_CS ; private ! Main surface wave options and publicly visible variables - logical, public :: UseWaves = .false. !< Flag to enable surface gravity wave feature - logical, public :: Stokes_VF !< Developmental: - !! True if Stokes vortex force is used - logical, public :: Stokes_PGF !< Developmental: - !! True if Stokes shear pressure Gradient force is used - logical, public :: Passive_Stokes_PGF !< Keeps Stokes_PGF on, but doesn't affect dynamics - logical, public :: Stokes_DDT !< Developmental: + logical, public :: UseWaves = .false. !< Flag to enable surface gravity wave feature + logical, public :: Stokes_VF = .false. !< Developmental: + !! True if Stokes vortex force is used + logical, public :: Stokes_PGF = .false. !< Developmental: + !! True if Stokes shear pressure Gradient force is used + logical, public :: Passive_Stokes_PGF = .false. !< Keeps Stokes_PGF on, but doesn't affect dynamics + logical, public :: Stokes_DDT = .false. !< Developmental: !! True if Stokes d/dt is used real, allocatable, dimension(:,:,:), public :: & Us_x !< 3d zonal Stokes drift profile [L T-1 ~> m s-1] From d4c36a60a6723a8ed7adf28c8d8a8b58801adc2d Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 8 Dec 2021 15:48:51 -0700 Subject: [PATCH 16/38] Fix openmp test by adding Stokes_VT to shr clause in MOM_CoriolisAdv. Also remove the Passive_Stokes_VF block since it's never set to true. --- src/core/MOM_CoriolisAdv.F90 | 30 ++++++++++++------------------ 1 file changed, 12 insertions(+), 18 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 2a199aca61..931cffa4ec 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -228,7 +228,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) 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 - logical :: Stokes_VF, Passive_Stokes_VF + logical :: Stokes_VF ! Diagnostics for fractional thickness-weighted terms real, allocatable, dimension(:,:) :: & @@ -293,12 +293,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) (Area_h(i+1,j) + Area_h(i,j+1)) enddo ; enddo - Stokes_VF = present(Waves) - if (Stokes_VF) Stokes_VF = associated(Waves) - if (Stokes_VF) Stokes_VF = Waves%Stokes_VF + Stokes_VF = .false. + if (present(Waves)) then ; if (associated(Waves)) then + Stokes_VF = Waves%Stokes_VF + endif ; endif !$OMP parallel do default(private) shared(u,v,h,uh,vh,CAu,CAv,G,GV,CS,AD,Area_h,Area_q,& - !$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,vol_neglect,h_tiny,OBC,eps_vel) + !$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,vol_neglect,h_tiny,OBC,eps_vel,Stokes_VF) do k=1,nz ! Here the second order accurate layer potential vorticities, q, @@ -315,19 +316,12 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) (-Waves%us_x(I,j,k))*G%dxCu(I,j)) enddo; enddo endif - if (Passive_Stokes_VF) then - 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)) - enddo; enddo - else - do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - dvdx(I,J) = ((v(i+1,J,k)-Waves%us_y(i+1,J,k))*G%dyCv(i+1,J) - & - (v(i,J,k)-Waves%us_y(i,J,k))*G%dyCv(i,J)) - dudy(I,J) = ((u(I,j+1,k)-Waves%us_x(I,j+1,k))*G%dxCu(I,j+1) - & - (u(I,j,k)-Waves%us_x(I,j,k))*G%dxCu(I,j)) - enddo; enddo - endif + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + dvdx(I,J) = ((v(i+1,J,k)-Waves%us_y(i+1,J,k))*G%dyCv(i+1,J) - & + (v(i,J,k)-Waves%us_y(i,J,k))*G%dyCv(i,J)) + dudy(I,J) = ((u(I,j+1,k)-Waves%us_x(I,j+1,k))*G%dxCu(I,j+1) - & + (u(I,j,k)-Waves%us_x(I,j,k))*G%dxCu(I,j)) + enddo; enddo else 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)) From b619d38eb10af1e75eecc3d056e495be0a91a950 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 14 Dec 2021 09:06:03 -0700 Subject: [PATCH 17/38] remove duplicate assignments of dvdx and dudy. These duplicate assignments incorrectly override dvdx and dudy when surfbands wave coupling is on. --- src/core/MOM_CoriolisAdv.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 931cffa4ec..16faaf3b2a 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -328,10 +328,6 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) dudy(I,J) = (u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j)) enddo; enddo endif - 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)) - 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)) enddo ; enddo From dc93bdeef20573f4432c67b5533f0081ae2a28dd Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Thu, 23 Dec 2021 09:22:01 -0500 Subject: [PATCH 18/38] Fixes for Stokes time tendency terms - Adding logical to prevent using terms if not allocated - Adding optional diagnostic only output of term - Moving time increment to within dynamics step instead of in main step MOOM loop. - Correcting time tendency term to reflect time between Stokes drift updates and extent of dynamics time loop. --- src/core/MOM.F90 | 23 ++++++----- src/user/MOM_wave_interface.F90 | 71 ++++++++++++++++++++------------- 2 files changed, 56 insertions(+), 38 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index cc6790f466..e36e3f71d9 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -661,20 +661,12 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS if (CS%UseWaves) then ! Update wave information, which is presently kept static over each call to step_mom call enable_averages(time_interval, Time_start + real_to_time(US%T_to_s*time_interval), CS%diag) - call Update_Stokes_Drift(G, GV, US, Waves, h, forces%ustar, dt) - if (Waves%Stokes_DDT) then - u(:,:,:) = u(:,:,:) + Waves%ddt_us_x(:,:,:)*dt - v(:,:,:) = v(:,:,:) + Waves%ddt_us_y(:,:,:)*dt - endif + call Update_Stokes_Drift(G, GV, US, Waves, h, forces%ustar, time_interval) call disable_averaging(CS%diag) endif else ! not do_dyn. if (CS%UseWaves) then ! Diagnostics are not enabled in this call. - call Update_Stokes_Drift(G, GV, US, Waves, h, fluxes%ustar, dt) - !if (Waves%Stokes_DDT) then - ! u(:,:,:) = u(:,:,:) + Waves%ddt_us_x(:,:,:)*dt - ! v(:,:,:) = v(:,:,:) + Waves%ddt_us_y(:,:,:)*dt - !endif + call Update_Stokes_Drift(G, GV, US, Waves, h, fluxes%ustar, time_interval) endif endif @@ -1106,6 +1098,17 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif ! -------------------------------------------------- end SPLIT + ! Update the model's current to reflect wind-wave growth + if (Waves%Stokes_DDT .and. (.not.Waves%Passive_Stokes_DDT)) then + do J=jsq,jeq ; do i=is,ie + v(i,J,:) = v(i,J,:) + Waves%ddt_us_y(i,J,:)*dt + enddo; enddo + do j=js,je ; do I=isq,ieq + u(I,j,:) = u(I,j,:) + Waves%ddt_us_x(I,j,:)*dt + enddo; enddo + call pass_vector(u,v,G%Domain) + endif + if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then call cpu_clock_begin(id_clock_thick_diff) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index d5850f79d0..f89d26451d 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -63,7 +63,9 @@ module MOM_wave_interface !! True if Stokes shear pressure Gradient force is used logical, public :: Passive_Stokes_PGF = .false. !< Keeps Stokes_PGF on, but doesn't affect dynamics logical, public :: Stokes_DDT = .false. !< Developmental: - !! True if Stokes d/dt is used + !! True if Stokes d/dt is used + logical, public :: Passive_Stokes_DDT = .false. !< Keeps Stokes_DDT on, but doesn't affect dynamics + real, allocatable, dimension(:,:,:), public :: & Us_x !< 3d zonal Stokes drift profile [L T-1 ~> m s-1] !! Horizontal -> U points @@ -310,6 +312,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar call get_param(param_file, mdl, "STOKES_DDT", CS%Stokes_DDT, & "Flag to use Stokes d/dt", units="", & Default=.false.) + call get_param(param_file, mdl, "PASSIVE_STOKES_DDT", CS%Passive_Stokes_DDT, & + "Flag to make Stokes d/dt diagnostic only", units="", & + Default=.false.) ! Get Wave Method and write to integer WaveMethod call get_param(param_file,mdl,"WAVE_METHOD",TMPSTRING1, & @@ -461,10 +466,12 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar CS%diag%axesCvL,Time,'3d Stokes drift (y)', 'm s-1', conversion=US%L_T_to_m_s) CS%id_3dstokes_x = register_diag_field('ocean_model','3d_stokes_x', & CS%diag%axesCuL,Time,'3d Stokes drift (x)', 'm s-1', conversion=US%L_T_to_m_s) - CS%id_ddt_3dstokes_y = register_diag_field('ocean_model','dvdt_Stokes', & - CS%diag%axesCvL,Time,'d/dt Stokes drift (meridional)','m s-2') - CS%id_ddt_3dstokes_x = register_diag_field('ocean_model','dudt_Stokes', & - CS%diag%axesCuL,Time,'d/dt Stokes drift (zonal)','m s-2') + if (CS%Stokes_DDT) then + CS%id_ddt_3dstokes_y = register_diag_field('ocean_model','dvdt_Stokes', & + CS%diag%axesCvL,Time,'d/dt Stokes drift (meridional)','m s-2') + CS%id_ddt_3dstokes_x = register_diag_field('ocean_model','dudt_Stokes', & + CS%diag%axesCuL,Time,'d/dt Stokes drift (zonal)','m s-2') + endif CS%id_PFv_Stokes = register_diag_field('ocean_model','PFv_Stokes', & CS%diag%axesCvL,Time,'PF from Stokes drift (meridional)','m s-2')!Needs conversion CS%id_PFu_Stokes = register_diag_field('ocean_model','PFu_Stokes', & @@ -602,16 +609,16 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) endif ! Getting Stokes drift profile from previous step - CS%ddt_us_x(:,:,:) = CS%US_x(:,:,:) - CS%ddt_us_y(:,:,:) = CS%US_y(:,:,:) + if (CS%Stokes_DDT) CS%ddt_us_x(:,:,:) = CS%US_x(:,:,:) + if (CS%Stokes_DDT) CS%ddt_us_y(:,:,:) = CS%US_y(:,:,:) ! 1. If Test Profile Option is chosen ! Computing mid-point value from surface value and decay wavelength if (CS%WaveMethod==TESTPROF) then PI = 4.0*atan(1.0) DecayScale = 4.*PI / CS%TP_WVL !4pi - do jj = G%jsd,G%jed - do II = G%isdB,G%iedB + do jj = G%jsc,G%jec + do II = G%iscB,G%iecB IIm1 = max(1,II-1) Bottom = 0.0 MidPoint = 0.0 @@ -623,8 +630,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) enddo enddo enddo - do JJ = G%jsdB,G%jedB - do ii = G%isd,G%ied + do JJ = G%jscB,G%jecB + do ii = G%isc,G%iec JJm1 = max(1,JJ-1) Bottom = 0.0 MidPoint = 0.0 @@ -636,6 +643,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) enddo enddo enddo + call pass_vector(CS%Us_x(:,:,:),CS%Us_y(:,:,:), G%Domain, To_All) ! 2. If Surface Bands is chosen ! In wavenumber mode compute integral for layer averaged Stokes drift. ! In frequency mode compuate value at midpoint. @@ -645,8 +653,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) CS%Us0_x(:,:) = 0.0 CS%Us0_y(:,:) = 0.0 ! Computing X direction Stokes drift - do jj = G%jsd,G%jed - do II = G%isdB,G%iedB + do jj = G%jsc,G%jec + do II = G%iscB,G%iecB ! 1. First compute the surface Stokes drift ! by integrating over the partitions. do b = 1,CS%NumBands @@ -709,8 +717,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) enddo enddo ! Computing Y direction Stokes drift - do JJ = G%jsdB,G%jedB - do ii = G%isd,G%ied + do JJ = G%jscB,G%jecB + do ii = G%isc,G%iec ! Compute the surface values. do b = 1,CS%NumBands if (CS%PartitionMode==0) then @@ -771,10 +779,12 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) enddo enddo enddo + call pass_vector(CS%Us_x(:,:,:),CS%Us_y(:,:,:), G%Domain, To_All) + call pass_vector(CS%Us0_x(:,:),CS%Us0_y(:,:), G%Domain) elseif (CS%WaveMethod == DHH85) then if (.not.(CS%StaticWaves .and. CS%DHH85_is_set)) then - do jj = G%jsd,G%jed - do II = G%isdB,G%iedB + do jj = G%jsc,G%jec + do II = G%iscB,G%iecB bottom = 0.0 do kk = 1,GV%ke Top = Bottom @@ -791,8 +801,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) enddo enddo enddo - do JJ = G%jsdB,G%jedB - do ii = G%isd,G%ied + do JJ = G%jscB,G%jecB + do ii = G%isc,G%iec Bottom = 0.0 do kk=1, GV%ke Top = Bottom @@ -815,6 +825,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) enddo CS%DHH85_is_set = .true. endif + call pass_vector(CS%Us_x(:,:),CS%Us_y(:,:), G%Domain) else! Keep this else, fallback to 0 Stokes drift do kk= 1,GV%ke do jj = G%jsd,G%jed @@ -844,8 +855,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) ! Finding tendency of Stokes drift over the time step to apply ! as an acceleration to the models current. - CS%ddt_us_x(:,:,:) = (CS%US_x(:,:,:) - CS%ddt_us_x(:,:,:)) * idt - CS%ddt_us_y(:,:,:) = (CS%US_y(:,:,:) - CS%ddt_us_y(:,:,:)) * idt + if (CS%Stokes_DDT) CS%ddt_us_x(:,:,:) = (CS%US_x(:,:,:) - CS%ddt_us_x(:,:,:)) * idt + if (CS%Stokes_DDT) CS%ddt_us_y(:,:,:) = (CS%US_y(:,:,:) - CS%ddt_us_y(:,:,:)) * idt ! Output any desired quantities if (CS%id_surfacestokes_y>0) & @@ -856,10 +867,12 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) call post_data(CS%id_3dstokes_y, CS%us_y, CS%diag) if (CS%id_3dstokes_x>0) & call post_data(CS%id_3dstokes_x, CS%us_x, CS%diag) - if (CS%id_ddt_3dstokes_x>0) & - call post_data(CS%id_ddt_3dstokes_x, CS%ddt_us_x, CS%diag) - if (CS%id_ddt_3dstokes_y>0) & - call post_data(CS%id_ddt_3dstokes_y, CS%ddt_us_y, CS%diag) + if (CS%Stokes_DDT) then + if (CS%id_ddt_3dstokes_x>0) & + call post_data(CS%id_ddt_3dstokes_x, CS%ddt_us_x, CS%diag) + if (CS%id_ddt_3dstokes_y>0) & + call post_data(CS%id_ddt_3dstokes_y, CS%ddt_us_y, CS%diag) + endif if (CS%id_La_turb>0) & call post_data(CS%id_La_turb, CS%La_turb, CS%diag) @@ -1783,9 +1796,11 @@ subroutine waves_register_restarts(CS, HI, GV, param_file, restart_CSp) call get_param(param_file,mdl,"WAVE_METHOD",wave_method_str, do_not_log=.true., default=NULL_STRING) if (trim(wave_method_str)== trim(SURFBANDS_STRING)) then - vd(1) = var_desc("US_x", "m s-1", "3d zonal Stokes drift profile") - vd(2) = var_desc("US_y", "m s-1", "3d meridional Stokes drift profile") - call register_restart_field(CS%US_x(:,:,:), vd(1), .true., restart_CSp) + vd(1) = var_desc("US_x", "m s-1", "3d zonal Stokes drift profile",& + hor_grid='u',z_grid='L') + vd(2) = var_desc("US_y", "m s-1", "3d meridional Stokes drift profile",& + hor_grid='v',z_grid='L') + call register_restart_field(CS%US_x(:,:,:), vd(1), .false., restart_CSp) call register_restart_field(CS%US_y(:,:,:), vd(2), .false., restart_CSp) endif From 28268d3e632ff1a406c997c9da582a88bc21ea39 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 23 Dec 2021 09:02:02 -0700 Subject: [PATCH 19/38] fixes in MOM_wave_interface array indices --- src/user/MOM_wave_interface.F90 | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index f89d26451d..340322379c 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -373,7 +373,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar "or the model will fail.",units='', default=1) allocate( CS%WaveNum_Cen(CS%NumBands), source=0.0 ) allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands), source=0.0 ) - allocate( CS%STKy0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands), source=0.0 ) + allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,CS%NumBands), source=0.0 ) CS%PartitionMode = 0 call get_param(param_file, mdl, "SURFBAND_WAVENUMBERS", CS%WaveNum_Cen, & "Central wavenumbers for surface Stokes drift bands.", & @@ -442,9 +442,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar ! a. Stokes driftProfiles if (CS%Stokes_DDT) then allocate(CS%ddt_Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke), source=0.0) - CS%ddt_Us_x(:,:,:) = 0.0 allocate(CS%ddt_Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke), source=0.0) - CS%ddt_Us_y(:,:,:) = 0.0 endif ! b. Surface Values allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed), source=0.0) @@ -825,7 +823,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) enddo CS%DHH85_is_set = .true. endif - call pass_vector(CS%Us_x(:,:),CS%Us_y(:,:), G%Domain) + call pass_vector(CS%Us_x(:,:,:),CS%Us_y(:,:,:), G%Domain) else! Keep this else, fallback to 0 Stokes drift do kk= 1,GV%ke do jj = G%jsd,G%jed @@ -1520,7 +1518,7 @@ subroutine CoriolisStokes(G, GV, dt, h, u, v, WAVES, US) integer :: i,j,k do k = 1, GV%ke -do j = G%jsc, G%jec + do j = G%jsc, G%jec do I = G%iscB, G%iecB DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + & 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) @@ -1788,10 +1786,8 @@ subroutine waves_register_restarts(CS, HI, GV, param_file, restart_CSp) if (.not.(use_waves .or. StatisticalWaves)) return ! Allocate wave fields needed for restart file - allocate(CS%Us_x(HI%isdB:HI%IedB,HI%jsd:HI%jed,GV%ke)) - CS%Us_x(:,:,:) = 0.0 - allocate(CS%Us_y(HI%isd:HI%Ied,HI%jsdB:HI%jedB,GV%ke)) - CS%Us_y(:,:,:) = 0.0 + allocate(CS%Us_x(HI%isdB:HI%IedB,HI%jsd:HI%jed,GV%ke), source=0.0) + allocate(CS%Us_y(HI%isd:HI%Ied,HI%jsdB:HI%jedB,GV%ke), source=0.0) call get_param(param_file,mdl,"WAVE_METHOD",wave_method_str, do_not_log=.true., default=NULL_STRING) From 4f592f2988a168152fc8372bda09ff28250b776e Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 23 Dec 2021 13:24:01 -0700 Subject: [PATCH 20/38] More changes for surfbands wave coupling: - for ustkb and vstkb, call pass_var, instead of pass_vector because they are on h grd. -remove unused ustk0 and vstk0 arrays. - correct the order of wave-related get param & allocate_forcing calls in nuopc cap. - add lamult flag to allocate_forcing_by_group because lamult should only be allocated if wave_method=="EFACTOR". --- config_src/drivers/nuopc_cap/mom_cap.F90 | 12 +++------- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 7 +++--- .../nuopc_cap/mom_surface_forcing_nuopc.F90 | 10 ++------ src/core/MOM_forcing_type.F90 | 23 +++++-------------- 4 files changed, 15 insertions(+), 37 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 409f3bd166..8d75c814f7 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -714,16 +714,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary%lamult = 0.0 else if (wave_method == "SURFACE_BANDS") then call query_ocean_state(ocean_state, NumWaveBands=Ice_ocean_boundary%num_stk_bands) - allocate ( Ice_ocean_boundary% ustk0 (isc:iec,jsc:jec), & - Ice_ocean_boundary% vstk0 (isc:iec,jsc:jec), & - Ice_ocean_boundary% ustkb (isc:iec,jsc:jec,Ice_ocean_boundary%num_stk_bands), & - Ice_ocean_boundary% vstkb (isc:iec,jsc:jec,Ice_ocean_boundary%num_stk_bands), & - Ice_ocean_boundary%stk_wavenumbers (Ice_ocean_boundary%num_stk_bands)) - Ice_ocean_boundary%ustk0 = 0.0 - Ice_ocean_boundary%vstk0 = 0.0 + allocate(Ice_ocean_boundary%ustkb(isc:iec,jsc:jec,Ice_ocean_boundary%num_stk_bands), source=0.0) + allocate(Ice_ocean_boundary%vstkb(isc:iec,jsc:jec,Ice_ocean_boundary%num_stk_bands), source=0.0) + allocate(Ice_ocean_boundary%stk_wavenumbers(Ice_ocean_boundary%num_stk_bands), source=0.0) call query_ocean_state(ocean_state, WaveNumbers=Ice_ocean_boundary%stk_wavenumbers, unscale=.true.) - Ice_ocean_boundary%ustkb = 0.0 - Ice_ocean_boundary%vstkb = 0.0 else call MOM_error(FATAL, "Unsupported WAVE_METHOD encountered in NUOPC cap.") endif diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 5e0242be13..c5ac1d44b4 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -373,6 +373,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call get_param(param_file, mdl, "USE_CFC_CAP", use_CFC, & default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "USE_WAVES", OS%Use_Waves, & + "If true, enables surface wave modules.", default=.false.) ! Consider using a run-time flag to determine whether to do the diagnostic ! vertical integrals, since the related 3-d sums are not negligible in cost. @@ -393,12 +395,11 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call allocate_forcing_type(OS%grid, OS%fluxes, shelf=.true.) endif - call allocate_forcing_type(OS%grid, OS%fluxes, waves=.true.) - call get_param(param_file, mdl, "USE_WAVES", OS%Use_Waves, & - "If true, enables surface wave modules.", default=.false.) if (OS%Use_Waves) then call get_param(param_file, mdl, "WAVE_METHOD", OS%wave_method, default="EMPTY", do_not_log=.true.) endif + call allocate_forcing_type(OS%grid, OS%fluxes, waves=.true., lamult=(trim(OS%wave_method)=="EFACTOR")) + ! MOM_wave_interface_init is called regardless of the value of USE_WAVES because ! it also initializes statistical waves. call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag, OS%restart_CSp) diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index c704214930..421ada487f 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -193,8 +193,6 @@ module MOM_surface_forcing_nuopc !! for divergence damping, as determined !! outside of the ocean model in [m3/s] real, pointer, dimension(:,:) :: lamult => NULL() !< Langmuir enhancement factor [nondim] - real, pointer, dimension(:,:) :: ustk0 => NULL() !< Surface Stokes drift, zonal [m/s] - real, pointer, dimension(:,:) :: vstk0 => NULL() !< Surface Stokes drift, meridional [m/s] real, pointer, dimension(:) :: stk_wavenumbers => NULL() !< The central wave number of Stokes bands [rad/m] real, pointer, dimension(:,:,:) :: ustkb => NULL() !< Stokes Drift spectrum, zonal [m/s] !! Horizontal - u points @@ -893,17 +891,13 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if ( associated(IOB%ustkb) ) then forces%stk_wavenumbers(:) = IOB%stk_wavenumbers - do j=js,je; do i=is,ie - forces%ustk0(i,j) = IOB%ustk0(i-I0,j-J0) ! How to be careful here that the domains are right? - forces%vstk0(i,j) = IOB%vstk0(i-I0,j-J0) - enddo ; enddo - call pass_vector(forces%ustk0,forces%vstk0, G%domain ) do istk = 1,IOB%num_stk_bands do j=js,je; do i=is,ie forces%ustkb(i,j,istk) = IOB%ustkb(i-I0,j-J0,istk) forces%vstkb(i,j,istk) = IOB%vstkb(i-I0,j-J0,istk) enddo; enddo - call pass_vector(forces%ustkb(:,:,istk),forces%vstkb(:,:,istk), G%domain ) + call pass_var(forces%ustkb(:,:,istk), G%domain ) + call pass_var(forces%vstkb(:,:,istk), G%domain ) enddo endif diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 2429ce9d2d..58041dbdac 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -256,9 +256,6 @@ module MOM_forcing_type logical :: accumulate_rigidity = .false. !< If true, the rigidity due to various types of !! ice needs to be accumulated, and the rigidity explicitly !! reset to zero at the driver level when appropriate. - real, pointer, dimension(:,:) :: & - ustk0 => NULL(), & !< Surface Stokes drift, zonal [m/s] - vstk0 => NULL() !< Surface Stokes drift, meridional [m/s] real, pointer, dimension(:) :: & stk_wavenumbers => NULL() !< The central wave number of Stokes bands [rad/m] real, pointer, dimension(:,:,:) :: & @@ -2953,7 +2950,7 @@ end subroutine forcing_diagnostics !> Conditionally allocate fields within the forcing type subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & - shelf, iceberg, salt, fix_accum_bug, cfc, waves) + shelf, iceberg, salt, fix_accum_bug, cfc, waves, lamult) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields logical, optional, intent(in) :: water !< If present and true, allocate water fluxes @@ -2967,6 +2964,7 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & !! accumulation of ustar_gustless logical, optional, intent(in) :: cfc !< If present and true, allocate cfc fluxes logical, optional, intent(in) :: waves !< If present and true, allocate wave fields + logical, optional, intent(in) :: lamult !< If present and true, allocate langmuir enhancement factor ! Local variables integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -3030,7 +3028,7 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & !These fields should only on allocated when wave coupling is activated. call myAlloc(fluxes%ice_fraction,isd,ied,jsd,jed, waves) - call myAlloc(fluxes%lamult,isd,ied,jsd,jed, waves) + call myAlloc(fluxes%lamult,isd,ied,jsd,jed, lamult) if (present(fix_accum_bug)) fluxes%gustless_accum_bug = .not.fix_accum_bug end subroutine allocate_forcing_by_group @@ -3125,8 +3123,6 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & call myAlloc(forces%mass_berg,isd,ied,jsd,jed, iceberg) !These fields should only be allocated when waves - call myAlloc(forces%ustk0,isd,ied,jsd,jed, waves) - call myAlloc(forces%vstk0,isd,ied,jsd,jed, waves) if (present(waves)) then; if (waves) then; if (.not. present(num_stk_bands)) then call MOM_error(FATAL,"Requested to & @@ -3134,20 +3130,13 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & endif if (num_stk_bands > 0) then if (.not.associated(forces%ustkb)) then - allocate(forces%stk_wavenumbers(num_stk_bands)) - forces%stk_wavenumbers(:) = 0.0 - allocate(forces%ustkb(isd:ied,jsd:jed,num_stk_bands)) - forces%ustkb(isd:ied,jsd:jed,:) = 0.0 + allocate(forces%stk_wavenumbers(num_stk_bands), source=0.0) + allocate(forces%ustkb(isd:ied,jsd:jed,num_stk_bands), source=0.0) + allocate(forces%vstkb(isd:ied,jsd:jed,num_stk_bands), source=0.0) endif endif endif ; endif - - if (present(waves)) then; if (waves) then; if (.not.associated(forces%vstkb)) then - allocate(forces%vstkb(isd:ied,jsd:jed,num_stk_bands)) - forces%vstkb(isd:ied,jsd:jed,:) = 0.0 - endif ; endif ; endif - end subroutine allocate_mech_forcing_by_group From 58874a5f35c38cf09dc3aedca028106d20c7cbb2 Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Fri, 14 Jan 2022 15:42:13 -0500 Subject: [PATCH 21/38] Updates to Stokes drift terms, primarily the pressure gradient routine. - Replaces Stokes-induced pressure anomaly gradient routine with more accurate method that explicitly integrates the Stokes-shear force contribution to the pressure. Includes diagnostics for the pressure anomaly to verify. - Updates the Stokes time derivative to only be updated on dynamics time-steps. Adds additional storage of previous step that is also only updated on the dynamics time-steps. - Update so that the surface Stokes drift output when using the exponential surfbands option is the surface Stokes drift and not averaged over a layer near the surface. - Minor rename for clarity in Update_Surface_Waves using data_override to clarify the time that wave terms are computed. - Adds diagnostic tracking Stokes time tendency term for verification. - Updates Stokes diagnostic names for conformity. - Fix allocation of CS%STKy0 from u grid to v grid. --- src/core/MOM.F90 | 18 +- src/core/MOM_CoriolisAdv.F90 | 4 +- src/core/MOM_dynamics_split_RK2.F90 | 9 +- src/user/MOM_wave_interface.F90 | 462 ++++++++++++++++++---------- 4 files changed, 321 insertions(+), 172 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index e36e3f71d9..84873aed2c 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -657,16 +657,15 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS else CS%p_surf_end => forces%p_surf endif - if (CS%UseWaves) then ! Update wave information, which is presently kept static over each call to step_mom call enable_averages(time_interval, Time_start + real_to_time(US%T_to_s*time_interval), CS%diag) - call Update_Stokes_Drift(G, GV, US, Waves, h, forces%ustar, time_interval) + call Update_Stokes_Drift(G, GV, US, Waves, h, forces%ustar, time_interval, do_dyn) call disable_averaging(CS%diag) endif else ! not do_dyn. if (CS%UseWaves) then ! Diagnostics are not enabled in this call. - call Update_Stokes_Drift(G, GV, US, Waves, h, fluxes%ustar, time_interval) + call Update_Stokes_Drift(G, GV, US, Waves, h, fluxes%ustar, time_interval, do_dyn) endif endif @@ -1108,6 +1107,19 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & enddo; enddo call pass_vector(u,v,G%Domain) endif + ! Added an additional output to track Stokes drift time tendency. + ! It is mostly for debugging, and perhaps doesn't need to hang + ! around permanently. + if (Waves%Stokes_DDT .and. (Waves%id_3dstokes_y_from_ddt>0)) then + do J=jsq,jeq ; do i=is,ie + Waves%us_y_from_ddt(i,J,:) = Waves%us_y_from_ddt(i,J,:) + Waves%ddt_us_y(i,J,:)*dt + enddo; enddo + endif + if (Waves%Stokes_DDT .and. (Waves%id_3dstokes_x_from_ddt>0)) then + do j=js,je ; do I=isq,ieq + Waves%us_x_from_ddt(I,j,:) = Waves%us_x_from_ddt(I,j,:) + Waves%ddt_us_x(I,j,:)*dt + enddo; enddo + endif if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then call cpu_clock_begin(id_clock_thick_diff) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 16faaf3b2a..f579a4dd85 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -1353,11 +1353,11 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) 'Zonal Acceleration from Relative Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_rvxv > 0) call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) - CS%id_CAuS = register_diag_field('ocean_model', 'CAuS', diag%axesCuL, Time, & + CS%id_CAuS = register_diag_field('ocean_model', 'CAu_Stokes', diag%axesCuL, Time, & 'Zonal Acceleration from Stokes Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) ! add to AD - CS%id_CAvS = register_diag_field('ocean_model', 'CAvS', diag%axesCvL, Time, & + CS%id_CAvS = register_diag_field('ocean_model', 'CAv_Stokes', diag%axesCvL, Time, & 'Meridional Acceleration from Stokes Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) ! add to AD diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index b43e2dc27b..37c2e82229 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -66,7 +66,7 @@ module MOM_dynamics_split_RK2 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, Stokes_PGF_Add_FD +use MOM_wave_interface, only: wave_parameters_CS, Stokes_PGF implicit none ; private @@ -478,10 +478,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s Use_Stokes_PGF = associated(Waves) if (Use_Stokes_PGF) Use_Stokes_PGF = Waves%Stokes_PGF if (Use_Stokes_PGF) then - call Stokes_PGF_Add_FD(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) + call Stokes_PGF(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) + ! We are adding Stokes_PGF to hydrostatic PGF here. The diag PFu/PFv ! will therefore report the sum total PGF and we avoid other - ! modifications in the code. The PFu_Stokes can be output within the waves routines. + ! modifications in the code. The PFu_Stokes is output within the waves routines. if (.not.Waves%Passive_Stokes_PGF) then do k=1,nz do j=js,je ; do I=Isq,Ieq @@ -740,7 +741,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s Use_Stokes_PGF = associated(Waves) if (Use_Stokes_PGF) Use_Stokes_PGF = Waves%Stokes_PGF if (Use_Stokes_PGF) then - call Stokes_PGF_Add_FD(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) + call Stokes_PGF(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) if (.not.Waves%Passive_Stokes_PGF) then do k=1,nz do j=js,je ; do I=Isq,Ieq diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index f89d26451d..88433731e7 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -34,8 +34,7 @@ module MOM_wave_interface ! called in step_mom. public get_Langmuir_Number ! Public interface to compute Langmuir number called from ! ePBL or KPP routines. -public Stokes_PGF_Add_FD ! Public interface to compute Stokes-shear modifications to pressure gradient force - ! using an additive, finite difference method +public Stokes_PGF ! Public interface to compute Stokes-shear induced pressure gradient force anomaly public StokesMixing ! NOT READY - Public interface to add down-Stokes gradient ! momentum mixing (e.g. the approach of Harcourt 2013/2015) public CoriolisStokes ! NOT READY - Public interface to add Coriolis-Stokes acceleration @@ -57,10 +56,9 @@ module MOM_wave_interface ! Main surface wave options and publicly visible variables logical, public :: UseWaves = .false. !< Flag to enable surface gravity wave feature - logical, public :: Stokes_VF = .false. !< Developmental: - !! True if Stokes vortex force is used - logical, public :: Stokes_PGF = .false. !< Developmental: - !! True if Stokes shear pressure Gradient force is used + logical, public :: Stokes_VF = .false. !< True if Stokes vortex force is used + logical, public :: Passive_Stokes_VF = .false. !< Computes Stokes VF, but doesn't affect dynamics + logical, public :: Stokes_PGF = .false. !< True if Stokes shear pressure Gradient force is used logical, public :: Passive_Stokes_PGF = .false. !< Keeps Stokes_PGF on, but doesn't affect dynamics logical, public :: Stokes_DDT = .false. !< Developmental: !! True if Stokes d/dt is used @@ -75,13 +73,29 @@ module MOM_wave_interface !! Horizontal -> V points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - ddt_Us_x !< 3d zonal Stokes drift profile [m s-1] - !! Horizontal -> U points - !! Vertical -> Mid-points + ddt_Us_x !< 3d time tendency of zonal Stokes drift profile [m s-1] + !! Horizontal -> U points + !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - ddt_Us_y !< 3d meridional Stokes drift profile [m s-1] - !! Horizontal -> V points - !! Vertical -> Mid-points + ddt_Us_y !< 3d time tendency of meridional Stokes drift profile [m s-1] + !! Horizontal -> V points + !! Vertical -> Mid-points + real, allocatable, dimension(:,:,:), public :: & + Us_x_from_ddt !< Check of 3d zonal Stokes drift profile [m s-1] + !! Horizontal -> U points + !! Vertical -> Mid-points + real, allocatable, dimension(:,:,:), public :: & + Us_y_from_ddt !< Check of 3d meridional Stokes drift profile [m s-1] + !! Horizontal -> V points + !! Vertical -> Mid-points + real, allocatable, dimension(:,:,:), public :: & + Us_x_prev !< 3d zonal Stokes drift profile, previous dynamics call [m s-1] + !! Horizontal -> U points + !! Vertical -> Mid-points + real, allocatable, dimension(:,:,:), public :: & + Us_y_prev !< 3d meridional Stokes drift profile, previous dynamics call [m s-1] + !! Horizontal -> V points + !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & KvS !< Viscosity for Stokes Drift shear [Z2 T-1 ~> m2 s-1] @@ -189,6 +203,8 @@ module MOM_wave_interface !>@{ Diagnostic handles integer, public :: id_PFu_Stokes = -1 , id_PFv_Stokes = -1 + integer, public :: id_3dstokes_x_from_ddt = -1 , id_3dstokes_y_from_ddt = -1 + integer :: id_P_deltaStokes_L = -1, id_P_deltaStokes_i = -1 integer :: id_surfacestokes_x = -1 , id_surfacestokes_y = -1 integer :: id_3dstokes_x = -1 , id_3dstokes_y = -1 integer :: id_ddt_3dstokes_x = -1 , id_ddt_3dstokes_y = -1 @@ -303,11 +319,14 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar call get_param(param_file, mdl, "STOKES_VF", CS%Stokes_VF, & "Flag to use Stokes vortex force", units="", & Default=.false.) + call get_param(param_file, mdl, "PASSIVE_STOKES_VF", CS%Passive_Stokes_VF, & + "Flag to make Stokes vortex force diagnostic only.", units="", & + Default=.false.) call get_param(param_file, mdl, "STOKES_PGF", CS%Stokes_PGF, & - "Flag to use Stokes pressure gradient force", units="", & + "Flag to use Stokes-induced pressure gradient anomaly", units="", & Default=.false.) call get_param(param_file, mdl, "PASSIVE_STOKES_PGF", CS%Passive_Stokes_PGF, & - "Flag to make Stokes pressure gradient force diagnostic only.", units="", & + "Flag to make Stokes-induced pressure gradient anomaly diagnostic only.", units="", & Default=.false.) call get_param(param_file, mdl, "STOKES_DDT", CS%Stokes_DDT, & "Flag to use Stokes d/dt", units="", & @@ -373,7 +392,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar "or the model will fail.",units='', default=1) allocate( CS%WaveNum_Cen(CS%NumBands), source=0.0 ) allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands), source=0.0 ) - allocate( CS%STKy0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands), source=0.0 ) + allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,CS%NumBands), source=0.0 ) CS%PartitionMode = 0 call get_param(param_file, mdl, "SURFBAND_WAVENUMBERS", CS%WaveNum_Cen, & "Central wavenumbers for surface Stokes drift bands.", & @@ -441,10 +460,15 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar ! Allocate and initialize ! a. Stokes driftProfiles if (CS%Stokes_DDT) then + allocate(CS%Us_x_prev(G%isdB:G%IedB,G%jsd:G%jed,G%ke), source=0.0) + allocate(CS%Us_y_prev(G%isd:G%Ied,G%jsdB:G%jedB,G%ke), source=0.0) allocate(CS%ddt_Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke), source=0.0) CS%ddt_Us_x(:,:,:) = 0.0 allocate(CS%ddt_Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke), source=0.0) CS%ddt_Us_y(:,:,:) = 0.0 + allocate(CS%Us_x_from_ddt(G%isdB:G%IedB,G%jsd:G%jed,G%ke), source=0.0) + allocate(CS%Us_y_from_ddt(G%isd:G%Ied,G%jsdB:G%jedB,G%ke), source=0.0) + endif ! b. Surface Values allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed), source=0.0) @@ -471,11 +495,21 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar CS%diag%axesCvL,Time,'d/dt Stokes drift (meridional)','m s-2') CS%id_ddt_3dstokes_x = register_diag_field('ocean_model','dudt_Stokes', & CS%diag%axesCuL,Time,'d/dt Stokes drift (zonal)','m s-2') + CS%id_3dstokes_y_from_ddt = register_diag_field('ocean_model','3d_stokes_y_from_ddt', & + CS%diag%axesCvL,Time,'3d Stokes drift from ddt (y)', 'm s-1', conversion=US%L_T_to_m_s) + CS%id_3dstokes_x_from_ddt = register_diag_field('ocean_model','3d_stokes_x_from_ddt', & + CS%diag%axesCuL,Time,'3d Stokes drift from ddt (x)', 'm s-1', conversion=US%L_T_to_m_s) endif CS%id_PFv_Stokes = register_diag_field('ocean_model','PFv_Stokes', & - CS%diag%axesCvL,Time,'PF from Stokes drift (meridional)','m s-2')!Needs conversion + CS%diag%axesCvL,Time,'PF from Stokes drift (meridional)','m s-2',conversion=US%L_T2_to_m_s2) CS%id_PFu_Stokes = register_diag_field('ocean_model','PFu_Stokes', & - CS%diag%axesCuL,Time,'PF from Stokes drift (zonal)','m s-2')!Needs conversion + CS%diag%axesCuL,Time,'PF from Stokes drift (zonal)','m s-2',conversion=US%L_T2_to_m_s2) + CS%id_P_deltaStokes_i = register_diag_field('ocean_model','P_deltaStokes_i', & + CS%diag%axesTi,Time,'Interfacial pressure anomaly from Stokes drift used in PFu_Stokes',& + 'm2 s-2',conversion=US%L_T_to_m_s**2) + CS%id_P_deltaStokes_L = register_diag_field('ocean_model','P_deltaStokes_L', & + CS%diag%axesTL,Time,'Layer averaged pressure anomaly from Stokes drift used in PFu_Stokes',& + 'm2 s-2',conversion=US%L_T_to_m_s**2) CS%id_La_turb = register_diag_field('ocean_model','La_turbulent', & CS%diag%axesT1,Time,'Surface (turbulent) Langmuir number','nondim') @@ -506,26 +540,28 @@ subroutine query_wave_properties(CS, NumBands, WaveNumbers, US) end subroutine query_wave_properties !> Subroutine that handles updating of surface wave/Stokes drift related properties -subroutine Update_Surface_Waves(G, GV, US, Day, dt, CS, forces) +subroutine Update_Surface_Waves(G, GV, US, Time_present, dt, CS, forces) type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(time_type), intent(in) :: Day !< Current model time - type(time_type), intent(in) :: dt !< Timestep as a time-type + type(time_type), intent(in) :: Time_present !< Model Time + type(time_type), intent(in) :: dt !< Time increment as a time-type type(mech_forcing), intent(in), optional :: forces !< MOM_forcing_type ! Local variables integer :: ii, jj, kk, b - type(time_type) :: Day_Center - - ! Computing central time of time step - Day_Center = Day + DT/2 + type(time_type) :: Stokes_Time if (CS%WaveMethod == TESTPROF) then ! Do nothing elseif (CS%WaveMethod == SURFBANDS) then if (CS%DataSource == DATAOVR) then - call Surface_Bands_by_data_override(day_center, G, GV, US, CS) + ! Updating Stokes drift time to center of time increment. + ! This choice makes sense for the thermodynamics, but for the + ! dynamics it may be more useful to update to the end of the + ! time increment. + Stokes_Time = Time_present + dt/2 + call Surface_Bands_by_data_override(Stokes_Time, G, GV, US, CS) elseif (CS%DataSource == COUPLER) then if (.not.present(FORCES)) then call MOM_error(FATAL,"The option SURFBAND = COUPLER can not be used with "//& @@ -574,7 +610,7 @@ end subroutine Update_Surface_Waves !> Constructs the Stokes Drift profile on the model grid based on !! desired coupling options -subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) +subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -584,6 +620,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ustar !< Wind friction velocity [Z T-1 ~> m s-1]. real, intent(in) :: dt !< Time-step for computing Stokes-tendency + logical, intent(in) :: dynamics_step !< True if this call is on a dynamics step + ! Local Variables real :: Top, MidPoint, Bottom ! Positions within the layer [Z ~> m] real :: one_cm ! One centimeter in the units of wavelengths [Z ~> m] @@ -608,10 +646,6 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) call pass_vector(CS%US_x(:,:,:),CS%US_y(:,:,:), G%Domain) endif - ! Getting Stokes drift profile from previous step - if (CS%Stokes_DDT) CS%ddt_us_x(:,:,:) = CS%US_x(:,:,:) - if (CS%Stokes_DDT) CS%ddt_us_y(:,:,:) = CS%US_y(:,:,:) - ! 1. If Test Profile Option is chosen ! Computing mid-point value from surface value and decay wavelength if (CS%WaveMethod==TESTPROF) then @@ -656,20 +690,9 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) do jj = G%jsc,G%jec do II = G%iscB,G%iecB ! 1. First compute the surface Stokes drift - ! by integrating over the partitions. + ! by summing over the partitions. do b = 1,CS%NumBands - if (CS%PartitionMode==0) then - ! In wavenumber we are averaging over (small) level - CMN_FAC = (1.0-exp(-one_cm*2.*CS%WaveNum_Cen(b))) / & - (one_cm*2.*CS%WaveNum_Cen(b)) - !### For accuracy and numerical stability rewrite this as: - ! CMN_FAC = one_minus_exp_x(2.*CS%WaveNum_Cen(b)*one_cm) - ! or maybe just take the limit of vanishing thickness, CMN_FAC = 1.0 - elseif (CS%PartitionMode==1) then - ! In frequency we are not averaging over level and taking top - CMN_FAC = 1.0 - endif - CS%US0_x(II,jj) = CS%US0_x(II,jj) + CS%STKx0(II,jj,b)*CMN_FAC + CS%US0_x(II,jj) = CS%US0_x(II,jj) + CS%STKx0(II,jj,b) enddo ! 2. Second compute the level averaged Stokes drift bottom = 0.0 @@ -719,20 +742,9 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) ! Computing Y direction Stokes drift do JJ = G%jscB,G%jecB do ii = G%isc,G%iec - ! Compute the surface values. + ! Set the surface value to that at z=0 do b = 1,CS%NumBands - if (CS%PartitionMode==0) then - ! In wavenumber we are averaging over (small) level - CMN_FAC = (1.0-exp(-one_cm*2.*CS%WaveNum_Cen(b))) / & - (one_cm*2.*CS%WaveNum_Cen(b)) - !### For accuracy and numerical stability rewrite this as: - ! CMN_FAC = one_minus_exp_x(2.*CS%WaveNum_Cen(b)*one_cm) - ! or maybe just take the limit of vanishing thickness, CMN_FAC = 1.0 - elseif (CS%PartitionMode==1) then - ! In frequency we are not averaging over level and taking top - CMN_FAC = 1.0 - endif - CS%US0_y(ii,JJ) = CS%US0_y(ii,JJ) + CS%STKy0(ii,JJ,b)*CMN_FAC + CS%US0_y(ii,JJ) = CS%US0_y(ii,JJ) + CS%STKy0(ii,JJ,b) enddo ! Compute the level averages. bottom = 0.0 @@ -825,7 +837,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) enddo CS%DHH85_is_set = .true. endif - call pass_vector(CS%Us_x(:,:),CS%Us_y(:,:), G%Domain) + call pass_vector(CS%Us_x(:,:,:),CS%Us_y(:,:,:), G%Domain) else! Keep this else, fallback to 0 Stokes drift do kk= 1,GV%ke do jj = G%jsd,G%jed @@ -855,8 +867,12 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) ! Finding tendency of Stokes drift over the time step to apply ! as an acceleration to the models current. - if (CS%Stokes_DDT) CS%ddt_us_x(:,:,:) = (CS%US_x(:,:,:) - CS%ddt_us_x(:,:,:)) * idt - if (CS%Stokes_DDT) CS%ddt_us_y(:,:,:) = (CS%US_y(:,:,:) - CS%ddt_us_y(:,:,:)) * idt + if ( dynamics_step .and. CS%Stokes_DDT ) then + CS%ddt_us_x(:,:,:) = (CS%US_x(:,:,:) - CS%US_x_prev(:,:,:)) * idt + CS%ddt_us_y(:,:,:) = (CS%US_y(:,:,:) - CS%US_y_prev(:,:,:)) * idt + CS%US_x_prev(:,:,:) = CS%US_x(:,:,:) + CS%US_y_prev(:,:,:) = CS%US_y(:,:,:) + endif ! Output any desired quantities if (CS%id_surfacestokes_y>0) & @@ -872,6 +888,10 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt) call post_data(CS%id_ddt_3dstokes_x, CS%ddt_us_x, CS%diag) if (CS%id_ddt_3dstokes_y>0) & call post_data(CS%id_ddt_3dstokes_y, CS%ddt_us_y, CS%diag) + if (CS%id_3dstokes_x_from_ddt>0) & + call post_data(CS%id_3dstokes_x_from_ddt, CS%us_x_from_ddt, CS%diag) + if (CS%id_3dstokes_y_from_ddt>0) & + call post_data(CS%id_3dstokes_y_from_ddt, CS%us_y_from_ddt, CS%diag) endif if (CS%id_La_turb>0) & call post_data(CS%id_La_turb, CS%La_turb, CS%diag) @@ -892,8 +912,8 @@ end function one_minus_exp_x !> A subroutine to fill the Stokes drift from a NetCDF file !! using the data_override procedures. -subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) - type(time_type), intent(in) :: day_center !< Center of timestep +subroutine Surface_Bands_by_data_override(Time, G, GV, US, CS) + type(time_type), intent(in) :: Time !< Time to get Stokes drift bands type(wave_parameters_CS), pointer :: CS !< Wave structure type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -952,7 +972,7 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) PI = 4.0*atan(1.0) call read_variable(CS%SurfBandFileName, dim_name(1), CS%Freq_Cen, scale=2.*PI*US%T_to_s) - do B = 1,CS%NumBands + do b = 1,CS%NumBands CS%WaveNum_Cen(b) = CS%Freq_Cen(b)**2 / CS%g_Earth enddo endif @@ -970,10 +990,10 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) temp_y(:,:) = 0.0 varname = ' ' write(varname, "(A3,I0)") 'Usx', b - call data_override('OCN', trim(varname), temp_x, day_center) + call data_override('OCN', trim(varname), temp_x, Time) varname = ' ' write(varname, "(A3,I0)") 'Usy', b - call data_override('OCN', trim(varname), temp_y, day_center) + call data_override('OCN', trim(varname), temp_y, Time) ! Update halo on h-grid call pass_vector(temp_x, temp_y, G%Domain, To_All, AGRID) ! Filter land values @@ -1540,10 +1560,11 @@ subroutine CoriolisStokes(G, GV, dt, h, u, v, WAVES, US) enddo end subroutine CoriolisStokes - -!> Computes tendency due to Stokes pressure gradient force using an -!! additive finite difference method -subroutine Stokes_PGF_Add_FD(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) +!> Computes tendency due to Stokes pressure gradient force anomaly +!! including analytical integration of Stokes shear using multiple-exponential decay +!! Stokes drift profile and vertical integration of the resulting pressure +!! anomaly to the total pressure gradient force +subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) type(ocean_grid_type), & intent(in) :: G !< Ocean grid type(verticalGrid_type), & @@ -1551,9 +1572,9 @@ subroutine Stokes_PGF_Add_FD(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Velocity i-component [m s-1] + intent(in) :: u !< Lagrangian Velocity i-component [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Velocity j-component [m s-1] + intent(in) :: v !< Lagrangian Velocity j-component [m s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: PFu_Stokes !< PGF Stokes-shear i-component [L T-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1562,116 +1583,226 @@ subroutine Stokes_PGF_Add_FD(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) pointer :: CS !< Surface wave related control structure. ! Local variables - real :: P_Stokes_l, P_Stokes_r ! Contribution of Stokes shear to pressure (left/right index) [L2 T-2 ~> m2 s-2] - real :: u_l, u_r, v_l, v_r ! Velocity components - real :: dUs_dz_l, dUs_dz_r ! Vertical derivative of zonal Stokes drift (left/right index) [T-1 ~> s-1] - real :: dVs_dz_l, dVs_dz_r ! Vertical derivative of meridional Stokes drift (left/right index) [T-1 ~> s-1] - real :: z_top_l, z_top_r ! The height of the top of the cell (left/right index) [Z ~> m]. - real :: z_mid_l, z_mid_r ! The height of the middle of the cell (left/right index) [Z ~> m]. - real :: h_l, h_r ! The thickness of the cell (left/right index) [Z ~> m]. - real :: TwoKexpL, TwoKexpR + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: P_deltaStokes_L ! The stokes induced Pressure anomaly, layer averaged + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: P_deltaStokes_i ! The stokes induced Pressure anomaly at interfaces + real :: P_Stokes_l, P_Stokes_r ! Stokes-induced pressure anomaly over layer (left/right of point) [L2 T-2 ~> m2 s-2] + real :: P_Stokes_l0, P_Stokes_r0 ! Stokes-induced pressure anomaly at interface (left/right of point) [L2 T-2 ~> m2 s-2] + real :: dP_Stokes_l_dz, dP_Stokes_r_dz ! Contribution of layer to integrated Stokes pressure anomaly for summation + ! (left/right of point) [L3 T-2 ~> m3 s-2] + real :: dP_Stokes_l, dP_Stokes_r ! Net increment of Stokes pressure anomaly across layer for summation + ! (left/right of point) [L2 T-2 ~> m2 s-2] + real :: uE_l, uE_r, vE_l, vE_r ! Eulerian velocity components (left/right of point) [L T-1 ~> m s-1] + real :: uS0_l, uS0_r, vS0_l, vS0_r ! Surface Stokes velocity components (left/right of point) [L T-1 ~> m s-1] + real :: zi_l(SZK_(G)+1), zi_r(SZK_(G)+1) ! The height of the edges of the cells (left/right of point) [Z ~> m]. + real :: idz_l(SZK_(G)), idz_r(SZK_(G)) ! The inverse thickness of the cells (left/right of point) [Z-1 ~> m-1] + real :: h_l, h_r ! The thickness of the cell (left/right of point) [Z ~> m]. + real :: dexp2kzL,dexp4kzL,dexp2kzR,dexp4kzR ! Analytical evaluation of multi-exponential decay contribution + ! to Stokes pressure anomalies. + real :: TwoK, FourK, iTwoK, iFourK ! Wavenumber multipliers/inverses + integer :: i,j,k,l + !--------------------------------------------------------------- ! Compute the Stokes contribution to the pressure gradient force + !--------------------------------------------------------------- + ! Notes on the algorithm/code: + ! This code requires computing velocities at bounding h points + ! of the u/v points to get the pressure-gradient. In this + ! implementation there are several redundant calculations as the + ! left/right points are computed at each cell while integrating + ! in the vertical, requiring about twice the calculations. The + ! velocities at the tracer points could be precomputed and + ! stored, but this would require more memory and cycling through + ! large 3d arrays while computing the pressures. This could be + ! explored as a way to speed up this code. + !--------------------------------------------------------------- + PFu_Stokes(:,:,:) = 0.0 PFv_Stokes(:,:,:) = 0.0 - + if (CS%id_P_deltaStokes_i > 0) P_deltaStokes_i(:,:,:) = 0.0 + if (CS%id_P_deltaStokes_L > 0) P_deltaStokes_L(:,:,:) = 0.0 + + ! First compute PGFu. The Stokes-induced pressure anomaly diagnostic is stored from this calculation. + ! > Seeking PGFx at (I,j), meanining we need to compute pressure at h-points (i,j) and (i+1,j). + ! UL(i,j) -> found as average of I-1 & I on j + ! UR(i+1,j) -> found as average of I & I+1 on j + ! VL(i,j) -> found on i as average of J-1 & J + ! VR(i+1,j) -> found on i+1 as average of J-1 & J + ! do j = G%jsc, G%jec ; do I = G%iscB, G%iecB if (G%mask2dCu(I,j)>0.5) then - - z_top_l = 0.0 - z_top_r = 0.0 - P_Stokes_l = 0.0 - P_Stokes_r = 0.0 + P_Stokes_l0 = 0.0 + P_Stokes_r0 = 0.0 + ! We don't need to precompute the grid in physical space arrays and could have done this during + ! the next loop, but this gives flexibility if the loop directions (integrations) are performed + ! upwards instead of downwards (it seems downwards is the better approach). + zi_l(1) = 0.0 + zi_r(1) = 0.0 do k = 1, G%ke - h_l = h(i,j,k) - h_r = h(i+1,j,k) - z_mid_l = z_top_l - 0.5*h_l - z_mid_r = z_top_r - 0.5*h_r + h_l = h(i,j,k)*GV%H_to_Z + h_r = h(i+1,j,k)*GV%H_to_Z + zi_l(k+1) = zi_l(k) - h_l + zi_r(k+1) = zi_r(k) - h_r + Idz_l(k) = 1./max(0.1,h_l) + Idz_r(k) = 1./max(0.1,h_r) + enddo + do k = 1,G%ke + ! Computing (left/right) Eulerian velocities assuming the velocity passed to this routine is the + ! Lagrangian velocity. This requires the wave acceleration terms to be activated together. + uE_l = 0.5*((u(I-1,j,k)-CS%Us_x(I-1,j,k))*G%mask2dCu(I-1,j) + & + (u(I,j,k)-CS%Us_x(I-1,j,k))*G%mask2dCu(I,j)) + uE_r = 0.5*((u(I,j,k)-CS%Us_x(I,j,k))*G%mask2dCu(I,j) + & + (u(I+1,j,k)-CS%Us_x(I+1,j,k))*G%mask2dCu(I+1,j)) + vE_l = 0.5*((v(i,J-1,k)-CS%Us_y(i,J-1,k))*G%mask2dCv(i,J-1) + & + (v(i,J,k)-CS%Us_y(i,J,k))*G%mask2dCv(i,J)) + vE_r = 0.5*((v(i+1,J-1,k)-CS%Us_y(i+1,J-1,k))*G%mask2dCv(i+1,J-1) + & + (v(i+1,J,k)-CS%Us_y(i+1,J,k))*G%mask2dCv(i+1,J)) + + dP_Stokes_l_dz = 0.0 + dP_Stokes_r_dz = 0.0 + dP_Stokes_l = 0.0 + dP_Stokes_r = 0.0 + do l = 1, CS%numbands - TwoKexpL = (2.*CS%WaveNum_Cen(l))*exp(2*CS%WaveNum_Cen(l)*z_mid_l) - TwoKexpR = (2.*CS%WaveNum_Cen(l))*exp(2*CS%WaveNum_Cen(l)*z_mid_r) - !UL -> I-1 & I, j - !UR -> I & I+1, j - !VL -> i, J-1 & J - !VR -> i+1, J-1 & J - dUs_dz_l = TwoKexpL*0.5 * & - (CS%Stkx0(I-1,j,l)*G%mask2dCu(I-1,j) + & - CS%Stkx0(I,j,l)*G%mask2dCu(I,j)) - dUs_dz_r = TwoKexpR*0.5 * & - (CS%Stkx0(I,j,l)*G%mask2dCu(I,j) + & - CS%Stkx0(I+1,j,l)*G%mask2dCu(I+1,j)) - dVs_dz_l = TwoKexpL*0.5 * & - (CS%Stky0(i,J-1,l)*G%mask2dCv(i,J-1) + & - CS%Stky0(i,J,l)*G%mask2dCv(i,J)) - dVs_dz_r = TwoKexpR*0.5 * & - (CS%Stky0(i+1,J-1,l)*G%mask2dCv(i+1,J-1) + & - CS%Stky0(i+1,J,l)*G%mask2dCv(i+1,J)) - u_l = 0.5*(u(I-1,j,k)*G%mask2dCu(I-1,j) + & - u(I,j,k)*G%mask2dCu(I,j)) - u_r = 0.5*(u(I,j,k)*G%mask2dCu(I,j) + & - u(I+1,j,k)*G%mask2dCu(I+1,j)) - v_l = 0.5*(v(i,J-1,k)*G%mask2dCv(i,J-1) + & - v(i,J,k)*G%mask2dCv(i,J)) - v_r = 0.5*(v(i+1,J-1,k)*G%mask2dCv(i+1,J-1) + & - v(i+1,J,k)*G%mask2dCv(i+1,J)) - if (G%mask2dT(i,j)>0.5) & - P_Stokes_l = P_Stokes_l + h_l*(dUs_dz_l*u_l+dVs_dz_l*v_l) - if (G%mask2dT(i+1,j)>0.5) & - P_Stokes_r = P_Stokes_r + h_r*(dUs_dz_r*u_r+dVs_dz_r*v_r) - PFu_Stokes(I,j,k) = PFu_Stokes(I,j,k) + (P_Stokes_r - P_Stokes_l)*G%IdxCu(I,j) + + ! Computing (left/right) surface Stokes drift velocities at wavenumber band + uS0_l = 0.5*(CS%Stkx0(I-1,j,l)*G%mask2dCu(I-1,j) + & + CS%Stkx0(I,j,l)*G%mask2dCu(I,j)) + uS0_r = 0.5*(CS%Stkx0(I,j,l)*G%mask2dCu(I,j) + & + CS%Stkx0(I+1,j,l)*G%mask2dCu(I+1,j)) + vS0_l = 0.5*(CS%Stky0(i,J-1,l)*G%mask2dCv(i,J-1) + & + CS%Stky0(i,J,l)*G%mask2dCv(i,J)) + vS0_r = 0.5*(CS%Stky0(i+1,J-1,l)*G%mask2dCv(i+1,J-1) + & + CS%Stky0(i+1,J,l)*G%mask2dCv(i+1,J)) + + ! Wavenumber terms that are useful to simplify the pressure calculations + TwoK = 2.*CS%WaveNum_Cen(l) + FourK = 2.*TwoK + iTwoK = 1./TwoK + iFourK = 1./(FourK) + dexp2kzL = exp(TwoK*zi_l(k))-exp(TwoK*zi_l(k+1)) + dexp2kzR = exp(TwoK*zi_r(k))-exp(TwoK*zi_r(k+1)) + dexp4kzL = exp(FourK*zi_l(k))-exp(FourK*zi_l(k+1)) + dexp4kzR = exp(FourK*zi_r(k))-exp(FourK*zi_r(k+1)) + + ! Compute Pressure at interface and integrated over layer on left/right bounding points. + ! These are summed over wavenumber bands. + if (G%mask2dT(i,j)>0.5) then + dP_Stokes_l_dz = dP_Stokes_l_dz + & + ((uE_l*uS0_l+vE_l*vS0_l)*iTwoK*dexp2kzL + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*iFourK*dexp4kzL) + dP_Stokes_l = dP_Stokes_l + (uE_l*uS0_l+vE_l*vS0_l)*dexp2kzL + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*dexp4kzL + endif + if (G%mask2dT(i+1,j)>0.5) then + dP_Stokes_r_dz = dP_Stokes_r_dz + & + ((uE_r*uS0_r+vE_r*vS0_r)*iTwoK*dexp2kzR + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*iFourK*dexp4kzR) + dP_Stokes_r = dP_Stokes_r + (uE_r*uS0_r+vE_r*vS0_r)*dexp2kzR + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*dexp4kzR + endif enddo - z_top_l = z_top_l - h_l - z_top_r = z_top_r - h_r + + ! Summing PF over bands + ! > Increment the Layer averaged pressure + P_Stokes_l = P_Stokes_l0 + dP_Stokes_l_dz*Idz_l(k) + P_Stokes_r = P_Stokes_r0 + dP_Stokes_r_dz*Idz_r(k) + ! > Increment the Interface pressure + P_Stokes_l0 = P_Stokes_l0 + dP_Stokes_l + P_Stokes_r0 = P_Stokes_r0 + dP_Stokes_r + + ! Pressure force anomaly is finite difference across the cell. + PFu_Stokes(I,j,k) = (P_Stokes_r - P_Stokes_l)*G%IdxCu(I,j) + + ! Choose to output the pressure delta on the h-points from the PFu calculation. + if (G%mask2dT(i,j)>0.5 .and. CS%id_P_deltaStokes_L > 0) P_deltaStokes_L(i,j,k) = P_Stokes_l + if (G%mask2dT(i,j)>0.5 .and. CS%id_P_deltaStokes_i > 0) P_deltaStokes_i(i,j,k+1) = P_Stokes_l0 + enddo endif enddo ; enddo + + ! Next compute PGFv. The Stokes-induced pressure anomaly diagnostic is stored from this calculation. + ! > Seeking PGFy at (i,J), meanining we need to compute pressure at h-points (i,j) and (i,j+1). + ! UL(i,j) -> found as average of I-1 & I on j + ! UR(i,j+1) -> found as average of I-1 & I on j+1 + ! VL(i,j) -> found on i as average of J-1 & J + ! VR(i,j+1) -> found on i as average of J & J+1 + ! do J = G%jscB, G%jecB ; do i = G%isc, G%iec if (G%mask2dCv(i,J)>0.5) then - z_top_l = 0.0 - z_top_r = 0.0 - P_Stokes_l = 0.0 - P_Stokes_r = 0.0 + P_Stokes_l0 = 0.0 + P_Stokes_r0 = 0.0 + zi_l(1) = 0.0 + zi_r(1) = 0.0 do k = 1, G%ke - h_l = h(i,j,k) - h_r = h(i,j+1,k) - z_mid_l = z_top_l - 0.5*h_l - z_mid_r = z_top_r - 0.5*h_r + h_l = h(i,j,k)*GV%H_to_Z + h_r = h(i,j+1,k)*GV%H_to_Z + zi_l(k+1) = zi_l(k) - h_l + zi_r(k+1) = zi_r(k) - h_r + Idz_l(k) = 1./max(0.1,h_l) + Idz_r(k) = 1./max(0.1,h_r) + enddo + do k = 1,G%ke + ! Computing (left/right) Eulerian velocities assuming the velocity passed to this routine is the + ! Lagrangian velocity. This requires the wave acceleration terms to be activated together. + uE_l = 0.5*((u(I-1,j,k)-CS%Us_x(I-1,j,k))*G%mask2dCu(I-1,j) + & + (u(I,j,k)-CS%Us_x(I,j,k))*G%mask2dCu(I,j)) + uE_r = 0.5*((u(I-1,j+1,k)-CS%Us_x(I-1,j+1,k))*G%mask2dCu(I-1,j+1) + & + (u(I,j+1,k)-CS%Us_x(I,j+1,k))*G%mask2dCu(I,j+1)) + vE_l = 0.5*((v(i,J-1,k)-CS%Us_y(i,J-1,k))*G%mask2dCv(i,J-1) + & + (v(i,J,k)-CS%Us_y(i,J,k))*G%mask2dCv(i,J)) + vE_r = 0.5*((v(i,J,k)-CS%Us_y(i,J,k))*G%mask2dCv(i,J) + & + (v(i,J+1,k)-CS%Us_y(i,J+1,k))*G%mask2dCv(i,J+1)) + + dP_Stokes_l_dz = 0.0 + dP_Stokes_r_dz = 0.0 + dP_Stokes_l = 0.0 + dP_Stokes_r = 0.0 + do l = 1, CS%numbands - TwoKexpL = (2.*CS%WaveNum_Cen(l))*exp(2*CS%WaveNum_Cen(l)*z_mid_l) - TwoKexpR = (2.*CS%WaveNum_Cen(l))*exp(2*CS%WaveNum_Cen(l)*z_mid_r) - !UL -> I-1 & I, j - !UR -> I-1 & I, j+1 - !VL -> i, J & J-1 - !VR -> i, J & J+1 - dUs_dz_l = TwoKexpL*0.5 * & - (CS%Stkx0(I-1,j,l)*G%mask2dCu(I-1,j) + & - CS%Stkx0(I,j,l)*G%mask2dCu(I,j)) - dUs_dz_r = TwoKexpR*0.5 * & - (CS%Stkx0(I-1,j+1,l)*G%mask2dCu(I-1,j+1) + & - CS%Stkx0(I,j+1,l)*G%mask2dCu(I,j+1)) - dVs_dz_l = TwoKexpL*0.5 * & - (CS%Stky0(i,J-1,l)*G%mask2dCv(i,J-1) + & - CS%Stky0(i,J,l)*G%mask2dCv(i,J)) - dVs_dz_r = TwoKexpR*0.5 * & - (CS%Stky0(i,J,l)*G%mask2dCv(i,J) + & - CS%Stky0(i,J+1,l)*G%mask2dCv(i,J+1)) - u_l = 0.5*(u(I-1,j,k)*G%mask2dCu(I-1,j) + & - u(I,j,k)*G%mask2dCu(I,j)) - u_r = 0.5*(u(I-1,j+1,k)*G%mask2dCu(I-1,j+1) + & - u(I,j+1,k)*G%mask2dCu(I,j+1)) - v_l = 0.5*(v(i,J-1,k)*G%mask2dCv(i,J-1) + & - v(i,J,k)*G%mask2dCv(i,J)) - v_r = 0.5*(v(i,J,k)*G%mask2dCv(i,J) + & - v(i,J+1,k)*G%mask2dCv(i,J+1)) - if (G%mask2dT(i,j)>0.5) & - P_Stokes_l = P_Stokes_l + h_l*(dUs_dz_l*u_l+dVs_dz_l*v_l) - if (G%mask2dT(i,j+1)>0.5) & - P_Stokes_r = P_Stokes_r + h_r*(dUs_dz_r*u_r+dVs_dz_r*v_r) - PFv_Stokes(i,J,k) = PFv_Stokes(i,J,k) + (P_Stokes_r - P_Stokes_l)*G%IdyCv(i,J) + + ! Computing (left/right) surface Stokes drift velocities at wavenumber band + uS0_l = 0.5*(CS%Stkx0(I-1,j,l)*G%mask2dCu(I-1,j) + & + CS%Stkx0(I,j,l)*G%mask2dCu(I,j)) + uS0_r = 0.5*(CS%Stkx0(I-1,j+1,l)*G%mask2dCu(I-1,j+1) + & + CS%Stkx0(I,j+1,l)*G%mask2dCu(I,j+1)) + vS0_l = 0.5*(CS%Stky0(i,J-1,l)*G%mask2dCv(i,J-1) + & + CS%Stky0(i,J,l)*G%mask2dCv(i,J)) + vS0_r = 0.5*(CS%Stky0(i,J,l)*G%mask2dCv(i,J) + & + CS%Stky0(i,J+1,l)*G%mask2dCv(i,J+1)) + + ! Wavenumber terms that are useful to simplify the pressure calculations + TwoK = 2.*CS%WaveNum_Cen(l) + FourK = 2.*TwoK + iTwoK = 1./TwoK + iFourK = 1./(FourK) + dexp2kzL = exp(TwoK*zi_l(k))-exp(TwoK*zi_l(k+1)) + dexp2kzR = exp(TwoK*zi_r(k))-exp(TwoK*zi_r(k+1)) + dexp4kzL = exp(FourK*zi_l(k))-exp(FourK*zi_l(k+1)) + dexp4kzR = exp(FourK*zi_r(k))-exp(FourK*zi_r(k+1)) + + ! Compute Pressure at interface and integrated over layer on left/right bounding points. + ! These are summed over wavenumber bands. + if (G%mask2dT(i,j)>0.5) then + dP_Stokes_l_dz = dP_Stokes_l_dz + & + ((uE_l*uS0_l+vE_l*vS0_l)*iTwoK*dexp2kzL + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*iFourK*dexp4kzL) + dP_Stokes_l = dP_Stokes_l + (uE_l*uS0_l+vE_l*vS0_l)*dexp2kzL + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*dexp4kzL + endif + if (G%mask2dT(i,j+1)>0.5) then + dP_Stokes_r_dz = dP_Stokes_r_dz + & + ((uE_r*uS0_r+vE_r*vS0_r)*iTwoK*dexp2kzR + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*iFourK*dexp4kzR) + dP_Stokes_r = dP_Stokes_r + (uE_r*uS0_r+vE_r*vS0_r)*dexp2kzR + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*dexp4kzR + endif enddo - z_top_l = z_top_l - h_l - z_top_r = z_top_r - h_r + + ! Summing PF over bands + ! > Increment the Layer averaged pressure + P_Stokes_l = P_Stokes_l0 + dP_Stokes_l_dz*Idz_l(k) + P_Stokes_r = P_Stokes_r0 + dP_Stokes_r_dz*Idz_r(k) + ! > Increment the Interface pressure + P_Stokes_l0 = P_Stokes_l0 + dP_Stokes_l + P_Stokes_r0 = P_Stokes_r0 + dP_Stokes_r + + ! Pressure force anomaly is finite difference across the cell. + PFv_Stokes(I,j,k) = (P_Stokes_r - P_Stokes_l)*G%IdyCv(i,J) + enddo endif enddo ; enddo @@ -1680,8 +1811,13 @@ subroutine Stokes_PGF_Add_FD(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) call post_data(CS%id_PFv_Stokes, PFv_Stokes, CS%diag) if (CS%id_PFu_Stokes>0) & call post_data(CS%id_PFu_Stokes, PFu_Stokes, CS%diag) + if (CS%id_P_deltaStokes_L>0) & + call post_data(CS%id_P_deltaStokes_L, P_deltaStokes_L, CS%diag) + if (CS%id_P_deltaStokes_i>0) & + call post_data(CS%id_P_deltaStokes_i, P_deltaStokes_i, CS%diag) + +end subroutine Stokes_PGF -end subroutine Stokes_PGF_Add_FD !> Computes wind speed from ustar_air based on COARE 3.5 Cd relationship !! Probably doesn't belong in this module, but it is used here to estimate From f89fd1351faf154a318b7ab8ae57039596c72459 Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Fri, 21 Jan 2022 09:46:00 -0500 Subject: [PATCH 22/38] Fixing diagnostic mode for vortex force correction term. - The model's Coriolis/acceleration term was incorrect when the Stokes vortex form correction was in diagnostic mode. The correct calculations are restored so it can be run in diagnostic mode and reproduce with the model when the setting is turned off entirely. --- src/core/MOM_CoriolisAdv.F90 | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index f579a4dd85..4eb3ade263 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -316,12 +316,19 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, Waves) (-Waves%us_x(I,j,k))*G%dxCu(I,j)) enddo; enddo endif - do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - dvdx(I,J) = ((v(i+1,J,k)-Waves%us_y(i+1,J,k))*G%dyCv(i+1,J) - & - (v(i,J,k)-Waves%us_y(i,J,k))*G%dyCv(i,J)) - dudy(I,J) = ((u(I,j+1,k)-Waves%us_x(I,j+1,k))*G%dxCu(I,j+1) - & - (u(I,j,k)-Waves%us_x(I,j,k))*G%dxCu(I,j)) - enddo; enddo + if (.not. Waves%Passive_Stokes_VF) then + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + dvdx(I,J) = ((v(i+1,J,k)-Waves%us_y(i+1,J,k))*G%dyCv(i+1,J) - & + (v(i,J,k)-Waves%us_y(i,J,k))*G%dyCv(i,J)) + dudy(I,J) = ((u(I,j+1,k)-Waves%us_x(I,j+1,k))*G%dxCu(I,j+1) - & + (u(I,j,k)-Waves%us_x(I,j,k))*G%dxCu(I,j)) + enddo; enddo + else + 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)) + enddo; enddo + endif else 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)) From dc59b117babb03377aaa69a943b35db7cbe9690f Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Fri, 21 Jan 2022 09:55:39 -0500 Subject: [PATCH 23/38] Fixing restart issue with Stokes time tendency term. - The term us_x and us_y needed to be replaced with us_x_prev and us_y_prev to store the previous timestep Stokes drift in order to have reproducing code with restart files. --- src/user/MOM_wave_interface.F90 | 34 +++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 88433731e7..0dd95d5ffb 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -88,7 +88,7 @@ module MOM_wave_interface Us_y_from_ddt !< Check of 3d meridional Stokes drift profile [m s-1] !! Horizontal -> V points !! Vertical -> Mid-points - real, allocatable, dimension(:,:,:), public :: & + real, allocatable, dimension(:,:,:), public :: & Us_x_prev !< 3d zonal Stokes drift profile, previous dynamics call [m s-1] !! Horizontal -> U points !! Vertical -> Mid-points @@ -459,9 +459,11 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar ! Allocate and initialize ! a. Stokes driftProfiles + allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke), source=0.0) + allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke), source=0.0) if (CS%Stokes_DDT) then - allocate(CS%Us_x_prev(G%isdB:G%IedB,G%jsd:G%jed,G%ke), source=0.0) - allocate(CS%Us_y_prev(G%isd:G%Ied,G%jsdB:G%jedB,G%ke), source=0.0) + !allocate(CS%Us_x_prev(G%isdB:G%IedB,G%jsd:G%jed,G%ke), source=0.0) + !allocate(CS%Us_y_prev(G%isd:G%Ied,G%jsdB:G%jedB,G%ke), source=0.0) allocate(CS%ddt_Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke), source=0.0) CS%ddt_Us_x(:,:,:) = 0.0 allocate(CS%ddt_Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke), source=0.0) @@ -1906,7 +1908,7 @@ subroutine waves_register_restarts(CS, HI, GV, param_file, restart_CSp) type(vardesc) :: vd(2) logical :: use_waves logical :: StatisticalWaves - character*(13) :: wave_method_str + logical :: time_tendency_term character(len=40) :: mdl = "MOM_wave_interface" !< This module's name. if (associated(CS)) then @@ -1923,21 +1925,21 @@ subroutine waves_register_restarts(CS, HI, GV, param_file, restart_CSp) if (.not.(use_waves .or. StatisticalWaves)) return - ! Allocate wave fields needed for restart file - allocate(CS%Us_x(HI%isdB:HI%IedB,HI%jsd:HI%jed,GV%ke)) - CS%Us_x(:,:,:) = 0.0 - allocate(CS%Us_y(HI%isd:HI%Ied,HI%jsdB:HI%jedB,GV%ke)) - CS%Us_y(:,:,:) = 0.0 - - call get_param(param_file,mdl,"WAVE_METHOD",wave_method_str, do_not_log=.true., default=NULL_STRING) + call get_param(param_file,mdl,"STOKES_DDT",time_tendency_term, do_not_log=.true., default=.false.) - if (trim(wave_method_str)== trim(SURFBANDS_STRING)) then - vd(1) = var_desc("US_x", "m s-1", "3d zonal Stokes drift profile",& + if (time_tendency_term) then + ! Allocate wave fields needed for restart file + allocate(CS%Us_x_prev(HI%isdB:HI%IedB,HI%jsd:HI%jed,GV%ke)) + CS%Us_x_prev(:,:,:) = 0.0 + allocate(CS%Us_y_prev(HI%isd:HI%Ied,HI%jsdB:HI%jedB,GV%ke)) + CS%Us_y_prev(:,:,:) = 0.0 + ! Register to restart + vd(1) = var_desc("Us_x_prev", "m s-1", "3d zonal Stokes drift profile",& hor_grid='u',z_grid='L') - vd(2) = var_desc("US_y", "m s-1", "3d meridional Stokes drift profile",& + vd(2) = var_desc("Us_y_prev", "m s-1", "3d meridional Stokes drift profile",& hor_grid='v',z_grid='L') - call register_restart_field(CS%US_x(:,:,:), vd(1), .false., restart_CSp) - call register_restart_field(CS%US_y(:,:,:), vd(2), .false., restart_CSp) + call register_restart_field(CS%US_x_prev(:,:,:), vd(1), .false., restart_CSp) + call register_restart_field(CS%US_y_prev(:,:,:), vd(2), .false., restart_CSp) endif end subroutine waves_register_restarts From c181854227c9530faeec6a3714a7ef1146ef9f62 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 2 Feb 2022 09:38:12 -0700 Subject: [PATCH 24/38] fix line lenght error in MOM_wave_interface --- src/user/MOM_wave_interface.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index fd2af99b6d..e789cd69cf 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1585,7 +1585,8 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: P_deltaStokes_L ! The stokes induced Pressure anomaly, layer averaged real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: P_deltaStokes_i ! The stokes induced Pressure anomaly at interfaces real :: P_Stokes_l, P_Stokes_r ! Stokes-induced pressure anomaly over layer (left/right of point) [L2 T-2 ~> m2 s-2] - real :: P_Stokes_l0, P_Stokes_r0 ! Stokes-induced pressure anomaly at interface (left/right of point) [L2 T-2 ~> m2 s-2] + real :: P_Stokes_l0, P_Stokes_r0 ! Stokes-induced pressure anomaly at interface + ! (left/right of point) [L2 T-2 ~> m2 s-2] real :: dP_Stokes_l_dz, dP_Stokes_r_dz ! Contribution of layer to integrated Stokes pressure anomaly for summation ! (left/right of point) [L3 T-2 ~> m3 s-2] real :: dP_Stokes_l, dP_Stokes_r ! Net increment of Stokes pressure anomaly across layer for summation From 035ae5c85f3f96acfa8291e8a2537548f8b88b41 Mon Sep 17 00:00:00 2001 From: Alper Altuntas Date: Tue, 15 Feb 2022 16:13:32 -0700 Subject: [PATCH 25/38] Misc dimensional consistency fixes in regridding, remapping, and MEKE routines --- src/ALE/MOM_regridding.F90 | 9 ++++++++- src/framework/MOM_diag_remap.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 35dcdaa819..348d72683e 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -488,7 +488,6 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m call setCoordinateResolution(dz, CS, scale=1.0) elseif (coordinateMode(coord_mode) == REGRIDDING_RHO) then call setCoordinateResolution(dz, CS, scale=US%kg_m3_to_R) - CS%coord_scale = US%R_to_kg_m3 elseif (coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then call setCoordinateResolution(dz, CS, scale=GV%m_to_H) CS%coord_scale = GV%H_to_m @@ -498,6 +497,14 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m endif endif + ! set coord_scale for RHO regridding independent of allocation status of dz + if (coordinateMode(coord_mode) == REGRIDDING_RHO) then + CS%coord_scale = US%R_to_kg_m3 + endif + + ! ensure CS%ref_pressure is rescaled properly + CS%ref_pressure = (US%kg_m3_to_R * US%m_s_to_L_T**2) * CS%ref_pressure + if (allocated(rho_target)) then call set_target_densities(CS, US%kg_m3_to_R*rho_target) deallocate(rho_target) diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index bb11d92673..15f50e5116 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -222,7 +222,7 @@ subroutine diag_remap_configure_axes(remap_cs, GV, US, param_file) allocate(interfaces(remap_cs%nz+1)) allocate(layers(remap_cs%nz)) - interfaces(:) = getCoordinateInterfaces(remap_cs%regrid_cs) + interfaces(:) = getCoordinateInterfaces(remap_cs%regrid_cs, undo_scaling=.true.) layers(:) = 0.5 * ( interfaces(1:remap_cs%nz) + interfaces(2:remap_cs%nz+1) ) remap_cs%interface_axes_id = MOM_diag_axis_init(lowercase(trim(remap_cs%diag_coord_name))//'_i', & diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 5efb318db1..f677e03c21 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -709,7 +709,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) if (CS%MEKE_equilibrium_alt) then - MEKE%MEKE(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_m*depth_tot(i,j))**2 / cd2 + MEKE%MEKE(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*depth_tot(i,j))**2 / cd2 else 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 From 098f5c9d93d7596c4dda0c74977a5abd1546b476 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 17 Feb 2022 19:31:28 -0700 Subject: [PATCH 26/38] fix u10_sqr dimensional scaling --- src/core/MOM_forcing_type.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 20050026d2..dbc45830cb 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1323,7 +1323,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, 'Fraction of cell area covered by sea ice', 'm2 m-2') handles%id_u10_sqr = register_diag_field('ocean_model', 'u10_sqr', diag%axesT1, Time, & - 'Wind magnitude at 10m, squared', 'm2 s-2', conversion=US%Z_to_m**2*US%s_to_T**2) + 'Wind magnitude at 10m, squared', 'm2 s-2', conversion=US%L_to_m**2*US%s_to_T**2) endif endif From 6963b222df6b5ae1b14266162e584d7c0d4f9e2a Mon Sep 17 00:00:00 2001 From: Michael Levy Date: Wed, 9 Mar 2022 14:16:48 -0700 Subject: [PATCH 27/38] Add KPP nonlocal term to passive tracers (#202) Support for KPP Nonlocal term beyond T & S When APPLY_NONLOCAL_TRANSPORT=True, the KPP Nonlocal term will be applied to the tracers in the MOM_CFC_cap module and the tracer in the pseudo_salt_tracer module (if they are active in the run). To support this, some of the KPP diagnostics were moved from the KPP_CS type to the tracer_type data structure and the KPP_NonLocalTransport_temp() and KPP_NonLocalTransport_saln() functions were refactored to put common code in KPP_NonLocalTransport() (which can be called from any of the tracer modules). Additionally, scaling terms for the diagnostics available from the KPP_NonLocalTransport() function are encoded via the conversion argument of the register_diag_field() call in register_tracer_diagnostics(). This results in a round-off level change to the KPP_NLT_temp_budget and KPP_NLT_saln_budget diagnostics. Lastly, two structural changes to the code: 1. To avoid a circular dependency between MOM_variables.F90 and MOM_tracer_registry.F90, tracer_type and tracer_registry_type have been moved to a new module named MOM_tracer_types.F90. Both of those types remain public in MOM_tracer_registry.F90, so they are still available through "use MOM_tracer_registry" statements. 2. Some code in MOM_CFC_cap.F90 was refactored to replace nearly-repeated lines (first for CFC11 and then for CFC12) with loops over an array of the new CFC_tracer_metadata type. This PR does not change answers for MOM6-examples when compared against MOM6/main. There is a minor change in MOM_parameter_doc.all for the following tests because the description of APPLY_NONLOCAL_TRANSPORT has been updated: ``` ocean_only/CVmix_SCM_tests/cooling_only/KPP/ ocean_only/CVmix_SCM_tests/mech_only/KPP/ ocean_only/CVmix_SCM_tests/skin_warming_wind/KPP/ ocean_only/CVmix_SCM_tests/wind_only/KPP/ ocean_only/SCM_idealized_hurricane/ ocean_only/SCM_idealized_hurricane/ ocean_only/single_column/EPBL/ ocean_only/single_column/KPP/ ``` --- src/core/MOM.F90 | 13 +- src/core/MOM_forcing_type.F90 | 29 ++- src/core/MOM_variables.F90 | 3 + .../vertical/MOM_CVMix_KPP.F90 | 210 +++++++----------- .../vertical/MOM_diabatic_driver.F90 | 40 ++-- src/tracer/MOM_CFC_cap.F90 | 190 +++++++++------- src/tracer/MOM_tracer_flow_control.F90 | 21 +- src/tracer/MOM_tracer_registry.F90 | 209 ++++++----------- src/tracer/MOM_tracer_types.F90 | 130 +++++++++++ src/tracer/pseudo_salt_tracer.F90 | 18 +- 10 files changed, 479 insertions(+), 384 deletions(-) create mode 100644 src/tracer/MOM_tracer_types.F90 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 31718ae37b..e2e966e3b4 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1834,6 +1834,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: first_direction ! An integer that indicates which direction is to be ! updated first in directionally split parts of the ! calculation. + logical :: use_KPP ! If true, diabatic is using KPP vertical mixing integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. @@ -2360,13 +2361,18 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, HI, GV, & tr_desc=vd_T, registry_diags=.true., flux_nameroot='T', & flux_units='W', flux_longname='Heat', & + net_surfflux_name='KPP_QminusSW', NLT_budget_name='KPP_NLT_temp_budget', & + net_surfflux_longname='Net temperature flux ignoring short-wave, as used by [CVMix] KPP', & flux_scale=conv2watt, convergence_units='W m-2', & - convergence_scale=conv2watt, CMOR_tendprefix="opottemp", diag_form=2) + convergence_scale=conv2watt, CMOR_tendprefix="opottemp", diag_form=2, & + Tr_out=CS%tv%tr_T) call register_tracer(CS%tv%S, CS%tracer_Reg, param_file, HI, GV, & tr_desc=vd_S, registry_diags=.true., flux_nameroot='S', & flux_units=S_flux_units, flux_longname='Salt', & + net_surfflux_name='KPP_netSalt', NLT_budget_name='KPP_NLT_saln_budget', & flux_scale=conv2salt, convergence_units='kg m-2 s-1', & - convergence_scale=0.001*GV%H_to_kg_m2, CMOR_tendprefix="osalt", diag_form=2) + convergence_scale=0.001*GV%H_to_kg_m2, CMOR_tendprefix="osalt", diag_form=2, & + Tr_out=CS%tv%tr_S) endif endif @@ -2840,8 +2846,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call register_surface_diags(Time, G, US, CS%sfc_IDs, CS%diag, CS%tv) call register_diags(Time, G, GV, US, CS%IDs, CS%diag) call register_transport_diags(Time, G, GV, US, CS%transport_IDs, CS%diag) + call extract_diabatic_member(CS%diabatic_CSp, use_KPP=use_KPP) call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, US, & - CS%use_ALE_algorithm) + CS%use_ALE_algorithm, use_KPP) if (CS%use_ALE_algorithm) then call ALE_register_diags(Time, G, GV, US, diag, CS%ALE_CSp) endif diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index dbc45830cb..1af57549f6 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -99,20 +99,21 @@ module MOM_forcing_type ! water mass fluxes into the ocean [R Z T-1 ~> kg m-2 s-1]; these fluxes impact the ocean mass real, pointer, dimension(:,:) :: & - evap => NULL(), & !< (-1)*fresh water flux evaporated out of the ocean [R Z T-1 ~> kg m-2 s-1] - lprec => NULL(), & !< precipitating liquid water into the ocean [R Z T-1 ~> kg m-2 s-1] - fprec => NULL(), & !< precipitating frozen water into the ocean [R Z T-1 ~> kg m-2 s-1] - vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring [R Z T-1 ~> kg m-2 s-1] - lrunoff => NULL(), & !< liquid river runoff entering ocean [R Z T-1 ~> kg m-2 s-1] - frunoff => NULL(), & !< frozen river runoff (calving) entering ocean [R Z T-1 ~> kg m-2 s-1] - seaice_melt => NULL() !< snow/seaice melt (positive) or formation (negative) [R Z T-1 ~> kg m-2 s-1] + evap => NULL(), & !< (-1)*fresh water flux evaporated out of the ocean [R Z T-1 ~> kg m-2 s-1] + lprec => NULL(), & !< precipitating liquid water into the ocean [R Z T-1 ~> kg m-2 s-1] + fprec => NULL(), & !< precipitating frozen water into the ocean [R Z T-1 ~> kg m-2 s-1] + vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring [R Z T-1 ~> kg m-2 s-1] + lrunoff => NULL(), & !< liquid river runoff entering ocean [R Z T-1 ~> kg m-2 s-1] + frunoff => NULL(), & !< frozen river runoff (calving) entering ocean [R Z T-1 ~> kg m-2 s-1] + seaice_melt => NULL() !< snow/seaice melt (positive) or formation (negative) [R Z T-1 ~> kg m-2 s-1] ! Integrated water mass fluxes into the ocean, used for passive tracer sources [H ~> m or kg m-2] real, pointer, dimension(:,:) :: & - netMassIn => NULL(), & !< Sum of water mass fluxes into the ocean integrated over a - !! forcing timestep [H ~> m or kg m-2] - netMassOut => NULL() !< Net water mass flux out of the ocean integrated over a forcing timestep, - !! with negative values for water leaving the ocean [H ~> m or kg m-2] + netMassIn => NULL(), & !< Sum of water mass fluxes into the ocean integrated over a + !! forcing timestep [H ~> m or kg m-2] + netMassOut => NULL(), & !< Net water mass flux out of the ocean integrated over a forcing timestep, + !! with negative values for water leaving the ocean [H ~> m or kg m-2] + KPP_salt_flux => NULL() !< KPP effective salt flux [ppt m s-1] ! heat associated with water crossing ocean surface real, pointer, dimension(:,:) :: & @@ -191,8 +192,8 @@ module MOM_forcing_type ! CFC-related arrays needed in the MOM_CFC_cap module real, pointer, dimension(:,:) :: & - cfc11_flux => NULL(), & !< flux of cfc_11 into the ocean [CU R Z T-1 kg m-3 ~> mol m-2 s-1] - cfc12_flux => NULL(), & !< flux of cfc_12 into the ocean [CU R Z T-1 kg m-3 ~> mol m-2 s-1] + cfc11_flux => NULL(), & !< flux of cfc_11 into the ocean [CU R Z T-1 ~> mol m-2 s-1] + cfc12_flux => NULL(), & !< flux of cfc_12 into the ocean [CU R Z T-1 ~> mol m-2 s-1] ice_fraction => NULL(), & !< fraction of sea ice coverage at h-cells, from 0 to 1 [nondim]. u10_sqr => NULL() !< wind magnitude at 10 m squared [L2 T-2 ~> m2 s-2] @@ -3554,8 +3555,6 @@ subroutine homogenize_forcing(fluxes, G) call homogenize_field_t(fluxes%seaice_melt, G) call homogenize_field_t(fluxes%netMassOut, G) call homogenize_field_t(fluxes%netMassIn, G) - !This was removed and I don't think replaced. Not needed? - !call homogenize_field_t(fluxes%netSalt, G) endif if (do_heat) then diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index a9bf6c3dcf..43f4d26b5d 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -13,6 +13,7 @@ module MOM_variables use MOM_grid, only : ocean_grid_type use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type +use MOM_tracer_types, only : tracer_type implicit none ; private @@ -124,6 +125,8 @@ module MOM_variables real, pointer :: varS(:,:,:) => NULL() !< SGS variance of salinity [ppt2]. real, pointer :: covarTS(:,:,:) => NULL() !< SGS covariance of salinity and potential !! temperature [degC ppt]. + type(tracer_type), pointer :: tr_T => NULL() !< pointer to temp in tracer registry + type(tracer_type), pointer :: tr_S => NULL() !< pointer to salinty in tracer registry end type thermo_var_ptrs !> Pointers to all of the prognostic variables allocated in MOM_variables.F90 and MOM.F90. diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 4d37cc85b3..3fc0b01943 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -19,6 +19,7 @@ module MOM_CVMix_KPP use MOM_domains, only : pass_var use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE, CLOCK_ROUTINE +use MOM_tracer_types, only : tracer_type use CVMix_kpp, only : CVMix_init_kpp, CVMix_put_kpp, CVMix_get_kpp_real use CVMix_kpp, only : CVMix_coeffs_kpp @@ -39,6 +40,7 @@ module MOM_CVMix_KPP public :: KPP_end public :: KPP_NonLocalTransport_temp public :: KPP_NonLocalTransport_saln +public :: KPP_NonLocalTransport public :: KPP_get_BLD ! Enumerated constants @@ -92,7 +94,7 @@ module MOM_CVMix_KPP logical :: debug !< If True, calculate checksums and write debugging information character(len=30) :: MatchTechnique !< Method used in CVMix for setting diffusivity and NLT profile functions integer :: NLT_shape !< MOM6 over-ride of CVMix NLT shape function - logical :: applyNonLocalTrans !< If True, apply non-local transport to heat and scalars + logical :: applyNonLocalTrans !< If True, apply non-local transport to all tracers integer :: n_smooth !< Number of times smoothing operator is applied on OBLdepth. logical :: deepen_only !< If true, apply OBLdepth smoothing at a cell only if the OBLdepth gets deeper. logical :: KPPzeroDiffusivity !< If True, will set diffusivity and viscosity from KPP to zero @@ -127,7 +129,6 @@ module MOM_CVMix_KPP integer :: id_Ws = -1, id_Vt2 = -1 integer :: id_BulkUz2 = -1, id_BulkDrho = -1 integer :: id_uStar = -1, id_buoyFlux = -1 - integer :: id_QminusSW = -1, id_netS = -1 integer :: id_sigma = -1, id_Kv_KPP = -1 integer :: id_Kt_KPP = -1, id_Ks_KPP = -1 integer :: id_Tsurf = -1, id_Ssurf = -1 @@ -135,10 +136,6 @@ module MOM_CVMix_KPP integer :: id_Kd_in = -1 integer :: id_NLTt = -1 integer :: id_NLTs = -1 - integer :: id_NLT_dSdt = -1 - integer :: id_NLT_dTdt = -1 - integer :: id_NLT_temp_budget = -1 - integer :: id_NLT_saln_budget = -1 integer :: id_EnhK = -1, id_EnhVt2 = -1 integer :: id_EnhW = -1 integer :: id_La_SL = -1 @@ -227,7 +224,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) if (present(passive)) passive=CS%passiveMode ! This is passed back to the caller so ! the caller knows to not use KPP output call get_param(paramFile, mdl, 'APPLY_NONLOCAL_TRANSPORT', CS%applyNonLocalTrans, & - 'If True, applies the non-local transport to heat and scalars. '// & + 'If True, applies the non-local transport to all tracers. '// & 'If False, calculates the non-local transport and tendencies but '//& 'purely for diagnostic purposes.', & default=.not. CS%passiveMode) @@ -537,10 +534,6 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m*US%s_to_T) CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, & 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', 'm2/s3', conversion=US%L_to_m**2*US%s_to_T**3) - CS%id_QminusSW = register_diag_field('ocean_model', 'KPP_QminusSW', diag%axesT1, Time, & - 'Net temperature flux ignoring short-wave, as used by [CVMix] KPP', 'K m/s', conversion=GV%H_to_m*US%s_to_T) - CS%id_netS = register_diag_field('ocean_model', 'KPP_netSalt', diag%axesT1, Time, & - 'Effective net surface salt flux, as used by [CVMix] KPP', 'ppt m/s', conversion=GV%H_to_m*US%s_to_T) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & @@ -553,18 +546,6 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) 'Non-local transport (Cs*G(sigma)) for heat, as calculated by [CVMix] KPP', 'nondim') CS%id_NLTs = register_diag_field('ocean_model', 'KPP_NLtransport_salt', diag%axesTi, Time, & 'Non-local tranpsort (Cs*G(sigma)) for scalars, as calculated by [CVMix] KPP', 'nondim') - CS%id_NLT_dTdt = register_diag_field('ocean_model', 'KPP_NLT_dTdt', diag%axesTL, Time, & - 'Temperature tendency due to non-local transport of heat, as calculated by [CVMix] KPP', & - 'K/s', conversion=US%s_to_T) - CS%id_NLT_dSdt = register_diag_field('ocean_model', 'KPP_NLT_dSdt', diag%axesTL, Time, & - 'Salinity tendency due to non-local transport of salt, as calculated by [CVMix] KPP', & - 'ppt/s', conversion=US%s_to_T) - CS%id_NLT_temp_budget = register_diag_field('ocean_model', 'KPP_NLT_temp_budget', diag%axesTL, Time, & - 'Heat content change due to non-local transport, as calculated by [CVMix] KPP', & - 'W/m^2', conversion=US%QRZ_T_to_W_m2) - CS%id_NLT_saln_budget = register_diag_field('ocean_model', 'KPP_NLT_saln_budget', diag%axesTL, Time, & - 'Salt content change due to non-local transport, as calculated by [CVMix] KPP', & - 'kg/(sec*m^2)', conversion=US%RZ_T_to_kg_m2s) CS%id_Tsurf = register_diag_field('ocean_model', 'KPP_Tsurf', diag%axesT1, Time, & 'Temperature of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'C') CS%id_Ssurf = register_diag_field('ocean_model', 'KPP_Ssurf', diag%axesT1, Time, & @@ -1384,10 +1365,75 @@ subroutine KPP_get_BLD(CS, BLD, G, US, m_to_BLD_units) end subroutine KPP_get_BLD -!> Apply KPP non-local transport of surface fluxes for temperature. -subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & - dt, scalar, C_p) +!> Apply KPP non-local transport of surface fluxes for a given tracer +subroutine KPP_NonLocalTransport(CS, G, GV, h, nonLocalTrans, surfFlux, & + dt, diag, tr_ptr, scalar, flux_scale) + type(KPP_CS), intent(in) :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of scalar + !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] + real, intent(in) :: dt !< Time-step [T ~> s] + type(diag_ctrl), target, intent(in) :: diag !< Diagnostics + type(tracer_type), pointer, intent(in) :: tr_ptr !< tracer_type has diagnostic ids on it + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Scalar (scalar units [conc]) + real, optional, intent(in) :: flux_scale !< Scale factor to get surfFlux + !! into proper units + + integer :: i, j, k + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dtracer ! Rate of tracer change [conc T-1 ~> conc s-1] + real, dimension(SZI_(G),SZJ_(G)) :: surfFlux_loc + + ! term used to scale + if (present(flux_scale)) then + do j = G%jsc, G%jec ; do i = G%isc, G%iec + surfFlux_loc(i,j) = surfFlux(i,j) * flux_scale + enddo ; enddo + else + surfFlux_loc(:,:) = surfFlux(:,:) + endif + + ! Post surface flux diagnostic + if (tr_ptr%id_net_surfflux > 0) call post_data(tr_ptr%id_net_surfflux, surfFlux_loc(:,:), diag) + + ! Only continue if we are applying the nonlocal tendency + ! or the nonlocal tendency diagnostic has been requested + if ((tr_ptr%id_NLT_tendency > 0) .or. (CS%applyNonLocalTrans)) then + + !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, h, G, GV, surfFlux_loc) + do k = 1, GV%ke ; do j = G%jsc, G%jec ; do i = G%isc, G%iec + dtracer(i,j,k) = ( nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1) ) / & + ( h(i,j,k) + GV%H_subroundoff ) * surfFlux_loc(i,j) + enddo ; enddo ; enddo + + ! Update tracer due to non-local redistribution of surface flux + if (CS%applyNonLocalTrans) then + !$OMP parallel do default(none) shared(G, GV, dt, scalar, dtracer) + do k = 1, GV%ke ; do j = G%jsc, G%jec ; do i = G%isc, G%iec + scalar(i,j,k) = scalar(i,j,k) + dt * dtracer(i,j,k) + enddo ; enddo ; enddo + endif + if (tr_ptr%id_NLT_tendency > 0) call post_data(tr_ptr%id_NLT_tendency, dtracer, diag) + + endif + + + if (tr_ptr%id_NLT_budget > 0) then + !$OMP parallel do default(none) shared(G, GV, dtracer, nonLocalTrans, surfFlux_loc) + do k = 1, GV%ke ; do j = G%jsc, G%jec ; do i = G%isc, G%iec + ! Here dtracer has units of [Q R Z T-1 ~> W m-2]. + dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * surfFlux_loc(i,j) + enddo ; enddo ; enddo + call post_data(tr_ptr%id_NLT_budget, dtracer(:,:,:), diag) + endif + +end subroutine KPP_NonLocalTransport + +!> Apply KPP non-local transport of surface fluxes for temperature. +subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, dt, tr_ptr, scalar, C_p) type(KPP_CS), intent(in) :: CS !< Control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid @@ -1396,116 +1442,32 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of temperature !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, intent(in) :: dt !< Time-step [T ~> s] + type(tracer_type), pointer, intent(in) :: tr_ptr !< tracer_type has diagnostic ids on it real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< temperature [degC] real, intent(in) :: C_p !< Seawater specific heat capacity !! [Q degC-1 ~> J kg-1 degC-1] - integer :: i, j, k - real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [degC T-1 ~> degC s-1] - - - dtracer(:,:,:) = 0.0 - !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, h, G, GV, surfFlux) - do k = 1, GV%ke - do j = G%jsc, G%jec - do i = G%isc, G%iec - dtracer(i,j,k) = ( nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1) ) / & - ( h(i,j,k) + GV%H_subroundoff ) * surfFlux(i,j) - enddo - enddo - enddo - - ! Update tracer due to non-local redistribution of surface flux - if (CS%applyNonLocalTrans) then - !$OMP parallel do default(none) shared(dt, scalar, dtracer, G, GV) - do k = 1, GV%ke - do j = G%jsc, G%jec - do i = G%isc, G%iec - scalar(i,j,k) = scalar(i,j,k) + dt * dtracer(i,j,k) - enddo - enddo - enddo - endif - - ! Diagnostics - if (CS%id_QminusSW > 0) call post_data(CS%id_QminusSW, surfFlux, CS%diag) - if (CS%id_NLT_dTdt > 0) call post_data(CS%id_NLT_dTdt, dtracer, CS%diag) - if (CS%id_NLT_temp_budget > 0) then - dtracer(:,:,:) = 0.0 - !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, surfFlux, C_p, G, GV) - do k = 1, GV%ke - do j = G%jsc, G%jec - do i = G%isc, G%iec - ! Here dtracer has units of [Q R Z T-1 ~> W m-2]. - dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * & - surfFlux(i,j) * C_p * GV%H_to_RZ - enddo - enddo - enddo - call post_data(CS%id_NLT_temp_budget, dtracer, CS%diag) - endif + call KPP_NonLocalTransport(CS, G, GV, h, nonLocalTrans, surfFlux, dt, CS%diag, & + tr_ptr, scalar) end subroutine KPP_NonLocalTransport_temp !> Apply KPP non-local transport of surface fluxes for salinity. -!> This routine is a useful prototype for other material tracers. -subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, scalar) - - type(KPP_CS), intent(in) :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] +subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, tr_ptr, scalar) + type(KPP_CS), intent(in) :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of salt + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of salt !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] - real, intent(in) :: dt !< Time-step [T ~> s] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Salinity [ppt] - - integer :: i, j, k - real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [ppt T-1 ~> ppt s-1] - - - dtracer(:,:,:) = 0.0 - !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, h, G, GV, surfFlux) - do k = 1, GV%ke - do j = G%jsc, G%jec - do i = G%isc, G%iec - dtracer(i,j,k) = ( nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1) ) / & - ( h(i,j,k) + GV%H_subroundoff ) * surfFlux(i,j) - enddo - enddo - enddo + real, intent(in) :: dt !< Time-step [T ~> s] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Salinity [ppt] + type(tracer_type), pointer, intent(in) :: tr_ptr !< tracer_type has diagnostic ids on it - ! Update tracer due to non-local redistribution of surface flux - if (CS%applyNonLocalTrans) then - !$OMP parallel do default(none) shared(G, GV, dt, scalar, dtracer) - do k = 1, GV%ke - do j = G%jsc, G%jec - do i = G%isc, G%iec - scalar(i,j,k) = scalar(i,j,k) + dt * dtracer(i,j,k) - enddo - enddo - enddo - endif - - ! Diagnostics - if (CS%id_netS > 0) call post_data(CS%id_netS, surfFlux, CS%diag) - if (CS%id_NLT_dSdt > 0) call post_data(CS%id_NLT_dSdt, dtracer, CS%diag) - if (CS%id_NLT_saln_budget > 0) then - dtracer(:,:,:) = 0.0 - !$OMP parallel do default(none) shared(G, GV, dtracer, nonLocalTrans, surfFlux) - do k = 1, GV%ke - do j = G%jsc, G%jec - do i = G%isc, G%iec - ! Here dtracer has units of [ppt R Z T-1 ~> ppt kg m-2 s-1] - dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * & - surfFlux(i,j) * GV%H_to_RZ - enddo - enddo - enddo - call post_data(CS%id_NLT_saln_budget, dtracer, CS%diag) - endif + call KPP_NonLocalTransport(CS, G, GV, h, nonLocalTrans, surfFlux, dt, CS%diag, & + tr_ptr, scalar) end subroutine KPP_NonLocalTransport_saln diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 7b180f1d65..7813800619 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -251,7 +251,7 @@ module MOM_diabatic_driver real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [L2 T-3 ~> m2 s-3] real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] - real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux + real, pointer, dimension(:,:) :: KPP_salt_flux => NULL() !< KPP effective salt flux !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) @@ -742,9 +742,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & - dt, tv%T, tv%C_p) + dt, tv%tr_T, tv%T, tv%C_p) call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & - dt, tv%S) + dt, tv%tr_S, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) @@ -754,6 +754,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif + if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux endif ! endif for KPP ! This is the "old" method for applying differential diffusion. @@ -1061,7 +1062,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied call call_tracer_column_fns(h_orig, h, ent_s(:,:,1:nz), ent_s(:,:,2:nz+1), fluxes, Hml, dt, & G, GV, US, tv, CS%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit = CS%evap_CFL_limit, & + KPP_CSp=CS%KPP_CSp, & + nonLocalTrans=CS%KPP_NLTscalar, & + evap_CFL_limit=CS%evap_CFL_limit, & minimum_forcing_depth=CS%minimum_forcing_depth) call cpu_clock_end(id_clock_tracers) @@ -1318,9 +1321,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & - dt, tv%T, tv%C_p) + dt, tv%tr_T, tv%T, tv%C_p) call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & - dt, tv%S) + dt, tv%tr_S, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) @@ -1330,6 +1333,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif + if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux endif ! endif for KPP ! Calculate vertical mixing due to convection (computed via CVMix) @@ -1568,6 +1572,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied call call_tracer_column_fns(h_orig, h, ent_s(:,:,1:nz), ent_s(:,:,2:nz+1), fluxes, Hml, dt, & G, GV, US, tv, CS%optics, CS%tracer_flow_CSp, CS%debug, & + KPP_CSp=CS%KPP_CSp, & + nonLocalTrans=CS%KPP_NLTscalar, & evap_CFL_limit=CS%evap_CFL_limit, & minimum_forcing_depth=CS%minimum_forcing_depth) @@ -1921,7 +1927,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif - + if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux endif ! endif for KPP ! Add vertical diff./visc. due to convection (computed via CVMix) @@ -1940,9 +1946,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & - dt, tv%T, tv%C_p) + dt, tv%tr_T, tv%T, tv%C_p) call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & - dt, tv%S) + dt, tv%tr_S, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) @@ -2335,7 +2341,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e enddo call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, US, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) + CS%optics, CS%tracer_flow_CSp, CS%debug, & + KPP_CSp=CS%KPP_CSp, & + nonLocalTrans=CS%KPP_NLTscalar) elseif (CS%double_diffuse) then ! extra diffusivity for passive tracers @@ -2356,11 +2364,15 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e enddo ; enddo ; enddo call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, US, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) + CS%optics, CS%tracer_flow_CSp, CS%debug, & + KPP_CSp=CS%KPP_CSp, & + nonLocalTrans=CS%KPP_NLTscalar) else call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, US, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) + CS%optics, CS%tracer_flow_CSp, CS%debug, & + KPP_CSp=CS%KPP_CSp, & + nonLocalTrans=CS%KPP_NLTscalar) endif ! (CS%mix_boundary_tracers) @@ -2569,7 +2581,7 @@ end subroutine layered_diabatic !> Returns pointers or values of members within the diabatic_CS type. For extensibility, !! each returned argument is an optional argument subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, minimum_forcing_depth, & - KPP_CSp, energetic_PBL_CSp, diabatic_aux_CSp, diabatic_halo) + KPP_CSp, energetic_PBL_CSp, diabatic_aux_CSp, diabatic_halo, use_KPP) type(diabatic_CS), target, intent(in) :: CS !< module control structure ! All output arguments are optional type(opacity_CS), optional, pointer :: opacity_CSp !< A pointer to be set to the opacity control structure @@ -2584,6 +2596,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, !! control structure integer, optional, intent( out) :: diabatic_halo !< The halo size where the diabatic algorithms !! assume thermodynamics properties are valid. + logical, optional, intent( out) :: use_KPP !< If true, diabatic is using KPP vertical mixing ! Pointers to control structures if (present(opacity_CSp)) opacity_CSp => CS%opacity @@ -2596,6 +2609,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit if (present(minimum_forcing_depth)) minimum_forcing_depth = CS%minimum_forcing_depth if (present(diabatic_halo)) diabatic_halo = CS%halo_TS_diff + if (present(use_KPP)) use_KPP = CS%use_KPP end subroutine extract_diabatic_member !> Routine called for adiabatic physics diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90 index 7296f1d469..8089334ff1 100644 --- a/src/tracer/MOM_CFC_cap.F90 +++ b/src/tracer/MOM_CFC_cap.F90 @@ -10,13 +10,16 @@ module MOM_CFC_cap use MOM_forcing_type, only : forcing use MOM_hor_index, only : hor_index_type use MOM_grid, only : ocean_grid_type +use MOM_CVMix_KPP, only : KPP_NonLocalTransport, KPP_CS use MOM_io, only : file_exists, MOM_read_data, slasher use MOM_io, only : vardesc, var_desc, query_vardesc, stdout +use MOM_tracer_registry, only : tracer_type use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_time_manager, only : time_type use time_interp_external_mod, only : init_external_field, time_interp_external -use MOM_tracer_registry, only : register_tracer, tracer_registry_type +use MOM_tracer_registry, only : register_tracer +use MOM_tracer_types, only : tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init use MOM_unit_scaling, only : unit_scale_type @@ -33,6 +36,17 @@ module MOM_CFC_cap integer, parameter :: NTR = 2 !< the number of tracers in this module. +!> Contains the concentration array, a pointer to Tr in Tr_reg, and some metadata for a single CFC tracer +type, private :: CFC_tracer_data + type(vardesc) :: desc !< A set of metadata for the tracer + real :: IC_val = 0.0 !< The initial value assigned to the tracer [mol kg-1]. + real :: land_val = -1.0 !< The value of the tracer used where land is masked out [mol kg-1]. + character(len=32) :: name !< Tracer variable name + integer :: id_cmor !< Diagnostic ID + real, pointer, dimension(:,:,:) :: conc !< The tracer concentration [mol kg-1]. + type(tracer_type), pointer :: tr_ptr !< pointer to tracer inside Tr_reg + end type CFC_tracer_data + !> The control structure for the CFC_cap tracer package type, public :: CFC_cap_CS ; private character(len=200) :: IC_file !< The file in which the CFC initial values can @@ -40,28 +54,13 @@ module MOM_CFC_cap logical :: Z_IC_file !< If true, the IC_file is in Z-space. The default is false. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM6 tracer registry - real, pointer, dimension(:,:,:) :: & - CFC11 => NULL(), & !< The CFC11 concentration [mol kg-1]. - CFC12 => NULL() !< The CFC12 concentration [mol kg-1]. - ! In the following variables a suffix of _11 refers to CFC11 and _12 to CFC12. - real :: CFC11_IC_val = 0.0 !< The initial value assigned to CFC11 [mol kg-1]. - real :: CFC12_IC_val = 0.0 !< The initial value assigned to CFC12 [mol kg-1]. - real :: CFC11_land_val = -1.0 !< The value of CFC11 used where land is masked out [mol kg-1]. - real :: CFC12_land_val = -1.0 !< The value of CFC12 used where land is masked out [mol kg-1]. logical :: tracers_may_reinit !< If true, tracers may be reset via the initialization code !! if they are not found in the restart files. - character(len=16) :: CFC11_name !< CFC11 variable name - character(len=16) :: CFC12_name !< CFC12 variable name type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate !! the timing of diagnostic output. type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< Model restart control structure - ! The following vardesc types contain a package of metadata about each tracer. - type(vardesc) :: CFC11_desc !< A set of metadata for the CFC11 tracer - type(vardesc) :: CFC12_desc !< A set of metadata for the CFC12 tracer - !>@{ Diagnostic IDs - integer :: id_cfc11_cmor = -1, id_cfc12_cmor = -1 - !>@} + type(CFC_tracer_data), dimension(2) :: CFC_data !< per-tracer parameters / metadata end type CFC_cap_CS contains @@ -85,6 +84,7 @@ function register_CFC_cap(HI, GV, param_file, CS, tr_Reg, restart_CS) #include "version_variable.h" real, dimension(:,:,:), pointer :: tr_ptr => NULL() character(len=200) :: dummy ! Dummy variable to store params that need to be logged here. + character :: m2char logical :: register_CFC_cap integer :: isd, ied, jsd, jed, nz, m @@ -117,12 +117,12 @@ function register_CFC_cap(HI, GV, param_file, CS, tr_Reg, restart_CS) "if they are not found in the restart files. Otherwise "//& "it is a fatal error if tracers are not found in the "//& "restart files of a restarted run.", default=.false.) - call get_param(param_file, mdl, "CFC11_IC_VAL", CS%CFC11_IC_val, & - "Value that CFC_11 is set to when it is not read from a file.", & - units="mol kg-1", default=0.0) - call get_param(param_file, mdl, "CFC12_IC_VAL", CS%CFC12_IC_val, & - "Value that CFC_12 is set to when it is not read from a file.", & - units="mol kg-1", default=0.0) + do m=1,2 + write(m2char, "(I1)") m + call get_param(param_file, mdl, "CFC1"//m2char//"_IC_VAL", CS%CFC_data(m)%IC_val, & + "Value that CFC_1"//m2char//" is set to when it is not read from a file.", & + units="mol kg-1", default=0.0) + enddo ! the following params are not used in this module. Instead, they are used in ! the cap but are logged here to keep all the CFC cap params together. @@ -147,25 +147,25 @@ function register_CFC_cap(HI, GV, param_file, CS, tr_Reg, restart_CS) ! The following vardesc types contain a package of metadata about each tracer, ! including, the name; units; longname; and grid information. - CS%CFC11_name = "CFC_11" ; CS%CFC12_name = "CFC_12" - CS%CFC11_desc = var_desc(CS%CFC11_name,"mol kg-1","Moles Per Unit Mass of CFC-11 in sea water", caller=mdl) - CS%CFC12_desc = var_desc(CS%CFC12_name,"mol kg-1","Moles Per Unit Mass of CFC-12 in sea water", caller=mdl) - - allocate(CS%CFC11(isd:ied,jsd:jed,nz), source=0.0) - allocate(CS%CFC12(isd:ied,jsd:jed,nz), source=0.0) - - ! This pointer assignment is needed to force the compiler not to do a copy in - ! the registration calls. Curses on the designers and implementers of F90. - tr_ptr => CS%CFC11 - ! Register CFC11 for horizontal advection, diffusion, and restarts. - call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, & - tr_desc=CS%CFC11_desc, registry_diags=.true., & - restart_CS=restart_CS, mandatory=.not.CS%tracers_may_reinit) - ! Do the same for CFC12 - tr_ptr => CS%CFC12 - call register_tracer(tr_ptr, Tr_Reg, param_file, HI, GV, & - tr_desc=CS%CFC12_desc, registry_diags=.true., & - restart_CS=restart_CS, mandatory=.not.CS%tracers_may_reinit) + do m=1,2 + write(m2char, "(I1)") m + write(CS%CFC_data(m)%name, "(2A)") "CFC_1", m2char + CS%CFC_data(m)%desc = var_desc(CS%CFC_data(m)%name, & + "mol kg-1", & + "Moles Per Unit Mass of CFC-1"//m2char//" in sea water", & + caller=mdl) + + allocate(CS%CFC_data(m)%conc(isd:ied,jsd:jed,nz), source=0.0) + + ! This pointer assignment is needed to force the compiler not to do a copy in + ! the registration calls. Curses on the designers and implementers of F90. + tr_ptr => CS%CFC_data(m)%conc + ! Register CFC tracer for horizontal advection, diffusion, and restarts. + call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, & + tr_desc=CS%CFC_data(m)%desc, registry_diags=.true., & + restart_CS=restart_CS, mandatory=.not.CS%tracers_may_reinit, & + Tr_out=CS%CFC_data(m)%tr_ptr) + enddo CS%tr_Reg => tr_Reg CS%restart_CSp => restart_CS @@ -193,30 +193,28 @@ subroutine initialize_CFC_cap(restart, day, G, GV, US, h, diag, OBC, CS) ! local variables logical :: from_file = .false. + integer :: m + character :: m2char if (.not.associated(CS)) return CS%Time => day CS%diag => diag - if (.not.restart .or. (CS%tracers_may_reinit .and. & - .not.query_initialized(CS%CFC11, CS%CFC11_name, CS%restart_CSp))) & - call init_tracer_CFC(h, CS%CFC11, CS%CFC11_name, CS%CFC11_land_val, & - CS%CFC11_IC_val, G, GV, US, CS) - - if (.not.restart .or. (CS%tracers_may_reinit .and. & - .not.query_initialized(CS%CFC12, CS%CFC12_name, CS%restart_CSp))) & - call init_tracer_CFC(h, CS%CFC12, CS%CFC12_name, CS%CFC12_land_val, & - CS%CFC12_IC_val, G, GV, US, CS) + do m=1,2 + if (.not.restart .or. (CS%tracers_may_reinit .and. & + .not.query_initialized(CS%CFC_data(m)%conc, CS%CFC_data(m)%name, CS%restart_CSp))) & + call init_tracer_CFC(h, CS%CFC_data(m)%conc, CS%CFC_data(m)%name, CS%CFC_data(m)%land_val, & + CS%CFC_data(m)%IC_val, G, GV, US, CS) + ! cmor diagnostics + ! CFC11 cmor conventions: http://clipc-services.ceda.ac.uk/dreq/u/42625c97b8fe75124a345962c4430982.html + ! CFC12 cmor conventions: http://clipc-services.ceda.ac.uk/dreq/u/3ab8e10027d7014f18f9391890369235.html + write(m2char, "(I1)") m + CS%CFC_data(m)%id_cmor = register_diag_field('ocean_model', 'cfc1'//m2char, diag%axesTL, day, & + 'Mole Concentration of CFC1'//m2char//' in Sea Water', 'mol m-3') + enddo - ! cmor diagnostics - ! CFC11 cmor conventions: http://clipc-services.ceda.ac.uk/dreq/u/42625c97b8fe75124a345962c4430982.html - CS%id_cfc11_cmor = register_diag_field('ocean_model', 'cfc11', diag%axesTL, day, & - 'Mole Concentration of CFC11 in Sea Water', 'mol m-3') - ! CFC12 cmor conventions: http://clipc-services.ceda.ac.uk/dreq/u/3ab8e10027d7014f18f9391890369235.html - CS%id_cfc12_cmor = register_diag_field('ocean_model', 'cfc12', diag%axesTL, day, & - 'Mole Concentration of CFC12 in Sea Water', 'mol m-3') if (associated(OBC)) then ! Steal from updated DOME in the fullness of time. @@ -273,8 +271,8 @@ end subroutine init_tracer_CFC !> Applies diapycnal diffusion, souces and sinks and any other column !! tracer physics to the CFC cap tracers. CFCs are relatively simple, !! as they are passive tracers with only a surface flux as a source. -subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, & - evap_CFL_limit, minimum_forcing_depth) +subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, KPP_CSp, & + nonLocalTrans, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -295,6 +293,8 @@ subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, C type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CFC_cap_CS), pointer :: CS !< The control structure returned by a !! previous call to register_CFC_cap. + type(KPP_CS), optional, pointer :: KPP_CSp !< KPP control structure + real, optional, intent(in) :: nonLocalTrans(:,:,:) !< Non-local transport [nondim] real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which @@ -305,39 +305,59 @@ subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, C ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] + real :: flux_scale integer :: i, j, k, m, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return + ! Compute KPP nonlocal term if necessary + if (present(KPP_CSp)) then + if (associated(KPP_CSp) .and. present(nonLocalTrans)) then + flux_scale = GV%Z_to_H / GV%rho0 + + call KPP_NonLocalTransport(KPP_CSp, G, GV, h_old, nonLocalTrans, fluxes%cfc11_flux(:,:), dt, CS%diag, & + CS%CFC_data(1)%tr_ptr, CS%CFC_data(1)%conc(:,:,:), & + flux_scale=flux_scale) + call KPP_NonLocalTransport(KPP_CSp, G, GV, h_old, nonLocalTrans, fluxes%cfc12_flux(:,:), dt, CS%diag, & + CS%CFC_data(2)%tr_ptr, CS%CFC_data(2)%conc(:,:,:), & + flux_scale=flux_scale) + endif + endif + ! Use a tridiagonal solver to determine the concentrations after the ! surface source is applied and diapycnal advection and diffusion occurs. if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC11, dt, fluxes, h_work, & + call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC_data(1)%conc, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) - call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=fluxes%cfc11_flux) + call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC_data(1)%conc, G, GV, sfc_flux=fluxes%cfc11_flux) do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC12, dt, fluxes, h_work, & + call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC_data(2)%conc, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) - call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=fluxes%cfc12_flux) + call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC_data(2)%conc, G, GV, sfc_flux=fluxes%cfc12_flux) else - call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=fluxes%cfc11_flux) - call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=fluxes%cfc12_flux) + call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC_data(1)%conc, G, GV, sfc_flux=fluxes%cfc11_flux) + call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC_data(2)%conc, G, GV, sfc_flux=fluxes%cfc12_flux) endif ! If needed, write out any desired diagnostics from tracer sources & sinks here. - if (CS%id_cfc11_cmor > 0) call post_data(CS%id_cfc11_cmor, (GV%Rho0*US%R_to_kg_m3)*CS%CFC11, CS%diag) - if (CS%id_cfc12_cmor > 0) call post_data(CS%id_cfc12_cmor, (GV%Rho0*US%R_to_kg_m3)*CS%CFC12, CS%diag) + if (CS%CFC_data(1)%id_cmor > 0) call post_data(CS%CFC_data(1)%id_cmor, & + (GV%Rho0*US%R_to_kg_m3)*CS%CFC_data(1)%conc, & + CS%diag) + if (CS%CFC_data(2)%id_cmor > 0) call post_data(CS%CFC_data(2)%id_cmor, & + (GV%Rho0*US%R_to_kg_m3)*CS%CFC_data(2)%conc, & + CS%diag) end subroutine CFC_cap_column_physics + !> Calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. @@ -360,7 +380,7 @@ function CFC_cap_stock(h, stocks, G, GV, US, CS, names, units, stock_index) ! Local variables real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] real :: mass ! The cell volume or mass [H L2 ~> m3 or kg] - integer :: i, j, k, is, ie, js, je, nz + integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke CFC_cap_stock = 0 @@ -373,19 +393,18 @@ function CFC_cap_stock(h, stocks, G, GV, US, CS, names, units, stock_index) return endif ; endif - call query_vardesc(CS%CFC11_desc, name=names(1), units=units(1), caller="CFC_cap_stock") - call query_vardesc(CS%CFC12_desc, name=names(2), units=units(2), caller="CFC_cap_stock") - units(1) = trim(units(1))//" kg" ; units(2) = trim(units(2))//" kg" - stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 - stocks(1) = 0.0 ; stocks(2) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) - stocks(1) = stocks(1) + CS%CFC11(i,j,k) * mass - stocks(2) = stocks(2) + CS%CFC12(i,j,k) * mass - enddo ; enddo ; enddo - stocks(1) = stock_scale * stocks(1) - stocks(2) = stock_scale * stocks(2) + do m=1,2 + call query_vardesc(CS%CFC_data(m)%desc, name=names(m), units=units(m), caller="CFC_cap_stock") + units(m) = trim(units(m))//" kg" + + stocks(m) = 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) + stocks(m) = stocks(m) + CS%CFC_data(m)%conc(i,j,k) * mass + enddo ; enddo ; enddo + stocks(m) = stock_scale * stocks(m) + enddo CFC_cap_stock = 2 @@ -407,8 +426,8 @@ subroutine CFC_cap_surface_state(sfc_state, G, CS) if (.not.associated(CS)) return do j=js,je ; do i=is,ie - sfc_state%sfc_cfc11(i,j) = CS%CFC11(i,j,1) - sfc_state%sfc_cfc12(i,j) = CS%CFC12(i,j,1) + sfc_state%sfc_cfc11(i,j) = CS%CFC_data(1)%conc(i,j,1) + sfc_state%sfc_cfc12(i,j) = CS%CFC_data(2)%conc(i,j,1) enddo ; enddo end subroutine CFC_cap_surface_state @@ -592,8 +611,9 @@ subroutine CFC_cap_end(CS) integer :: m if (associated(CS)) then - if (associated(CS%CFC11)) deallocate(CS%CFC11) - if (associated(CS%CFC12)) deallocate(CS%CFC12) + do m=1,2 + if (associated(CS%CFC_data(m)%conc)) deallocate(CS%CFC_data(m)%conc) + enddo deallocate(CS) endif diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 2ae72a3270..4940d8fa89 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -10,6 +10,7 @@ module MOM_tracer_flow_control use MOM_get_input, only : Get_MOM_input use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type +use MOM_CVMix_KPP, only : KPP_CS use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : MOM_restart_CS use MOM_sponge, only : sponge_CS @@ -402,7 +403,7 @@ end subroutine call_tracer_set_forcing !> This subroutine calls all registered tracer column physics subroutines. subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, US, tv, optics, CS, & - debug, evap_CFL_limit, minimum_forcing_depth) + debug, KPP_CSp, nonLocalTrans, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Layer thickness before entrainment @@ -430,6 +431,8 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, !! a previous call to !! call_tracer_register. logical, intent(in) :: debug !< If true calculate checksums + type(KPP_CS), optional, pointer :: KPP_CSp !< KPP control structure + real, optional, intent(in) :: nonLocalTrans(:,:,:) !< Non-local transport [nondim] real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of !! the water that can be fluxed out !! of the top layer in a timestep [nondim] @@ -489,6 +492,8 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (CS%use_CFC_cap) & call CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%CFC_cap_CSp, & + KPP_CSp=KPP_CSp, & + nonLocalTrans=nonLocalTrans, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) if (CS%use_MOM_generic_tracer) then @@ -502,7 +507,10 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, endif if (CS%use_pseudo_salt_tracer) & call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, CS%pseudo_salt_tracer_CSp, tv, debug, & + G, GV, US, CS%pseudo_salt_tracer_CSp, tv, & + debug, & + KPP_CSp=KPP_CSp, & + nonLocalTrans=nonLocalTrans, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) if (CS%use_boundary_impulse_tracer) & @@ -550,7 +558,9 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, G, GV, US, CS%OCMIP2_CFC_CSp) if (CS%use_CFC_cap) & call CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, CS%CFC_cap_CSp) + G, GV, US, CS%CFC_cap_CSp, & + KPP_CSp=KPP_CSp, & + nonLocalTrans=nonLocalTrans) if (CS%use_MOM_generic_tracer) then if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//& "has not been written to permit dimensionsal rescaling. Set all 4 of the "//& @@ -560,7 +570,10 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, endif if (CS%use_pseudo_salt_tracer) & call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, CS%pseudo_salt_tracer_CSp, tv, debug) + G, GV, US, CS%pseudo_salt_tracer_CSp, & + tv, debug, & + KPP_CSp=KPP_CSp, & + nonLocalTrans=nonLocalTrans) if (CS%use_boundary_impulse_tracer) & call boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%boundary_impulse_tracer_CSp, tv, debug) diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index 2c77df3e74..cbb73e3fd2 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -1,7 +1,7 @@ -!> This module contains the tracer_registry_type and the subroutines -!! that handle registration of tracers and related subroutines. -!! The primary subroutine, register_tracer, is called to indicate the -!! tracers advected and diffused. +!> This module contains subroutines that handle registration of tracers +!! and related subroutines. The primary subroutine, register_tracer, is +!! called to indicate the tracers advected and diffused. +!! It also makes public the types defined in MOM_tracer_types. module MOM_tracer_registry ! This file is part of MOM6. See LICENSE.md for the license. @@ -22,7 +22,7 @@ module MOM_tracer_registry use MOM_time_manager, only : time_type use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type - +use MOM_tracer_types, only : tracer_type, tracer_registry_type implicit none ; private #include @@ -34,132 +34,19 @@ module MOM_tracer_registry public tracer_registry_init, lock_tracer_registry, tracer_registry_end public tracer_name_lookup -!> The tracer type -type, public :: tracer_type - - real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array [conc] -! real :: OBC_inflow_conc= 0.0 !< tracer concentration for generic inflows [conc] -! real, dimension(:,:,:), pointer :: OBC_in_u => NULL() !< structured values for flow into the domain -! !! specified in OBCs through u-face of cell -! real, dimension(:,:,:), pointer :: OBC_in_v => NULL() !< structured values for flow into the domain -! !! specified in OBCs through v-face of cell - - real, dimension(:,:,:), pointer :: ad_x => NULL() !< diagnostic array for x-advective tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:,:), pointer :: ad_y => NULL() !< diagnostic array for y-advective tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: ad2d_x => NULL() !< diagnostic vertical sum x-advective tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: ad2d_y => NULL() !< diagnostic vertical sum y-advective tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - - real, dimension(:,:,:), pointer :: df_x => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:,:), pointer :: df_y => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:,:), pointer :: lbd_dfx => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:,:), pointer :: lbd_dfy => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: lbd_dfx_2d => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: lbd_dfy_2d => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - !### These two arrays may be allocated but are never used. - real, dimension(:,:), pointer :: lbd_bulk_df_x => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: lbd_bulk_df_y => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: df2d_x => NULL() !< diagnostic vertical sum x-diffusive flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: df2d_y => NULL() !< diagnostic vertical sum y-diffusive flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] -! real, dimension(:,:), pointer :: df2d_conc_x => NULL() !< diagnostic vertical sum x-diffusive content flux -! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] -! real, dimension(:,:), pointer :: df2d_conc_y => NULL() !< diagnostic vertical sum y-diffusive content flux -! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - - real, dimension(:,:,:), pointer :: advection_xy => NULL() !< convergence of lateral advective tracer fluxes - !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] -! real, dimension(:,:,:), pointer :: diff_cont_xy => NULL() !< convergence of lateral diffusive tracer fluxes -! !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] -! real, dimension(:,:,:), pointer :: diff_conc_xy => NULL() !< convergence of lateral diffusive tracer fluxes -! !! expressed as a change in concentration -! !! [conc T-1 ~> conc s-1] - real, dimension(:,:,:), pointer :: t_prev => NULL() !< tracer concentration array at a previous - !! timestep used for diagnostics [conc] - real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array - !! at a previous timestep used for diagnostics - !! [conc H ~> conc m or conc kg m-2] - - character(len=32) :: name !< tracer name used for diagnostics and error messages - character(len=64) :: units !< Physical dimensions of the tracer concentration - character(len=240) :: longname !< Long name of the variable -! type(vardesc), pointer :: vd => NULL() !< metadata describing the tracer - logical :: registry_diags = .false. !< If true, use the registry to set up the - !! diagnostics associated with this tracer. - character(len=64) :: cmor_name !< CMOR name of this tracer - character(len=64) :: cmor_units !< CMOR physical dimensions of the tracer - character(len=240) :: cmor_longname !< CMOR long name of the tracer - character(len=32) :: flux_nameroot = "" !< Short tracer name snippet used construct the - !! names of flux diagnostics. - character(len=64) :: flux_longname = "" !< A word or phrase used construct the long - !! names of flux diagnostics. - real :: flux_scale = 1.0 !< A scaling factor used to convert the fluxes - !! of this tracer to its desired units, - !! including a factor compensating for H scaling. - character(len=48) :: flux_units = "" !< The units for fluxes of this variable. - character(len=48) :: conv_units = "" !< The units for the flux convergence of this tracer. - real :: conv_scale = 1.0 !< A scaling factor used to convert the flux - !! convergence of this tracer to its desired units, - !! including a factor compensating for H scaling. - character(len=48) :: cmor_tendprefix = "" !< The CMOR variable prefix for tendencies of this - !! tracer, required because CMOR does not follow any - !! discernable pattern for these names. - integer :: ind_tr_squared = -1 !< The tracer registry index for the square of this tracer - - !### THESE CAPABILITIES HAVE NOT YET BEEN IMPLEMENTED. - ! logical :: advect_tr = .true. !< If true, this tracer should be advected - ! logical :: hordiff_tr = .true. !< If true, this tracer should experience epineutral diffusion - logical :: remap_tr = .true. !< If true, this tracer should be vertically remapped - - integer :: diag_form = 1 !< An integer indicating which template is to be used to label diagnostics. - !>@{ Diagnostic IDs - integer :: id_tr = -1, id_tr_post_horzn = -1 - integer :: id_adx = -1, id_ady = -1, id_dfx = -1, id_dfy = -1 - integer :: id_lbd_bulk_dfx = -1, id_lbd_bulk_dfy = -1, id_lbd_dfx = -1, id_lbd_dfy = -1 - integer :: id_lbd_dfx_2d = -1 , id_lbd_dfy_2d = -1 - integer :: id_adx_2d = -1, id_ady_2d = -1, id_dfx_2d = -1, id_dfy_2d = -1 - integer :: id_adv_xy = -1, id_adv_xy_2d = -1 - integer :: id_dfxy_cont = -1, id_dfxy_cont_2d = -1, id_dfxy_conc = -1 - integer :: id_lbdxy_cont = -1, id_lbdxy_cont_2d = -1, id_lbdxy_conc = -1 - integer :: id_remap_conc = -1, id_remap_cont = -1, id_remap_cont_2d = -1 - integer :: id_tendency = -1, id_trxh_tendency = -1, id_trxh_tendency_2d = -1 - integer :: id_tr_vardec = -1 - !>@} -end type tracer_type - -!> Type to carry basic tracer information -type, public :: tracer_registry_type - integer :: ntr = 0 !< number of registered tracers - type(tracer_type) :: Tr(MAX_FIELDS_) !< array of registered tracers -! type(diag_ctrl), pointer :: diag !< structure to regulate timing of diagnostics - logical :: locked = .false. !< New tracers may be registered if locked=.false. - !! When locked=.true., no more tracers can be registered, - !! at which point common diagnostics can be set up - !! for the registered tracers -end type tracer_registry_type +! These types come from MOM_tracer_types +public tracer_type, tracer_registry_type contains !> This subroutine registers a tracer to be advected and laterally diffused. subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, units, & - cmor_name, cmor_units, cmor_longname, tr_desc, & - OBC_inflow, OBC_in_u, OBC_in_v, ad_x, ad_y, df_x, df_y, & - ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, & + cmor_name, cmor_units, cmor_longname, net_surfflux_name, NLT_budget_name, & + net_surfflux_longname, tr_desc, OBC_inflow, OBC_in_u, OBC_in_v, ad_x, ad_y, & + df_x, df_y, ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, & flux_nameroot, flux_longname, flux_units, flux_scale, & convergence_units, convergence_scale, cmor_tendprefix, diag_form, & - restart_CS, mandatory) + restart_CS, mandatory, Tr_out) type(hor_index_type), intent(in) :: HI !< horizontal index type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(tracer_registry_type), pointer :: Reg !< pointer to the tracer registry @@ -172,6 +59,9 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit character(len=*), optional, intent(in) :: cmor_name !< CMOR name character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name + character(len=*), optional, intent(in) :: net_surfflux_name !< Name for net_surfflux diag + character(len=*), optional, intent(in) :: NLT_budget_name !< Name for NLT_budget diag + character(len=*), optional, intent(in) :: net_surfflux_longname !< Long name for net_surfflux diag type(vardesc), optional, intent(in) :: tr_desc !< A structure with metadata about the tracer real, optional, intent(in) :: OBC_inflow !< the tracer for all inflows via OBC for which OBC_in_u @@ -221,6 +111,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit type(MOM_restart_CS), optional, intent(inout) :: restart_CS !< MOM restart control struct logical, optional, intent(in) :: mandatory !< If true, this tracer must be read !! from a restart file. + type(tracer_type), optional, pointer :: Tr_out !< If present, returns pointer into registry logical :: mand type(tracer_type), pointer :: Tr=>NULL() @@ -236,6 +127,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit Reg%ntr = Reg%ntr + 1 Tr => Reg%Tr(Reg%ntr) + if (present(Tr_out)) Tr_out => Reg%Tr(Reg%ntr) if (present(name)) then Tr%name = name @@ -277,6 +169,22 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit if (len_trim(flux_longname) > 0) Tr%flux_longname = flux_longname endif + Tr%net_surfflux_name = "KPP_net"//trim(Tr%name) + if (present(net_surfflux_name)) then + Tr%net_surfflux_name = net_surfflux_name + endif + + Tr%NLT_budget_name = 'KPP_NLT_'//trim(Tr%flux_nameroot)//'_budget' + if (present(NLT_budget_name)) then + Tr%NLT_budget_name = NLT_budget_name + endif + + Tr%net_surfflux_longname = 'Effective net surface '//trim(lowercase(Tr%flux_longname))//& + ' flux, as used by [CVMix] KPP' + if (present(net_surfflux_longname)) then + Tr%net_surfflux_longname = net_surfflux_longname + endif + Tr%flux_units = "" if (present(flux_units)) Tr%flux_units = flux_units @@ -340,7 +248,7 @@ end subroutine lock_tracer_registry !> register_tracer_diagnostics does a set of register_diag_field calls for any previously !! registered in a tracer registry with a value of registry_diags set to .true. -subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) +subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE, use_KPP) 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 @@ -351,23 +259,26 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) type(diag_ctrl), intent(in) :: diag !< structure to regulate diagnostic output logical, intent(in) :: use_ALE !< If true active diagnostics that only !! apply to ALE configurations - - character(len=24) :: name ! A variable's name in a NetCDF file. - character(len=24) :: shortnm ! A shortened version of a variable's name for - ! creating additional diagnostics. - character(len=72) :: longname ! The long name of that tracer variable. - character(len=72) :: flux_longname ! The tracer name in the long names of fluxes. - character(len=48) :: units ! The dimensions of the tracer. - character(len=48) :: flux_units ! The units for fluxes, either - ! [units] m3 s-1 or [units] kg s-1. - character(len=48) :: conv_units ! The units for flux convergences, either - ! [units] m2 s-1 or [units] kg s-1. - character(len=48) :: unit2 ! The dimensions of the tracer squared + logical, intent(in) :: use_KPP !< If true active diagnostics that only + !! apply to CVMix KPP mixings + + character(len=24) :: name ! A variable's name in a NetCDF file. + character(len=24) :: shortnm ! A shortened version of a variable's name for + ! creating additional diagnostics. + character(len=72) :: longname ! The long name of that tracer variable. + character(len=72) :: flux_longname ! The tracer name in the long names of fluxes. + character(len=48) :: units ! The dimensions of the tracer. + character(len=48) :: flux_units ! The units for fluxes, either + ! [units] m3 s-1 or [units] kg s-1. + character(len=48) :: conv_units ! The units for flux convergences, either + ! [units] m2 s-1 or [units] kg s-1. + character(len=48) :: unit2 ! The dimensions of the tracer squared character(len=72) :: cmorname ! The CMOR name of this tracer. character(len=120) :: cmor_longname ! The CMOR long name of that variable. character(len=120) :: var_lname ! A temporary longname for a diagnostic. character(len=120) :: cmor_var_lname ! The temporary CMOR long name for a diagnostic character(len=72) :: cmor_varname ! The temporary CMOR name for a diagnostic + real :: conversion ! Temporary term while we address a bug type(tracer_type), pointer :: Tr=>NULL() integer :: i, j, k, is, ie, js, je, nz, m, m2, nTr_in integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -661,6 +572,30 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) endif endif + ! KPP nonlocal term diagnostics + if (use_KPP) then + Tr%id_net_surfflux = register_diag_field('ocean_model', Tr%net_surfflux_name, diag%axesT1, Time, & + Tr%net_surfflux_longname, trim(units)//' m s-1', conversion=GV%H_to_m*US%s_to_T) + Tr%id_NLT_tendency = register_diag_field('ocean_model', "KPP_NLT_d"//trim(shortnm)//"dt", & + diag%axesTL, Time, & + trim(longname)//' tendency due to non-local transport of '//trim(lowercase(flux_longname))//& + ', as calculated by [CVMix] KPP', trim(units)//' s-1', conversion=US%s_to_T) + if (Tr%conv_scale == 0.001*GV%H_to_kg_m2) then + conversion = GV%H_to_kg_m2 + else + conversion = Tr%conv_scale + end if + ! We actually want conversion=Tr%conv_scale for all tracers, but introducing the local variable + ! 'conversion' and setting it to GV%H_to_kg_m2 instead of 0.001*GV%H_to_kg_m2 for salt tracers + ! keeps changes introduced by this refactoring limited to round-off level; as it turns out, + ! there is a bug in the code and the NLT budget term for salinity is off by a factor of 10^3 + ! so introducing the 0.001 here will fix that bug. + Tr%id_NLT_budget = register_diag_field('ocean_model', Tr%NLT_budget_name, & + diag%axesTL, Time, & + trim(flux_longname)//' content change due to non-local transport, as calculated by [CVMix] KPP', & + conv_units, conversion=conversion*US%s_to_T, v_extensive=.true.) + endif + endif ; enddo end subroutine register_tracer_diagnostics diff --git a/src/tracer/MOM_tracer_types.F90 b/src/tracer/MOM_tracer_types.F90 new file mode 100644 index 0000000000..4a474e9301 --- /dev/null +++ b/src/tracer/MOM_tracer_types.F90 @@ -0,0 +1,130 @@ +!> This module contains the tracer_type and tracer_registry_type +module MOM_tracer_types + +implicit none ; private + +#include + +!> The tracer type +type, public :: tracer_type + + real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array [conc] +! real :: OBC_inflow_conc= 0.0 !< tracer concentration for generic inflows [conc] +! real, dimension(:,:,:), pointer :: OBC_in_u => NULL() !< structured values for flow into the domain +! !! specified in OBCs through u-face of cell +! real, dimension(:,:,:), pointer :: OBC_in_v => NULL() !< structured values for flow into the domain +! !! specified in OBCs through v-face of cell + + real, dimension(:,:,:), pointer :: ad_x => NULL() !< diagnostic array for x-advective tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:,:), pointer :: ad_y => NULL() !< diagnostic array for y-advective tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: ad2d_x => NULL() !< diagnostic vertical sum x-advective tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: ad2d_y => NULL() !< diagnostic vertical sum y-advective tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + + real, dimension(:,:,:), pointer :: df_x => NULL() !< diagnostic array for x-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:,:), pointer :: df_y => NULL() !< diagnostic array for y-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:,:), pointer :: lbd_dfx => NULL() !< diagnostic array for x-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:,:), pointer :: lbd_dfy => NULL() !< diagnostic array for y-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: lbd_dfx_2d => NULL() !< diagnostic array for x-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: lbd_dfy_2d => NULL() !< diagnostic array for y-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !### These two arrays may be allocated but are never used. + real, dimension(:,:), pointer :: lbd_bulk_df_x => NULL() !< diagnostic array for x-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: lbd_bulk_df_y => NULL() !< diagnostic array for y-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: df2d_x => NULL() !< diagnostic vertical sum x-diffusive flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: df2d_y => NULL() !< diagnostic vertical sum y-diffusive flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] +! real, dimension(:,:), pointer :: df2d_conc_x => NULL() !< diagnostic vertical sum x-diffusive content flux +! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] +! real, dimension(:,:), pointer :: df2d_conc_y => NULL() !< diagnostic vertical sum y-diffusive content flux +! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + + real, dimension(:,:,:), pointer :: advection_xy => NULL() !< convergence of lateral advective tracer fluxes + !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] +! real, dimension(:,:,:), pointer :: diff_cont_xy => NULL() !< convergence of lateral diffusive tracer fluxes +! !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] +! real, dimension(:,:,:), pointer :: diff_conc_xy => NULL() !< convergence of lateral diffusive tracer fluxes +! !! expressed as a change in concentration + !! [conc T-1 ~> conc s-1] + real, dimension(:,:,:), pointer :: t_prev => NULL() !< tracer concentration array at a previous + !! timestep used for diagnostics [conc] + real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array + !! at a previous timestep used for diagnostics + !! [conc H ~> conc m or conc kg m-2] + + character(len=32) :: name !< tracer name used for diagnostics and error messages + character(len=64) :: units !< Physical dimensions of the tracer concentration + character(len=240) :: longname !< Long name of the variable +! type(vardesc), pointer :: vd => NULL() !< metadata describing the tracer + logical :: registry_diags = .false. !< If true, use the registry to set up the + !! diagnostics associated with this tracer. + character(len=64) :: cmor_name !< CMOR name of this tracer + character(len=64) :: cmor_units !< CMOR physical dimensions of the tracer + character(len=240) :: cmor_longname !< CMOR long name of the tracer + character(len=32) :: flux_nameroot = "" !< Short tracer name snippet used construct the + !! names of flux diagnostics. + character(len=64) :: flux_longname = "" !< A word or phrase used construct the long + !! names of flux diagnostics. + real :: flux_scale = 1.0 !< A scaling factor used to convert the fluxes + !! of this tracer to its desired units, + !! including a factor compensating for H scaling. + character(len=48) :: flux_units = "" !< The units for fluxes of this variable. + character(len=48) :: conv_units = "" !< The units for the flux convergence of this tracer. + real :: conv_scale = 1.0 !< A scaling factor used to convert the flux + !! convergence of this tracer to its desired units, + !! including a factor compensating for H scaling. + character(len=48) :: cmor_tendprefix = "" !< The CMOR variable prefix for tendencies of this + !! tracer, required because CMOR does not follow any + !! discernable pattern for these names. + character(len=48) :: net_surfflux_name = "" !< Name to use for net_surfflux KPP diagnostic + character(len=48) :: NLT_budget_name = "" !< Name to use for NLT_budget KPP diagnostic + character(len=128) :: net_surfflux_longname = "" !< Long name to use for net_surfflux KPP diagnostic + integer :: ind_tr_squared = -1 !< The tracer registry index for the square of this tracer + + !### THESE CAPABILITIES HAVE NOT YET BEEN IMPLEMENTED. + ! logical :: advect_tr = .true. !< If true, this tracer should be advected + ! logical :: hordiff_tr = .true. !< If true, this tracer should experience epineutral diffusion + ! logical :: kpp_nonlocal_tr = .true. !< if true, apply KPP nonlocal transport to this tracer before diffusion + logical :: remap_tr = .true. !< If true, this tracer should be vertically remapped + + integer :: diag_form = 1 !< An integer indicating which template is to be used to label diagnostics. + !>@{ Diagnostic IDs + integer :: id_tr = -1, id_tr_post_horzn = -1 + integer :: id_adx = -1, id_ady = -1, id_dfx = -1, id_dfy = -1 + integer :: id_lbd_bulk_dfx = -1, id_lbd_bulk_dfy = -1, id_lbd_dfx = -1, id_lbd_dfy = -1 + integer :: id_lbd_dfx_2d = -1 , id_lbd_dfy_2d = -1 + integer :: id_adx_2d = -1, id_ady_2d = -1, id_dfx_2d = -1, id_dfy_2d = -1 + integer :: id_adv_xy = -1, id_adv_xy_2d = -1 + integer :: id_dfxy_cont = -1, id_dfxy_cont_2d = -1, id_dfxy_conc = -1 + integer :: id_lbdxy_cont = -1, id_lbdxy_cont_2d = -1, id_lbdxy_conc = -1 + integer :: id_remap_conc = -1, id_remap_cont = -1, id_remap_cont_2d = -1 + integer :: id_tendency = -1, id_trxh_tendency = -1, id_trxh_tendency_2d = -1 + integer :: id_tr_vardec = -1 + integer :: id_net_surfflux = -1, id_NLT_tendency = -1, id_NLT_budget = -1 + !>@} +end type tracer_type + +!> Type to carry basic tracer information +type, public :: tracer_registry_type + integer :: ntr = 0 !< number of registered tracers + type(tracer_type) :: Tr(MAX_FIELDS_) !< array of registered tracers +! type(diag_ctrl), pointer :: diag !< structure to regulate timing of diagnostics + logical :: locked = .false. !< New tracers may be registered if locked=.false. + !! When locked=.true., no more tracers can be registered, + !! at which point common diagnostics can be set up + !! for the registered tracers +end type tracer_registry_type + + +end module MOM_tracer_types diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index c441e519be..579751952c 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -10,13 +10,14 @@ module pseudo_salt_tracer use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type +use MOM_CVMix_KPP, only : KPP_NonLocalTransport, KPP_CS use MOM_hor_index, only : hor_index_type use MOM_io, only : vardesc, var_desc, query_vardesc use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type -use MOM_tracer_registry, only : register_tracer, tracer_registry_type +use MOM_tracer_registry, only : register_tracer, tracer_registry_type, tracer_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init use MOM_unit_scaling, only : unit_scale_type @@ -33,6 +34,7 @@ module pseudo_salt_tracer !> The control structure for the pseudo-salt tracer type, public :: pseudo_salt_tracer_CS ; private + type(tracer_type), pointer :: tr_ptr !< pointer to tracer inside Tr_reg type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry real, pointer :: ps(:,:,:) => NULL() !< The array of pseudo-salt tracer used in this @@ -96,7 +98,7 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, name="pseudo_salt", & longname="Pseudo salt passive tracer", units="psu", & registry_diags=.true., restart_CS=restart_CS, & - mandatory=.not.CS%pseudo_salt_may_reinit) + mandatory=.not.CS%pseudo_salt_may_reinit, Tr_out=CS%tr_ptr) CS%tr_Reg => tr_Reg CS%restart_CSp => restart_CS @@ -157,7 +159,7 @@ end subroutine initialize_pseudo_salt_tracer !> Apply sources, sinks and diapycnal diffusion to the tracers in this package. subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, tv, debug, & - evap_CFL_limit, minimum_forcing_depth) + KPP_CSp, nonLocalTrans, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -178,6 +180,8 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G !! call to register_pseudo_salt_tracer type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables logical, intent(in) :: debug !< If true calculate checksums + type(KPP_CS), optional, pointer :: KPP_CSp !< KPP control structure + real, optional, intent(in) :: nonLocalTrans(:,:,:) !< Non-local transport [nondim] real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which @@ -210,6 +214,14 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G call hchksum(CS%ps,"pseudo_salt pre pseudo-salt vertdiff", G%HI) endif + ! Compute KPP nonlocal term if necessary + if (present(KPP_CSp)) then + if (associated(KPP_CSp) .and. present(nonLocalTrans)) & + call KPP_NonLocalTransport(KPP_CSp, G, GV, h_old, nonLocalTrans, fluxes%KPP_salt_flux(:,:), & + dt, CS%diag, CS%tr_ptr, CS%ps(:,:,:)) + endif + + ! This uses applyTracerBoundaryFluxesInOut, usually in ALE mode if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then ! This option uses applyTracerBoundaryFluxesInOut, usually in ALE mode From 72daf7b0c3924fedffc1183545a672d514aba560 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 25 Mar 2022 15:06:29 -0600 Subject: [PATCH 28/38] Add option to receive enthalpy fluxes via coupler * Remove lrunoff_hflx and frunoff_hflx from the IOB type. These are never used; * mean_runoff_heat_flx and mean_calving_heat_flx are are never advertized, so these have been deleted; * If cesm_coupled=true, six new fields are imported: - heat_content_lprec - heat_content_fprec - heat_content_evap - heat_content_cond - heat_content_rofl - heat_content_rofi * Add a new parameter (ENTHALPY_FROM_COUPLER) to control if the enthalpy associated with mass entering/leaving the ocean is provided via the coupler or calculated in MOM6. --- config_src/drivers/nuopc_cap/mom_cap.F90 | 91 ++++++++++++++----- .../drivers/nuopc_cap/mom_cap_methods.F90 | 56 ++++++++++-- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 11 ++- .../nuopc_cap/mom_surface_forcing_nuopc.F90 | 61 +++++++++++-- 4 files changed, 174 insertions(+), 45 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 84c82da340..078314fd61 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -654,8 +654,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ocean_public%is_ocean_pe = .true. call ocean_model_init(ocean_public, ocean_state, time0, time_start, input_restart_file=trim(restartfiles)) - ! GMM, this call is not needed for NCAR. Check with EMC. - ! If this can be deleted, perhaps we should also delete ocean_model_flux_init + ! GMM, this call is not needed in CESM. Check with EMC if it can be deleted. call ocean_model_flux_init(ocean_state) call ocean_model_init_sfc(ocean_state, ocean_public) @@ -680,9 +679,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary% ice_fraction (isc:iec,jsc:jec), & Ice_ocean_boundary% u10_sqr (isc:iec,jsc:jec), & Ice_ocean_boundary% p (isc:iec,jsc:jec), & - Ice_ocean_boundary% lrunoff_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% frunoff_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% lrunoff (isc:iec,jsc:jec), & + Ice_ocean_boundary% lrunoff (isc:iec,jsc:jec), & Ice_ocean_boundary% frunoff (isc:iec,jsc:jec)) Ice_ocean_boundary%u_flux = 0.0 @@ -703,11 +700,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary%ice_fraction = 0.0 Ice_ocean_boundary%u10_sqr = 0.0 Ice_ocean_boundary%p = 0.0 - Ice_ocean_boundary%lrunoff_hflx = 0.0 - Ice_ocean_boundary%frunoff_hflx = 0.0 Ice_ocean_boundary%lrunoff = 0.0 Ice_ocean_boundary%frunoff = 0.0 + if (cesm_coupled) then + allocate (Ice_ocean_boundary% hrain (isc:iec,jsc:jec), & + Ice_ocean_boundary% hsnow (isc:iec,jsc:jec), & + Ice_ocean_boundary% hrofl (isc:iec,jsc:jec), & + Ice_ocean_boundary% hrofi (isc:iec,jsc:jec), & + Ice_ocean_boundary% hevap (isc:iec,jsc:jec), & + Ice_ocean_boundary% hcond (isc:iec,jsc:jec)) + + Ice_ocean_boundary%hrain = 0.0 + Ice_ocean_boundary%hsnow = 0.0 + Ice_ocean_boundary%hrofl = 0.0 + Ice_ocean_boundary%hrofi = 0.0 + Ice_ocean_boundary%hevap = 0.0 + Ice_ocean_boundary%hcond = 0.0 + endif + call query_ocean_state(ocean_state, use_waves=use_waves, wave_method=wave_method) if (use_waves) then if (wave_method == "EFACTOR") then @@ -756,9 +767,16 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") !-> wind^2 at 10m call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fresh_water_to_ocean_rate", "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "net_heat_flx_to_ocn" , "will provide") - !These are not currently used and changing requires a nuopc dictionary change - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") + + if (cesm_coupled) then + call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_lprec", "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_fprec", "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_evap" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_cond" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_rofl" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_rofi" , "will provide") + endif + if (use_waves) then if (wave_method == "EFACTOR") then call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") @@ -1663,7 +1681,8 @@ subroutine ModelAdvance(gcomp, rc) !--------------- if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") - call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) + call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled, & + cesm_coupled) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") !--------------- @@ -2388,7 +2407,7 @@ end subroutine shr_file_getLogUnit !! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a !! call into the MOM update routine: !! -!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) +!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled, cesm_coupled) !! !! Priori to the call to `update_ocean_model()`, the cap performs these steps !! - the `Time` and `Time_step_coupled` parameters, based on FMS types, are derived from the incoming ESMF clock @@ -2499,13 +2518,6 @@ end subroutine shr_file_getLogUnit !! !! !! -!! mean_calving_heat_flx -!! W m-2 -!! calving_hflx -!! heat flux, relative to 0C, of frozen land water into ocean -!! -!! -!! !! mean_calving_rate !! kg m-2 s-1 !! calving @@ -2576,10 +2588,45 @@ end subroutine shr_file_getLogUnit !! !! !! -!! mean_runoff_heat_flx +!! heat_content_lprec +!! W m-2 +!! hrain +!! heat content (enthalpy) of liquid water entering the ocean +!! +!! +!! +!! heat_content_fprec +!! W m-2 +!! hsnow +!! heat content (enthalpy) of frozen water entering the ocean +!! +!! +!! +!! heat_content_evap +!! W m-2 +!! hevap +!! heat content (enthalpy) of water leaving the ocean +!! +!! +!! +!! heat_content_cond +!! W m-2 +!! hcond +!! heat content (enthalpy) of liquid water entering the ocean due to condensation +!! +!! +!! +!! heat_content_rofl +!! W m-2 +!! hrofl +!! heat content (enthalpy) of liquid runoff +!! +!! +!! +!! heat_content_rofi !! W m-2 -!! runoff_hflx -!! heat flux, relative to 0C, of liquid land water into ocean +!! hrofi +!! heat content (enthalpy) of frozen runoff !! !! !! diff --git a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 b/config_src/drivers/nuopc_cap/mom_cap_methods.F90 index fc80900758..a87998398c 100644 --- a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap_methods.F90 @@ -217,17 +217,53 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, isc, iec, jsc, jec, ice_ocean_boundary%frunoff, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! heat content of lrunoff - ice_ocean_boundary%lrunoff_hflx(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_runoff_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%lrunoff_hflx, areacor=med2mod_areacor, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !---- + ! Enthalpy terms (only in CESM) + !---- + if (cesm_coupled) then + !---- + ! enthalpy from liquid precipitation (hrain) + !---- + call state_getimport(importState, 'heat_content_lprec', & + isc, iec, jsc, jec, ice_ocean_boundary%hrain, areacor=med2mod_areacor, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---- + ! enthalpy from frozen precipitation (hsnow) + !---- + call state_getimport(importState, 'heat_content_fprec', & + isc, iec, jsc, jec, ice_ocean_boundary%hsnow, areacor=med2mod_areacor, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---- + ! enthalpy from liquid runoff (hrofl) + !---- + call state_getimport(importState, 'heat_content_rofl', & + isc, iec, jsc, jec, ice_ocean_boundary%hrofl, areacor=med2mod_areacor, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---- + ! enthalpy from frozen runoff (hrofi) + !---- + call state_getimport(importState, 'heat_content_rofi', & + isc, iec, jsc, jec, ice_ocean_boundary%hrofi, areacor=med2mod_areacor, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---- + ! enthalpy from evaporation (hevap) + !---- + call state_getimport(importState, 'heat_content_evap', & + isc, iec, jsc, jec, ice_ocean_boundary%hevap, areacor=med2mod_areacor, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---- + ! enthalpy from condensation (hcond) + !---- + call state_getimport(importState, 'heat_content_cond', & + isc, iec, jsc, jec, ice_ocean_boundary%hcond, areacor=med2mod_areacor, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! heat content of frunoff - ice_ocean_boundary%frunoff_hflx(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_calving_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%frunoff_hflx, areacor=med2mod_areacor, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif !---- ! salt flux from ice diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 0563b38842..edab80ca8e 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -459,7 +459,7 @@ end subroutine ocean_model_init !! storing the new ocean properties in Ocean_state. subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & time_start_update, Ocean_coupling_time_step, & - update_dyn, update_thermo, Ocn_fluxes_used) + cesm_coupled, update_dyn, update_thermo, Ocn_fluxes_used) type(ice_ocean_boundary_type), & intent(in) :: Ice_ocean_boundary !< A structure containing the !! various forcing fields coming from the ice. @@ -474,6 +474,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & type(time_type), intent(in) :: time_start_update !< The time at the beginning of the update step. type(time_type), intent(in) :: Ocean_coupling_time_step !< The amount of time over !! which to advance the ocean. + logical, intent(in) :: cesm_coupled !< Flag to check if coupled with cesm logical, optional, intent(in) :: update_dyn !< If present and false, do not do updates !! due to the ocean dynamics. logical, optional, intent(in) :: update_thermo !< If present and false, do not do updates @@ -523,7 +524,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & do_dyn = .true. ; if (present(update_dyn)) do_dyn = update_dyn do_thermo = .true. ; if (present(update_thermo)) do_thermo = update_thermo - ! This is benign but not necessary if ocean_model_init_sfc was called or if ! OS%sfc_state%tr_fields was spawned in ocean_model_init. Consider removing it. is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec @@ -690,7 +690,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%Time, OS%diag, OS%forcing_CSp%handles) if (OS%fluxes%fluxes_used) then - call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%grid, OS%US, OS%Time, OS%diag, OS%forcing_CSp%handles) + if (cesm_coupled) then + call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%grid, OS%US, OS%Time, OS%diag, & + OS%forcing_CSp%handles, enthalpy=.true.) + else + call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%grid, OS%US, OS%Time, OS%diag, OS%forcing_CSp%handles) + endif endif ! Translate state into Ocean. diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index 421ada487f..5b2c7140c5 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -82,6 +82,8 @@ module MOM_surface_forcing_nuopc !! pressure limited by max_p_surf instead of the !! full atmospheric pressure. The default is true. logical :: use_CFC !< enables the MOM_CFC_cap tracer package. + logical :: enthalpy_cpl !< Controls if enthalpy terms are provided by the coupler or computed + !! internally. real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied !! from an input file. @@ -181,8 +183,12 @@ module MOM_surface_forcing_nuopc real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs [m/s] real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs[m2/m2] real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2) - real, pointer, dimension(:,:) :: lrunoff_hflx =>NULL() !< heat content of liquid runoff [W/m2] - real, pointer, dimension(:,:) :: frunoff_hflx =>NULL() !< heat content of frozen runoff [W/m2] + real, pointer, dimension(:,:) :: hrofl =>NULL() !< heat content from liquid runoff [W/m2] + real, pointer, dimension(:,:) :: hrofi =>NULL() !< heat content from frozen runoff [W/m2] + real, pointer, dimension(:,:) :: hrain =>NULL() !< heat content from liquid precipitation [W/m2] + real, pointer, dimension(:,:) :: hsnow =>NULL() !< heat content from frozen precipitation [W/m2] + real, pointer, dimension(:,:) :: hevap =>NULL() !< heat content from evaporation [W/m2] + real, pointer, dimension(:,:) :: hcond =>NULL() !< heat content from condensation [W/m2] real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere !< on ocean surface [Pa] real, pointer, dimension(:,:) :: ice_fraction =>NULL() !< fractional ice area [nondim] @@ -304,7 +310,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (fluxes%dt_buoy_accum < 0) then call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.true., & press=.true., fix_accum_bug=CS%fix_ustar_gustless_bug, & - cfc=CS%use_CFC) + cfc=CS%use_CFC, hevap=CS%enthalpy_cpl) call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) @@ -487,13 +493,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (associated(IOB%mass_berg)) & fluxes%mass_berg(i,j) = US%m_to_Z*US%kg_m3_to_R * IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%lrunoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = US%W_m2_to_QRZ_T * IOB%lrunoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%frunoff_hflx)) & - fluxes%heat_content_frunoff(i,j) = US%W_m2_to_QRZ_T * kg_m2_s_conversion * & - IOB%frunoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%lw_flux)) & fluxes%lw(i,j) = US%W_m2_to_QRZ_T * IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) @@ -544,6 +543,25 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, fluxes%sw(i,j) = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + & fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j) + ! enthalpy terms + if (associated(IOB%hrofl)) & + fluxes%heat_content_lrunoff(i,j) = US%W_m2_to_QRZ_T * IOB%hrofl(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%hrofi)) & + fluxes%heat_content_frunoff(i,j) = US%W_m2_to_QRZ_T * IOB%hrofi(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%hrain)) & + fluxes%heat_content_lprec(i,j) = US%W_m2_to_QRZ_T * IOB%hrain(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%hsnow)) & + fluxes%heat_content_fprec(i,j) = US%W_m2_to_QRZ_T * IOB%hsnow(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%hevap)) & + fluxes%heat_content_evap(i,j) = US%W_m2_to_QRZ_T * IOB%hevap(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%hcond)) & + fluxes%heat_content_cond(i,j) = US%W_m2_to_QRZ_T * IOB%hcond(i-i0,j-j0) * G%mask2dT(i,j) + ! sea ice fraction [nondim] if (associated(IOB%ice_fraction) .and. associated(fluxes%ice_fraction)) & fluxes%ice_fraction(i,j) = G%mask2dT(i,j) * IOB%ice_fraction(i-i0,j-j0) @@ -1201,6 +1219,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "USE_CFC_CAP", CS%use_CFC, & default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "ENTHALPY_FROM_COUPLER", CS%enthalpy_cpl, & + default=.false., do_not_log=.true.) + if (restore_salt) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes to the relative "//& @@ -1507,6 +1528,26 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) chks = field_chksum( iobt%mass_berg ) ; if (root) write(outunit,100) 'iobt%mass_berg ', chks endif + ! enthalpy + if (associated(iobt%hrofl)) then + chks = field_chksum( iobt%hrofl ) ; if (root) write(outunit,100) 'iobt%hrofl ', chks + endif + if (associated(iobt%hrofi)) then + chks = field_chksum( iobt%hrofi ) ; if (root) write(outunit,100) 'iobt%hrofi ', chks + endif + if (associated(iobt%hrain)) then + chks = field_chksum( iobt%hrain ) ; if (root) write(outunit,100) 'iobt%hrain ', chks + endif + if (associated(iobt%hsnow)) then + chks = field_chksum( iobt%hsnow ) ; if (root) write(outunit,100) 'iobt%hsnow ', chks + endif + if (associated(iobt%hevap)) then + chks = field_chksum( iobt%hevap ) ; if (root) write(outunit,100) 'iobt%hevap ', chks + endif + if (associated(iobt%hcond)) then + chks = field_chksum( iobt%hcond ) ; if (root) write(outunit,100) 'iobt%hcond ', chks + endif + 100 FORMAT(" CHECKSUM::",A20," = ",Z20) call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') From b7665f481bc6868d4a63c4ef3f76b2e90a42b39b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 25 Mar 2022 15:17:31 -0600 Subject: [PATCH 29/38] Heat conservation when enthalpy is via coupler * If fluxes%heat_content_evap is associated, which will only happens in CESM and when ENTHALPY_FROM_COUPLER=True, the heat contribution from mass entering/leaving the ocean is accounted for using the six enthalpy terms provided by the coupler: heat_content_evap, heat_content_lprec, heat_content_fprec, heat_content_cond, heat_content_lrunoff, and heat_content_frunoff. If fluxes%heat_content_evap is not associated, these terms are accounted for via tv%TempxPmE; * TODO: check that these changes do not change answers for GFDL. --- src/diagnostics/MOM_sum_output.F90 | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 668c297658..578d1ca88c 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -1008,7 +1008,14 @@ subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS) ! enddo ; enddo ; endif ! smg: old code - if (associated(tv%TempxPmE)) then + if (associated(fluxes%heat_content_evap)) then + do j=js,je ; do i=is,ie + heat_in(i,j) = heat_in(i,j) + dt * QRZL2_to_J * G%areaT(i,j) * & + (fluxes%heat_content_evap(i,j) + fluxes%heat_content_lprec(i,j) + & + fluxes%heat_content_cond(i,j) + fluxes%heat_content_fprec(i,j) + & + fluxes%heat_content_lrunoff(i,j) + fluxes%heat_content_frunoff(i,j)) + enddo ; enddo + elseif (associated(tv%TempxPmE)) then do j=js,je ; do i=is,ie heat_in(i,j) = heat_in(i,j) + (fluxes%C_p * QRZL2_to_J*G%areaT(i,j)) * tv%TempxPmE(i,j) enddo ; enddo From 7924fbaee6263056cf8f6eb47ce6d4bd333b80f5 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 28 Mar 2022 16:00:06 -0600 Subject: [PATCH 30/38] Modify log/description of ENTHALPY_FROM_COUPLER This commit change the description of parameter ENTHALPY_FROM_COUPLER, and it changes the call so that ENTHALPY_FROM_COUPLER is now logged at this point. --- config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index 5b2c7140c5..3ae7b7e337 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -1220,7 +1220,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, default=.false., do_not_log=.true.) call get_param(param_file, mdl, "ENTHALPY_FROM_COUPLER", CS%enthalpy_cpl, & - default=.false., do_not_log=.true.) + "If True, the heat (enthalpy) associated with mass entering/leaving the "//& + "ocean is provided via coupler.", default=.false.) if (restore_salt) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & From fc05abe214722c798a4c59c9cd9d24f98debb2e4 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 29 Mar 2022 15:17:19 -0600 Subject: [PATCH 31/38] Modifications needed for when enthalpy is via CPL * Introduces a new constant (EnthalpyConst = 1.0, by default) which is set to 0.0 when fluxes%heat_content_evap is associated. This constant is used in the expression that accounts for the temperature of the mass exchange (dTemp) to avoid double-couting for the enthalpy terms when they are provided via coupler. * Use heat_content_evap to determine if the diagostics heat_content_massin, heat_content_massout, and TempxPmE should be calculated. --- .../vertical/MOM_diabatic_aux.F90 | 50 +++++++++++-------- 1 file changed, 30 insertions(+), 20 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 13d25f06f5..ea7739450f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1031,7 +1031,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t real :: dThickness, dTemp, dSalt real :: fractionOfForcing, hOld, Ithickness real :: RivermixConst ! A constant used in implementing river mixing [R Z2 T-1 ~> Pa s]. - + real :: EnthalpyConst ! A constant used to control the enthalpy calculation + ! By default EnthalpyConst = 1.0. If fluxes%heat_content_evap + ! is associated enthalpy is provided via coupler and EnthalpyConst = 0.0. real, dimension(SZI_(G)) :: & d_pres, & ! pressure change across a layer [R L2 T-2 ~> Pa] p_lay, & ! average pressure in a layer [R L2 T-2 ~> Pa] @@ -1095,6 +1097,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! Only apply forcing if fluxes%sw is associated. if (.not.associated(fluxes%sw) .and. .not.calculate_energetics) return + EnthalpyConst = 1.0 + if (associated(fluxes%heat_content_evap)) EnthalpyConst = 0.0 + if (calculate_buoyancy) then SurfPressure(:) = 0.0 GoRho = US%L_to_Z**2*GV%g_Earth / GV%Rho0 @@ -1116,7 +1121,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t !$OMP nonPenSW,hGrounding,CS,Idt,aggregate_FW_forcing, & !$OMP minimum_forcing_depth,evap_CFL_limit,dt,EOSdom, & !$OMP calculate_buoyancy,netPen_rate,SkinBuoyFlux,GoRho, & - !$OMP calculate_energetics,dSV_dT,dSV_dS,cTKE,g_Hconv2) & + !$OMP calculate_energetics,dSV_dT,dSV_dS,cTKE,g_Hconv2, & + !$OMP EnthalpyConst) & !$OMP private(opacityBand,h2d,T2d,netMassInOut,netMassOut, & !$OMP netHeat,netSalt,Pen_SW_bnd,fractionOfForcing, & !$OMP IforcingDepthScale, & @@ -1258,17 +1264,19 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! This line accounts for the temperature of the mass exchange Temp_in = T2d(i,k) Salin_in = 0.0 - dTemp = dTemp + dThickness*Temp_in + dTemp = dTemp + dThickness*Temp_in*EnthalpyConst ! Diagnostics of heat content associated with mass fluxes - if (associated(fluxes%heat_content_massin)) & - fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & - T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt - if (associated(fluxes%heat_content_massout)) & - fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + & - T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt - if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & - T2d(i,k) * dThickness * GV%H_to_RZ + if (.not. associated(fluxes%heat_content_evap)) then + if (associated(fluxes%heat_content_massin)) & + fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & + T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt + if (associated(fluxes%heat_content_massout)) & + fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + & + T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt + if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & + T2d(i,k) * dThickness * GV%H_to_RZ + endif ! Determine the energetics of river mixing before updating the state. if (calculate_energetics .and. associated(fluxes%lrunoff) .and. CS%do_rivermix) then @@ -1341,17 +1349,19 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t netSalt(i) = netSalt(i) - dSalt ! This line accounts for the temperature of the mass exchange - dTemp = dTemp + dThickness*T2d(i,k) + dTemp = dTemp + dThickness*T2d(i,k)*EnthalpyConst ! Diagnostics of heat content associated with mass fluxes - if (associated(fluxes%heat_content_massin)) & - fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & - T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt - if (associated(fluxes%heat_content_massout)) & - fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + & - T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt - if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & - T2d(i,k) * dThickness * GV%H_to_RZ + if (.not. associated(fluxes%heat_content_evap)) then + if (associated(fluxes%heat_content_massin)) & + fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & + T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt + if (associated(fluxes%heat_content_massout)) & + fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + & + T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt + if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & + T2d(i,k) * dThickness * GV%H_to_RZ + endif ! Update state by the appropriate increment. hOld = h2d(i,k) ! Keep original thickness in hand From b9b67a8389a055f3598074c34f56828cdd9f3ec4 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 29 Mar 2022 15:26:41 -0600 Subject: [PATCH 32/38] Changes needed for when enthalpy is via coupler * Modify allocate_forcing_by_group so that heat_content_evap is allocated and heat_content_massin and heat_content_massout *are not* allocated when enthlapy terms are provided via coupler. This is done via optional argument (hevap); * Apply all modifications needed to include a new field in the flux type (heat_content_evap): rotate_array, deallocate, fluxes_accumulate, hchksum, and new diagnostics; * Modify forcing_diagnostics so that diagnostics are properly computed whether enthalpy terms are provided via coupler or computed by MOM6. This is done by introducing a logical variable mom_enthalpy (default = true, meaning dianostics are computed in the default way, using heat_content_massout). When then optional argument (enthalpy) is present and true, mom_enthalpy = false. In this case, diagnositcs are computed using heat_content_evap instead of heat_content_massout. * Deletes all entries associated with heat_content_icemelt. The enthalpy associated with the mass from sea ice formation/melting is already accounted for in field seaice_melt_heat. A note explaining this is also added. Subroutine extractFluxes1d: * When enthalpy terms are computed by MOM6, their contribution to the heat budget is accounted for in subroutine applyBoundaryFluxesInOut. On the other hand, when enthalpy terms are provided via coupler, they are included in net_heat in this subroutine; * By default the heat content from mass entering and leaving the ocean (enthalpy) is diagnosed in this subroutine. When heat_content_evap is associated, the enthalpy terms are provided via coupler and, therefore, they do not need to be computed again. A logical variable (do_enthalpy, deault = true) is introduced for this purposes. If luxes%heat_content_evap, do_enthalpy = false. --- src/core/MOM_forcing_type.F90 | 204 +++++++++++++++++++++------------- 1 file changed, 128 insertions(+), 76 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 1af57549f6..9d2759abf2 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -118,9 +118,8 @@ module MOM_forcing_type ! heat associated with water crossing ocean surface real, pointer, dimension(:,:) :: & heat_content_cond => NULL(), & !< heat content associated with condensating water [Q R Z T-1 ~> W m-2] + heat_content_evap => NULL(), & !< heat content associated with evaporating water [Q R Z T-1 ~> W m-2] heat_content_lprec => NULL(), & !< heat content associated with liquid >0 precip [Q R Z T-1 ~> W m-2] - heat_content_icemelt => NULL(), & !< heat content associated with snow and seaice - !! melt and formation [Q R Z T-1 ~> W m-2] heat_content_fprec => NULL(), & !< heat content associated with frozen precip [Q R Z T-1 ~> W m-2] heat_content_vprec => NULL(), & !< heat content associated with virtual >0 precip [Q R Z T-1 ~> W m-2] heat_content_lrunoff => NULL(), & !< heat content associated with liquid runoff [Q R Z T-1 ~> W m-2] @@ -312,10 +311,11 @@ module MOM_forcing_type integer :: id_heat_content_lrunoff= -1, id_heat_content_frunoff = -1 integer :: id_heat_content_lprec = -1, id_heat_content_fprec = -1 integer :: id_heat_content_cond = -1, id_heat_content_surfwater= -1 + integer :: id_heat_content_evap = -1 integer :: id_heat_content_vprec = -1, id_heat_content_massout = -1 integer :: id_heat_added = -1, id_heat_content_massin = -1 integer :: id_hfrainds = -1, id_hfrunoffds = -1 - integer :: id_seaice_melt_heat = -1, id_heat_content_icemelt = -1 + integer :: id_seaice_melt_heat = -1 ! global area integrated heat flux diagnostic handles integer :: id_total_net_heat_coupler = -1, id_total_net_heat_surface = -1 @@ -326,9 +326,10 @@ module MOM_forcing_type integer :: id_total_heat_content_lrunoff= -1, id_total_heat_content_frunoff = -1 integer :: id_total_heat_content_lprec = -1, id_total_heat_content_fprec = -1 integer :: id_total_heat_content_cond = -1, id_total_heat_content_surfwater= -1 + integer :: id_total_heat_content_evap = -1 integer :: id_total_heat_content_vprec = -1, id_total_heat_content_massout = -1 integer :: id_total_heat_added = -1, id_total_heat_content_massin = -1 - integer :: id_total_seaice_melt_heat = -1, id_total_heat_content_icemelt = -1 + integer :: id_total_seaice_melt_heat = -1 ! global area averaged heat flux diagnostic handles integer :: id_net_heat_coupler_ga = -1, id_net_heat_surface_ga = -1 @@ -469,6 +470,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & real :: I_Cp_Hconvert ! Unit conversion factors divided by the heat capacity ! [degC H R-1 Z-1 Q-1 ~> degC m3 J-1 or kg degC J-1] logical :: calculate_diags ! Indicate to calculate/update diagnostic arrays + logical :: do_enthalpy ! If true (default) enthalpy terms are computed in MOM6 character(len=200) :: mesg integer :: is, ie, nz, i, k, n @@ -488,6 +490,13 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & if (present(pen_sw_bnd_rate)) do_PSWBR = .true. !}BGR + ! GMM: by default heat content from mass entering and leaving the ocean (enthalpy) + ! is diagnosed in this subroutine. When heat_content_evap is associated, + ! the enthalpy terms are provided via coupler and, therefore, they do not need + ! to be computed again. + do_enthalpy = .true. + if (associated(fluxes%heat_content_evap)) do_enthalpy = .false. + Ih_limit = 0.0 ; if (FluxRescaleDepth > 0.0) Ih_limit = 1.0 / FluxRescaleDepth I_Cp = 1.0 / fluxes%C_p I_Cp_Hconvert = 1.0 / (GV%H_to_RZ * fluxes%C_p) @@ -598,7 +607,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! evap > 0 means condensating water is added into ocean. ! evap < 0 means evaporation of water from the ocean, in - ! which case heat_content_evap is computed in MOM_diabatic_driver.F90 + ! which case heat_content_massout is computed in MOM_diabatic_driver.F90 if (fluxes%evap(i,j) < 0.0) netMassOut(i) = netMassOut(i) + fluxes%evap(i,j) ! if (associated(fluxes%heat_content_cond)) fluxes%heat_content_cond(i,j) = 0.0 !??? --AJA @@ -624,6 +633,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! (H=m for Bouss, H=kg/m2 for non-Bouss) ! CIME provides heat flux from snow&ice melt (seaice_melt_heat), so this is added below + ! Note: this term accounts for the enthalpy associated with water flux due to sea ice melting/freezing if (associated(fluxes%seaice_melt_heat)) then net_heat(i) = scale * dt * I_Cp_Hconvert * & ( fluxes%sw(i,j) + (((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) + & @@ -696,6 +706,14 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! (fluxes%heat_content_cond(i,j) + fluxes%heat_content_vprec(i,j)))))) ! endif + ! When enthalpy terms are provided via coupler, they must be included in net_heat + if (.not. do_enthalpy) then + net_heat(i) = net_heat(i) + (scale * dt * I_Cp_Hconvert * & + (fluxes%heat_content_lrunoff(i,j) + fluxes%heat_content_frunoff(i,j) + & + fluxes%heat_content_lprec(i,j) + fluxes%heat_content_fprec(i,j) + & + fluxes%heat_content_evap(i,j) + fluxes%heat_content_cond(i,j))) + endif + if (fluxes%num_msg < fluxes%max_msg) then if (Pen_SW_tot(i) > 1.000001 * I_Cp_Hconvert*scale*dt*fluxes%sw(i,j)) then fluxes%num_msg = fluxes%num_msg + 1 @@ -732,7 +750,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & endif ! Diagnostics follow... - if (calculate_diags) then + if (calculate_diags .and. do_enthalpy) then ! Initialize heat_content_massin that is diagnosed in mixedlayer_convection or ! applyBoundaryFluxes such that the meaning is as the sum of all incoming components. @@ -790,15 +808,6 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & endif endif - ! Following lprec and fprec, water flux due to sea ice melt (seaice_melt) enters at SST - GMM - if (associated(fluxes%heat_content_icemelt)) then - if (fluxes%seaice_melt(i,j) > 0.0) then - fluxes%heat_content_icemelt(i,j) = fluxes%C_p*fluxes%seaice_melt(i,j)*T(i,1) - else - fluxes%heat_content_icemelt(i,j) = 0.0 - endif - endif - ! virtual precip associated with salinity restoring ! vprec > 0 means add water to ocean, assumed to be at SST ! vprec < 0 means remove water from ocean; set heat_content_vprec in MOM_diabatic_driver.F90 @@ -838,7 +847,31 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & endif endif - endif ! calculate_diags + elseif (.not. do_enthalpy) then + + ! virtual precip associated with salinity restoring. Heat content associated with + ! that is *not* provided by the coupler and must be calculated by MOM6. + ! vprec > 0 means add water to ocean, assumed to be at SST + ! vprec < 0 means remove water from ocean; set heat_content_vprec in MOM_diabatic_driver.F90 + if (associated(fluxes%heat_content_vprec)) then + if (fluxes%vprec(i,j) > 0.0) then + fluxes%heat_content_vprec(i,j) = fluxes%C_p*fluxes%vprec(i,j)*T(i,1) + else + fluxes%heat_content_vprec(i,j) = 0.0 + endif + endif + + if (associated(tv%TempxPmE)) then + tv%TempxPmE(i,j) = (I_Cp*dt*scale) * & + (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_evap(i,j) + & + fluxes%heat_content_cond(i,j)) + endif + + endif ! calculate_diags and do_enthalpy enddo ! i-loop @@ -1019,6 +1052,7 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: netSalt !< Net surface salt flux !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + ! local variables integer :: j @@ -1120,15 +1154,18 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) if (associated(fluxes%heat_content_fprec)) & call hchksum(fluxes%heat_content_fprec, mesg//" fluxes%heat_content_fprec", G%HI, & haloshift=hshift, scale=US%QRZ_T_to_W_m2) - if (associated(fluxes%heat_content_icemelt)) & - call hchksum(fluxes%heat_content_icemelt, mesg//" fluxes%heat_content_icemelt", G%HI, & - haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%heat_content_cond)) & call hchksum(fluxes%heat_content_cond, mesg//" fluxes%heat_content_cond", G%HI, & haloshift=hshift, scale=US%QRZ_T_to_W_m2) + if (associated(fluxes%heat_content_evap)) & + call hchksum(fluxes%heat_content_evap, mesg//" fluxes%heat_content_evap", G%HI, & + haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%heat_content_massout)) & call hchksum(fluxes%heat_content_massout, mesg//" fluxes%heat_content_massout", G%HI, & haloshift=hshift, scale=US%QRZ_T_to_W_m2) + if (associated(fluxes%heat_content_massin)) & + call hchksum(fluxes%heat_content_massin, mesg//" fluxes%heat_content_massin", G%HI, & + haloshift=hshift, scale=US%QRZ_T_to_W_m2) end subroutine MOM_forcing_chksum !> Write out chksums for the driving mechanical forces. @@ -1227,10 +1264,12 @@ subroutine forcing_SinglePointPrint(fluxes, G, i, j, mesg) call locMsg(fluxes%heat_content_frunoff,'heat_content_frunoff') call locMsg(fluxes%heat_content_lprec,'heat_content_lprec') call locMsg(fluxes%heat_content_fprec,'heat_content_fprec') - call locMsg(fluxes%heat_content_icemelt,'heat_content_icemelt') call locMsg(fluxes%heat_content_vprec,'heat_content_vprec') call locMsg(fluxes%heat_content_cond,'heat_content_cond') call locMsg(fluxes%heat_content_cond,'heat_content_massout') + call locMsg(fluxes%heat_content_evap,'heat_content_evap') + call locMsg(fluxes%heat_content_massout,'heat_content_massout') + call locMsg(fluxes%heat_content_massin,'heat_content_massin') contains !> Format and write a message depending on associated state of array @@ -1546,10 +1585,6 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, diag%axesT1,Time,'Heat content (relative to 0degC) of frozen prec entering ocean',& 'W m-2', conversion=US%QRZ_T_to_W_m2) - handles%id_heat_content_icemelt = register_diag_field('ocean_model', 'heat_content_icemelt',& - diag%axesT1,Time,'Heat content (relative to 0degC) of water flux due to sea ice melting/freezing',& - 'W m-2', conversion=US%QRZ_T_to_W_m2) - handles%id_heat_content_vprec = register_diag_field('ocean_model', 'heat_content_vprec', & diag%axesT1,Time,'Heat content (relative to 0degC) of virtual precip entering ocean',& 'W m-2', conversion=US%QRZ_T_to_W_m2) @@ -1558,6 +1593,10 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, diag%axesT1,Time,'Heat content (relative to 0degC) of water condensing into ocean',& 'W m-2', conversion=US%QRZ_T_to_W_m2) + handles%id_heat_content_evap = register_diag_field('ocean_model', 'heat_content_evap', & + diag%axesT1,Time,'Heat content (relative to 0degC) of water evaporating from ocean',& + 'W m-2', conversion=US%QRZ_T_to_W_m2) + handles%id_hfrainds = register_diag_field('ocean_model', 'hfrainds', & diag%axesT1,Time,'Heat content (relative to 0degC) of liquid+frozen precip entering ocean', & 'W m-2', conversion=US%QRZ_T_to_W_m2, & @@ -1689,11 +1728,6 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, long_name='Area integrated heat content (relative to 0C) of frozen precip',& units='W') - handles%id_total_heat_content_icemelt = register_scalar_field('ocean_model', & - 'total_heat_content_icemelt', Time, diag,long_name= & - 'Area integrated heat content (relative to 0C) of water flux due sea ice melting/freezing', & - units='W') - handles%id_total_heat_content_vprec = register_scalar_field('ocean_model', & 'total_heat_content_vprec', Time, diag, & long_name='Area integrated heat content (relative to 0C) of virtual precip',& @@ -1704,6 +1738,11 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, long_name='Area integrated heat content (relative to 0C) of condensate',& units='W') + handles%id_total_heat_content_evap = register_scalar_field('ocean_model', & + 'total_heat_content_evap', Time, diag, & + long_name='Area integrated heat content (relative to 0C) of evaporation',& + units='W') + handles%id_total_heat_content_surfwater = register_scalar_field('ocean_model', & 'total_heat_content_surfwater', Time, diag, & long_name='Area integrated heat content (relative to 0C) of water crossing surface',& @@ -2051,6 +2090,11 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces) fluxes%heat_content_cond(i,j) = wt1*fluxes%heat_content_cond(i,j) + wt2*flux_tmp%heat_content_cond(i,j) enddo ; enddo endif + if (associated(fluxes%heat_content_evap) .and. associated(flux_tmp%heat_content_evap)) then + do j=js,je ; do i=is,ie + fluxes%heat_content_evap(i,j) = wt1*fluxes%heat_content_evap(i,j) + wt2*flux_tmp%heat_content_evap(i,j) + enddo ; enddo + endif if (associated(fluxes%heat_content_lprec) .and. associated(flux_tmp%heat_content_lprec)) then do j=js,je ; do i=is,ie fluxes%heat_content_lprec(i,j) = wt1*fluxes%heat_content_lprec(i,j) + wt2*flux_tmp%heat_content_lprec(i,j) @@ -2061,11 +2105,6 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces) fluxes%heat_content_fprec(i,j) = wt1*fluxes%heat_content_fprec(i,j) + wt2*flux_tmp%heat_content_fprec(i,j) enddo ; enddo endif - if (associated(fluxes%heat_content_icemelt) .and. associated(flux_tmp%heat_content_icemelt)) then - do j=js,je ; do i=is,ie - fluxes%heat_content_icemelt(i,j) = wt1*fluxes%heat_content_icemelt(i,j) + wt2*flux_tmp%heat_content_icemelt(i,j) - enddo ; enddo - endif if (associated(fluxes%heat_content_vprec) .and. associated(flux_tmp%heat_content_vprec)) then do j=js,je ; do i=is,ie fluxes%heat_content_vprec(i,j) = wt1*fluxes%heat_content_vprec(i,j) + wt2*flux_tmp%heat_content_vprec(i,j) @@ -2081,11 +2120,6 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces) fluxes%heat_content_frunoff(i,j) = wt1*fluxes%heat_content_frunoff(i,j) + wt2*flux_tmp%heat_content_frunoff(i,j) enddo ; enddo endif - if (associated(fluxes%heat_content_icemelt) .and. associated(flux_tmp%heat_content_icemelt)) then - do j=js,je ; do i=is,ie - fluxes%heat_content_icemelt(i,j) = wt1*fluxes%heat_content_icemelt(i,j) + wt2*flux_tmp%heat_content_icemelt(i,j) - enddo ; enddo - endif if (associated(fluxes%ustar_shelf) .and. associated(flux_tmp%ustar_shelf)) then do i=isd,ied ; do j=jsd,jed @@ -2322,7 +2356,7 @@ end subroutine mech_forcing_diags !> Offer buoyancy forcing fields for diagnostics for those !! fields registered as part of register_forcing_type_diags. -subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, handles) +subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, handles, enthalpy) type(forcing), target, intent(in) :: fluxes_in !< A structure containing thermodynamic forcing fields type(surface), intent(in) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. @@ -2331,6 +2365,11 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h type(time_type), intent(in) :: time_end !< The end time of the diagnostic interval. type(diag_ctrl), intent(inout) :: diag !< diagnostic regulator type(forcing_diags), intent(inout) :: handles !< diagnostic ids + logical, optional, intent(in ) :: enthalpy !< If present and true, the heat content associated + !! with mass entering/leaving the ocean is provided + !! by the coupler. Diagnostics net_heat_surface and + !! heat_content_surfwater are computed using + !! heat_content_evap instead of heat_content_massout. ! local variables type(ocean_grid_type), pointer :: G ! Grid metric on model index map @@ -2342,10 +2381,14 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h real :: I_dt ! inverse time step [T-1 ~> s-1] real :: ppt2mks ! conversion between ppt and mks units [nondim] integer :: turns ! Number of index quarter turns + logical :: mom_enthalpy ! If true (default) enthalpy terms are computed in MOM6 integer :: i, j, is, ie, js, je call cpu_clock_begin(handles%id_clock_forcing) + mom_enthalpy = .true. + if (present(enthalpy)) mom_enthalpy = .not. enthalpy + ! NOTE: post_data expects data to be on the rotated index map, so any ! rotations must be applied before saving the output. turns = diag%G%HI%turns @@ -2565,13 +2608,6 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h call post_data(handles%id_total_heat_content_fprec, total_transport, diag) endif - if ((handles%id_heat_content_icemelt > 0) .and. associated(fluxes%heat_content_icemelt)) & - call post_data(handles%id_heat_content_icemelt, fluxes%heat_content_icemelt, diag) - if ((handles%id_total_heat_content_icemelt > 0) .and. associated(fluxes%heat_content_icemelt)) then - total_transport = global_area_integral(fluxes%heat_content_icemelt, G, scale=US%QRZ_T_to_W_m2) - call post_data(handles%id_total_heat_content_icemelt, total_transport, diag) - endif - if ((handles%id_heat_content_vprec > 0) .and. associated(fluxes%heat_content_vprec)) & call post_data(handles%id_heat_content_vprec, fluxes%heat_content_vprec, diag) if ((handles%id_total_heat_content_vprec > 0) .and. associated(fluxes%heat_content_vprec)) then @@ -2586,6 +2622,13 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h call post_data(handles%id_total_heat_content_cond, total_transport, diag) endif + if ((handles%id_heat_content_evap > 0) .and. associated(fluxes%heat_content_evap)) & + call post_data(handles%id_heat_content_evap, fluxes%heat_content_evap, diag) + if ((handles%id_total_heat_content_evap > 0) .and. associated(fluxes%heat_content_evap)) then + total_transport = global_area_integral(fluxes%heat_content_evap, G, scale=US%QRZ_T_to_W_m2) + call post_data(handles%id_total_heat_content_evap, total_transport, diag) + endif + if ((handles%id_heat_content_massout > 0) .and. associated(fluxes%heat_content_massout)) & call post_data(handles%id_heat_content_massout, fluxes%heat_content_massout, diag) if ((handles%id_total_heat_content_massout > 0) .and. associated(fluxes%heat_content_massout)) then @@ -2634,22 +2677,25 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h !if (associated(sfc_state%TempXpme)) then ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt !else - if (associated(fluxes%heat_content_lrunoff)) & - res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) - if (associated(fluxes%heat_content_frunoff)) & - res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) - if (associated(fluxes%heat_content_lprec)) & - res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) - if (associated(fluxes%heat_content_fprec)) & - res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) - if (associated(fluxes%heat_content_icemelt)) & - res(i,j) = res(i,j) + fluxes%heat_content_icemelt(i,j) - if (associated(fluxes%heat_content_vprec)) & - res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) - if (associated(fluxes%heat_content_cond)) & - res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) + if (associated(fluxes%heat_content_lrunoff)) & + res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) + if (associated(fluxes%heat_content_frunoff)) & + res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) + if (associated(fluxes%heat_content_lprec)) & + res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) + if (associated(fluxes%heat_content_fprec)) & + res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) + if (associated(fluxes%heat_content_vprec)) & + res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) + if (associated(fluxes%heat_content_cond)) & + res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) + if (mom_enthalpy) then if (associated(fluxes%heat_content_massout)) & res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) + else + if (associated(fluxes%heat_content_evap)) & + res(i,j) = res(i,j) + fluxes%heat_content_evap(i,j) + endif !endif if (associated(fluxes%heat_added)) res(i,j) = res(i,j) + fluxes%heat_added(i,j) enddo ; enddo @@ -2671,14 +2717,17 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h ! if (associated(sfc_state%TempXpme)) then ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt ! else - if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) - if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) - if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) - if (associated(fluxes%heat_content_icemelt)) res(i,j) = res(i,j) + fluxes%heat_content_icemelt(i,j) - if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) - if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) - if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) - if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) + if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) + if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) + if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) + if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) + if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) + if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) + if (mom_enthalpy) then + if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) + else + if (associated(fluxes%heat_content_evap)) res(i,j) = res(i,j) + fluxes%heat_content_evap(i,j) + endif ! endif enddo ; enddo if (handles%id_heat_content_surfwater > 0) call post_data(handles%id_heat_content_surfwater, res, diag) @@ -2926,7 +2975,8 @@ end subroutine forcing_diagnostics !> Conditionally allocate fields within the forcing type subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & - shelf, iceberg, salt, fix_accum_bug, cfc, waves, lamult) + shelf, iceberg, salt, fix_accum_bug, & + cfc, waves, lamult, hevap) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields logical, optional, intent(in) :: water !< If present and true, allocate water fluxes @@ -2941,6 +2991,9 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & logical, optional, intent(in) :: cfc !< If present and true, allocate cfc fluxes logical, optional, intent(in) :: waves !< If present and true, allocate wave fields logical, optional, intent(in) :: lamult !< If present and true, allocate langmuir enhancement factor + logical, optional, intent(in) :: hevap !< If present and true, allocate heat content evap. + !! This field must be allocated when enthalpy is provided + !! via coupler. ! Local variables integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -2974,14 +3027,14 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & if (present(heat) .and. present(water)) then ; if (heat .and. water) then call myAlloc(fluxes%heat_content_cond,isd,ied,jsd,jed, .true.) - call myAlloc(fluxes%heat_content_icemelt,isd,ied,jsd,jed, .true.) + call myAlloc(fluxes%heat_content_evap,isd,ied,jsd,jed, hevap) call myAlloc(fluxes%heat_content_lprec,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_fprec,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_vprec,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_lrunoff,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_frunoff,isd,ied,jsd,jed, .true.) - call myAlloc(fluxes%heat_content_massout,isd,ied,jsd,jed, .true.) - call myAlloc(fluxes%heat_content_massin,isd,ied,jsd,jed, .true.) + call myAlloc(fluxes%heat_content_massout,isd,ied,jsd,jed, .not. hevap) + call myAlloc(fluxes%heat_content_massin,isd,ied,jsd,jed, .not. hevap) endif ; endif call myAlloc(fluxes%p_surf,isd,ied,jsd,jed, press) @@ -3225,10 +3278,10 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%heat_added)) deallocate(fluxes%heat_added) if (associated(fluxes%heat_content_lrunoff)) deallocate(fluxes%heat_content_lrunoff) if (associated(fluxes%heat_content_frunoff)) deallocate(fluxes%heat_content_frunoff) - if (associated(fluxes%heat_content_icemelt)) deallocate(fluxes%heat_content_icemelt) if (associated(fluxes%heat_content_lprec)) deallocate(fluxes%heat_content_lprec) if (associated(fluxes%heat_content_fprec)) deallocate(fluxes%heat_content_fprec) if (associated(fluxes%heat_content_cond)) deallocate(fluxes%heat_content_cond) + if (associated(fluxes%heat_content_evap)) deallocate(fluxes%heat_content_evap) if (associated(fluxes%heat_content_massout)) deallocate(fluxes%heat_content_massout) if (associated(fluxes%heat_content_massin)) deallocate(fluxes%heat_content_massin) if (associated(fluxes%evap)) deallocate(fluxes%evap) @@ -3327,7 +3380,7 @@ subroutine rotate_forcing(fluxes_in, fluxes, turns) if (do_heat .and. do_water) then call rotate_array(fluxes_in%heat_content_cond, turns, fluxes%heat_content_cond) - call rotate_array(fluxes_in%heat_content_icemelt, turns, fluxes%heat_content_icemelt) + call rotate_array(fluxes_in%heat_content_evap, turns, fluxes%heat_content_evap) call rotate_array(fluxes_in%heat_content_lprec, turns, fluxes%heat_content_lprec) call rotate_array(fluxes_in%heat_content_fprec, turns, fluxes%heat_content_fprec) call rotate_array(fluxes_in%heat_content_vprec, turns, fluxes%heat_content_vprec) @@ -3572,7 +3625,6 @@ subroutine homogenize_forcing(fluxes, G) if (do_heat .and. do_water) then call homogenize_field_t(fluxes%heat_content_cond, G) - call homogenize_field_t(fluxes%heat_content_icemelt, G) call homogenize_field_t(fluxes%heat_content_lprec, G) call homogenize_field_t(fluxes%heat_content_fprec, G) call homogenize_field_t(fluxes%heat_content_vprec, G) From f81414708a294ae8965de5bf4fd9b537df50a7a5 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 29 Mar 2022 16:54:34 -0600 Subject: [PATCH 33/38] Add missing logical to control allocation of fluxes --- src/core/MOM_forcing_type.F90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 9d2759abf2..1217429791 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -2997,7 +2997,11 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & ! Local variables integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - logical :: heat_water + logical :: heat_water, enthalpy_mom + + ! if true, allocate fluxes needed to calculate enthalpy terms in MOM6 + enthalpy_mom = .true. + if (present (hevap)) enthalpy_mom = .not. hevap isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -3027,14 +3031,14 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & if (present(heat) .and. present(water)) then ; if (heat .and. water) then call myAlloc(fluxes%heat_content_cond,isd,ied,jsd,jed, .true.) - call myAlloc(fluxes%heat_content_evap,isd,ied,jsd,jed, hevap) + call myAlloc(fluxes%heat_content_evap,isd,ied,jsd,jed, .not. enthalpy_mom) call myAlloc(fluxes%heat_content_lprec,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_fprec,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_vprec,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_lrunoff,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_frunoff,isd,ied,jsd,jed, .true.) - call myAlloc(fluxes%heat_content_massout,isd,ied,jsd,jed, .not. hevap) - call myAlloc(fluxes%heat_content_massin,isd,ied,jsd,jed, .not. hevap) + call myAlloc(fluxes%heat_content_massout,isd,ied,jsd,jed, enthalpy_mom) + call myAlloc(fluxes%heat_content_massin,isd,ied,jsd,jed, enthalpy_mom) endif ; endif call myAlloc(fluxes%p_surf,isd,ied,jsd,jed, press) From fc3ab450b090c3d3d64a63370d6361d305d5dc65 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 29 Mar 2022 17:13:34 -0600 Subject: [PATCH 34/38] Avoid rotating arrays that are not associated --- src/core/MOM_forcing_type.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 1217429791..d4afabc2de 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -3384,14 +3384,17 @@ subroutine rotate_forcing(fluxes_in, fluxes, turns) if (do_heat .and. do_water) then call rotate_array(fluxes_in%heat_content_cond, turns, fluxes%heat_content_cond) - call rotate_array(fluxes_in%heat_content_evap, turns, fluxes%heat_content_evap) call rotate_array(fluxes_in%heat_content_lprec, turns, fluxes%heat_content_lprec) call rotate_array(fluxes_in%heat_content_fprec, turns, fluxes%heat_content_fprec) call rotate_array(fluxes_in%heat_content_vprec, turns, fluxes%heat_content_vprec) call rotate_array(fluxes_in%heat_content_lrunoff, turns, fluxes%heat_content_lrunoff) call rotate_array(fluxes_in%heat_content_frunoff, turns, fluxes%heat_content_frunoff) - call rotate_array(fluxes_in%heat_content_massout, turns, fluxes%heat_content_massout) - call rotate_array(fluxes_in%heat_content_massin, turns, fluxes%heat_content_massin) + if (associated (fluxes_in%heat_content_evap)) then + call rotate_array(fluxes_in%heat_content_evap, turns, fluxes%heat_content_evap) + else + call rotate_array(fluxes_in%heat_content_massout, turns, fluxes%heat_content_massout) + call rotate_array(fluxes_in%heat_content_massin, turns, fluxes%heat_content_massin) + endif endif if (do_press) then From 2cd228fbe369833506c9953eb82c4ef4d45961d0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 19 Apr 2022 09:51:09 -0600 Subject: [PATCH 35/38] Adds conditional for setting fluxes%heat_content_* * only writes fluxes%heat_content_* when ENTHALPY_FROM_COUPLER = True. --- .../nuopc_cap/mom_surface_forcing_nuopc.F90 | 26 ++++++++++--------- 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index 3ae7b7e337..69841bf84a 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -544,23 +544,25 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j) ! enthalpy terms - if (associated(IOB%hrofl)) & - fluxes%heat_content_lrunoff(i,j) = US%W_m2_to_QRZ_T * IOB%hrofl(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%enthalpy_cpl) then + if (associated(IOB%hrofl)) & + fluxes%heat_content_lrunoff(i,j) = US%W_m2_to_QRZ_T * IOB%hrofl(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%hrofi)) & - fluxes%heat_content_frunoff(i,j) = US%W_m2_to_QRZ_T * IOB%hrofi(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%hrofi)) & + fluxes%heat_content_frunoff(i,j) = US%W_m2_to_QRZ_T * IOB%hrofi(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%hrain)) & - fluxes%heat_content_lprec(i,j) = US%W_m2_to_QRZ_T * IOB%hrain(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%hrain)) & + fluxes%heat_content_lprec(i,j) = US%W_m2_to_QRZ_T * IOB%hrain(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%hsnow)) & - fluxes%heat_content_fprec(i,j) = US%W_m2_to_QRZ_T * IOB%hsnow(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%hsnow)) & + fluxes%heat_content_fprec(i,j) = US%W_m2_to_QRZ_T * IOB%hsnow(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%hevap)) & - fluxes%heat_content_evap(i,j) = US%W_m2_to_QRZ_T * IOB%hevap(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%hevap)) & + fluxes%heat_content_evap(i,j) = US%W_m2_to_QRZ_T * IOB%hevap(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%hcond)) & - fluxes%heat_content_cond(i,j) = US%W_m2_to_QRZ_T * IOB%hcond(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%hcond)) & + fluxes%heat_content_cond(i,j) = US%W_m2_to_QRZ_T * IOB%hcond(i-i0,j-j0) * G%mask2dT(i,j) + endif ! sea ice fraction [nondim] if (associated(IOB%ice_fraction) .and. associated(fluxes%ice_fraction)) & From 8f97b3d2f73f80ad4dd5c0ac30cca0c1fad8e435 Mon Sep 17 00:00:00 2001 From: Ian Grooms Date: Sat, 7 May 2022 12:00:36 -0600 Subject: [PATCH 36/38] Corrections to cell-averaged density computation (#213) * initial hooks for stochastic EOS modifications * remove debug statements * add documentation * Change ampltiude from 0.39 to sqrt(.39) * remove global_indexing logic from stoch_eos_init * switch to using MOM_random and add restart capability * update random sequence to update each each time-step * remove tseed0 from MOM_random (leftover from debugging) * Added necessary submodules and S^2, T^2 diagnostics to MOM_diagnostics * Added diagnostics for outputting variables related to the stochastic parameterization. * Diagnostics in MOM_PressureForce_FV updated for stochastic (rather than deterministic) Stanley SGS T variance parameterization. * Added parentheses for reproducibility. * Changed diagnostics to account for possible absence of stoch_eos_pattern in MOM_PressureForce_FV, when deterministic parameterization is on. * remove mom6_da_hooks and geoKdTree from pkg * add stochastic compoment to MOM_thickness_diffuse * fix array size declaration and post_data * Corrected indexing of loops in MOM_calc_varT * Changed how parameterization of SGS T variance (deterministic and stochastic) is switched on in PGF and thickness diffusion codes * Corrected a few typos * Cleaned up indices, redundant diagnostic, printing * Fixed diagnostic IDs * Fixed diagnostics typo * Corrected indices in calculation of tv%varT * Minor index fix * Corrected bug in pressure in Stanley diagnostics * Fixed whitespace error * Stoch eos clock (#5) *Added a clock for the Stanley parameterization Co-authored-by: jkenigson * add halo update to random pattern * Update MOM_stoch_eos.F90 Fix bug for looping over compute domain (is -> isc etc.) * Avoid unnessary computations on halo (MOM_stoch_eos) and code clean-up (MOM_thickness_diffuse) * Removed halo updates before determ param calc * Update MOM_stoch_eos.F90 Removed unnecessary code * Bug - indices are transposed * Changed Stanley stochastic coefficient from exp(X) to exp(aX) (#9) * Changed Stanley stochastic coefficient from exp(X) to exp(aX) * Extra spaces removed * Stoch eos init fix (#10) * Don't bother calculating tv%varT if stanley_coeff<0 * Missing then added * Merge Ian Grooms Tvar Discretization (#11) * Update MOM_stoch_eos.F90 In progress updating stencil for$ | dx \times \nabla T|^2$ calculation * New discretization of |dx\circ\nablaT|^2 Co-authored-by: Ian Grooms * Multiplied tvar%SGS by grid cell thickness ratio * Added limiter for tv%varT * Stoch eos ncar linear disc (#12) * Update MOM_stoch_eos.F90 In progress updating stencil for$ | dx \times \nabla T|^2$ calculation * New discretization of |dx\circ\nablaT|^2 * AR1 timescale land mask Adds land mask to the computation of the AR1 decorrelation time * Update dt in call to MOM_stoch_eos_run The call to `MOM_stoch_eos_run` (which time steps the noise) is from within `step_MOM_dynamics`. `step_MOM_dynamics` advances on time step `dt` (per line 957), but the noise is updated using `dt_thermo`. It seems more appropriate to update the noise using `dt`, since it gets called from within `step_MOM_dynamics`. * Fixed the units for r_sm_H * Remove vestigial declarations The variables `hl`, `Tl`, `mn_T`, `mn_T2`, and `r_sm_H` are no longer used, so I removed their declarations and an OMP private clause Co-authored-by: Ian Grooms * Update MOM_thickness_diffuse.F90 Changed index for soft convention * Update CVMix-src * Ensure use_varT, etc., initialized * Don't register stanley diagnostics if scheme is off * Stanley density second derivs at h pts (#15) * Change discretization of Stanley correction (drho_dT_dT at h points) * Limit Stanley noise, shrink limiting value * Revert t variance discretization * Reverted variable declarations * Stanley scheme in mixed_layer_restrat, vert_fill in stoch_eos, code cleanup (#19) * Test Stanley EOS param in mixed_layer_restrat * Fix size of TS cov, S var in Stanley calculate_density calls * Test move stanley scheme initialization * Added missing openMP directives * Revert Stanley tvar discretization (#18) * Perform vertical filling in calculation of T variance * Variable declaration syntax error, remove scaling from get_param * Fix call to vert_fill_TS * Code cleanup, whitespace cleanup Co-authored-by: Jessica Kenigson * Use Stanley (2020) variance; scheme off at coast * Comment clean-up * Remove factor of 0.5 in Tvar * Don't calculate Stanley diagnostics on halo * Change start indices in stanley_density_1d * Stanley param in MOM_isopycnal_slopes (#22) Stanley param in MOM_isopycnal_slopes and thickness diffuse index fix * Set eady flag to true if use_stored_slopes is true * Cleanup, docs, whitespace * Docs and whitespace * Docs and whitespace * Docs and whitespace * Whitespace cleanup * Whitespace cleanup * Clean up whitespace * Docs cleanup * use_stanley * Update MOM_lateral_mixing_coeffs.F90 * Adds link to another TEOS10 module * Set Stanley off for testing * Line continuation Co-authored-by: Phil Pegion <38869668+pjpegion@users.noreply.github.com> Co-authored-by: Philip Pegion Co-authored-by: Jessica Kenigson Co-authored-by: Jessica Kenigson Co-authored-by: jkenigson Co-authored-by: jskenigson Co-authored-by: Jessica Kenigson Co-authored-by: Jessica Kenigson Co-authored-by: Philip Pegion Co-authored-by: Jessica Kenigson --- .testing/tc2/MOM_input | 4 +- src/core/MOM.F90 | 22 +- src/core/MOM_PressureForce_FV.F90 | 109 ++++----- src/core/MOM_density_integrals.F90 | 37 +-- src/core/MOM_isopycnal_slopes.F90 | 72 +++++- src/core/MOM_stoch_eos.F90 | 212 ++++++++++++++++++ src/diagnostics/MOM_diagnostics.F90 | 37 ++- src/equation_of_state/MOM_EOS.F90 | 18 +- .../TEOS10/gsw_mod_error_functions.f90 | 1 + src/framework/MOM_random.F90 | 1 + .../lateral/MOM_lateral_mixing_coeffs.F90 | 9 +- .../lateral/MOM_mixed_layer_restrat.F90 | 34 ++- .../lateral/MOM_thickness_diffuse.F90 | 141 +++++------- 13 files changed, 515 insertions(+), 182 deletions(-) create mode 100644 src/core/MOM_stoch_eos.F90 create mode 120000 src/equation_of_state/TEOS10/gsw_mod_error_functions.f90 diff --git a/.testing/tc2/MOM_input b/.testing/tc2/MOM_input index ca84d1c382..c7d2a35aa6 100644 --- a/.testing/tc2/MOM_input +++ b/.testing/tc2/MOM_input @@ -297,7 +297,7 @@ BOUND_CORIOLIS = True ! [Boolean] default = False ! v-points, and similarly at v-points. This option would ! have no effect on the SADOURNY Coriolis scheme if it ! were possible to use centered difference thickness fluxes. -PGF_STANLEY_T2_DET_COEFF = 0.5 ! [nondim] default = -1.0 +PGF_STANLEY_T2_DET_COEFF = -1.0 ! [nondim] default = -1.0 ! The coefficient correlating SGS temperature variance with the mean temperature ! gradient in the deterministic part of the Stanley form of the Brankart ! correction. Negative values disable the scheme. @@ -430,7 +430,7 @@ KHTH = 1.0 ! [m2 s-1] default = 0.0 ! The background horizontal thickness diffusivity. KHTH_MAX = 900.0 ! [m2 s-1] default = 0.0 ! The maximum horizontal thickness diffusivity. -STANLEY_PRM_DET_COEFF = 0.5 ! [nondim] default = -1.0 +STANLEY_PRM_DET_COEFF = -1.0 ! [nondim] default = -1.0 ! The coefficient correlating SGS temperature variance with the mean temperature ! gradient in the deterministic part of the Stanley parameterization. Negative ! values disable the scheme. diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index e2e966e3b4..c14085c923 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -108,6 +108,7 @@ module MOM use MOM_shared_initialization, only : write_ocean_geometry_file use MOM_sponge, only : init_sponge_diags, sponge_CS use MOM_state_initialization, only : MOM_initialize_state +use MOM_stoch_eos, only : MOM_stoch_eos_init,MOM_stoch_eos_run,MOM_stoch_eos_CS,mom_calc_varT use MOM_sum_output, only : write_energy, accumulate_net_input use MOM_sum_output, only : MOM_sum_output_init, MOM_sum_output_end use MOM_sum_output, only : sum_output_CS @@ -242,6 +243,7 @@ module MOM logical :: use_ALE_algorithm !< If true, use the ALE algorithm rather than layered !! isopycnal/stacked shallow water mode. This logical is set by calling the !! function useRegridding() from the MOM_regridding module. + type(MOM_stoch_eos_CS) :: stoch_eos_CS !< structure containing random pattern for stoch EOS logical :: alternate_first_direction !< If true, alternate whether the x- or y-direction !! updates occur first in directionally split parts of the calculation. real :: first_dir_restart = -1.0 !< A real copy of G%first_direction for use in restart files @@ -444,6 +446,8 @@ module MOM integer :: id_clock_other integer :: id_clock_offline_tracer integer :: id_clock_unit_tests +integer :: id_clock_stoch +integer :: id_clock_varT !>@} contains @@ -1063,6 +1067,15 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & showCallTree = callTree_showQuery() call cpu_clock_begin(id_clock_dynamics) + call cpu_clock_begin(id_clock_stoch) + if (CS%stoch_eos_CS%use_stoch_eos) call MOM_stoch_eos_run(G,u,v,dt,Time_local,CS%stoch_eos_CS,CS%diag) + call cpu_clock_end(id_clock_stoch) + call cpu_clock_begin(id_clock_varT) + if (CS%stoch_eos_CS%stanley_coeff >= 0.0) then + call MOM_calc_varT(G,GV,h,CS%tv,CS%stoch_eos_CS,dt) + call pass_var(CS%tv%varT, G%Domain,clock=id_clock_pass,halo=1) + endif + call cpu_clock_end(id_clock_varT) if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse .and. CS%thickness_diffuse_first) then @@ -1229,6 +1242,9 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (IDs%id_u > 0) call post_data(IDs%id_u, u, CS%diag) if (IDs%id_v > 0) call post_data(IDs%id_v, v, CS%diag) if (IDs%id_h > 0) call post_data(IDs%id_h, h, CS%diag) + if (CS%stoch_eos_CS%id_stoch_eos > 0) call post_data(CS%stoch_eos_CS%id_stoch_eos, CS%stoch_eos_CS%pattern, CS%diag) + if (CS%stoch_eos_CS%id_stoch_phi > 0) call post_data(CS%stoch_eos_CS%id_stoch_phi, CS%stoch_eos_CS%phi, CS%diag) + if (CS%stoch_eos_CS%id_tvar_sgs > 0) call post_data(CS%stoch_eos_CS%id_tvar_sgs, CS%tv%varT, CS%diag) call disable_averaging(CS%diag) call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other) @@ -2765,6 +2781,8 @@ 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) + new_sim = is_new_run(restart_CSp) + call MOM_stoch_eos_init(G,Time,param_file,CS%stoch_eos_CS,restart_CSp,diag) if (CS%split) then allocate(eta(SZI_(G),SZJ_(G)), source=0.0) call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & @@ -2854,7 +2872,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif ! This subroutine initializes any tracer packages. - new_sim = is_new_run(restart_CSp) call tracer_flow_control_init(.not.new_sim, Time, G, GV, US, CS%h, param_file, & CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, & CS%ALE_sponge_CSp, CS%tv) @@ -3065,6 +3082,7 @@ subroutine register_diags(Time, G, GV, US, IDs, diag) v_extensive=.true.) IDs%id_ssh_inst = register_diag_field('ocean_model', 'SSH_inst', diag%axesT1, & Time, 'Instantaneous Sea Surface Height', 'm', conversion=US%Z_to_m) + end subroutine register_diags !> Set up CPU clock IDs for timing various subroutines. @@ -3097,6 +3115,8 @@ subroutine MOM_timing_init(CS) if (CS%offline_tracer_mode) then id_clock_offline_tracer = cpu_clock_id('Ocean offline tracers', grain=CLOCK_SUBCOMPONENT) endif + id_clock_stoch = cpu_clock_id('(Stochastic EOS)', grain=CLOCK_MODULE) + id_clock_varT = cpu_clock_id('(SGS Temperature Variance)', grain=CLOCK_MODULE) end subroutine MOM_timing_init diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 2a79486a5f..d50ce4b364 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -58,11 +58,12 @@ module MOM_PressureForce_FV integer :: Recon_Scheme !< Order of the polynomial of the reconstruction of T & S !! for the finite volume pressure gradient calculation. !! By the default (1) is for a piecewise linear method - real :: Stanley_T2_det_coeff !< The coefficient correlating SGS temperature variance with - !! the mean temperature gradient in the deterministic part of - !! the Stanley form of the Brankart correction. + + logical :: use_stanley_pgf !< If true, turn on Stanley parameterization in the PGF integer :: id_e_tidal = -1 !< Diagnostic identifier - integer :: id_tvar_sgs = -1 !< Diagnostic identifier + integer :: id_rho_pgf = -1 !< Diagnostic identifier + integer :: id_rho_stanley_pgf = -1 !< Diagnostic identifier + integer :: id_p_stanley = -1 !< Diagnostic identifier type(tidal_forcing_CS), pointer :: tides_CSp => NULL() !< Tides control structure end type PressureForce_FV_CS @@ -167,7 +168,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ if (.not.CS%initialized) call MOM_error(FATAL, & "MOM_PressureForce_FV_nonBouss: Module must be initialized before it is used.") - if (CS%Stanley_T2_det_coeff>=0.) call MOM_error(FATAL, & + if (CS%use_stanley_pgf) call MOM_error(FATAL, & "MOM_PressureForce_FV_nonBouss: The Stanley parameterization is not yet"//& "implemented in non-Boussinesq mode.") @@ -473,6 +474,13 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & S_t, S_b, T_t, T_b ! Top and bottom edge values for linear reconstructions ! of salinity and temperature within each layer. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + rho_pgf, rho_stanley_pgf ! Density [kg m-3] from EOS with and without SGS T variance + ! in Stanley parameterization. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + p_stanley ! Pressure [Pa] estimated with Rho_0 + real :: rho_stanley_scalar ! Scalar quantity to hold density [kg m-3] in Stanley diagnostics. + real :: p_stanley_scalar ! Scalar quantity to hold pressure [Pa] in Stanley diagnostics. real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). @@ -487,11 +495,6 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. - real :: Tl(5) ! copy and T in local stencil [degC] - real :: mn_T ! mean of T in local stencil [degC] - real :: mn_T2 ! mean of T**2 in local stencil [degC2] - real :: hl(5) ! Copy of local stencil of H [H ~> m] - real :: r_sm_H ! Reciprocal of sum of H in local stencil [H-1 ~> m-1] real, parameter :: C1_6 = 1.0/6.0 integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb @@ -511,49 +514,6 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm use_ALE = .false. if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS - if (CS%Stanley_T2_det_coeff>=0.) then - if (.not. associated(tv%varT)) call safe_alloc_ptr(tv%varT, G%isd, G%ied, G%jsd, G%jed, GV%ke) - do k=1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - ! Strictly speaking we should estimate the *horizontal* grid-scale variance - ! but neither of the following blocks make a rotation to the horizontal - ! and instead work along coordinate. - - ! This block calculates a simple |delta T| along coordinates and does - ! not allow vanishing layer thicknesses or layers tracking topography - !! SGS variance in i-direction [degC2] - !dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( tv%T(i+1,j,k) - tv%T(i,j,k) ) & - ! + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( tv%T(i,j,k) - tv%T(i-1,j,k) ) & - ! ) * G%dxT(i,j) * 0.5 )**2 - !! SGS variance in j-direction [degC2] - !dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( tv%T(i,j+1,k) - tv%T(i,j,k) ) & - ! + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( tv%T(i,j,k) - tv%T(i,j-1,k) ) & - ! ) * G%dyT(i,j) * 0.5 )**2 - !tv%varT(i,j,k) = CS%Stanley_T2_det_coeff * 0.5 * ( dTdi2 + dTdj2 ) - - ! This block does a thickness weighted variance calculation and helps control for - ! extreme gradients along layers which are vanished against topography. It is - ! still a poor approximation in the interior when coordinates are strongly tilted. - hl(1) = h(i,j,k) * G%mask2dT(i,j) - hl(2) = h(i-1,j,k) * G%mask2dCu(I-1,j) - hl(3) = h(i+1,j,k) * G%mask2dCu(I,j) - hl(4) = h(i,j-1,k) * G%mask2dCv(i,J-1) - hl(5) = h(i,j+1,k) * G%mask2dCv(i,J) - r_sm_H = 1. / ( ( hl(1) + ( ( hl(2) + hl(3) ) + ( hl(4) + hl(5) ) ) ) + GV%H_subroundoff ) - ! Mean of T - Tl(1) = tv%T(i,j,k) ; Tl(2) = tv%T(i-1,j,k) ; Tl(3) = tv%T(i+1,j,k) - Tl(4) = tv%T(i,j-1,k) ; Tl(5) = tv%T(i,j+1,k) - mn_T = ( hl(1)*Tl(1) + ( ( hl(2)*Tl(2) + hl(3)*Tl(3) ) + ( hl(4)*Tl(4) + hl(5)*Tl(5) ) ) ) * r_sm_H - ! Adjust T vectors to have zero mean - Tl(:) = Tl(:) - mn_T ; mn_T = 0. - ! Variance of T - mn_T2 = ( hl(1)*Tl(1)*Tl(1) + ( ( hl(2)*Tl(2)*Tl(2) + hl(3)*Tl(3)*Tl(3) ) & - + ( hl(4)*Tl(4)*Tl(4) + hl(5)*Tl(5)*Tl(5) ) ) ) * r_sm_H - ! Variance should be positive but round-off can violate this. Calculating - ! variance directly would fix this but requires more operations. - tv%varT(i,j,k) = CS%Stanley_T2_det_coeff * max(0., mn_T2) - enddo ; enddo ; enddo - endif - h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0 / GV%Rho0 @@ -690,7 +650,6 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm do k=1,nz ! Calculate 4 integrals through the layer that are required in the ! subsequent calculation. - if (use_EOS) then ! The following routine computes the integrals that are needed to ! calculate the pressure gradient force. Linear profiles for T and S are @@ -701,13 +660,13 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, & rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, & - G%HI, GV, tv%eqn_of_state, US, dpa, intz_dpa, intx_dpa, inty_dpa, & + G%HI, GV, tv%eqn_of_state, US, CS%use_stanley_pgf, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp=CS%useMassWghtInterp, & use_inaccurate_form=CS%use_inaccurate_pgf_rho_anom, Z_0p=G%Z_ref) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, & - G%HI, GV, tv%eqn_of_state, US, dpa, intz_dpa, intx_dpa, inty_dpa, & + G%HI, GV, tv%eqn_of_state, US, CS%use_stanley_pgf, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp=CS%useMassWghtInterp, Z_0p=G%Z_ref) endif else @@ -797,8 +756,26 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm endif endif + if (CS%use_stanley_pgf) then + do j=js,je ; do i=is,ie ; + p_stanley_scalar=0.0 + do k=1, nz + p_stanley_scalar = p_stanley_scalar + 0.5 * h(i,j,k) * GV%H_to_Pa !Pressure at mid-point of layer + call calculate_density(tv%T(i,j,k), tv%S(i,j,k), p_stanley_scalar, 0.0, 0.0, 0.0, & + rho_stanley_scalar, tv%eqn_of_state) + rho_pgf(i,j,k) = rho_stanley_scalar + call calculate_density(tv%T(i,j,k), tv%S(i,j,k), p_stanley_scalar, tv%varT(i,j,k), 0.0, 0.0, & + rho_stanley_scalar, tv%eqn_of_state) + rho_stanley_pgf(i,j,k) = rho_stanley_scalar + p_stanley(i,j,k) = p_stanley_scalar + p_stanley_scalar = p_stanley_scalar + 0.5 * h(i,j,k) * GV%H_to_Pa !Pressure at bottom of layer + enddo; enddo; enddo + endif + if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) - if (CS%id_tvar_sgs>0) call post_data(CS%id_tvar_sgs, tv%varT, CS%diag) + if (CS%id_rho_pgf>0) call post_data(CS%id_rho_pgf, rho_pgf, CS%diag) + if (CS%id_rho_stanley_pgf>0) call post_data(CS%id_rho_stanley_pgf, rho_stanley_pgf, CS%diag) + if (CS%id_p_stanley>0) call post_data(CS%id_p_stanley, p_stanley, CS%diag) end subroutine PressureForce_FV_Bouss @@ -859,14 +836,16 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS "boundary cells is extrapolated, rather than using PCM "//& "in these cells. If true, the same order polynomial is "//& "used as is used for the interior cells.", default=.true.) - call get_param(param_file, mdl, "PGF_STANLEY_T2_DET_COEFF", CS%Stanley_T2_det_coeff, & - "The coefficient correlating SGS temperature variance with "// & - "the mean temperature gradient in the deterministic part of "// & - "the Stanley form of the Brankart correction. "// & - "Negative values disable the scheme.", units="nondim", default=-1.0) - if (CS%Stanley_T2_det_coeff>=0.) then - CS%id_tvar_sgs = register_diag_field('ocean_model', 'tvar_sgs_pgf', diag%axesTL, & - Time, 'SGS temperature variance used in PGF', 'degC2') + call get_param(param_file, mdl, "USE_STANLEY_PGF", CS%use_stanley_pgf, & + "If true, turn on Stanley SGS T variance parameterization "// & + "in PGF code.", default=.false.) + if (CS%use_stanley_pgf) then + CS%id_rho_pgf = register_diag_field('ocean_model', 'rho_pgf', diag%axesTL, & + Time, 'rho in PGF', 'kg m3') + CS%id_rho_stanley_pgf = register_diag_field('ocean_model', 'rho_stanley_pgf', diag%axesTL, & + Time, 'rho in PGF with Stanley correction', 'kg m3') + CS%id_p_stanley = register_diag_field('ocean_model', 'p_stanley', diag%axesTL, & + Time, 'p in PGF with Stanley correction', 'Pa') endif if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index 8f26918253..c4420e0541 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -338,7 +338,7 @@ end subroutine int_density_dz_generic_pcm !> Compute pressure gradient force integrals by quadrature for the case where !! T and S are linear profiles. subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & - rho_0, G_e, dz_subroundoff, bathyT, HI, GV, EOS, US, dpa, & + rho_0, G_e, dz_subroundoff, bathyT, HI, GV, EOS, US, use_stanley_eos, dpa, & intz_dpa, intx_dpa, inty_dpa, useMassWghtInterp, & use_inaccurate_form, Z_0p) integer, intent(in) :: k !< Layer index to calculate integrals for @@ -365,6 +365,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m] type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + logical, intent(in) :: use_stanley_eos !< If true, turn on Stanley SGS T variance parameterization real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly across the layer [R L2 T-2 ~> Pa] real, dimension(SZI_(HI),SZJ_(HI)), & @@ -436,7 +437,6 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & real :: hWght ! A topographically limited thickness weight [Z ~> m] real :: hL, hR ! Thicknesses to the left and right [Z ~> m] real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2] - logical :: use_stanley_eos ! True is SGS variance fields exist in tv. logical :: use_rho_ref ! Pass rho_ref to the equation of state for more accurate calculation ! of density anomalies. logical :: use_varT, use_varS, use_covarTS ! Logicals for SGS variances fields @@ -459,10 +459,15 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & if (use_inaccurate_form) use_rho_ref = .not. use_inaccurate_form endif - use_varT = associated(tv%varT) - use_covarTS = associated(tv%covarTS) - use_varS = associated(tv%varS) - use_stanley_eos = use_varT .or. use_covarTS .or. use_varS + use_varT = .false. !ensure initialized + use_covarTS = .false. + use_varS = .false. + if (use_stanley_eos) then + use_varT = associated(tv%varT) + use_covarTS = associated(tv%covarTS) + use_varS = associated(tv%varS) + endif + T25(:) = 0. TS5(:) = 0. S25(:) = 0. @@ -489,7 +494,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & if (use_covarTS) TS5(i*5+1:i*5+5) = tv%covarTS(i,j,k) if (use_varS) S25(i*5+1:i*5+5) = tv%varS(i,j,k) enddo - if (use_Stanley_eos) then + if (use_stanley_eos) then if (rho_scale /= 1.0) then call calculate_density(T5, S5, p5, T25, TS5, S25, r5, 1, (ieq-isq+2)*5, EOS, & rho_ref=rho_ref_mks, scale=rho_scale) @@ -781,7 +786,7 @@ end subroutine int_density_dz_generic_plm !> Compute pressure gradient force integrals for layer "k" and the case where T and S !! are parabolic profiles subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & - rho_ref, rho_0, G_e, dz_subroundoff, bathyT, HI, GV, EOS, US, & + rho_ref, rho_0, G_e, dz_subroundoff, bathyT, HI, GV, EOS, US, use_stanley_eos, & dpa, intz_dpa, intx_dpa, inty_dpa, useMassWghtInterp, Z_0p) integer, intent(in) :: k !< Layer index to calculate integrals for type(hor_index_type), intent(in) :: HI !< Ocean horizontal index structures for the input arrays @@ -807,6 +812,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m] type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + logical, intent(in) :: use_stanley_eos !< If true, turn on Stanley SGS T variance parameterization real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly across the layer [R L2 T-2 ~> Pa] real, dimension(SZI_(HI),SZJ_(HI)), & @@ -868,7 +874,6 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2] integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n logical :: use_PPM ! If false, assume zero curvature in reconstruction, i.e. PLM - logical :: use_stanley_eos ! True is SGS variance fields exist in tv. logical :: use_varT, use_varS, use_covarTS Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB @@ -888,10 +893,15 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & t6 = 0. use_PPM = .true. ! This is a place-holder to allow later re-use of this function - use_varT = associated(tv%varT) - use_covarTS = associated(tv%covarTS) - use_varS = associated(tv%varS) - use_stanley_eos = use_varT .or. use_covarTS .or. use_varS + use_varT = .false. !ensure initialized + use_covarTS = .false. + use_varS = .false. + if (use_stanley_eos) then + use_varT = associated(tv%varT) + use_covarTS = associated(tv%covarTS) + use_varS = associated(tv%varS) + endif + T25(:) = 0. TS5(:) = 0. S25(:) = 0. @@ -1003,7 +1013,6 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & S5(n) = wt_t(n) * S_top + wt_b(n) * ( S_bot + s6 * wt_t(n) ) T5(n) = wt_t(n) * T_top + wt_b(n) * ( T_bot + t6 * wt_t(n) ) enddo - if (use_stanley_eos) then if (use_varT) T25(:) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i+1,j,k) if (use_covarTS) TS5(:) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i+1,j,k) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 80d94ec7fe..27a2217413 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -8,6 +8,7 @@ module MOM_isopycnal_slopes use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density_derivs +use MOM_EOS, only : calculate_density_second_derivs use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S @@ -26,7 +27,7 @@ module MOM_isopycnal_slopes !> Calculate isopycnal slopes, and optionally return other stratification dependent functions such as N^2 !! and dz*S^2*g-prime used, or calculable from factors used, during the calculation. -subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & +subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stanley, & slope_x, slope_y, N2_u, N2_v, dzu, dzv, dzSxN, dzSyN, halo, OBC) !, eta_to_m) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -38,6 +39,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & !! thermodynamic variables real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity !! times a smoothing timescale [Z2 ~> m2]. + logical, intent(in) :: use_stanley !< turn on stanley param in slope real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: slope_x !< Isopycnal slope in i-dir [Z L-1 ~> nondim] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: slope_y !< Isopycnal slope in j-dir [Z L-1 ~> nondim] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), & @@ -70,12 +72,15 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! Rho ! Density itself, when a nonlinear equation of state is not in use [R ~> kg m-3]. real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: & pres ! The pressure at an interface [R L2 T-2 ~> Pa]. + real, dimension(SZI_(G)) :: scrap ! An array to pass to calculate_density_second_derivs() that will be ingored. real, dimension(SZIB_(G)) :: & drho_dT_u, & ! The derivative of density with temperature at u points [R degC-1 ~> kg m-3 degC-1]. drho_dS_u ! The derivative of density with salinity at u points [R ppt-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)) :: & drho_dT_v, & ! The derivative of density with temperature at v points [R degC-1 ~> kg m-3 degC-1]. - drho_dS_v ! The derivative of density with salinity at v points [R ppt-1 ~> kg m-3 ppt-1]. + drho_dS_v, & ! The derivative of density with salinity at v points [R ppt-1 ~> kg m-3 ppt-1]. + drho_dT_dT_h, & ! The second derivative of density with temperature at h points [R degC-2 ~> kg m-3 degC-2] + drho_dT_dT_hr ! The second derivative of density with temperature at h (+1) points [R degC-2 ~> kg m-3 degC-2] 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]. @@ -84,6 +89,13 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & T_v, & ! Temperature on the interface at the v-point [degC]. S_v, & ! Salinity on the interface at the v-point [ppt]. pres_v ! Pressure on the interface at the v-point [R L2 T-2 ~> Pa]. + real, dimension(SZI_(G)) :: & + T_h, & ! Temperature on the interface at the h-point [degC]. + S_h, & ! Salinity on the interface at the h-point [ppt] + pres_h, & ! Pressure on the interface at the h-point [R L2 T-2 ~> Pa]. + T_hr, & ! Temperature on the interface at the h (+1) point [degC]. + S_hr, & ! Salinity on the interface at the h (+1) point [ppt] + pres_hr ! Pressure on the interface at the h (+1) point [R L2 T-2 ~> Pa]. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below (B) the ! interface times the grid spacing [R ~> kg m-3]. @@ -215,9 +227,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv,h,e, & !$OMP h_neglect,dz_neglect,Z_to_L,L_to_Z,H_to_Z,h_neglect2, & !$OMP present_N2_u,G_Rho0,N2_u,slope_x,dzSxN,EOSdom_u,local_open_u_BC, & - !$OMP dzu,OBC) & + !$OMP dzu,OBC,use_stanley) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & + !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & !$OMP drdx,mag_grad2,slope,slope2_Ratio,l_seg) do j=js,je ; do K=nz,2,-1 @@ -237,6 +250,19 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & tv%eqn_of_state, EOSdom_u) endif + if (use_stanley) then + do i=is-1,ie+1 + pres_h(i) = pres(i,j,K) + T_h(i) = 0.5*(T(i,j,k) + T(i,j,k-1)) + S_h(i) = 0.5*(S(i,j,k) + S(i,j,k-1)) + enddo + ! The second line below would correspond to arguments + ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & + call calculate_density_second_derivs(T_h, S_h, pres_h, & + scrap, scrap, drho_dT_dT_h, scrap, scrap, & + is-1, ie-is+3, tv%eqn_of_state) + endif + do I=is-1,ie if (use_EOS) then ! Estimate the horizontal density gradients along layers. @@ -251,7 +277,14 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & drdkR = (drho_dT_u(I) * (T(i+1,j,k)-T(i+1,j,k-1)) + & drho_dS_u(I) * (S(i+1,j,k)-S(i+1,j,k-1))) endif - + if (use_stanley) then + ! Correction to the horizontal density gradient due to nonlinearity in + ! the EOS rectifying SGS temperature anomalies + drdiA = drdiA + 0.5 * ((drho_dT_dT_h(i+1) * tv%varT(i+1,j,k-1)) - & + (drho_dT_dT_h(i) * tv%varT(i,j,k-1)) ) + drdiB = drdiB + 0.5 * ((drho_dT_dT_h(i+1) * tv%varT(i+1,j,k)) - & + (drho_dT_dT_h(i) * tv%varT(i,j,k)) ) + endif hg2A = h(i,j,k-1)*h(i+1,j,k-1) + h_neglect2 hg2B = h(i,j,k)*h(i+1,j,k) + h_neglect2 @@ -325,9 +358,11 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv, & !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & !$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y,dzSyN,EOSdom_v, & - !$OMP dzv,local_open_v_BC,OBC) & + !$OMP dzv,local_open_v_BC,OBC,use_stanley) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & + !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h, & + !$OMP drho_dT_dT_hr,pres_hr,T_hr,S_hr, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & !$OMP drdy,mag_grad2,slope,slope2_Ratio,l_seg) do j=js-1,je ; do K=nz,2,-1 @@ -345,6 +380,25 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, drho_dS_v, tv%eqn_of_state, & EOSdom_v) endif + if (use_stanley) then + do i=is,ie + pres_h(i) = pres(i,j,K) + T_h(i) = 0.5*(T(i,j,k) + T(i,j,k-1)) + S_h(i) = 0.5*(S(i,j,k) + S(i,j,k-1)) + + pres_hr(i) = pres(i,j+1,K) + T_hr(i) = 0.5*(T(i,j+1,k) + T(i,j+1,k-1)) + S_hr(i) = 0.5*(S(i,j+1,k) + S(i,j+1,k-1)) + enddo + ! The second line below would correspond to arguments + ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & + call calculate_density_second_derivs(T_h, S_h, pres_h, & + scrap, scrap, drho_dT_dT_h, scrap, scrap, & + is, ie-is+1, tv%eqn_of_state) + call calculate_density_second_derivs(T_hr, S_hr, pres_hr, & + scrap, scrap, drho_dT_dT_hr, scrap, scrap, & + is, ie-is+1, tv%eqn_of_state) + endif do i=is,ie if (use_EOS) then ! Estimate the horizontal density gradients along layers. @@ -359,6 +413,14 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & drdkR = (drho_dT_v(i) * (T(i,j+1,k)-T(i,j+1,k-1)) + & drho_dS_v(i) * (S(i,j+1,k)-S(i,j+1,k-1))) endif + if (use_stanley) then + ! Correction to the horizontal density gradient due to nonlinearity in + ! the EOS rectifying SGS temperature anomalies + drdjA = drdjA + 0.5 * ((drho_dT_dT_hr(i) * tv%varT(i,j+1,k-1)) - & + (drho_dT_dT_h(i) * tv%varT(i,j,k-1)) ) + drdjB = drdjB + 0.5 * ((drho_dT_dT_hr(i) * tv%varT(i,j+1,k)) - & + (drho_dT_dT_h(i) * tv%varT(i,j,k)) ) + endif hg2A = h(i,j,k-1)*h(i,j+1,k-1) + h_neglect2 hg2B = h(i,j,k)*h(i,j+1,k) + h_neglect2 diff --git a/src/core/MOM_stoch_eos.F90 b/src/core/MOM_stoch_eos.F90 new file mode 100644 index 0000000000..0ee6d6b1be --- /dev/null +++ b/src/core/MOM_stoch_eos.F90 @@ -0,0 +1,212 @@ +!> Provides the ocean stochastic equation of state +module MOM_stoch_eos +! This file is part of MOM6. See LICENSE.md for the license. +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_file_parser, only : get_param, param_file_type +use MOM_random, only : PRNG,random_2d_constructor,random_2d_norm +use MOM_time_manager, only : time_type +use MOM_io, only : vardesc, var_desc +use MOM_restart, only : MOM_restart_CS,is_new_run +use MOM_diag_mediator, only : register_diag_field,post_data,diag_ctrl,safe_alloc_ptr +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_restart, only : register_restart_field +use MOM_isopycnal_slopes,only : vert_fill_TS +!use random_numbers_mod, only : getRandomNumbers,initializeRandomNumberStream,randomNumberStream + +implicit none +#include + +public MOM_stoch_eos_init +public MOM_stoch_eos_run +public MOM_calc_varT + +real,private ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: l2_inv + !< One over sum of the T cell side side lengths squared +real,private ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: rgauss !< nondimensional random Gaussian +real, parameter,private :: tfac=0.27 !< Nondimensional decorrelation time factor, ~1/3.7 +real, parameter,private :: amplitude=0.624499 !< Nondimensional std dev of Gaussian +integer ,private :: seed !< PRNG seed +type(PRNG) :: rn_CS !< PRNG control structure + +!> Describes parameters of the stochastic component of the EOS +!! correction, described in Stanley et al. JAMES 2020. +type, public :: MOM_stoch_eos_CS + real,public ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: pattern + !< Random pattern for stochastic EOS + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: phi + !< temporal correlation stochastic EOS (deugging) + logical :: use_stoch_eos !< If true, use the stochastic equation of state (Stanley et al. 2020) + real :: stanley_coeff !< Coefficient correlating the temperature gradient + !and SGS T variance; if <0, turn off scheme in all codes + real :: stanley_a ! m2 s-1] + !>@{ Diagnostic IDs + integer :: id_stoch_eos = -1, id_stoch_phi = -1, id_tvar_sgs = -1 + !>@} + +end type MOM_stoch_eos_CS + + +contains + subroutine MOM_stoch_eos_init(G,Time,param_file,stoch_eos_CS,restart_CS,diag) +! initialization subroutine called by MOM.F90, + type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(time_type), intent(in) :: Time !< Time for stochastic process + type(MOM_stoch_eos_CS), intent(inout) :: stoch_eos_CS !< Stochastic control structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics + integer :: i,j + type(vardesc) :: vd + seed=0 + ! contants + !pi=2*acos(0.0) + call get_param(param_file, "MOM_stoch_eos", "STOCH_EOS", stoch_eos_CS%use_stoch_eos, & + "If true, stochastic perturbations are applied "//& + "to the EOS in the PGF.", default=.false.) + call get_param(param_file, "MOM_stoch_eos", "STANLEY_COEFF", stoch_eos_CS%stanley_coeff, & + "Coefficient correlating the temperature gradient "//& + "and SGS T variance.", default=-1.0) + call get_param(param_file, "MOM_stoch_eos", "STANLEY_A", stoch_eos_CS%stanley_a, & + "Coefficient a which scales chi in stochastic perturbation of the "//& + "SGS T variance.", default=1.0) + call get_param(param_file, "MOM_stoch_eos", "KD_SMOOTH", stoch_eos_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) + + !don't run anything if STANLEY_COEFF < 0 + if (stoch_eos_CS%stanley_coeff >= 0.0) then + + ALLOC_(stoch_eos_CS%pattern(G%isd:G%ied,G%jsd:G%jed)) ; stoch_eos_CS%pattern(:,:) = 0.0 + vd = var_desc("stoch_eos_pattern","nondim","Random pattern for stoch EOS",'h','1') + call register_restart_field(stoch_eos_CS%pattern, vd, .false., restart_CS) + ALLOC_(stoch_eos_CS%phi(G%isd:G%ied,G%jsd:G%jed)) ; stoch_eos_CS%phi(:,:) = 0.0 + ALLOC_(l2_inv(G%isd:G%ied,G%jsd:G%jed)) + ALLOC_(rgauss(G%isd:G%ied,G%jsd:G%jed)) + call get_param(param_file, "MOM_stoch_eos", "SEED_STOCH_EOS", seed, & + "Specfied seed for random number sequence ", default=0) + call random_2d_constructor(rn_CS, G%HI, Time, seed) + call random_2d_norm(rn_CS, G%HI, rgauss) + ! fill array with approximation of grid area needed for decorrelation + ! time-scale calculation + do j=G%jsc,G%jec + do i=G%isc,G%iec + l2_inv(i,j)=1.0/(G%dxT(i,j)**2+G%dyT(i,j)**2) + enddo + enddo + if (is_new_run(restart_CS)) then + do j=G%jsc,G%jec + do i=G%isc,G%iec + stoch_eos_CS%pattern(i,j)=amplitude*rgauss(i,j) + enddo + enddo + endif + + !register diagnostics + stoch_eos_CS%id_tvar_sgs = register_diag_field('ocean_model', 'tvar_sgs', diag%axesTL, Time, & + 'Parameterized SGS Temperature Variance ', 'None') + if (stoch_eos_CS%use_stoch_eos) then + stoch_eos_CS%id_stoch_eos = register_diag_field('ocean_model', 'stoch_eos', diag%axesT1, Time, & + 'random pattern for EOS', 'None') + stoch_eos_CS%id_stoch_phi = register_diag_field('ocean_model', 'stoch_phi', diag%axesT1, Time, & + 'phi for EOS', 'None') + endif + endif + + end subroutine MOM_stoch_eos_init + + subroutine MOM_stoch_eos_run(G,u,v,delt,Time,stoch_eos_CS,diag) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. + real, intent(in) :: delt !< Time step size for AR1 process [T ~> s]. + type(time_type), intent(in) :: Time !< Time for stochastic process + type(MOM_stoch_eos_CS), intent(inout) :: stoch_eos_CS !< Stochastic control structure + type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics +! locals + integer :: i,j + integer :: yr,mo,dy,hr,mn,sc + real :: phi,ubar,vbar + + call random_2d_constructor(rn_CS, G%HI, Time, seed) + call random_2d_norm(rn_CS, G%HI, rgauss) + ! advance AR(1) + do j=G%jsc,G%jec + do i=G%isc,G%iec + ubar=0.5*(u(I,j,1)*G%mask2dCu(I,j)+u(I-1,j,1)*G%mask2dCu(I-1,j)) + vbar=0.5*(v(i,J,1)*G%mask2dCv(i,J)+v(i,J-1,1)*G%mask2dCv(i,J-1)) + phi=exp(-delt*tfac*sqrt((ubar**2+vbar**2)*l2_inv(i,j))) + stoch_eos_CS%pattern(i,j)=phi*stoch_eos_CS%pattern(i,j) + amplitude*sqrt(1-phi**2)*rgauss(i,j) + stoch_eos_CS%phi(i,j)=phi + enddo + enddo + + end subroutine MOM_stoch_eos_run + + + subroutine MOM_calc_varT(G,GV,h,tv,stoch_eos_CS,dt) + type(ocean_grid_type), intent(in) :: G !< The ocean's 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] + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + type(MOM_stoch_eos_CS), intent(inout) :: stoch_eos_CS !< Stochastic control structure. + real, intent(in) :: dt !< Time increment [T ~> s] +! locals + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & + T, & !> The temperature (or density) [degC], with the values in + !! in massless layers filled vertically by diffusion. + S !> The filled salinity [ppt], with the values in + !! in massless layers filled vertically by diffusion. + integer :: i,j,k + real :: hl(5) !> Copy of local stencil of H [H ~> m] + real :: dTdi2, dTdj2 !> Differences in T variance [degC2] + + ! This block does a thickness weighted variance calculation and helps control for + ! extreme gradients along layers which are vanished against topography. It is + ! still a poor approximation in the interior when coordinates are strongly tilted. + if (.not. associated(tv%varT)) call safe_alloc_ptr(tv%varT, G%isd, G%ied, G%jsd, G%jed, GV%ke) + + call vert_fill_TS(h, tv%T, tv%S, stoch_eos_CS%kappa_smooth*dt, T, S, G, GV, halo_here=1, larger_h_denom=.true.) + + do k=1,G%ke + do j=G%jsc,G%jec + do i=G%isc,G%iec + hl(1) = h(i,j,k) * G%mask2dT(i,j) + hl(2) = h(i-1,j,k) * G%mask2dCu(I-1,j) + hl(3) = h(i+1,j,k) * G%mask2dCu(I,j) + hl(4) = h(i,j-1,k) * G%mask2dCv(i,J-1) + hl(5) = h(i,j+1,k) * G%mask2dCv(i,J) + + ! SGS variance in i-direction [degC2] + dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( T(i+1,j,k) - T(i,j,k) ) & + + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) ) & + ) * G%dxT(i,j) * 0.5 )**2 + ! SGS variance in j-direction [degC2] + dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( T(i,j+1,k) - T(i,j,k) ) & + + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) ) & + ) * G%dyT(i,j) * 0.5 )**2 + tv%varT(i,j,k) = stoch_eos_CS%stanley_coeff * ( dTdi2 + dTdj2 ) + ! Turn off scheme near land + tv%varT(i,j,k) = tv%varT(i,j,k) * (minval(hl) / (maxval(hl) + GV%H_subroundoff)) + enddo + enddo + enddo + ! if stochastic, perturb + if (stoch_eos_CS%use_stoch_eos) then + do k=1,G%ke + do j=G%jsc,G%jec + do i=G%isc,G%iec + tv%varT(i,j,k) = exp (stoch_eos_CS%stanley_a * stoch_eos_CS%pattern(i,j)) * tv%varT(i,j,k) + enddo + enddo + enddo + endif + end subroutine MOM_calc_varT + +end module MOM_stoch_eos + diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 8d667503d7..c98fe7539a 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -106,6 +106,8 @@ module MOM_diagnostics integer :: id_rhopot0 = -1, id_rhopot2 = -1 integer :: id_drho_dT = -1, id_drho_dS = -1 integer :: id_h_pre_sync = -1 + integer :: id_tosq = -1, id_sosq = -1 + !>@} type(wave_speed_CS) :: wave_speed !< Wave speed control struct @@ -402,16 +404,28 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! Internal T&S variables are conservative temperature & absolute salinity, ! so they need to converted to potential temperature and practical salinity ! for some diagnostics using TEOS-10 function calls. - if ((CS%id_Tpot > 0) .or. (CS%id_tob > 0)) then + if ((CS%id_Tpot > 0) .or. (CS%id_tob > 0) .or. (CS%id_tosq > 0)) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = gsw_pt_from_ct(tv%S(i,j,k),tv%T(i,j,k)) enddo ; enddo ; enddo if (CS%id_Tpot > 0) call post_data(CS%id_Tpot, work_3d, CS%diag) if (CS%id_tob > 0) call post_data(CS%id_tob, work_3d(:,:,nz), CS%diag, mask=G%mask2dT) + if (CS%id_tosq > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = work_3d(i,j,k)*work_3d(i,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_tosq, work_3d, CS%diag) + endif endif else ! Internal T&S variables are potential temperature & practical salinity if (CS%id_tob > 0) call post_data(CS%id_tob, tv%T(:,:,nz), CS%diag, mask=G%mask2dT) + if (CS%id_tosq > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = tv%T(i,j,k)*tv%T(i,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_tosq, work_3d, CS%diag) + endif endif ! Calculate additional, potentially derived salinity diagnostics @@ -419,16 +433,28 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! Internal T&S variables are conservative temperature & absolute salinity, ! so they need to converted to potential temperature and practical salinity ! for some diagnostics using TEOS-10 function calls. - if ((CS%id_Sprac > 0) .or. (CS%id_sob > 0)) then + if ((CS%id_Sprac > 0) .or. (CS%id_sob > 0) .or. (CS%id_sosq >0)) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = gsw_sp_from_sr(tv%S(i,j,k)) enddo ; enddo ; enddo if (CS%id_Sprac > 0) call post_data(CS%id_Sprac, work_3d, CS%diag) if (CS%id_sob > 0) call post_data(CS%id_sob, work_3d(:,:,nz), CS%diag, mask=G%mask2dT) + if (CS%id_sosq > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = work_3d(i,j,k)*work_3d(i,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_sosq, work_3d, CS%diag) + endif endif else ! Internal T&S variables are potential temperature & practical salinity if (CS%id_sob > 0) call post_data(CS%id_sob, tv%S(:,:,nz), CS%diag, mask=G%mask2dT) + if (CS%id_sosq > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = tv%S(i,j,k)*tv%S(i,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_sosq, work_3d, CS%diag) + endif endif ! volume mean potential temperature @@ -1619,6 +1645,13 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag long_name='Sea Water Salinity at Sea Floor', & standard_name='sea_water_salinity_at_sea_floor', units='psu') + CS%id_tosq = register_diag_field('ocean_model', 'tosq', diag%axesTL,& + Time, 'Square of Potential Temperature', 'degc2', & + standard_name='Potential Temperature Squared') + CS%id_sosq = register_diag_field('ocean_model', 'sosq', diag%axesTL,& + Time, 'Square of Salinity', 'psu2', & + standard_name='Salinity Squared') + CS%id_temp_layer_ave = register_diag_field('ocean_model', 'temp_layer_ave', & diag%axesZL, Time, 'Layer Average Ocean Temperature', 'degC') CS%id_salt_layer_ave = register_diag_field('ocean_model', 'salt_layer_ave', & diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 39b626985a..881cea329d 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -64,9 +64,9 @@ module MOM_EOS !> Calculates density of sea water from T, S and P interface calculate_density - module procedure calculate_density_scalar, calculate_density_array, calculate_density_1d - module procedure calculate_stanley_density_scalar, calculate_stanley_density_array - module procedure calculate_stanley_density_1d + module procedure calculate_density_scalar, calculate_density_array, calculate_density_1d, & + calculate_stanley_density_scalar, calculate_stanley_density_array, & + calculate_stanley_density_1d end interface calculate_density !> Calculates specific volume of sea water from T, S and P @@ -430,18 +430,18 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_linear(T, S, pres, rho, 1, npts, & + call calculate_density_linear(T, S, pres, rho, is, npts, & EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_ref) call calculate_density_second_derivs_linear(T, S, pres, d2RdSS, d2RdST, & - d2RdTT, d2RdSp, d2RdTP, 1, npts) + d2RdTT, d2RdSp, d2RdTP, is, npts) case (EOS_WRIGHT) - call calculate_density_wright(T, S, pres, rho, 1, npts, rho_ref) + call calculate_density_wright(T, S, pres, rho, is, npts, rho_ref) call calculate_density_second_derivs_wright(T, S, pres, d2RdSS, d2RdST, & - d2RdTT, d2RdSp, d2RdTP, 1, npts) + d2RdTT, d2RdSp, d2RdTP, is, npts) case (EOS_TEOS10) - call calculate_density_teos10(T, S, pres, rho, 1, npts, rho_ref) + call calculate_density_teos10(T, S, pres, rho, is, npts, rho_ref) call calculate_density_second_derivs_teos10(T, S, pres, d2RdSS, d2RdST, & - d2RdTT, d2RdSp, d2RdTP, 1, npts) + d2RdTT, d2RdSp, d2RdTP, is, npts) case default call MOM_error(FATAL, "calculate_stanley_density_scalar: EOS is not valid.") end select diff --git a/src/equation_of_state/TEOS10/gsw_mod_error_functions.f90 b/src/equation_of_state/TEOS10/gsw_mod_error_functions.f90 new file mode 120000 index 0000000000..1c3b7bfb3c --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_mod_error_functions.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/modules/gsw_mod_error_functions.f90 \ No newline at end of file diff --git a/src/framework/MOM_random.F90 b/src/framework/MOM_random.F90 index bef78a433a..38e330c4be 100644 --- a/src/framework/MOM_random.F90 +++ b/src/framework/MOM_random.F90 @@ -156,6 +156,7 @@ subroutine random_2d_constructor(CS, HI, Time, seed) if (.not. allocated(CS%stream2d)) allocate( CS%stream2d(HI%isd:HI%ied,HI%jsd:HI%jed) ) tseed = seed_from_time(Time) + tseed = ieor(tseed*9007, seed) do j = HI%jsd,HI%jed do i = HI%isd,HI%ied diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index da8e936642..236a2cebce 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -59,6 +59,7 @@ module MOM_lateral_mixing_coeffs !! This parameter is set depending on other parameters. logical :: calculate_Eady_growth_rate !< If true, calculate all the Eady growth rate. !! This parameter is set depending on other parameters. + logical :: use_stanley_iso !< If true, use Stanley parameterization in MOM_isopycnal_slopes logical :: use_simpler_Eady_growth_rate !< If true, use a simpler method to calculate the !! Eady growth rate that avoids division by layer thickness. !! This parameter is set depending on other parameters. @@ -471,14 +472,14 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) if (CS%calculate_Eady_growth_rate) then if (CS%use_simpler_Eady_growth_rate) then call find_eta(h, tv, G, GV, US, e, halo_size=2) - call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & + call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, CS%use_stanley_iso, & CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, dzu=dzu, dzv=dzv, & dzSxN=dzSxN, dzSyN=dzSyN, halo=1, OBC=OBC) call calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, dzSyN, CS%SN_u, CS%SN_v) else call find_eta(h, tv, G, GV, US, e, halo_size=2) if (CS%use_stored_slopes) then - call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & + call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, CS%use_stanley_iso, & CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) call calc_Visbeck_coeffs_old(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS, OBC) else @@ -1267,6 +1268,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "USE_STANLEY_ISO", CS%use_stanley_iso, & + "If true, turn on Stanley SGS T variance parameterization "// & + "in isopycnal slope code.", default=.false.) if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct) then in_use = .true. @@ -1290,6 +1294,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) endif if (CS%use_stored_slopes) then + ! CS%calculate_Eady_growth_rate=.true. in_use = .true. allocate(CS%slope_x(IsdB:IedB,jsd:jed,GV%ke+1), source=0.0) allocate(CS%slope_y(isd:ied,JsdB:JedB,GV%ke+1), source=0.0) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 04982d7171..7ebc6c0eff 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -60,6 +60,7 @@ module MOM_mixed_layer_restrat logical :: debug = .false. !< If true, calculate checksums of fields for debugging. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. + logical :: use_stanley_ml !< If true, use the Stanley parameterization of SGS T variance real, dimension(:,:), allocatable :: & MLD_filtered, & !< Time-filtered MLD [H ~> m or kg m-2] @@ -178,6 +179,7 @@ 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 [R L2 T-2 ~> Pa]. real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 + real, dimension(SZI_(G)) :: covTS, varS !SGS TS covariance, S variance in Stanley param; currently 0 real :: aFac, bFac ! Nondimensional ratios [nondim] real :: ddRho ! A density difference [R ~> kg m-3] real :: hAtVel, zpa, zpb, dh, res_scaling_fac @@ -198,6 +200,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + covTS(:)=0.0 !!Functionality not implemented yet; in future, should be passed in tv + varS(:)=0.0 + if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") if (.not. allocated(VarMix%Rd_dx_h) .and. CS%front_length > 0.) & @@ -210,7 +215,12 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var EOSdom(:) = EOS_domain(G%HI, halo=1) do j = js-1, je+1 dK(:) = 0.5 * h(:,j,1) ! Depth of center of surface layer - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, tv%eqn_of_state, EOSdom) + if (CS%use_stanley_ml) then + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, tv%varT(:,j,1), covTS, varS, & + rhoSurf, tv%eqn_of_state, EOSdom) + else + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, tv%eqn_of_state, EOSdom) + endif deltaRhoAtK(:) = 0. MLD_fast(:,j) = 0. do k = 2, nz @@ -218,7 +228,12 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var dK(:) = dK(:) + 0.5 * ( h(:,j,k) + h(:,j,k-1) ) ! Depth of center of layer K ! Mixed-layer depth, using sigma-0 (surface reference pressure) deltaRhoAtKm1(:) = deltaRhoAtK(:) ! Store value from previous iteration of K - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, tv%eqn_of_state, EOSdom) + if (CS%use_stanley_ml) then + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, tv%varT(:,j,k), covTS, varS, & + deltaRhoAtK, tv%eqn_of_state, EOSdom) + else + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, tv%eqn_of_state, EOSdom) + endif do i = is-1,ie+1 deltaRhoAtK(i) = deltaRhoAtK(i) - rhoSurf(i) ! Density difference between layer K and surface enddo @@ -303,6 +318,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr,EOSdom, & !$OMP utimescale_diag,vtimescale_diag,forces,dz_neglect, & !$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_LFront, & +!$OMP covTS, varS, & !$OMP res_upscale, nz,MLD_fast,uDml_diag,vDml_diag) & !$OMP private(rho_ml,h_vel,u_star,absf,mom_mixrate,timescale, & !$OMP line_is_empty, keep_going,res_scaling_fac, & @@ -320,7 +336,12 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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(:), tv%eqn_of_state, EOSdom) + if (CS%use_stanley_ml) then + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, tv%varT(:,j,k), covTS, varS, & + rho_ml(:), tv%eqn_of_state, EOSdom) + else + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, rho_ml(:), tv%eqn_of_state, EOSdom) + endif line_is_empty = .true. do i=is-1,ie+1 if (htot_fast(i,j) < MLD_fast(i,j)) then @@ -619,6 +640,10 @@ 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 + if (CS%use_stanley_ml) call MOM_error(FATAL, & + "MOM_mixedlayer_restrat: The Stanley parameterization is not"//& + "available with the BML.") + uDml(:) = 0.0 ; vDml(:) = 0.0 I4dt = 0.25 / dt g_Rho0 = GV%g_Earth / GV%Rho0 @@ -842,6 +867,9 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "geostrophic kinetic energy or 1 plus the square of the "//& "grid spacing over the deformation radius, as detailed "//& "by Fox-Kemper et al. (2010)", units="nondim", default=0.0) + call get_param(param_file, mdl, "USE_STANLEY_ML", CS%use_stanley_ml, & + "If true, turn on Stanley SGS T variance parameterization "// & + "in ML restrat code.", default=.false.) ! We use GV%nkml to distinguish between the old and new implementation of MLE. ! The old implementation only works for the layer model with nkml>0. if (GV%nkml==0) then diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 8303d30621..14a7c30e3e 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -78,9 +78,7 @@ module MOM_thickness_diffuse !! than the streamfunction for the GM source term. logical :: use_GM_work_bug !< If true, use the incorrect sign for the !! top-level work tendency on the top layer. - real :: Stanley_det_coeff !< The coefficient correlating SGS temperature variance with the mean - !! temperature gradient in the deterministic part of the Stanley parameterization. - !! Negative values disable the scheme." [nondim] + logical :: use_stanley_gm !< If true, also use the Stanley parameterization in MOM_thickness_diffuse type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics real, allocatable :: GMwork(:,:) !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] @@ -611,13 +609,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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 [R degC-1 ~> kg m-3 degC-1] - drho_dS_u, & ! The derivative of density with salinity at u points [R ppt-1 ~> kg m-3 ppt-1]. - drho_dT_dT_u ! The second derivative of density with temperature at u points [R degC-2 ~> kg m-3 degC-2] - real, dimension(SZIB_(G)) :: scrap ! An array to pass to calculate_density_second_derivs() that will be ingored. + drho_dS_u ! The derivative of density with salinity at u points [R ppt-1 ~> kg m-3 ppt-1]. + real, dimension(SZI_(G)) :: scrap ! An array to pass to calculate_density_second_derivs() that will be ingored. real, dimension(SZI_(G)) :: & drho_dT_v, & ! The derivative of density with temperature at v points [R degC-1 ~> kg m-3 degC-1] drho_dS_v, & ! The derivative of density with salinity at v points [R ppt-1 ~> kg m-3 ppt-1]. - drho_dT_dT_v ! The second derivative of density with temperature at v points [R degC-2 ~> kg m-3 degC-2] + drho_dT_dT_h, & ! The second derivative of density with temperature at h points [R degC-2 ~> kg m-3 degC-2] + drho_dT_dT_hr ! The second derivative of density with temperature at h (+1) points [R degC-2 ~> kg m-3 degC-2] 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)) :: & @@ -628,6 +626,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV T_v, & ! Temperature on the interface at the v-point [degC]. S_v, & ! Salinity on the interface at the v-point [ppt]. pres_v ! Pressure on the interface at the v-point [R L2 T-2 ~> Pa]. + real, dimension(SZI_(G)) :: & + T_h, & ! Temperature on the interface at the h-point [degC]. + S_h, & ! Salinity on the interface at the h-point [ppt]. + pres_h, & ! Pressure on the interface at the h-point [R L2 T-2 ~> Pa]. + T_hr, & ! Temperature on the interface at the h (+1) point [degC]. + S_hr, & ! Salinity on the interface at the h (+1) point [ppt]. + pres_hr ! Pressure on the interface at the h (+1) point [R L2 T-2 ~> Pa]. real :: Work_u(SZIB_(G), SZJ_(G)) ! The work being done by the thickness real :: Work_v(SZI_(G), SZJB_(G)) ! diffusion integrated over a cell [R Z L4 T-3 ~> W ] real :: Work_h ! The work averaged over an h-cell [R Z L2 T-3 ~> W m-2]. @@ -683,13 +688,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: G_rho0 ! g/Rho0 [L2 R-1 Z-1 T-2 ~> m4 kg-1 s-2]. real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver ! times unit conversion factors [T-2 L2 Z-2 ~> s-2] - real :: Tl(5) ! copy and T in local stencil [degC] - real :: mn_T ! mean of T in local stencil [degC] - real :: mn_T2 ! mean of T**2 in local stencil [degC] - real :: hl(5) ! Copy of local stencil of H [H ~> m] - real :: r_sm_H ! Reciprocal of sum of H in local stencil [H-1 ~> m-1] - real, dimension(SZI_(G), SZJ_(G),SZK_(GV)) :: Tsgs2 ! Sub-grid temperature variance [degC2] - real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: diag_sfn_x, diag_sfn_unlim_x ! Diagnostics real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: diag_sfn_y, diag_sfn_unlim_y ! Diagnostics logical :: present_slope_x, present_slope_y, calc_derivatives @@ -697,7 +695,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! state calculations at u-points. integer, dimension(2) :: EOSdom_v ! The shifted I-computational domain to use for equation of ! state calculations at v-points. - logical :: use_Stanley + logical :: use_stanley integer :: is, ie, js, je, nz, IsdB, halo integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ; IsdB = G%IsdB @@ -714,7 +712,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV use_EOS = associated(tv%eqn_of_state) present_slope_x = PRESENT(slope_x) present_slope_y = PRESENT(slope_y) - use_Stanley = CS%Stanley_det_coeff >= 0. + + use_stanley = CS%use_stanley_gm nk_linear = max(GV%nkml, 1) @@ -728,17 +727,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (use_EOS) then halo = 1 ! Default halo to fill is 1 - if (use_Stanley) halo = 2 ! Need wider valid halo for gradients of T call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, halo, larger_h_denom=.true.) endif if (CS%use_FGNV_streamfn .and. .not. associated(cg1)) call MOM_error(FATAL, & "cg1 must be associated when using FGNV streamfunction.") -!$OMP parallel default(none) shared(is,ie,js,je,h_avail_rsum,pres,h_avail,I4dt, use_Stanley, & -!$OMP CS,G,GV,tv,h,h_frac,nz,uhtot,Work_u,vhtot,Work_v,Tsgs2,T, & -!$OMP diag_sfn_x, diag_sfn_y, diag_sfn_unlim_x, diag_sfn_unlim_y ) & -!$OMP private(hl,r_sm_H,Tl,mn_T,mn_T2) +!$OMP parallel default(none) shared(is,ie,js,je,h_avail_rsum,pres,h_avail,I4dt, use_stanley, & +!$OMP CS,G,GV,tv,h,h_frac,nz,uhtot,Work_u,vhtot,Work_v,T, & +!$OMP diag_sfn_x, diag_sfn_y, diag_sfn_unlim_x, diag_sfn_unlim_y ) ! Find the maximum and minimum permitted streamfunction. !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 @@ -751,41 +748,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV h_frac(i,j,1) = 1.0 pres(i,j,2) = pres(i,j,1) + (GV%g_Earth*GV%H_to_RZ) * h(i,j,1) enddo ; enddo - if (use_Stanley) then -!$OMP do - do k=1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - !! SGS variance in i-direction [degC2] - !dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( T(i+1,j,k) - T(i,j,k) ) & - ! + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) ) & - ! ) * G%dxT(i,j) * 0.5 )**2 - !! SGS variance in j-direction [degC2] - !dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( T(i,j+1,k) - T(i,j,k) ) & - ! + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) ) & - ! ) * G%dyT(i,j) * 0.5 )**2 - !Tsgs2(i,j,k) = CS%Stanley_det_coeff * 0.5 * ( dTdi2 + dTdj2 ) - ! This block does a thickness weighted variance calculation and helps control for - ! extreme gradients along layers which are vanished against topography. It is - ! still a poor approximation in the interior when coordinates are strongly tilted. - hl(1) = h(i,j,k) * G%mask2dT(i,j) - hl(2) = h(i-1,j,k) * G%mask2dCu(I-1,j) - hl(3) = h(i+1,j,k) * G%mask2dCu(I,j) - hl(4) = h(i,j-1,k) * G%mask2dCv(i,J-1) - hl(5) = h(i,j+1,k) * G%mask2dCv(i,J) - r_sm_H = 1. / ( ( hl(1) + ( ( hl(2) + hl(3) ) + ( hl(4) + hl(5) ) ) ) + GV%H_subroundoff ) - ! Mean of T - Tl(1) = T(i,j,k) ; Tl(2) = T(i-1,j,k) ; Tl(3) = T(i+1,j,k) - Tl(4) = T(i,j-1,k) ; Tl(5) = T(i,j+1,k) - mn_T = ( hl(1)*Tl(1) + ( ( hl(2)*Tl(2) + hl(3)*Tl(3) ) + ( hl(4)*Tl(4) + hl(5)*Tl(5) ) ) ) * r_sm_H - ! Adjust T vectors to have zero mean - Tl(:) = Tl(:) - mn_T ; mn_T = 0. - ! Variance of T - mn_T2 = ( hl(1)*Tl(1)*Tl(1) + ( ( hl(2)*Tl(2)*Tl(2) + hl(3)*Tl(3)*Tl(3) ) & - + ( hl(4)*Tl(4)*Tl(4) + hl(5)*Tl(5)*Tl(5) ) ) ) * r_sm_H - ! Variance should be positive but round-off can violate this. Calculating - ! variance directly would fix this but requires more operations. - Tsgs2(i,j,k) = CS%Stanley_det_coeff * max(0., mn_T2) - enddo ; enddo ; enddo - endif !$OMP do do j=js-1,je+1 do k=2,nz ; do i=is-1,ie+1 @@ -815,11 +777,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, & !$OMP h_neglect2,int_slope_u,KH_u,uhtot,h_frac,h_avail_rsum, & !$OMP uhD,h_avail,G_scale,Work_u,CS,slope_x,cg1,diag_sfn_x, & -!$OMP diag_sfn_unlim_x,N2_floor,EOSdom_u,use_stanley, Tsgs2, & +!$OMP diag_sfn_unlim_x,N2_floor,EOSdom_u,use_stanley, & !$OMP present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & -!$OMP drho_dT_dT_u,scrap, & +!$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & !$OMP drdx,mag_grad2,Slope,slope2_Ratio_u,hN2_u, & !$OMP Sfn_unlim_u,drdi_u,drdkDe_u,h_harm,c2_h_u, & @@ -833,7 +795,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif calc_derivatives = use_EOS .and. (k >= nk_linear) .and. & - (find_work .or. .not. present_slope_x .or. CS%use_FGNV_streamfn .or. use_Stanley) + (find_work .or. .not. present_slope_x .or. CS%use_FGNV_streamfn .or. use_stanley) ! Calculate the zonal fluxes and gradients. if (calc_derivatives) then @@ -845,12 +807,17 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, drho_dS_u, & tv%eqn_of_state, EOSdom_u) endif - if (use_Stanley) then + if (use_stanley) then + do i=is-1,ie+1 + pres_h(i) = pres(i,j,K) + T_h(i) = 0.5*(T(i,j,k) + T(i,j,k-1)) + S_h(i) = 0.5*(S(i,j,k) + S(i,j,k-1)) + enddo ! The second line below would correspond to arguments ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & - call calculate_density_second_derivs(T_u, S_u, pres_u, & - scrap, scrap, drho_dT_dT_u, scrap, scrap, & - (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state) + call calculate_density_second_derivs(T_h, S_h, pres_h, & + scrap, scrap, drho_dT_dT_h, scrap, scrap, & + is-1, ie-is+3, tv%eqn_of_state) endif do I=is-1,ie @@ -870,11 +837,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV elseif (find_work) then ! This is used in pure stacked SW mode drdkDe_u(I,K) = drdkR * e(i+1,j,K) - drdkL * e(i,j,K) endif - if (use_Stanley) then + if (use_stanley) then ! Correction to the horizontal density gradient due to nonlinearity in ! the EOS rectifying SGS temperature anomalies - drdiA = drdiA + drho_dT_dT_u(I) * 0.5 * ( Tsgs2(i+1,j,k-1)-Tsgs2(i,j,k-1) ) - drdiB = drdiB + drho_dT_dT_u(I) * 0.5 * ( Tsgs2(i+1,j,k)-Tsgs2(i,j,k) ) + drdiA = drdiA + 0.5 * ((drho_dT_dT_h(i+1) * tv%varT(i+1,j,k-1)) - & + (drho_dT_dT_h(i) * tv%varT(i,j,k-1)) ) + drdiB = drdiB + 0.5 * ((drho_dT_dT_h(i+1) * tv%varT(i+1,j,k)) - & + (drho_dT_dT_h(i) * tv%varT(i,j,k)) ) endif if (find_work) drdi_u(I,k) = drdiB @@ -1083,11 +1052,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, & !$OMP h_neglect2,int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, & !$OMP vhD,h_avail,G_scale,Work_v,CS,slope_y,cg1,diag_sfn_y, & -!$OMP diag_sfn_unlim_y,N2_floor,EOSdom_v,use_stanley,Tsgs2, & +!$OMP diag_sfn_unlim_y,N2_floor,EOSdom_v,use_stanley, & !$OMP present_slope_y,G_rho0,Slope_y_PE,hN2_y_PE) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & -!$OMP drho_dT_dT_v,scrap, & +!$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h, & +!$OMP drho_dT_dT_hr,pres_hr,T_hr,S_hr, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & !$OMP drdy,mag_grad2,Slope,slope2_Ratio_v,hN2_v, & !$OMP Sfn_unlim_v,drdj_v,drdkDe_v,h_harm,c2_h_v, & @@ -1100,7 +1070,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif calc_derivatives = use_EOS .and. (k >= nk_linear) .and. & - (find_work .or. .not. present_slope_y .or. CS%use_FGNV_streamfn .or. use_Stanley) + (find_work .or. .not. present_slope_y .or. CS%use_FGNV_streamfn .or. use_stanley) if (calc_derivatives) then do i=is,ie @@ -1111,11 +1081,23 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, drho_dS_v, & tv%eqn_of_state, EOSdom_v) endif - if (use_Stanley) then + if (use_stanley) then + do i=is,ie + pres_h(i) = pres(i,j,K) + T_h(i) = 0.5*(T(i,j,k) + T(i,j,k-1)) + S_h(i) = 0.5*(S(i,j,k) + S(i,j,k-1)) + + pres_hr(i) = pres(i,j+1,K) + T_hr(i) = 0.5*(T(i,j+1,k) + T(i,j+1,k-1)) + S_hr(i) = 0.5*(S(i,j+1,k) + S(i,j+1,k-1)) + enddo ! The second line below would correspond to arguments ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & - call calculate_density_second_derivs(T_v, S_v, pres_v, & - scrap, scrap, drho_dT_dT_v, scrap, scrap, & + call calculate_density_second_derivs(T_h, S_h, pres_h, & + scrap, scrap, drho_dT_dT_h, scrap, scrap, & + is, ie-is+1, tv%eqn_of_state) + call calculate_density_second_derivs(T_hr, S_hr, pres_hr, & + scrap, scrap, drho_dT_dT_hr, scrap, scrap, & is, ie-is+1, tv%eqn_of_state) endif do i=is,ie @@ -1135,11 +1117,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV elseif (find_work) then ! This is used in pure stacked SW mode drdkDe_v(i,K) = drdkR * e(i,j+1,K) - drdkL * e(i,j,K) endif - if (use_Stanley) then + if (use_stanley) then ! Correction to the horizontal density gradient due to nonlinearity in ! the EOS rectifying SGS temperature anomalies - drdjA = drdjA + drho_dT_dT_v(I) * 0.5 * ( Tsgs2(i,j+1,k-1)-Tsgs2(i,j,k-1) ) - drdjB = drdjB + drho_dT_dT_v(I) * 0.5 * ( Tsgs2(i,j+1,k)-Tsgs2(i,j,k) ) + drdjA = drdjA + 0.5 * ((drho_dT_dT_hr(i) * tv%varT(i,j+1,k-1)) - & + (drho_dT_dT_h(i) * tv%varT(i,j,k-1)) ) + drdjB = drdjB + 0.5 * ((drho_dT_dT_hr(i) * tv%varT(i,j+1,k)) - & + (drho_dT_dT_h(i) * tv%varT(i,j,k)) ) endif if (find_work) drdj_v(i,k) = drdjB @@ -1969,10 +1953,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, "STANLEY_PRM_DET_COEFF", CS%Stanley_det_coeff, & - "The coefficient correlating SGS temperature variance with the mean "//& - "temperature gradient in the deterministic part of the Stanley parameterization. "//& - "Negative values disable the scheme.", units="nondim", default=-1.0) + call get_param(param_file, mdl, "USE_STANLEY_GM", CS%use_stanley_gm, & + "If true, turn on Stanley SGS T variance parameterization "// & + "in GM code.", default=.false.) 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) From 0c1e89a2cee0ae614ce3950b7cc646d72f947cd7 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 9 Jun 2022 14:49:26 -0600 Subject: [PATCH 37/38] Add missing units Address comment from reviewer by adding units to covTS and varS. --- src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 0c223ffdeb..864669a217 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -179,7 +179,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real, dimension(SZI_(G)) :: dK, dKm1 ! Depths of layer centers [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer ! densities [R L2 T-2 ~> Pa]. - real, dimension(SZI_(G)) :: covTS, varS !SGS TS covariance, S variance in Stanley param; currently 0 + real, dimension(SZI_(G)) :: covTS, & !SGS TS covariance in Stanley param; currently 0 [degC ppt] + varS !SGS S variance in Stanley param; currently 0 [ppt2] real :: aFac, bFac ! Nondimensional ratios [nondim] real :: ddRho ! A density difference [R ~> kg m-3] real :: hAtVel ! Thickness at the velocity points [H ~> m or kg m-2] From 3b80e443d2897719445bdfeaae28bf1580b50c22 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 9 Jun 2022 14:51:44 -0600 Subject: [PATCH 38/38] Follow MOM6 code style guide * Add ``implicit none ; private`` to this module; * Put module variables into the control structure for this module; * Add the description of the units for all real variables; * Add a consistent two-point indent throughout the module . TODO: Without further modifications, adding ``private`` to the control structure of this module will break the model. Currently, MOM.F90 needs access to ``use_stoch_eos``, ``stanley_coeff``, and some of the diagnostic ids. --- src/core/MOM_stoch_eos.F90 | 234 +++++++++++++++++++------------------ 1 file changed, 121 insertions(+), 113 deletions(-) diff --git a/src/core/MOM_stoch_eos.F90 b/src/core/MOM_stoch_eos.F90 index 0ee6d6b1be..bc5e15af4e 100644 --- a/src/core/MOM_stoch_eos.F90 +++ b/src/core/MOM_stoch_eos.F90 @@ -1,5 +1,6 @@ !> Provides the ocean stochastic equation of state module MOM_stoch_eos + ! This file is part of MOM6. See LICENSE.md for the license. use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type @@ -15,148 +16,156 @@ module MOM_stoch_eos use MOM_isopycnal_slopes,only : vert_fill_TS !use random_numbers_mod, only : getRandomNumbers,initializeRandomNumberStream,randomNumberStream -implicit none +implicit none; private #include public MOM_stoch_eos_init public MOM_stoch_eos_run public MOM_calc_varT -real,private ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: l2_inv - !< One over sum of the T cell side side lengths squared -real,private ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: rgauss !< nondimensional random Gaussian -real, parameter,private :: tfac=0.27 !< Nondimensional decorrelation time factor, ~1/3.7 -real, parameter,private :: amplitude=0.624499 !< Nondimensional std dev of Gaussian -integer ,private :: seed !< PRNG seed -type(PRNG) :: rn_CS !< PRNG control structure - !> Describes parameters of the stochastic component of the EOS !! correction, described in Stanley et al. JAMES 2020. type, public :: MOM_stoch_eos_CS - real,public ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: pattern - !< Random pattern for stochastic EOS + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: l2_inv + !< One over sum of the T cell side side lengths squared + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: rgauss + !< nondimensional random Gaussian + real :: tfac=0.27 !< Nondimensional decorrelation time factor, ~1/3.7 + real :: amplitude=0.624499 !< Nondimensional std dev of Gaussian + integer :: seed !< PRNG seed + type(PRNG) :: rn_CS !< PRNG control structure + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: pattern + !< Random pattern for stochastic EOS [nondim] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: phi - !< temporal correlation stochastic EOS (deugging) - logical :: use_stoch_eos !< If true, use the stochastic equation of state (Stanley et al. 2020) - real :: stanley_coeff !< Coefficient correlating the temperature gradient - !and SGS T variance; if <0, turn off scheme in all codes - real :: stanley_a ! m2 s-1] + !>@{ Diagnostic IDs integer :: id_stoch_eos = -1, id_stoch_phi = -1, id_tvar_sgs = -1 !>@} end type MOM_stoch_eos_CS - contains - subroutine MOM_stoch_eos_init(G,Time,param_file,stoch_eos_CS,restart_CS,diag) -! initialization subroutine called by MOM.F90, - type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(time_type), intent(in) :: Time !< Time for stochastic process - type(MOM_stoch_eos_CS), intent(inout) :: stoch_eos_CS !< Stochastic control structure - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. - type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics + +!> Initializes MOM_stoch_eos module. +subroutine MOM_stoch_eos_init(G,Time,param_file,CS,restart_CS,diag) + type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(time_type), intent(in) :: Time !< Time for stochastic process + type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics + + ! local variables integer :: i,j - type(vardesc) :: vd - seed=0 + type(vardesc) :: vd + CS%seed=0 ! contants !pi=2*acos(0.0) - call get_param(param_file, "MOM_stoch_eos", "STOCH_EOS", stoch_eos_CS%use_stoch_eos, & + call get_param(param_file, "MOM_stoch_eos", "STOCH_EOS", CS%use_stoch_eos, & "If true, stochastic perturbations are applied "//& "to the EOS in the PGF.", default=.false.) - call get_param(param_file, "MOM_stoch_eos", "STANLEY_COEFF", stoch_eos_CS%stanley_coeff, & + call get_param(param_file, "MOM_stoch_eos", "STANLEY_COEFF", CS%stanley_coeff, & "Coefficient correlating the temperature gradient "//& "and SGS T variance.", default=-1.0) - call get_param(param_file, "MOM_stoch_eos", "STANLEY_A", stoch_eos_CS%stanley_a, & + call get_param(param_file, "MOM_stoch_eos", "STANLEY_A", CS%stanley_a, & "Coefficient a which scales chi in stochastic perturbation of the "//& "SGS T variance.", default=1.0) - call get_param(param_file, "MOM_stoch_eos", "KD_SMOOTH", stoch_eos_CS%kappa_smooth, & + call get_param(param_file, "MOM_stoch_eos", "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & units="m2 s-1", default=1.0e-6) !don't run anything if STANLEY_COEFF < 0 - if (stoch_eos_CS%stanley_coeff >= 0.0) then + if (CS%stanley_coeff >= 0.0) then - ALLOC_(stoch_eos_CS%pattern(G%isd:G%ied,G%jsd:G%jed)) ; stoch_eos_CS%pattern(:,:) = 0.0 + ALLOC_(CS%pattern(G%isd:G%ied,G%jsd:G%jed)) ; CS%pattern(:,:) = 0.0 vd = var_desc("stoch_eos_pattern","nondim","Random pattern for stoch EOS",'h','1') - call register_restart_field(stoch_eos_CS%pattern, vd, .false., restart_CS) - ALLOC_(stoch_eos_CS%phi(G%isd:G%ied,G%jsd:G%jed)) ; stoch_eos_CS%phi(:,:) = 0.0 - ALLOC_(l2_inv(G%isd:G%ied,G%jsd:G%jed)) - ALLOC_(rgauss(G%isd:G%ied,G%jsd:G%jed)) - call get_param(param_file, "MOM_stoch_eos", "SEED_STOCH_EOS", seed, & + call register_restart_field(CS%pattern, vd, .false., restart_CS) + ALLOC_(CS%phi(G%isd:G%ied,G%jsd:G%jed)) ; CS%phi(:,:) = 0.0 + ALLOC_(CS%l2_inv(G%isd:G%ied,G%jsd:G%jed)) + ALLOC_(CS%rgauss(G%isd:G%ied,G%jsd:G%jed)) + call get_param(param_file, "MOM_stoch_eos", "SEED_STOCH_EOS", CS%seed, & "Specfied seed for random number sequence ", default=0) - call random_2d_constructor(rn_CS, G%HI, Time, seed) - call random_2d_norm(rn_CS, G%HI, rgauss) + call random_2d_constructor(CS%rn_CS, G%HI, Time, CS%seed) + call random_2d_norm(CS%rn_CS, G%HI, CS%rgauss) ! fill array with approximation of grid area needed for decorrelation ! time-scale calculation do j=G%jsc,G%jec - do i=G%isc,G%iec - l2_inv(i,j)=1.0/(G%dxT(i,j)**2+G%dyT(i,j)**2) - enddo + do i=G%isc,G%iec + CS%l2_inv(i,j)=1.0/(G%dxT(i,j)**2+G%dyT(i,j)**2) + enddo enddo if (is_new_run(restart_CS)) then - do j=G%jsc,G%jec - do i=G%isc,G%iec - stoch_eos_CS%pattern(i,j)=amplitude*rgauss(i,j) - enddo - enddo + do j=G%jsc,G%jec + do i=G%isc,G%iec + CS%pattern(i,j)=CS%amplitude*CS%rgauss(i,j) + enddo + enddo endif !register diagnostics - stoch_eos_CS%id_tvar_sgs = register_diag_field('ocean_model', 'tvar_sgs', diag%axesTL, Time, & + CS%id_tvar_sgs = register_diag_field('ocean_model', 'tvar_sgs', diag%axesTL, Time, & 'Parameterized SGS Temperature Variance ', 'None') - if (stoch_eos_CS%use_stoch_eos) then - stoch_eos_CS%id_stoch_eos = register_diag_field('ocean_model', 'stoch_eos', diag%axesT1, Time, & + if (CS%use_stoch_eos) then + CS%id_stoch_eos = register_diag_field('ocean_model', 'stoch_eos', diag%axesT1, Time, & 'random pattern for EOS', 'None') - stoch_eos_CS%id_stoch_phi = register_diag_field('ocean_model', 'stoch_phi', diag%axesT1, Time, & + CS%id_stoch_phi = register_diag_field('ocean_model', 'stoch_phi', diag%axesT1, Time, & 'phi for EOS', 'None') endif endif - end subroutine MOM_stoch_eos_init +end subroutine MOM_stoch_eos_init - subroutine MOM_stoch_eos_run(G,u,v,delt,Time,stoch_eos_CS,diag) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. +!> Generates a pattern in space and time for the ocean stochastic equation of state +subroutine MOM_stoch_eos_run(G,u,v,delt,Time,CS,diag) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. + 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, intent(in) :: delt !< Time step size for AR1 process [T ~> s]. - type(time_type), intent(in) :: Time !< Time for stochastic process - type(MOM_stoch_eos_CS), intent(inout) :: stoch_eos_CS !< Stochastic control structure - type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics -! locals - integer :: i,j + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. + real, intent(in) :: delt !< Time step size for AR1 process [T ~> s]. + type(time_type), intent(in) :: Time !< Time for stochastic process + type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure + type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics + + ! local variables + integer :: i,j integer :: yr,mo,dy,hr,mn,sc - real :: phi,ubar,vbar + real :: phi,ubar,vbar + + call random_2d_constructor(CS%rn_CS, G%HI, Time, CS%seed) + call random_2d_norm(CS%rn_CS, G%HI, CS%rgauss) - call random_2d_constructor(rn_CS, G%HI, Time, seed) - call random_2d_norm(rn_CS, G%HI, rgauss) ! advance AR(1) do j=G%jsc,G%jec - do i=G%isc,G%iec - ubar=0.5*(u(I,j,1)*G%mask2dCu(I,j)+u(I-1,j,1)*G%mask2dCu(I-1,j)) - vbar=0.5*(v(i,J,1)*G%mask2dCv(i,J)+v(i,J-1,1)*G%mask2dCv(i,J-1)) - phi=exp(-delt*tfac*sqrt((ubar**2+vbar**2)*l2_inv(i,j))) - stoch_eos_CS%pattern(i,j)=phi*stoch_eos_CS%pattern(i,j) + amplitude*sqrt(1-phi**2)*rgauss(i,j) - stoch_eos_CS%phi(i,j)=phi - enddo + do i=G%isc,G%iec + ubar=0.5*(u(I,j,1)*G%mask2dCu(I,j)+u(I-1,j,1)*G%mask2dCu(I-1,j)) + vbar=0.5*(v(i,J,1)*G%mask2dCv(i,J)+v(i,J-1,1)*G%mask2dCv(i,J-1)) + phi=exp(-delt*CS%tfac*sqrt((ubar**2+vbar**2)*CS%l2_inv(i,j))) + CS%pattern(i,j)=phi*CS%pattern(i,j) + CS%amplitude*sqrt(1-phi**2)*CS%rgauss(i,j) + CS%phi(i,j)=phi + enddo enddo - end subroutine MOM_stoch_eos_run +end subroutine MOM_stoch_eos_run +!> Computes a parameterization of the SGS temperature variance +subroutine MOM_calc_varT(G,GV,h,tv,CS,dt) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thickness [H ~> m] + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure + real, intent(in) :: dt !< Time increment [T ~> s] - subroutine MOM_calc_varT(G,GV,h,tv,stoch_eos_CS,dt) - type(ocean_grid_type), intent(in) :: G !< The ocean's 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] - type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure - type(MOM_stoch_eos_CS), intent(inout) :: stoch_eos_CS !< Stochastic control structure. - real, intent(in) :: dt !< Time increment [T ~> s] -! locals + ! local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & T, & !> The temperature (or density) [degC], with the values in !! in massless layers filled vertically by diffusion. @@ -171,42 +180,41 @@ subroutine MOM_calc_varT(G,GV,h,tv,stoch_eos_CS,dt) ! still a poor approximation in the interior when coordinates are strongly tilted. if (.not. associated(tv%varT)) call safe_alloc_ptr(tv%varT, G%isd, G%ied, G%jsd, G%jed, GV%ke) - call vert_fill_TS(h, tv%T, tv%S, stoch_eos_CS%kappa_smooth*dt, T, S, G, GV, halo_here=1, larger_h_denom=.true.) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, halo_here=1, larger_h_denom=.true.) do k=1,G%ke - do j=G%jsc,G%jec - do i=G%isc,G%iec - hl(1) = h(i,j,k) * G%mask2dT(i,j) - hl(2) = h(i-1,j,k) * G%mask2dCu(I-1,j) - hl(3) = h(i+1,j,k) * G%mask2dCu(I,j) - hl(4) = h(i,j-1,k) * G%mask2dCv(i,J-1) - hl(5) = h(i,j+1,k) * G%mask2dCv(i,J) - - ! SGS variance in i-direction [degC2] - dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( T(i+1,j,k) - T(i,j,k) ) & - + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) ) & - ) * G%dxT(i,j) * 0.5 )**2 - ! SGS variance in j-direction [degC2] - dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( T(i,j+1,k) - T(i,j,k) ) & - + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) ) & - ) * G%dyT(i,j) * 0.5 )**2 - tv%varT(i,j,k) = stoch_eos_CS%stanley_coeff * ( dTdi2 + dTdj2 ) - ! Turn off scheme near land - tv%varT(i,j,k) = tv%varT(i,j,k) * (minval(hl) / (maxval(hl) + GV%H_subroundoff)) - enddo - enddo + do j=G%jsc,G%jec + do i=G%isc,G%iec + hl(1) = h(i,j,k) * G%mask2dT(i,j) + hl(2) = h(i-1,j,k) * G%mask2dCu(I-1,j) + hl(3) = h(i+1,j,k) * G%mask2dCu(I,j) + hl(4) = h(i,j-1,k) * G%mask2dCv(i,J-1) + hl(5) = h(i,j+1,k) * G%mask2dCv(i,J) + + ! SGS variance in i-direction [degC2] + dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( T(i+1,j,k) - T(i,j,k) ) & + + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) ) & + ) * G%dxT(i,j) * 0.5 )**2 + ! SGS variance in j-direction [degC2] + dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( T(i,j+1,k) - T(i,j,k) ) & + + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) ) & + ) * G%dyT(i,j) * 0.5 )**2 + tv%varT(i,j,k) = CS%stanley_coeff * ( dTdi2 + dTdj2 ) + ! Turn off scheme near land + tv%varT(i,j,k) = tv%varT(i,j,k) * (minval(hl) / (maxval(hl) + GV%H_subroundoff)) + enddo + enddo enddo ! if stochastic, perturb - if (stoch_eos_CS%use_stoch_eos) then - do k=1,G%ke - do j=G%jsc,G%jec - do i=G%isc,G%iec - tv%varT(i,j,k) = exp (stoch_eos_CS%stanley_a * stoch_eos_CS%pattern(i,j)) * tv%varT(i,j,k) - enddo + if (CS%use_stoch_eos) then + do k=1,G%ke + do j=G%jsc,G%jec + do i=G%isc,G%iec + tv%varT(i,j,k) = exp (CS%stanley_a * CS%pattern(i,j)) * tv%varT(i,j,k) enddo - enddo + enddo + enddo endif - end subroutine MOM_calc_varT +end subroutine MOM_calc_varT end module MOM_stoch_eos -