From fd4faf566d336c77dfd800959e3885e24358ea65 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 4 Dec 2017 15:03:37 -0500 Subject: [PATCH 001/106] Converted local scalar Vort_mag into local 2d array - In preparation for modularizing the Leith calculations so that we can add QG-Leith (Bachman et al., 2017), we have made the local scalar that held the vorticity magnitude a 2d array. --- .../lateral/MOM_hor_visc.F90 | 25 +++++++++++-------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index bba797523b..46d9ce52fc 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -281,14 +281,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, str_xx,& ! str_xx is the diagonal term in the stress tensor (H m2 s-2) bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution (H m2 s-2) div_xx, & ! horizontal divergence (du/dx + dv/dy) (1/sec) including metric terms - FrictWorkIntz ! depth integrated energy dissipated by lateral friction (W/m2) + FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction (W/m2) + vert_vort_mag_h ! Magnitude of vertical vorticity at h-points |dv/dx - du/dy| (1/sec) real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) (1/sec) including metric terms str_xy, & ! str_xy is the cross term in the stress tensor (H m2 s-2) bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution (H m2 s-2) - vort_xy ! vertical vorticity (dv/dx - du/dy) (1/sec) including metric terms + vort_xy, & ! Vertical vorticity (dv/dx - du/dy) (1/sec) + vert_vort_mag_q ! Magnitude of vertical vorticity at q-points |dv/dx - du/dy| (1/sec) real, dimension(SZI_(G),SZJB_(G)) :: & vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 sec-1) including metric terms @@ -317,7 +319,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! viscosity. Here set equal to nondimensional Laplacian Leith constant. ! This is set equal to zero if modified Leith is not used. real :: Shear_mag ! magnitude of the shear (1/s) - real :: Vort_mag ! magnitude of the vorticity (1/s) +! real :: Vort_mag ! magnitude of the vorticity (1/s) real :: h2uq, h2vq ! temporary variables in units of H^2 (i.e. m2 or kg2 m-4). real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner ! points; these are first interpolated to u or v velocity @@ -379,11 +381,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & -!$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE) & +!$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, & +!$OMP vert_vort_mag_h, vert_vort_mag_q) & !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & -!$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & +!$OMP vort_xy,vort_xy_dx,vort_xy_dy,AhLth,KhLth, & !$OMP div_xx, div_xx_dx, div_xx_dy, mod_Leith, & !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz @@ -600,7 +603,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - Vort_mag = sqrt( & + vert_vort_mag_h(i,j) = sqrt( & 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)*div_xx_dx(I-1,j)) + & @@ -621,7 +624,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if (CS%Smagorinsky_Kh) & KhSm = CS%LAPLAC_CONST_xx(i,j) * Shear_mag if (CS%Leith_Kh) & - KhLth = CS%LAPLAC3_CONST_xx(i,j) * Vort_mag + KhLth = CS%LAPLAC3_CONST_xx(i,j) * vert_vort_mag_h(i,j) Kh = Kh_scale * MAX(KhLth, MAX(CS%Kh_bg_xx(i,j), KhSm)) if (CS%bound_Kh .and. .not.CS%better_bound_Kh) & Kh = MIN(Kh, CS%Kh_Max_xx(i,j)) @@ -663,7 +666,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif endif if (CS%Leith_Ah) & - AhLth = Vort_mag * (CS%BIHARM_CONST_xx(i,j)) + AhLth = vert_vort_mag_h(i,j) * (CS%BIHARM_CONST_xx(i,j)) Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm),AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xx(i,j)) @@ -730,7 +733,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, (sh_xx(i,j+1)*sh_xx(i,j+1) + sh_xx(i+1,j)*sh_xx(i+1,j)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) & - Vort_mag = sqrt( & + vert_vort_mag_q(I,J) = sqrt( & 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)*div_xx_dx(I,j+1)) + & @@ -778,7 +781,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if (CS%Smagorinsky_Kh) & KhSm = CS%LAPLAC_CONST_xy(I,J) * Shear_mag if (CS%Leith_Kh) & - KhLth = CS%LAPLAC3_CONST_xy(I,J) * Vort_mag + KhLth = CS%LAPLAC3_CONST_xy(I,J) * vert_vort_mag_q(I,J) Kh = Kh_scale * MAX(MAX(CS%Kh_bg_xy(I,J), KhSm), KhLth) if (CS%bound_Kh .and. .not.CS%better_bound_Kh) & Kh = MIN(Kh, CS%Kh_Max_xy(I,J)) @@ -823,7 +826,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif endif if (CS%Leith_Ah) & - AhLth = Vort_mag * (CS%BIHARM5_CONST_xy(I,J)) + AhLth = vert_vort_mag_q(I,J) * (CS%BIHARM5_CONST_xy(I,J)) Ah = MAX(MAX(CS%Ah_bg_xy(I,J), AhSm),AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xy(I,J)) From e5d4bdfde0da7fe5c2a5ceccfe7510209e2cc178 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 4 Dec 2017 15:36:43 -0500 Subject: [PATCH 002/106] Consolidated Leith related calculations - Grouped all the Leith related calculations in preparations for turning them into a single subroutine call. - Also duplicated the calculation of dvdx and dudy expecting that we might soon change the discretization for vorticity. --- .../lateral/MOM_hor_visc.F90 | 78 +++++++++++-------- 1 file changed, 47 insertions(+), 31 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 46d9ce52fc..451c366409 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -535,25 +535,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, enddo ; enddo endif - if (CS%no_slip) then - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) - enddo ; enddo - else - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) - enddo ; enddo - endif - -! Vorticity gradient - do J=js-2,Jeq+1 ; do I=is-1,Ieq+1 - vort_xy_dx(i,J) = CS%DY_dxBu(I,J)*(vort_xy(I,J)*G%IdyCu(I,j) - vort_xy(I-1,J)*G%IdyCu(I-1,j)) - enddo ; enddo - - do J=js-1,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy_dy(I,j) = CS%DX_dyBu(I,J)*(vort_xy(I,J)*G%IdxCv(i,J) - vort_xy(I,J-1)*G%IdxCv(i,J-1)) - enddo ; enddo - ! Divergence gradient do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) @@ -596,18 +577,59 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif; endif endif - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then - Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & - 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & - (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) + if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then + ! Components for the vertical vorticity + ! Note this a simple re-calculation of shearing components using the same discretization. + ! We will consider using a circulation based calculation of vorticity later. + ! Also note this will need OBC boundary conditions re-applied... + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + dvdx(I,J) = CS%DY_dxBu(I,J)*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J)) + dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) + enddo ; enddo + ! Vorticity + if (CS%no_slip) then + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) + enddo ; enddo + else + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) + enddo ; enddo endif - if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then + + ! Vorticity gradient + do J=js-2,Jeq+1 ; do I=is-1,Ieq+1 + vort_xy_dx(i,J) = CS%DY_dxBu(I,J)*(vort_xy(I,J)*G%IdyCu(I,j) - vort_xy(I-1,J)*G%IdyCu(I-1,j)) + enddo ; enddo + + do J=js-1,Jeq+1 ; do I=is-2,Ieq+1 + vort_xy_dy(I,j) = CS%DX_dyBu(I,J)*(vort_xy(I,J)*G%IdxCv(i,J) - vort_xy(I,J-1)*G%IdxCv(i,J-1)) + enddo ; enddo + + ! Magnitude of vorticity at h-points + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 vert_vort_mag_h(i,j) = sqrt( & 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)*div_xx_dx(I-1,j)) + & (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) + enddo ; enddo + + ! Magnitude of vorticity at q-points + do J=js-1,Jeq ; do I=is-1,Ieq + vert_vort_mag_q(I,J) = sqrt( & + 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & + (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & + mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)*div_xx_dx(I,j+1)) + & + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) + enddo ; enddo + endif + + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then + Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & + 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & + (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) endif if (CS%better_bound_Ah .or. CS%better_bound_Kh) then hrat_min = min(1.0, min(h_u(I,j), h_u(I-1,j), h_v(i,J), h_v(i,J-1)) / & @@ -732,12 +754,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, 0.25*((sh_xx(i,j)*sh_xx(i,j) + sh_xx(i+1,j+1)*sh_xx(i+1,j+1)) + & (sh_xx(i,j+1)*sh_xx(i,j+1) + sh_xx(i+1,j)*sh_xx(i+1,j)))) endif - if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) & - vert_vort_mag_q(I,J) = sqrt( & - 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & - (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & - mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)*div_xx_dx(I,j+1)) + & - (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) h2uq = 4.0 * h_u(I,j) * h_u(I,j+1) h2vq = 4.0 * h_v(i,J) * h_v(i+1,J) From 273745c0b00d2c71d266d5dcf08de16aeda968c5 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 4 Dec 2017 16:17:12 -0500 Subject: [PATCH 003/106] Moved Leith vorticity magnitude calc into MOM_lateral_mixing_coeffs.F90 - Block of calculations for vorticity magnitude used in Leith are now in a subroutine in MOM_lateral_mixing_coeffs.F90 --- .../lateral/MOM_hor_visc.F90 | 75 +------------ .../lateral/MOM_lateral_mixing_coeffs.F90 | 106 +++++++++++++++++- 2 files changed, 109 insertions(+), 72 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 451c366409..a12721a2ea 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -76,6 +76,7 @@ module MOM_hor_visc use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_lateral_mixing_coeffs, only : VarMix_CS +use MOM_lateral_mixing_coeffs, only : calc_vert_vort_mag use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type, OBC_DIRECTION_E, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_NONE @@ -280,7 +281,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, sh_xx, & ! horizontal tension (du/dx - dv/dy) (1/sec) including metric terms str_xx,& ! str_xx is the diagonal term in the stress tensor (H m2 s-2) bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution (H m2 s-2) - div_xx, & ! horizontal divergence (du/dx + dv/dy) (1/sec) including metric terms FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction (W/m2) vert_vort_mag_h ! Magnitude of vertical vorticity at h-points |dv/dx - du/dy| (1/sec) @@ -289,17 +289,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) (1/sec) including metric terms str_xy, & ! str_xy is the cross term in the stress tensor (H m2 s-2) bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution (H m2 s-2) - vort_xy, & ! Vertical vorticity (dv/dx - du/dy) (1/sec) vert_vort_mag_q ! Magnitude of vertical vorticity at q-points |dv/dx - du/dy| (1/sec) - real, dimension(SZI_(G),SZJB_(G)) :: & - vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 sec-1) including metric terms - div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 sec-1) including metric terms - - real, dimension(SZIB_(G),SZJ_(G)) :: & - vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 sec-1) including metric terms - div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 sec-1) including metric terms - real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & Ah_q, & ! biharmonic viscosity at corner points (m4/s) Kh_q ! Laplacian viscosity at corner points (m2/s) @@ -386,8 +377,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & -!$OMP vort_xy,vort_xy_dx,vort_xy_dy,AhLth,KhLth, & -!$OMP div_xx, div_xx_dx, div_xx_dy, mod_Leith, & +!$OMP AhLth,KhLth, & +!$OMP mod_Leith, & !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz @@ -409,11 +400,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, G%IdyCu(I-1,j) * u(I-1,j,k)) - & CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v(i,J,k) - & G%IdxCv(i,J-1)*v(i,J-1,k))) - div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & - G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & - (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & - (h(i,j,k) + h_neglect) enddo ; enddo ! Components for the shearing strain do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 @@ -535,15 +521,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, enddo ; enddo endif -! Divergence gradient - do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 - div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) - enddo ; enddo - - do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 - div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) - enddo ; enddo - ! Coefficient for modified Leith if (CS%Modified_Leith) then mod_Leith = 1.0 @@ -578,51 +555,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - ! Components for the vertical vorticity - ! Note this a simple re-calculation of shearing components using the same discretization. - ! We will consider using a circulation based calculation of vorticity later. - ! Also note this will need OBC boundary conditions re-applied... - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - dvdx(I,J) = CS%DY_dxBu(I,J)*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J)) - dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) - enddo ; enddo - ! Vorticity - if (CS%no_slip) then - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) - enddo ; enddo - else - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) - enddo ; enddo - endif - - ! Vorticity gradient - do J=js-2,Jeq+1 ; do I=is-1,Ieq+1 - vort_xy_dx(i,J) = CS%DY_dxBu(I,J)*(vort_xy(I,J)*G%IdyCu(I,j) - vort_xy(I-1,J)*G%IdyCu(I-1,j)) - enddo ; enddo - - do J=js-1,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy_dy(I,j) = CS%DX_dyBu(I,J)*(vort_xy(I,J)*G%IdxCv(i,J) - vort_xy(I,J-1)*G%IdxCv(i,J-1)) - enddo ; enddo - - ! Magnitude of vorticity at h-points - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - vert_vort_mag_h(i,j) = sqrt( & - 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & - (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & - mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)*div_xx_dx(I-1,j)) + & - (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) - enddo ; enddo - - ! Magnitude of vorticity at q-points - do J=js-1,Jeq ; do I=is-1,Ieq - vert_vort_mag_q(I,J) = sqrt( & - 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & - (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & - mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)*div_xx_dx(I,j+1)) + & - (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) - enddo ; enddo + call calc_vert_vort_mag(G, GV, u, v, h, k, CS%no_slip, mod_Leith, vert_vort_mag_h, vert_vort_mag_q) endif do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 7f981f7c04..1e5e7fdbea 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -125,6 +125,7 @@ module MOM_lateral_mixing_coeffs end type VarMix_CS public VarMix_init, calc_slope_functions, calc_resoln_function +public calc_vert_vort_mag contains @@ -719,7 +720,110 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) end subroutine calc_slope_functions_using_just_e -!> Initializes the variables mixing coefficients container +!> Calculates the magnitude of the vertical component of vorticity for use in the Leith-like schemes +subroutine calc_vert_vort_mag(G, GV, u, v, h, k, no_slip, mod_Leith, vert_vort_mag_h, vert_vort_mag_q) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow (m s-1) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow (m s-1) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg m-2) + integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude + logical, intent(in) :: no_slip !< True if vorticity should have no-slip BCs + real, intent(in) :: mod_Leith !< Non-dimensional coefficient multiplying the + !! divergence contribution to the Leith viscosity. + !! Set to zero for conventional Leith. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: vert_vort_mag_h !< Magnitude of vertical component + !! of vorticity at h-ponts (s-1) + real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: vert_vort_mag_q !< Magnitude of vertical component + !! of vorticity at q-ponts (s-1) + ! Local variables + real, dimension(SZIB_(G),SZJB_(G)) :: vort_xy, & ! Vertical vorticity (dv/dx - du/dy) (s-1) + dudy, & ! Meridional shear of zonal velocity (s-1) + dvdx ! Zonal shear of meridional velocity (s-1) + real, dimension(SZI_(G),SZJB_(G)) :: & + vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) + div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) + + real, dimension(SZIB_(G),SZJ_(G)) :: & + vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) + div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) + real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points (s-1) + real :: DY_dxBu, DX_dyBu + integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + + ! Divergence + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & + G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & + (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & + G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & + (h(i,j,k) + GV%H_subroundoff) + enddo ; enddo + + ! Divergence gradient + do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 + div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) + enddo ; enddo + + do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 + div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) + enddo ; enddo + + ! Components for the vertical vorticity + ! Note this a simple re-calculation of shearing components using the same discretization. + ! We will consider using a circulation based calculation of vorticity later. + ! Also note this will need OBC boundary conditions re-applied... + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) + dvdx(I,J) = DY_dxBu * (v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) + DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) + dudy(I,J) = DX_dyBu * (u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) + enddo ; enddo + + ! Vorticity + if (no_slip) then + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) + enddo ; enddo + else + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) + enddo ; enddo + endif + + ! Vorticity gradient + do J=js-2,Jeq+1 ; do I=is-1,Ieq+1 + DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) + vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) + enddo ; enddo + + do J=js-1,Jeq+1 ; do I=is-2,Ieq+1 + DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) + vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) + enddo ; enddo + + ! Magnitude of vorticity at h-points + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + vert_vort_mag_h(i,j) = sqrt( & + 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & + (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & + mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)*div_xx_dx(I-1,j)) + & + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) + enddo ; enddo + + ! Magnitude of vorticity at q-points + do J=js-1,Jeq ; do I=is-1,Ieq + vert_vort_mag_q(I,J) = sqrt( & + 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & + (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & + mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)*div_xx_dx(I,j+1)) + & + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) + enddo ; enddo + +end subroutine calc_vert_vort_mag + subroutine VarMix_init(Time, G, param_file, diag, CS) type(time_type), intent(in) :: Time !< Current model time type(ocean_grid_type), intent(in) :: G !< Ocean grid structure From 7dc2510d124e703052e4961380b1f6501859e60f Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 4 Dec 2017 16:43:16 -0500 Subject: [PATCH 004/106] Added beta to Leith vorticity magnitude - Added beta from grid type to vorticity magnitude --- src/parameterizations/lateral/MOM_hor_visc.F90 | 2 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 13 ++++++++++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index a12721a2ea..1959a200f8 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -555,7 +555,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - call calc_vert_vort_mag(G, GV, u, v, h, k, CS%no_slip, mod_Leith, vert_vort_mag_h, vert_vort_mag_q) + call calc_vert_vort_mag(G, GV, u, v, h, k, CS%no_slip, mod_Leith, .false., vert_vort_mag_h, vert_vort_mag_q) endif do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 1e5e7fdbea..bc4b06fa8b 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -721,7 +721,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) end subroutine calc_slope_functions_using_just_e !> Calculates the magnitude of the vertical component of vorticity for use in the Leith-like schemes -subroutine calc_vert_vort_mag(G, GV, u, v, h, k, no_slip, mod_Leith, vert_vort_mag_h, vert_vort_mag_q) +subroutine calc_vert_vort_mag(G, GV, u, v, h, k, no_slip, mod_Leith, QG_Leith, vert_vort_mag_h, vert_vort_mag_q) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow (m s-1) @@ -732,6 +732,7 @@ subroutine calc_vert_vort_mag(G, GV, u, v, h, k, no_slip, mod_Leith, vert_vort_m real, intent(in) :: mod_Leith !< Non-dimensional coefficient multiplying the !! divergence contribution to the Leith viscosity. !! Set to zero for conventional Leith. + logical, intent(in) :: QG_Leith !< True if using QG Leith scheme real, dimension(SZI_(G),SZJ_(G)), intent(out) :: vert_vort_mag_h !< Magnitude of vertical component !! of vorticity at h-ponts (s-1) real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: vert_vort_mag_q !< Magnitude of vertical component @@ -804,6 +805,16 @@ subroutine calc_vert_vort_mag(G, GV, u, v, h, k, no_slip, mod_Leith, vert_vort_m vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo + ! Add in beta for QG Leith + if (QG_Leith) then + do J=js-2,Jeq+1 ; do I=is-1,Ieq+1 + vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1) ) + enddo ; enddo + do J=js-1,Jeq+1 ; do I=is-2,Ieq+1 + vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j) ) + enddo ; enddo + endif + ! Magnitude of vorticity at h-points do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 vert_vort_mag_h(i,j) = sqrt( & From c59f87e1cb2a0e7fa203785cd9e521d387f21405 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 5 Dec 2017 11:23:21 -0500 Subject: [PATCH 005/106] Read Leith parameters in MOM_lateral_coeffs.F90 - Now reading parameters for Leith in MOM_lateral_coeffs.F90 (in additional to MOM_hor_visc.F90 which we'll remove later). - Removed parameters from dummy argument list. --- .../lateral/MOM_hor_visc.F90 | 12 +--- .../lateral/MOM_lateral_mixing_coeffs.F90 | 64 ++++++++++++++++--- 2 files changed, 56 insertions(+), 20 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 1959a200f8..f9da5ab15e 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -306,9 +306,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real :: KhSm ! Smagorinsky Laplacian viscosity (m2/s) real :: AhLth ! 2D Leith biharmonic viscosity (m4/s) real :: KhLth ! 2D Leith Laplacian viscosity (m2/s) - real :: mod_Leith ! nondimensional coefficient for divergence part of modified Leith - ! viscosity. Here set equal to nondimensional Laplacian Leith constant. - ! This is set equal to zero if modified Leith is not used. real :: Shear_mag ! magnitude of the shear (1/s) ! real :: Vort_mag ! magnitude of the vorticity (1/s) real :: h2uq, h2vq ! temporary variables in units of H^2 (i.e. m2 or kg2 m-4). @@ -521,13 +518,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, enddo ; enddo endif -! Coefficient for modified Leith - if (CS%Modified_Leith) then - mod_Leith = 1.0 - else - mod_Leith = 0.0 - endif - ! Evaluate u0 = x.Div(Grad u) and v0 = y.Div( Grad u) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 @@ -555,7 +545,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - call calc_vert_vort_mag(G, GV, u, v, h, k, CS%no_slip, mod_Leith, .false., vert_vort_mag_h, vert_vort_mag_q) + call calc_vert_vort_mag(VarMix, G, GV, u, v, h, k, vert_vort_mag_h, vert_vort_mag_q) endif do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index bc4b06fa8b..e5275c78ce 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -109,6 +109,21 @@ module MOM_lateral_mixing_coeffs !! and especially 2 are coded to be more efficient. real :: Visbeck_S_max !< Upper bound on slope used in Eady growth rate (nondim). + ! Leith parameters + logical :: use_QG_Leith !< If true, enables the QG Leith scheme + logical :: Leith_Kh !< If true, enables the Leith scheme + logical :: modified_Leith !< if true, include the divergence contribution to Leith viscosity + real :: Leith_Lap_const !< The non-dimensional coefficient in the Leith viscosity + logical :: Leith_Ah !< If true, enables the bi-harmonic Leith scheme + real :: Leith_bi_const !< The non-dimensional coefficient in the bi-harmonic Leith viscosity + logical :: no_slip !< If true, no slip boundary conditions are used. + !! Otherwise free slip boundary conditions are assumed. + !! The implementation of the free slip boundary + !! conditions on a C-grid is much cleaner than the + !! no slip boundary conditions. The use of free slip + !! b.c.s is strongly encouraged. The no slip b.c.s + !! are not implemented with the biharmonic viscosity. + ! Diagnostics !>@{ !! Diagnostic identifier @@ -721,18 +736,14 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) end subroutine calc_slope_functions_using_just_e !> Calculates the magnitude of the vertical component of vorticity for use in the Leith-like schemes -subroutine calc_vert_vort_mag(G, GV, u, v, h, k, no_slip, mod_Leith, QG_Leith, vert_vort_mag_h, vert_vort_mag_q) +subroutine calc_vert_vort_mag(CS, G, GV, u, v, h, k, vert_vort_mag_h, vert_vort_mag_q) + type(VarMix_CS), pointer :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow (m s-1) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow (m s-1) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg m-2) integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude - logical, intent(in) :: no_slip !< True if vorticity should have no-slip BCs - real, intent(in) :: mod_Leith !< Non-dimensional coefficient multiplying the - !! divergence contribution to the Leith viscosity. - !! Set to zero for conventional Leith. - logical, intent(in) :: QG_Leith !< True if using QG Leith scheme real, dimension(SZI_(G),SZJ_(G)), intent(out) :: vert_vort_mag_h !< Magnitude of vertical component !! of vorticity at h-ponts (s-1) real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: vert_vort_mag_q !< Magnitude of vertical component @@ -749,7 +760,7 @@ subroutine calc_vert_vort_mag(G, GV, u, v, h, k, no_slip, mod_Leith, QG_Leith, v vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points (s-1) - real :: DY_dxBu, DX_dyBu + real :: mod_Leith, DY_dxBu, DX_dyBu integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -784,7 +795,7 @@ subroutine calc_vert_vort_mag(G, GV, u, v, h, k, no_slip, mod_Leith, QG_Leith, v enddo ; enddo ! Vorticity - if (no_slip) then + if (CS%no_slip) then do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) enddo ; enddo @@ -806,7 +817,7 @@ subroutine calc_vert_vort_mag(G, GV, u, v, h, k, no_slip, mod_Leith, QG_Leith, v enddo ; enddo ! Add in beta for QG Leith - if (QG_Leith) then + if (CS%use_QG_Leith) then do J=js-2,Jeq+1 ; do I=is-1,Ieq+1 vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1) ) enddo ; enddo @@ -815,6 +826,8 @@ subroutine calc_vert_vort_mag(G, GV, u, v, h, k, no_slip, mod_Leith, QG_Leith, v enddo ; enddo endif + mod_Leith = 0.; if (CS%modified_Leith) mod_Leith = 1.0 + ! Magnitude of vorticity at h-points do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 vert_vort_mag_h(i,j) = sqrt( & @@ -1131,6 +1144,39 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) call wave_speed_init(CS%wave_speed_CSp, use_ebt_mode=CS%Resoln_use_ebt, mono_N2_depth=N2_filter_depth) endif + ! Leith parameters + call get_param(param_file, mdl, "LEITH_KH", CS%Leith_Kh, & + "If true, use a Leith nonlinear eddy viscosity.", & + default=CS%use_QG_Leith) + call get_param(param_file, mdl, "LEITH_AH", CS%Leith_Ah, & + "If true, use a biharmonic Leith nonlinear eddy \n"//& + "viscosity.", default=.false.) + call get_param(param_file, mdl, "USE_QG_LEITH", CS%use_QG_Leith, & + "If true, use the QG Leith nonlinear eddy viscosity.", & + default=.false.) + call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & + "If true, add a term to Leith viscosity which is \n"//& + "proportional to the gradient of divergence.", & + default=.false.) + call get_param(param_file, mdl, "LEITH_LAP_CONST", CS%Leith_Lap_const, & + "The nondimensional Laplacian Leith constant, \n"//& + "often set to 1.0", units="nondim", default=0.0, & + fail_if_missing = CS%Leith_Kh) + call get_param(param_file, mdl, "LEITH_BI_CONST", CS%Leith_bi_const, & + "The nondimensional biharmonic Leith constant, \n"//& + "typical values are thus far undetermined.", units="nondim", default=0.0, & + fail_if_missing = CS%Leith_Ah) + if (CS%Leith_Kh .or. CS%Leith_Ah) then + in_use = .true. + call get_param(param_file, mdl, "NOSLIP", CS%no_slip, & + "If true, no slip boundary conditions are used; otherwise \n"//& + "free slip boundary conditions are assumed. The \n"//& + "implementation of the free slip BCs on a C-grid is much \n"//& + "cleaner than the no slip BCs. The use of free slip BCs \n"//& + "is strongly encouraged, and no slip BCs are not used with \n"//& + "the biharmonic viscosity.", default=.false.) + endif + ! If nothing is being stored in this class then deallocate if (in_use) then CS%use_variable_mixing = .true. From c546d3ddc3276a0a1cda73d4852374d843f441e4 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 5 Dec 2017 11:25:13 -0500 Subject: [PATCH 006/106] Replaced calc_vert_vort_mag() with calc_Leith_viscosity() - The subroutine that was calculating terms used in the Leith viscosities now returns the viscosities themselves. --- .../lateral/MOM_hor_visc.F90 | 27 +++---- .../lateral/MOM_lateral_mixing_coeffs.F90 | 81 +++++++++++++++---- 2 files changed, 76 insertions(+), 32 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index f9da5ab15e..cc3359a070 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -76,7 +76,7 @@ module MOM_hor_visc use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_lateral_mixing_coeffs, only : VarMix_CS -use MOM_lateral_mixing_coeffs, only : calc_vert_vort_mag +use MOM_lateral_mixing_coeffs, only : calc_Leith_viscosity use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type, OBC_DIRECTION_E, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_NONE @@ -282,14 +282,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, str_xx,& ! str_xx is the diagonal term in the stress tensor (H m2 s-2) bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution (H m2 s-2) FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction (W/m2) - vert_vort_mag_h ! Magnitude of vertical vorticity at h-points |dv/dx - du/dy| (1/sec) + Leith_Kh_h, & ! Leith Laplacian viscosity at h-points (m2 s-1) + Leith_Ah_h ! Leith bi-harmonic viscosity at h-points (m4 s-1) real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) (1/sec) including metric terms str_xy, & ! str_xy is the cross term in the stress tensor (H m2 s-2) bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution (H m2 s-2) - vert_vort_mag_q ! Magnitude of vertical vorticity at q-points |dv/dx - du/dy| (1/sec) + Leith_Kh_q, & ! Leith Laplacian viscosity at q-points (m2 s-1) + Leith_Ah_q ! Leith bi-harmonic viscosity at q-points (m4 s-1) real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & Ah_q, & ! biharmonic viscosity at corner points (m4/s) @@ -307,7 +309,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real :: AhLth ! 2D Leith biharmonic viscosity (m4/s) real :: KhLth ! 2D Leith Laplacian viscosity (m2/s) real :: Shear_mag ! magnitude of the shear (1/s) -! real :: Vort_mag ! magnitude of the vorticity (1/s) real :: h2uq, h2vq ! temporary variables in units of H^2 (i.e. m2 or kg2 m-4). real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner ! points; these are first interpolated to u or v velocity @@ -370,12 +371,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & !$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, & -!$OMP vert_vort_mag_h, vert_vort_mag_q) & +!$OMP Leith_Kh_h, Leith_Kh_q, Leith_Ah_h, Leith_Ah_q) & !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & !$OMP AhLth,KhLth, & -!$OMP mod_Leith, & !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz @@ -545,7 +545,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - call calc_vert_vort_mag(VarMix, G, GV, u, v, h, k, vert_vort_mag_h, vert_vort_mag_q) + call calc_Leith_viscosity(VarMix, G, GV, u, v, h, k, Leith_Kh_h, Leith_Kh_q, Leith_Ah_h, Leith_Ah_q) endif do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -568,8 +568,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if ((CS%Smagorinsky_Kh) .or. (CS%Leith_Kh)) then if (CS%Smagorinsky_Kh) & KhSm = CS%LAPLAC_CONST_xx(i,j) * Shear_mag - if (CS%Leith_Kh) & - KhLth = CS%LAPLAC3_CONST_xx(i,j) * vert_vort_mag_h(i,j) + if (CS%Leith_Kh) KhLth = Leith_Kh_h(i,j) + ! Note: move Leith outside of resolution function Kh = Kh_scale * MAX(KhLth, MAX(CS%Kh_bg_xx(i,j), KhSm)) if (CS%bound_Kh .and. .not.CS%better_bound_Kh) & Kh = MIN(Kh, CS%Kh_Max_xx(i,j)) @@ -610,8 +610,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, AhSm = CS%BIHARM_CONST_xx(i,j) * Shear_mag endif endif - if (CS%Leith_Ah) & - AhLth = vert_vort_mag_h(i,j) * (CS%BIHARM_CONST_xx(i,j)) + if (CS%Leith_Ah) AhLth = Leith_Ah_h(i,j) Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm),AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xx(i,j)) @@ -719,8 +718,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if ((CS%Smagorinsky_Kh) .or. (CS%Leith_Kh)) then if (CS%Smagorinsky_Kh) & KhSm = CS%LAPLAC_CONST_xy(I,J) * Shear_mag - if (CS%Leith_Kh) & - KhLth = CS%LAPLAC3_CONST_xy(I,J) * vert_vort_mag_q(I,J) + if (CS%Leith_Kh) KhLth = Leith_Kh_q(I,J) Kh = Kh_scale * MAX(MAX(CS%Kh_bg_xy(I,J), KhSm), KhLth) if (CS%bound_Kh .and. .not.CS%better_bound_Kh) & Kh = MIN(Kh, CS%Kh_Max_xy(I,J)) @@ -764,8 +762,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, AhSm = CS%BIHARM_CONST_xy(I,J) * Shear_mag endif endif - if (CS%Leith_Ah) & - AhLth = vert_vort_mag_q(I,J) * (CS%BIHARM5_CONST_xy(I,J)) + if (CS%Leith_Ah) AhLth = Leith_Ah_q(I,J) Ah = MAX(MAX(CS%Ah_bg_xy(I,J), AhSm),AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xy(I,J)) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index e5275c78ce..764e393188 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -113,9 +113,7 @@ module MOM_lateral_mixing_coeffs logical :: use_QG_Leith !< If true, enables the QG Leith scheme logical :: Leith_Kh !< If true, enables the Leith scheme logical :: modified_Leith !< if true, include the divergence contribution to Leith viscosity - real :: Leith_Lap_const !< The non-dimensional coefficient in the Leith viscosity logical :: Leith_Ah !< If true, enables the bi-harmonic Leith scheme - real :: Leith_bi_const !< The non-dimensional coefficient in the bi-harmonic Leith viscosity logical :: no_slip !< If true, no slip boundary conditions are used. !! Otherwise free slip boundary conditions are assumed. !! The implementation of the free slip boundary @@ -123,6 +121,12 @@ module MOM_lateral_mixing_coeffs !! no slip boundary conditions. The use of free slip !! b.c.s is strongly encouraged. The no slip b.c.s !! are not implemented with the biharmonic viscosity. + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & + Laplac3_const_xx, & ! Laplacian metric-dependent constants (nondim) + biharm5_const_xx ! Biharmonic metric-dependent constants (nondim) + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & + Laplac3_const_xy, & ! Laplacian metric-dependent constants (nondim) + biharm5_const_xy ! Biharmonic metric-dependent constants (nondim) ! Diagnostics !>@{ @@ -140,7 +144,7 @@ module MOM_lateral_mixing_coeffs end type VarMix_CS public VarMix_init, calc_slope_functions, calc_resoln_function -public calc_vert_vort_mag +public calc_Leith_viscosity contains @@ -735,8 +739,8 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) end subroutine calc_slope_functions_using_just_e -!> Calculates the magnitude of the vertical component of vorticity for use in the Leith-like schemes -subroutine calc_vert_vort_mag(CS, G, GV, u, v, h, k, vert_vort_mag_h, vert_vort_mag_q) +!> Calculates the Leith Laplacian and bi-harmonic viscosity coefficients +subroutine calc_Leith_viscosity(CS, G, GV, u, v, h, k, Leith_Kh_h, Leith_Kh_q, Leith_Ah_h, Leith_Ah_q) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -744,10 +748,10 @@ subroutine calc_vert_vort_mag(CS, G, GV, u, v, h, k, vert_vort_mag_h, vert_vort_ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow (m s-1) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg m-2) integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: vert_vort_mag_h !< Magnitude of vertical component - !! of vorticity at h-ponts (s-1) - real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: vert_vort_mag_q !< Magnitude of vertical component - !! of vorticity at q-ponts (s-1) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity at h-points (m2 s-1) + real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity at q-points (m2 s-1) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Ah_h !< Leith bi-harmonic viscosity at h-points (m4 s-1) + real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Ah_q !< Leith bi-harmonic viscosity at q-points (m4 s-1) ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: vort_xy, & ! Vertical vorticity (dv/dx - du/dy) (s-1) dudy, & ! Meridional shear of zonal velocity (s-1) @@ -760,7 +764,7 @@ subroutine calc_vert_vort_mag(CS, G, GV, u, v, h, k, vert_vort_mag_h, vert_vort_ vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points (s-1) - real :: mod_Leith, DY_dxBu, DX_dyBu + real :: mod_Leith, DY_dxBu, DX_dyBu, vert_vort_mag integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -828,25 +832,29 @@ subroutine calc_vert_vort_mag(CS, G, GV, u, v, h, k, vert_vort_mag_h, vert_vort_ mod_Leith = 0.; if (CS%modified_Leith) mod_Leith = 1.0 - ! Magnitude of vorticity at h-points + ! h-point viscosities do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - vert_vort_mag_h(i,j) = sqrt( & + vert_vort_mag = sqrt( & 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)*div_xx_dx(I-1,j)) + & (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) + if (CS%Leith_Kh) Leith_Kh_h(i,j) = CS%Laplac3_const_xx(i,j) * vert_vort_mag + if (CS%Leith_Ah) Leith_Ah_h(i,j) = CS%biharm5_const_xx(i,j) * vert_vort_mag enddo ; enddo - ! Magnitude of vorticity at q-points + ! q-point viscosities do J=js-1,Jeq ; do I=is-1,Ieq - vert_vort_mag_q(I,J) = sqrt( & + vert_vort_mag = sqrt( & 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)*div_xx_dx(I,j+1)) + & (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) + if (CS%Leith_Kh) Leith_Kh_q(I,J) = CS%Laplac3_const_xy(I,J) * vert_vort_mag + if (CS%Leith_Ah) Leith_Ah_q(I,J) = CS%biharm5_const_xx(I,J) * vert_vort_mag enddo ; enddo -end subroutine calc_vert_vort_mag +end subroutine calc_Leith_viscosity subroutine VarMix_init(Time, G, param_file, diag, CS) type(time_type), intent(in) :: Time !< Current model time @@ -862,6 +870,9 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) ! value is roughly (pi / (the age of the universe) )^2. logical :: Gill_equatorial_Ld, use_FGNV_streamfn, use_MEKE, in_use real :: MLE_front_length + real :: Leith_Lap_const ! The non-dimensional coefficient in the Leith viscosity + real :: Leith_bi_const ! The non-dimensional coefficient in the bi-harmonic Leith viscosity + real :: DX2, DY2, grid_sp_2, grid_sp_3 ! Intermediate quantities for Leith metrics ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_lateral_mixing_coeffs" ! This module's name. @@ -1158,11 +1169,11 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) "If true, add a term to Leith viscosity which is \n"//& "proportional to the gradient of divergence.", & default=.false.) - call get_param(param_file, mdl, "LEITH_LAP_CONST", CS%Leith_Lap_const, & + call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & "The nondimensional Laplacian Leith constant, \n"//& "often set to 1.0", units="nondim", default=0.0, & fail_if_missing = CS%Leith_Kh) - call get_param(param_file, mdl, "LEITH_BI_CONST", CS%Leith_bi_const, & + call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & "The nondimensional biharmonic Leith constant, \n"//& "typical values are thus far undetermined.", units="nondim", default=0.0, & fail_if_missing = CS%Leith_Ah) @@ -1176,6 +1187,42 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) "is strongly encouraged, and no slip BCs are not used with \n"//& "the biharmonic viscosity.", default=.false.) endif + if (CS%Leith_Kh) then + allocate(CS%Laplac3_const_xx(isd:ied,jsd:jed)) ; CS%Laplac3_const_xx(:,:) = 0.0 + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + DX2 = G%dxT(i,j)*G%dxT(i,j) + DY2 = G%dyT(i,j)*G%dyT(i,j) + grid_sp_2 = (2.0*DX2*DY2) / (DX2 + DY2) + grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) + CS%Laplac3_const_xx(i,j) = Leith_Lap_const * grid_sp_3 + enddo ; enddo + allocate(CS%Laplac3_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Laplac3_const_xy(:,:) = 0.0 + do J=js-1,Jeq ; do I=is-1,Ieq + DX2 = G%dxBu(I,J)*G%dxBu(I,J) + DY2 = G%dyBu(I,J)*G%dyBu(I,J) + grid_sp_2 = (2.0*DX2*DY2) / (DX2 + DY2) + grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) + CS%Laplac3_const_xy(I,J) = Leith_Lap_const * grid_sp_3 + enddo ; enddo + endif + if (CS%Leith_Ah) then + allocate(CS%biharm5_const_xx(isd:ied,jsd:jed)) ; CS%biharm5_const_xx(:,:) = 0.0 + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + DX2 = G%dxT(i,j)*G%dxT(i,j) + DY2 = G%dyT(i,j)*G%dyT(i,j) + grid_sp_2 = (2.0*DX2*DY2) / (DX2+DY2) + grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) + CS%biharm5_const_xx(i,j) = Leith_bi_const * (grid_sp_2 * grid_sp_3) + enddo ; enddo + allocate(CS%biharm5_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm5_const_xy(:,:) = 0.0 + do J=js-1,Jeq ; do I=is-1,Ieq + DX2 = G%dxBu(I,J)*G%dxBu(I,J) + DY2 = G%dyBu(I,J)*G%dyBu(I,J) + grid_sp_2 = (2.0*DX2*DY2) / (DX2+DY2) + grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) + CS%biharm5_const_xy(I,J) = Leith_bi_const * (grid_sp_2 * grid_sp_3) + enddo ; enddo + endif ! If nothing is being stored in this class then deallocate if (in_use) then From b39edff245773cdbd61e7afa02d99321e29f8e0e Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 5 Dec 2017 11:36:07 -0500 Subject: [PATCH 007/106] Cleaned up left over arrays from moving Leith out of MOM_hor_visc.F90 - Removed allocatable arrays and a left over parameter. --- .../lateral/MOM_hor_visc.F90 | 52 +------------------ 1 file changed, 2 insertions(+), 50 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index cc3359a070..22dd8f4b22 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -117,8 +117,6 @@ module MOM_hor_visc ! nonlinear eddy viscosity. AH is the background. logical :: Leith_Kh ! If true, use 2D Leith nonlinear eddy ! viscosity. KH is the background value. - logical :: Modified_Leith ! If true, use extra component of Leith viscosity - ! to damp divergent flow. To use, still set Leith_Kh=.TRUE. logical :: Leith_Ah ! If true, use a biharmonic form of 2D Leith ! nonlinear eddy viscosity. AH is the background. logical :: bound_Coriolis ! If true & SMAGORINSKY_AH is used, the biharmonic @@ -184,15 +182,11 @@ module MOM_hor_visc ! parameters and metric terms. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & Laplac_Const_xx, & ! Laplacian metric-dependent constants (nondim) - Biharm_Const_xx, & ! Biharmonic metric-dependent constants (nondim) - Laplac3_Const_xx, & ! Laplacian metric-dependent constants (nondim) - Biharm5_Const_xx ! Biharmonic metric-dependent constants (nondim) + Biharm_Const_xx ! Biharmonic metric-dependent constants (nondim) real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & Laplac_Const_xy, & ! Laplacian metric-dependent constants (nondim) - Biharm_Const_xy, & ! Biharmonic metric-dependent constants (nondim) - Laplac3_Const_xy, & ! Laplacian metric-dependent constants (nondim) - Biharm5_Const_xy ! Biharmonic metric-dependent constants (nondim) + Biharm_Const_xy ! Biharmonic metric-dependent constants (nondim) type(diag_ctrl), pointer :: diag ! structure to regulate diagnostic timing @@ -1012,7 +1006,6 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) CS%bound_Kh = .false. ; CS%better_bound_Kh = .false. ; CS%Smagorinsky_Kh = .false. ; CS%Leith_Kh = .false. CS%bound_Ah = .false. ; CS%better_bound_Ah = .false. ; CS%Smagorinsky_Ah = .false. ; CS%Leith_Ah = .false. CS%bound_Coriolis = .false. - CS%Modified_Leith = .false. Kh = 0.0 ; Ah = 0.0 @@ -1050,17 +1043,6 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) "If true, use a Leith nonlinear eddy viscosity.", & default=.false.) - call get_param(param_file, mdl, "MODIFIED_LEITH", CS%Modified_Leith, & - "If true, add a term to Leith viscosity which is \n"//& - "proportional to the gradient of divergence.", & - default=.false.) - - if (CS%Leith_Kh .or. get_all) & - call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & - "The nondimensional Laplacian Leith constant, \n"//& - "often ??", units="nondim", default=0.0, & - fail_if_missing = CS%Leith_Kh) - call get_param(param_file, mdl, "BOUND_KH", CS%bound_Kh, & "If true, the Laplacian coefficient is locally limited \n"//& "to be stable.", default=.true.) @@ -1124,13 +1106,6 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) endif endif - if (CS%Leith_Ah .or. get_all) then - call get_param(param_file, mdl, "LEITH_BI_CONST",Leith_bi_const, & - "The nondimensional biharmonic Leith constant, \n"//& - "typical values are thus far undetermined", units="nondim", default=0.0, & - fail_if_missing = CS%Leith_Ah) - endif - endif call get_param(param_file, mdl, "USE_LAND_MASK_FOR_HVISC", CS%use_land_mask, & @@ -1198,10 +1173,6 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) ALLOC_(CS%Laplac_Const_xx(isd:ied,jsd:jed)) ; CS%Laplac_Const_xx(:,:) = 0.0 ALLOC_(CS%Laplac_Const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Laplac_Const_xy(:,:) = 0.0 endif - if (CS%Leith_Kh) then - ALLOC_(CS%Laplac3_Const_xx(isd:ied,jsd:jed)) ; CS%Laplac3_Const_xx(:,:) = 0.0 - ALLOC_(CS%Laplac3_Const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Laplac3_Const_xy(:,:) = 0.0 - endif endif ALLOC_(CS%reduction_xx(isd:ied,jsd:jed)) ; CS%reduction_xx(:,:) = 0.0 @@ -1239,10 +1210,6 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) ALLOC_(CS%Biharm_Const2_xy(IsdB:IedB,JsdB:JedB)) ; CS%Biharm_Const2_xy(:,:) = 0.0 endif endif - if (CS%Leith_Ah) then - ALLOC_(CS%Biharm5_Const_xx(isd:ied,jsd:jed)) ; CS%Biharm5_Const_xx(:,:) = 0.0 - ALLOC_(CS%Biharm5_Const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Biharm5_Const_xy(:,:) = 0.0 - endif endif do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 @@ -1294,7 +1261,6 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j) + CS%DY2h(i,j)) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) if (CS%Smagorinsky_Kh) CS%LAPLAC_CONST_xx(i,j) = Smag_Lap_const * grid_sp_h2 - if (CS%Leith_Kh) CS%LAPLAC3_CONST_xx(i,j) = Leith_Lap_const * grid_sp_h3 CS%Kh_bg_xx(i,j) = MAX(Kh, Kh_vel_scale * sqrt(grid_sp_h2)) @@ -1309,7 +1275,6 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J) + CS%DY2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) if (CS%Smagorinsky_Kh) CS%LAPLAC_CONST_xy(I,J) = Smag_Lap_const * grid_sp_q2 - if (CS%Leith_Kh) CS%LAPLAC3_CONST_xy(I,J) = Leith_Lap_const * grid_sp_q3 CS%Kh_bg_xy(I,J) = MAX(Kh, Kh_vel_scale * sqrt(grid_sp_q2)) @@ -1352,9 +1317,6 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) (fmax * BoundCorConst) endif endif - if (CS%Leith_Ah) then - CS%BIHARM5_CONST_xx(i,j) = Leith_bi_const * (grid_sp_h2 * grid_sp_h3) - endif CS%Ah_bg_xx(i,j) = MAX(Ah, Ah_vel_scale * grid_sp_h2 * sqrt(grid_sp_h2)) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then @@ -1374,10 +1336,6 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) endif endif - if (CS%Leith_Ah) then - CS%BIHARM5_CONST_xy(I,J) = Leith_bi_const * (grid_sp_q2 * grid_sp_q3) - endif - CS%Ah_bg_xy(I,J) = MAX(Ah, Ah_vel_scale * grid_sp_q2 * sqrt(grid_sp_q2)) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then CS%Ah_Max_xy(I,J) = Ah_Limit * (grid_sp_q2 * grid_sp_q2) @@ -1533,9 +1491,6 @@ subroutine hor_visc_end(CS) if (CS%Smagorinsky_Kh) then DEALLOC_(CS%Laplac_Const_xx) ; DEALLOC_(CS%Laplac_Const_xy) endif - if (CS%Leith_Kh) then - DEALLOC_(CS%Laplac3_Const_xx) ; DEALLOC_(CS%Laplac3_Const_xy) - endif endif if (CS%biharmonic) then @@ -1551,9 +1506,6 @@ subroutine hor_visc_end(CS) DEALLOC_(CS%Biharm_Const2_xx) ; DEALLOC_(CS%Biharm_Const2_xy) endif endif - if (CS%Leith_Ah) then - DEALLOC_(CS%Biharm5_Const_xx) ; DEALLOC_(CS%Biharm5_Const_xy) - endif endif deallocate(CS) From f08592f7727fcd19dbade006124970482e393c57 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 6 Dec 2017 13:59:51 -0500 Subject: [PATCH 008/106] Added independent flag for beta-term in Leith - USE_BETA_IN_LEITH now controls the beta-term in the Leith viscosity. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 20 ++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 764e393188..4298963ac7 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -111,6 +111,7 @@ module MOM_lateral_mixing_coeffs ! Leith parameters logical :: use_QG_Leith !< If true, enables the QG Leith scheme + logical :: use_beta_in_Leith !< If true, includes the beta term in the Leith viscosity logical :: Leith_Kh !< If true, enables the Leith scheme logical :: modified_Leith !< if true, include the divergence contribution to Leith viscosity logical :: Leith_Ah !< If true, enables the bi-harmonic Leith scheme @@ -820,8 +821,8 @@ subroutine calc_Leith_viscosity(CS, G, GV, u, v, h, k, Leith_Kh_h, Leith_Kh_q, L vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo - ! Add in beta for QG Leith - if (CS%use_QG_Leith) then + ! Add in beta for the Leith viscosity + if (CS%use_beta_in_Leith) then do J=js-2,Jeq+1 ; do I=is-1,Ieq+1 vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1) ) enddo ; enddo @@ -1156,15 +1157,21 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) endif ! Leith parameters + call get_param(param_file, mdl, "USE_QG_LEITH", CS%use_QG_Leith, & + "If true, use the QG Leith nonlinear eddy viscosity.", & + default=.false.) call get_param(param_file, mdl, "LEITH_KH", CS%Leith_Kh, & "If true, use a Leith nonlinear eddy viscosity.", & default=CS%use_QG_Leith) + if (CS%use_QG_Leith .and. .not. CS%Leith_Kh) call MOM_error(FATAL, & + "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& + "LEITH_KH must be True when USE_QG_LEITH=True.") + call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_Leith, & + "If true, include the beta term in the QG Leith nonlinear eddy viscosity.", & + default=CS%use_QG_Leith) call get_param(param_file, mdl, "LEITH_AH", CS%Leith_Ah, & "If true, use a biharmonic Leith nonlinear eddy \n"//& "viscosity.", default=.false.) - call get_param(param_file, mdl, "USE_QG_LEITH", CS%use_QG_Leith, & - "If true, use the QG Leith nonlinear eddy viscosity.", & - default=.false.) call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & "If true, add a term to Leith viscosity which is \n"//& "proportional to the gradient of divergence.", & @@ -1186,6 +1193,9 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) "cleaner than the no slip BCs. The use of free slip BCs \n"//& "is strongly encouraged, and no slip BCs are not used with \n"//& "the biharmonic viscosity.", default=.false.) + if (.not. CS%use_stored_slopes) call MOM_error(FATAL, & + "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& + "USE_STORED_SLOPES must be True when ing Leith.") endif if (CS%Leith_Kh) then allocate(CS%Laplac3_const_xx(isd:ied,jsd:jed)) ; CS%Laplac3_const_xx(:,:) = 0.0 From 69f2c755e7acbed9c6f5ff016b4817c34fdf90f9 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 6 Dec 2017 15:46:36 -0500 Subject: [PATCH 009/106] Added stretching term for QG Leith viscosity - Nasty expressions for harmonic mean h's at u/v points for vertical derivatives of slopes... Eek! --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 63 ++++++++++++++++--- 1 file changed, 55 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 4298963ac7..2820ea7e45 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -413,12 +413,14 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) if (.not. ASSOCIATED(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& "Module must be initialized before it is used.") - if (CS%calculate_Eady_growth_rate) then + if (CS%calculate_Eady_growth_rate .or. CS%use_stored_slopes) then call find_eta(h, tv, GV%g_Earth, G, GV, e, halo_size=2) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) - call calc_Visbeck_coeffs(h, e, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS) + if (CS%calculate_Eady_growth_rate) then + call calc_Visbeck_coeffs(h, e, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS) + endif ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) else !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) @@ -759,13 +761,18 @@ subroutine calc_Leith_viscosity(CS, G, GV, u, v, h, k, Leith_Kh_h, Leith_Kh_q, L dvdx ! Zonal shear of meridional velocity (s-1) real, dimension(SZI_(G),SZJB_(G)) :: & vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) - div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) + div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) + dslopey_dz, & ! z-derivative of y-slope at v-points (m-1) + h_at_v ! Thickness at v-points (m or kg m-2) real, dimension(SZIB_(G),SZJ_(G)) :: & vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) - div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) + div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) + dslopex_dz, & ! z-derivative of x-slope at u-points (m-1) + h_at_u ! Thickness at u-points (m or kg m-2) real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points (s-1) real :: mod_Leith, DY_dxBu, DX_dyBu, vert_vort_mag + real :: h_at_slope_above, h_at_slope_below, Ih, f integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -811,26 +818,66 @@ subroutine calc_Leith_viscosity(CS, G, GV, u, v, h, k, Leith_Kh_h, Leith_Kh_q, L endif ! Vorticity gradient - do J=js-2,Jeq+1 ; do I=is-1,Ieq+1 + do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) enddo ; enddo - do J=js-1,Jeq+1 ; do I=is-2,Ieq+1 + do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo ! Add in beta for the Leith viscosity if (CS%use_beta_in_Leith) then - do J=js-2,Jeq+1 ; do I=is-1,Ieq+1 + do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1) ) enddo ; enddo - do J=js-1,Jeq+1 ; do I=is-2,Ieq+1 + do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j) ) enddo ; enddo endif + ! Add in stretching term for the QG Leith vsicosity + if (CS%use_QG_Leith) then + do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 + h_at_slope_above = 2. * ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) * h(i+1,j,k) ) / & + ( ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) + h(i+1,j,k) ) & + + ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k-1) + h(i+1,j,k-1) ) + GV%H_subroundoff ) + h_at_slope_below = 2. * ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k+1) * h(i+1,j,k+1) ) / & + ( ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k+1) + h(i+1,j,k+1) ) & + + ( h(i,j,k+1) * h(i+1,j,k+1) ) * ( h(i,j,k) + h(i+1,j,k) ) + GV%H_subroundoff ) + Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_m ) + dslopex_dz(I,j) = 2. * ( CS%slope_x(i,j,k) - CS%slope_x(i,j,k+1) ) * Ih + h_at_u(I,j) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih + enddo ; enddo + do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 + h_at_slope_above = 2. * ( h(i,j,k-1) * h(i,j+1,k-1) ) * ( h(i,j,k) * h(i,j+1,k) ) / & + ( ( h(i,j,k-1) * h(i,j+1,k-1) ) * ( h(i,j,k) + h(i,j+1,k) ) & + + ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k-1) + h(i,j+1,k-1) ) + GV%H_subroundoff ) + h_at_slope_below = 2. * ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k+1) * h(i,j+1,k+1) ) / & + ( ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k+1) + h(i,j+1,k+1) ) & + + ( h(i,j,k+1) * h(i,j+1,k+1) ) * ( h(i,j,k) + h(i,j+1,k) ) + GV%H_subroundoff ) + Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_m ) + dslopey_dz(i,J) = 2. * ( CS%slope_y(i,j,k) - CS%slope_y(i,j,k+1) ) * Ih + h_at_v(i,J) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih + enddo ; enddo + do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 + f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) + vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * & + ( ( h_at_u(I,j) * dslopex_dz(I,j) + h_at_u(I-1,j+1) * dslopex_dz(I-1,j+1) ) & + + ( h_at_u(I-1,j) * dslopex_dz(I-1,j) + h_at_u(I,j+1) * dslopex_dz(I,j+1) ) ) / & + ( ( h_at_u(I,j) + h_at_u(I-1,j+1) ) + ( h_at_u(I-1,j) + h_at_u(I,j+1) ) ) + enddo ; enddo + do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 + f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) + vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * & + ( ( h_at_v(i,J) * dslopey_dz(i,J) + h_at_v(i+1,J-1) * dslopey_dz(i+1,J-1) ) & + + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / & + ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) ) + enddo ; enddo + endif + mod_Leith = 0.; if (CS%modified_Leith) mod_Leith = 1.0 ! h-point viscosities From 7746539d57f79a0c401faf8c8627017ef414d08d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 10 Oct 2018 17:14:44 -0600 Subject: [PATCH 010/106] Deletes unecessary code and adds Leith_Kh_* --- .../lateral/MOM_hor_visc.F90 | 85 ++++++++++--------- 1 file changed, 44 insertions(+), 41 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 87b95cd5cb..3c5cc6213b 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -238,6 +238,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real :: KhSm ! Smagorinsky Laplacian viscosity (m2/s) real :: AhLth ! 2D Leith biharmonic viscosity (m4/s) real :: KhLth ! 2D Leith Laplacian viscosity (m2/s) + real :: mod_Leith ! nondimensional coefficient for divergence part of modified Leith + ! viscosity. Here set equal to nondimensional Laplacian Leith constant. + ! This is set equal to zero if modified Leith is not used. real :: Shear_mag ! magnitude of the shear (1/s) real :: h2uq, h2vq ! temporary variables in units of H^2 (i.e. m2 or kg2 m-4). real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner @@ -468,15 +471,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! Calculate horizontal divergence (not from continuity) if needed. ! h_u and h_v include modifications at OBCs from above. - if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - div_xx(i,j) = ((G%dyCu(I ,j) * u(I ,j,k) * h_u(I ,j) - & - G%dyCu(I-1,j) * u(I-1,j,k) * h_u(I-1,j) ) + & - (G%dxCv(i,J ) * v(i,J ,k) * h_v(i,J ) - & - G%dxCv(i,J-1) * v(i,J-1,k) * h_v(i,J-1) ) )*G%IareaT(i,j)/ & - (h(i,j,k) + h_neglect) - enddo ; enddo - endif +! if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then +! do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 +! div_xx(i,j) = ((G%dyCu(I ,j) * u(I ,j,k) * h_u(I ,j) - & +! G%dyCu(I-1,j) * u(I-1,j,k) * h_u(I-1,j) ) + & +! (G%dxCv(i,J ) * v(i,J ,k) * h_v(i,J ) - & +! G%dxCv(i,J-1) * v(i,J-1,k) * h_v(i,J-1) ) )*G%IareaT(i,j)/ & +! (h(i,j,k) + h_neglect) +! enddo ; enddo +! endif ! Shearing strain (including no-slip boundary conditions at the 2-D land-sea mask). ! dudy and dvdx include modifications at OBCs from above. @@ -490,37 +493,37 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, enddo ; enddo endif - if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - ! Calculate relative vorticity (including no-slip boundary conditions at the 2-D land-sea mask). - ! dudy and dvdx include modifications at OBCs from above. - if (CS%no_slip) then - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) - enddo ; enddo - else - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) - enddo ; enddo - endif - - ! Vorticity gradient - do J=js-2,Jeq+1 ; do I=is-1,Ieq+1 - vort_xy_dx(i,J) = CS%DY_dxBu(I,J)*(vort_xy(I,J)*G%IdyCu(I,j) - vort_xy(I-1,J)*G%IdyCu(I-1,j)) - enddo ; enddo - - do J=js-1,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy_dy(I,j) = CS%DX_dyBu(I,J)*(vort_xy(I,J)*G%IdxCv(i,J) - vort_xy(I,J-1)*G%IdxCv(i,J-1)) - enddo ; enddo - +! if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then +! ! Calculate relative vorticity (including no-slip boundary conditions at the 2-D land-sea mask). +! ! dudy and dvdx include modifications at OBCs from above. +! if (CS%no_slip) then +! do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 +! vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) +! enddo ; enddo +! else +! do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 +! vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) +! enddo ; enddo +! endif +! +! ! Vorticity gradient +! do J=js-2,Jeq+1 ; do I=is-1,Ieq+1 +! vort_xy_dx(i,J) = CS%DY_dxBu(I,J)*(vort_xy(I,J)*G%IdyCu(I,j) - vort_xy(I-1,J)*G%IdyCu(I-1,j)) +! enddo ; enddo +! +! do J=js-1,Jeq+1 ; do I=is-2,Ieq+1 +! vort_xy_dy(I,j) = CS%DX_dyBu(I,J)*(vort_xy(I,J)*G%IdxCv(i,J) - vort_xy(I,J-1)*G%IdxCv(i,J-1)) +! enddo ; enddo +! ! Divergence gradient - do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) - enddo ; enddo - - do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) - enddo ; enddo - endif +! do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 +! div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) +! enddo ; enddo +! +! do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 +! div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) +! enddo ; enddo +! endif ! Evaluate u0 = x.Div(Grad u) and v0 = y.Div( Grad u) if (CS%biharmonic) then @@ -569,7 +572,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! largest value from several parameterizations. Kh = CS%Kh_bg_xx(i,j) ! Static (pre-computed) background viscosity if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%LAPLAC_CONST_xx(i,j) * Shear_mag ) - if (CS%Leith_Kh) Kh = max( Kh, CS%LAPLAC3_CONST_xx(i,j) * Vort_mag ) + if (CS%Leith_Kh) Kh = max( Kh, Leith_Kh_h(i,j)) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_h(i,j) * Kh ! Older method of bounding for stability @@ -722,7 +725,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! largest value from several parameterizations. Kh = CS%Kh_bg_xy(i,j) ! Static (pre-computed) background viscosity if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%LAPLAC_CONST_xy(I,J) * Shear_mag ) - if (CS%Leith_Kh) Kh = max( Kh, CS%LAPLAC3_CONST_xy(I,J) * Vort_mag) + if (CS%Leith_Kh) Kh = max( Kh, Leith_Kh_q(I,J)) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_q(i,j) * Kh ! Older method of bounding for stability From cda9edd516c90fd22861a3692d28929283493cd0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 11 Oct 2018 10:25:49 -0600 Subject: [PATCH 011/106] Deletes unneeded code --- .../lateral/MOM_hor_visc.F90 | 44 ------------------- 1 file changed, 44 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 3c5cc6213b..a8c1a0afc3 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -469,18 +469,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif enddo ; endif - ! Calculate horizontal divergence (not from continuity) if needed. - ! h_u and h_v include modifications at OBCs from above. -! if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then -! do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 -! div_xx(i,j) = ((G%dyCu(I ,j) * u(I ,j,k) * h_u(I ,j) - & -! G%dyCu(I-1,j) * u(I-1,j,k) * h_u(I-1,j) ) + & -! (G%dxCv(i,J ) * v(i,J ,k) * h_v(i,J ) - & -! G%dxCv(i,J-1) * v(i,J-1,k) * h_v(i,J-1) ) )*G%IareaT(i,j)/ & -! (h(i,j,k) + h_neglect) -! enddo ; enddo -! endif - ! Shearing strain (including no-slip boundary conditions at the 2-D land-sea mask). ! dudy and dvdx include modifications at OBCs from above. if (CS%no_slip) then @@ -493,38 +481,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, enddo ; enddo endif -! if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then -! ! Calculate relative vorticity (including no-slip boundary conditions at the 2-D land-sea mask). -! ! dudy and dvdx include modifications at OBCs from above. -! if (CS%no_slip) then -! do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 -! vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) -! enddo ; enddo -! else -! do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 -! vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) -! enddo ; enddo -! endif -! -! ! Vorticity gradient -! do J=js-2,Jeq+1 ; do I=is-1,Ieq+1 -! vort_xy_dx(i,J) = CS%DY_dxBu(I,J)*(vort_xy(I,J)*G%IdyCu(I,j) - vort_xy(I-1,J)*G%IdyCu(I-1,j)) -! enddo ; enddo -! -! do J=js-1,Jeq+1 ; do I=is-2,Ieq+1 -! vort_xy_dy(I,j) = CS%DX_dyBu(I,J)*(vort_xy(I,J)*G%IdxCv(i,J) - vort_xy(I,J-1)*G%IdxCv(i,J-1)) -! enddo ; enddo -! - ! Divergence gradient -! do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 -! div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) -! enddo ; enddo -! -! do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 -! div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) -! enddo ; enddo -! endif - ! Evaluate u0 = x.Div(Grad u) and v0 = y.Div( Grad u) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 From 84542af50fa068ecf50d3e6e934713e48b09ace8 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Mon, 15 Oct 2018 16:26:00 -0600 Subject: [PATCH 012/106] QG Leith code refactoring --- .../lateral/MOM_hor_visc.F90 | 164 +++++++- .../lateral/MOM_lateral_mixing_coeffs.F90 | 396 +++++++++--------- 2 files changed, 347 insertions(+), 213 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index a8c1a0afc3..f358715377 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -54,8 +54,11 @@ module MOM_hor_visc !! viscosity. KH is the background value. logical :: Modified_Leith !< If true, use extra component of Leith viscosity !! to damp divergent flow. To use, still set Leith_Kh=.TRUE. + logical :: use_beta_in_Leith !< If true, includes the beta term in the Leith viscosity logical :: Leith_Ah !< If true, use a biharmonic form of 2D Leith !! nonlinear eddy viscosity. AH is the background. + logical :: use_QG_Leith !< If true, use QG Leith nonlinear eddy viscosity. + !! KH is the background value. logical :: bound_Coriolis !< If true & SMAGORINSKY_AH is used, the biharmonic !! viscosity is modified to include a term that !! scales quadratically with the velocity shears. @@ -201,13 +204,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - u0, & ! Laplacian of u (m-1 s-1) - h_u ! Thickness interpolated to u points, in H. + u0, & ! Laplacian of u (m-1 s-1) + h_u, & ! Thickness interpolated to u points, in H. + vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) + div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) real, dimension(SZI_(G),SZJB_(G)) :: & - v0, & ! Laplacian of v (m-1 s-1) - h_v ! Thickness interpolated to v points, in H. - + v0, & ! Laplacian of v (m-1 s-1) + h_v, & ! Thickness interpolated to v points, in H. + vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) + div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) real, dimension(SZI_(G),SZJ_(G)) :: & + div_xx, & ! Estimate of horizontal divergence at h-points (s-1) sh_xx, & ! horizontal tension (du/dx - dv/dy) (1/sec) including metric terms str_xx,& ! str_xx is the diagonal term in the stress tensor (H m2 s-2) bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution (H m2 s-2) @@ -220,6 +227,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) (1/sec) including metric terms str_xy, & ! str_xy is the cross term in the stress tensor (H m2 s-2) bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution (H m2 s-2) + vort_xy, & ! Vertical vorticity (dv/dx - du/dy) (s-1) Leith_Kh_q, & ! Leith Laplacian viscosity at q-points (m2 s-1) Leith_Ah_q ! Leith bi-harmonic viscosity at q-points (m4 s-1) @@ -242,6 +250,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! viscosity. Here set equal to nondimensional Laplacian Leith constant. ! This is set equal to zero if modified Leith is not used. real :: Shear_mag ! magnitude of the shear (1/s) + real :: vert_vort_mag ! magnitude of the vertical vorticity gradient (m-1 s-1) real :: h2uq, h2vq ! temporary variables in units of H^2 (i.e. m2 or kg2 m-4). real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner ! points; these are first interpolated to u or v velocity @@ -508,8 +517,73 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - call calc_Leith_viscosity(VarMix, G, GV, u, v, h, k, Leith_Kh_h, Leith_Kh_q, Leith_Ah_h, Leith_Ah_q) - endif + ! Divergence + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & + G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & + (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & + G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & + (h(i,j,k) + GV%H_subroundoff) + enddo ; enddo + + ! Divergence gradient + do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 + div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) + enddo ; enddo + + do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 + div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) + enddo ; enddo + + ! Components for the vertical vorticity + ! Note this a simple re-calculation of shearing components using the same discretization. + ! We will consider using a circulation based calculation of vorticity later. + ! Also note this will need OBC boundary conditions re-applied... + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) + dvdx(I,J) = DY_dxBu * (v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) + DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) + dudy(I,J) = DX_dyBu * (u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) + enddo ; enddo + + ! Vorticity + if (CS%no_slip) then + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) + enddo ; enddo + else + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) + enddo ; enddo + endif + + ! Vorticity gradient + do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 + DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) + vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) + enddo ; enddo + + do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 + DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) + vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) + enddo ; enddo + + ! Add in beta for the Leith viscosity + if (CS%use_beta_in_Leith) then + do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 + vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1) ) + enddo ; enddo + do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 + vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j) ) + enddo ; enddo + endif + + mod_Leith = 0.; if (CS%modified_Leith) mod_Leith = 1.0 + + if (CS%use_QG_Leith) then + call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, vort_xy_dx, vort_xy_dy) + endif + endif do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then @@ -517,6 +591,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) endif + if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then + vert_vort_mag = sqrt( & + 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & + (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & + mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)*div_xx_dx(I-1,j)) + & + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) + endif if (CS%better_bound_Ah .or. CS%better_bound_Kh) then hrat_min = min(1.0, min(h_u(I,j), h_u(I-1,j), h_v(i,J), h_v(i,J-1)) / & (h(i,j,k) + h_neglect) ) @@ -528,7 +609,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! largest value from several parameterizations. Kh = CS%Kh_bg_xx(i,j) ! Static (pre-computed) background viscosity if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%LAPLAC_CONST_xx(i,j) * Shear_mag ) - if (CS%Leith_Kh) Kh = max( Kh, Leith_Kh_h(i,j)) + if (CS%Leith_Kh) Kh = max( Kh, CS%LAPLAC3_CONST_xx(i,j) * vert_vort_mag) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_h(i,j) * Kh ! Older method of bounding for stability @@ -576,7 +657,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, AhSm = CS%BIHARM_CONST_xx(i,j) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = Leith_Ah_h(i,j) + if (CS%Leith_Ah) AhLth = CS%BIHARM5_CONST_xx(i,j) * vert_vort_mag Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm),AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xx(i,j)) @@ -642,7 +723,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, 0.25*((sh_xx(i,j)*sh_xx(i,j) + sh_xx(i+1,j+1)*sh_xx(i+1,j+1)) + & (sh_xx(i,j+1)*sh_xx(i,j+1) + sh_xx(i+1,j)*sh_xx(i+1,j)))) endif - + if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then + vert_vort_mag = sqrt( & + 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & + (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & + mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)*div_xx_dx(I,j+1)) + & + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) + endif h2uq = 4.0 * h_u(I,j) * h_u(I,j+1) h2vq = 4.0 * h_v(i,J) * h_v(i+1,J) !hq = 2.0 * h2uq * h2vq / (h_neglect3 + (h2uq + h2vq) * & @@ -681,7 +768,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! largest value from several parameterizations. Kh = CS%Kh_bg_xy(i,j) ! Static (pre-computed) background viscosity if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%LAPLAC_CONST_xy(I,J) * Shear_mag ) - if (CS%Leith_Kh) Kh = max( Kh, Leith_Kh_q(I,J)) + if (CS%Leith_Kh) Kh = max( Kh, CS%LAPLAC3_CONST_xy(I,J) * vert_vort_mag) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_q(i,j) * Kh ! Older method of bounding for stability @@ -732,7 +819,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, AhSm = CS%BIHARM_CONST_xy(I,J) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = Leith_Ah_q(I,J) + if (CS%Leith_Ah) AhLth = CS%BIHARM5_CONST_xy(I,J) * vert_vort_mag Ah = MAX(MAX(CS%Ah_bg_xy(I,J), AhSm),AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xy(I,J)) @@ -971,6 +1058,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) ! cases where the corresponding parameters are not read. CS%bound_Kh = .false. ; CS%better_bound_Kh = .false. ; CS%Smagorinsky_Kh = .false. ; CS%Leith_Kh = .false. CS%bound_Ah = .false. ; CS%better_bound_Ah = .false. ; CS%Smagorinsky_Ah = .false. ; CS%Leith_Ah = .false. + CS%use_QG_Leith = .false. CS%bound_Coriolis = .false. CS%Modified_Leith = .false. CS%anisotropic = .false. @@ -1020,7 +1108,27 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "LEITH_KH", CS%Leith_Kh, & "If true, use a Leith nonlinear eddy viscosity.", & default=.false.) - + if (CS%Leith_Kh .or. get_all) then + call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & + "The nondimensional Laplacian Leith constant, \n"//& + "often set to 1.0", units="nondim", default=0.0, & + fail_if_missing = CS%Leith_Kh) + call get_param(param_file, mdl, "USE_QG_LEITH", CS%use_QG_Leith, & + "If true, use QG Leith nonlinear eddy viscosity.", & + default=.false.) + if (CS%use_QG_Leith .and. .not. CS%Leith_Kh) call MOM_error(FATAL, & + "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& + "LEITH_KH must be True when USE_QG_LEITH=True.") + endif + if (CS%Leith_Kh .or. CS%Leith_Ah .or. get_all) then + call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_Leith, & + "If true, include the beta term in the QG Leith nonlinear eddy viscosity.", & + default=CS%use_QG_Leith) + call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & + "If true, add a term to Leith viscosity which is \n"//& + "proportional to the gradient of divergence.", & + default=.false.) + endif call get_param(param_file, mdl, "BOUND_KH", CS%bound_Kh, & "If true, the Laplacian coefficient is locally limited \n"//& "to be stable.", default=.true.) @@ -1109,6 +1217,11 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) units="m s-1", default=maxvel) endif endif + if (CS%Leith_Ah .or. get_all) + call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & + "The nondimensional biharmonic Leith constant, \n"//& + "typical values are thus far undetermined.", units="nondim", default=0.0, & + fail_if_missing = CS%Leith_Ah) endif @@ -1179,7 +1292,10 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) ALLOC_(CS%Laplac_Const_xx(isd:ied,jsd:jed)) ; CS%Laplac_Const_xx(:,:) = 0.0 ALLOC_(CS%Laplac_Const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Laplac_Const_xy(:,:) = 0.0 endif - + if (CS%Leith_Kh) then + ALLOC_(CS%Laplac3_const_xx(isd:ied,jsd:jed)) ; CS%Laplac3_const_xx(:,:) = 0.0 + ALLOC_(CS%Laplac3_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Laplac3_const_xy(:,:) = 0.0 + endif endif ALLOC_(CS%reduction_xx(isd:ied,jsd:jed)) ; CS%reduction_xx(:,:) = 0.0 ALLOC_(CS%reduction_xy(IsdB:IedB,JsdB:JedB)) ; CS%reduction_xy(:,:) = 0.0 @@ -1234,6 +1350,10 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) ALLOC_(CS%Biharm_Const2_xy(IsdB:IedB,JsdB:JedB)) ; CS%Biharm_Const2_xy(:,:) = 0.0 endif endif + if (CS%Leith_Ah) then + ALLOC_(CS%biharm5_const_xx(isd:ied,jsd:jed)) ; CS%biharm5_const_xx(:,:) = 0.0 + ALLOC_(CS%biharm5_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm5_const_xy(:,:) = 0.0 + endif endif do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 @@ -1288,7 +1408,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j) + CS%DY2h(i,j)) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) if (CS%Smagorinsky_Kh) CS%LAPLAC_CONST_xx(i,j) = Smag_Lap_const * grid_sp_h2 - + if (CS%Leith_Kh) CS%LAPLAC3_const_xx(i,j) = Leith_Lap_const * grid_sp_h3 ! Maximum of constant background and MICOM viscosity CS%Kh_bg_xx(i,j) = MAX(Kh, Kh_vel_scale * sqrt(grid_sp_h2)) @@ -1314,7 +1434,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J) + CS%DY2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) if (CS%Smagorinsky_Kh) CS%LAPLAC_CONST_xy(I,J) = Smag_Lap_const * grid_sp_q2 - + if (CS%Leith_Kh) CS%LAPLAC3_const_xy(I,J) = Leith_Lap_const * grid_sp_q3 ! Maximum of constant background and MICOM viscosity CS%Kh_bg_xy(I,J) = MAX(Kh, Kh_vel_scale * sqrt(grid_sp_q2)) @@ -1365,7 +1485,9 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) (fmax * BoundCorConst) endif endif - + if (CS%Leith_Ah) then + CS%biharm5_const_xx(i,j) = Leith_bi_const * (grid_sp_h2 * grid_sp_h3) + endif CS%Ah_bg_xx(i,j) = MAX(Ah, Ah_vel_scale * grid_sp_h2 * sqrt(grid_sp_h2)) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then CS%Ah_Max_xx(i,j) = Ah_Limit * (grid_sp_h2 * grid_sp_h2) @@ -1383,6 +1505,9 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) (abs(G%CoriolisBu(I,J)) * BoundCorConst) endif endif + if (CS%Leith_Ah) then + CS%biharm5_const_xy(i,j) = Leith_bi_const * (grid_sp_q2 * grid_sp_q3) + endif CS%Ah_bg_xy(I,J) = MAX(Ah, Ah_vel_scale * grid_sp_q2 * sqrt(grid_sp_q2)) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then @@ -1558,6 +1683,9 @@ subroutine hor_visc_end(CS) if (CS%Smagorinsky_Kh) then DEALLOC_(CS%Laplac_Const_xx) ; DEALLOC_(CS%Laplac_Const_xy) endif + if (CS%Leith_Kh) then + DEALLOC_(CS%Laplac3_Const_xx) ; DEALLOC_(CS%Laplac3_Const_xy) + endif endif if (CS%biharmonic) then @@ -1573,6 +1701,8 @@ subroutine hor_visc_end(CS) DEALLOC_(CS%Biharm_Const2_xx) ; DEALLOC_(CS%Biharm_Const2_xy) endif endif + if (CS%Leith_Ah) then + DEALLOC_(CS%Biharm5_Const_xx) ; DEALLOC_(CS%Biharm5_Const_xy) endif if (CS%anisotropic) then DEALLOC_(CS%n1n2_h) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index ceab645e3e..6d1fe58224 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -110,24 +110,24 @@ module MOM_lateral_mixing_coeffs real :: Visbeck_S_max !< Upper bound on slope used in Eady growth rate (nondim). ! Leith parameters - logical :: use_QG_Leith !< If true, enables the QG Leith scheme - logical :: use_beta_in_Leith !< If true, includes the beta term in the Leith viscosity - logical :: Leith_Kh !< If true, enables the Leith scheme - logical :: modified_Leith !< if true, include the divergence contribution to Leith viscosity - logical :: Leith_Ah !< If true, enables the bi-harmonic Leith scheme - logical :: no_slip !< If true, no slip boundary conditions are used. - !! Otherwise free slip boundary conditions are assumed. - !! The implementation of the free slip boundary - !! conditions on a C-grid is much cleaner than the - !! no slip boundary conditions. The use of free slip - !! b.c.s is strongly encouraged. The no slip b.c.s - !! are not implemented with the biharmonic viscosity. - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - Laplac3_const_xx, & ! Laplacian metric-dependent constants (nondim) - biharm5_const_xx ! Biharmonic metric-dependent constants (nondim) - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - Laplac3_const_xy, & ! Laplacian metric-dependent constants (nondim) - biharm5_const_xy ! Biharmonic metric-dependent constants (nondim) + logical :: use_QG_Leith_GM !< If true, uses the QG Leith viscosity as the GM coefficient +! logical :: use_beta_in_Leith !< If true, includes the beta term in the Leith viscosity +! logical :: Leith_Kh !< If true, enables the Leith scheme +! logical :: modified_Leith !< if true, include the divergence contribution to Leith viscosity +! logical :: Leith_Ah !< If true, enables the bi-harmonic Leith scheme +! logical :: no_slip !< If true, no slip boundary conditions are used. +! !! Otherwise free slip boundary conditions are assumed. +! !! The implementation of the free slip boundary +! !! conditions on a C-grid is much cleaner than the +! !! no slip boundary conditions. The use of free slip +! !! b.c.s is strongly encouraged. The no slip b.c.s +! !! are not implemented with the biharmonic viscosity. +! real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & +! Laplac3_const_xx, & ! Laplacian metric-dependent constants (nondim) +! biharm5_const_xx ! Biharmonic metric-dependent constants (nondim) +! real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & +! Laplac3_const_xy, & ! Laplacian metric-dependent constants (nondim) +! biharm5_const_xy ! Biharmonic metric-dependent constants (nondim) ! Diagnostics !>@{ @@ -743,103 +743,106 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) end subroutine calc_slope_functions_using_just_e !> Calculates the Leith Laplacian and bi-harmonic viscosity coefficients -subroutine calc_Leith_viscosity(CS, G, GV, u, v, h, k, Leith_Kh_h, Leith_Kh_q, Leith_Ah_h, Leith_Ah_q) +subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, vort_xy_dx, vort_xy_dy) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow (m s-1) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow (m s-1) +! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow (m s-1) +! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow (m s-1) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg m-2) integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity at h-points (m2 s-1) - real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity at q-points (m2 s-1) - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Ah_h !< Leith bi-harmonic viscosity at h-points (m4 s-1) - real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Ah_q !< Leith bi-harmonic viscosity at q-points (m4 s-1) + real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vort_xy_dx !< x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) + real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: vort_xy_dy !< y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) +! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity at h-points (m2 s-1) +! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity at q-points (m2 s-1) +! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Ah_h !< Leith bi-harmonic viscosity at h-points (m4 s-1) +! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Ah_q !< Leith bi-harmonic viscosity at q-points (m4 s-1) + ! Local variables - real, dimension(SZIB_(G),SZJB_(G)) :: vort_xy, & ! Vertical vorticity (dv/dx - du/dy) (s-1) - dudy, & ! Meridional shear of zonal velocity (s-1) - dvdx ! Zonal shear of meridional velocity (s-1) +! real, dimension(SZIB_(G),SZJB_(G)) :: vort_xy, & ! Vertical vorticity (dv/dx - du/dy) (s-1) +! dudy, & ! Meridional shear of zonal velocity (s-1) +! dvdx ! Zonal shear of meridional velocity (s-1) real, dimension(SZI_(G),SZJB_(G)) :: & - vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) - div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) +! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) +! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) dslopey_dz, & ! z-derivative of y-slope at v-points (m-1) h_at_v ! Thickness at v-points (m or kg m-2) real, dimension(SZIB_(G),SZJ_(G)) :: & - vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) - div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) +! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) +! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) dslopex_dz, & ! z-derivative of x-slope at u-points (m-1) h_at_u ! Thickness at u-points (m or kg m-2) - real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points (s-1) - real :: mod_Leith, DY_dxBu, DX_dyBu, vert_vort_mag +! real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points (s-1) +! real :: mod_Leith, DY_dxBu, DX_dyBu, vert_vort_mag real :: h_at_slope_above, h_at_slope_below, Ih, f integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - ! Divergence - do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & - G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & - (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & - (h(i,j,k) + GV%H_subroundoff) - enddo ; enddo - - ! Divergence gradient - do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 - div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) - enddo ; enddo - - do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 - div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) - enddo ; enddo - - ! Components for the vertical vorticity - ! Note this a simple re-calculation of shearing components using the same discretization. - ! We will consider using a circulation based calculation of vorticity later. - ! Also note this will need OBC boundary conditions re-applied... - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) - dvdx(I,J) = DY_dxBu * (v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) - DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) - dudy(I,J) = DX_dyBu * (u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) - enddo ; enddo - - ! Vorticity - if (CS%no_slip) then - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) - enddo ; enddo - else - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) - enddo ; enddo - endif - - ! Vorticity gradient - do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 - DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) - vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) - enddo ; enddo - - do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 - DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) - vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) - enddo ; enddo - - ! Add in beta for the Leith viscosity - if (CS%use_beta_in_Leith) then - do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 - vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1) ) - enddo ; enddo - do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j) ) - enddo ; enddo - endif - +! ! Divergence +! do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 +! div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & +! G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & +! (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & +! G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & +! (h(i,j,k) + GV%H_subroundoff) +! enddo ; enddo +! +! ! Divergence gradient +! do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 +! div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) +! enddo ; enddo +! +! do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 +! div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) +! enddo ; enddo +! +! ! Components for the vertical vorticity +! ! Note this a simple re-calculation of shearing components using the same discretization. +! ! We will consider using a circulation based calculation of vorticity later. +! ! Also note this will need OBC boundary conditions re-applied... +! do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 +! DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) +! dvdx(I,J) = DY_dxBu * (v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) +! DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) +! dudy(I,J) = DX_dyBu * (u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) +! enddo ; enddo +! +! ! Vorticity +! if (CS%no_slip) then +! do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 +! vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) +! enddo ; enddo +! else +! do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 +! vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) +! enddo ; enddo +! endif +! +! ! Vorticity gradient +! do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 +! DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) +! vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) +! enddo ; enddo +! +! do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 +! DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) +! vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) +! enddo ; enddo +! +! ! Add in beta for the Leith viscosity +! if (CS%use_beta_in_Leith) then +! do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 +! vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1) ) +! enddo ; enddo +! do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 +! vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j) ) +! enddo ; enddo +! endif +! ! Add in stretching term for the QG Leith vsicosity - if (CS%use_QG_Leith) then +! if (CS%use_QG_Leith) then do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 h_at_slope_above = 2. * ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) * h(i+1,j,k) ) / & ( ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) + h(i+1,j,k) ) & @@ -876,33 +879,33 @@ subroutine calc_Leith_viscosity(CS, G, GV, u, v, h, k, Leith_Kh_h, Leith_Kh_q, L + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / & ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) ) enddo ; enddo - endif - - mod_Leith = 0.; if (CS%modified_Leith) mod_Leith = 1.0 - - ! h-point viscosities - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - vert_vort_mag = sqrt( & - 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & - (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & - mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)*div_xx_dx(I-1,j)) + & - (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) - if (CS%Leith_Kh) Leith_Kh_h(i,j) = CS%Laplac3_const_xx(i,j) * vert_vort_mag - if (CS%Leith_Ah) Leith_Ah_h(i,j) = CS%biharm5_const_xx(i,j) * vert_vort_mag - enddo ; enddo - - ! q-point viscosities - do J=js-1,Jeq ; do I=is-1,Ieq - vert_vort_mag = sqrt( & - 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & - (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & - mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)*div_xx_dx(I,j+1)) + & - (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) - if (CS%Leith_Kh) Leith_Kh_q(I,J) = CS%Laplac3_const_xy(I,J) * vert_vort_mag - if (CS%Leith_Ah) Leith_Ah_q(I,J) = CS%biharm5_const_xx(I,J) * vert_vort_mag - enddo ; enddo - -end subroutine calc_Leith_viscosity +! endif + +! mod_Leith = 0.; if (CS%modified_Leith) mod_Leith = 1.0 + +! ! h-point viscosities +! do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 +! vert_vort_mag = sqrt( & +! 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & +! (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & +! mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)*div_xx_dx(I-1,j)) + & +! (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) +! if (CS%Leith_Kh) Leith_Kh_h(i,j) = CS%Laplac3_const_xx(i,j) * vert_vort_mag +! if (CS%Leith_Ah) Leith_Ah_h(i,j) = CS%biharm5_const_xx(i,j) * vert_vort_mag +! enddo ; enddo + +! ! q-point viscosities +! do J=js-1,Jeq ; do I=is-1,Ieq +! vert_vort_mag = sqrt( & +! 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & +! (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & +! mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)*div_xx_dx(I,j+1)) + & +! (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) +! if (CS%Leith_Kh) Leith_Kh_q(I,J) = CS%Laplac3_const_xy(I,J) * vert_vort_mag +! if (CS%Leith_Ah) Leith_Ah_q(I,J) = CS%biharm5_const_xx(I,J) * vert_vort_mag +! enddo ; enddo + +end subroutine calc_QG_Leith_viscosity subroutine VarMix_init(Time, G, param_file, diag, CS) type(time_type), intent(in) :: Time !< Current model time @@ -1204,82 +1207,83 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) endif ! Leith parameters - call get_param(param_file, mdl, "USE_QG_LEITH", CS%use_QG_Leith, & - "If true, use the QG Leith nonlinear eddy viscosity.", & - default=.false.) - call get_param(param_file, mdl, "LEITH_KH", CS%Leith_Kh, & - "If true, use a Leith nonlinear eddy viscosity.", & - default=CS%use_QG_Leith) - if (CS%use_QG_Leith .and. .not. CS%Leith_Kh) call MOM_error(FATAL, & - "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& - "LEITH_KH must be True when USE_QG_LEITH=True.") - call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_Leith, & - "If true, include the beta term in the QG Leith nonlinear eddy viscosity.", & - default=CS%use_QG_Leith) - call get_param(param_file, mdl, "LEITH_AH", CS%Leith_Ah, & - "If true, use a biharmonic Leith nonlinear eddy \n"//& - "viscosity.", default=.false.) - call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & - "If true, add a term to Leith viscosity which is \n"//& - "proportional to the gradient of divergence.", & - default=.false.) - call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & - "The nondimensional Laplacian Leith constant, \n"//& - "often set to 1.0", units="nondim", default=0.0, & - fail_if_missing = CS%Leith_Kh) - call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & - "The nondimensional biharmonic Leith constant, \n"//& - "typical values are thus far undetermined.", units="nondim", default=0.0, & - fail_if_missing = CS%Leith_Ah) - if (CS%Leith_Kh .or. CS%Leith_Ah) then - in_use = .true. - call get_param(param_file, mdl, "NOSLIP", CS%no_slip, & - "If true, no slip boundary conditions are used; otherwise \n"//& - "free slip boundary conditions are assumed. The \n"//& - "implementation of the free slip BCs on a C-grid is much \n"//& - "cleaner than the no slip BCs. The use of free slip BCs \n"//& - "is strongly encouraged, and no slip BCs are not used with \n"//& - "the biharmonic viscosity.", default=.false.) +! call get_param(param_file, mdl, "USE_QG_LEITH", CS%use_QG_Leith, & +! "If true, use the QG Leith nonlinear eddy viscosity.", & +! default=.false.) +! call get_param(param_file, mdl, "LEITH_KH", CS%Leith_Kh, & +! "If true, use a Leith nonlinear eddy viscosity.", & +! default=CS%use_QG_Leith) +! if (CS%use_QG_Leith .and. .not. CS%Leith_Kh) call MOM_error(FATAL, & +! "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& +! "LEITH_KH must be True when USE_QG_LEITH=True.") +! call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_Leith, & +! "If true, include the beta term in the QG Leith nonlinear eddy viscosity.", & +! default=CS%use_QG_Leith) +! call get_param(param_file, mdl, "LEITH_AH", CS%Leith_Ah, & +! "If true, use a biharmonic Leith nonlinear eddy \n"//& +! "viscosity.", default=.false.) +! call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & +! "If true, add a term to Leith viscosity which is \n"//& +! "proportional to the gradient of divergence.", & +! default=.false.) +! call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & +! "The nondimensional Laplacian Leith constant, \n"//& +! "often set to 1.0", units="nondim", default=0.0, & +! fail_if_missing = CS%Leith_Kh) +! call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & +! "The nondimensional biharmonic Leith constant, \n"//& +! "typical values are thus far undetermined.", units="nondim", default=0.0, & +! fail_if_missing = CS%Leith_Ah) +! if (CS%Leith_Kh .or. CS%Leith_Ah) then +! in_use = .true. +! call get_param(param_file, mdl, "NOSLIP", CS%no_slip, & +! "If true, no slip boundary conditions are used; otherwise \n"//& +! "free slip boundary conditions are assumed. The \n"//& +! "implementation of the free slip BCs on a C-grid is much \n"//& +! "cleaner than the no slip BCs. The use of free slip BCs \n"//& +! "is strongly encouraged, and no slip BCs are not used with \n"//& +! "the biharmonic viscosity.", default=.false.) + if (CS%Use_QG_Leith_GM) then if (.not. CS%use_stored_slopes) call MOM_error(FATAL, & "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& - "USE_STORED_SLOPES must be True when ing Leith.") - endif - if (CS%Leith_Kh) then - allocate(CS%Laplac3_const_xx(isd:ied,jsd:jed)) ; CS%Laplac3_const_xx(:,:) = 0.0 - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - DX2 = G%dxT(i,j)*G%dxT(i,j) - DY2 = G%dyT(i,j)*G%dyT(i,j) - grid_sp_2 = (2.0*DX2*DY2) / (DX2 + DY2) - grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) - CS%Laplac3_const_xx(i,j) = Leith_Lap_const * grid_sp_3 - enddo ; enddo - allocate(CS%Laplac3_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Laplac3_const_xy(:,:) = 0.0 - do J=js-1,Jeq ; do I=is-1,Ieq - DX2 = G%dxBu(I,J)*G%dxBu(I,J) - DY2 = G%dyBu(I,J)*G%dyBu(I,J) - grid_sp_2 = (2.0*DX2*DY2) / (DX2 + DY2) - grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) - CS%Laplac3_const_xy(I,J) = Leith_Lap_const * grid_sp_3 - enddo ; enddo - endif - if (CS%Leith_Ah) then - allocate(CS%biharm5_const_xx(isd:ied,jsd:jed)) ; CS%biharm5_const_xx(:,:) = 0.0 - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - DX2 = G%dxT(i,j)*G%dxT(i,j) - DY2 = G%dyT(i,j)*G%dyT(i,j) - grid_sp_2 = (2.0*DX2*DY2) / (DX2+DY2) - grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) - CS%biharm5_const_xx(i,j) = Leith_bi_const * (grid_sp_2 * grid_sp_3) - enddo ; enddo - allocate(CS%biharm5_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm5_const_xy(:,:) = 0.0 - do J=js-1,Jeq ; do I=is-1,Ieq - DX2 = G%dxBu(I,J)*G%dxBu(I,J) - DY2 = G%dyBu(I,J)*G%dyBu(I,J) - grid_sp_2 = (2.0*DX2*DY2) / (DX2+DY2) - grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) - CS%biharm5_const_xy(I,J) = Leith_bi_const * (grid_sp_2 * grid_sp_3) - enddo ; enddo + "USE_STORED_SLOPES must be True when using QG Leith.") endif +! if (CS%Leith_Kh) then +! allocate(CS%Laplac3_const_xx(isd:ied,jsd:jed)) ; CS%Laplac3_const_xx(:,:) = 0.0 +! do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 +! DX2 = G%dxT(i,j)*G%dxT(i,j) +! DY2 = G%dyT(i,j)*G%dyT(i,j) +! grid_sp_2 = (2.0*DX2*DY2) / (DX2 + DY2) +! grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) +! CS%Laplac3_const_xx(i,j) = Leith_Lap_const * grid_sp_3 +! enddo ; enddo +! allocate(CS%Laplac3_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Laplac3_const_xy(:,:) = 0.0 +! do J=js-1,Jeq ; do I=is-1,Ieq +! DX2 = G%dxBu(I,J)*G%dxBu(I,J) +! DY2 = G%dyBu(I,J)*G%dyBu(I,J) +! grid_sp_2 = (2.0*DX2*DY2) / (DX2 + DY2) +! grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) +! CS%Laplac3_const_xy(I,J) = Leith_Lap_const * grid_sp_3 +! enddo ; enddo +! endif +! if (CS%Leith_Ah) then +! allocate(CS%biharm5_const_xx(isd:ied,jsd:jed)) ; CS%biharm5_const_xx(:,:) = 0.0 +! do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 +! DX2 = G%dxT(i,j)*G%dxT(i,j) +! DY2 = G%dyT(i,j)*G%dyT(i,j) +! grid_sp_2 = (2.0*DX2*DY2) / (DX2+DY2) +! grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) +! CS%biharm5_const_xx(i,j) = Leith_bi_const * (grid_sp_2 * grid_sp_3) +! enddo ; enddo +! allocate(CS%biharm5_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm5_const_xy(:,:) = 0.0 +! do J=js-1,Jeq ; do I=is-1,Ieq +! DX2 = G%dxBu(I,J)*G%dxBu(I,J) +! DY2 = G%dyBu(I,J)*G%dyBu(I,J) +! grid_sp_2 = (2.0*DX2*DY2) / (DX2+DY2) +! grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) +! CS%biharm5_const_xy(I,J) = Leith_bi_const * (grid_sp_2 * grid_sp_3) +! enddo ; enddo +! endif ! If nothing is being stored in this class then deallocate if (in_use) then From da862b331f1709ca8e367e31f82743e0505b1742 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 16 Oct 2018 16:49:14 -0600 Subject: [PATCH 013/106] Change calc_Leith_viscosity to calc_QG_Leith_viscosity --- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 6d1fe58224..fe0dd18d75 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -145,7 +145,7 @@ module MOM_lateral_mixing_coeffs end type VarMix_CS public VarMix_init, calc_slope_functions, calc_resoln_function -public calc_Leith_viscosity +public calc_QG_Leith_viscosity contains @@ -840,7 +840,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, vort_xy_dx, vort_xy_dy) ! vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j) ) ! enddo ; enddo ! endif -! +! ! Add in stretching term for the QG Leith vsicosity ! if (CS%use_QG_Leith) then do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 From d02fd47cc47269e6addc4c0567a6b36e49bc1b55 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 16 Oct 2018 16:50:00 -0600 Subject: [PATCH 014/106] Adds option to diagnose div_xx_h and vort_xy_q --- .../lateral/MOM_hor_visc.F90 | 38 +++++++++++++------ 1 file changed, 27 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index f358715377..63cb67bad4 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -9,8 +9,7 @@ module MOM_hor_visc use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_lateral_mixing_coeffs, only : VarMix_CS -use MOM_lateral_mixing_coeffs, only : calc_Leith_viscosity +use MOM_lateral_mixing_coeffs, only : VarMix_CS, calc_QG_Leith_viscosity use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type, OBC_DIRECTION_E, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_NONE @@ -160,6 +159,7 @@ module MOM_hor_visc integer :: id_diffu = -1, id_diffv = -1 integer :: id_Ah_h = -1, id_Ah_q = -1 integer :: id_Kh_h = -1, id_Kh_q = -1 + integer :: id_vort_xy_q = -1, id_div_xx_h = -1 integer :: id_FrictWork = -1, id_FrictWorkIntz = -1 !!@} @@ -233,12 +233,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & Ah_q, & ! biharmonic viscosity at corner points (m4/s) - Kh_q ! Laplacian viscosity at corner points (m2/s) + Kh_q, & ! Laplacian viscosity at corner points (m2/s) + vort_xy_q ! vertical vorticity at corner points (s-1) real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points (m4/s) Kh_h, & ! Laplacian viscosity at thickness points (m2/s) - FrictWork ! energy dissipated by lateral friction (W/m2) + FrictWork, & ! energy dissipated by lateral friction (W/m2) + div_xx_h ! horizontal divergence (s-1) real :: Ah ! biharmonic viscosity (m4/s) real :: Kh ! Laplacian viscosity (m2/s) @@ -269,7 +271,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real :: RoScl ! The scaling function for MEKE source term real :: FatH ! abs(f) at h-point for MEKE source term (s-1) real :: local_strain ! Local variable for interpolating computed strain rates (s-1). - + real :: DY_dxBu, DX_dyBu logical :: rescale_Kh, legacy_bound logical :: find_FrictWork logical :: apply_OBC = .false. @@ -323,7 +325,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & !$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, & -!$OMP mod_Leith, legacy_bound) & +!$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & @@ -591,7 +593,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) endif - if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then + if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then vert_vort_mag = sqrt( & 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & @@ -631,6 +633,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif if (CS%id_Kh_h>0) Kh_h(i,j,k) = Kh + if (CS%id_div_xx_h>0) div_xx_h(i,j,k) = div_xx(i,j) str_xx(i,j) = -Kh * sh_xx(i,j) else ! not Laplacian @@ -793,6 +796,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif if (CS%id_Kh_q>0) Kh_q(I,J,k) = Kh + if (CS%id_vort_xy_q>0) vort_xy_q(I,J,k) = vort_xy(I,J) str_xy(I,J) = -Kh * sh_xy(I,J) else ! not Laplacian @@ -961,6 +965,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if (CS%id_diffv>0) call post_data(CS%id_diffv, diffv, CS%diag) if (CS%id_FrictWork>0) call post_data(CS%id_FrictWork, FrictWork, CS%diag) if (CS%id_Ah_h>0) call post_data(CS%id_Ah_h, Ah_h, CS%diag) + if (CS%id_div_xx_h>0) call post_data(CS%id_div_xx_h, div_xx_h, CS%diag) + if (CS%id_vort_xy_q>0) call post_data(CS%id_vort_xy_q, vort_xy_q, CS%diag) if (CS%id_Ah_q>0) call post_data(CS%id_Ah_q, Ah_q, CS%diag) if (CS%id_Kh_h>0) call post_data(CS%id_Kh_h, Kh_h, CS%diag) if (CS%id_Kh_q>0) call post_data(CS%id_Kh_q, Kh_q, CS%diag) @@ -1217,7 +1223,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) units="m s-1", default=maxvel) endif endif - if (CS%Leith_Ah .or. get_all) + if (CS%Leith_Ah .or. get_all) & call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & "The nondimensional biharmonic Leith constant, \n"//& "typical values are thus far undetermined.", units="nondim", default=0.0, & @@ -1294,7 +1300,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) endif if (CS%Leith_Kh) then ALLOC_(CS%Laplac3_const_xx(isd:ied,jsd:jed)) ; CS%Laplac3_const_xx(:,:) = 0.0 - ALLOC_(CS%Laplac3_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Laplac3_const_xy(:,:) = 0.0 + ALLOC_(CS%Laplac3_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Laplac3_const_xy(:,:) = 0.0 endif endif ALLOC_(CS%reduction_xx(isd:ied,jsd:jed)) ; CS%reduction_xx(:,:) = 0.0 @@ -1351,7 +1357,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) endif endif if (CS%Leith_Ah) then - ALLOC_(CS%biharm5_const_xx(isd:ied,jsd:jed)) ; CS%biharm5_const_xx(:,:) = 0.0 + ALLOC_(CS%biharm5_const_xx(isd:ied,jsd:jed)) ; CS%biharm5_const_xx(:,:) = 0.0 ALLOC_(CS%biharm5_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm5_const_xy(:,:) = 0.0 endif endif @@ -1485,7 +1491,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) (fmax * BoundCorConst) endif endif - if (CS%Leith_Ah) then + if (CS%Leith_Ah) then CS%biharm5_const_xx(i,j) = Leith_bi_const * (grid_sp_h2 * grid_sp_h3) endif CS%Ah_bg_xx(i,j) = MAX(Ah, Ah_vel_scale * grid_sp_h2 * sqrt(grid_sp_h2)) @@ -1628,6 +1634,15 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) CS%id_Kh_q = register_diag_field('ocean_model', 'Khq', diag%axesBL, Time, & 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1') + + if (CS%Leith_Kh) then + CS%id_vort_xy_q = register_diag_field('ocean_model', 'vort_xy_q', diag%axesBL, Time, & + 'Vertical vorticity at q Points', 's-1') + + CS%id_div_xx_h = register_diag_field('ocean_model', 'div_xx_h', diag%axesTL, Time, & + 'Horizontal divergence at h Points', 's-1') + endif + endif CS%id_FrictWork = register_diag_field('ocean_model','FrictWork',diag%axesTL,Time,& @@ -1703,6 +1718,7 @@ subroutine hor_visc_end(CS) endif if (CS%Leith_Ah) then DEALLOC_(CS%Biharm5_Const_xx) ; DEALLOC_(CS%Biharm5_Const_xy) + endif endif if (CS%anisotropic) then DEALLOC_(CS%n1n2_h) From 92e28751c311437936f8243c43332f4d685130ee Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 17 Oct 2018 16:14:40 -0600 Subject: [PATCH 015/106] Bounds vort_xy_* in Leith. --- .../lateral/MOM_hor_visc.F90 | 36 +++++++++++++++---- 1 file changed, 29 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 63cb67bad4..a9e64eebec 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -220,7 +220,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution (H m2 s-2) FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction (W/m2) Leith_Kh_h, & ! Leith Laplacian viscosity at h-points (m2 s-1) - Leith_Ah_h ! Leith bi-harmonic viscosity at h-points (m4 s-1) + Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points (m4 s-1) + pl ! Planetary number (nondim) real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) @@ -271,6 +272,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real :: RoScl ! The scaling function for MEKE source term real :: FatH ! abs(f) at h-point for MEKE source term (s-1) real :: local_strain ! Local variable for interpolating computed strain rates (s-1). + real :: beta, u_scale, epsilon, grid_sp_h2, pl_u, pl_v, mod_Leith_pl real :: DY_dxBu, DX_dyBu logical :: rescale_Kh, legacy_bound logical :: find_FrictWork @@ -572,11 +574,31 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! Add in beta for the Leith viscosity if (CS%use_beta_in_Leith) then + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) + u_scale = sqrt((0.5*(u(I,j,k)+u(I-1,j,k)))**2 + (0.5*(v(i,J,k)+v(i,J-1,k)))**2) + grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j) + CS%DY2h(i,j)) + pl(i,j) = beta * grid_sp_h2 / (u_scale + epsilon) + enddo; enddo + + mod_Leith_pl = 1.0 do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 - vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1) ) + pl_v = 0.5 * (pl(i,j) + pl(i,j+1)) + if (pl_v > 1.0) then + vort_xy_dx(i,J) = 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1)) + mod_Leith_pl = 0.0 + else + vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1)) + endif enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j) ) + pl_u = 0.5 * (pl(i,j) + pl(i+1,j)) + if (pl_u > 1.0) then + vort_xy_dy(I,j) = 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j)) + mod_Leith_pl = 0.0 + else + vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j)) + endif enddo ; enddo endif @@ -597,8 +619,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, vert_vort_mag = sqrt( & 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & - mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)*div_xx_dx(I-1,j)) + & - (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) + mod_Leith*mod_Leith_pl*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)* & + div_xx_dx(I-1,j)) + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) endif if (CS%better_bound_Ah .or. CS%better_bound_Kh) then hrat_min = min(1.0, min(h_u(I,j), h_u(I-1,j), h_v(i,J), h_v(i,J-1)) / & @@ -730,8 +752,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, vert_vort_mag = sqrt( & 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & - mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)*div_xx_dx(I,j+1)) + & - (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) + mod_Leith*mod_Leith_pl*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)* & + div_xx_dx(I,j+1)) + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) endif h2uq = 4.0 * h_u(I,j) * h_u(I,j+1) h2vq = 4.0 * h_v(i,J) * h_v(i+1,J) From d069e51136be35e5d0d2c515337e9ed87ae6a630 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Wed, 17 Oct 2018 16:37:58 -0600 Subject: [PATCH 016/106] Changed constraint on Leith viscosity. --- .../lateral/MOM_hor_visc.F90 | 46 +++++++++++-------- 1 file changed, 26 insertions(+), 20 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index a9e64eebec..227188e731 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -221,8 +221,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction (W/m2) Leith_Kh_h, & ! Leith Laplacian viscosity at h-points (m2 s-1) Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points (m4 s-1) - pl ! Planetary number (nondim) - + pl_h ! Planetary number (nondim) + real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) (1/sec) including metric terms @@ -230,7 +230,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution (H m2 s-2) vort_xy, & ! Vertical vorticity (dv/dx - du/dy) (s-1) Leith_Kh_q, & ! Leith Laplacian viscosity at q-points (m2 s-1) - Leith_Ah_q ! Leith bi-harmonic viscosity at q-points (m4 s-1) + Leith_Ah_q, & ! Leith bi-harmonic viscosity at q-points (m4 s-1) + pl_q ! Planetary number (nondim) real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & Ah_q, & ! biharmonic viscosity at corner points (m4/s) @@ -272,7 +273,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real :: RoScl ! The scaling function for MEKE source term real :: FatH ! abs(f) at h-point for MEKE source term (s-1) real :: local_strain ! Local variable for interpolating computed strain rates (s-1). - real :: beta, u_scale, epsilon, grid_sp_h2, pl_u, pl_v, mod_Leith_pl + real :: beta, u_scale, epsilon, grid_sp_h2, grid_sp_q2 real :: DY_dxBu, DX_dyBu logical :: rescale_Kh, legacy_bound logical :: find_FrictWork @@ -578,28 +579,24 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) u_scale = sqrt((0.5*(u(I,j,k)+u(I-1,j,k)))**2 + (0.5*(v(i,J,k)+v(i,J-1,k)))**2) grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j) + CS%DY2h(i,j)) - pl(i,j) = beta * grid_sp_h2 / (u_scale + epsilon) + pl_h(i,j) = beta * grid_sp_h2 / (u_scale + epsilon) enddo; enddo - mod_Leith_pl = 1.0 + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + beta = sqrt( (0.25*(G%dF_dx(i,j)+G%dF_dx(i+1,j)+G%dF_dx(i,j+1)+G%dF_dx(i+1,j+1))**2) + & + (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) + u_scale = sqrt((0.5*(u(I,j,k)+u(I,j+1,k)))**2 + (0.5*(v(i,J,k)+v(i,J+1,k)))**2) + grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J) + CS%DY2q(I,J)) + pl_q(I,J) = beta * grid_sp_q2 / (u_scale + epsilon) + enddo ; enddo + do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 - pl_v = 0.5 * (pl(i,j) + pl(i,j+1)) - if (pl_v > 1.0) then - vort_xy_dx(i,J) = 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1)) - mod_Leith_pl = 0.0 - else vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1)) - endif enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 - pl_u = 0.5 * (pl(i,j) + pl(i+1,j)) - if (pl_u > 1.0) then - vort_xy_dy(I,j) = 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j)) - mod_Leith_pl = 0.0 - else vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j)) - endif enddo ; enddo + endif mod_Leith = 0.; if (CS%modified_Leith) mod_Leith = 1.0 @@ -616,11 +613,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - vert_vort_mag = sqrt( & + if (pl_h(i,j) > 1) then + vert_vort_mag = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) + else + vert_vort_mag = sqrt( & 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & mod_Leith*mod_Leith_pl*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)* & div_xx_dx(I-1,j)) + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) + endif endif if (CS%better_bound_Ah .or. CS%better_bound_Kh) then hrat_min = min(1.0, min(h_u(I,j), h_u(I-1,j), h_v(i,J), h_v(i,J-1)) / & @@ -749,7 +750,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, (sh_xx(i,j+1)*sh_xx(i,j+1) + sh_xx(i+1,j)*sh_xx(i+1,j)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - vert_vort_mag = sqrt( & + if (pl_q(I,J) > 1) then + vert_vort_mag = sqrt( & + (0.25*(G%dF_dx(i,j)+G%dF_dx(i+1,j)+G%dF_dx(i,j+1)+G%dF_dx(i+1,j+1))**2) + & + (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) + else + vert_vort_mag = sqrt( & 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & mod_Leith*mod_Leith_pl*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)* & From b9d69b7e1118cb8b9a8cb31cabe900a7a8ce5a56 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 17 Oct 2018 16:59:08 -0600 Subject: [PATCH 017/106] Fix a bug in an if statement --- src/parameterizations/lateral/MOM_hor_visc.F90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 227188e731..e578b1a4e7 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -222,7 +222,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, Leith_Kh_h, & ! Leith Laplacian viscosity at h-points (m2 s-1) Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points (m4 s-1) pl_h ! Planetary number (nondim) - + real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) (1/sec) including metric terms @@ -586,7 +586,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, beta = sqrt( (0.25*(G%dF_dx(i,j)+G%dF_dx(i+1,j)+G%dF_dx(i,j+1)+G%dF_dx(i+1,j+1))**2) + & (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) u_scale = sqrt((0.5*(u(I,j,k)+u(I,j+1,k)))**2 + (0.5*(v(i,J,k)+v(i,J+1,k)))**2) - grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J) + CS%DY2q(I,J)) + grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J) + CS%DY2q(I,J)) pl_q(I,J) = beta * grid_sp_q2 / (u_scale + epsilon) enddo ; enddo @@ -619,7 +619,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, vert_vort_mag = sqrt( & 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & - mod_Leith*mod_Leith_pl*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)* & + mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)* & div_xx_dx(I-1,j)) + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) endif endif @@ -750,7 +750,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, (sh_xx(i,j+1)*sh_xx(i,j+1) + sh_xx(i+1,j)*sh_xx(i+1,j)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - if (pl_q(I,J) > 1) then + if (pl_q(I,J) > 1) then vert_vort_mag = sqrt( & (0.25*(G%dF_dx(i,j)+G%dF_dx(i+1,j)+G%dF_dx(i,j+1)+G%dF_dx(i+1,j+1))**2) + & (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) @@ -758,8 +758,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, vert_vort_mag = sqrt( & 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & - mod_Leith*mod_Leith_pl*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)* & + mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)* & div_xx_dx(I,j+1)) + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) + endif endif h2uq = 4.0 * h_u(I,j) * h_u(I,j+1) h2vq = 4.0 * h_v(i,J) * h_v(i+1,J) From 5c5533b987ea9443e89154ff90150d04e8b25f34 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 25 Oct 2018 16:09:34 -0600 Subject: [PATCH 018/106] Rename variables to make names consistent; fix dimens. Biharm Smag --- .../lateral/MOM_hor_visc.F90 | 99 ++++++++++--------- 1 file changed, 51 insertions(+), 48 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index e578b1a4e7..2e8352089e 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -85,7 +85,7 @@ module MOM_hor_visc !< The background biharmonic viscosity at h points, in units !! of m4 s-1. The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Biharm_Const2_xx + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Biharm5_const2_xx !< A constant relating the biharmonic viscosity to the !! square of the velocity shear, in m4 s. This value is !! set to be the magnitude of the Coriolis terms once the @@ -107,7 +107,7 @@ module MOM_hor_visc !< The background biharmonic viscosity at q points, in units !! of m4 s-1. The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Biharm_Const2_xy + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Biharm5_const2_xy !< A constant relating the biharmonic viscosity to the !! square of the velocity shear, in m4 s. This value is !! set to be the magnitude of the Coriolis terms once the @@ -141,16 +141,16 @@ module MOM_hor_visc ! The following variables are precalculated time-invariant combinations of ! parameters and metric terms. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - Laplac_Const_xx, & !< Laplacian metric-dependent constants (nondim) - Biharm_Const_xx, & !< Biharmonic metric-dependent constants (nondim) - Laplac3_Const_xx, & !< Laplacian metric-dependent constants (nondim) - Biharm5_Const_xx !< Biharmonic metric-dependent constants (nondim) + Laplac2_const_xx, & !< Laplacian metric-dependent constants (nondim) + Biharm5_const_xx, & !< Biharmonic metric-dependent constants (nondim) + Laplac3_const_xx, & !< Laplacian metric-dependent constants (nondim) + Biharm6_const_xx !< Biharmonic metric-dependent constants (nondim) real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - Laplac_Const_xy, & !< Laplacian metric-dependent constants (nondim) - Biharm_Const_xy, & !< Biharmonic metric-dependent constants (nondim) - Laplac3_Const_xy, & !< Laplacian metric-dependent constants (nondim) - Biharm5_Const_xy !< Biharmonic metric-dependent constants (nondim) + Laplac2_const_xy, & !< Laplacian metric-dependent constants (nondim) + Biharm5_const_xy, & !< Biharmonic metric-dependent constants (nondim) + Laplac3_const_xy, & !< Laplacian metric-dependent constants (nondim) + Biharm6_const_xy !< Biharmonic metric-dependent constants (nondim) type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics @@ -281,12 +281,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, logical :: use_MEKE_Ku integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k, n + real :: inv_PI3, inv_PI6 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB h_neglect = GV%H_subroundoff h_neglect3 = h_neglect**3 + inv_PI3 = 1.0/((4.0*atan(1.0))**3) + inv_PI6 = inv_PI3**2 if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then apply_OBC = OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally @@ -604,16 +607,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if (CS%use_QG_Leith) then call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, vort_xy_dx, vort_xy_dy) endif - endif + endif ! CS%Leith_Kh - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - if (pl_h(i,j) > 1) then + if ((pl_h(i,j) > 1) .and. (CS%use_beta_in_Leith)) then vert_vort_mag = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) else vert_vort_mag = sqrt( & @@ -633,8 +636,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! Determine the Laplacian viscosity at h points, using the ! largest value from several parameterizations. Kh = CS%Kh_bg_xx(i,j) ! Static (pre-computed) background viscosity - if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%LAPLAC_CONST_xx(i,j) * Shear_mag ) - if (CS%Leith_Kh) Kh = max( Kh, CS%LAPLAC3_CONST_xx(i,j) * vert_vort_mag) + if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%Laplac2_const_xx(i,j) * Shear_mag ) + if (CS%Leith_Kh) Kh = max( Kh, CS%Laplac3_const_xx(i,j) * vert_vort_mag*inv_PI3) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_h(i,j) * Kh ! Older method of bounding for stability @@ -677,13 +680,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if ((CS%Smagorinsky_Ah) .or. (CS%Leith_Ah)) then if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then - AhSm = Shear_mag * (CS%BIHARM_CONST_xx(i,j) + & - CS%Biharm_Const2_xx(i,j)*Shear_mag) + AhSm = Shear_mag * (CS%Biharm5_const_xx(i,j) + & + CS%Biharm5_const2_xx(i,j)*Shear_mag) else - AhSm = CS%BIHARM_CONST_xx(i,j) * Shear_mag + AhSm = CS%Biharm5_const_xx(i,j) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = CS%BIHARM5_CONST_xx(i,j) * vert_vort_mag + if (CS%Leith_Ah) AhLth = CS%Biharm6_const_xx(i,j) * vert_vort_mag*inv_PI6 Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm),AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xx(i,j)) @@ -799,8 +802,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! Determine the Laplacian viscosity at q points, using the ! largest value from several parameterizations. Kh = CS%Kh_bg_xy(i,j) ! Static (pre-computed) background viscosity - if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%LAPLAC_CONST_xy(I,J) * Shear_mag ) - if (CS%Leith_Kh) Kh = max( Kh, CS%LAPLAC3_CONST_xy(I,J) * vert_vort_mag) + if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%Laplac2_const_xy(I,J) * Shear_mag ) + if (CS%Leith_Kh) Kh = max( Kh, CS%Laplac3_const_xy(I,J) * vert_vort_mag*inv_PI3) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_q(i,j) * Kh ! Older method of bounding for stability @@ -846,13 +849,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if (CS%Smagorinsky_Ah .or. CS%Leith_Ah) then if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then - AhSm = Shear_mag * (CS%BIHARM_CONST_xy(I,J) + & - CS%Biharm_Const2_xy(I,J)*Shear_mag) + AhSm = Shear_mag * (CS%Biharm5_const_xy(I,J) + & + CS%Biharm5_const2_xy(I,J)*Shear_mag) else - AhSm = CS%BIHARM_CONST_xy(I,J) * Shear_mag + AhSm = CS%Biharm5_const_xy(I,J) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = CS%BIHARM5_CONST_xy(I,J) * vert_vort_mag + if (CS%Leith_Ah) AhLth = CS%Biharm6_const_xy(I,J) * vert_vort_mag * inv_PI6 Ah = MAX(MAX(CS%Ah_bg_xy(I,J), AhSm),AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xy(I,J)) @@ -1324,8 +1327,8 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) ALLOC_(CS%Kh_Max_xy(IsdB:IedB,JsdB:JedB)) ; CS%Kh_Max_xy(:,:) = 0.0 endif if (CS%Smagorinsky_Kh) then - ALLOC_(CS%Laplac_Const_xx(isd:ied,jsd:jed)) ; CS%Laplac_Const_xx(:,:) = 0.0 - ALLOC_(CS%Laplac_Const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Laplac_Const_xy(:,:) = 0.0 + ALLOC_(CS%Laplac2_const_xx(isd:ied,jsd:jed)) ; CS%Laplac2_const_xx(:,:) = 0.0 + ALLOC_(CS%Laplac2_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Laplac2_const_xy(:,:) = 0.0 endif if (CS%Leith_Kh) then ALLOC_(CS%Laplac3_const_xx(isd:ied,jsd:jed)) ; CS%Laplac3_const_xx(:,:) = 0.0 @@ -1378,16 +1381,16 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) ALLOC_(CS%Ah_Max_xy(IsdB:IedB,JsdB:JedB)) ; CS%Ah_Max_xy(:,:) = 0.0 endif if (CS%Smagorinsky_Ah) then - ALLOC_(CS%Biharm_Const_xx(isd:ied,jsd:jed)) ; CS%Biharm_Const_xx(:,:) = 0.0 - ALLOC_(CS%Biharm_Const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Biharm_Const_xy(:,:) = 0.0 + ALLOC_(CS%Biharm5_const_xx(isd:ied,jsd:jed)) ; CS%Biharm5_const_xx(:,:) = 0.0 + ALLOC_(CS%Biharm5_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Biharm5_const_xy(:,:) = 0.0 if (CS%bound_Coriolis) then - ALLOC_(CS%Biharm_Const2_xx(isd:ied,jsd:jed)) ; CS%Biharm_Const2_xx(:,:) = 0.0 - ALLOC_(CS%Biharm_Const2_xy(IsdB:IedB,JsdB:JedB)) ; CS%Biharm_Const2_xy(:,:) = 0.0 + ALLOC_(CS%Biharm5_const2_xx(isd:ied,jsd:jed)) ; CS%Biharm5_const2_xx(:,:) = 0.0 + ALLOC_(CS%Biharm5_const2_xy(IsdB:IedB,JsdB:JedB)) ; CS%Biharm5_const2_xy(:,:) = 0.0 endif endif if (CS%Leith_Ah) then - ALLOC_(CS%biharm5_const_xx(isd:ied,jsd:jed)) ; CS%biharm5_const_xx(:,:) = 0.0 - ALLOC_(CS%biharm5_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm5_const_xy(:,:) = 0.0 + ALLOC_(CS%biharm6_const_xx(isd:ied,jsd:jed)) ; CS%biharm6_const_xx(:,:) = 0.0 + ALLOC_(CS%biharm6_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm6_const_xy(:,:) = 0.0 endif endif @@ -1442,8 +1445,8 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) ! Static factors in the Smagorinsky and Leith schemes grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j) + CS%DY2h(i,j)) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) - if (CS%Smagorinsky_Kh) CS%LAPLAC_CONST_xx(i,j) = Smag_Lap_const * grid_sp_h2 - if (CS%Leith_Kh) CS%LAPLAC3_const_xx(i,j) = Leith_Lap_const * grid_sp_h3 + if (CS%Smagorinsky_Kh) CS%Laplac2_const_xx(i,j) = Smag_Lap_const * grid_sp_h2 + if (CS%Leith_Kh) CS%Laplac3_const_xx(i,j) = Leith_Lap_const * grid_sp_h3 ! Maximum of constant background and MICOM viscosity CS%Kh_bg_xx(i,j) = MAX(Kh, Kh_vel_scale * sqrt(grid_sp_h2)) @@ -1468,8 +1471,8 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) ! Static factors in the Smagorinsky and Leith schemes grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J) + CS%DY2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) - if (CS%Smagorinsky_Kh) CS%LAPLAC_CONST_xy(I,J) = Smag_Lap_const * grid_sp_q2 - if (CS%Leith_Kh) CS%LAPLAC3_const_xy(I,J) = Leith_Lap_const * grid_sp_q3 + if (CS%Smagorinsky_Kh) CS%Laplac2_const_xy(I,J) = Smag_Lap_const * grid_sp_q2 + if (CS%Leith_Kh) CS%Laplac3_const_xy(I,J) = Leith_Lap_const * grid_sp_q3 ! Maximum of constant background and MICOM viscosity CS%Kh_bg_xy(I,J) = MAX(Kh, Kh_vel_scale * sqrt(grid_sp_q2)) @@ -1512,16 +1515,16 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) if (CS%Smagorinsky_Ah) then - CS%BIHARM_CONST_xx(i,j) = Smag_bi_const * (grid_sp_h2 * grid_sp_h2) + CS%Biharm5_const_xx(i,j) = Smag_bi_const * (grid_sp_h3 * grid_sp_h2) if (CS%bound_Coriolis) then fmax = MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) - CS%Biharm_Const2_xx(i,j) = (grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & + CS%Biharm5_const2_xx(i,j) = (grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & (fmax * BoundCorConst) endif endif if (CS%Leith_Ah) then - CS%biharm5_const_xx(i,j) = Leith_bi_const * (grid_sp_h2 * grid_sp_h3) + CS%biharm6_const_xx(i,j) = Leith_bi_const * (grid_sp_h3**2) endif CS%Ah_bg_xx(i,j) = MAX(Ah, Ah_vel_scale * grid_sp_h2 * sqrt(grid_sp_h2)) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then @@ -1534,14 +1537,14 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) if (CS%Smagorinsky_Ah) then - CS%BIHARM_CONST_xy(I,J) = Smag_bi_const * (grid_sp_q2 * grid_sp_q2) + CS%Biharm5_const_xy(I,J) = Smag_bi_const * (grid_sp_q3 * grid_sp_q2) if (CS%bound_Coriolis) then - CS%Biharm_Const2_xy(I,J) = (grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & + CS%Biharm5_const2_xy(I,J) = (grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & (abs(G%CoriolisBu(I,J)) * BoundCorConst) endif endif if (CS%Leith_Ah) then - CS%biharm5_const_xy(i,j) = Leith_bi_const * (grid_sp_q2 * grid_sp_q3) + CS%biharm6_const_xy(i,j) = Leith_bi_const * (grid_sp_q3**2) endif CS%Ah_bg_xy(I,J) = MAX(Ah, Ah_vel_scale * grid_sp_q2 * sqrt(grid_sp_q2)) @@ -1725,10 +1728,10 @@ subroutine hor_visc_end(CS) DEALLOC_(CS%Kh_Max_xx) ; DEALLOC_(CS%Kh_Max_xy) endif if (CS%Smagorinsky_Kh) then - DEALLOC_(CS%Laplac_Const_xx) ; DEALLOC_(CS%Laplac_Const_xy) + DEALLOC_(CS%Laplac2_const_xx) ; DEALLOC_(CS%Laplac2_const_xy) endif if (CS%Leith_Kh) then - DEALLOC_(CS%Laplac3_Const_xx) ; DEALLOC_(CS%Laplac3_Const_xy) + DEALLOC_(CS%Laplac3_const_xx) ; DEALLOC_(CS%Laplac3_const_xy) endif endif @@ -1740,13 +1743,13 @@ subroutine hor_visc_end(CS) DEALLOC_(CS%Ah_Max_xx) ; DEALLOC_(CS%Ah_Max_xy) endif if (CS%Smagorinsky_Ah) then - DEALLOC_(CS%Biharm_Const_xx) ; DEALLOC_(CS%Biharm_Const_xy) + DEALLOC_(CS%Biharm5_const_xx) ; DEALLOC_(CS%Biharm5_const_xy) if (CS%bound_Coriolis) then - DEALLOC_(CS%Biharm_Const2_xx) ; DEALLOC_(CS%Biharm_Const2_xy) + DEALLOC_(CS%Biharm5_const2_xx) ; DEALLOC_(CS%Biharm5_const2_xy) endif endif if (CS%Leith_Ah) then - DEALLOC_(CS%Biharm5_Const_xx) ; DEALLOC_(CS%Biharm5_Const_xy) + DEALLOC_(CS%Biharm6_const_xx) ; DEALLOC_(CS%Biharm6_const_xy) endif endif if (CS%anisotropic) then From f4256fbb8685c5ca0858c414d8e867139c570063 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 1 Nov 2018 11:36:12 -0600 Subject: [PATCH 019/106] Adding a limiter via planetary number --- .../lateral/MOM_hor_visc.F90 | 46 ++++++++++++++----- 1 file changed, 34 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 2e8352089e..edc25f2c43 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -161,6 +161,7 @@ module MOM_hor_visc integer :: id_Kh_h = -1, id_Kh_q = -1 integer :: id_vort_xy_q = -1, id_div_xx_h = -1 integer :: id_FrictWork = -1, id_FrictWorkIntz = -1 + integer :: id_Pl_h = -1 !!@} end type hor_visc_CS @@ -221,7 +222,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction (W/m2) Leith_Kh_h, & ! Leith Laplacian viscosity at h-points (m2 s-1) Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points (m4 s-1) - pl_h ! Planetary number (nondim) + Pl ! Planetary number (nondim) real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) @@ -240,6 +241,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points (m4/s) + Pl_h, & ! Planetary number (nondim) Kh_h, & ! Laplacian viscosity at thickness points (m2/s) FrictWork, & ! energy dissipated by lateral friction (W/m2) div_xx_h ! horizontal divergence (s-1) @@ -273,7 +275,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real :: RoScl ! The scaling function for MEKE source term real :: FatH ! abs(f) at h-point for MEKE source term (s-1) real :: local_strain ! Local variable for interpolating computed strain rates (s-1). - real :: beta, u_scale, epsilon, grid_sp_h2, grid_sp_q2 + real :: beta, u_scale, epsilon, grid_sp_h2, grid_sp_q2, grad_vort_mag, grad_div_mag real :: DY_dxBu, DX_dyBu logical :: rescale_Kh, legacy_bound logical :: find_FrictWork @@ -290,6 +292,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, h_neglect3 = h_neglect**3 inv_PI3 = 1.0/((4.0*atan(1.0))**3) inv_PI6 = inv_PI3**2 + epsilon = 1.e-15 if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then apply_OBC = OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally @@ -582,7 +585,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) u_scale = sqrt((0.5*(u(I,j,k)+u(I-1,j,k)))**2 + (0.5*(v(i,J,k)+v(i,J-1,k)))**2) grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j) + CS%DY2h(i,j)) - pl_h(i,j) = beta * grid_sp_h2 / (u_scale + epsilon) + grad_vort_mag = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + (0.5*(vort_xy_dy(I,j) + & + vort_xy_dy(I-1,j)))**2 ) + Pl(i,j) = beta * MAX(grid_sp_h2 / (u_scale + epsilon), 1.0/(grad_vort_mag + epsilon)) + if (CS%modified_Leith) then + grad_div_mag =sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & + (0.5 * (div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2) + Pl(i,j) = MAX(Pl(i,j), 10.0* beta/(grad_div_mag + epsilon)) + endif enddo; enddo do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 @@ -590,7 +600,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) u_scale = sqrt((0.5*(u(I,j,k)+u(I,j+1,k)))**2 + (0.5*(v(i,J,k)+v(i,J+1,k)))**2) grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J) + CS%DY2q(I,J)) - pl_q(I,J) = beta * grid_sp_q2 / (u_scale + epsilon) + grad_vort_mag = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + (0.5*(vort_xy_dy(I,j) + & + vort_xy_dy(I,j+1)))**2 ) + Pl_q(i,j) = beta * MAX(grid_sp_q2 / (u_scale + epsilon), 1.0/(grad_vort_mag + epsilon)) + if (CS%modified_Leith) then + grad_div_mag =sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + & + (0.5 * (div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2) + Pl_q(i,j) = MAX(Pl_q(i,j), beta/(grad_div_mag + epsilon)) + endif enddo ; enddo do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 @@ -616,14 +633,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - if ((pl_h(i,j) > 1) .and. (CS%use_beta_in_Leith)) then + if ((Pl(i,j) > 1) .and. (CS%use_beta_in_Leith)) then vert_vort_mag = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) else vert_vort_mag = sqrt( & 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & - (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & - mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)* & - div_xx_dx(I-1,j)) + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) + (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j)))) + & + 0.0*mod_Leith* sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & + (0.5 * (div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2) endif endif if (CS%better_bound_Ah .or. CS%better_bound_Kh) then @@ -658,6 +675,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif endif + if (CS%id_Pl_h>0) Pl_h(i,j,k) = Pl(i,j) if (CS%id_Kh_h>0) Kh_h(i,j,k) = Kh if (CS%id_div_xx_h>0) div_xx_h(i,j,k) = div_xx(i,j) @@ -753,16 +771,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, (sh_xx(i,j+1)*sh_xx(i,j+1) + sh_xx(i+1,j)*sh_xx(i+1,j)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - if (pl_q(I,J) > 1) then + if ((Pl_q(I,J) > 1) .and. (CS%use_beta_in_Leith)) then vert_vort_mag = sqrt( & (0.25*(G%dF_dx(i,j)+G%dF_dx(i+1,j)+G%dF_dx(i,j+1)+G%dF_dx(i+1,j+1))**2) + & (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) else vert_vort_mag = sqrt( & 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & - (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & - mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)* & - div_xx_dx(I,j+1)) + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) + (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1)))) + & + 0.0*mod_Leith*sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + & + (0.5 * (div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2) endif endif h2uq = 4.0 * h_u(I,j) * h_u(I,j+1) @@ -1001,6 +1019,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if (CS%id_vort_xy_q>0) call post_data(CS%id_vort_xy_q, vort_xy_q, CS%diag) if (CS%id_Ah_q>0) call post_data(CS%id_Ah_q, Ah_q, CS%diag) if (CS%id_Kh_h>0) call post_data(CS%id_Kh_h, Kh_h, CS%diag) + if (CS%id_Pl_h>0) call post_data(CS%id_Pl_h, Pl_h, CS%diag) if (CS%id_Kh_q>0) call post_data(CS%id_Kh_q, Kh_q, CS%diag) if (CS%id_FrictWorkIntz > 0) then @@ -1664,6 +1683,9 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) cmor_long_name='Ocean lateral Laplacian viscosity', & cmor_standard_name='ocean_momentum_xy_laplacian_diffusivity') + CS%id_Pl_h = register_diag_field('ocean_model', 'Pl', diag%axesTL, Time, & + 'Planetary number', 'nondim') + CS%id_Kh_q = register_diag_field('ocean_model', 'Khq', diag%axesBL, Time, & 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1') From 3b43efe619843c876f616005d8a82d35768bae9d Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Thu, 1 Nov 2018 13:34:54 -0600 Subject: [PATCH 020/106] Refactored the entire Leith section. --- .../lateral/MOM_hor_visc.F90 | 122 +++++++++--------- 1 file changed, 61 insertions(+), 61 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index edc25f2c43..b72143c3fb 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -528,23 +528,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - ! Divergence - do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & - G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & - (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & - (h(i,j,k) + GV%H_subroundoff) - enddo ; enddo - - ! Divergence gradient - do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 - div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) - enddo ; enddo - - do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 - div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) - enddo ; enddo ! Components for the vertical vorticity ! Note this a simple re-calculation of shearing components using the same discretization. @@ -578,36 +561,54 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo + + if (CS%modified_Leith) then + ! Divergence + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & + G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & + (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & + G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & + (h(i,j,k) + GV%H_subroundoff) + enddo ; enddo + + ! Divergence gradient + do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 + div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) + enddo ; enddo + do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 + div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) + enddo ; enddo + + ! Magnitude of divergence gradient + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + grad_div_mag_h(i,j) =sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & + (0.5 * (div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2) + enddo ; enddo + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + grad_div_mag_q(I,J) =sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + & + (0.5 * (div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2) + enddo ; enddo + + else + + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + grad_div_mag_h(i,j) = 0.0 + enddo ; enddo + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + grad_div_mag_q(I,J) = 0.0 + enddo ; enddo + + endif ! CS%modified_Leith ! Add in beta for the Leith viscosity if (CS%use_beta_in_Leith) then do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) - u_scale = sqrt((0.5*(u(I,j,k)+u(I-1,j,k)))**2 + (0.5*(v(i,J,k)+v(i,J-1,k)))**2) - grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j) + CS%DY2h(i,j)) - grad_vort_mag = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + (0.5*(vort_xy_dy(I,j) + & - vort_xy_dy(I-1,j)))**2 ) - Pl(i,j) = beta * MAX(grid_sp_h2 / (u_scale + epsilon), 1.0/(grad_vort_mag + epsilon)) - if (CS%modified_Leith) then - grad_div_mag =sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & - (0.5 * (div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2) - Pl(i,j) = MAX(Pl(i,j), 10.0* beta/(grad_div_mag + epsilon)) - endif + beta_h(i,j) = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) enddo; enddo - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - beta = sqrt( (0.25*(G%dF_dx(i,j)+G%dF_dx(i+1,j)+G%dF_dx(i,j+1)+G%dF_dx(i+1,j+1))**2) + & + beta_q(I,J) = sqrt( (0.25*(G%dF_dx(i,j)+G%dF_dx(i+1,j)+G%dF_dx(i,j+1)+G%dF_dx(i+1,j+1))**2) + & (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) - u_scale = sqrt((0.5*(u(I,j,k)+u(I,j+1,k)))**2 + (0.5*(v(i,J,k)+v(i,J+1,k)))**2) - grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J) + CS%DY2q(I,J)) - grad_vort_mag = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + (0.5*(vort_xy_dy(I,j) + & - vort_xy_dy(I,j+1)))**2 ) - Pl_q(i,j) = beta * MAX(grid_sp_q2 / (u_scale + epsilon), 1.0/(grad_vort_mag + epsilon)) - if (CS%modified_Leith) then - grad_div_mag =sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + & - (0.5 * (div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2) - Pl_q(i,j) = MAX(Pl_q(i,j), beta/(grad_div_mag + epsilon)) - endif enddo ; enddo do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 @@ -616,16 +617,25 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j)) enddo ; enddo - - endif - - mod_Leith = 0.; if (CS%modified_Leith) mod_Leith = 1.0 + endif ! CS%use_beta_in_Leith if (CS%use_QG_Leith) then call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, vort_xy_dx, vort_xy_dy) endif + + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + grad_vort_mag_h(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + (0.5*(vort_xy_dy(I,j) + & + vort_xy_dy(I-1,j)))**2 ) + enddo; enddo + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + grad_vort_mag_q(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + (0.5*(vort_xy_dy(I,j) + & + vort_xy_dy(I,j+1)))**2 ) + enddo ; enddo + endif ! CS%Leith_Kh + + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & @@ -633,14 +643,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - if ((Pl(i,j) > 1) .and. (CS%use_beta_in_Leith)) then - vert_vort_mag = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) + if (CS%use_beta_in_Leith) then + vert_vort_mag = MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j), beta_h(i,j)**3) else - vert_vort_mag = sqrt( & - 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & - (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j)))) + & - 0.0*mod_Leith* sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & - (0.5 * (div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2) + vert_vort_mag = grad_vort_mag_h(i,j) + grad_div_mag_h(i,j) endif endif if (CS%better_bound_Ah .or. CS%better_bound_Kh) then @@ -771,17 +777,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, (sh_xx(i,j+1)*sh_xx(i,j+1) + sh_xx(i+1,j)*sh_xx(i+1,j)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - if ((Pl_q(I,J) > 1) .and. (CS%use_beta_in_Leith)) then - vert_vort_mag = sqrt( & - (0.25*(G%dF_dx(i,j)+G%dF_dx(i+1,j)+G%dF_dx(i,j+1)+G%dF_dx(i+1,j+1))**2) + & - (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) + if (CS%use_beta_in_Leith) then + vert_vort_mag = MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), beta_q(I,J)**3) else - vert_vort_mag = sqrt( & - 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & - (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1)))) + & - 0.0*mod_Leith*sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + & - (0.5 * (div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2) - endif + vert_vort_mag = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) + endif endif h2uq = 4.0 * h_u(I,j) * h_u(I,j+1) h2vq = 4.0 * h_v(i,J) * h_v(i+1,J) From e0baaeaf19a7d9362e91f2180982846d35dda856 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Thu, 1 Nov 2018 13:49:01 -0600 Subject: [PATCH 021/106] Initialized new arrays for Leith, deleted deprecated ones --- src/parameterizations/lateral/MOM_hor_visc.F90 | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index b72143c3fb..657582f8e4 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -161,7 +161,6 @@ module MOM_hor_visc integer :: id_Kh_h = -1, id_Kh_q = -1 integer :: id_vort_xy_q = -1, id_div_xx_h = -1 integer :: id_FrictWork = -1, id_FrictWorkIntz = -1 - integer :: id_Pl_h = -1 !!@} end type hor_visc_CS @@ -222,7 +221,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction (W/m2) Leith_Kh_h, & ! Leith Laplacian viscosity at h-points (m2 s-1) Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points (m4 s-1) - Pl ! Planetary number (nondim) + beta_h, & ! Gradient of planetary vorticity at h-points (m-1 s-1) + grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points (m-1 s-1) + grad_div_mag_h ! Magnitude of divergence gradient at h-points (m-1 s-1) real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) @@ -232,7 +233,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, vort_xy, & ! Vertical vorticity (dv/dx - du/dy) (s-1) Leith_Kh_q, & ! Leith Laplacian viscosity at q-points (m2 s-1) Leith_Ah_q, & ! Leith bi-harmonic viscosity at q-points (m4 s-1) - pl_q ! Planetary number (nondim) + beta_q, & ! Gradient of planetary vorticity at q-points (m-1 s-1) + grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points (m-1 s-1) + grad_div_mag_q ! Magnitude of divergence gradient at q-points (m-1 s-1) real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & Ah_q, & ! biharmonic viscosity at corner points (m4/s) @@ -241,7 +244,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points (m4/s) - Pl_h, & ! Planetary number (nondim) Kh_h, & ! Laplacian viscosity at thickness points (m2/s) FrictWork, & ! energy dissipated by lateral friction (W/m2) div_xx_h ! horizontal divergence (s-1) @@ -275,7 +277,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real :: RoScl ! The scaling function for MEKE source term real :: FatH ! abs(f) at h-point for MEKE source term (s-1) real :: local_strain ! Local variable for interpolating computed strain rates (s-1). - real :: beta, u_scale, epsilon, grid_sp_h2, grid_sp_q2, grad_vort_mag, grad_div_mag + real :: epsilon real :: DY_dxBu, DX_dyBu logical :: rescale_Kh, legacy_bound logical :: find_FrictWork @@ -681,7 +683,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif endif - if (CS%id_Pl_h>0) Pl_h(i,j,k) = Pl(i,j) if (CS%id_Kh_h>0) Kh_h(i,j,k) = Kh if (CS%id_div_xx_h>0) div_xx_h(i,j,k) = div_xx(i,j) @@ -1019,7 +1020,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if (CS%id_vort_xy_q>0) call post_data(CS%id_vort_xy_q, vort_xy_q, CS%diag) if (CS%id_Ah_q>0) call post_data(CS%id_Ah_q, Ah_q, CS%diag) if (CS%id_Kh_h>0) call post_data(CS%id_Kh_h, Kh_h, CS%diag) - if (CS%id_Pl_h>0) call post_data(CS%id_Pl_h, Pl_h, CS%diag) if (CS%id_Kh_q>0) call post_data(CS%id_Kh_q, Kh_q, CS%diag) if (CS%id_FrictWorkIntz > 0) then @@ -1683,9 +1683,6 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) cmor_long_name='Ocean lateral Laplacian viscosity', & cmor_standard_name='ocean_momentum_xy_laplacian_diffusivity') - CS%id_Pl_h = register_diag_field('ocean_model', 'Pl', diag%axesTL, Time, & - 'Planetary number', 'nondim') - CS%id_Kh_q = register_diag_field('ocean_model', 'Khq', diag%axesBL, Time, & 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1') From 52667e9127e5a0dd559c28809a7be767ae505615 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Thu, 1 Nov 2018 14:15:31 -0600 Subject: [PATCH 022/106] Changed use_QG_Leith to use_QG_Leith_visc. Removed commented lines from calc_QG_Leith_viscosity. --- .../lateral/MOM_hor_visc.F90 | 26 +++--- .../lateral/MOM_lateral_mixing_coeffs.F90 | 85 ------------------- 2 files changed, 10 insertions(+), 101 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 657582f8e4..480070ac0b 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -56,7 +56,7 @@ module MOM_hor_visc logical :: use_beta_in_Leith !< If true, includes the beta term in the Leith viscosity logical :: Leith_Ah !< If true, use a biharmonic form of 2D Leith !! nonlinear eddy viscosity. AH is the background. - logical :: use_QG_Leith !< If true, use QG Leith nonlinear eddy viscosity. + logical :: use_QG_Leith_visc !< If true, use QG Leith nonlinear eddy viscosity. !! KH is the background value. logical :: bound_Coriolis !< If true & SMAGORINSKY_AH is used, the biharmonic !! viscosity is modified to include a term that @@ -322,13 +322,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, legacy_bound = (CS%Smagorinsky_Kh .or. CS%Leith_Kh) .and. & (CS%bound_Kh .and. .not.CS%better_bound_Kh) - ! Coefficient for modified Leith - if (CS%Modified_Leith) then - mod_Leith = 1.0 - else - mod_Leith = 0.0 - endif - ! Toggle whether to use a Laplacian viscosity derived from MEKE use_MEKE_Ku = associated(MEKE%Ku) @@ -621,8 +614,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, enddo ; enddo endif ! CS%use_beta_in_Leith - if (CS%use_QG_Leith) then - call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, vort_xy_dx, vort_xy_dy) + if (CS%use_QG_Leith_visc) then + call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, vort_xy_dx, vort_xy_dy, & + grad_div_mag_h, grad_div_mag_q) endif do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 @@ -1115,7 +1109,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) ! cases where the corresponding parameters are not read. CS%bound_Kh = .false. ; CS%better_bound_Kh = .false. ; CS%Smagorinsky_Kh = .false. ; CS%Leith_Kh = .false. CS%bound_Ah = .false. ; CS%better_bound_Ah = .false. ; CS%Smagorinsky_Ah = .false. ; CS%Leith_Ah = .false. - CS%use_QG_Leith = .false. + CS%use_QG_Leith_visc = .false. CS%bound_Coriolis = .false. CS%Modified_Leith = .false. CS%anisotropic = .false. @@ -1170,17 +1164,17 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) "The nondimensional Laplacian Leith constant, \n"//& "often set to 1.0", units="nondim", default=0.0, & fail_if_missing = CS%Leith_Kh) - call get_param(param_file, mdl, "USE_QG_LEITH", CS%use_QG_Leith, & + call get_param(param_file, mdl, "USE_QG_LEITH_VISC", CS%use_QG_Leith_visc, & "If true, use QG Leith nonlinear eddy viscosity.", & default=.false.) - if (CS%use_QG_Leith .and. .not. CS%Leith_Kh) call MOM_error(FATAL, & + if (CS%use_QG_Leith_visc .and. .not. CS%Leith_Kh) call MOM_error(FATAL, & "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& - "LEITH_KH must be True when USE_QG_LEITH=True.") + "LEITH_KH must be True when USE_QG_LEITH_VISC=True.") endif if (CS%Leith_Kh .or. CS%Leith_Ah .or. get_all) then call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_Leith, & - "If true, include the beta term in the QG Leith nonlinear eddy viscosity.", & - default=CS%use_QG_Leith) + "If true, include the beta term in the Leith nonlinear eddy viscosity.", & + default=CS%Leith_Kh) call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & "If true, add a term to Leith viscosity which is \n"//& "proportional to the gradient of divergence.", & diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index fe0dd18d75..0e9659e12a 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -780,67 +780,6 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, vort_xy_dx, vort_xy_dy) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB -! ! Divergence -! do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 -! div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & -! G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & -! (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & -! G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & -! (h(i,j,k) + GV%H_subroundoff) -! enddo ; enddo -! -! ! Divergence gradient -! do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 -! div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) -! enddo ; enddo -! -! do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 -! div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) -! enddo ; enddo -! -! ! Components for the vertical vorticity -! ! Note this a simple re-calculation of shearing components using the same discretization. -! ! We will consider using a circulation based calculation of vorticity later. -! ! Also note this will need OBC boundary conditions re-applied... -! do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 -! DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) -! dvdx(I,J) = DY_dxBu * (v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) -! DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) -! dudy(I,J) = DX_dyBu * (u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) -! enddo ; enddo -! -! ! Vorticity -! if (CS%no_slip) then -! do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 -! vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) -! enddo ; enddo -! else -! do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 -! vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) -! enddo ; enddo -! endif -! -! ! Vorticity gradient -! do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 -! DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) -! vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) -! enddo ; enddo -! -! do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 -! DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) -! vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) -! enddo ; enddo -! -! ! Add in beta for the Leith viscosity -! if (CS%use_beta_in_Leith) then -! do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 -! vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1) ) -! enddo ; enddo -! do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 -! vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j) ) -! enddo ; enddo -! endif -! ! Add in stretching term for the QG Leith vsicosity ! if (CS%use_QG_Leith) then do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 @@ -879,31 +818,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, vort_xy_dx, vort_xy_dy) + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / & ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) ) enddo ; enddo -! endif -! mod_Leith = 0.; if (CS%modified_Leith) mod_Leith = 1.0 - -! ! h-point viscosities -! do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! vert_vort_mag = sqrt( & -! 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & -! (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & -! mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)*div_xx_dx(I-1,j)) + & -! (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) -! if (CS%Leith_Kh) Leith_Kh_h(i,j) = CS%Laplac3_const_xx(i,j) * vert_vort_mag -! if (CS%Leith_Ah) Leith_Ah_h(i,j) = CS%biharm5_const_xx(i,j) * vert_vort_mag -! enddo ; enddo - -! ! q-point viscosities -! do J=js-1,Jeq ; do I=is-1,Ieq -! vert_vort_mag = sqrt( & -! 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & -! (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & -! mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)*div_xx_dx(I,j+1)) + & -! (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) -! if (CS%Leith_Kh) Leith_Kh_q(I,J) = CS%Laplac3_const_xy(I,J) * vert_vort_mag -! if (CS%Leith_Ah) Leith_Ah_q(I,J) = CS%biharm5_const_xx(I,J) * vert_vort_mag -! enddo ; enddo end subroutine calc_QG_Leith_viscosity From f913004949fbdc7516cd6820cea329ebe286c40e Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Thu, 1 Nov 2018 16:14:45 -0600 Subject: [PATCH 023/106] Preparing lateral_coeffs and thickness_diffuse for QG Leith calculations. --- .../lateral/MOM_hor_visc.F90 | 8 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 173 ++++++++---------- .../lateral/MOM_thickness_diffuse.F90 | 4 + 3 files changed, 90 insertions(+), 95 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 480070ac0b..b98aeee1d9 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -587,6 +587,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, else + do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 + div_xx_dx(I,j) = 0.0 + enddo ; enddo + do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 + div_xx_dy(i,J) = 0.0 + enddo ; enddo do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 grad_div_mag_h(i,j) = 0.0 enddo ; enddo @@ -616,7 +622,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if (CS%use_QG_Leith_visc) then call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, vort_xy_dx, vort_xy_dy, & - grad_div_mag_h, grad_div_mag_q) + div_xx_dx, div_xx_dy) endif do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 0e9659e12a..16ec09da96 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -91,6 +91,12 @@ module MOM_lateral_mixing_coeffs slope_y => NULL(), & !< Meridional isopycnal slope (non-dimensional) ebt_struct => NULL() !< Vertical structure function to scale diffusivities with (non-dim) + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & + Laplac3_const_u !< Laplacian metric-dependent constants (nondim) + + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & + Laplac3_const_v !< Laplacian metric-dependent constants (nondim) + ! Parameters integer :: VarMix_Ktop !< Top layer to start downward integrals real :: Visbeck_L_scale !< Fixed length scale in Visbeck formula @@ -111,23 +117,7 @@ module MOM_lateral_mixing_coeffs ! Leith parameters logical :: use_QG_Leith_GM !< If true, uses the QG Leith viscosity as the GM coefficient -! logical :: use_beta_in_Leith !< If true, includes the beta term in the Leith viscosity -! logical :: Leith_Kh !< If true, enables the Leith scheme -! logical :: modified_Leith !< if true, include the divergence contribution to Leith viscosity -! logical :: Leith_Ah !< If true, enables the bi-harmonic Leith scheme -! logical :: no_slip !< If true, no slip boundary conditions are used. -! !! Otherwise free slip boundary conditions are assumed. -! !! The implementation of the free slip boundary -! !! conditions on a C-grid is much cleaner than the -! !! no slip boundary conditions. The use of free slip -! !! b.c.s is strongly encouraged. The no slip b.c.s -! !! are not implemented with the biharmonic viscosity. -! real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & -! Laplac3_const_xx, & ! Laplacian metric-dependent constants (nondim) -! biharm5_const_xx ! Biharmonic metric-dependent constants (nondim) -! real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & -! Laplac3_const_xy, & ! Laplacian metric-dependent constants (nondim) -! biharm5_const_xy ! Biharmonic metric-dependent constants (nondim) + logical :: use_beta_in_QG_Leith ! If true, includes the beta term in the QG Leith GM coefficient ! Diagnostics !>@{ @@ -743,7 +733,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) end subroutine calc_slope_functions_using_just_e !> Calculates the Leith Laplacian and bi-harmonic viscosity coefficients -subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, vort_xy_dx, vort_xy_dy) +subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, vort_xy_dx, vort_xy_dy, div_xx_dx, div_xx_dy) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -753,6 +743,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, vort_xy_dx, vort_xy_dy) integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vort_xy_dx !< x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: vort_xy_dy !< y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) + real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) + real, dimension(SZI_(G),SZJB_(G)), intent(out) :: div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) ! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity at h-points (m2 s-1) ! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity at q-points (m2 s-1) ! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Ah_h !< Leith bi-harmonic viscosity at h-points (m4 s-1) @@ -809,17 +801,54 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, vort_xy_dx, vort_xy_dy) vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * & ( ( h_at_u(I,j) * dslopex_dz(I,j) + h_at_u(I-1,j+1) * dslopex_dz(I-1,j+1) ) & + ( h_at_u(I-1,j) * dslopex_dz(I-1,j) + h_at_u(I,j+1) * dslopex_dz(I,j+1) ) ) / & - ( ( h_at_u(I,j) + h_at_u(I-1,j+1) ) + ( h_at_u(I-1,j) + h_at_u(I,j+1) ) ) + ( ( h_at_u(I,j) + h_at_u(I-1,j+1) ) + ( h_at_u(I-1,j) + h_at_u(I,j+1) ) + GV%H_subroundoff) enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * & ( ( h_at_v(i,J) * dslopey_dz(i,J) + h_at_v(i+1,J-1) * dslopey_dz(i+1,J-1) ) & + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / & - ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) ) + ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) + GV%H_subroundoff) enddo ; enddo + if (CS%use_QG_Leith_GM) then + if (CS%use_beta_in_QG_Leith) then + do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 + beta_u(I,j) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & + (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2) ) + enddo ; enddo + do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 + beta_v(i,J) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & + (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) + enddo ; enddo + endif + + do j=js-1,Jeq+1 ; do I=is-2,Ieq + grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J) & + + vort_xy_dx(i,J-1) + vort_xy_dx(i+1,J-1)))**2) + grad_div_mag_u(I,j) = SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & + + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) + if (CS%use_beta_in_QG_Leith) then + vert_vort_mag = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), beta_u(I,j)**3) + else + vert_vort_mag = grad_vort_mag_u(I,j) + grad_div_mag_u(I,j) + endif + enddo ; enddo + + do J=js-2,Jeq ; do i=is-1,Ieq+1 + grad_vort_mag_v(i,J) = SQRT(vort_xy_dx(i,J)**2 + (0.25*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j) & + + vort_xy_dy(I,j+1) + vort_xy_dy(I-1,j+1)))**2) + grad_div_mag_v(i,J) = SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & + + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) + if (CS%use_beta_in_QG_Leith) then + vert_vort_mag = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)**3) + else + vert_vort_mag = grad_vort_mag_v(i,J) + grad_div_mag_v(i,J) + endif + enddo ; enddo + endif + end subroutine calc_QG_Leith_viscosity subroutine VarMix_init(Time, G, param_file, diag, CS) @@ -837,8 +866,8 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) logical :: Gill_equatorial_Ld, use_FGNV_streamfn, use_MEKE, in_use real :: MLE_front_length real :: Leith_Lap_const ! The non-dimensional coefficient in the Leith viscosity - real :: Leith_bi_const ! The non-dimensional coefficient in the bi-harmonic Leith viscosity - real :: DX2, DY2, grid_sp_2, grid_sp_3 ! Intermediate quantities for Leith metrics + real :: grid_sp_u2, grid_sp_u3 + real :: grid_sp_v2, grid_sp_v3 ! Intermediate quantities for Leith metrics ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_lateral_mixing_coeffs" ! This module's name. @@ -1122,83 +1151,39 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) endif ! Leith parameters -! call get_param(param_file, mdl, "USE_QG_LEITH", CS%use_QG_Leith, & -! "If true, use the QG Leith nonlinear eddy viscosity.", & -! default=.false.) -! call get_param(param_file, mdl, "LEITH_KH", CS%Leith_Kh, & -! "If true, use a Leith nonlinear eddy viscosity.", & -! default=CS%use_QG_Leith) -! if (CS%use_QG_Leith .and. .not. CS%Leith_Kh) call MOM_error(FATAL, & -! "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& -! "LEITH_KH must be True when USE_QG_LEITH=True.") -! call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_Leith, & -! "If true, include the beta term in the QG Leith nonlinear eddy viscosity.", & -! default=CS%use_QG_Leith) -! call get_param(param_file, mdl, "LEITH_AH", CS%Leith_Ah, & -! "If true, use a biharmonic Leith nonlinear eddy \n"//& -! "viscosity.", default=.false.) -! call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & -! "If true, add a term to Leith viscosity which is \n"//& -! "proportional to the gradient of divergence.", & -! default=.false.) -! call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & -! "The nondimensional Laplacian Leith constant, \n"//& -! "often set to 1.0", units="nondim", default=0.0, & -! fail_if_missing = CS%Leith_Kh) -! call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & -! "The nondimensional biharmonic Leith constant, \n"//& -! "typical values are thus far undetermined.", units="nondim", default=0.0, & -! fail_if_missing = CS%Leith_Ah) -! if (CS%Leith_Kh .or. CS%Leith_Ah) then -! in_use = .true. -! call get_param(param_file, mdl, "NOSLIP", CS%no_slip, & -! "If true, no slip boundary conditions are used; otherwise \n"//& -! "free slip boundary conditions are assumed. The \n"//& -! "implementation of the free slip BCs on a C-grid is much \n"//& -! "cleaner than the no slip BCs. The use of free slip BCs \n"//& -! "is strongly encouraged, and no slip BCs are not used with \n"//& -! "the biharmonic viscosity.", default=.false.) + call get_param(param_file, mdl, "USE_QG_LEITH_GM", CS%use_QG_Leith_GM, & + "If true, use the QG Leith viscosity as the GM coefficient.", & + default=.false.) + if (CS%Use_QG_Leith_GM) then + call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & + "The nondimensional Laplacian Leith constant, \n"//& + "often set to 1.0", units="nondim", default=0.0) + + call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_QG_Leith, & + "If true, include the beta term in the Leith nonlinear eddy viscosity.", & + default=.true.) + + allocate(CS%Laplac3_const_u(IsdB:IedB,jsd:jed)) ; CS%Laplac3_const_u(:,:) = 0.0 + allocate(CS%Laplac3_const_v(isd:ied,JsdB:JedB)) ; CS%Laplac3_const_v(:,:) = 0.0 + + do j=Jsq,Jeq+1 ; do I=is-1,Ieq + ! Static factors in the Leith schemes + grid_sp_u2 = G%dyCu(I,j)*G%dxCu(I,j) + grid_sp_u3 = grid_sp_u2*sqrt(grid_sp_u2) + CS%Laplac3_const_u(I,j) = Leith_Lap_const * grid_sp_v3 + enddo ; enddo + do j=js-1,Jeq ; do I=Isq,Ieq+1 + ! Static factors in the Leith schemes + grid_sp_v2 = G%dyCv(i,J)*G%dxCu(i,J) + grid_sp_v3 = grid_sp_v2*sqrt(grid_sp_v2) + CS%Laplac3_const_v(i,J) = Leith_Lap_const * grid_sp_v3 + enddo ; enddo + if (.not. CS%use_stored_slopes) call MOM_error(FATAL, & "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& "USE_STORED_SLOPES must be True when using QG Leith.") endif -! if (CS%Leith_Kh) then -! allocate(CS%Laplac3_const_xx(isd:ied,jsd:jed)) ; CS%Laplac3_const_xx(:,:) = 0.0 -! do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! DX2 = G%dxT(i,j)*G%dxT(i,j) -! DY2 = G%dyT(i,j)*G%dyT(i,j) -! grid_sp_2 = (2.0*DX2*DY2) / (DX2 + DY2) -! grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) -! CS%Laplac3_const_xx(i,j) = Leith_Lap_const * grid_sp_3 -! enddo ; enddo -! allocate(CS%Laplac3_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Laplac3_const_xy(:,:) = 0.0 -! do J=js-1,Jeq ; do I=is-1,Ieq -! DX2 = G%dxBu(I,J)*G%dxBu(I,J) -! DY2 = G%dyBu(I,J)*G%dyBu(I,J) -! grid_sp_2 = (2.0*DX2*DY2) / (DX2 + DY2) -! grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) -! CS%Laplac3_const_xy(I,J) = Leith_Lap_const * grid_sp_3 -! enddo ; enddo -! endif -! if (CS%Leith_Ah) then -! allocate(CS%biharm5_const_xx(isd:ied,jsd:jed)) ; CS%biharm5_const_xx(:,:) = 0.0 -! do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! DX2 = G%dxT(i,j)*G%dxT(i,j) -! DY2 = G%dyT(i,j)*G%dyT(i,j) -! grid_sp_2 = (2.0*DX2*DY2) / (DX2+DY2) -! grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) -! CS%biharm5_const_xx(i,j) = Leith_bi_const * (grid_sp_2 * grid_sp_3) -! enddo ; enddo -! allocate(CS%biharm5_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm5_const_xy(:,:) = 0.0 -! do J=js-1,Jeq ; do I=is-1,Ieq -! DX2 = G%dxBu(I,J)*G%dxBu(I,J) -! DY2 = G%dyBu(I,J)*G%dyBu(I,J) -! grid_sp_2 = (2.0*DX2*DY2) / (DX2+DY2) -! grid_sp_3 = grid_sp_2*sqrt(grid_sp_2) -! CS%biharm5_const_xy(I,J) = Leith_bi_const * (grid_sp_2 * grid_sp_3) -! enddo ; enddo -! endif ! If nothing is being stored in this class then deallocate if (in_use) then diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index fd05c4a5a2..75236fef2d 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -52,6 +52,7 @@ module MOM_thickness_diffuse !! longer than DT, or 0 (the default) to use DT. integer :: nkml !< number of layers within mixed layer logical :: debug !< write verbose checksums for debugging purposes + logical :: QG_Leith_GM !< If true, uses the QG Leith viscosity as the GM coefficient type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity (W m-2) real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope (nondim) @@ -1728,6 +1729,9 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) "marginally unstable value in a pure layered model, but \n"//& "much smaller numbers (e.g. 0.1) seem to work better for \n"//& "ALE-based models.", units = "nondimensional", default=0.8) + call get_param(param_file, mdl, "USE_QG_LEITH_GM", CS%QG_Leith_GM, & + "If true, use the QG Leith viscosity as the GM coefficient.", & + default=.false.) if (CS%max_Khth_CFL < 0.0) CS%max_Khth_CFL = 0.0 call get_param(param_file, mdl, "DETANGLE_INTERFACES", CS%detangle_interfaces, & "If defined add 3-d structured enhanced interface height \n"//& From d96a3fef7661efa3fad14ca295f8f6d1c1174867 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Fri, 2 Nov 2018 11:00:23 -0600 Subject: [PATCH 024/106] Defined KH arrays in VarMix to be passed to thickness_diffuse. --- .../lateral/MOM_hor_visc.F90 | 4 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 32 +++++++++++----- .../lateral/MOM_thickness_diffuse.F90 | 37 ++++++++++++++++--- 3 files changed, 56 insertions(+), 17 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index b98aeee1d9..2f74b48203 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -621,8 +621,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif ! CS%use_beta_in_Leith if (CS%use_QG_Leith_visc) then - call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, vort_xy_dx, vort_xy_dy, & - div_xx_dx, div_xx_dy) + call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, div_xx_dx, div_xx_dy, & + vort_xy_dx, vort_xy_dy,) endif do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 16ec09da96..da8097b466 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -97,6 +97,12 @@ module MOM_lateral_mixing_coeffs real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & Laplac3_const_v !< Laplacian metric-dependent constants (nondim) + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & + KH_u_QGL !< QG Leith GM coefficient at u-points (m2 s-1) + + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & + KH_v_QGL !< QG Leith GM coefficient at v-points (m2 s-1) + ! Parameters integer :: VarMix_Ktop !< Top layer to start downward integrals real :: Visbeck_L_scale !< Fixed length scale in Visbeck formula @@ -116,8 +122,8 @@ module MOM_lateral_mixing_coeffs real :: Visbeck_S_max !< Upper bound on slope used in Eady growth rate (nondim). ! Leith parameters - logical :: use_QG_Leith_GM !< If true, uses the QG Leith viscosity as the GM coefficient - logical :: use_beta_in_QG_Leith ! If true, includes the beta term in the QG Leith GM coefficient + logical :: use_QG_Leith_GM !! If true, uses the QG Leith viscosity as the GM coefficient + logical :: use_beta_in_QG_Leith !! If true, includes the beta term in the QG Leith GM coefficient ! Diagnostics !>@{ @@ -733,7 +739,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) end subroutine calc_slope_functions_using_just_e !> Calculates the Leith Laplacian and bi-harmonic viscosity coefficients -subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, vort_xy_dx, vort_xy_dy, div_xx_dx, div_xx_dy) +subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_xy_dx, vort_xy_dy) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -741,10 +747,10 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, vort_xy_dx, vort_xy_dy, div_ ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow (m s-1) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg m-2) integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vort_xy_dx !< x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: vort_xy_dy !< y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) - real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) - real, dimension(SZI_(G),SZJB_(G)), intent(out) :: div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) ! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity at h-points (m2 s-1) ! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity at q-points (m2 s-1) ! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Ah_h !< Leith bi-harmonic viscosity at h-points (m4 s-1) @@ -772,6 +778,10 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, vort_xy_dx, vort_xy_dy, div_ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + real :: inv_PI3 + + + inv_PI3 = 1.0/((4.0*atan(1.0))**3) ! Add in stretching term for the QG Leith vsicosity ! if (CS%use_QG_Leith) then do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 @@ -830,9 +840,11 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, vort_xy_dx, vort_xy_dy, div_ grad_div_mag_u(I,j) = SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) if (CS%use_beta_in_QG_Leith) then - vert_vort_mag = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), beta_u(I,j)**3) + KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), beta_u(I,j)**3) & + * CS%Laplac3_const_u(I,j) * inv_PI3 else - vert_vort_mag = grad_vort_mag_u(I,j) + grad_div_mag_u(I,j) + KH_u_QG(I,j,k) = (grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) & + * CS%Laplac3_const_u(I,j) * inv_PI3 endif enddo ; enddo @@ -842,9 +854,11 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, vort_xy_dx, vort_xy_dy, div_ grad_div_mag_v(i,J) = SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) if (CS%use_beta_in_QG_Leith) then - vert_vort_mag = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)**3) + KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)**3) & + * CS%Laplac3_const_v(i,J) * inv_PI3 else - vert_vort_mag = grad_vort_mag_v(i,J) + grad_div_mag_v(i,J) + KH_v_QG(i,J,k) = (grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) & + * CS%Laplac3_const_v(i,J) * inv_PI3 endif enddo ; enddo endif diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 75236fef2d..b1c0496a2c 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -117,6 +117,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS ! in roundoff and can be neglected, in H. real, dimension(:,:), pointer :: cg1 => null() !< Wave speed (m/s) logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct + logical :: use_QG_Leith integer :: i, j, k, is, ie, js, je, nz real :: hu(SZI_(G), SZJ_(G)) ! u-thickness (H) real :: hv(SZI_(G), SZJ_(G)) ! v-thickness (H) @@ -146,6 +147,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS Resoln_scaled = VarMix%Resoln_scaled_KhTh use_stored_slopes = VarMix%use_stored_slopes khth_use_ebt_struct = VarMix%khth_use_ebt_struct + use_QG_Leith = VarMix%use_QG_Leith_GM if (associated(VarMix%cg1)) cg1 => VarMix%cg1 else cg1 => null() @@ -177,9 +179,11 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS if (use_VarMix) then !$OMP do - do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + CS%KHTH_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) - enddo ; enddo + if (.not. use_QG_Leith) then + do j=js,je ; do I=is-1,ie + Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + CS%KHTH_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) + enddo ; enddo + endif endif if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then @@ -212,6 +216,15 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS KH_u(I,j,1) = min(KH_u_CFL(I,j), Khth_Loc_u(I,j)) enddo ; enddo + if (use_VarMix) then +!$OMP do + if (use_QG_Leith) then + do K=2,nz+1 ; do j=js,je ; do I=is-1,ie + KH_u(I,j,K) = VarMix%KH_u_QG(I,j,k-1) + enddo ; enddo ; enddo + endif + endif + if (khth_use_ebt_struct) then !$OMP do do K=2,nz+1 ; do j=js,je ; do I=is-1,ie @@ -231,9 +244,11 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS if (use_VarMix) then !$OMP do - do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) - enddo ; enddo + if (.not. use_QG_Leith) then + do J=js-1,je ; do i=is,ie + Khth_Loc(i,j) = Khth_Loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) + enddo ; enddo + endif endif if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then !$OMP do @@ -267,6 +282,16 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS KH_v(i,J,1) = min(KH_v_CFL(i,J), Khth_Loc(i,j)) enddo ; enddo endif + + if (use_VarMix) then +!$OMP do + if (use_QG_Leith) then + do K=2,nz+1 ; do J=js-1,je ; do i=is,ie + KH_v(i,J,K) = VarMix%KH_v_QG(i,J,k-1) + enddo ; enddo ; enddo + endif + endif + if (khth_use_ebt_struct) then !$OMP do do K=2,nz+1 ; do J=js-1,je ; do i=is,ie From c42b6a456172dc56da63af3a8be6f778d78db202 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 26 Nov 2018 16:23:33 -0700 Subject: [PATCH 025/106] Add grad_vort_mag_h and grad_vort_mag_q --- src/parameterizations/lateral/MOM_hor_visc.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 2f74b48203..243d52abbc 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -222,7 +222,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, Leith_Kh_h, & ! Leith Laplacian viscosity at h-points (m2 s-1) Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points (m4 s-1) beta_h, & ! Gradient of planetary vorticity at h-points (m-1 s-1) - grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points (m-1 s-1) + grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points (m-1 s-1) grad_div_mag_h ! Magnitude of divergence gradient at h-points (m-1 s-1) real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -234,7 +234,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, Leith_Kh_q, & ! Leith Laplacian viscosity at q-points (m2 s-1) Leith_Ah_q, & ! Leith bi-harmonic viscosity at q-points (m4 s-1) beta_q, & ! Gradient of planetary vorticity at q-points (m-1 s-1) - grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points (m-1 s-1) + grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points (m-1 s-1) grad_div_mag_q ! Magnitude of divergence gradient at q-points (m-1 s-1) real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & @@ -556,7 +556,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo - + if (CS%modified_Leith) then ! Divergence do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 @@ -598,7 +598,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, enddo ; enddo do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 grad_div_mag_q(I,J) = 0.0 - enddo ; enddo + enddo ; enddo endif ! CS%modified_Leith @@ -622,9 +622,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if (CS%use_QG_Leith_visc) then call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, div_xx_dx, div_xx_dy, & - vort_xy_dx, vort_xy_dy,) + vort_xy_dx, vort_xy_dy) endif - + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 grad_vort_mag_h(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + (0.5*(vort_xy_dy(I,j) + & vort_xy_dy(I-1,j)))**2 ) @@ -646,7 +646,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_beta_in_Leith) then - vert_vort_mag = MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j), beta_h(i,j)**3) + vert_vort_mag = MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j), beta_h(i,j)*3) else vert_vort_mag = grad_vort_mag_h(i,j) + grad_div_mag_h(i,j) endif @@ -779,10 +779,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_beta_in_Leith) then - vert_vort_mag = MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), beta_q(I,J)**3) + vert_vort_mag = MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), beta_q(I,J)*3) else vert_vort_mag = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) - endif + endif endif h2uq = 4.0 * h_u(I,j) * h_u(I,j+1) h2vq = 4.0 * h_v(i,J) * h_v(i+1,J) From 81a577128ae8cc4b25f60d8d067fb88e0d6a51ab Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 26 Nov 2018 16:25:16 -0700 Subject: [PATCH 026/106] Compute QG Leith GM coefficient and add some diagnostics --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 78 ++++++++++++------- 1 file changed, 50 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index da8097b466..f8b66ecc51 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -98,10 +98,10 @@ module MOM_lateral_mixing_coeffs Laplac3_const_v !< Laplacian metric-dependent constants (nondim) real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - KH_u_QGL !< QG Leith GM coefficient at u-points (m2 s-1) + KH_u_QG !< QG Leith GM coefficient at u-points (m2 s-1) real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - KH_v_QGL !< QG Leith GM coefficient at v-points (m2 s-1) + KH_v_QG !< QG Leith GM coefficient at v-points (m2 s-1) ! Parameters integer :: VarMix_Ktop !< Top layer to start downward integrals @@ -130,7 +130,7 @@ module MOM_lateral_mixing_coeffs !! Diagnostic identifier integer :: id_SN_u=-1, id_SN_v=-1, id_L2u=-1, id_L2v=-1, id_Res_fn = -1 integer :: id_N2_u=-1, id_N2_v=-1, id_S2_u=-1, id_S2_v=-1 - integer :: id_Rd_dx=-1 + integer :: id_Rd_dx=-1, id_KH_u_QG = -1, id_KH_v_QG = -1 type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. !>@} @@ -425,12 +425,12 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) endif if (query_averaging_enabled(CS%diag)) then - if (CS%id_SN_u > 0) call post_data(CS%id_SN_u, CS%SN_u, CS%diag) - if (CS%id_SN_v > 0) call post_data(CS%id_SN_v, CS%SN_v, CS%diag) - if (CS%id_L2u > 0) call post_data(CS%id_L2u, CS%L2u, CS%diag) - if (CS%id_L2v > 0) call post_data(CS%id_L2v, CS%L2v, CS%diag) - if (CS%id_N2_u > 0) call post_data(CS%id_N2_u, N2_u, CS%diag) - if (CS%id_N2_v > 0) call post_data(CS%id_N2_v, N2_v, CS%diag) + if (CS%id_SN_u > 0) call post_data(CS%id_SN_u, CS%SN_u, CS%diag) + if (CS%id_SN_v > 0) call post_data(CS%id_SN_v, CS%SN_v, CS%diag) + if (CS%id_L2u > 0) call post_data(CS%id_L2u, CS%L2u, CS%diag) + if (CS%id_L2v > 0) call post_data(CS%id_L2v, CS%L2v, CS%diag) + if (CS%id_N2_u > 0) call post_data(CS%id_N2_u, N2_u, CS%diag) + if (CS%id_N2_v > 0) call post_data(CS%id_N2_v, N2_v, CS%diag) endif end subroutine calc_slope_functions @@ -749,8 +749,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) - real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vort_xy_dx !< x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) - real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: vort_xy_dy !< y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vort_xy_dx !< x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: vort_xy_dy !< y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) ! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity at h-points (m2 s-1) ! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity at q-points (m2 s-1) ! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Ah_h !< Leith bi-harmonic viscosity at h-points (m4 s-1) @@ -764,27 +764,35 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x ! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) ! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) dslopey_dz, & ! z-derivative of y-slope at v-points (m-1) - h_at_v ! Thickness at v-points (m or kg m-2) + h_at_v, & ! Thickness at v-points (m or kg m-2) + beta_v, & ! Beta at v-points (m-1 s-1) + grad_vort_mag_v, & ! mag. of vort. grad. at v-points (s-1) + grad_div_mag_v ! mag. of div. grad. at v-points (s-1) real, dimension(SZIB_(G),SZJ_(G)) :: & ! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) ! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) dslopex_dz, & ! z-derivative of x-slope at u-points (m-1) - h_at_u ! Thickness at u-points (m or kg m-2) + h_at_u, & ! Thickness at u-points (m or kg m-2) + beta_u, & ! Beta at u-points (m-1 s-1) + grad_vort_mag_u, & ! mag. of vort. grad. at u-points (s-1) + grad_div_mag_u ! mag. of div. grad. at u-points (s-1) ! real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points (s-1) ! real :: mod_Leith, DY_dxBu, DX_dyBu, vert_vort_mag real :: h_at_slope_above, h_at_slope_below, Ih, f integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq + real :: inv_PI3 + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - real :: inv_PI3 + if (k > 1) then - inv_PI3 = 1.0/((4.0*atan(1.0))**3) ! Add in stretching term for the QG Leith vsicosity ! if (CS%use_QG_Leith) then - do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 +! do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 + do j=js-2,Jeq+2 ; do I=is-2,Ieq+1 h_at_slope_above = 2. * ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) * h(i+1,j,k) ) / & ( ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) + h(i+1,j,k) ) & + ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k-1) + h(i+1,j,k-1) ) + GV%H_subroundoff ) @@ -795,7 +803,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x dslopex_dz(I,j) = 2. * ( CS%slope_x(i,j,k) - CS%slope_x(i,j,k+1) ) * Ih h_at_u(I,j) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo - do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 +! do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 + do J=js-2,Jeq+1 ; do i=is-2,Ieq+2 h_at_slope_above = 2. * ( h(i,j,k-1) * h(i,j+1,k-1) ) * ( h(i,j,k) * h(i,j+1,k) ) / & ( ( h(i,j,k-1) * h(i,j+1,k-1) ) * ( h(i,j,k) + h(i,j+1,k) ) & + ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k-1) + h(i,j+1,k-1) ) + GV%H_subroundoff ) @@ -806,6 +815,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x dslopey_dz(i,J) = 2. * ( CS%slope_y(i,j,k) - CS%slope_y(i,j,k+1) ) * Ih h_at_v(i,J) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo + do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * & @@ -813,6 +823,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x + ( h_at_u(I-1,j) * dslopex_dz(I-1,j) + h_at_u(I,j+1) * dslopex_dz(I,j+1) ) ) / & ( ( h_at_u(I,j) + h_at_u(I-1,j+1) ) + ( h_at_u(I-1,j) + h_at_u(I,j+1) ) + GV%H_subroundoff) enddo ; enddo + do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * & @@ -820,7 +831,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / & ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) + GV%H_subroundoff) enddo ; enddo - + endif ! k > 1 if (CS%use_QG_Leith_GM) then if (CS%use_beta_in_QG_Leith) then @@ -828,22 +839,22 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x beta_u(I,j) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2) ) enddo ; enddo - do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 + do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 beta_v(i,J) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) enddo ; enddo endif - + do j=js-1,Jeq+1 ; do I=is-2,Ieq grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J) & + vort_xy_dx(i,J-1) + vort_xy_dx(i+1,J-1)))**2) grad_div_mag_u(I,j) = SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & - + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) + + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) if (CS%use_beta_in_QG_Leith) then - KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), beta_u(I,j)**3) & + CS%KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), beta_u(I,j)*3) & * CS%Laplac3_const_u(I,j) * inv_PI3 else - KH_u_QG(I,j,k) = (grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) & + CS%KH_u_QG(I,j,k) = (grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) & * CS%Laplac3_const_u(I,j) * inv_PI3 endif enddo ; enddo @@ -852,15 +863,18 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x grad_vort_mag_v(i,J) = SQRT(vort_xy_dx(i,J)**2 + (0.25*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j) & + vort_xy_dy(I,j+1) + vort_xy_dy(I-1,j+1)))**2) grad_div_mag_v(i,J) = SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & - + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) + + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) if (CS%use_beta_in_QG_Leith) then - KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)**3) & + CS%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)*3) & * CS%Laplac3_const_v(i,J) * inv_PI3 else - KH_v_QG(i,J,k) = (grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) & + CS%KH_v_QG(i,J,k) = (grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) & * CS%Laplac3_const_v(i,J) * inv_PI3 endif enddo ; enddo + ! post diagnostics + if (CS%id_KH_v_QG > 0) call post_data(CS%id_KH_v_QG, CS%KH_v_QG, CS%diag) + if (CS%id_KH_u_QG > 0) call post_data(CS%id_KH_u_QG, CS%KH_u_QG, CS%diag) endif end subroutine calc_QG_Leith_viscosity @@ -1168,7 +1182,7 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "USE_QG_LEITH_GM", CS%use_QG_Leith_GM, & "If true, use the QG Leith viscosity as the GM coefficient.", & default=.false.) - + if (CS%Use_QG_Leith_GM) then call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & "The nondimensional Laplacian Leith constant, \n"//& @@ -1180,12 +1194,20 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) allocate(CS%Laplac3_const_u(IsdB:IedB,jsd:jed)) ; CS%Laplac3_const_u(:,:) = 0.0 allocate(CS%Laplac3_const_v(isd:ied,JsdB:JedB)) ; CS%Laplac3_const_v(:,:) = 0.0 + allocate(CS%KH_u_QG(IsdB:IedB,jsd:jed,G%ke)) ; CS%KH_u_QG(:,:,:) = 0.0 + allocate(CS%KH_v_QG(isd:ied,JsdB:JedB,G%ke)) ; CS%KH_v_QG(:,:,:) = 0.0 + ! register diagnostics + + CS%id_KH_u_QG = register_diag_field('ocean_model', 'KH_u_QG', diag%axesCuL, Time, & + 'Horizontal viscosity from Leith QG, at u-points', 'm2 s-1') + CS%id_KH_v_QG = register_diag_field('ocean_model', 'KH_v_QG', diag%axesCvL, Time, & + 'Horizontal viscosity from Leith QG, at v-points', 'm2 s-1') do j=Jsq,Jeq+1 ; do I=is-1,Ieq ! Static factors in the Leith schemes grid_sp_u2 = G%dyCu(I,j)*G%dxCu(I,j) grid_sp_u3 = grid_sp_u2*sqrt(grid_sp_u2) - CS%Laplac3_const_u(I,j) = Leith_Lap_const * grid_sp_v3 + CS%Laplac3_const_u(I,j) = Leith_Lap_const * grid_sp_u3 enddo ; enddo do j=js-1,Jeq ; do I=Isq,Ieq+1 ! Static factors in the Leith schemes From 60d493aa6f805055a90b3c72f18e4bc445641b46 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 26 Nov 2018 16:26:42 -0700 Subject: [PATCH 027/106] Add option to use QG Leith viscosity as the GM coefficient --- .../lateral/MOM_thickness_diffuse.F90 | 50 ++++++++++--------- 1 file changed, 27 insertions(+), 23 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index b1c0496a2c..d65634b1f7 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -52,7 +52,7 @@ module MOM_thickness_diffuse !! longer than DT, or 0 (the default) to use DT. integer :: nkml !< number of layers within mixed layer logical :: debug !< write verbose checksums for debugging purposes - logical :: QG_Leith_GM !< If true, uses the QG Leith viscosity as the GM coefficient +! logical :: QG_Leith_GM !< If true, uses the QG Leith viscosity as the GM coefficient type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity (W m-2) real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope (nondim) @@ -142,6 +142,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS use_VarMix = .false. ; Resoln_scaled = .false. ; use_stored_slopes = .false. khth_use_ebt_struct = .false. + if (associated(VarMix)) then use_VarMix = VarMix%use_variable_mixing .and. (CS%KHTH_Slope_Cff > 0.) Resoln_scaled = VarMix%Resoln_scaled_KhTh @@ -216,15 +217,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS KH_u(I,j,1) = min(KH_u_CFL(I,j), Khth_Loc_u(I,j)) enddo ; enddo - if (use_VarMix) then -!$OMP do - if (use_QG_Leith) then - do K=2,nz+1 ; do j=js,je ; do I=is-1,ie - KH_u(I,j,K) = VarMix%KH_u_QG(I,j,k-1) - enddo ; enddo ; enddo - endif - endif - if (khth_use_ebt_struct) then !$OMP do do K=2,nz+1 ; do j=js,je ; do I=is-1,ie @@ -237,6 +229,15 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS enddo ; enddo ; enddo endif + if (use_VarMix) then +!$OMP do + if (use_QG_Leith) then + do k=1,nz ; do j=js,je ; do I=is-1,ie + KH_u(I,j,k) = VarMix%KH_u_QG(I,j,k) + enddo ; enddo ; enddo + endif + endif + !$OMP do do J=js-1,je ; do i=is,ie Khth_Loc(i,j) = CS%Khth @@ -283,15 +284,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS enddo ; enddo endif - if (use_VarMix) then -!$OMP do - if (use_QG_Leith) then - do K=2,nz+1 ; do J=js-1,je ; do i=is,ie - KH_v(i,J,K) = VarMix%KH_v_QG(i,J,k-1) - enddo ; enddo ; enddo - endif - endif - if (khth_use_ebt_struct) then !$OMP do do K=2,nz+1 ; do J=js-1,je ; do i=is,ie @@ -303,6 +295,16 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS KH_v(i,J,K) = KH_v(i,J,1) enddo ; enddo ; enddo endif + + if (use_VarMix) then +!$OMP do + if (use_QG_Leith) then + do k=1,nz ; do J=js-1,je ; do i=is,ie + KH_v(i,J,k) = VarMix%KH_v_QG(i,J,k) + enddo ; enddo ; enddo + endif + endif + !$OMP do do K=1,nz+1 ; do j=js,je ; do I=is-1,ie ; int_slope_u(I,j,K) = 0.0 ; enddo ; enddo ; enddo !$OMP do @@ -1754,9 +1756,11 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) "marginally unstable value in a pure layered model, but \n"//& "much smaller numbers (e.g. 0.1) seem to work better for \n"//& "ALE-based models.", units = "nondimensional", default=0.8) - call get_param(param_file, mdl, "USE_QG_LEITH_GM", CS%QG_Leith_GM, & - "If true, use the QG Leith viscosity as the GM coefficient.", & - default=.false.) + +! call get_param(param_file, mdl, "USE_QG_LEITH_GM", CS%QG_Leith_GM, & +! "If true, use the QG Leith viscosity as the GM coefficient.", & +! default=.false.) + if (CS%max_Khth_CFL < 0.0) CS%max_Khth_CFL = 0.0 call get_param(param_file, mdl, "DETANGLE_INTERFACES", CS%detangle_interfaces, & "If defined add 3-d structured enhanced interface height \n"//& @@ -1789,7 +1793,7 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) "streamfunction formulation.", & default=0., units="m s-1", do_not_log=.not.CS%use_FGNV_streamfn) call get_param(param_file, mdl, "FGNV_STRAT_FLOOR", strat_floor, & - "A floor for Brunt-Vasaila frequency in the Ferrari et al., 2010,\n"//& + "A floor for Brunt-Vaisala frequency in the Ferrari et al., 2010,\n"//& "streamfunction formulation, expressed as a fraction of planetary\n"//& "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) From ec68e41d479c6355a079945c26c50ddbdcae7680 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 17 Jan 2019 14:50:03 -0700 Subject: [PATCH 028/106] Adds infrastructure to enable GME to access private arrays --- src/core/MOM.F90 | 14 ++-- src/core/MOM_barotropic.F90 | 27 +++++++- src/core/MOM_dynamics_split_RK2.F90 | 20 +++++- src/core/MOM_dynamics_unsplit.F90 | 11 ++- src/core/MOM_dynamics_unsplit_RK2.F90 | 11 ++- .../lateral/MOM_thickness_diffuse.F90 | 68 ++++++++++++++++++- 6 files changed, 134 insertions(+), 17 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f6bf668b73..bd3103e468 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -50,6 +50,7 @@ module MOM use MOM_ALE, only : ALE_init, ALE_end, ALE_main, ALE_CS, adjustGridForIntegrity use MOM_ALE, only : ALE_getCoordinate, ALE_getCoordinateUnits, ALE_writeCoordinateFile use MOM_ALE, only : ALE_updateVerticalGridType, ALE_remap_init_conds, ALE_register_diags +use MOM_barotropic, only : Barotropic_CS use MOM_boundary_update, only : call_OBC_register, OBC_register_end, update_OBC_CS use MOM_coord_initialization, only : MOM_initialize_coord use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS @@ -317,7 +318,8 @@ module MOM !< Pointer to the control structure for the MEKE updates type(VarMix_CS), pointer :: VarMix => NULL() !< Pointer to the control structure for the variable mixing module - + type(Barotropic_CS), pointer :: Barotropic_CSp => NULL() + !< Pointer to the control structure for the barotropic module type(tracer_registry_type), pointer :: tracer_Reg => NULL() !< Pointer to the MOM tracer registry type(tracer_advect_CS), pointer :: tracer_adv_CSp => NULL() @@ -959,7 +961,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call step_MOM_dyn_split_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, CS%MEKE) + CS%eta_av_bc, G, GV, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, & + CS%MEKE, CS%Barotropic_CSp, CS%thickness_diffuse_CSp) if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_split (step_MOM)") elseif (CS%do_dynamics) then ! ------------------------------------ not SPLIT @@ -973,11 +976,13 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%use_RK2) then call step_MOM_dyn_unsplit_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE) + CS%eta_av_bc, G, GV, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE, & + CS%Barotropic_CSp, CS%thickness_diffuse_CSp) else call step_MOM_dyn_unsplit(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE, Waves=Waves) + CS%eta_av_bc, G, GV, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE, & + CS%Barotropic_CSp, CS%thickness_diffuse_CSp, Waves=Waves) endif if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_unsplit (step_MOM)") @@ -2291,6 +2296,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & G, GV, param_file, diag, CS%dyn_split_RK2_CSp, restart_CSp, & CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE, & + CS%Barotropic_CSp, CS%thickness_diffuse_CSp, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & CS%visc, dirs, CS%ntrunc, calc_dtbt=calc_dtbt) if (CS%dtbt_reset_period > 0.0) then diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 940c99b8be..022bde860d 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -55,7 +55,7 @@ module MOM_barotropic #endif public btcalc, bt_mass_source, btstep, barotropic_init, barotropic_end -public register_barotropic_restarts, set_dtbt +public register_barotropic_restarts, set_dtbt, barotropic_get_tav !> The barotropic stepping open boundary condition type type, private :: BT_OBC_type @@ -4348,6 +4348,29 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & end subroutine barotropic_init +!> Copies ubtav and vbtav from private type into arrays +subroutine barotropic_get_tav(CS, ubtav, vbtav, G) + type(barotropic_CS), pointer :: CS !< Control structure for + !! this module + type(ocean_grid_type), intent(in) :: G !< Grid structure + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav!< zonal barotropic vel. + !! ave. over baroclinic time-step (m s-1) + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav!< meridional barotropic vel. + !! ave. over baroclinic time-step (m s-1) + ! Local variables + integer :: i,j + + do j = G%jsc, G%jec ; do I = G%isc-1, G%iec + ubtav(I,j) = CS%ubtav(I,j) + enddo ; enddo + + do J = G%jsc-1, G%jec ; do i = G%isc, G%iec + vbtav(i,J) = CS%vbtav(i,J) + enddo ; enddo + +end subroutine barotropic_get_tav + + !> Clean up the barotropic control structure. subroutine barotropic_end(CS) type(barotropic_CS), pointer :: CS !< Control structure to clear out. @@ -4366,7 +4389,7 @@ subroutine barotropic_end(CS) end subroutine barotropic_end !> This subroutine is used to register any fields from MOM_barotropic.F90 -!! that should be written to or read from the restart file. +!!! that should be written to or read from the restart file. subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d02285148a..9fdc2d77de 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -52,6 +52,7 @@ module MOM_dynamics_split_RK2 use MOM_open_boundary, only : open_boundary_test_extern_h use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_ML, set_visc_CS +use MOM_thickness_diffuse, only : thickness_diffuse_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_remnant use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS @@ -228,7 +229,8 @@ module MOM_dynamics_split_RK2 subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & Time_local, dt, forces, p_surf_begin, p_surf_end, & uh, vh, uhtr, vhtr, eta_av, & - G, GV, CS, calc_dtbt, VarMix, MEKE) + G, GV, CS, calc_dtbt, VarMix, MEKE, Barotropic_CSp, & + thickness_diffuse_CSp) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -262,7 +264,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param + type(barotropic_CS), pointer :: Barotropic_CSp!< Pointer to a structure containing + !! barotropic velocities + type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp!< Pointer to a structure containing + !! interface height diffusivities + ! local variables real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity in m s-1. @@ -679,7 +686,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! diffu = horizontal viscosity terms (u_av) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_av, v_av, h_av, CS%diffu, CS%diffv, & - MEKE, Varmix, G, GV, CS%hor_visc_CSp, OBC=CS%OBC) + MEKE, Varmix, Barotropic_CSp, thickness_diffuse_CSp, & + G, GV, CS%hor_visc_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_horvisc) if (showCallTree) call callTree_wayPoint("done with horizontal_viscosity (step_MOM_dyn_split_RK2)") @@ -951,7 +959,8 @@ end subroutine register_restarts_dyn_split_RK2 !! dynamic core, including diagnostics and the cpu clocks. subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_file, & diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & - VarMix, MEKE, OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & + VarMix, MEKE, Barotropic_CSp, thickness_diffuse_CSp, & + OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, calc_dtbt) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -978,6 +987,10 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil !! diagnostic pointers type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields + type(Barotropic_CS), pointer :: Barotropic_CSp !< Pointer to the control structure for + !! the barotropic module + type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp !< Pointer to the control structure + !! used for the isopycnal height diffusive transport. type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields type(ALE_CS), pointer :: ALE_CSp !< points to ALE control structure @@ -1126,6 +1139,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) & call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & + Barotropic_CSp, thickness_diffuse_CSp, & G, GV, CS%hor_visc_CSp, OBC=CS%OBC) if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 47d3510c5a..cef44f65bc 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -50,7 +50,6 @@ module MOM_dynamics_unsplit !* * !********+*********+*********+*********+*********+*********+*********+** - use MOM_variables, only : vertvisc_type, thermo_var_ptrs use MOM_variables, only : accel_diag_ptrs, ocean_internal_state, cont_diag_ptrs use MOM_forcing_type, only : mech_forcing @@ -76,6 +75,7 @@ module MOM_dynamics_unsplit use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_ALE, only : ALE_CS +use MOM_barotropic, only : barotropic_CS use MOM_boundary_update, only : update_OBC_data, update_OBC_CS use MOM_continuity, only : continuity, continuity_init, continuity_CS use MOM_CoriolisAdv, only : CorAdCalc, CoriolisAdv_init, CoriolisAdv_CS @@ -91,6 +91,7 @@ module MOM_dynamics_unsplit use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_ML, set_visc_CS +use MOM_thickness_diffuse, only : thickness_diffuse_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_vert_friction, only : vertvisc, vertvisc_coef use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS @@ -181,7 +182,7 @@ module MOM_dynamics_unsplit !! 3rd order (for the inviscid momentum equations) order scheme subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, CS, & - VarMix, MEKE, Waves) + VarMix, MEKE, Barotropic, thickness_diffuse, Waves) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1. @@ -216,6 +217,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! that specify the spatially variable viscosities. type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing !! fields related to the Mesoscale Eddy Kinetic Energy. + type(barotropic_CS), pointer :: Barotropic!< Pointer to a structure containing + !! barotropic velocities + type(thickness_diffuse_CS), pointer :: thickness_diffuse!< Pointer to a structure containing + !! interface height diffusivities type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions @@ -254,7 +259,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, & - G, GV, CS%hor_visc_CSp) + Barotropic, thickness_diffuse, G, GV, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index a1615ad413..4c1522480a 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -75,6 +75,7 @@ module MOM_dynamics_unsplit_RK2 use MOM_ALE, only : ALE_CS use MOM_boundary_update, only : update_OBC_data, update_OBC_CS +use MOM_barotropic, only : barotropic_CS use MOM_continuity, only : continuity, continuity_init, continuity_CS use MOM_CoriolisAdv, only : CorAdCalc, CoriolisAdv_init, CoriolisAdv_CS use MOM_debugging, only : check_redundant @@ -88,6 +89,7 @@ module MOM_dynamics_unsplit_RK2 use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_ML, set_visc_CS +use MOM_thickness_diffuse, only : thickness_diffuse_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_vert_friction, only : vertvisc, vertvisc_coef use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS @@ -183,7 +185,7 @@ module MOM_dynamics_unsplit_RK2 !> Step the MOM6 dynamics using an unsplit quasi-2nd order Runge-Kutta scheme subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, CS, & - VarMix, MEKE) + VarMix, MEKE, Barotropic, thickness_diffuse) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. @@ -230,7 +232,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing !! fields related to the Mesoscale !! Eddy Kinetic Energy. - + type(barotropic_CS), pointer :: Barotropic!< Pointer to a structure containing + !! barotropic velocities + type(thickness_diffuse_CS), pointer :: thickness_diffuse!< Pointer to a structure containing + !! interface height diffusivities ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up @@ -266,7 +271,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_in, v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & - G, GV, CS%hor_visc_CSp) + Barotropic, thickness_diffuse, G, GV, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) call pass_vector(CS%diffu, CS%diffv, G%Domain, clock=id_clock_pass) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index d65634b1f7..4ad7ef4a7a 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -20,7 +20,7 @@ module MOM_thickness_diffuse implicit none ; private public thickness_diffuse, thickness_diffuse_init, thickness_diffuse_end -public vert_fill_TS +public vert_fill_TS, thickness_diffuse_get_KH #include @@ -52,12 +52,18 @@ module MOM_thickness_diffuse !! longer than DT, or 0 (the default) to use DT. integer :: nkml !< number of layers within mixed layer logical :: debug !< write verbose checksums for debugging purposes -! logical :: QG_Leith_GM !< If true, uses the QG Leith viscosity as the GM coefficient + logical :: use_GME_thickness_diffuse !< If true, passes GM coefficients to MOM_hor_visc for use + !! with GME closure. type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity (W m-2) real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope (nondim) real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope (nondim) + real, dimension(:,:,:), pointer :: & + KH_u_GME => NULL(), & !< interface height diffusivities in u-columns (m2 s-1) + KH_v_GME => NULL(), & !< interface height diffusivities in v-columns (m2 s-1) + KH_t_GME => NULL() !< interface height diffusivities in t-columns (m2 s-1) + !>@{ !! Diagnostic identifier integer :: id_uhGM = -1, id_vhGM = -1, id_GMwork = -1 @@ -238,6 +244,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS endif endif +!$OMP do + if (CS%use_GME_thickness_diffuse) then + do k=1,nz ; do j=js,je ; do I=is-1,ie + CS%KH_u_GME(I,j,k) = KH_u(I,j,k) + enddo ; enddo ; enddo + endif + !$OMP do do J=js-1,je ; do i=is,ie Khth_Loc(i,j) = CS%Khth @@ -305,6 +318,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS endif endif +!$OMP do + if (CS%use_GME_thickness_diffuse) then + do k=1,nz ; do j=js-1,je ; do I=is,ie + CS%KH_v_GME(I,j,k) = KH_v(I,j,k) + enddo ; enddo ; enddo + endif + !$OMP do do K=1,nz+1 ; do j=js,je ; do I=is-1,ie ; int_slope_u(I,j,K) = 0.0 ; enddo ; enddo ; enddo !$OMP do @@ -385,6 +405,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS / (hu(I-1,j)+hu(I,j)+hv(i,J-1)+hv(i,J)+h_neglect) enddo ; enddo enddo + + if (CS%use_GME_thickness_diffuse) then + do k=1,nz; do j=js,je ; do i=is,ie + CS%KH_t_GME(i,j,k) = KH_t(i,j,k) + enddo ; enddo ; enddo + endif + if (CS%id_KH_t > 0) call post_data(CS%id_KH_t, KH_t, CS%diag) if (CS%id_KH_t1 > 0) call post_data(CS%id_KH_t1, KH_t(:,:,1), CS%diag) endif @@ -1805,6 +1832,15 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) + call get_param(param_file, mdl, "USE_GME", CS%use_GME_thickness_diffuse, & + "If true, use the GM+E backscatter scheme in association \n"//& + "with the Gent and McWilliams parameterization.", default=.false.) + + if (CS%use_GME_thickness_diffuse) then + allocate(CS%KH_u_GME(G%IsdB:G%IedB,G%jsd:G%jed,G%ke+1)) ; CS%KH_u_GME(:,:,:) = 0.0 + allocate(CS%KH_v_GME(G%isd:G%ied,G%JsdB:G%JedB,G%ke+1)) ; CS%KH_v_GME(:,:,:) = 0.0 + allocate(CS%KH_t_GME(G%isd:G%ied,G%jsd:G%jed,G%ke+1)) ; CS%KH_t_GME(:,:,:) = 0.0 + endif if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0 else ; flux_to_kg_per_s = 1. ; endif @@ -1860,6 +1896,34 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) end subroutine thickness_diffuse_init +!> Copies ubtav and vbtav from private type into arrays +subroutine thickness_diffuse_get_KH(CS, KH_t_GME, KH_u_GME, KH_v_GME, G) + type(thickness_diffuse_CS), pointer :: CS !< Control structure for + !! this module + type(ocean_grid_type), intent(in) :: G !< Grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_t_GME!< interface height + !! diffusivities in t-columns (m2 s-1) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_u_GME!< interface height + !! diffusivities in u-columns (m2 s-1) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: KH_v_GME!< interface height + !! diffusivities in v-columns (m2 s-1) + ! Local variables + integer :: i,j,k + + do k=1,G%ke ; do j = G%jsc, G%jec ; do i = G%isc, G%iec + KH_t_GME(i,j,k) = CS%KH_t_GME(i,j,k) + enddo ; enddo ; enddo + + do k=1,G%ke ; do j = G%jsc, G%jec ; do I = G%isc-1, G%iec + KH_u_GME(I,j,k) = CS%KH_u_GME(I,j,k) + enddo ; enddo ; enddo + + do k=1,G%ke ; do J = G%jsc-1, G%jec ; do i = G%isc, G%iec + KH_v_GME(i,J,k) = CS%KH_v_GME(i,J,k) + enddo ; enddo ; enddo + +end subroutine thickness_diffuse_get_KH + !> Deallocate the thickness diffusion control structure subroutine thickness_diffuse_end(CS) type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion From a38fc07779faa5c966d9b8ff5367a06507d76288 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 17 Jan 2019 14:51:59 -0700 Subject: [PATCH 029/106] Add flags for GME and define necessary arrays --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 29 ++++++++++++++----- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index f8b66ecc51..2c546d6534 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -54,6 +54,8 @@ 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_GME_VarMix !< If true, calculates slopes and Brunt-Vaisala frequency for use with + !! the GME closure. real, dimension(:,:), pointer :: & SN_u => NULL(), & !< S*N at u-points (s^-1) SN_v => NULL(), & !< S*N at v-points (s^-1) @@ -89,6 +91,8 @@ module MOM_lateral_mixing_coeffs real, dimension(:,:,:), pointer :: & slope_x => NULL(), & !< Zonal isopycnal slope (non-dimensional) slope_y => NULL(), & !< Meridional isopycnal slope (non-dimensional) + N2_u => NULL(), & !< Brunt-Vaisala frequency at u-points (s-2) + N2_v => NULL(), & !< Brunt-Vaisala frequency at v-points (s-2) ebt_struct => NULL() !< Vertical structure function to scale diffusivities with (non-dim) real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & @@ -403,19 +407,20 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & e ! The interface heights relative to mean sea level, in m. - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points - real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at u-points +! real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points +! real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at u-points if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& "Module must be initialized before it is used.") - if (CS%calculate_Eady_growth_rate .or. CS%use_stored_slopes) then + if (CS%calculate_Eady_growth_rate .or. CS%use_stored_slopes & + .or. CS%use_GME_VarMix) then call find_eta(h, tv, GV%g_Earth, G, GV, e, halo_size=2) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & - CS%slope_x, CS%slope_y, N2_u, N2_v, 1) + CS%slope_x, CS%slope_y, CS%N2_u, CS%N2_v, 1) if (CS%calculate_Eady_growth_rate) then - call calc_Visbeck_coeffs(h, e, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS) + call calc_Visbeck_coeffs(h, e, CS%slope_x, CS%slope_y, CS%N2_u, CS%N2_v, G, GV, CS) endif ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) else @@ -429,8 +434,8 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) if (CS%id_SN_v > 0) call post_data(CS%id_SN_v, CS%SN_v, CS%diag) if (CS%id_L2u > 0) call post_data(CS%id_L2u, CS%L2u, CS%diag) if (CS%id_L2v > 0) call post_data(CS%id_L2v, CS%L2v, CS%diag) - if (CS%id_N2_u > 0) call post_data(CS%id_N2_u, N2_u, CS%diag) - if (CS%id_N2_v > 0) call post_data(CS%id_N2_v, N2_v, CS%diag) + if (CS%id_N2_u > 0) call post_data(CS%id_N2_u, CS%N2_u, CS%diag) + if (CS%id_N2_v > 0) call post_data(CS%id_N2_v, CS%N2_v, CS%diag) endif end subroutine calc_slope_functions @@ -998,6 +1003,8 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) in_use = .true. allocate(CS%slope_x(IsdB:IedB,jsd:jed,G%ke+1)) ; CS%slope_x(:,:,:) = 0.0 allocate(CS%slope_y(isd:ied,JsdB:JedB,G%ke+1)) ; CS%slope_y(:,:,:) = 0.0 + allocate(CS%N2_u(IsdB:IedB,jsd:jed,G%ke+1)) ; CS%N2_u(:,:,:) = 0.0 + allocate(CS%N2_v(isd:ied,JsdB:JedB,G%ke+1)) ; CS%N2_v(:,:,:) = 0.0 call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate \n"//& "more sensible values of T & S into thin layers.", & @@ -1115,6 +1122,14 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) oneOrTwo = 1.0 endif + call get_param(param_file, mdl, "USE_GME", CS%use_GME_VarMix, & + "If true, use the GM+E backscatter scheme in association \n"//& + "with the Gent and McWilliams parameterization.", default=.false.) + + if (CS%use_GME_VarMix .and. .not. CS%use_stored_slopes) & + call MOM_error(FATAL,"ERROR: use_stored_slopes must be TRUE when "// & + "using GME.") + do J=js-1,Jeq ; do I=is-1,Ieq CS%f2_dx2_q(I,J) = (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * & max(G%CoriolisBu(I,J)**2, absurdly_small_freq2) From d5f5d3203137a0cde9efc87d8ae84122fa9ab996 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 18 Jan 2019 11:26:43 -0700 Subject: [PATCH 030/106] Adds GME and smoothing function --- .../lateral/MOM_hor_visc.F90 | 224 +++++++++++++++++- 1 file changed, 211 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 243d52abbc..f0f296a0a5 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -5,11 +5,13 @@ module MOM_hor_visc use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type -use MOM_domains, only : pass_var +use MOM_domains, only : pass_var, CORNER use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_lateral_mixing_coeffs, only : VarMix_CS, calc_QG_Leith_viscosity +use MOM_barotropic, only : barotropic_CS, barotropic_get_tav +use MOM_thickness_diffuse, only : thickness_diffuse_CS, thickness_diffuse_get_KH use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type, OBC_DIRECTION_E, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_NONE @@ -73,6 +75,7 @@ module MOM_hor_visc real :: Kh_aniso !< The anisotropic viscosity in m2 s-1. logical :: dynamic_aniso !< If true, the anisotropic viscosity is recomputed as a function !! of state. This is set depending on ANISOTROPIC_MODE. + logical :: use_GME !< If true, use GME backscatter scheme. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_xx !< The background Laplacian viscosity at h points, in units !! of m2 s-1. The actual viscosity may be the larger of this @@ -159,6 +162,7 @@ module MOM_hor_visc integer :: id_diffu = -1, id_diffv = -1 integer :: id_Ah_h = -1, id_Ah_q = -1 integer :: id_Kh_h = -1, id_Kh_q = -1 + integer :: id_GME_coeff_h = -1, id_GME_coeff_q = -1 integer :: id_vort_xy_q = -1, id_div_xx_h = -1 integer :: id_FrictWork = -1, id_FrictWorkIntz = -1 !!@} @@ -179,7 +183,9 @@ module MOM_hor_visc !! u[is-2:ie+2,js-2:je+2] !! v[is-2:ie+2,js-2:je+2] !! h[is-1:ie+1,js-1:je+1] -subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, OBC) + +subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, & + thickness_diffuse, G, GV, CS, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -199,24 +205,34 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, !! related to Mesoscale Eddy Kinetic Energy. type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that !! specify the spatially variable viscosities - type(hor_visc_CS), pointer :: CS !< Pontrol structure returned by a previous + type(barotropic_CS), pointer :: Barotropic !< Pointer to a structure containing + !! barotropic velocities + type(thickness_diffuse_CS), pointer :: thickness_diffuse !< Pointer to a structure containing + !! interface height diffusivities + type(hor_visc_CS), pointer :: CS !< Control structure returned by a previous !! call to hor_visc_init. type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type + ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & u0, & ! Laplacian of u (m-1 s-1) h_u, & ! Thickness interpolated to u points, in H. vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) - div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) + div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) + ubtav ! zonal barotropic vel. ave. over baroclinic time-step (m s-1) real, dimension(SZI_(G),SZJB_(G)) :: & v0, & ! Laplacian of v (m-1 s-1) h_v, & ! Thickness interpolated to v points, in H. vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) - div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) + div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) + vbtav ! meridional barotropic vel. ave. over baroclinic time-step (m s-1) real, dimension(SZI_(G),SZJ_(G)) :: & + dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension (s-1) div_xx, & ! Estimate of horizontal divergence at h-points (s-1) sh_xx, & ! horizontal tension (du/dx - dv/dy) (1/sec) including metric terms + sh_xx_bt, & ! barotropic horizontal tension (du/dx - dv/dy) (1/sec) including metric terms str_xx,& ! str_xx is the diagonal term in the stress tensor (H m2 s-2) + str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME (H m2 s-2) bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution (H m2 s-2) FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction (W/m2) Leith_Kh_h, & ! Leith Laplacian viscosity at h-points (m2 s-1) @@ -227,8 +243,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) + dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain (s-1) sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) (1/sec) including metric terms + sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) (1/sec) inc. metric terms str_xy, & ! str_xy is the cross term in the stress tensor (H m2 s-2) + str_xy_GME, & ! smoothed cross term in the stress tensor from GME (H m2 s-2) bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution (H m2 s-2) vort_xy, & ! Vertical vorticity (dv/dx - du/dy) (s-1) Leith_Kh_q, & ! Leith Laplacian viscosity at q-points (m2 s-1) @@ -238,15 +257,22 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, grad_div_mag_q ! Magnitude of divergence gradient at q-points (m-1 s-1) real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & - Ah_q, & ! biharmonic viscosity at corner points (m4/s) - Kh_q, & ! Laplacian viscosity at corner points (m2/s) - vort_xy_q ! vertical vorticity at corner points (s-1) - + Ah_q, & ! biharmonic viscosity at corner points (m4/s) + Kh_q, & ! Laplacian viscosity at corner points (m2/s) + vort_xy_q, & ! vertical vorticity at corner points (s-1) + GME_coeff_q !< GME coeff. at q-points (m2 s-1) + + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & + KH_u_GME !< interface height diffusivities in u-columns (m2 s-1) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & + KH_v_GME !< interface height diffusivities in v-columns (m2 s-1) real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points (m4/s) Kh_h, & ! Laplacian viscosity at thickness points (m2/s) FrictWork, & ! energy dissipated by lateral friction (W/m2) - div_xx_h ! horizontal divergence (s-1) + div_xx_h, & ! horizontal divergence (s-1) + KH_t_GME, & !< interface height diffusivities in t-columns (m2 s-1) + GME_coeff_h !< GME coeff. at h-points (m2 s-1) real :: Ah ! biharmonic viscosity (m4/s) real :: Kh ! Laplacian viscosity (m2/s) @@ -278,6 +304,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real :: FatH ! abs(f) at h-point for MEKE source term (s-1) real :: local_strain ! Local variable for interpolating computed strain rates (s-1). real :: epsilon + real :: GME_coeff ! The GME (negative) viscosity coefficient (m2 s-1) real :: DY_dxBu, DX_dyBu logical :: rescale_Kh, legacy_bound logical :: find_FrictWork @@ -330,12 +357,46 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & !$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, & !$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & -!$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & +!$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & +!$OMP sh_xx_bt, sh_xy_bt, dvdx_bt, dudy_bt, & !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & !$OMP div_xx, div_xx_dx, div_xx_dy, & !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) + + + if (CS%use_GME) then + call barotropic_get_tav(Barotropic, ubtav, vbtav, G) + + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + dudx_bt(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * ubtav(I,j) - & + G%IdyCu(I-1,j) * ubtav(I-1,j)) + dvdy_bt(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * vbtav(i,J) - & + G%IdxCv(i,J-1) * vbtav(i,J-1)) + sh_xx_bt(i,j) = dudx_bt(i,j) - dvdy_bt(i,j) + enddo ; enddo + + ! Components for the barotropic shearing strain + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + dvdx_bt(I,J) = CS%DY_dxBu(I,J)*(vbtav(i+1,J)*G%IdyCv(i+1,J) & + - vbtav(i,J)*G%IdyCv(i,J)) + dudy_bt(I,J) = CS%DX_dyBu(I,J)*(ubtav(I,j+1)*G%IdxCu(I,j+1) & + - ubtav(I,j)*G%IdxCu(I,j)) + enddo ; enddo + + if (CS%no_slip) then + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + sh_xy_bt(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx_bt(I,J) + dudy_bt(I,J) ) + enddo ; enddo + else + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + sh_xy_bt(I,J) = G%mask2dBu(I,J) * ( dvdx_bt(I,J) + dudy_bt(I,J) ) + enddo ; enddo + endif + + endif ! use_GME + do k=1,nz ! The following are the forms of the horizontal tension and horizontal @@ -636,8 +697,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif ! CS%Leith_Kh - - do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & @@ -691,6 +750,23 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, str_xx(i,j) = 0.0 endif ! Laplacian + if (CS%use_GME) then + call thickness_diffuse_get_KH(thickness_diffuse, KH_t_GME, KH_u_GME, KH_v_GME, G) + GME_coeff = KH_t_GME(i,j,k) * & + 0.5*(VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)) * & + ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & + (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) / & + ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & + (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & + (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & + epsilon) + + str_xx_GME(i,j) = GME_coeff * sh_xx_bt(i,j) + + endif + + if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = GME_coeff + if (CS%anisotropic) then ! Shearing-strain averaged to h-points local_strain = 0.25 * ( (sh_xy(I,J) + sh_xy(I-1,J-1)) + (sh_xy(I-1,J) + sh_xy(I,J-1)) ) @@ -740,6 +816,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, str_xx(i,j) = str_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) enddo ; enddo + ! applying GME diagonal term + if (CS%use_GME) then + call smooth_GME(CS,G,GME_flux_h=str_xx_GME) + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + str_xx(i,j) = str_xx(i,j) + str_xx_GME(i,j) + enddo ; enddo + endif + if (CS%biharmonic) then ! Gradient of Laplacian, for use in bi-harmonic term do J=js-1,Jeq ; do I=is-1,Ieq @@ -854,6 +938,23 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, str_xy(I,J) = 0.0 endif ! Laplacian + if (CS%use_GME) then + GME_coeff = ( 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & + KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & + 0.25*(VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & + VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)) * & + ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I,j+1,k)) )**2 + & + (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i+1,J,k)) )**2 ) / & + ( dvdx_bt(i,j)**2 + dudy(i,j)**2 + & + (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & + (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & + epsilon)) + + str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) + endif + + if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff + if (CS%anisotropic) then ! Horizontal-tension averaged to q-points local_strain = 0.25 * ( (sh_xx(i,j) + sh_xx(i+1,j+1)) + (sh_xx(i+1,j) + sh_xx(i,j+1)) ) @@ -902,6 +1003,18 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif enddo ; enddo + ! applying GME diagonal term + if (CS%use_GME) then + call smooth_GME(CS,G,GME_flux_q=str_xy_GME) + do J=js-1,Jeq ; do I=is-1,Ieq + if (CS%no_slip) then + str_xy(I,J) = (str_xy(I,J) + str_xy_GME(I,J)) * (hq * CS%reduction_xy(I,J)) + else + str_xy(I,J) = (str_xy(I,J) + str_xy_GME(I,J)) * (hq * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) + endif + enddo ; enddo + endif + ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & @@ -1021,6 +1134,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if (CS%id_Ah_q>0) call post_data(CS%id_Ah_q, Ah_q, CS%diag) if (CS%id_Kh_h>0) call post_data(CS%id_Kh_h, Kh_h, CS%diag) if (CS%id_Kh_q>0) call post_data(CS%id_Kh_q, Kh_q, CS%diag) + if (CS%id_GME_coeff_h > 0) call post_data(CS%id_GME_coeff_h, GME_coeff_h, CS%diag) + if (CS%id_GME_coeff_q > 0) call post_data(CS%id_GME_coeff_q, GME_coeff_q, CS%diag) if (CS%id_FrictWorkIntz > 0) then do j=js,je @@ -1309,6 +1424,9 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) "viscosities. The final viscosity is the maximum of the other "//& "terms and this background value.", default=.false.) + call get_param(param_file, mdl, "USE_GME", CS%use_GME, & + "If true, use the GM+E backscatter scheme in association \n"//& + "with the Gent and McWilliams parameterization.", default=.false.) if (CS%bound_Kh .or. CS%bound_Ah .or. CS%better_bound_Kh .or. CS%better_bound_Ah) & call get_param(param_file, mdl, "DT", dt, & @@ -1696,6 +1814,14 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) endif + if (CS%use_GME) then + CS%id_GME_coeff_h = register_diag_field('ocean_model', 'GME_coeff_h', diag%axesTL, Time, & + 'GME coefficient at h Points', 'm^2 s-1') + + CS%id_GME_coeff_q = register_diag_field('ocean_model', 'GME_coeff_q', diag%axesBL, Time, & + 'GME coefficient at q Points', 'm^2 s-1') + endif + CS%id_FrictWork = register_diag_field('ocean_model','FrictWork',diag%axesTL,Time,& 'Integral work done by lateral friction terms', 'W m-2') @@ -1730,6 +1856,78 @@ subroutine align_aniso_tensor_to_grid(CS, n1, n2) end subroutine align_aniso_tensor_to_grid +!> Apply a 1-1-4-1-1 Laplacian filter one time on GME diffusive flux to reduce any +!! horizontal two-grid-point noise +subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) + ! Arguments + type(hor_visc_CS), pointer :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: GME_flux_h!< + real, dimension(SZIB_(G),SZJB_(G)), optional, intent(inout) :: GME_flux_q!< + + ! local variables + real, dimension(SZI_(G),SZJ_(G)) :: GME_flux_h_original + real, dimension(SZIB_(G),SZJB_(G)) :: GME_flux_q_original + real :: wc, ww, we, wn, ws ! averaging weights for smoothing + integer :: i, j, k, s + + !do s=1,CS%n_smooth + do s=1,1 + + ! Update halos + if (present(GME_flux_h)) then + call pass_var(GME_flux_h, G%Domain) + GME_flux_h_original = GME_flux_h + ! apply smoothing on GME + do j = G%jsc, G%jec + do i = G%isc, G%iec + ! skip land points + if (G%mask2dT(i,j)==0.) cycle + + ! compute weights + ww = 0.125 * G%mask2dT(i-1,j) + we = 0.125 * G%mask2dT(i+1,j) + ws = 0.125 * G%mask2dT(i,j-1) + wn = 0.125 * G%mask2dT(i,j+1) + wc = 1.0 - (ww+we+wn+ws) + + GME_flux_h(i,j) = wc * GME_flux_h_original(i,j) & + + ww * GME_flux_h_original(i-1,j) & + + we * GME_flux_h_original(i+1,j) & + + ws * GME_flux_h_original(i,j-1) & + + wn * GME_flux_h_original(i,j+1) + enddo; enddo + endif + + ! Update halos + if (present(GME_flux_q)) then + call pass_var(GME_flux_q, G%Domain, position=CORNER, complete=.true.) + GME_flux_q_original = GME_flux_q + ! apply smoothing on GME + do J = G%JscB, G%JecB + do I = G%IscB, G%IecB + ! skip land points + if (G%mask2dBu(I,J)==0.) cycle + + ! compute weights + ww = 0.125 * G%mask2dBu(I-1,J) + we = 0.125 * G%mask2dBu(I+1,J) + ws = 0.125 * G%mask2dBu(I,J-1) + wn = 0.125 * G%mask2dBu(I,J+1) + wc = 1.0 - (ww+we+wn+ws) + + GME_flux_q(I,J) = wc * GME_flux_q_original(I,J) & + + ww * GME_flux_q_original(I-1,J) & + + we * GME_flux_q_original(I+1,J) & + + ws * GME_flux_q_original(I,J-1) & + + wn * GME_flux_q_original(I,J+1) + enddo; enddo + endif + + enddo ! s-loop + +end subroutine smooth_GME + !> Deallocates any variables allocated in hor_visc_init. subroutine hor_visc_end(CS) type(hor_visc_CS), pointer :: CS !< The control structure returned by a From d3aaa9dc501edccdb338d79577294d088ec0ae05 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 22 Jan 2019 15:37:59 -0700 Subject: [PATCH 031/106] Fix calls to find_eta and calc_Visbeck_coeffs --- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index fe532b688e..8e6a6ee7e8 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -415,12 +415,12 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) if (CS%calculate_Eady_growth_rate .or. CS%use_stored_slopes & .or. CS%use_GME_VarMix) then - call find_eta(h, tv, GV%g_Earth, G, GV, e, halo_size=2) + call find_eta(h, tv, G, GV, e, halo_size=2) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, CS%N2_u, CS%N2_v, 1) if (CS%calculate_Eady_growth_rate) then - call calc_Visbeck_coeffs(h, e, CS%slope_x, CS%slope_y, CS%N2_u, CS%N2_v, G, GV, CS) + call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, CS%N2_u, CS%N2_v, G, GV, CS) endif ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) else From e8a7386552af25f80c1d5a777d3faae26cf401d6 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 24 Jan 2019 14:34:30 -0700 Subject: [PATCH 032/106] Move thickness_diffuse_init before initialize_dyn_split_RK2 Also adds thickness_diffuse_CSp as argument in initialize_dyn_split_RK2 --- src/core/MOM.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 32558c3ca5..8a1b168661 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -964,7 +964,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call step_MOM_dyn_split_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & CS%eta_av_bc, G, GV, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, & - CS%MEKE, CS%Barotropic_CSp, CS%thickness_diffuse_CSp) + CS%MEKE, CS%thickness_diffuse_CSp) if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_split (step_MOM)") elseif (CS%do_dynamics) then ! ------------------------------------ not SPLIT @@ -2304,12 +2304,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call VarMix_init(Time, G, GV, param_file, diag, CS%VarMix) call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) + call thickness_diffuse_init(Time, G, GV, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & G, GV, param_file, diag, CS%dyn_split_RK2_CSp, restart_CSp, & CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE, & - CS%Barotropic_CSp, CS%thickness_diffuse_CSp, & + CS%thickness_diffuse_CSp, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & CS%visc, dirs, CS%ntrunc, calc_dtbt=calc_dtbt) if (CS%dtbt_reset_period > 0.0) then @@ -2337,7 +2338,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif call callTree_waypoint("dynamics initialized (initialize_MOM)") - call thickness_diffuse_init(Time, G, GV, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, param_file, diag, & CS%mixedlayer_restrat_CSp, restart_CSp) if (CS%mixedlayer_restrat) then From bef613bc580793016c1f98725fa7e87599c7dc1d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 24 Jan 2019 14:36:45 -0700 Subject: [PATCH 033/106] Add thickness_diffuse_CSp and Barotropic_CSp as arguments --- src/core/MOM_dynamics_split_RK2.F90 | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index c59747136e..aebe22316f 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -183,6 +183,8 @@ module MOM_dynamics_split_RK2 type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() !> A pointer to the barotropic stepping control structure type(barotropic_CS), pointer :: barotropic_CSp => NULL() + !> A pointer to a structure containing interface height diffusivities + type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL() !> A pointer to the vertical viscosity control structure type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure @@ -229,8 +231,7 @@ module MOM_dynamics_split_RK2 subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & Time_local, dt, forces, p_surf_begin, p_surf_end, & uh, vh, uhtr, vhtr, eta_av, & - G, GV, CS, calc_dtbt, VarMix, MEKE, Barotropic_CSp, & - thickness_diffuse_CSp) + G, GV, CS, calc_dtbt, VarMix, MEKE, thickness_diffuse_CSp) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -264,10 +265,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param - type(barotropic_CS), pointer :: Barotropic_CSp!< Pointer to a structure containing - !! barotropic velocities +! type(barotropic_CS), pointer :: Barotropic_CSp!< Pointer to a structure containing +! !! barotropic velocities type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp!< Pointer to a structure containing - !! interface height diffusivities + !! interface height diffusivities ! local variables real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. @@ -686,7 +687,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! diffu = horizontal viscosity terms (u_av) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_av, v_av, h_av, CS%diffu, CS%diffv, & - MEKE, Varmix, Barotropic_CSp, thickness_diffuse_CSp, & + MEKE, Varmix, CS%barotropic_CSp, thickness_diffuse_CSp, & G, GV, CS%hor_visc_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_horvisc) if (showCallTree) call callTree_wayPoint("done with horizontal_viscosity (step_MOM_dyn_split_RK2)") @@ -959,7 +960,7 @@ end subroutine register_restarts_dyn_split_RK2 !! dynamic core, including diagnostics and the cpu clocks. subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_file, & diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & - VarMix, MEKE, Barotropic_CSp, thickness_diffuse_CSp, & + VarMix, MEKE, thickness_diffuse_CSp, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, calc_dtbt) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure @@ -987,8 +988,8 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil !! diagnostic pointers type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields - type(Barotropic_CS), pointer :: Barotropic_CSp !< Pointer to the control structure for - !! the barotropic module +! type(Barotropic_CS), pointer :: Barotropic_CSp !< Pointer to the control structure for +! !! the barotropic module type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp !< Pointer to the control structure !! used for the isopycnal height diffusive transport. type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields @@ -1002,6 +1003,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil !! truncated (this should be 0). logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step + ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. character(len=48) :: thickness_units, flux_units, eta_rest_name @@ -1143,10 +1145,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil CS%barotropic_CSp, restart_CS, calc_dtbt, CS%BT_cont, & CS%tides_CSp) +! CS%barotropic_CSp => Barotropic_CSp +! CS%thickness_diffuse_CSp => thickness_diffuse_CSp + if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) & call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & - Barotropic_CSp, thickness_diffuse_CSp, & + CS%barotropic_CSp, thickness_diffuse_CSp, & G, GV, CS%hor_visc_CSp, OBC=CS%OBC) if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then From 462dfd8b3513882037b276b5d791e44bceaef1ff Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 24 Jan 2019 14:37:37 -0700 Subject: [PATCH 034/106] Change condition for applying Ah_Limit + axes for GME diag. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 1200e99398..05e2239c85 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -262,18 +262,18 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, vort_xy_q, & ! vertical vorticity at corner points (s-1) GME_coeff_q !< GME coeff. at q-points (m2 s-1) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1) :: & KH_u_GME !< interface height diffusivities in u-columns (m2 s-1) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1) :: & KH_v_GME !< interface height diffusivities in v-columns (m2 s-1) real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points (m4/s) Kh_h, & ! Laplacian viscosity at thickness points (m2/s) FrictWork, & ! energy dissipated by lateral friction (W/m2) - div_xx_h, & ! horizontal divergence (s-1) + div_xx_h ! horizontal divergence (s-1) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & KH_t_GME, & !< interface height diffusivities in t-columns (m2 s-1) GME_coeff_h !< GME coeff. at h-points (m2 s-1) - real :: Ah ! biharmonic viscosity (m4/s) real :: Kh ! Laplacian viscosity (m2/s) real :: AhSm ! Smagorinsky biharmonic viscosity (m4/s) @@ -367,6 +367,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%use_GME) then + call barotropic_get_tav(Barotropic, ubtav, vbtav, G) do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 @@ -752,7 +753,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%use_GME) then call thickness_diffuse_get_KH(thickness_diffuse, KH_t_GME, KH_u_GME, KH_v_GME, G) - GME_coeff = KH_t_GME(i,j,k) * & + GME_coeff = 0.001 * KH_t_GME(i,j,k) * & 0.5*(VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)) * & ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) / & @@ -939,7 +940,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif ! Laplacian if (CS%use_GME) then - GME_coeff = ( 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & + GME_coeff = 0.001 * ( 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & 0.25*(VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)) * & @@ -1644,7 +1645,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) CS%Ah_bg_xy(:,:) = 0.0 ! The 0.3 below was 0.4 in MOM1.10. The change in hq requires ! this to be less than 1/3, rather than 1/2 as before. - Ah_Limit = 0.3 / (dt*64.0) + if (CS%better_bound_Ah .or. CS%bound_Ah) Ah_Limit = 0.3 / (dt*64.0) if (CS%Smagorinsky_Ah .and. CS%bound_Coriolis) & BoundCorConst = 1.0 / (5.0*(bound_Cor_vel*bound_Cor_vel)) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -1815,7 +1816,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) endif if (CS%use_GME) then - CS%id_GME_coeff_h = register_diag_field('ocean_model', 'GME_coeff_h', diag%axesTL, Time, & + CS%id_GME_coeff_h = register_diag_field('ocean_model', 'GME_coeff_h', diag%axesTi, Time, & 'GME coefficient at h Points', 'm^2 s-1') CS%id_GME_coeff_q = register_diag_field('ocean_model', 'GME_coeff_q', diag%axesBL, Time, & From 581b30d053fb1e00cc0e4ec505430a0006a1c520 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 24 Jan 2019 14:39:16 -0700 Subject: [PATCH 035/106] Move inv_PI3 outside of k loop --- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 8e6a6ee7e8..7960b31bb6 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -777,9 +777,10 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + inv_PI3 = 1.0/((4.0*atan(1.0))**3) + if (k > 1) then - inv_PI3 = 1.0/((4.0*atan(1.0))**3) ! Add in stretching term for the QG Leith vsicosity ! if (CS%use_QG_Leith) then ! do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 From de3a52ceb1010002859a8b75e62c73121c123162 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 29 Jan 2019 14:57:14 -0700 Subject: [PATCH 036/106] Deleted KH_t_GME and allocate arrays via safe_alloc_ptr --- .../lateral/MOM_thickness_diffuse.F90 | 24 ++++--------------- 1 file changed, 5 insertions(+), 19 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index f3df33e53d..eca86acf52 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -7,7 +7,7 @@ module MOM_thickness_diffuse use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, time_type use MOM_diag_mediator, only : diag_update_remap_grids -use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_EOS, only : calculate_density, calculate_density_derivs use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type @@ -61,8 +61,7 @@ module MOM_thickness_diffuse real, dimension(:,:,:), pointer :: & KH_u_GME => NULL(), & !< interface height diffusivities in u-columns (m2 s-1) - KH_v_GME => NULL(), & !< interface height diffusivities in v-columns (m2 s-1) - KH_t_GME => NULL() !< interface height diffusivities in t-columns (m2 s-1) + KH_v_GME => NULL() !< interface height diffusivities in v-columns (m2 s-1) !>@{ !! Diagnostic identifier @@ -404,12 +403,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS enddo ; enddo enddo - if (CS%use_GME_thickness_diffuse) then - do k=1,nz; do j=js,je ; do i=is,ie - CS%KH_t_GME(i,j,k) = KH_t(i,j,k) - enddo ; enddo ; enddo - endif - if (CS%id_KH_t > 0) call post_data(CS%id_KH_t, KH_t, CS%diag) if (CS%id_KH_t1 > 0) call post_data(CS%id_KH_t1, KH_t(:,:,1), CS%diag) endif @@ -1834,9 +1827,8 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) "with the Gent and McWilliams parameterization.", default=.false.) if (CS%use_GME_thickness_diffuse) then - allocate(CS%KH_u_GME(G%IsdB:G%IedB,G%jsd:G%jed,G%ke+1)) ; CS%KH_u_GME(:,:,:) = 0.0 - allocate(CS%KH_v_GME(G%isd:G%ied,G%JsdB:G%JedB,G%ke+1)) ; CS%KH_v_GME(:,:,:) = 0.0 - allocate(CS%KH_t_GME(G%isd:G%ied,G%jsd:G%jed,G%ke+1)) ; CS%KH_t_GME(:,:,:) = 0.0 + call safe_alloc_ptr(CS%KH_u_GME,G%IsdB,G%IedB,G%jsd,G%jed,G%ke+1) + call safe_alloc_ptr(CS%KH_v_GME,G%isd,G%ied,G%JsdB,G%JedB,G%ke+1) endif if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0 @@ -1896,12 +1888,10 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) end subroutine thickness_diffuse_init !> Copies ubtav and vbtav from private type into arrays -subroutine thickness_diffuse_get_KH(CS, KH_t_GME, KH_u_GME, KH_v_GME, G) +subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G) type(thickness_diffuse_CS), pointer :: CS !< Control structure for !! this module type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_t_GME!< interface height - !! diffusivities in t-columns (m2 s-1) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_u_GME!< interface height !! diffusivities in u-columns (m2 s-1) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: KH_v_GME!< interface height @@ -1909,10 +1899,6 @@ subroutine thickness_diffuse_get_KH(CS, KH_t_GME, KH_u_GME, KH_v_GME, G) ! Local variables integer :: i,j,k - do k=1,G%ke ; do j = G%jsc, G%jec ; do i = G%isc, G%iec - KH_t_GME(i,j,k) = CS%KH_t_GME(i,j,k) - enddo ; enddo ; enddo - do k=1,G%ke ; do j = G%jsc, G%jec ; do I = G%isc-1, G%iec KH_u_GME(I,j,k) = CS%KH_u_GME(I,j,k) enddo ; enddo ; enddo From cc7f725dbcb1296a55d23c41a90c1d9481742138 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 31 Jan 2019 07:55:44 -0700 Subject: [PATCH 037/106] apply oda tracer increments only if da is active --- src/core/MOM.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1a590bb5b8..cf9e4b677c 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1153,7 +1153,9 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & call enable_averaging(dtdia, Time_end_thermo, CS%diag) - call apply_oda_tracer_increments(dtdia,G,tv,h,CS%odaCS) + if (associated(CS%odaCS)) then + call apply_oda_tracer_increments(dtdia,G,tv,h,CS%odaCS) + endif if (update_BBL) then ! Calculate the BBL properties and store them inside visc (u,h). From 38ac453468125a0792fb79c5df4933c085c1a2fb Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 11 Feb 2019 11:07:57 -0700 Subject: [PATCH 038/106] Fixed several issues for GME These include: * halo updates * loop indices * moving no-slip outside do-loops --- .../lateral/MOM_hor_visc.F90 | 94 +++++++++++++------ 1 file changed, 65 insertions(+), 29 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 05e2239c85..3f0f9dfbb5 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -5,8 +5,8 @@ module MOM_hor_visc use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type -use MOM_domains, only : pass_var, CORNER -use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_domains, only : pass_var, CORNER, pass_vector +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_lateral_mixing_coeffs, only : VarMix_CS, calc_QG_Leith_viscosity @@ -303,6 +303,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real :: RoScl ! The scaling function for MEKE source term real :: FatH ! abs(f) at h-point for MEKE source term (s-1) real :: local_strain ! Local variable for interpolating computed strain rates (s-1). + real :: GME_is_on ! If use_GME = True, equals one. Otherwise, equals zero. real :: epsilon real :: GME_coeff ! The GME (negative) viscosity coefficient (m2 s-1) real :: DY_dxBu, DX_dyBu @@ -365,16 +366,42 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, !$OMP div_xx, div_xx_dx, div_xx_dy,local_strain, & !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) + GME_is_on = 0.0 if (CS%use_GME) then + GME_is_on = 1.0 + ! initialize diag. array with zeros + if (CS%id_GME_coeff_h>0) then + do k=1,G%ke+1 ; do j = G%jsc, G%jec ; do i = G%isc, G%iec + GME_coeff_h(i,j,k) = 0.0 + enddo; enddo; enddo + endif + do j=js,je ; do i=is,ie + str_xx_GME(i,j) = 0.0 + enddo; enddo + do j=jsq,jeq ; do i=isq,ieq + str_xy_GME(i,j) = 0.0 + enddo; enddo call barotropic_get_tav(Barotropic, ubtav, vbtav, G) - do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + call pass_vector(ubtav, vbtav, G%Domain) + + do j=js,je ; do i=is,ie dudx_bt(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * ubtav(I,j) - & G%IdyCu(I-1,j) * ubtav(I-1,j)) dvdy_bt(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * vbtav(i,J) - & G%IdxCv(i,J-1) * vbtav(i,J-1)) + enddo; enddo + + call pass_var(dudx_bt, G%Domain, complete=.true.) + call pass_var(dvdy_bt, G%Domain, complete=.true.) + + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 +! dudx_bt(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * ubtav(I,j) - & +! G%IdyCu(I-1,j) * ubtav(I-1,j)) +! dvdy_bt(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * vbtav(i,J) - & +! G%IdxCv(i,J-1) * vbtav(i,J-1)) sh_xx_bt(i,j) = dudx_bt(i,j) - dvdy_bt(i,j) enddo ; enddo @@ -386,6 +413,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, - ubtav(I,j)*G%IdxCu(I,j)) enddo ; enddo + call pass_var(dvdx_bt, G%Domain, position=CORNER, complete=.true.) + call pass_var(dudy_bt, G%Domain, position=CORNER, complete=.true.) + if (CS%no_slip) then do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 sh_xy_bt(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx_bt(I,J) + dudy_bt(I,J) ) @@ -396,6 +426,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo endif + call thickness_diffuse_get_KH(thickness_diffuse, KH_u_GME, KH_v_GME, G) + + ! halo updates + call pass_vector(KH_u_GME, KH_v_GME, G%Domain) + call pass_vector(VarMix%slope_x, VarMix%slope_y, G%Domain) + call pass_vector(VarMix%N2_u, VarMix%N2_v, G%Domain) + endif ! use_GME do k=1,nz @@ -752,21 +789,19 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif ! Laplacian if (CS%use_GME) then - call thickness_diffuse_get_KH(thickness_diffuse, KH_t_GME, KH_u_GME, KH_v_GME, G) - GME_coeff = 0.001 * KH_t_GME(i,j,k) * & + GME_coeff = 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & + KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & 0.5*(VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)) * & ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) / & ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & - epsilon) - - str_xx_GME(i,j) = GME_coeff * sh_xx_bt(i,j) - - endif + epsilon) if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = GME_coeff + str_xx_GME(i,j) = GME_coeff * sh_xx_bt(i,j) + endif ! CS%use_GME if (CS%anisotropic) then ! Shearing-strain averaged to h-points @@ -940,21 +975,21 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif ! Laplacian if (CS%use_GME) then - GME_coeff = 0.001 * ( 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & + GME_coeff = 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & 0.25*(VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)) * & ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I,j+1,k)) )**2 + & (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i+1,J,k)) )**2 ) / & - ( dvdx_bt(i,j)**2 + dudy(i,j)**2 + & + ( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & - (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & - epsilon)) + (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & + epsilon) + if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) - endif - if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff + endif if (CS%anisotropic) then ! Horizontal-tension averaged to q-points @@ -996,26 +1031,25 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (hq * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif ! biharmonic - - if (CS%no_slip) then - str_xy(I,J) = str_xy(I,J) * (hq * CS%reduction_xy(I,J)) - else - str_xy(I,J) = str_xy(I,J) * (hq * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) - endif enddo ; enddo ! applying GME diagonal term if (CS%use_GME) then call smooth_GME(CS,G,GME_flux_q=str_xy_GME) do J=js-1,Jeq ; do I=is-1,Ieq - if (CS%no_slip) then - str_xy(I,J) = (str_xy(I,J) + str_xy_GME(I,J)) * (hq * CS%reduction_xy(I,J)) - else - str_xy(I,J) = (str_xy(I,J) + str_xy_GME(I,J)) * (hq * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) - endif + str_xy(i,j) = str_xy(i,j) + str_xy_GME(i,j) enddo ; enddo endif + do J=js-1,Jeq ; do I=is-1,Ieq + ! GME is applied below + if (CS%no_slip) then + str_xy(I,J) = (str_xy(I,J) + GME_is_on * str_xy_GME(I,J)) * (hq * CS%reduction_xy(I,J)) + else + str_xy(I,J) = (str_xy(I,J) + GME_is_on * str_xy_GME(I,J)) * (hq * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) + endif + enddo ; enddo + ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & @@ -1863,8 +1897,10 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) ! Arguments type(hor_visc_CS), pointer :: CS !< Control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid - real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: GME_flux_h!< - real, dimension(SZIB_(G),SZJB_(G)), optional, intent(inout) :: GME_flux_q!< + real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: GME_flux_h!< GME diffusive flux + !! at h points + real, dimension(SZIB_(G),SZJB_(G)), optional, intent(inout) :: GME_flux_q!< GME diffusive flux + !! at q points ! local variables real, dimension(SZI_(G),SZJ_(G)) :: GME_flux_h_original From 4b354525338d23fc3397e31b53e29d28403eb9a8 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 12 Feb 2019 09:39:34 -0700 Subject: [PATCH 039/106] Modified initialization of GME variables --- .../lateral/MOM_hor_visc.F90 | 68 ++++++++++--------- 1 file changed, 35 insertions(+), 33 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 3f0f9dfbb5..0f0c8d19b6 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -271,7 +271,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, Kh_h, & ! Laplacian viscosity at thickness points (m2/s) FrictWork, & ! energy dissipated by lateral friction (W/m2) div_xx_h ! horizontal divergence (s-1) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & + !real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & KH_t_GME, & !< interface height diffusivities in t-columns (m2 s-1) GME_coeff_h !< GME coeff. at h-points (m2 s-1) real :: Ah ! biharmonic viscosity (m4/s) @@ -371,17 +372,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%use_GME) then GME_is_on = 1.0 ! initialize diag. array with zeros - if (CS%id_GME_coeff_h>0) then - do k=1,G%ke+1 ; do j = G%jsc, G%jec ; do i = G%isc, G%iec - GME_coeff_h(i,j,k) = 0.0 - enddo; enddo; enddo - endif - do j=js,je ; do i=is,ie - str_xx_GME(i,j) = 0.0 - enddo; enddo - do j=jsq,jeq ; do i=isq,ieq - str_xy_GME(i,j) = 0.0 - enddo; enddo + GME_coeff_h(:,:,:) = 0.0 + GME_coeff_q(:,:,:) = 0.0 + str_xx_GME(:,:) = 0.0 + str_xy_GME(:,:) = 0.0 call barotropic_get_tav(Barotropic, ubtav, vbtav, G) @@ -398,10 +392,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, call pass_var(dvdy_bt, G%Domain, complete=.true.) do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 -! dudx_bt(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * ubtav(I,j) - & -! G%IdyCu(I-1,j) * ubtav(I-1,j)) -! dvdy_bt(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * vbtav(i,J) - & -! G%IdxCv(i,J-1) * vbtav(i,J-1)) sh_xx_bt(i,j) = dudx_bt(i,j) - dvdy_bt(i,j) enddo ; enddo @@ -791,7 +781,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%use_GME) then GME_coeff = 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & - 0.5*(VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)) * & + 0.5*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)),0.0) * & ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) / & ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & @@ -799,8 +789,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & epsilon) - if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = GME_coeff - str_xx_GME(i,j) = GME_coeff * sh_xx_bt(i,j) + ! simple way to limit this coeff + GME_coeff = 0.0 !MIN(GME_coeff,0.0) + + !if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = GME_coeff + + str_xx_GME(i,j) = 0.0 !GME_coeff * sh_xx_bt(i,j) + if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = str_xx_GME(i,j) + endif ! CS%use_GME if (CS%anisotropic) then @@ -849,14 +845,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif ! biharmonic - str_xx(i,j) = str_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) enddo ; enddo ! applying GME diagonal term if (CS%use_GME) then - call smooth_GME(CS,G,GME_flux_h=str_xx_GME) + !call smooth_GME(CS,G,GME_flux_h=str_xx_GME) do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - str_xx(i,j) = str_xx(i,j) + str_xx_GME(i,j) + str_xx(i,j) = (str_xx(i,j) + str_xx_GME(i,j)) * (h(i,j,k) * CS%reduction_xx(i,j)) + enddo ; enddo + else + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + str_xx(i,j) = str_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) enddo ; enddo endif @@ -977,17 +976,20 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%use_GME) then GME_coeff = 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & - 0.25*(VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & - VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)) * & + 0.25*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & + VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)),0.0) * & ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I,j+1,k)) )**2 + & (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i+1,J,k)) )**2 ) / & ( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & epsilon) + ! simple way to limit this coeff + GME_coeff = 0.0 !MIN(GME_coeff,0.0) - if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff - str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) + !if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff + str_xy_GME(I,J) = 0.0 !GME_coeff * sh_xy_bt(I,J) + if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = str_xy_GME(I,J) endif @@ -1034,12 +1036,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo ! applying GME diagonal term - if (CS%use_GME) then - call smooth_GME(CS,G,GME_flux_q=str_xy_GME) - do J=js-1,Jeq ; do I=is-1,Ieq - str_xy(i,j) = str_xy(i,j) + str_xy_GME(i,j) - enddo ; enddo - endif + !if (CS%use_GME) then + !call smooth_GME(CS,G,GME_flux_q=str_xy_GME) + !do J=js-1,Jeq ; do I=is-1,Ieq + ! str_xy(i,j) = str_xy(i,j) + str_xy_GME(i,j) + !enddo ; enddo + !endif do J=js-1,Jeq ; do I=is-1,Ieq ! GME is applied below @@ -1850,7 +1852,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) endif if (CS%use_GME) then - CS%id_GME_coeff_h = register_diag_field('ocean_model', 'GME_coeff_h', diag%axesTi, Time, & + CS%id_GME_coeff_h = register_diag_field('ocean_model', 'GME_coeff_h', diag%axesTL, Time, & 'GME coefficient at h Points', 'm^2 s-1') CS%id_GME_coeff_q = register_diag_field('ocean_model', 'GME_coeff_q', diag%axesBL, Time, & From 5360863d8d8f1b453c91e927a1f1c7e9a62d63e9 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 12 Feb 2019 10:37:33 -0700 Subject: [PATCH 040/106] Changed hq to a 2D array --- .../lateral/MOM_hor_visc.F90 | 56 ++++++++++++------- 1 file changed, 36 insertions(+), 20 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0f0c8d19b6..733fd48161 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -254,7 +254,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, Leith_Ah_q, & ! Leith bi-harmonic viscosity at q-points (m4 s-1) beta_q, & ! Gradient of planetary vorticity at q-points (m-1 s-1) grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points (m-1 s-1) - grad_div_mag_q ! Magnitude of divergence gradient at q-points (m-1 s-1) + grad_div_mag_q, & ! Magnitude of divergence gradient at q-points (m-1 s-1) + hq ! harmonic mean of the harmonic means of the u- & v- + ! point thicknesses, in H; This form guarantees that hq/hu < 4. real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & Ah_q, & ! biharmonic viscosity at corner points (m4/s) @@ -290,8 +292,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner ! points; these are first interpolated to u or v velocity ! points where masks are applied, in units of H (i.e. m or kg m-2). - real :: hq ! harmonic mean of the harmonic means of the u- & v- - ! point thicknesses, in H; This form guarantees that hq/hu < 4. +! real :: hq ! harmonic mean of the harmonic means of the u- & v- +! ! point thicknesses, in H; This form guarantees that hq/hu < 4. real :: h_neglect ! thickness so small it can be lost in roundoff and so neglected (H) real :: h_neglect3 ! h_neglect^3, in H3 real :: hrat_min ! minimum thicknesses at the 4 neighboring @@ -357,7 +359,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & -!$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, & +!$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, hq, & !$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & @@ -365,7 +367,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & !$OMP div_xx, div_xx_dx, div_xx_dy,local_strain, & -!$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) +!$OMP Shear_mag, h2uq, h2vq, Kh_scale, hrat_min) GME_is_on = 0.0 @@ -907,12 +909,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, h2vq = 4.0 * h_v(i,J) * h_v(i+1,J) !hq = 2.0 * h2uq * h2vq / (h_neglect3 + (h2uq + h2vq) * & ! ((h(i,j,k) + h(i+1,j+1,k)) + (h(i,j+1,k) + h(i+1,j,k)))) - hq = 2.0 * h2uq * h2vq / (h_neglect3 + (h2uq + h2vq) * & - ((h_u(I,j) + h_u(I,j+1)) + (h_v(i,J) + h_v(i+1,J)))) + hq(I,J) = 2.0 * h2uq * h2vq / (h_neglect3 + (h2uq + h2vq) * & + ((h_u(I,j) + h_u(I,j+1)) + (h_v(i,J) + h_v(i+1,J)))) if (CS%better_bound_Ah .or. CS%better_bound_Kh) then hrat_min = min(1.0, min(h_u(I,j), h_u(I,j+1), h_v(i,J), h_v(i+1,J)) / & - (hq + h_neglect) ) + (hq(I,J) + h_neglect) ) visc_bound_rem = 1.0 endif @@ -926,12 +928,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if ((G%mask2dCu(I,j) + G%mask2dCu(I,j+1)) * & (G%mask2dCv(i,J) + G%mask2dCv(i+1,J)) == 0.0) then ! Only one of hu and hv is nonzero, so just add them. - hq = hu + hv + hq(I,J) = hu + hv hrat_min = 1.0 else ! Both hu and hv are nonzero, so take the harmonic mean. - hq = 2.0 * (hu * hv) / ((hu + hv) + h_neglect) - hrat_min = min(1.0, min(hu, hv) / (hq + h_neglect) ) + hq(I,J) = 2.0 * (hu * hv) / ((hu + hv) + h_neglect) + hrat_min = min(1.0, min(hu, hv) / (hq(I,J) + h_neglect) ) endif endif endif @@ -1030,9 +1032,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! Keep a copy of the biharmonic contribution for backscatter parameterization bhstr_xy(I,J) = Ah * ( dvdx(I,J) + dudy(I,J) ) * & - (hq * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) + (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif ! biharmonic + enddo ; enddo ! applying GME diagonal term @@ -1043,14 +1046,27 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, !enddo ; enddo !endif - do J=js-1,Jeq ; do I=is-1,Ieq - ! GME is applied below - if (CS%no_slip) then - str_xy(I,J) = (str_xy(I,J) + GME_is_on * str_xy_GME(I,J)) * (hq * CS%reduction_xy(I,J)) - else - str_xy(I,J) = (str_xy(I,J) + GME_is_on * str_xy_GME(I,J)) * (hq * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) - endif - enddo ; enddo + if (CS%use_GME) then + do J=js-1,Jeq ; do I=is-1,Ieq + ! GME is applied below + if (CS%no_slip) then + str_xy(I,J) = (str_xy(I,J) + str_xy_GME(I,J)) * (hq(I,J) * CS%reduction_xy(I,J)) + else + str_xy(I,J) = (str_xy(I,J) + str_xy_GME(I,J)) * (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) + endif + enddo ; enddo + else + do J=js-1,Jeq ; do I=is-1,Ieq + ! GME is applied below + if (CS%no_slip) then + str_xy(I,J) = str_xy(I,J) * (hq(I,J) * CS%reduction_xy(I,J)) + ! str_xy(I,J) = (str_xy(I,J) + GME_is_on * str_xy_GME(I,J)) * (hq(I,J) * CS%reduction_xy(I,J)) + else + str_xy(I,J) = str_xy(I,J) * (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) + ! str_xy(I,J) = (str_xy(I,J) + GME_is_on * str_xy_GME(I,J)) * (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) + endif + enddo ; enddo + endif ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq From b97a787dc24205658e1c4f6eab9b050f48e6375a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 14 Feb 2019 09:12:28 -0700 Subject: [PATCH 041/106] Fixed problem with updating hq -- hq is now a 2D array --- .../lateral/MOM_hor_visc.F90 | 36 +++++++------------ 1 file changed, 12 insertions(+), 24 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 733fd48161..9d4266ad17 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -306,7 +306,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real :: RoScl ! The scaling function for MEKE source term real :: FatH ! abs(f) at h-point for MEKE source term (s-1) real :: local_strain ! Local variable for interpolating computed strain rates (s-1). - real :: GME_is_on ! If use_GME = True, equals one. Otherwise, equals zero. real :: epsilon real :: GME_coeff ! The GME (negative) viscosity coefficient (m2 s-1) real :: DY_dxBu, DX_dyBu @@ -369,10 +368,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, !$OMP div_xx, div_xx_dx, div_xx_dy,local_strain, & !$OMP Shear_mag, h2uq, h2vq, Kh_scale, hrat_min) - GME_is_on = 0.0 - if (CS%use_GME) then - GME_is_on = 1.0 ! initialize diag. array with zeros GME_coeff_h(:,:,:) = 0.0 GME_coeff_q(:,:,:) = 0.0 @@ -792,12 +788,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, epsilon) ! simple way to limit this coeff - GME_coeff = 0.0 !MIN(GME_coeff,0.0) + GME_coeff = MIN(GME_coeff,1.0E6) - !if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = GME_coeff + if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = GME_coeff - str_xx_GME(i,j) = 0.0 !GME_coeff * sh_xx_bt(i,j) - if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = str_xx_GME(i,j) + str_xx_GME(i,j) = GME_coeff * sh_xx_bt(i,j) endif ! CS%use_GME @@ -851,7 +846,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! applying GME diagonal term if (CS%use_GME) then - !call smooth_GME(CS,G,GME_flux_h=str_xx_GME) + call smooth_GME(CS,G,GME_flux_h=str_xx_GME) do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 str_xx(i,j) = (str_xx(i,j) + str_xx_GME(i,j)) * (h(i,j,k) * CS%reduction_xx(i,j)) enddo ; enddo @@ -987,11 +982,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & epsilon) ! simple way to limit this coeff - GME_coeff = 0.0 !MIN(GME_coeff,0.0) + GME_coeff = MIN(GME_coeff,1.0E6) - !if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff - str_xy_GME(I,J) = 0.0 !GME_coeff * sh_xy_bt(I,J) - if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = str_xy_GME(I,J) + if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff + str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) endif @@ -1039,12 +1033,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo ! applying GME diagonal term - !if (CS%use_GME) then - !call smooth_GME(CS,G,GME_flux_q=str_xy_GME) - !do J=js-1,Jeq ; do I=is-1,Ieq - ! str_xy(i,j) = str_xy(i,j) + str_xy_GME(i,j) - !enddo ; enddo - !endif + if (CS%use_GME) then + call smooth_GME(CS,G,GME_flux_q=str_xy_GME) + endif if (CS%use_GME) then do J=js-1,Jeq ; do I=is-1,Ieq @@ -1057,13 +1048,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - ! GME is applied below if (CS%no_slip) then - str_xy(I,J) = str_xy(I,J) * (hq(I,J) * CS%reduction_xy(I,J)) - ! str_xy(I,J) = (str_xy(I,J) + GME_is_on * str_xy_GME(I,J)) * (hq(I,J) * CS%reduction_xy(I,J)) + str_xy(I,J) = str_xy(I,J) * (hq(I,J) * CS%reduction_xy(I,J)) else - str_xy(I,J) = str_xy(I,J) * (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) - ! str_xy(I,J) = (str_xy(I,J) + GME_is_on * str_xy_GME(I,J)) * (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) + str_xy(I,J) = str_xy(I,J) * (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif enddo ; enddo endif From 1241da85129fd42a5e2e34609b48ade2513b97df Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 20 Feb 2019 15:55:38 -0700 Subject: [PATCH 042/106] Add new way of calculating latent heat --- config_src/mct_driver/MOM_surface_forcing.F90 | 41 +++++++++++++------ 1 file changed, 29 insertions(+), 12 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 84713622ca..153424980c 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -203,8 +203,8 @@ module MOM_surface_forcing !! See \ref section_ocn_import for a summary of the surface fluxes that are !! passed from MCT to MOM6, including fluxes that need to be included in !! the future. -subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & - sfc_state, restore_salt, restore_temp) +subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, sfc_state, & + restore_salt, restore_temp) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive @@ -213,7 +213,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & type(forcing), intent(inout) :: fluxes !< A structure containing pointers to !! all possible mass, heat or salt flux forcing fields. !! Unused fields have NULL ptrs. - type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the !! salinity to the right time, when it is being restored. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure @@ -241,7 +240,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer - integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd logical :: restore_salinity ! local copy of the argument restore_salt, if it ! is present, or false (no restoring) otherwise. @@ -392,9 +390,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & enddo; enddo endif - !i0 = is - isc_bnd ; j0 = js - jsc_bnd ??? - i0 = 0; j0 = 0 ! TODO: is this right? - + ! obtain fluxes from IOB + i0 = 0; j0 = 0 do j=js,je ; do i=is,ie ! liquid precipitation (rain) if (associated(fluxes%lprec)) & @@ -453,8 +450,27 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & fluxes%meltw(i,j) = G%mask2dT(i,j) * IOB%meltw(i-i0,j-j0) ! latent heat flux (W/m^2) - if (associated(fluxes%latent)) & - fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) + ! old method, latent = IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + !if (associated(fluxes%latent)) & + ! fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) + ! new method + fluxes%latent(i,j) = 0.0 + ! contribution from frozen ppt + if (associated(fluxes%fprec)) then + fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion + endif + ! contribution from frozen runoff + if (associated(fluxes%frunoff)) then + fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%rofi_flux(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0)*CS%latent_heat_fusion + endif + ! contribution from evaporation + if (associated(IOB%q_flux)) then + fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + endif + fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) if (associated(IOB%sw_flux_vis_dir)) & fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0) @@ -574,10 +590,11 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 - !isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) - !jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) + isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) + jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) + !if (is_root_pe()) write(*,*)'isc_bnd, jsc_bnd, iec_bnd, jec_bnd',isc_bnd, jsc_bnd, iec_bnd, jec_bnd !i0 = is - isc_bnd ; j0 = js - jsc_bnd - i0 = 0; j0 = 0 ! TODO: is this right? + i0 = 0; j0 = 0 ! TODO: is this right? Irho0 = 1.0/CS%Rho0 From 72945e459c5f90107181adb85f81649aaa04c18c Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 20 Feb 2019 15:58:45 -0700 Subject: [PATCH 043/106] Comment lines with index_bounds --- config_src/mct_driver/MOM_surface_forcing.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 153424980c..358b823a5f 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -590,8 +590,8 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 - isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) - jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) + !isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) + !jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) !if (is_root_pe()) write(*,*)'isc_bnd, jsc_bnd, iec_bnd, jec_bnd',isc_bnd, jsc_bnd, iec_bnd, jec_bnd !i0 = is - isc_bnd ; j0 = js - jsc_bnd i0 = 0; j0 = 0 ! TODO: is this right? From a5fe8c00614d69661665cb60237d04e4eccd7176 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 21 Feb 2019 10:16:36 -0700 Subject: [PATCH 044/106] Fix rotations in import and export subroutines --- config_src/mct_driver/ocn_cap_methods.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index ee965366be..701158e677 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -50,11 +50,11 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ! rotate taux and tauy from true zonal/meridional to local coordinates ! taux ice_ocean_boundary%u_flux(i,j) = GRID%cos_rot(i,j) * x2o(ind%x2o_Foxx_taux,k) & - + GRID%sin_rot(i,j) * x2o(ind%x2o_Foxx_tauy,k) + - GRID%sin_rot(i,j) * x2o(ind%x2o_Foxx_tauy,k) ! tauy ice_ocean_boundary%v_flux(i,j) = GRID%cos_rot(i,j) * x2o(ind%x2o_Foxx_tauy,k) & - - GRID%sin_rot(i,j) * x2o(ind%x2o_Foxx_taux,k) + + GRID%sin_rot(i,j) * x2o(ind%x2o_Foxx_taux,k) ! liquid precipitation (rain) ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) @@ -186,9 +186,9 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) ! rotate ocn current from local tripolar grid to true zonal/meridional (inverse transformation) - o2x(ind%o2x_So_u, n) = (grid%cos_rot(i,j) * ocn_public%u_surf(ig,jg) - & + o2x(ind%o2x_So_u, n) = (grid%cos_rot(i,j) * ocn_public%u_surf(ig,jg) + & grid%sin_rot(i,j) * ocn_public%v_surf(ig,jg)) * grid%mask2dT(i,j) - o2x(ind%o2x_So_v, n) = (grid%cos_rot(i,j) * ocn_public%v_surf(ig,jg) + & + o2x(ind%o2x_So_v, n) = (grid%cos_rot(i,j) * ocn_public%v_surf(ig,jg) - & grid%sin_rot(i,j) * ocn_public%u_surf(ig,jg)) * grid%mask2dT(i,j) ! boundary layer depth (m) @@ -268,8 +268,8 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) n = 0 do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec n = n+1 - o2x(ind%o2x_So_dhdx, n) = grid%cos_rot(i,j) * sshx(i,j) - grid%sin_rot(i,j) * sshy(i,j) - o2x(ind%o2x_So_dhdy, n) = grid%cos_rot(i,j) * sshy(i,j) + grid%sin_rot(i,j) * sshx(i,j) + o2x(ind%o2x_So_dhdx, n) = grid%cos_rot(i,j) * sshx(i,j) + grid%sin_rot(i,j) * sshy(i,j) + o2x(ind%o2x_So_dhdy, n) = grid%cos_rot(i,j) * sshy(i,j) - grid%sin_rot(i,j) * sshx(i,j) enddo; enddo end subroutine ocn_export From adfd67e4a0baf587fb4e178574cb3ae38c489649 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 21 Feb 2019 10:21:53 -0700 Subject: [PATCH 045/106] Fix line length --- config_src/mct_driver/ocn_cap_methods.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index a5c98a83dc..b0381f9a36 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -123,8 +123,10 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i,j) write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j) write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, seaice_melt_heat = ',day,secs,j,i,ice_ocean_boundary%seaice_melt_heat(i,j) - write(logunit,F01)'import: day, secs, j, i, seaice_melt = ',day,secs,j,i,ice_ocean_boundary%seaice_melt(i,j) + write(logunit,F01)'import: day, secs, j, i, seaice_melt_heat = ',day,secs,j,i, & + ice_ocean_boundary%seaice_melt_heat(i,j) + write(logunit,F01)'import: day, secs, j, i, seaice_melt = ',day,secs,j,i, & + ice_ocean_boundary%seaice_melt(i,j) write(logunit,F01)'import: day, secs, j, i, latent_flux = ',& day,secs,j,i,ice_ocean_boundary%latent_flux(i,j) write(logunit,F01)'import: day, secs, j, i, runoff = ',& From e502a97b2b724ba67b3178ff3ebd939d3924234b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 21 Feb 2019 10:45:38 -0700 Subject: [PATCH 046/106] Fix another line length --- 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 701f25aac0..c0a3c9cc70 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1457,7 +1457,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use 'W m-2') handles%id_net_heat_surface = register_diag_field('ocean_model', 'net_heat_surface',diag%axesT1, Time, & - 'Surface ocean heat flux from SW+LW+lat+sens+mass transfer+frazil+restore+seaice_melt_heat or flux adjustments',& + 'Surface ocean heat flux from SW+LW+lat+sens+mass transfer+frazil+restore+seaice_melt_heat or flux adjustments',& 'W m-2',& standard_name='surface_downward_heat_flux_in_sea_water', cmor_field_name='hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water', & From a160252d764c355502b666dcc120e5be980b4352 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 21 Feb 2019 11:20:36 -0700 Subject: [PATCH 047/106] Change limiter in the GME_coeff to 1.0e5 --- src/parameterizations/lateral/MOM_hor_visc.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 9d4266ad17..121c9b309e 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -788,7 +788,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, epsilon) ! simple way to limit this coeff - GME_coeff = MIN(GME_coeff,1.0E6) + GME_coeff = MIN(GME_coeff,1.0E5) if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = GME_coeff @@ -982,7 +982,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & epsilon) ! simple way to limit this coeff - GME_coeff = MIN(GME_coeff,1.0E6) + GME_coeff = MIN(GME_coeff,1.0E5) if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) From bed3fbc93eaf8526055ff3557dc4f22782e6c6cf Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 21 Feb 2019 16:01:15 -0700 Subject: [PATCH 048/106] Change limiter in the GME_coeff to 1.0e4 --- src/parameterizations/lateral/MOM_hor_visc.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 121c9b309e..b85ccab01e 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -788,7 +788,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, epsilon) ! simple way to limit this coeff - GME_coeff = MIN(GME_coeff,1.0E5) + GME_coeff = MIN(GME_coeff,1.0E4) if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = GME_coeff @@ -982,7 +982,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & epsilon) ! simple way to limit this coeff - GME_coeff = MIN(GME_coeff,1.0E5) + GME_coeff = MIN(GME_coeff,1.0E4) if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) From a271bb96a12d153ce8268c259161c9e38f9fd9cd Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 28 Feb 2019 16:12:06 -0700 Subject: [PATCH 049/106] Changed QG Leith limiter to 2D vort. grad. --- .../lateral/MOM_hor_visc.F90 | 31 ++++++++++++++++--- 1 file changed, 26 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index b85ccab01e..c7c6ac85cf 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -239,6 +239,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points (m4 s-1) beta_h, & ! Gradient of planetary vorticity at h-points (m-1 s-1) grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points (m-1 s-1) + grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points (m-1 s-1) grad_div_mag_h ! Magnitude of divergence gradient at h-points (m-1 s-1) real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -254,6 +255,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, Leith_Ah_q, & ! Leith bi-harmonic viscosity at q-points (m4 s-1) beta_q, & ! Gradient of planetary vorticity at q-points (m-1 s-1) grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points (m-1 s-1) + grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points (m-1 s-1) grad_div_mag_q, & ! Magnitude of divergence gradient at q-points (m-1 s-1) hq ! harmonic mean of the harmonic means of the u- & v- ! point thicknesses, in H; This form guarantees that hq/hu < 4. @@ -316,7 +318,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k, n real :: inv_PI3, inv_PI6 - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -633,6 +634,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo endif + call pass_var(vort_xy, G%Domain, position=CORNER, complete=.true.) + ! Vorticity gradient do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) @@ -708,8 +711,19 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif ! CS%use_beta_in_Leith if (CS%use_QG_Leith_visc) then + + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + grad_vort_mag_h_2d(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + (0.5*(vort_xy_dy(I,j) + & + vort_xy_dy(I-1,j)))**2 ) + enddo; enddo + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + grad_vort_mag_q_2d(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + (0.5*(vort_xy_dy(I,j) + & + vort_xy_dy(I,j+1)))**2 ) + enddo ; enddo + call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, div_xx_dx, div_xx_dy, & vort_xy_dx, vort_xy_dy) + endif do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 @@ -730,8 +744,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - if (CS%use_beta_in_Leith) then - vert_vort_mag = MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j), beta_h(i,j)*3) + if (CS%use_QG_Leith_visc) then + !vert_vort_mag = MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j), beta_h(i,j)*3) + vert_vort_mag = MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j),3*grad_vort_mag_h_2d(i,j)) else vert_vort_mag = grad_vort_mag_h(i,j) + grad_div_mag_h(i,j) endif @@ -786,6 +801,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & epsilon) + ! apply mask + GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) ! simple way to limit this coeff GME_coeff = MIN(GME_coeff,1.0E4) @@ -894,8 +911,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (sh_xx(i,j+1)*sh_xx(i,j+1) + sh_xx(i+1,j)*sh_xx(i+1,j)))) endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then - if (CS%use_beta_in_Leith) then - vert_vort_mag = MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), beta_q(I,J)*3) + if (CS%use_QG_Leith_visc) then + vert_vort_mag = MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), 3*grad_vort_mag_q_2d(I,J)) + !vert_vort_mag = MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), beta_q(I,J)*3) else vert_vort_mag = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) endif @@ -981,6 +999,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & epsilon) + ! apply mask + GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) + ! simple way to limit this coeff GME_coeff = MIN(GME_coeff,1.0E4) From a605c59eee2f246f93792d1cffd259c255341109 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 7 Mar 2019 15:34:03 -0700 Subject: [PATCH 050/106] Added some pass_vector calls --- src/parameterizations/lateral/MOM_hor_visc.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index c7c6ac85cf..0ba3ff98a7 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -193,7 +193,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H + intent(inout) :: h !< Layer thicknesses, in H !! (usually m or kg m-2). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: diffu !< Zonal acceleration due to convergence of @@ -647,6 +647,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo + call pass_vector(vort_xy_dy, vort_xy_dx, G%Domain) + if (CS%modified_Leith) then ! Divergence do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 @@ -657,6 +659,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (h(i,j,k) + GV%H_subroundoff) enddo ; enddo + call pass_var(div_xx, G%Domain, complete=.true.) + ! Divergence gradient do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) @@ -665,6 +669,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) enddo ; enddo + call pass_vector(div_xx_dx, div_xx_dy, G%Domain) + ! Magnitude of divergence gradient do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 grad_div_mag_h(i,j) =sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & From 24790c23a2fa8806e988be31cf6567f59c11bf23 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 7 Mar 2019 15:34:39 -0700 Subject: [PATCH 051/106] Added some pass_vector and pass_var calls --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 7960b31bb6..0b61b84dec 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -8,7 +8,7 @@ module MOM_lateral_mixing_coeffs use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, post_data use MOM_diag_mediator, only : diag_ctrl, time_type, query_averaging_enabled use MOM_domains, only : create_group_pass, do_group_pass -use MOM_domains, only : group_pass_type, pass_var +use MOM_domains, only : group_pass_type, pass_var, pass_vector use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_interface_heights, only : find_eta use MOM_isopycnal_slopes, only : calc_isoneutral_slopes @@ -736,7 +736,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow (m s-1) ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow (m s-1) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg m-2) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (m or kg m-2) integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) @@ -779,6 +779,9 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x inv_PI3 = 1.0/((4.0*atan(1.0))**3) + ! update halos + call pass_var(h, G%Domain) + if (k > 1) then ! Add in stretching term for the QG Leith vsicosity @@ -825,6 +828,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x enddo ; enddo endif ! k > 1 + call pass_vector(vort_xy_dy,vort_xy_dx,G%Domain) + if (CS%use_QG_Leith_GM) then if (CS%use_beta_in_QG_Leith) then do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 From fda033447f77bb07005fa46118b8ec164fa1e0a4 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Mon, 11 Mar 2019 14:14:43 -0600 Subject: [PATCH 052/106] Fixed QG Leith halo problem on k=nz level. Also added a tapering function to GME that turns it off in shallow water. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 8 ++++++-- .../lateral/MOM_lateral_mixing_coeffs.F90 | 5 +++-- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0ba3ff98a7..8b68deff9d 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -311,6 +311,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real :: epsilon real :: GME_coeff ! The GME (negative) viscosity coefficient (m2 s-1) real :: DY_dxBu, DX_dyBu + real :: H0 logical :: rescale_Kh, legacy_bound logical :: find_FrictWork logical :: apply_OBC = .false. @@ -370,6 +371,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, !$OMP Shear_mag, h2uq, h2vq, Kh_scale, hrat_min) if (CS%use_GME) then + ! GME tapers off above this depth + H0 = 1000.0 + ! initialize diag. array with zeros GME_coeff_h(:,:,:) = 0.0 GME_coeff_q(:,:,:) = 0.0 @@ -798,7 +802,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif ! Laplacian if (CS%use_GME) then - GME_coeff = 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & + GME_coeff = MIN(G%bathyT(i,j)/H0,1.0)*0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & 0.5*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)),0.0) * & ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & @@ -995,7 +999,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif ! Laplacian if (CS%use_GME) then - GME_coeff = 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & + GME_coeff = MIN(G%bathyT(i,j)/H0,1.0)*0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & 0.25*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)),0.0) * & diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 0b61b84dec..e5569cd5e2 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -771,18 +771,19 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x ! real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points (s-1) ! real :: mod_Leith, DY_dxBu, DX_dyBu, vert_vort_mag real :: h_at_slope_above, h_at_slope_below, Ih, f - integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq + integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq,nz real :: inv_PI3 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + nz = G%ke inv_PI3 = 1.0/((4.0*atan(1.0))**3) ! update halos call pass_var(h, G%Domain) - if (k > 1) then + if ((k > 1) .and. (k < nz)) then ! Add in stretching term for the QG Leith vsicosity ! if (CS%use_QG_Leith) then From bd98d833109a5ca2196b5682bd247d7a6de1ef18 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Mon, 18 Mar 2019 14:14:01 -0600 Subject: [PATCH 053/106] Increased GME limiter and number of times to pass through smoothing function. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 8b68deff9d..22183d1fc0 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -815,7 +815,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) ! simple way to limit this coeff - GME_coeff = MIN(GME_coeff,1.0E4) + GME_coeff = MIN(GME_coeff,1.0E5) if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = GME_coeff @@ -1013,7 +1013,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) ! simple way to limit this coeff - GME_coeff = MIN(GME_coeff,1.0E4) + GME_coeff = MIN(GME_coeff,1.0E5) if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) @@ -1946,7 +1946,7 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) integer :: i, j, k, s !do s=1,CS%n_smooth - do s=1,1 + do s=1,5 ! Update halos if (present(GME_flux_h)) then From 807072b2e99ed9a801be87d68b076621ec60cc00 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Fri, 12 Apr 2019 10:07:36 -0600 Subject: [PATCH 054/106] Refactored MOM_hor_visc. Moved GME out of loops where downgradient viscosity is calculated. Moved calculation of FrictWork ahead of GME so I can separate the work done by downgradient stuff from that of GME. --- .../lateral/MOM_hor_visc.F90 | 198 ++++++++++++------ 1 file changed, 136 insertions(+), 62 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 22183d1fc0..e084a36d6d 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -76,6 +76,7 @@ module MOM_hor_visc logical :: dynamic_aniso !< If true, the anisotropic viscosity is recomputed as a function !! of state. This is set depending on ANISOTROPIC_MODE. logical :: use_GME !< If true, use GME backscatter scheme. + real :: GME_dt real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_xx !< The background Laplacian viscosity at h points, in units !! of m2 s-1. The actual viscosity may be the larger of this @@ -240,7 +241,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, beta_h, & ! Gradient of planetary vorticity at h-points (m-1 s-1) grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points (m-1 s-1) grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points (m-1 s-1) - grad_div_mag_h ! Magnitude of divergence gradient at h-points (m-1 s-1) + grad_div_mag_h, & ! Magnitude of divergence gradient at h-points (m-1 s-1) + dudx, & + dvdy real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) @@ -257,8 +260,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points (m-1 s-1) grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points (m-1 s-1) grad_div_mag_q, & ! Magnitude of divergence gradient at q-points (m-1 s-1) - hq ! harmonic mean of the harmonic means of the u- & v- - ! point thicknesses, in H; This form guarantees that hq/hu < 4. + hq ! harmonic mean of the harmonic means of the u- & v point thicknesses, in H; This form guarantees that hq/hu < 4. real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & Ah_q, & ! biharmonic viscosity at corner points (m4/s) @@ -310,8 +312,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real :: local_strain ! Local variable for interpolating computed strain rates (s-1). real :: epsilon real :: GME_coeff ! The GME (negative) viscosity coefficient (m2 s-1) + real :: GME_coeff_limiter real :: DY_dxBu, DX_dyBu real :: H0 + real :: tmp logical :: rescale_Kh, legacy_bound logical :: find_FrictWork logical :: apply_OBC = .false. @@ -326,7 +330,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, h_neglect3 = h_neglect**3 inv_PI3 = 1.0/((4.0*atan(1.0))**3) inv_PI6 = inv_PI3**2 - epsilon = 1.e-15 + epsilon = 1.e-8 if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then apply_OBC = OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally @@ -373,7 +377,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%use_GME) then ! GME tapers off above this depth H0 = 1000.0 - + ! initialize diag. array with zeros GME_coeff_h(:,:,:) = 0.0 GME_coeff_q(:,:,:) = 0.0 @@ -631,10 +635,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%no_slip) then do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) + dudy(I,J) = (2.0-G%mask2dBu(I,J)) * dudy(I,J) + dvdx(I,J) = (2.0-G%mask2dBu(I,J)) * dvdx(I,J) enddo ; enddo else do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) + dudy(I,J) = G%mask2dBu(I,J) * dudy(I,J) + dvdx(I,J) = G%mask2dBu(I,J) * dvdx(I,J) enddo ; enddo endif @@ -661,6 +669,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & (h(i,j,k) + GV%H_subroundoff) + dudx(i,j) = 0.5*(G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & + G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) )*G%IareaT(i,j)/ & + (h(i,j,k) + GV%H_subroundoff) * G%mask2dcu(I,j) + dvdy(i,j) = 0.5*(G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & + G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k)))*G%IareaT(i,j)/ & + (h(i,j,k) + GV%H_subroundoff) * G%mask2dcv(i,J) enddo ; enddo call pass_var(div_xx, G%Domain, complete=.true.) @@ -801,28 +815,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, str_xx(i,j) = 0.0 endif ! Laplacian - if (CS%use_GME) then - GME_coeff = MIN(G%bathyT(i,j)/H0,1.0)*0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & - KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & - 0.5*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)),0.0) * & - ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & - (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) / & - ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & - (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & - (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & - epsilon) - ! apply mask - GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) - - ! simple way to limit this coeff - GME_coeff = MIN(GME_coeff,1.0E5) - - if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = GME_coeff - - str_xx_GME(i,j) = GME_coeff * sh_xx_bt(i,j) - - endif ! CS%use_GME - if (CS%anisotropic) then ! Shearing-strain averaged to h-points local_strain = 0.25 * ( (sh_xy(I,J) + sh_xy(I-1,J-1)) + (sh_xy(I-1,J) + sh_xy(I,J-1)) ) @@ -871,18 +863,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo - ! applying GME diagonal term - if (CS%use_GME) then - call smooth_GME(CS,G,GME_flux_h=str_xx_GME) - do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - str_xx(i,j) = (str_xx(i,j) + str_xx_GME(i,j)) * (h(i,j,k) * CS%reduction_xx(i,j)) - enddo ; enddo - else - do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - str_xx(i,j) = str_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) - enddo ; enddo - endif - if (CS%biharmonic) then ! Gradient of Laplacian, for use in bi-harmonic term do J=js-1,Jeq ; do I=is-1,Ieq @@ -998,28 +978,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, str_xy(I,J) = 0.0 endif ! Laplacian - if (CS%use_GME) then - GME_coeff = MIN(G%bathyT(i,j)/H0,1.0)*0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & - KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & - 0.25*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & - VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)),0.0) * & - ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I,j+1,k)) )**2 + & - (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i+1,J,k)) )**2 ) / & - ( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & - (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & - (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & - epsilon) - ! apply mask - GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) - - ! simple way to limit this coeff - GME_coeff = MIN(GME_coeff,1.0E5) - - if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff - str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) - - endif - if (CS%anisotropic) then ! Horizontal-tension averaged to q-points local_strain = 0.25 * ( (sh_xx(i,j) + sh_xx(i+1,j+1)) + (sh_xx(i+1,j) + sh_xx(i,j+1)) ) @@ -1063,6 +1021,115 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo + + if (find_FrictWork) then ; do j=js,je ; do i=is,ie + ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) + FrictWork(i,j,k) = GV%H_to_kg_m2 * ( & + (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & + -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & + +0.25*((str_xy(I,J)*( & + (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & + +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & + +str_xy(I-1,J-1)*( & + (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & + +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & + +(str_xy(I-1,J)*( & + (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & + +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & + +str_xy(I,J-1)*( & + (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & + +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) + enddo ; enddo ; endif + + + if (CS%use_GME) then + + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + +! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & +! KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & +! sqrt(0.5*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)),0.0) * & +! ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & +! (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) / & +! ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & +! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & +! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & +! epsilon)) + + GME_coeff = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / & + SQRT( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & + (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & + (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & + epsilon) + + ! apply mask + GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) + +! GME_coeff_limiter = 1e5 +! GME_coeff_limiter = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / sqrt(dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & +! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & +! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + epsilon) + + ! simple way to limit this coeff +! GME_coeff = MIN(GME_coeff,GME_coeff_limiter) + + if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = GME_coeff + + str_xx_GME(i,j) = GME_coeff * sh_xx_bt(i,j) + + enddo ; enddo + + endif ! CS%use_GME + + ! applying GME diagonal term + if (CS%use_GME) then + call smooth_GME(CS,G,GME_flux_h=str_xx_GME) + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + str_xx(i,j) = (str_xx(i,j) + str_xx_GME(i,j)) * (h(i,j,k) * CS%reduction_xx(i,j)) + enddo ; enddo + else + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + str_xx(i,j) = str_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) + enddo ; enddo + endif + + if (CS%use_GME) then + do J=js-1,Jeq ; do I=is-1,Ieq + +! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & +! KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & +! sqrt( 0.25*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & +! VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)),0.0) * & +! ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I,j+1,k)) )**2 + & +! (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i+1,J,k)) )**2 ) / & +! ( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & +! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & +! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & +! epsilon)) + + GME_coeff = 2.0* MAX(0.0,MEKE%MEKE(i,j)) / & + SQRT( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & + (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & + (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & + epsilon) + + ! apply mask + GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) + +! GME_coeff_limiter = 1e5 +! GME_coeff_limiter = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / sqrt( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & +! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & +! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + epsilon) + + ! simple way to limit this coeff +! GME_coeff = MIN(GME_coeff,GME_coeff_limiter) + + if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff + str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) + + enddo ; enddo + endif + ! applying GME diagonal term if (CS%use_GME) then call smooth_GME(CS,G,GME_flux_q=str_xy_GME) @@ -1087,6 +1154,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo endif + + + + + ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & @@ -1644,6 +1716,8 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / G%dxCv(i+1,J) enddo ; enddo + CS%GME_dt = dt + if (CS%Laplacian) then ! The 0.3 below was 0.4 in MOM1.10. The change in hq requires ! this to be less than 1/3, rather than 1/2 as before. @@ -1946,7 +2020,7 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) integer :: i, j, k, s !do s=1,CS%n_smooth - do s=1,5 + do s=1,1 ! Update halos if (present(GME_flux_h)) then From 59aad4fb2783dea84fbb12d03374fbd390bb29bf Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Fri, 12 Apr 2019 10:21:44 -0600 Subject: [PATCH 055/106] Added a loop to ensure MEKE is never less than 0. Added new variable called FrictWorkMax that calculates the maximum frictional work that is allowed by theory. --- src/parameterizations/lateral/MOM_MEKE.F90 | 6 ++++++ src/parameterizations/lateral/MOM_hor_visc.F90 | 7 +++++++ 2 files changed, 13 insertions(+) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 949268c7e9..90e164022f 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -490,6 +490,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) endif endif ! MEKE_KH>=0 !$OMP end parallel + + ! Ensure that MEKE is non-negative + do j=js,je ; do i=is,ie + MEKE%MEKE(i,j) = MAX(0.0, MEKE%MEKE(i,j) + enddo ; enddo + call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_MEKE, G%Domain) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index e084a36d6d..ae485047dd 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1039,6 +1039,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, +str_xy(I,J-1)*( & (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) + + if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then + FrictWorkMax(i,j,k) = MEKE%MEKE * sqrt(dudx(i,j)**2 + dvdy(i,j)**2 + & + (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & + (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) + endif ; endif + enddo ; enddo ; endif From f5da24dd02ebea96d73ed5f8651d1149f9107e71 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Fri, 12 Apr 2019 10:23:49 -0600 Subject: [PATCH 056/106] Allocated FrictWorkMax array (forgot last time). --- src/parameterizations/lateral/MOM_hor_visc.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index ae485047dd..dfa3accebd 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -276,6 +276,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, Ah_h, & ! biharmonic viscosity at thickness points (m4/s) Kh_h, & ! Laplacian viscosity at thickness points (m2/s) FrictWork, & ! energy dissipated by lateral friction (W/m2) + FrictWorkMax, & ! maximum possible energy dissipated by lateral friction (W/m2) div_xx_h ! horizontal divergence (s-1) !real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & From 2260e70093547ce4863d2639e4eec9730c702144 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Fri, 12 Apr 2019 10:47:32 -0600 Subject: [PATCH 057/106] Fixed some coding mistakes from the last commit. --- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- .../lateral/MOM_hor_visc.F90 | 48 +++++++++++++------ 2 files changed, 35 insertions(+), 15 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 90e164022f..f650407ab2 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -493,7 +493,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) ! Ensure that MEKE is non-negative do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = MAX(0.0, MEKE%MEKE(i,j) + MEKE%MEKE(i,j) = MAX(0.0, MEKE%MEKE(i,j)) enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index dfa3accebd..cb3a2b2d93 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -277,6 +277,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, Kh_h, & ! Laplacian viscosity at thickness points (m2/s) FrictWork, & ! energy dissipated by lateral friction (W/m2) FrictWorkMax, & ! maximum possible energy dissipated by lateral friction (W/m2) + target_FrictWork_GME, & ! target amount of energy to add via GME (W/m2) div_xx_h ! horizontal divergence (s-1) !real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & @@ -314,6 +315,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real :: epsilon real :: GME_coeff ! The GME (negative) viscosity coefficient (m2 s-1) real :: GME_coeff_limiter + real :: FWfrac real :: DY_dxBu, DX_dyBu real :: H0 real :: tmp @@ -1042,11 +1044,19 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then - FrictWorkMax(i,j,k) = MEKE%MEKE * sqrt(dudx(i,j)**2 + dvdy(i,j)**2 + & + FrictWorkMax(i,j,k) = MEKE%MEKE(i,j) * sqrt(dudx(i,j)**2 + dvdy(i,j)**2 + & (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) endif ; endif + ! Determine how much work GME needs to do to reach the "target" ratio between + ! the amount of work actually done and the maximum allowed by theory. Note that + ! we need to add the FrictWork done by the dissipation operators, since this work + ! is done only for numerical stability and is therefore spurious + if (CS%use_GME) then + target_FrictWork_GME(i,j,k) = FWfrac * FrictWorkMax(i,j,k) - FrictWork(i,j,k) + endif + enddo ; enddo ; endif @@ -1064,14 +1074,21 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & ! epsilon)) - GME_coeff = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / & - SQRT( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & +! GME_coeff = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / & +! SQRT( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & +! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & +! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & +! epsilon) + + if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then + GME_coeff = target_FrictWork_GME(i,j,k) / ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & - epsilon) + epsilon) + endif ; endif - ! apply mask - GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) +! ! apply mask +! GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) ! GME_coeff_limiter = 1e5 ! GME_coeff_limiter = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / sqrt(dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & @@ -1115,11 +1132,18 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & ! epsilon)) - GME_coeff = 2.0* MAX(0.0,MEKE%MEKE(i,j)) / & - SQRT( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & +! GME_coeff = 2.0* MAX(0.0,MEKE%MEKE(i,j)) / & +! SQRT( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & +! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & +! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & +! epsilon) + + if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then + GME_coeff = target_FrictWork_GME(i,j,k) / (dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & - (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & - epsilon) + (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & + epsilon) + endif ; endif ! apply mask GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) @@ -1163,10 +1187,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif - - - - ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & From 654212278bd4ac0a39b58ea6413b78d2ccf4b694 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Fri, 12 Apr 2019 16:24:10 -0600 Subject: [PATCH 058/106] Added new variable FrictWork_diss to account for the energy dissipated by shear production (excluding the energy diffusion term which can be positive). --- .../lateral/MOM_hor_visc.F90 | 145 ++++++++++-------- 1 file changed, 78 insertions(+), 67 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index cb3a2b2d93..986d32ce19 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -166,8 +166,11 @@ module MOM_hor_visc integer :: id_GME_coeff_h = -1, id_GME_coeff_q = -1 integer :: id_vort_xy_q = -1, id_div_xx_h = -1 integer :: id_FrictWork = -1, id_FrictWorkIntz = -1 + integer :: id_FrictWorkMax = -1, id_target_FrictWork_GME = -1 + integer :: id_FrictWork_diss = -1 !!@} + end type hor_visc_CS contains @@ -275,7 +278,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points (m4/s) Kh_h, & ! Laplacian viscosity at thickness points (m2/s) - FrictWork, & ! energy dissipated by lateral friction (W/m2) + FrictWork, & ! energy flux by parameterized shear production (W/m2) + FrictWork_diss, & ! energy dissipated by parameterized shear production (W/m2) FrictWorkMax, & ! maximum possible energy dissipated by lateral friction (W/m2) target_FrictWork_GME, & ! target amount of energy to add via GME (W/m2) div_xx_h ! horizontal divergence (s-1) @@ -380,7 +384,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%use_GME) then ! GME tapers off above this depth H0 = 1000.0 - + FWfrac = 0.1 ! initialize diag. array with zeros GME_coeff_h(:,:,:) = 0.0 GME_coeff_q(:,:,:) = 0.0 @@ -810,7 +814,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif endif - if (CS%id_Kh_h>0) Kh_h(i,j,k) = Kh + if ((CS%id_Kh_h>0) .or. find_FrictWork) Kh_h(i,j,k) = Kh if (CS%id_div_xx_h>0) div_xx_h(i,j,k) = div_xx(i,j) str_xx(i,j) = -Kh * sh_xx(i,j) @@ -850,7 +854,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j)) endif - if (CS%id_Ah_h>0) Ah_h(i,j,k) = Ah + if ((CS%id_Ah_h>0) .or. find_FrictWork) Ah_h(i,j,k) = Ah str_xx(i,j) = str_xx(i,j) + Ah * & (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & @@ -1025,54 +1029,49 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo - if (find_FrictWork) then ; do j=js,je ; do i=is,ie - ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) - FrictWork(i,j,k) = GV%H_to_kg_m2 * ( & - (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & - -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & - +0.25*((str_xy(I,J)*( & - (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & - +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & - +str_xy(I-1,J-1)*( & - (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & - +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & - +(str_xy(I-1,J)*( & - (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & - +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & - +str_xy(I,J-1)*( & - (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & - +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) + if (find_FrictWork) then + if (CS%biharmonic) call pass_vector(u0, v0, G%Domain) + + do j=js,je ; do i=is,ie + ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) + FrictWork_diss(i,j,k) = Kh_h(i,j,k) * (dudx(i,j)**2 + dvdy(i,j)**2 + & + (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & + (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) + & + Ah_h(i,j,k) * ((0.5*(u0(I,j) + u0(I-1,j)))**2 + & + (0.5*(v0(i,J) + v0(i,J-1)))**2) - if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then - FrictWorkMax(i,j,k) = MEKE%MEKE(i,j) * sqrt(dudx(i,j)**2 + dvdy(i,j)**2 + & + if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then + FrictWorkMax(i,j,k) = MEKE%MEKE(i,j) * sqrt(dudx(i,j)**2 + dvdy(i,j)**2 + & (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) - endif ; endif - ! Determine how much work GME needs to do to reach the "target" ratio between - ! the amount of work actually done and the maximum allowed by theory. Note that - ! we need to add the FrictWork done by the dissipation operators, since this work - ! is done only for numerical stability and is therefore spurious - if (CS%use_GME) then - target_FrictWork_GME(i,j,k) = FWfrac * FrictWorkMax(i,j,k) - FrictWork(i,j,k) - endif + ! Determine how much work GME needs to do to reach the "target" ratio between + ! the amount of work actually done and the maximum allowed by theory. Note that + ! we need to add the FrictWork done by the dissipation operators, since this work + ! is done only for numerical stability and is therefore spurious + if (CS%use_GME) then + target_FrictWork_GME(i,j,k) = FWfrac * FrictWorkMax(i,j,k) - FrictWork(i,j,k) + endif - enddo ; enddo ; endif + endif ; endif + + enddo ; enddo + endif if (CS%use_GME) then do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & -! KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & -! sqrt(0.5*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)),0.0) * & -! ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & -! (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) / & -! ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & -! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & -! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & -! epsilon)) + GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & + KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & + sqrt(0.5*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)),0.0) * & + ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & + (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) / & + ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & + (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & + (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & + epsilon)) ! GME_coeff = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / & ! SQRT( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & @@ -1080,23 +1079,23 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & ! epsilon) - if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then - GME_coeff = target_FrictWork_GME(i,j,k) / ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & - (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & - (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & - epsilon) - endif ; endif +! if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then +! GME_coeff = target_FrictWork_GME(i,j,k) / ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & +! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & +! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & +! epsilon) +! endif ; endif ! ! apply mask ! GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) -! GME_coeff_limiter = 1e5 + GME_coeff_limiter = 0.0 ! GME_coeff_limiter = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / sqrt(dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & ! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & ! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + epsilon) ! simple way to limit this coeff -! GME_coeff = MIN(GME_coeff,GME_coeff_limiter) + GME_coeff = MIN(GME_coeff,GME_coeff_limiter) if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = GME_coeff @@ -1121,16 +1120,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%use_GME) then do J=js-1,Jeq ; do I=is-1,Ieq -! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & -! KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & -! sqrt( 0.25*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & -! VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)),0.0) * & -! ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I,j+1,k)) )**2 + & -! (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i+1,J,k)) )**2 ) / & -! ( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & -! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & -! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & -! epsilon)) + GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & + KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & + sqrt( 0.25*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & + VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)),0.0) * & + ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I,j+1,k)) )**2 + & + (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i+1,J,k)) )**2 ) / & + ( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & + (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & + (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & + epsilon)) ! GME_coeff = 2.0* MAX(0.0,MEKE%MEKE(i,j)) / & ! SQRT( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & @@ -1138,23 +1137,23 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & ! epsilon) - if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then - GME_coeff = target_FrictWork_GME(i,j,k) / (dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & - (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & - (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & - epsilon) - endif ; endif +! if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then +! GME_coeff = target_FrictWork_GME(i,j,k) / (dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & +! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & +! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & +! epsilon) +! endif ; endif ! apply mask GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) -! GME_coeff_limiter = 1e5 + GME_coeff_limiter = 0.0 ! GME_coeff_limiter = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / sqrt( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & ! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & ! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + epsilon) ! simple way to limit this coeff -! GME_coeff = MIN(GME_coeff,GME_coeff_limiter) + GME_coeff = MIN(GME_coeff,GME_coeff_limiter) if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) @@ -1300,6 +1299,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%id_diffu>0) call post_data(CS%id_diffu, diffu, CS%diag) if (CS%id_diffv>0) call post_data(CS%id_diffv, diffv, CS%diag) if (CS%id_FrictWork>0) call post_data(CS%id_FrictWork, FrictWork, CS%diag) + if (CS%id_FrictWorkMax>0) call post_data(CS%id_FrictWorkMax, FrictWorkMax, CS%diag) + if (CS%id_FrictWork_diss>0) call post_data(CS%id_FrictWork_diss, FrictWork_diss, CS%diag) + if (CS%id_target_FrictWork_GME>0) call post_data(CS%id_target_FrictWork_GME, target_FrictWork_GME, CS%diag) if (CS%id_Ah_h>0) call post_data(CS%id_Ah_h, Ah_h, CS%diag) if (CS%id_div_xx_h>0) call post_data(CS%id_div_xx_h, div_xx_h, CS%diag) if (CS%id_vort_xy_q>0) call post_data(CS%id_vort_xy_q, vort_xy_q, CS%diag) @@ -1994,10 +1996,19 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) CS%id_GME_coeff_q = register_diag_field('ocean_model', 'GME_coeff_q', diag%axesBL, Time, & 'GME coefficient at q Points', 'm^2 s-1') + + CS%id_target_FrictWork_GME = register_diag_field('ocean_model','target_FrictWork_GME',diag%axesTL,Time,& + 'Target for the amount of integral work done by lateral friction terms in GME', 'W m-2') endif CS%id_FrictWork = register_diag_field('ocean_model','FrictWork',diag%axesTL,Time,& 'Integral work done by lateral friction terms', 'W m-2') + + CS%id_FrictWork_diss = register_diag_field('ocean_model','FrictWork_diss',diag%axesTL,Time,& + 'Integral work done by lateral friction terms (excluding diffusion of energy)', 'W m-2') + + CS%id_FrictWorkMax = register_diag_field('ocean_model','FrictWorkMax',diag%axesTL,Time,& + 'Maximum possible integral work done by lateral friction terms', 'W m-2') CS%id_FrictWorkIntz = register_diag_field('ocean_model','FrictWorkIntz',diag%axesT1,Time, & 'Depth integrated work done by lateral friction', 'W m-2', & From 8df6efd31d20d30bf512fab550176257484c97f7 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Tue, 16 Apr 2019 10:05:43 -0600 Subject: [PATCH 059/106] Added a new flag to MOM_lateral_mixing_coeffs called "USE_VISBECK", which calculates the GM coefficient using the Visbeck et al. (1997) formulation. Previously this was being done whenever VarMix was enabled, but I wanted to separate VarMix from this diffusivity call. --- src/parameterizations/lateral/MOM_MEKE.F90 | 8 ++-- .../lateral/MOM_hor_visc.F90 | 27 +++++++++++--- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 ++ .../lateral/MOM_thickness_diffuse.F90 | 37 ++++++++++++++++--- 4 files changed, 61 insertions(+), 15 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index f650407ab2..ebb202f65b 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -491,10 +491,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) endif ! MEKE_KH>=0 !$OMP end parallel - ! Ensure that MEKE is non-negative - do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = MAX(0.0, MEKE%MEKE(i,j)) - enddo ; enddo +! ! Ensure that MEKE is non-negative +! do j=js,je ; do i=is,ie +! MEKE%MEKE(i,j) = MAX(0.0, MEKE%MEKE(i,j)) +! enddo ; enddo call cpu_clock_begin(CS%id_clock_pass) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 986d32ce19..41deef61a7 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1065,7 +1065,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & - sqrt(0.5*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)),0.0) * & + (0.5*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)),0.0) * & ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) / & ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & @@ -1073,6 +1073,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & epsilon)) +! GME_coeff = 2.0 * (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & +! KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & +! sqrt(0.5*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)),0.0)) / & +! sqrt( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & +! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & +! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & +! epsilon) + ! GME_coeff = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / & ! SQRT( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & ! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & @@ -1089,7 +1097,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! ! apply mask ! GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) - GME_coeff_limiter = 0.0 + GME_coeff_limiter = 1e6 ! 1e8 ! GME_coeff_limiter = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / sqrt(dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & ! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & ! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + epsilon) @@ -1122,7 +1130,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & - sqrt( 0.25*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & + ( 0.25*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)),0.0) * & ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I,j+1,k)) )**2 + & (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i+1,J,k)) )**2 ) / & @@ -1131,6 +1139,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & epsilon)) +! GME_coeff = 2.0 * (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & +! KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & +! sqrt( 0.25*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & +! VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)),0.0)) / & +! sqrt(dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & +! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & +! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & +! epsilon) + ! GME_coeff = 2.0* MAX(0.0,MEKE%MEKE(i,j)) / & ! SQRT( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & ! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & @@ -1147,7 +1164,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! apply mask GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) - GME_coeff_limiter = 0.0 + GME_coeff_limiter = 1e6 !1e8 ! GME_coeff_limiter = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / sqrt( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & ! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & ! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + epsilon) @@ -1288,7 +1305,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo else do j=js,je ; do i=is,ie - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork(i,j,k) + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork_diss(i,j,k) enddo ; enddo endif endif ; endif diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index e5569cd5e2..036f3b0ef5 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -108,6 +108,7 @@ module MOM_lateral_mixing_coeffs KH_v_QG !< QG Leith GM coefficient at v-points (m2 s-1) ! Parameters + logical :: use_Visbeck !< Use Visbeck formulation for thickness diffusivity integer :: VarMix_Ktop !< Top layer to start downward integrals real :: Visbeck_L_scale !< Fixed length scale in Visbeck formula real :: Res_coef_khth !< A non-dimensional number that determines the function @@ -928,6 +929,9 @@ subroutine VarMix_init(Time, G, GV, param_file, diag, CS) "not used. If KHTR_SLOPE_CFF>0 or KhTh_Slope_Cff>0, \n"//& "this is set to true regardless of what is in the \n"//& "parameter file.", default=.false.) + call get_param(param_file, mdl, "USE_VISBECK", CS%use_Visbeck,& + "If true, use the Visbeck et al. (1997) formulation for \n"//& + "thickness diffusivity.", default=.false.) call get_param(param_file, mdl, "RESOLN_SCALED_KH", CS%Resoln_scaled_Kh, & "If true, the Laplacian lateral viscosity is scaled away \n"//& "when the first baroclinic deformation radius is well \n"//& diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index eca86acf52..b6e6caea8f 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -120,7 +120,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. real, dimension(:,:), pointer :: cg1 => null() !< Wave speed (m/s) - logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct + logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct, use_Visbeck logical :: use_QG_Leith integer :: i, j, k, is, ie, js, je, nz real :: hu(SZI_(G), SZJ_(G)) ! u-thickness (H) @@ -151,6 +151,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS Resoln_scaled = VarMix%Resoln_scaled_KhTh use_stored_slopes = VarMix%use_stored_slopes khth_use_ebt_struct = VarMix%khth_use_ebt_struct + use_Visbeck = VarMix%use_Visbeck use_QG_Leith = VarMix%use_QG_Leith_GM if (associated(VarMix%cg1)) cg1 => VarMix%cg1 else @@ -183,7 +184,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS if (use_VarMix) then !$OMP do - if (.not. use_QG_Leith) then + if (use_Visbeck) then do j=js,je ; do I=is-1,ie Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + CS%KHTH_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) enddo ; enddo @@ -255,7 +256,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS if (use_VarMix) then !$OMP do - if (.not. use_QG_Leith) then + if (use_Visbeck) then do J=js-1,je ; do i=is,ie Khth_Loc(i,j) = Khth_Loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) enddo ; enddo @@ -328,6 +329,16 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS do K=1,nz+1 ; do J=js-1,je ; do i=is,ie ; int_slope_v(i,J,K) = 0.0 ; enddo ; enddo ; enddo !$OMP end parallel +! if (associated(MEKE)) then +! do j=js,je ; do i=is,ie +! MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + 0.25*(Kh_u(I,j,k) + KH_u(I-1,j,k) + & +! KH_v(i,J,k) + KH_v(i,J-1,k)) +!! 0.25*MAX(VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)+VarMix%N2_v(i,J,k)+VarMix%N2_v(i,J-1,k),0.0) * & +!! ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & +!! (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) +! enddo; enddo +! endif + if (CS%detangle_interfaces) then call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, & CS, int_slope_u, int_slope_v) @@ -351,7 +362,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS ! Calculate uhD, vhD from h, e, KH_u, KH_v, tv%T/S if (use_stored_slopes) then call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, MEKE, CS, & - int_slope_u, int_slope_v, VarMix%slope_x, VarMix%slope_y) + int_slope_u, int_slope_v, VarMix%slope_x, VarMix%slope_y, & + VarMix%N2_u, VarMix%N2_v) else call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, MEKE, CS, & int_slope_u, int_slope_v) @@ -445,7 +457,7 @@ end subroutine thickness_diffuse !! Fluxes are limited to give positive definite thicknesses. !! Called by thickness_diffuse(). subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, MEKE, & - CS, int_slope_u, int_slope_v, slope_x, slope_y) + CS, int_slope_u, int_slope_v, slope_x, slope_y, N2_x, N2_y) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) @@ -471,7 +483,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !! density gradients. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: slope_x !< Isopycnal slope at u-points real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: slope_y !< Isopycnal slope at v-points - + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: N2_x !< Brunt-Vaisala frequency at + !! u points (s-2) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: N2_y !< Brunt-Vaisala frequency at + !! v points (s-2) ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & T, & ! The temperature (or density) in C, with the values in @@ -556,6 +571,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: diag_sfn_y, diag_sfn_unlim_y ! Diagnostics logical :: present_int_slope_u, present_int_slope_v logical :: present_slope_x, present_slope_y, calc_derivatives + logical :: present_N2_x, present_N2_y integer :: is, ie, js, je, nz, IsdB integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ; IsdB = G%IsdB @@ -573,6 +589,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV present_int_slope_v = PRESENT(int_slope_v) present_slope_x = PRESENT(slope_x) present_slope_y = PRESENT(slope_y) + present_N2_x = PRESENT(N2_x) + present_N2_y = PRESENT(N2_y) nk_linear = max(GV%nkml, 1) @@ -1181,6 +1199,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h if (associated(MEKE)) then ; if (associated(MEKE%GM_src)) then MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h +! if (present_N2_x .and. present_N2_y) & +! MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + 0.25*(Kh_u(I,j,k) + KH_u(I-1,j,k) + & +! KH_v(i,J,k) + KH_v(i,J-1,k)) * & +! 0.25*MAX(N2_x(I,j,k)+N2_x(I-1,j,k)+N2_y(i,J,k)+N2_y(i,J-1,k),0.0) * & +! ( (0.5*(slope_x(I,j,k)+slope_x(I-1,j,k)) )**2 + & +! (0.5*(slope_y(i,J,k)+slope_y(i,J-1,k)) )**2 ) + endif ; endif enddo ; enddo ; endif From 172ae02ebfb38d602303d19d6ee360e7756a20fa Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Wed, 17 Apr 2019 09:59:42 -0600 Subject: [PATCH 060/106] Fixed problems with FrictWorkMax and FrictWorkDiss in MOM_hor_visc.F. More specifically, I moved the calculation of dudx and dvdy outside of the Leith loop so now it is being calculated with sh_xx. --- .../lateral/MOM_hor_visc.F90 | 30 +++++++++--------- .../lateral/MOM_thickness_diffuse.F90 | 31 ++----------------- 2 files changed, 18 insertions(+), 43 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 41deef61a7..b73590f8e6 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -384,7 +384,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%use_GME) then ! GME tapers off above this depth H0 = 1000.0 - FWfrac = 0.1 + FWfrac = 1.0 ! initialize diag. array with zeros GME_coeff_h(:,:,:) = 0.0 GME_coeff_q(:,:,:) = 0.0 @@ -447,10 +447,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! Calculate horizontal tension do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - sh_xx(i,j) = (CS%DY_dxT(i,j)*(G%IdyCu(I,j) * u(I,j,k) - & - G%IdyCu(I-1,j) * u(I-1,j,k)) - & - CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v(i,J,k) - & - G%IdxCv(i,J-1)*v(i,J-1,k))) + dudx(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * u(I,j,k) - & + G%IdyCu(I-1,j) * u(I-1,j,k)) + dvdy(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v(i,J,k) - & + G%IdxCv(i,J-1) * v(i,J-1,k)) + sh_xx(i,j) = dudx(i,j) - dvdy(i,j) enddo ; enddo ! Components for the shearing strain @@ -459,6 +460,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) enddo ; enddo + ! Interpolate the thicknesses to velocity points. ! The extra wide halos are to accommodate the cross-corner-point projections ! in OBCs, which are not ordinarily be necessary, and might not be necessary @@ -676,12 +678,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & (h(i,j,k) + GV%H_subroundoff) - dudx(i,j) = 0.5*(G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & - G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) )*G%IareaT(i,j)/ & - (h(i,j,k) + GV%H_subroundoff) * G%mask2dcu(I,j) - dvdy(i,j) = 0.5*(G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k)))*G%IareaT(i,j)/ & - (h(i,j,k) + GV%H_subroundoff) * G%mask2dcv(i,J) enddo ; enddo call pass_var(div_xx, G%Domain, complete=.true.) @@ -1031,17 +1027,21 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (find_FrictWork) then if (CS%biharmonic) call pass_vector(u0, v0, G%Domain) + call pass_var(dudx, G%Domain, complete=.true.) + call pass_var(dvdy, G%Domain, complete=.true.) + call pass_var(dvdx, G%Domain, position=CORNER, complete=.true.) + call pass_var(dudy, G%Domain, position=CORNER, complete=.true.) do j=js,je ; do i=is,ie ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) - FrictWork_diss(i,j,k) = Kh_h(i,j,k) * (dudx(i,j)**2 + dvdy(i,j)**2 + & + FrictWork_diss(i,j,k) = -Kh_h(i,j,k) * (dudx(i,j)**2 + dvdy(i,j)**2 + & (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & - (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) + & + (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) - & Ah_h(i,j,k) * ((0.5*(u0(I,j) + u0(I-1,j)))**2 + & (0.5*(v0(i,J) + v0(i,J-1)))**2) if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then - FrictWorkMax(i,j,k) = MEKE%MEKE(i,j) * sqrt(dudx(i,j)**2 + dvdy(i,j)**2 + & + FrictWorkMax(i,j,k) = 2.0*MEKE%MEKE(i,j) * sqrt(dudx(i,j)**2 + dvdy(i,j)**2 + & (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) @@ -1050,7 +1050,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! we need to add the FrictWork done by the dissipation operators, since this work ! is done only for numerical stability and is therefore spurious if (CS%use_GME) then - target_FrictWork_GME(i,j,k) = FWfrac * FrictWorkMax(i,j,k) - FrictWork(i,j,k) + target_FrictWork_GME(i,j,k) = FWfrac * FrictWorkMax(i,j,k) - FrictWork_diss(i,j,k) endif endif ; endif diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index b6e6caea8f..cabcf1f9f2 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -329,16 +329,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS do K=1,nz+1 ; do J=js-1,je ; do i=is,ie ; int_slope_v(i,J,K) = 0.0 ; enddo ; enddo ; enddo !$OMP end parallel -! if (associated(MEKE)) then -! do j=js,je ; do i=is,ie -! MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + 0.25*(Kh_u(I,j,k) + KH_u(I-1,j,k) + & -! KH_v(i,J,k) + KH_v(i,J-1,k)) -!! 0.25*MAX(VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)+VarMix%N2_v(i,J,k)+VarMix%N2_v(i,J-1,k),0.0) * & -!! ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & -!! (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) -! enddo; enddo -! endif - if (CS%detangle_interfaces) then call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, & CS, int_slope_u, int_slope_v) @@ -362,8 +352,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS ! Calculate uhD, vhD from h, e, KH_u, KH_v, tv%T/S if (use_stored_slopes) then call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, MEKE, CS, & - int_slope_u, int_slope_v, VarMix%slope_x, VarMix%slope_y, & - VarMix%N2_u, VarMix%N2_v) + int_slope_u, int_slope_v, VarMix%slope_x, VarMix%slope_y) else call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, MEKE, CS, & int_slope_u, int_slope_v) @@ -457,7 +446,7 @@ end subroutine thickness_diffuse !! Fluxes are limited to give positive definite thicknesses. !! Called by thickness_diffuse(). subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, MEKE, & - CS, int_slope_u, int_slope_v, slope_x, slope_y, N2_x, N2_y) + CS, int_slope_u, int_slope_v, slope_x, slope_y) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) @@ -483,10 +472,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !! density gradients. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: slope_x !< Isopycnal slope at u-points real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: slope_y !< Isopycnal slope at v-points - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: N2_x !< Brunt-Vaisala frequency at - !! u points (s-2) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: N2_y !< Brunt-Vaisala frequency at - !! v points (s-2) ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & T, & ! The temperature (or density) in C, with the values in @@ -571,7 +556,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: diag_sfn_y, diag_sfn_unlim_y ! Diagnostics logical :: present_int_slope_u, present_int_slope_v logical :: present_slope_x, present_slope_y, calc_derivatives - logical :: present_N2_x, present_N2_y integer :: is, ie, js, je, nz, IsdB integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ; IsdB = G%IsdB @@ -589,8 +573,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV present_int_slope_v = PRESENT(int_slope_v) present_slope_x = PRESENT(slope_x) present_slope_y = PRESENT(slope_y) - present_N2_x = PRESENT(N2_x) - present_N2_y = PRESENT(N2_y) nk_linear = max(GV%nkml, 1) @@ -1198,14 +1180,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h if (associated(MEKE)) then ; if (associated(MEKE%GM_src)) then - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h -! if (present_N2_x .and. present_N2_y) & -! MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + 0.25*(Kh_u(I,j,k) + KH_u(I-1,j,k) + & -! KH_v(i,J,k) + KH_v(i,J-1,k)) * & -! 0.25*MAX(N2_x(I,j,k)+N2_x(I-1,j,k)+N2_y(i,J,k)+N2_y(i,J-1,k),0.0) * & -! ( (0.5*(slope_x(I,j,k)+slope_x(I-1,j,k)) )**2 + & -! (0.5*(slope_y(i,J,k)+slope_y(i,J-1,k)) )**2 ) - + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + MIN(0.0,Work_h) endif ; endif enddo ; enddo ; endif From 379e9ee047e829fa2c57fe5a9867c916f4a731d9 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 24 Apr 2019 09:31:59 -0600 Subject: [PATCH 061/106] make uppercase DEBUG lowercase --- src/ice_shelf/MOM_ice_shelf.F90 | 10 +++++----- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 3a27c988c9..9abebcfe9a 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -308,7 +308,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) if (CS%mass_from_file) call update_shelf_mass(G, CS, ISS, Time) endif - if (CS%DEBUG) then + if (CS%debug) then call hchksum(fluxes%frac_shelf_h, "frac_shelf_h before apply melting", G%HI, haloshift=0) call hchksum(state%sst, "sst before apply melting", G%HI, haloshift=0) call hchksum(state%sss, "sss before apply melting", G%HI, haloshift=0) @@ -633,7 +633,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call change_thickness_using_melt(ISS, G, time_step, fluxes, CS%density_ice, CS%debug) endif - if (CS%DEBUG) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) + if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) call add_shelf_flux(G, CS, state, fluxes) @@ -675,7 +675,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call cpu_clock_end(id_clock_shelf) - if (CS%DEBUG) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) + if (CS%debug) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) end subroutine shelf_calc_flux @@ -1043,7 +1043,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) endif enddo ; enddo - if (CS%DEBUG) then + if (CS%debug) then write(mesg,*) 'Mean melt flux (kg/(m^2 s)), dt = ', mean_melt_flux, CS%time_step call MOM_mesg(mesg) call MOM_forcing_chksum("After constant sea level", fluxes, G, haloshift=0) @@ -1483,7 +1483,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / G%areaT(i,j) enddo ; enddo ; endif - if (CS%DEBUG) then + if (CS%debug) then call hchksum(fluxes%frac_shelf_h, "IS init: frac_shelf_h", G%HI, haloshift=0) endif diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index eea9ee322a..eac698f67c 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -920,7 +920,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) call ice_shelf_solve_inner(CS, ISS, G, u, v, TAUDX, TAUDY, H_node, float_cond, & ISS%hmask, conv_flag, iters, time, Phi, Phisub) - if (CS%DEBUG) then + if (CS%debug) then call qchksum(u, "u shelf", G%HI, haloshift=2) call qchksum(v, "v shelf", G%HI, haloshift=2) endif @@ -3597,7 +3597,7 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) call pass_var(CS%t_shelf, G%domain) call pass_var(CS%tmask, G%domain) - if (CS%DEBUG) then + if (CS%debug) then call hchksum(CS%t_shelf, "temp after front", G%HI, haloshift=3) endif From d8b782526c66dfa37f6f9ba72ea5822c1ea79808 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 24 Apr 2019 09:33:56 -0600 Subject: [PATCH 062/106] fix uninitialized oneOrTwo --- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 7f33140fb7..e297af1411 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -869,6 +869,7 @@ subroutine VarMix_init(Time, G, GV, param_file, diag, CS) 'Depth average square of slope magnitude, S^2, at v-points, as used in Visbeck et al.', 's-2') endif + oneOrTwo = 1.0 if (CS%Resoln_scaled_Kh .or. CS%Resoln_scaled_KhTh .or. CS%Resoln_scaled_KhTr) then CS%calculate_Rd_dx = .true. CS%calculate_res_fns = .true. @@ -937,8 +938,6 @@ subroutine VarMix_init(Time, G, GV, param_file, diag, CS) "is the more appropriate definition.\n", default=.false.) if (Gill_equatorial_Ld) then oneOrTwo = 2.0 - else - oneOrTwo = 1.0 endif do J=js-1,Jeq ; do I=is-1,Ieq From ce5571fb1227c095cb6e8ff97adf96a1a9463302 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 24 Apr 2019 10:43:56 -0600 Subject: [PATCH 063/106] Add CS%US argument lost during merge conflict --- src/ice_shelf/MOM_ice_shelf.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 6e45f2b780..43987f8f63 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -650,7 +650,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) endif endif - if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) + if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, CS%US, haloshift=0) call add_shelf_flux(G, CS, state, fluxes) @@ -692,7 +692,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call cpu_clock_end(id_clock_shelf) - if (CS%debug) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) + if (CS%debug) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, CS%US, haloshift=0) end subroutine shelf_calc_flux From 0fcc576b9ab0e2fe8583f65ae08fcf4214668082 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 24 Apr 2019 16:50:20 -0600 Subject: [PATCH 064/106] use ESMF operators --- config_src/nuopc_driver/mom_cap.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 24e60388b4..9cf16c8a40 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -377,6 +377,7 @@ module mom_cap_mod use ESMF, only: ESMF_COORDSYS_SPH_DEG, ESMF_GridCreate, ESMF_INDEX_DELOCAL use ESMF, only: ESMF_MESHLOC_ELEMENT, ESMF_RC_VAL_OUTOFRANGE, ESMF_StateGet use ESMF, only: ESMF_TimePrint, ESMF_AlarmSet, ESMF_FieldGet +use ESMF, only: operator(==), operator(/=), operator(+), operator(-) ! TODO ESMF_GridCompGetInternalState does not have an explicit Fortran interface. !! Model does not compile with "use ESMF, only: ESMF_GridCompGetInternalState" From c24bfb399e067c8b3c07ddf4ae873320a31c3811 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Tue, 30 Apr 2019 10:07:29 -0600 Subject: [PATCH 065/106] Added Jansen et al. (2015) version of MEKE dissipation. Added an alternative way of calculating PE-to_MEKE energy conversion. --- src/parameterizations/lateral/MOM_MEKE.F90 | 92 ++++++++++++------- .../lateral/MOM_thickness_diffuse.F90 | 49 ++++++++-- 2 files changed, 100 insertions(+), 41 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index ebb202f65b..3aab80bfb5 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -38,6 +38,9 @@ module MOM_MEKE real :: MEKE_min_gamma!< Minimum value of gamma_b^2 allowed (non-dim) real :: MEKE_Ct !< Coefficient in the \f$\gamma_{bt}\f$ expression (non-dim) logical :: visc_drag !< If true use the vertvisc_type to calculate bottom drag. + logical :: Jansen15_drag !< If true use the bottom drag formulation from Jansen et al. (2015) + logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather + !! than the streamfunction for the MEKE GM source term. logical :: Rd_as_max_scale !< If true the length scale can not exceed the !! first baroclinic deformation radius. logical :: use_old_lscale !< Use the old formula for mixing length scale. @@ -114,6 +117,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) LmixScale, & ! Square of eddy mixing length, in m2. barotrFac2, & ! Ratio of EKE_barotropic / EKE (nondim)/ bottomFac2 ! Ratio of EKE_bottom / EKE (nondim)/ + real, dimension(SZIB_(G),SZJ_(G)) :: & MEKE_uflux, & ! The zonal diffusive flux of MEKE, in kg m2 s-3. Kh_u, & ! The zonal diffusivity that is actually used, in m2 s-1. @@ -289,9 +293,14 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) if (associated(MEKE%GM_src)) then !$OMP do - do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*MEKE%GM_src(i,j) - enddo ; enddo + if (CS%GM_src_alt) then + do j=js,je ; do i=is,ie + src(i,j) = src(i,j) - CS%MEKE_GMcoeff*MEKE%GM_src(i,j) / MAX(1.0,G%bathyT(i,j)) + enddo ; enddo + else + do j=js,je ; do i=is,ie + src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*MEKE%GM_src(i,j) + enddo ; enddo endif ! Increase EKE by a full time-steps worth of source @@ -303,22 +312,37 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) if (use_drag_rate) then ! Calculate a viscous drag rate (includes BBL contributions from mean flow and eddies) !$OMP do - do j=js,je ; do i=is,ie - drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & + if (CS%Jansen15_drag) then + do j=js,je ; do i=is,ie + drag_rate(i,j) = (cdrag2/MAX(1.0,G%bathyT(i,j))) * sqrt(CS%MEKE_Uscale**2 + drag_rate_visc(i,j)**2 + & + 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) * 2.0 * bottomFac2(i,j)*MEKE%MEKE(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) - enddo ; enddo + enddo ; enddo + endif endif ! First stage of Strang splitting !$OMP do - do j=js,je ; do i=is,ie - ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) - if (MEKE%MEKE(i,j)<0.) ldamping = 0. - ! notice that the above line ensures a damping only if MEKE is positive, - ! while leaving MEKE unchanged if it is negative - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) - MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) - enddo ; enddo + if (CS%Jansen15_drag) then + do j=js,je ; do i=is,ie + ldamping = CS%MEKE_damping + drag_rate(i,j) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - MIN(MEKE%MEKE(i,j),sdt_damp*drag_rate(i,j)) + MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) + if (MEKE%MEKE(i,j)<0.) ldamping = 0. + ! notice that the above line ensures a damping only if MEKE is positive, + ! while leaving MEKE unchanged if it is negative + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) + MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) + enddo ; enddo + endif !$OMP end parallel if (CS%MEKE_KH >= 0.0 .or. CS%KhMEKE_FAC > 0.0 .or. CS%MEKE_K4 >= 0.0) then @@ -473,30 +497,28 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) ! Recalculate the drag rate, since MEKE has changed. if (use_drag_rate) then !$OMP do - do j=js,je ; do i=is,ie - drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & - + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) - enddo ; enddo + if (CS%Jansen15_drag) then + do j=js,je ; do i=is,ie + ldamping = CS%MEKE_damping + drag_rate(i,j) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - MIN(MEKE%MEKE(i,j),sdt_damp*drag_rate(i,j)) + MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) + if (MEKE%MEKE(i,j)<0.) ldamping = 0. + ! notice that the above line ensures a damping only if MEKE is positive, + ! while leaving MEKE unchanged if it is negative + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) + MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) + enddo ; enddo + endif endif !$OMP do - do j=js,je ; do i=is,ie - ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) - if (MEKE%MEKE(i,j)<0.) ldamping = 0. - ! notice that the above line ensures a damping only if MEKE is positive, - ! while leaving MEKE unchanged if it is negative - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) - MEKE_decay(i,j) = 0.5 * G%mask2dT(i,j) * (MEKE_decay(i,j) + ldamping) - enddo ; enddo endif endif ! MEKE_KH>=0 !$OMP end parallel -! ! Ensure that MEKE is non-negative -! do j=js,je ; do i=is,ie -! MEKE%MEKE(i,j) = MAX(0.0, MEKE%MEKE(i,j)) -! enddo ; enddo - - call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_MEKE, G%Domain) call cpu_clock_end(CS%id_clock_pass) @@ -888,6 +910,12 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) call get_param(param_file, mdl, "MEKE_USCALE", CS%MEKE_Uscale, & "The background velocity that is combined with MEKE to \n"//& "calculate the bottom drag.", units="m s-1", default=0.0) + call get_param(param_file, mdl, "MEKE_JANSEN15_DRAG", CS%Jansen15_drag, & + "If true, use the bottom drag formulation from Jansen et al. (2015) \n"//& + "to calculate the drag acting on MEKE.", default=.false.) + call get_param(param_file, mdl, "MEKE_GM_SRC_ALT", CS%GM_src_alt, & + "If true, use the GM energy conversion form S^2*N^2*kappa rather \n"//& + "than the streamfunction for the MEKE GM source term.", default=.false.) call get_param(param_file, mdl, "MEKE_VISC_DRAG", CS%visc_drag, & "If true, use the vertvisc_type to calculate the bottom \n"//& "drag acting on MEKE.", default=.true.) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index cabcf1f9f2..1dfc466139 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -7,6 +7,7 @@ module MOM_thickness_diffuse use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, time_type use MOM_diag_mediator, only : diag_update_remap_grids +use MOM_domains, only : pass_var, CORNER, pass_vector use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_EOS, only : calculate_density, calculate_density_derivs use MOM_file_parser, only : get_param, log_version, param_file_type @@ -244,7 +245,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS !$OMP do if (CS%use_GME_thickness_diffuse) then - do k=1,nz ; do j=js,je ; do I=is-1,ie + do k=1,nz+1 ; do j=js,je ; do I=is-1,ie CS%KH_u_GME(I,j,k) = KH_u(I,j,k) enddo ; enddo ; enddo endif @@ -318,7 +319,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS !$OMP do if (CS%use_GME_thickness_diffuse) then - do k=1,nz ; do j=js-1,je ; do I=is,ie + do k=1,nz+1 ; do j=js-1,je ; do I=is,ie CS%KH_v_GME(I,j,k) = KH_v(I,j,k) enddo ; enddo ; enddo endif @@ -484,6 +485,14 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! by dt, in H m2 s-1. h_frac ! The fraction of the mass in the column above the bottom ! interface of a layer that is within a layer, ND. 0 nk_linear) then if (use_EOS) then - if (CS%use_FGNV_streamfn .or. .not.present_slope_x) then + if (CS%use_FGNV_streamfn .or. find_work .or. .not.present_slope_x) then hg2L = h(i,j,k-1)*h(i,j,k) + h_neglect2 hg2R = h(i+1,j,k-1)*h(i+1,j,k) + h_neglect2 haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect @@ -740,6 +756,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV int_slope_u(I,j,K) * GV%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) endif + + Slope_x_PE(I,j,k) = MIN(Slope,CS%slope_max) + hN2_x_PE(I,j,k) = hN2_u(I,K) * GV%m_to_Z if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope ! Estimate the streamfunction at each interface (m3 s-1). @@ -928,7 +947,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (k > nk_linear) then if (use_EOS) then - if (CS%use_FGNV_streamfn .or. .not.present_slope_y) then + if (CS%use_FGNV_streamfn .or. find_work .or. .not. present_slope_y) then hg2L = h(i,j,k-1)*h(i,j,k) + h_neglect2 hg2R = h(i,j+1,k-1)*h(i,j+1,k) + h_neglect2 haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect @@ -986,6 +1005,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV int_slope_v(i,J,K) * GV%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) endif + + Slope_y_PE(i,J,k) = MIN(Slope,CS%slope_max) + hN2_y_PE(i,J,k) = hN2_v(i,K) * GV%m_to_Z if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope ! Estimate the streamfunction at each interface (m3 s-1). @@ -1174,15 +1196,24 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV enddo endif - if (find_work) then ; do j=js,je ; do i=is,ie + + if (find_work) then ; do j=js,je ; do i=is,ie ; do k=nz,1,-1 ! Note that the units of Work_v and Work_u are W, while Work_h is W m-2. Work_h = 0.5 * G%IareaT(i,j) * & ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) + PE_release_h = -0.25*(Kh_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & + Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + & + Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k) + & + Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k)) if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h if (associated(MEKE)) then ; if (associated(MEKE%GM_src)) then - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + MIN(0.0,Work_h) + if (MEKE%GM_src_alt) then + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + PE_release_h + else + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h + endif endif ; endif - enddo ; enddo ; endif + enddo ; enddo ; enddo ; endif if (CS%id_slope_x > 0) call post_data(CS%id_slope_x, CS%diagSlopeX, CS%diag) if (CS%id_slope_y > 0) call post_data(CS%id_slope_y, CS%diagSlopeY, CS%diag) @@ -1899,11 +1930,11 @@ subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G) ! Local variables integer :: i,j,k - do k=1,G%ke ; do j = G%jsc, G%jec ; do I = G%isc-1, G%iec + do k=1,G%ke+1 ; do j = G%jsc, G%jec ; do I = G%isc-1, G%iec KH_u_GME(I,j,k) = CS%KH_u_GME(I,j,k) enddo ; enddo ; enddo - do k=1,G%ke ; do J = G%jsc-1, G%jec ; do i = G%isc, G%iec + do k=1,G%ke+1 ; do J = G%jsc-1, G%jec ; do i = G%isc, G%iec KH_v_GME(i,J,k) = CS%KH_v_GME(i,J,k) enddo ; enddo ; enddo From f6d1c65bf55093bcb46ab2f96c504c672f67e24e Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Tue, 30 Apr 2019 10:58:12 -0600 Subject: [PATCH 066/106] Fixed if statement in MOM_MEKE.F90. Added option to use alternative form of GM PE-to_MEKE energy conversion in MOM_thickness_diffuse. --- src/parameterizations/lateral/MOM_MEKE.F90 | 1 + src/parameterizations/lateral/MOM_MEKE_types.F90 | 1 + .../lateral/MOM_thickness_diffuse.F90 | 12 ++++++++---- 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 3aab80bfb5..0a966468c0 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -301,6 +301,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*MEKE%GM_src(i,j) enddo ; enddo + endif endif ! Increase EKE by a full time-steps worth of source diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 2b637af239..fadc21a71b 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -22,6 +22,7 @@ module MOM_MEKE_types real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr, nondim. real :: backscatter_Ro_pow = 0.0 !< Power in Rossby number function for backscatter. real :: backscatter_Ro_c = 0.0 !< Coefficient in Rossby number function for backscatter. + end type MEKE_type end module MOM_MEKE_types diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 1dfc466139..751a66f02d 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -55,6 +55,8 @@ module MOM_thickness_diffuse logical :: debug !< write verbose checksums for debugging purposes logical :: use_GME_thickness_diffuse !< If true, passes GM coefficients to MOM_hor_visc for use !! with GME closure. + logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather + !! than the streamfunction for the GM source term. type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity (W m-2) real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope (nondim) @@ -145,7 +147,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS endif use_VarMix = .false. ; Resoln_scaled = .false. ; use_stored_slopes = .false. - khth_use_ebt_struct = .false. + khth_use_ebt_struct = .false. ; use_Visbeck = .false. ; use_QG_Leith = .false. if (associated(VarMix)) then use_VarMix = VarMix%use_variable_mixing .and. (CS%KHTH_Slope_Cff > 0.) @@ -595,7 +597,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV find_work = .false. if (associated(MEKE)) find_work = associated(MEKE%GM_src) find_work = (associated(CS%GMwork) .or. find_work) - + if (use_EOS) then call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth, dt, T, S, G, GV, 1) endif @@ -1207,7 +1209,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k)) if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h if (associated(MEKE)) then ; if (associated(MEKE%GM_src)) then - if (MEKE%GM_src_alt) then + if (CS%GM_src_alt) then MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + PE_release_h else MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h @@ -1856,7 +1858,9 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) call get_param(param_file, mdl, "USE_GME", CS%use_GME_thickness_diffuse, & "If true, use the GM+E backscatter scheme in association \n"//& "with the Gent and McWilliams parameterization.", default=.false.) - + call get_param(param_file, mdl, "MEKE_GM_SRC_ALT", CS%GM_src_alt, & + "If true, use the GM energy conversion form S^2*N^2*kappa rather \n"//& + "than the streamfunction for the GM source term.", default=.false.) if (CS%use_GME_thickness_diffuse) then call safe_alloc_ptr(CS%KH_u_GME,G%IsdB,G%IedB,G%jsd,G%jed,G%ke+1) call safe_alloc_ptr(CS%KH_v_GME,G%isd,G%ied,G%JsdB,G%JedB,G%ke+1) From 3c91971f800eaba172a74b59c745318f0cfb63e5 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Tue, 30 Apr 2019 11:02:58 -0600 Subject: [PATCH 067/106] Added option to calculate MKE-to-MEKE energy conversion by GME. --- .../lateral/MOM_hor_visc.F90 | 196 +++++++++--------- 1 file changed, 99 insertions(+), 97 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index b73590f8e6..3b0a890c86 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -167,7 +167,7 @@ module MOM_hor_visc integer :: id_vort_xy_q = -1, id_div_xx_h = -1 integer :: id_FrictWork = -1, id_FrictWorkIntz = -1 integer :: id_FrictWorkMax = -1, id_target_FrictWork_GME = -1 - integer :: id_FrictWork_diss = -1 + integer :: id_FrictWork_diss = -1, id_FrictWork_GME !!@} @@ -245,8 +245,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points (m-1 s-1) grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points (m-1 s-1) grad_div_mag_h, & ! Magnitude of divergence gradient at h-points (m-1 s-1) - dudx, & - dvdy + dudx, dvdy ! components in the horizontal tension (s-1) real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) @@ -279,9 +278,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, Ah_h, & ! biharmonic viscosity at thickness points (m4/s) Kh_h, & ! Laplacian viscosity at thickness points (m2/s) FrictWork, & ! energy flux by parameterized shear production (W/m2) - FrictWork_diss, & ! energy dissipated by parameterized shear production (W/m2) - FrictWorkMax, & ! maximum possible energy dissipated by lateral friction (W/m2) - target_FrictWork_GME, & ! target amount of energy to add via GME (W/m2) + FrictWork_diss, & ! MKE dissipated by parameterized shear production (m3 s-3) + FrictWorkMax, & ! maximum possible energy dissipated by lateral friction (m3 s-3) + FrictWork_GME, & ! MKE added by parameterized shear production in GME (m3 s-3) + target_FrictWork_GME, & ! target amount of energy to add via GME (m3 s-3) div_xx_h ! horizontal divergence (s-1) !real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & @@ -337,7 +337,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, h_neglect3 = h_neglect**3 inv_PI3 = 1.0/((4.0*atan(1.0))**3) inv_PI6 = inv_PI3**2 - epsilon = 1.e-8 + epsilon = 1.e-7 if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then apply_OBC = OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally @@ -384,7 +384,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%use_GME) then ! GME tapers off above this depth H0 = 1000.0 - FWfrac = 1.0 + FWfrac = 0.1 ! initialize diag. array with zeros GME_coeff_h(:,:,:) = 0.0 GME_coeff_q(:,:,:) = 0.0 @@ -1034,14 +1034,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, do j=js,je ; do i=is,ie ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) - FrictWork_diss(i,j,k) = -Kh_h(i,j,k) * (dudx(i,j)**2 + dvdy(i,j)**2 + & + FrictWork_diss(i,j,k) = -Kh_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * & + (dudx(i,j)**2 + dvdy(i,j)**2 + & (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) - & Ah_h(i,j,k) * ((0.5*(u0(I,j) + u0(I-1,j)))**2 + & (0.5*(v0(i,J) + v0(i,J-1)))**2) if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then - FrictWorkMax(i,j,k) = 2.0*MEKE%MEKE(i,j) * sqrt(dudx(i,j)**2 + dvdy(i,j)**2 + & + FrictWorkMax(i,j,k) = 2.0*MEKE%MEKE(i,j) * h(i,j,k) * GV%H_to_kg_m2 * & + sqrt(dudx(i,j)**2 + dvdy(i,j)**2 + & (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) @@ -1063,15 +1065,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & - KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & - (0.5*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)),0.0) * & - ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & - (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) / & - ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & - (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & - (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & - epsilon)) +! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & +! KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & +! (0.5*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)),0.0) * & +! ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & +! (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) / & +! ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & +! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & +! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & +! epsilon)) ! GME_coeff = 2.0 * (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & ! KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & @@ -1081,63 +1083,46 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & ! epsilon) -! GME_coeff = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / & -! SQRT( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & -! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & -! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & -! epsilon) - -! if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then -! GME_coeff = target_FrictWork_GME(i,j,k) / ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & + if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then +! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * target_FrictWork_GME(i,j,k) / ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & ! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & ! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & ! epsilon) -! endif ; endif + GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * target_FrictWork_GME(i,j,k) * G%areaT(i,j) / & + (0.1**2) -! ! apply mask -! GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) +! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * MEKE%MEKE(i,j) / MAX(0.25*(VarMix%SN_u(I,j)+VarMIX%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)),epsilon) - GME_coeff_limiter = 1e6 ! 1e8 -! GME_coeff_limiter = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / sqrt(dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & -! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & -! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + epsilon) +! (0.5*(ubtav(i,j)**2 + vbtav(i,j)**2)) + endif ; endif + + ! apply mask + GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) + + GME_coeff_limiter = 2e5 ! 1e6 ! simple way to limit this coeff GME_coeff = MIN(GME_coeff,GME_coeff_limiter) - if (CS%id_GME_coeff_h>0) GME_coeff_h(i,j,k) = GME_coeff + if ((CS%id_GME_coeff_h>0) .or. find_FrictWork) GME_coeff_h(i,j,k) = GME_coeff str_xx_GME(i,j) = GME_coeff * sh_xx_bt(i,j) enddo ; enddo - endif ! CS%use_GME - ! applying GME diagonal term - if (CS%use_GME) then - call smooth_GME(CS,G,GME_flux_h=str_xx_GME) - do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - str_xx(i,j) = (str_xx(i,j) + str_xx_GME(i,j)) * (h(i,j,k) * CS%reduction_xx(i,j)) - enddo ; enddo - else - do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - str_xx(i,j) = str_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) - enddo ; enddo - endif - - if (CS%use_GME) then do J=js-1,Jeq ; do I=is-1,Ieq - GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & - KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & - ( 0.25*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & - VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)),0.0) * & - ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I,j+1,k)) )**2 + & - (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i+1,J,k)) )**2 ) / & - ( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & - (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & - (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & - epsilon)) +! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & +! KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & +! ( 0.25*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & +! VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)),0.0) * & +! ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I,j+1,k)) )**2 + & +! (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i+1,J,k)) )**2 ) / & +! ( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & +! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & +! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & +! epsilon)) ! GME_coeff = 2.0 * (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & ! KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & @@ -1147,27 +1132,23 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & ! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & ! epsilon) - -! GME_coeff = 2.0* MAX(0.0,MEKE%MEKE(i,j)) / & -! SQRT( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & -! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & -! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & -! epsilon) - -! if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then -! GME_coeff = target_FrictWork_GME(i,j,k) / (dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & + + if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then +! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * target_FrictWork_GME(i,j,k) / (dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & ! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & ! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & ! epsilon) -! endif ; endif + GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * target_FrictWork_GME(i,j,k) * G%areaT(i,j) / & + (0.1**2) +! +! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * MEKE%MEKE(i,j) / MAX(0.25*(VarMix%SN_u(I,j)+VarMIX%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)),epsilon) +! + endif ; endif ! apply mask GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) - GME_coeff_limiter = 1e6 !1e8 -! GME_coeff_limiter = 2.0 * MAX(0.0,MEKE%MEKE(i,j)) / sqrt( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & -! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & -! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + epsilon) + GME_coeff_limiter = 2e5 ! 1e6 ! simple way to limit this coeff GME_coeff = MIN(GME_coeff,GME_coeff_limiter) @@ -1176,14 +1157,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) enddo ; enddo - endif ! applying GME diagonal term - if (CS%use_GME) then + call smooth_GME(CS,G,GME_flux_h=str_xx_GME) call smooth_GME(CS,G,GME_flux_q=str_xy_GME) - endif - if (CS%use_GME) then + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + str_xx(i,j) = (str_xx(i,j) + str_xx_GME(i,j)) * (h(i,j,k) * CS%reduction_xx(i,j)) + enddo ; enddo + do J=js-1,Jeq ; do I=is-1,Ieq ! GME is applied below if (CS%no_slip) then @@ -1192,7 +1174,21 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, str_xy(I,J) = (str_xy(I,J) + str_xy_GME(I,J)) * (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif enddo ; enddo - else + + if (find_FrictWork) then + do j=js,je ; do i=is,ie + ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) + FrictWork_GME(i,j,k) = GME_coeff_h(i,j,k) * h(i,j,k) * (dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & + (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & + (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2) + enddo ; enddo + endif + + else ! use_GME + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + str_xx(i,j) = str_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) + enddo ; enddo + do J=js-1,Jeq ; do I=is-1,Ieq if (CS%no_slip) then str_xy(I,J) = str_xy(I,J) * (hq(I,J) * CS%reduction_xy(I,J)) @@ -1200,7 +1196,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, str_xy(I,J) = str_xy(I,J) * (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif enddo ; enddo - endif + + endif ! use_GME + ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. @@ -1246,24 +1244,24 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo endif - if (find_FrictWork) then ; do j=js,je ; do i=is,ie - ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) - FrictWork(i,j,k) = GV%H_to_kg_m2 * ( & - (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & - -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & - +0.25*((str_xy(I,J)*( & - (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & - +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & - +str_xy(I-1,J-1)*( & - (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & - +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & - +(str_xy(I-1,J)*( & - (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & - +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & - +str_xy(I,J-1)*( & - (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & - +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) - enddo ; enddo ; endif +! if (find_FrictWork) then ; do j=js,je ; do i=is,ie +! ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) +! FrictWork(i,j,k) = GV%H_to_kg_m2 * ( & +! (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & +! -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & +! +0.25*((str_xy(I,J)*( & +! (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & +! +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & +! +str_xy(I-1,J-1)*( & +! (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & +! +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & +! +(str_xy(I-1,J)*( & +! (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & +! +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & +! +str_xy(I,J-1)*( & +! (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & +! +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) +! enddo ; enddo ; endif ! Make a similar calculation as for FrictWork above but accumulating into ! the vertically integrated MEKE source term, and adjusting for any @@ -1318,6 +1316,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%id_FrictWork>0) call post_data(CS%id_FrictWork, FrictWork, CS%diag) if (CS%id_FrictWorkMax>0) call post_data(CS%id_FrictWorkMax, FrictWorkMax, CS%diag) if (CS%id_FrictWork_diss>0) call post_data(CS%id_FrictWork_diss, FrictWork_diss, CS%diag) + if (CS%id_FrictWork_GME>0) call post_data(CS%id_FrictWork_GME, FrictWork_GME, CS%diag) if (CS%id_target_FrictWork_GME>0) call post_data(CS%id_target_FrictWork_GME, target_FrictWork_GME, CS%diag) if (CS%id_Ah_h>0) call post_data(CS%id_Ah_h, Ah_h, CS%diag) if (CS%id_div_xx_h>0) call post_data(CS%id_div_xx_h, div_xx_h, CS%diag) @@ -2016,6 +2015,9 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) CS%id_target_FrictWork_GME = register_diag_field('ocean_model','target_FrictWork_GME',diag%axesTL,Time,& 'Target for the amount of integral work done by lateral friction terms in GME', 'W m-2') + + CS%id_FrictWork_GME = register_diag_field('ocean_model','FrictWork_GME',diag%axesTL,Time,& + 'Integral work done by lateral friction terms in GME (excluding diffusion of energy)', 'W m-2') endif CS%id_FrictWork = register_diag_field('ocean_model','FrictWork',diag%axesTL,Time,& From 73e89ec2ebd7ce9b37700b2439633c3146a204c7 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Tue, 30 Apr 2019 11:15:52 -0600 Subject: [PATCH 068/106] Cleaned up MOM_hor_visc.F90 a bit, especially parts having to do with calculating FrictWork. --- .../lateral/MOM_hor_visc.F90 | 42 ++++++++++--------- 1 file changed, 23 insertions(+), 19 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 3b0a890c86..ba1383668c 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1033,7 +1033,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, call pass_var(dudy, G%Domain, position=CORNER, complete=.true.) do j=js,je ; do i=is,ie - ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) + ! Diagnose -Kh * |del u|^2 - Ah * |del^2 u|^2 FrictWork_diss(i,j,k) = -Kh_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * & (dudx(i,j)**2 + dvdy(i,j)**2 + & (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & @@ -1042,6 +1042,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (0.5*(v0(i,J) + v0(i,J-1)))**2) if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then + ! This is the maximum possible amount of energy that can be converted + ! per unit time, according to theory (multiplied by h) FrictWorkMax(i,j,k) = 2.0*MEKE%MEKE(i,j) * h(i,j,k) * GV%H_to_kg_m2 * & sqrt(dudx(i,j)**2 + dvdy(i,j)**2 + & (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & @@ -1244,24 +1246,25 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo endif -! if (find_FrictWork) then ; do j=js,je ; do i=is,ie -! ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) -! FrictWork(i,j,k) = GV%H_to_kg_m2 * ( & -! (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & -! -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & -! +0.25*((str_xy(I,J)*( & -! (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & -! +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & -! +str_xy(I-1,J-1)*( & -! (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & -! +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & -! +(str_xy(I-1,J)*( & -! (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & -! +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & -! +str_xy(I,J-1)*( & -! (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & -! +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) -! enddo ; enddo ; endif + if (find_FrictWork) then ; do j=js,je ; do i=is,ie + ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) + ! This is the old formulation that includes energy diffusion + FrictWork(i,j,k) = GV%H_to_kg_m2 * ( & + (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & + -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & + +0.25*((str_xy(I,J)*( & + (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & + +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & + +str_xy(I-1,J-1)*( & + (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & + +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & + +(str_xy(I-1,J)*( & + (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & + +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & + +str_xy(I,J-1)*( & + (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & + +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) + enddo ; enddo ; endif ! Make a similar calculation as for FrictWork above but accumulating into ! the vertically integrated MEKE source term, and adjusting for any @@ -1303,6 +1306,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo else do j=js,je ; do i=is,ie + ! MEKE%mom_src now is sign definite because it only uses the dissipation MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork_diss(i,j,k) enddo ; enddo endif From 6b321744f269f725568634e68280150507f7633e Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Thu, 2 May 2019 11:45:10 -0600 Subject: [PATCH 069/106] Added biharmonic option for MEKE viscosity. --- src/parameterizations/lateral/MOM_MEKE.F90 | 32 +++- .../lateral/MOM_MEKE_types.F90 | 1 + .../lateral/MOM_hor_visc.F90 | 170 ++++++++++++++---- 3 files changed, 161 insertions(+), 42 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 0a966468c0..d44bf88c32 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -74,7 +74,7 @@ module MOM_MEKE integer :: id_MEKE = -1, id_Ue = -1, id_Kh = -1, id_src = -1 integer :: id_Ub = -1, id_Ut = -1 integer :: id_GM_src = -1, id_mom_src = -1, id_decay = -1 - integer :: id_KhMEKE_u = -1, id_KhMEKE_v = -1, id_Ku = -1 + integer :: id_KhMEKE_u = -1, id_KhMEKE_v = -1, id_Ku = -1, id_Au = -1 integer :: id_Le = -1, id_gamma_b = -1, id_gamma_t = -1 integer :: id_Lrhines = -1, id_Leady = -1 !!@} @@ -84,6 +84,7 @@ module MOM_MEKE type(group_pass_type) :: pass_MEKE !< Type for group halo pass calls type(group_pass_type) :: pass_Kh !< Type for group halo pass calls type(group_pass_type) :: pass_Ku !< Type for group halo pass calls + type(group_pass_type) :: pass_Au !< Type for group halo pass calls type(group_pass_type) :: pass_del2MEKE !< Type for group halo pass calls end type MEKE_CS @@ -555,9 +556,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) if (CS%viscosity_coeff/=0.) then do j=js,je ; do i=is,ie MEKE%Ku(i,j) = CS%viscosity_coeff*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j) + MEKE%Au(i,j) = CS%viscosity_coeff*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j)**3 enddo ; enddo call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_Ku, G%Domain) + call do_group_pass(CS%pass_Au, G%Domain) call cpu_clock_end(CS%id_clock_pass) endif @@ -568,6 +571,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) if (CS%id_Ut>0) call post_data(CS%id_Ut, sqrt(max(0.,2.0*MEKE%MEKE*barotrFac2)), CS%diag) if (CS%id_Kh>0) call post_data(CS%id_Kh, MEKE%Kh, CS%diag) if (CS%id_Ku>0) call post_data(CS%id_Ku, MEKE%Ku, CS%diag) + if (CS%id_Au>0) call post_data(CS%id_Au, MEKE%Au, CS%diag) if (CS%id_KhMEKE_u>0) call post_data(CS%id_KhMEKE_u, Kh_u, CS%diag) if (CS%id_KhMEKE_v>0) call post_data(CS%id_KhMEKE_v, Kh_v, CS%diag) if (CS%id_src>0) call post_data(CS%id_src, src, CS%diag) @@ -708,7 +712,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) else EKE = 0. endif - MEKE%MEKE(i,j) = EKE +! MEKE%MEKE(i,j) = EKE + MEKE%MEKE(i,j) = (G%Zd_to_m*G%bathyT(i,j)*SN / (8*CS%cdrag))**2 enddo ; enddo end subroutine MEKE_equilibrium @@ -828,7 +833,7 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. ! Local variables integer :: is, ie, js, je, isd, ied, jsd, jed, nz - logical :: laplacian, useVarMix, coldStart + logical :: laplacian, biharmonic, useVarMix, coldStart ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_MEKE" ! This module's name. @@ -989,8 +994,10 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "the velocity field to the bottom stress.", units="nondim", & default=0.003) call get_param(param_file, mdl, "LAPLACIAN", laplacian, default=.false., do_not_log=.true.) - if (CS%viscosity_coeff/=0. .and. .not. laplacian) call MOM_error(FATAL, & - "LAPLACIAN must be true if MEKE_VISCOSITY_COEFF is true.") + call get_param(param_file, mdl, "BIHARMONIC", biharmonic, default=.false., do_not_log=.true.) + + if (CS%viscosity_coeff/=0. .and. .not. laplacian .and. .not. biharmonic) call MOM_error(FATAL, & + "Either LAPLACIAN or BIHARMONIC must be true if MEKE_VISCOSITY_COEFF is true.") call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) @@ -1012,6 +1019,10 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) call create_group_pass(CS%pass_Ku, MEKE%Ku, G%Domain) call do_group_pass(CS%pass_Ku, G%Domain) endif + if (associated(MEKE%Au)) then + call create_group_pass(CS%pass_Au, MEKE%Au, G%Domain) + call do_group_pass(CS%pass_Au, G%Domain) + endif if (allocated(CS%del2MEKE)) then call create_group_pass(CS%pass_del2MEKE, CS%del2MEKE, G%Domain) call do_group_pass(CS%pass_del2MEKE, G%Domain) @@ -1028,6 +1039,9 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) CS%id_Ku = register_diag_field('ocean_model', 'MEKE_KU', diag%axesT1, Time, & 'MEKE derived lateral viscosity', 'm2 s-1') if (.not. associated(MEKE%Ku)) CS%id_Ku = -1 + CS%id_Au = register_diag_field('ocean_model', 'MEKE_AU', diag%axesT1, Time, & + 'MEKE derived lateral biharmonic viscosity', 'm4 s-1') + if (.not. associated(MEKE%Au)) CS%id_Au = -1 CS%id_Ue = register_diag_field('ocean_model', 'MEKE_Ue', diag%axesT1, Time, & 'MEKE derived eddy-velocity scale', 'm s-1') if (.not. associated(MEKE%MEKE)) CS%id_Ue = -1 @@ -1127,9 +1141,14 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) allocate(MEKE%Rd_dx_h(isd:ied,jsd:jed)) ; MEKE%Rd_dx_h(:,:) = 0.0 if (MEKE_viscCoeff/=0.) then allocate(MEKE%Ku(isd:ied,jsd:jed)) ; MEKE%Ku(:,:) = 0.0 - vd = var_desc("MEKE_Ah", "m2 s-1", hor_grid='h', z_grid='1', & + vd = var_desc("MEKE_Ku", "m2 s-1", hor_grid='h', z_grid='1', & longname="Lateral viscosity from Mesoscale Eddy Kinetic Energy") call register_restart_field(MEKE%Ku, vd, .false., restart_CS) + + allocate(MEKE%Au(isd:ied,jsd:jed)) ; MEKE%Au(:,:) = 0.0 + vd = var_desc("MEKE_Au", "m4 s-1", hor_grid='h', z_grid='1', & + longname="Lateral biharmonic viscosity from Mesoscale Eddy Kinetic Energy") + call register_restart_field(MEKE%Au, vd, .false., restart_CS) endif end subroutine MEKE_alloc_register_restart @@ -1149,6 +1168,7 @@ subroutine MEKE_end(MEKE, CS) if (associated(MEKE%mom_src)) deallocate(MEKE%mom_src) if (associated(MEKE%Kh)) deallocate(MEKE%Kh) if (associated(MEKE%Ku)) deallocate(MEKE%Ku) + if (associated(MEKE%Au)) deallocate(MEKE%Au) if (allocated(CS%del2MEKE)) deallocate(CS%del2MEKE) deallocate(MEKE) diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index fadc21a71b..26257360b5 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -17,6 +17,7 @@ module MOM_MEKE_types real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient in m2 s-1. !! This viscosity can be negative when representing backscatter !! from unresolved eddies (see Jansen and Held, 2014). + real, dimension(:,:), pointer :: Au => NULL() !< The MEKE-derived lateral biharmonic viscosity coefficient in m4 s-1. ! Parameters real :: KhTh_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTh, nondim real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr, nondim. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index ba1383668c..94094759ed 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -245,7 +245,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points (m-1 s-1) grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points (m-1 s-1) grad_div_mag_h, & ! Magnitude of divergence gradient at h-points (m-1 s-1) - dudx, dvdy ! components in the horizontal tension (s-1) + dudx, dvdy, & ! components in the horizontal tension (s-1) + grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points (s-2) + grad_vel_mag_bt_h, & ! Magnitude of the barotropic velocity gradient tensor squared at h-points (s-2) + max_diss_rate_bt ! maximum possible energy dissipated by barotropic lateral friction (m2 s-3) real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) @@ -262,7 +265,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points (m-1 s-1) grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points (m-1 s-1) grad_div_mag_q, & ! Magnitude of divergence gradient at q-points (m-1 s-1) - hq ! harmonic mean of the harmonic means of the u- & v point thicknesses, in H; This form guarantees that hq/hu < 4. + grad_vel_mag_q, & ! Magnitude of the velocity gradient tensor squared at q-points (s-2) + hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses, in H; This form guarantees that hq/hu < 4. + grad_vel_mag_bt_q ! Magnitude of the barotropic velocity gradient tensor squared at q-points (s-2) real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & Ah_q, & ! biharmonic viscosity at corner points (m4/s) @@ -277,11 +282,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points (m4/s) Kh_h, & ! Laplacian viscosity at thickness points (m2/s) - FrictWork, & ! energy flux by parameterized shear production (W/m2) - FrictWork_diss, & ! MKE dissipated by parameterized shear production (m3 s-3) - FrictWorkMax, & ! maximum possible energy dissipated by lateral friction (m3 s-3) - FrictWork_GME, & ! MKE added by parameterized shear production in GME (m3 s-3) - target_FrictWork_GME, & ! target amount of energy to add via GME (m3 s-3) + diss_rate, & ! MKE dissipated by parameterized shear production (m2 s-3) + max_diss_rate, & ! maximum possible energy dissipated by lateral friction (m2 s-3) + target_diss_rate_GME, & ! target amount of energy to add via GME (m2 s-3) + FrictWork, & ! work done by MKE dissipation mechanisms (W/m2) + FrictWork_diss, & ! negative definite work done by MKE dissipation mechanisms (W/m2) + FrictWorkMax, & ! maximum possible work done by MKE dissipation mechanisms (W/m2) + FrictWork_GME, & ! work done by GME (W/m2) + target_FrictWork_GME, & ! target amount of work for GME to do (W/m2) div_xx_h ! horizontal divergence (s-1) !real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & @@ -322,11 +330,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real :: FWfrac real :: DY_dxBu, DX_dyBu real :: H0 - real :: tmp + real :: dr, dv logical :: rescale_Kh, legacy_bound logical :: find_FrictWork logical :: apply_OBC = .false. logical :: use_MEKE_Ku + logical :: use_MEKE_Au integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k, n real :: inv_PI3, inv_PI6 @@ -367,11 +376,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! Toggle whether to use a Laplacian viscosity derived from MEKE use_MEKE_Ku = associated(MEKE%Ku) + use_MEKE_Au = associated(MEKE%Au) !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & -!$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, hq, & +!$OMP find_FrictWork,FrictWork,use_MEKE_Ku, +!$OMP use_MEKE_Au, MEKE, hq, & !$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & @@ -432,6 +443,25 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, call thickness_diffuse_get_KH(thickness_diffuse, KH_u_GME, KH_v_GME, G) + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + grad_vel_mag_bt_h(i,j) = dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & + (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & + (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + enddo ; enddo + + if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + max_diss_rate_bt(i,j) = 2.0*MEKE%MEKE(i,j) * grad_vel_mag_bt_h(i,j) + enddo ; enddo + endif ; endif + + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + grad_vel_mag_bt_q(I,J) = dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & + (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & + (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + enddo ; enddo + + ! halo updates call pass_vector(KH_u_GME, KH_v_GME, G%Domain) call pass_vector(VarMix%slope_x, VarMix%slope_y, G%Domain) @@ -461,6 +491,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo + if ((find_FrictWork) .or. (CS%use_GME)) then + do j=js,je ; do i=is,ie + grad_vel_mag_h(i,j) = (dudx(i,j)**2 + dvdy(i,j)**2 + & + (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & + (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) + enddo ; enddo + endif + ! Interpolate the thicknesses to velocity points. ! The extra wide halos are to accommodate the cross-corner-point projections ! in OBCs, which are not ordinarily be necessary, and might not be necessary @@ -815,6 +853,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, str_xx(i,j) = -Kh * sh_xx(i,j) else ! not Laplacian + Kh_h(i,j,k) = 0.0 str_xx(i,j) = 0.0 endif ! Laplacian @@ -846,6 +885,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, Ah = CS%Ah_bg_xx(i,j) endif ! Smagorinsky_Ah or Leith_Ah + if (use_MEKE_Au) Ah = Ah + MEKE%Au(i,j) ! *Add* the MEKE contribution + if (CS%better_bound_Ah) then Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j)) endif @@ -862,6 +903,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) bhstr_xx(i,j) = bhstr_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) + else + Ah_h(i,j,k) = 0.0 endif ! biharmonic enddo ; enddo @@ -1008,6 +1051,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, else Ah = CS%Ah_bg_xy(I,J) endif ! Smagorinsky_Ah or Leith_Ah + + if (use_MEKE_Au) then ! *Add* the MEKE contribution + Ah = Ah + 0.25*( (MEKE%Au(I,J)+MEKE%Au(I+1,J+1)) & + +(MEKE%Au(I+1,J)+MEKE%Au(I,J+1)) ) + endif + if (CS%better_bound_Ah) then Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xy(I,J)) endif @@ -1034,28 +1083,26 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, do j=js,je ; do i=is,ie ! Diagnose -Kh * |del u|^2 - Ah * |del^2 u|^2 - FrictWork_diss(i,j,k) = -Kh_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * & - (dudx(i,j)**2 + dvdy(i,j)**2 + & - (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & - (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) - & + diss_rate(i,j,k) = -Kh_h(i,j,k) * grad_vel_mag_h(i,j) - & Ah_h(i,j,k) * ((0.5*(u0(I,j) + u0(I-1,j)))**2 + & (0.5*(v0(i,J) + v0(i,J-1)))**2) + FrictWork_diss(i,j,k) = diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then ! This is the maximum possible amount of energy that can be converted ! per unit time, according to theory (multiplied by h) - FrictWorkMax(i,j,k) = 2.0*MEKE%MEKE(i,j) * h(i,j,k) * GV%H_to_kg_m2 * & - sqrt(dudx(i,j)**2 + dvdy(i,j)**2 + & - (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & - (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) + max_diss_rate(i,j,k) = 2.0*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) + + FrictWorkMax(i,j,k) = max_diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 ! Determine how much work GME needs to do to reach the "target" ratio between ! the amount of work actually done and the maximum allowed by theory. Note that ! we need to add the FrictWork done by the dissipation operators, since this work ! is done only for numerical stability and is therefore spurious if (CS%use_GME) then - target_FrictWork_GME(i,j,k) = FWfrac * FrictWorkMax(i,j,k) - FrictWork_diss(i,j,k) - endif + target_diss_rate_GME(i,j,k) = FWfrac * max_diss_rate(i,j,k) - diss_rate(i,j,k) + target_FrictWork_GME(i,j,k) = target_diss_rate_GME(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 + endif endif ; endif @@ -1090,20 +1137,38 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & ! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & ! epsilon) - GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * target_FrictWork_GME(i,j,k) * G%areaT(i,j) / & - (0.1**2) +! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * max_diss_rate(i,j,k) * (G%areaT(i,j)/0.01) ! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * MEKE%MEKE(i,j) / MAX(0.25*(VarMix%SN_u(I,j)+VarMIX%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)),epsilon) + GME_coeff = 1e10; dr = 1e6 + +! if (G%mask2dT(i,j)) +! do while (dr >= max_diss_rate(i,j,k)) +! GME_coeff = GME_coeff / 2.0 + dr = GME_coeff * grad_vel_mag_h(i,j) + + if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_h(i,j)>0) ) then + GME_coeff = FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_h(i,j) +! GME_coeff = max_diss_rate_bt(i,j) / grad_vel_mag_bt_h(i,j) + else + GME_coeff = 0.0 + endif + +! GME_coeff = (MIN(G%bathyT(i,j)*G%Zd_to_m/H0,1.0)**2)*GME_coeff + +! GME_coeff = 10.0 +! enddo +! else +! GME_coeff = 0.0 +! endif + -! (0.5*(ubtav(i,j)**2 + vbtav(i,j)**2)) endif ; endif ! apply mask GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) - GME_coeff_limiter = 2e5 ! 1e6 - - ! simple way to limit this coeff + GME_coeff_limiter = 1e7 GME_coeff = MIN(GME_coeff,GME_coeff_limiter) if ((CS%id_GME_coeff_h>0) .or. find_FrictWork) GME_coeff_h(i,j,k) = GME_coeff @@ -1140,19 +1205,49 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & ! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & ! epsilon) - GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * target_FrictWork_GME(i,j,k) * G%areaT(i,j) / & - (0.1**2) +! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * target_diss_rate_GME(i,j,k) * G%areaT(i,j) / & +! (0.1**2) +! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * target_diss_rate_GME(i,j,k) * sqrt(G%areaT(i,j))/0.0001 ! ! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * MEKE%MEKE(i,j) / MAX(0.25*(VarMix%SN_u(I,j)+VarMIX%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)),epsilon) ! + +! if (G%mask2dT(i,j)) + GME_coeff = 1e10; dr = 1e6 + + if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_q(i,j)>0) ) then + GME_coeff = FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_q(I,J) +! GME_coeff = max_diss_rate_bt(i,j) / grad_vel_mag_bt_q(I,J) + else + GME_coeff = 0.0 + endif + +! dr = GME_coeff * bt_grad_mag_q(I,J) +! if ((max_diss_rate(i,j,k) > 0) .and. (dr>0) ) then +! dv = dr / (FWfrac*max_diss_rate(i,j,k)) +! GME_coeff = GME_coeff / dv +! else +! GME_coeff = 0.0 +! endif + +! GME_coeff = (MIN(G%bathyT(i,j)*G%Zd_to_m/H0,1.0)**2)*GME_coeff +! do while (dr >= max_diss_rate(i,j,k)) +! GME_coeff = GME_coeff / 2.0 +! dr = GME_coeff * (dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & +! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & +! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2) +! enddo +! else +! GME_coeff = 0.0 +! endif +! GME_coeff = 10.0 + endif ; endif ! apply mask GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) - - GME_coeff_limiter = 2e5 ! 1e6 - - ! simple way to limit this coeff + + GME_coeff_limiter = 1e7 GME_coeff = MIN(GME_coeff,GME_coeff_limiter) if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff @@ -1179,10 +1274,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (find_FrictWork) then do j=js,je ; do i=is,ie - ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) - FrictWork_GME(i,j,k) = GME_coeff_h(i,j,k) * h(i,j,k) * (dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & - (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & - (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2) + FrictWork_GME(i,j,k) = GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * grad_vel_mag_bt_h(i,j) enddo ; enddo endif @@ -1307,8 +1399,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, else do j=js,je ; do i=is,ie ! MEKE%mom_src now is sign definite because it only uses the dissipation - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork_diss(i,j,k) + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + MAX(-FrictWorkMax(i,j,k),FrictWork_diss(i,j,k)) enddo ; enddo + if (CS%use_GME) then + do j=js,je ; do i=is,ie + ! MEKE%mom_src now is sign definite because it only uses the dissipation + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork_GME(i,j,k) + enddo ; enddo + endif endif endif ; endif From 80c65c72421ecbb9945021ed8600a7ac305256c8 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Fri, 3 May 2019 10:35:37 -0600 Subject: [PATCH 070/106] Added a GME sink term to the MEKE budget. Cleaned up MOM_hor_visc.F90. --- src/parameterizations/lateral/MOM_MEKE.F90 | 27 ++- .../lateral/MOM_MEKE_types.F90 | 1 + .../lateral/MOM_hor_visc.F90 | 167 ++++-------------- 3 files changed, 61 insertions(+), 134 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index d44bf88c32..a02eed93af 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -30,6 +30,7 @@ module MOM_MEKE ! Parameters real :: MEKE_FrCoeff !< Efficiency of conversion of ME into MEKE (non-dim) real :: MEKE_GMcoeff !< Efficiency of conversion of PE into MEKE (non-dim) + real :: MEKE_GMECoeff !< Efficiency of conversion of MEKE into ME by GME (non-dim) real :: MEKE_damping !< Local depth-independent MEKE dissipation rate in s-1. real :: MEKE_Cd_scale !< The ratio of the bottom eddy velocity to the column mean !! eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 @@ -73,7 +74,7 @@ module MOM_MEKE !>@{ Diagnostic handles integer :: id_MEKE = -1, id_Ue = -1, id_Kh = -1, id_src = -1 integer :: id_Ub = -1, id_Ut = -1 - integer :: id_GM_src = -1, id_mom_src = -1, id_decay = -1 + integer :: id_GM_src = -1, id_mom_src = -1, id_GME_snk = -1, id_decay = -1 integer :: id_KhMEKE_u = -1, id_KhMEKE_v = -1, id_Ku = -1, id_Au = -1 integer :: id_Le = -1, id_gamma_b = -1, id_gamma_t = -1 integer :: id_Lrhines = -1, id_Leady = -1 @@ -113,6 +114,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) MEKE_decay, & ! The MEKE decay timescale, in s-1. MEKE_GM_src, & ! The MEKE source from thickness mixing, in m2 s-3. MEKE_mom_src, & ! The MEKE source from momentum, in m2 s-3. + MEKE_GME_snk, & ! The MEKE sink from GME backscatter, in m2 s-3. drag_rate_visc, & drag_rate, & ! The MEKE spindown timescale due to bottom drag, in s-1. LmixScale, & ! Square of eddy mixing length, in m2. @@ -165,6 +167,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) if (CS%debug) then if (associated(MEKE%mom_src)) call hchksum(MEKE%mom_src, 'MEKE mom_src',G%HI) + if (associated(MEKE%GME_snk)) call hchksum(MEKE%GME_snk, 'MEKE GME_snk',G%HI) if (associated(MEKE%GM_src)) call hchksum(MEKE%GM_src, 'MEKE GM_src',G%HI) if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE',G%HI) call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI) @@ -292,6 +295,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) enddo ; enddo endif + if (associated(MEKE%GME_snk)) then +!$OMP do + do j=js,je ; do i=is,ie + src(i,j) = src(i,j) - CS%MEKE_GMECoeff*I_mass(i,j)*MEKE%GME_snk(i,j) + enddo ; enddo + endif + if (associated(MEKE%GM_src)) then !$OMP do if (CS%GM_src_alt) then @@ -578,6 +588,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) if (CS%id_decay>0) call post_data(CS%id_decay, MEKE_decay, CS%diag) if (CS%id_GM_src>0) call post_data(CS%id_GM_src, MEKE%GM_src, CS%diag) if (CS%id_mom_src>0) call post_data(CS%id_mom_src, MEKE%mom_src, CS%diag) + if (CS%id_GME_snk>0) call post_data(CS%id_GME_snk, MEKE%GME_snk, CS%diag) if (CS%id_Le>0) call post_data(CS%id_Le, LmixScale, CS%diag) if (CS%id_gamma_b>0) then do j=js,je ; do i=is,ie @@ -892,6 +903,10 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "The efficiency of the conversion of mean energy into \n"//& "MEKE. If MEKE_FRCOEFF is negative, this conversion \n"//& "is not used or calculated.", units="nondim", default=-1.0) + call get_param(param_file, mdl, "MEKE_GMECOEFF", CS%MEKE_GMECoeff, & + "The efficiency of the conversion of MEKE into mean energy \n"//& + "by GME. If MEKE_GMECOEFF is negative, this conversion \n"//& + "is not used or calculated.", units="nondim", default=-1.0) call get_param(param_file, mdl, "MEKE_BGSRC", CS%MEKE_BGsrc, & "A background energy source for MEKE.", units="W kg-1", & default=0.0) @@ -1065,6 +1080,9 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) CS%id_mom_src = register_diag_field('ocean_model', 'MEKE_mom_src',diag%axesT1, Time, & 'MEKE energy available from momentum', 'W m-2') if (.not. associated(MEKE%mom_src)) CS%id_mom_src = -1 + CS%id_GME_snk = register_diag_field('ocean_model', 'MEKE_GME_snk',diag%axesT1, Time, & + 'MEKE energy lost to GME backscatter', 'W m-2') + if (.not. associated(MEKE%GME_snk)) CS%id_GME_snk = -1 CS%id_Le = register_diag_field('ocean_model', 'MEKE_Le', diag%axesT1, Time, & 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm') CS%id_Lrhines = register_diag_field('ocean_model', 'MEKE_Lrhines', diag%axesT1, Time, & @@ -1097,7 +1115,7 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. ! Local variables type(vardesc) :: vd - real :: MEKE_GMcoeff, MEKE_FrCoeff, MEKE_KHCoeff, MEKE_viscCoeff + real :: MEKE_GMcoeff, MEKE_FrCoeff, MEKE_GMECoeff, MEKE_KHCoeff, MEKE_viscCoeff logical :: useMEKE integer :: isd, ied, jsd, jed @@ -1107,6 +1125,7 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) ! Read these parameters to determine what should be in the restarts MEKE_GMcoeff =-1.; call read_param(param_file,"MEKE_GMCOEFF",MEKE_GMcoeff) MEKE_FrCoeff =-1.; call read_param(param_file,"MEKE_FRCOEFF",MEKE_FrCoeff) + MEKE_GMEcoeff =-1.; call read_param(param_file,"MEKE_GMECOEFF",MEKE_GMEcoeff) MEKE_KhCoeff =1.; call read_param(param_file,"MEKE_KHCOEFF",MEKE_KhCoeff) MEKE_viscCoeff =0.; call read_param(param_file,"MEKE_VISCOSITY_COEFF",MEKE_viscCoeff) @@ -1132,6 +1151,9 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) if (MEKE_FrCoeff>=0.) then allocate(MEKE%mom_src(isd:ied,jsd:jed)) ; MEKE%mom_src(:,:) = 0.0 endif + if (MEKE_GMECoeff>=0.) then + allocate(MEKE%GME_snk(isd:ied,jsd:jed)) ; MEKE%GME_snk(:,:) = 0.0 + endif if (MEKE_KhCoeff>=0.) then allocate(MEKE%Kh(isd:ied,jsd:jed)) ; MEKE%Kh(:,:) = 0.0 vd = var_desc("MEKE_Kh", "m2 s-1",hor_grid='h',z_grid='1', & @@ -1166,6 +1188,7 @@ subroutine MEKE_end(MEKE, CS) if (associated(MEKE%MEKE)) deallocate(MEKE%MEKE) if (associated(MEKE%GM_src)) deallocate(MEKE%GM_src) if (associated(MEKE%mom_src)) deallocate(MEKE%mom_src) + if (associated(MEKE%GME_snk)) deallocate(MEKE%GME_snk) if (associated(MEKE%Kh)) deallocate(MEKE%Kh) if (associated(MEKE%Ku)) deallocate(MEKE%Ku) if (associated(MEKE%Au)) deallocate(MEKE%Au) diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 26257360b5..e5d0ce9072 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -11,6 +11,7 @@ module MOM_MEKE_types MEKE => NULL(), & !< Vertically averaged eddy kinetic energy, in m2 s-2. GM_src => NULL(), & !< MEKE source due to thickness mixing (GM), in W m-2. mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations, in W m-2. + GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations, in W m-2. Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient in m2 s-1. Rd_dx_h => NULL() !< The deformation radius compared with the grid spacing, nondim. !! Rd_dx_h is copied from VarMix_CS. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 94094759ed..a8e5005205 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -76,7 +76,7 @@ module MOM_hor_visc logical :: dynamic_aniso !< If true, the anisotropic viscosity is recomputed as a function !! of state. This is set depending on ANISOTROPIC_MODE. logical :: use_GME !< If true, use GME backscatter scheme. - real :: GME_dt + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_xx !< The background Laplacian viscosity at h points, in units !! of m2 s-1. The actual viscosity may be the larger of this @@ -326,11 +326,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real :: local_strain ! Local variable for interpolating computed strain rates (s-1). real :: epsilon real :: GME_coeff ! The GME (negative) viscosity coefficient (m2 s-1) - real :: GME_coeff_limiter - real :: FWfrac + real :: GME_coeff_limiter ! Maximum permitted value of the GME coefficient (m2 s-1) + real :: FWfrac ! Fraction of maximum theoretical energy transfer to use when scaling GME coefficient real :: DY_dxBu, DX_dyBu - real :: H0 - real :: dr, dv + real :: H0 ! Depth used to scale down GME coefficient in shallow areas (m) logical :: rescale_Kh, legacy_bound logical :: find_FrictWork logical :: apply_OBC = .false. @@ -396,6 +395,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! GME tapers off above this depth H0 = 1000.0 FWfrac = 0.1 + GME_coeff_limiter = 1e7 + ! initialize diag. array with zeros GME_coeff_h(:,:,:) = 0.0 GME_coeff_q(:,:,:) = 0.0 @@ -1091,7 +1092,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then ! This is the maximum possible amount of energy that can be converted ! per unit time, according to theory (multiplied by h) - max_diss_rate(i,j,k) = 2.0*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) + max_diss_rate(i,j,k) = 2.0*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) * (MIN(G%bathyT(i,j)/H0,1.0)**2) FrictWorkMax(i,j,k) = max_diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 @@ -1111,64 +1112,24 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%use_GME) then + + if (.not. (associated(MEKE))) call MOM_error(FATAL, & + "MEKE must be enabled for GME to be used.") - do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + if (.not. (associated(MEKE%mom_src))) call MOM_error(FATAL, & + "MEKE%mom_src must be enabled for GME to be used.") -! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & -! KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & -! (0.5*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)),0.0) * & -! ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I-1,j,k)) )**2 + & -! (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i,J-1,k)) )**2 ) / & -! ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & -! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & -! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & -! epsilon)) - -! GME_coeff = 2.0 * (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I-1,j,k) + & -! KH_v_GME(i,J,k) + KH_v_GME(i,J-1,k)) * & -! sqrt(0.5*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I-1,j,k)),0.0)) / & -! sqrt( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & -! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & -! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & -! epsilon) - - if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then -! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * target_FrictWork_GME(i,j,k) / ( dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & -! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & -! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + & -! epsilon) -! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * max_diss_rate(i,j,k) * (G%areaT(i,j)/0.01) - -! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * MEKE%MEKE(i,j) / MAX(0.25*(VarMix%SN_u(I,j)+VarMIX%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)),epsilon) - GME_coeff = 1e10; dr = 1e6 - -! if (G%mask2dT(i,j)) -! do while (dr >= max_diss_rate(i,j,k)) -! GME_coeff = GME_coeff / 2.0 - dr = GME_coeff * grad_vel_mag_h(i,j) + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_h(i,j)>0) ) then - GME_coeff = FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_h(i,j) -! GME_coeff = max_diss_rate_bt(i,j) / grad_vel_mag_bt_h(i,j) - else - GME_coeff = 0.0 - endif - -! GME_coeff = (MIN(G%bathyT(i,j)*G%Zd_to_m/H0,1.0)**2)*GME_coeff - -! GME_coeff = 10.0 -! enddo -! else -! GME_coeff = 0.0 -! endif - - - endif ; endif + if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_h(i,j)>0) ) then + GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_h(i,j) + else + GME_coeff = 0.0 + endif ! apply mask GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) - GME_coeff_limiter = 1e7 GME_coeff = MIN(GME_coeff,GME_coeff_limiter) if ((CS%id_GME_coeff_h>0) .or. find_FrictWork) GME_coeff_h(i,j,k) = GME_coeff @@ -1180,74 +1141,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, do J=js-1,Jeq ; do I=is-1,Ieq -! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & -! KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & -! ( 0.25*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & -! VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)),0.0) * & -! ( (0.5*(VarMix%slope_x(I,j,k)+VarMix%slope_x(I,j+1,k)) )**2 + & -! (0.5*(VarMix%slope_y(i,J,k)+VarMix%slope_y(i+1,J,k)) )**2 ) / & -! ( dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & -! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & -! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & -! epsilon)) - -! GME_coeff = 2.0 * (MIN(G%bathyT(i,j)/H0,1.0)**2) * 0.25*(KH_u_GME(I,j,k) + KH_u_GME(I,j+1,k) + & -! KH_v_GME(i,J,k) + KH_v_GME(i+1,J,k)) * & -! sqrt( 0.25*MAX((VarMix%N2_u(I,j,k)+VarMix%N2_u(I,j+1,k) + & -! VarMix%N2_v(i,J,k)+VarMix%N2_v(i+1,J,k)),0.0)) / & -! sqrt(dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & -! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & -! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & -! epsilon) - - if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then -! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * target_FrictWork_GME(i,j,k) / (dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & -! (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & -! (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + & -! epsilon) -! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * target_diss_rate_GME(i,j,k) * G%areaT(i,j) / & -! (0.1**2) -! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * target_diss_rate_GME(i,j,k) * sqrt(G%areaT(i,j))/0.0001 -! -! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * MEKE%MEKE(i,j) / MAX(0.25*(VarMix%SN_u(I,j)+VarMIX%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)),epsilon) -! - -! if (G%mask2dT(i,j)) - GME_coeff = 1e10; dr = 1e6 - - if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_q(i,j)>0) ) then - GME_coeff = FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_q(I,J) -! GME_coeff = max_diss_rate_bt(i,j) / grad_vel_mag_bt_q(I,J) - else - GME_coeff = 0.0 - endif - -! dr = GME_coeff * bt_grad_mag_q(I,J) -! if ((max_diss_rate(i,j,k) > 0) .and. (dr>0) ) then -! dv = dr / (FWfrac*max_diss_rate(i,j,k)) -! GME_coeff = GME_coeff / dv -! else -! GME_coeff = 0.0 -! endif + if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_q(i,j)>0) ) then + GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_q(I,J) + else + GME_coeff = 0.0 + endif -! GME_coeff = (MIN(G%bathyT(i,j)*G%Zd_to_m/H0,1.0)**2)*GME_coeff -! do while (dr >= max_diss_rate(i,j,k)) -! GME_coeff = GME_coeff / 2.0 -! dr = GME_coeff * (dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & -! (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & -! (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2) -! enddo -! else -! GME_coeff = 0.0 -! endif -! GME_coeff = 10.0 - - endif ; endif - ! apply mask GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) - GME_coeff_limiter = 1e7 GME_coeff = MIN(GME_coeff,GME_coeff_limiter) if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff @@ -1272,11 +1174,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif enddo ; enddo - if (find_FrictWork) then - do j=js,je ; do i=is,ie - FrictWork_GME(i,j,k) = GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * grad_vel_mag_bt_h(i,j) - enddo ; enddo - endif + if (associated(MEKE%GME_snk)) then + do j=js,je ; do i=is,ie + FrictWork_GME(i,j,k) = GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * grad_vel_mag_bt_h(i,j) + enddo ; enddo + endif else ! use_GME do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -1401,11 +1303,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! MEKE%mom_src now is sign definite because it only uses the dissipation MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + MAX(-FrictWorkMax(i,j,k),FrictWork_diss(i,j,k)) enddo ; enddo + if (CS%use_GME) then - do j=js,je ; do i=is,ie - ! MEKE%mom_src now is sign definite because it only uses the dissipation - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork_GME(i,j,k) - enddo ; enddo + if (associated(MEKE%GME_snk)) then + do j=js,je ; do i=is,ie + ! MEKE%mom_src now is sign definite because it only uses the dissipation + MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + FrictWork_GME(i,j,k) + enddo ; enddo + endif endif endif endif ; endif @@ -1864,8 +1769,6 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / G%dxCv(i+1,J) enddo ; enddo - CS%GME_dt = dt - if (CS%Laplacian) then ! The 0.3 below was 0.4 in MOM1.10. The change in hq requires ! this to be less than 1/3, rather than 1/2 as before. From a6cd3fe62457c5b01b234beb0d12cd457282e296 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Fri, 3 May 2019 10:41:33 -0600 Subject: [PATCH 071/106] Commented out thickness diffusivity calls for GME, since it is not presently being used. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index a8e5005205..c6f9df0df0 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -442,7 +442,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo endif - call thickness_diffuse_get_KH(thickness_diffuse, KH_u_GME, KH_v_GME, G) + ! Get thickness diffusivity for use in GME +! call thickness_diffuse_get_KH(thickness_diffuse, KH_u_GME, KH_v_GME, G) do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 grad_vel_mag_bt_h(i,j) = dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & @@ -463,10 +464,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo - ! halo updates - call pass_vector(KH_u_GME, KH_v_GME, G%Domain) - call pass_vector(VarMix%slope_x, VarMix%slope_y, G%Domain) - call pass_vector(VarMix%N2_u, VarMix%N2_v, G%Domain) + ! halo updates (presently not used since GME is now hooked to MEKE) +! call pass_vector(KH_u_GME, KH_v_GME, G%Domain) +! call pass_vector(VarMix%slope_x, VarMix%slope_y, G%Domain) +! call pass_vector(VarMix%N2_u, VarMix%N2_v, G%Domain) endif ! use_GME From 4d02387fc25568d24d9aa98a778ee52836fc14b6 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 3 May 2019 10:53:38 -0600 Subject: [PATCH 072/106] Add seaice_melt and seaice_melt_heat This commit adds two new fluxes to the nuopc cap. The MOM (coupler) definition of these terms is seaice_melt (meltw) and seaice_melt_heat (melth). Currently, the alias name for these terms in the fd.yaml file is mean_fresh_water_to_ocean_rate and net_heat_flx_to_ocn. We need to change these to more meningful names and this will require changes in CICE. --- .../nuopc_driver/MOM_surface_forcing.F90 | 25 +++++++------ config_src/nuopc_driver/mom_cap.F90 | 10 ++++-- config_src/nuopc_driver/mom_cap_methods.F90 | 35 ++++++++++--------- 3 files changed, 39 insertions(+), 31 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 7bd705a07a..57da9d5a31 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -163,7 +163,7 @@ module MOM_surface_forcing real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux [kg/m2/s] real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux [kg/m2/s] real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux [W/m2] - real, pointer, dimension(:,:) :: seaice_melt_water =>NULL() !< water flux due to sea ice and snow melting [kg/m2/s] + real, pointer, dimension(:,:) :: seaice_melt =>NULL() !< water flux due to sea ice and snow melting [kg/m2/s] real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation [W/m2] real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation [W/m2] real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation [W/m2] @@ -457,18 +457,18 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%lw_flux)) & - fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%t_flux)) & - fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - ! ! sea ice and snow melt heat flux [W/m2] - ! if (associated(fluxes%seaice_melt_heat)) & - ! fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0) + ! sea ice and snow melt heat flux [W/m2] + if (associated(IOB%seaice_melt_heat)) & + fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0) - ! ! water flux due to sea ice and snow melt [kg/m2/s] - ! if (associated(fluxes%seaice_melt)) & - ! fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_water(i-i0,j-j0) + ! water flux due to sea ice and snow melt [kg/m2/s] + if (associated(IOB%seaice_melt)) & + fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then @@ -540,10 +540,9 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & sign_for_net_FW_bug = 1. if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1. do j=js,je ; do i=is,ie - net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + & + net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) - ! net_FW(i,j) = netFW(i,j) + fluxes%seaice_melt(i,j) * G%areaT(i,j) ! The following contribution appears to be calculating the volume flux of sea-ice ! melt. This calculation is clearly WRONG if either sea-ice has variable @@ -1368,8 +1367,8 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) write(outunit,100) 'iobt%t_flux ' , mpp_chksum( iobt%t_flux ) write(outunit,100) 'iobt%q_flux ' , mpp_chksum( iobt%q_flux ) write(outunit,100) 'iobt%salt_flux ' , mpp_chksum( iobt%salt_flux ) - !write(outunit,100) 'iobt%seaice_melt_heat' , mpp_chksum( iobt%seaice_melt_heat) - !write(outunit,100) 'iobt%seaice_melt_water' , mpp_chksum( iobt%seaice_melt_water) + write(outunit,100) 'iobt%seaice_melt_heat' , mpp_chksum( iobt%seaice_melt_heat) + write(outunit,100) 'iobt%seaice_melt ' , mpp_chksum( iobt%seaice_melt ) write(outunit,100) 'iobt%lw_flux ' , mpp_chksum( iobt%lw_flux ) write(outunit,100) 'iobt%sw_flux_vis_dir' , mpp_chksum( iobt%sw_flux_vis_dir) write(outunit,100) 'iobt%sw_flux_vis_dif' , mpp_chksum( iobt%sw_flux_vis_dif) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 9cf16c8a40..53e44fda7d 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -204,6 +204,8 @@ !! --------------------------|------------|-----------------|---------------------------------------|------------------- !! inst_pres_height_surface | Pa | p | pressure of overlying sea ice and atmosphere !! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | +!! seaice_melt_heat | W m-2 | seaice_melt_heat| sea ice and snow melt heat flux | | +!! seaice_melt | kg m-2 s-1 | seaice_melt | water flux due to sea ice and snow melting | | !! 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 | mass flux of frozen runoff | | !! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | @@ -961,6 +963,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% seaice_melt_heat (isc:iec,jsc:jec),& + Ice_ocean_boundary% seaice_melt (isc:iec,jsc:jec), & Ice_ocean_boundary% mi (isc:iec,jsc:jec), & Ice_ocean_boundary% p (isc:iec,jsc:jec), & Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & @@ -982,6 +986,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary%sw_flux_nir_dif = 0.0 Ice_ocean_boundary%lprec = 0.0 Ice_ocean_boundary%fprec = 0.0 + Ice_ocean_boundary%seaice_melt = 0.0 + Ice_ocean_boundary%seaice_melt_heat= 0.0 Ice_ocean_boundary%mi = 0.0 Ice_ocean_boundary%p = 0.0 Ice_ocean_boundary%runoff = 0.0 @@ -1031,8 +1037,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff - !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_water" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_heat" , "will provide") + 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") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index d893685aec..e6bdbea307 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -294,6 +294,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! salt flux from ice !---- + ice_ocean_boundary%salt_flux(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_salt_rate', & isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -304,22 +305,24 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! !---- ! ! snow&ice melt heat flux (W/m^2) ! !---- - ! call state_getimport(importState, 'seaice_melt_heat', & - ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out + ice_ocean_boundary%seaice_melt_heat(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'net_heat_flx_to_ocn', & + isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! !---- - ! ! snow&ice melt water flux (W/m^2) - ! !---- - ! call state_getimport(importState, 'seaice_melt_water', & - ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_water,rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out + ! !---- + ! ! snow&ice melt water flux (W/m^2) + ! !---- + ice_ocean_boundary%seaice_melt(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_fresh_water_to_ocean_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! mass of overlying ice @@ -373,7 +376,6 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc = ESMF_SUCCESS - ! Use Adcroft's rule of reciprocals; it does the right thing here. call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -386,6 +388,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, file=__FILE__)) & return ! bail out + ! Use Adcroft's rule of reciprocals; it does the right thing here. if (real(dt_int) > 0.0) then inv_dt_int = 1.0 / real(dt_int) else From 69c21eac16317e65768a09a5c50d56fe02ab4eb3 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 3 May 2019 14:21:30 -0600 Subject: [PATCH 073/106] Add missing US entries and fix typos introduced during merge --- src/core/MOM.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- src/parameterizations/lateral/MOM_hor_visc.F90 | 2 +- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 4 ++-- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 4 ++-- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 35a499f7c2..75ad9c427f 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -985,7 +985,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call step_MOM_dyn_split_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & CS%eta_av_bc, G, GV, US, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, & - CS%MEKE, CS%thickness_diffuse_CSpi, waves=waves) + CS%MEKE, CS%thickness_diffuse_CSp, waves=waves) if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_split (step_MOM)") elseif (CS%do_dynamics) then ! ------------------------------------ not SPLIT diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index e579ec4d79..f5a2b6c1f9 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -712,7 +712,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m EKE = 0. endif ! MEKE%MEKE(i,j) = EKE - MEKE%MEKE(i,j) = (G%Zd_to_m*G%bathyT(i,j)*SN / (8*CS%cdrag))**2 + MEKE%MEKE(i,j) = (US%Z_to_m*G%bathyT(i,j)*SN / (8*CS%cdrag))**2 enddo ; enddo end subroutine MEKE_equilibrium diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 5fca75dde3..34d9234313 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -381,7 +381,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & -!$OMP find_FrictWork,FrictWork,use_MEKE_Ku, +!$OMP find_FrictWork,FrictWork,use_MEKE_Ku, & !$OMP use_MEKE_Au, MEKE, hq, & !$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 9c26ab8840..5ef6347ebb 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -418,9 +418,9 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) if (CS%calculate_Eady_growth_rate .or. CS%use_stored_slopes & .or. CS%use_GME_VarMix) then - call find_eta(h, tv, G, GV, e, halo_size=2) + call find_eta(h, tv, G, GV, US, e, halo_size=2) if (CS%use_stored_slopes) then - call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & + call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, CS%N2_u, CS%N2_v, 1) if (CS%calculate_Eady_growth_rate) then call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, CS%N2_u, CS%N2_v, G, GV, CS) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index d694b44f64..f7d008f366 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -776,7 +776,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif Slope_x_PE(I,j,k) = MIN(Slope,CS%slope_max) - hN2_x_PE(I,j,k) = hN2_u(I,K) * GV%m_to_Z + hN2_x_PE(I,j,k) = hN2_u(I,K) * US%m_to_Z if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope ! Estimate the streamfunction at each interface [m3 s-1]. @@ -1025,7 +1025,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif Slope_y_PE(i,J,k) = MIN(Slope,CS%slope_max) - hN2_y_PE(i,J,k) = hN2_v(i,K) * GV%m_to_Z + hN2_y_PE(i,J,k) = hN2_v(i,K) * US%m_to_Z if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope ! Estimate the streamfunction at each interface [m3 s-1]. From 7671d3118d8408fb7987c6406e63b15d55797214 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 3 May 2019 14:58:52 -0600 Subject: [PATCH 074/106] get calendar from CESM --- config_src/nuopc_driver/mom_cap.F90 | 31 ++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 9cf16c8a40..740e16cea2 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -754,6 +754,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: userRc character(len=512) :: restartfile ! Path/Name of restart file character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' + character(len=32) :: calendar !-------------------------------- rc = ESMF_SUCCESS @@ -805,7 +806,35 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fms_init(mpi_comm_mom) call constants_init call field_manager_init - call set_calendar_type (JULIAN) + + ! determine the calendar + if (cesm_coupled) then + call NUOPC_CompAttributeGet(gcomp, name="calendar", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) calendar + select case (trim(calendar)) + case ("NO_LEAP") + call set_calendar_type (NOLEAP) + case ("GREGORIAN") + call set_calendar_type (GREGORIAN) + case default + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": Calendar not supported in MOM6: "//trim(calendar), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + end select + else + call set_calendar_type (NOLEAP) + endif + + else + call set_calendar_type (JULIAN) + endif + call diag_manager_init ! this ocean connector will be driven at set interval From 4b6ef52a94553024fabe56b97c39007f20e3ace7 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Fri, 3 May 2019 15:06:04 -0600 Subject: [PATCH 075/106] Revert "Added biharmonic option for MEKE viscosity." This reverts commit 6b321744f269f725568634e68280150507f7633e. Conflicts: src/parameterizations/lateral/MOM_MEKE.F90 src/parameterizations/lateral/MOM_hor_visc.F90 --- src/parameterizations/lateral/MOM_MEKE.F90 | 30 ++----- .../lateral/MOM_MEKE_types.F90 | 1 - .../lateral/MOM_hor_visc.F90 | 78 ++++++------------- 3 files changed, 29 insertions(+), 80 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index a02eed93af..3882e2c974 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -85,7 +85,6 @@ module MOM_MEKE type(group_pass_type) :: pass_MEKE !< Type for group halo pass calls type(group_pass_type) :: pass_Kh !< Type for group halo pass calls type(group_pass_type) :: pass_Ku !< Type for group halo pass calls - type(group_pass_type) :: pass_Au !< Type for group halo pass calls type(group_pass_type) :: pass_del2MEKE !< Type for group halo pass calls end type MEKE_CS @@ -566,11 +565,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) if (CS%viscosity_coeff/=0.) then do j=js,je ; do i=is,ie MEKE%Ku(i,j) = CS%viscosity_coeff*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j) - MEKE%Au(i,j) = CS%viscosity_coeff*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j)**3 enddo ; enddo call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_Ku, G%Domain) - call do_group_pass(CS%pass_Au, G%Domain) call cpu_clock_end(CS%id_clock_pass) endif @@ -581,7 +578,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) if (CS%id_Ut>0) call post_data(CS%id_Ut, sqrt(max(0.,2.0*MEKE%MEKE*barotrFac2)), CS%diag) if (CS%id_Kh>0) call post_data(CS%id_Kh, MEKE%Kh, CS%diag) if (CS%id_Ku>0) call post_data(CS%id_Ku, MEKE%Ku, CS%diag) - if (CS%id_Au>0) call post_data(CS%id_Au, MEKE%Au, CS%diag) if (CS%id_KhMEKE_u>0) call post_data(CS%id_KhMEKE_u, Kh_u, CS%diag) if (CS%id_KhMEKE_v>0) call post_data(CS%id_KhMEKE_v, Kh_v, CS%diag) if (CS%id_src>0) call post_data(CS%id_src, src, CS%diag) @@ -723,8 +719,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) else EKE = 0. endif -! MEKE%MEKE(i,j) = EKE - MEKE%MEKE(i,j) = (G%Zd_to_m*G%bathyT(i,j)*SN / (8*CS%cdrag))**2 + MEKE%MEKE(i,j) = EKE enddo ; enddo end subroutine MEKE_equilibrium @@ -844,7 +839,7 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. ! Local variables integer :: is, ie, js, je, isd, ied, jsd, jed, nz - logical :: laplacian, biharmonic, useVarMix, coldStart + logical :: laplacian, useVarMix, coldStart ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_MEKE" ! This module's name. @@ -1009,10 +1004,8 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "the velocity field to the bottom stress.", units="nondim", & default=0.003) call get_param(param_file, mdl, "LAPLACIAN", laplacian, default=.false., do_not_log=.true.) - call get_param(param_file, mdl, "BIHARMONIC", biharmonic, default=.false., do_not_log=.true.) - - if (CS%viscosity_coeff/=0. .and. .not. laplacian .and. .not. biharmonic) call MOM_error(FATAL, & - "Either LAPLACIAN or BIHARMONIC must be true if MEKE_VISCOSITY_COEFF is true.") + if (CS%viscosity_coeff/=0. .and. .not. laplacian) call MOM_error(FATAL, & + "LAPLACIAN must be true if MEKE_VISCOSITY_COEFF is true.") call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) @@ -1034,10 +1027,6 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) call create_group_pass(CS%pass_Ku, MEKE%Ku, G%Domain) call do_group_pass(CS%pass_Ku, G%Domain) endif - if (associated(MEKE%Au)) then - call create_group_pass(CS%pass_Au, MEKE%Au, G%Domain) - call do_group_pass(CS%pass_Au, G%Domain) - endif if (allocated(CS%del2MEKE)) then call create_group_pass(CS%pass_del2MEKE, CS%del2MEKE, G%Domain) call do_group_pass(CS%pass_del2MEKE, G%Domain) @@ -1054,9 +1043,6 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) CS%id_Ku = register_diag_field('ocean_model', 'MEKE_KU', diag%axesT1, Time, & 'MEKE derived lateral viscosity', 'm2 s-1') if (.not. associated(MEKE%Ku)) CS%id_Ku = -1 - CS%id_Au = register_diag_field('ocean_model', 'MEKE_AU', diag%axesT1, Time, & - 'MEKE derived lateral biharmonic viscosity', 'm4 s-1') - if (.not. associated(MEKE%Au)) CS%id_Au = -1 CS%id_Ue = register_diag_field('ocean_model', 'MEKE_Ue', diag%axesT1, Time, & 'MEKE derived eddy-velocity scale', 'm s-1') if (.not. associated(MEKE%MEKE)) CS%id_Ue = -1 @@ -1163,14 +1149,9 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) allocate(MEKE%Rd_dx_h(isd:ied,jsd:jed)) ; MEKE%Rd_dx_h(:,:) = 0.0 if (MEKE_viscCoeff/=0.) then allocate(MEKE%Ku(isd:ied,jsd:jed)) ; MEKE%Ku(:,:) = 0.0 - vd = var_desc("MEKE_Ku", "m2 s-1", hor_grid='h', z_grid='1', & + vd = var_desc("MEKE_Ah", "m2 s-1", hor_grid='h', z_grid='1', & longname="Lateral viscosity from Mesoscale Eddy Kinetic Energy") call register_restart_field(MEKE%Ku, vd, .false., restart_CS) - - allocate(MEKE%Au(isd:ied,jsd:jed)) ; MEKE%Au(:,:) = 0.0 - vd = var_desc("MEKE_Au", "m4 s-1", hor_grid='h', z_grid='1', & - longname="Lateral biharmonic viscosity from Mesoscale Eddy Kinetic Energy") - call register_restart_field(MEKE%Au, vd, .false., restart_CS) endif end subroutine MEKE_alloc_register_restart @@ -1191,7 +1172,6 @@ subroutine MEKE_end(MEKE, CS) if (associated(MEKE%GME_snk)) deallocate(MEKE%GME_snk) if (associated(MEKE%Kh)) deallocate(MEKE%Kh) if (associated(MEKE%Ku)) deallocate(MEKE%Ku) - if (associated(MEKE%Au)) deallocate(MEKE%Au) if (allocated(CS%del2MEKE)) deallocate(CS%del2MEKE) deallocate(MEKE) diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index e5d0ce9072..d87d4b810f 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -18,7 +18,6 @@ module MOM_MEKE_types real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient in m2 s-1. !! This viscosity can be negative when representing backscatter !! from unresolved eddies (see Jansen and Held, 2014). - real, dimension(:,:), pointer :: Au => NULL() !< The MEKE-derived lateral biharmonic viscosity coefficient in m4 s-1. ! Parameters real :: KhTh_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTh, nondim real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr, nondim. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index c6f9df0df0..b73c5227fa 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -245,10 +245,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points (m-1 s-1) grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points (m-1 s-1) grad_div_mag_h, & ! Magnitude of divergence gradient at h-points (m-1 s-1) - dudx, dvdy, & ! components in the horizontal tension (s-1) - grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points (s-2) - grad_vel_mag_bt_h, & ! Magnitude of the barotropic velocity gradient tensor squared at h-points (s-2) - max_diss_rate_bt ! maximum possible energy dissipated by barotropic lateral friction (m2 s-3) + dudx, dvdy ! components in the horizontal tension (s-1) real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) @@ -265,9 +262,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points (m-1 s-1) grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points (m-1 s-1) grad_div_mag_q, & ! Magnitude of divergence gradient at q-points (m-1 s-1) - grad_vel_mag_q, & ! Magnitude of the velocity gradient tensor squared at q-points (s-2) - hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses, in H; This form guarantees that hq/hu < 4. - grad_vel_mag_bt_q ! Magnitude of the barotropic velocity gradient tensor squared at q-points (s-2) + hq ! harmonic mean of the harmonic means of the u- & v point thicknesses, in H; This form guarantees that hq/hu < 4. real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & Ah_q, & ! biharmonic viscosity at corner points (m4/s) @@ -282,14 +277,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points (m4/s) Kh_h, & ! Laplacian viscosity at thickness points (m2/s) - diss_rate, & ! MKE dissipated by parameterized shear production (m2 s-3) - max_diss_rate, & ! maximum possible energy dissipated by lateral friction (m2 s-3) - target_diss_rate_GME, & ! target amount of energy to add via GME (m2 s-3) - FrictWork, & ! work done by MKE dissipation mechanisms (W/m2) - FrictWork_diss, & ! negative definite work done by MKE dissipation mechanisms (W/m2) - FrictWorkMax, & ! maximum possible work done by MKE dissipation mechanisms (W/m2) - FrictWork_GME, & ! work done by GME (W/m2) - target_FrictWork_GME, & ! target amount of work for GME to do (W/m2) + FrictWork, & ! energy flux by parameterized shear production (W/m2) + FrictWork_diss, & ! MKE dissipated by parameterized shear production (m3 s-3) + FrictWorkMax, & ! maximum possible energy dissipated by lateral friction (m3 s-3) + FrictWork_GME, & ! MKE added by parameterized shear production in GME (m3 s-3) + target_FrictWork_GME, & ! target amount of energy to add via GME (m3 s-3) div_xx_h ! horizontal divergence (s-1) !real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & @@ -334,7 +326,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, logical :: find_FrictWork logical :: apply_OBC = .false. logical :: use_MEKE_Ku - logical :: use_MEKE_Au integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k, n real :: inv_PI3, inv_PI6 @@ -375,13 +366,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! Toggle whether to use a Laplacian viscosity derived from MEKE use_MEKE_Ku = associated(MEKE%Ku) - use_MEKE_Au = associated(MEKE%Au) !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & -!$OMP find_FrictWork,FrictWork,use_MEKE_Ku, -!$OMP use_MEKE_Au, MEKE, hq, & +!$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, hq, & !$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & @@ -443,8 +432,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif ! Get thickness diffusivity for use in GME -! call thickness_diffuse_get_KH(thickness_diffuse, KH_u_GME, KH_v_GME, G) - + ! call thickness_diffuse_get_KH(thickness_diffuse, KH_u_GME, KH_v_GME, G) do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 grad_vel_mag_bt_h(i,j) = dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & @@ -464,11 +452,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo - ! halo updates (presently not used since GME is now hooked to MEKE) +! halo updates (presently not used since GME is now hooked to MEKE) ! call pass_vector(KH_u_GME, KH_v_GME, G%Domain) ! call pass_vector(VarMix%slope_x, VarMix%slope_y, G%Domain) ! call pass_vector(VarMix%N2_u, VarMix%N2_v, G%Domain) - endif ! use_GME do k=1,nz @@ -493,14 +480,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo - if ((find_FrictWork) .or. (CS%use_GME)) then - do j=js,je ; do i=is,ie - grad_vel_mag_h(i,j) = (dudx(i,j)**2 + dvdy(i,j)**2 + & - (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & - (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) - enddo ; enddo - endif - ! Interpolate the thicknesses to velocity points. ! The extra wide halos are to accommodate the cross-corner-point projections ! in OBCs, which are not ordinarily be necessary, and might not be necessary @@ -855,7 +834,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, str_xx(i,j) = -Kh * sh_xx(i,j) else ! not Laplacian - Kh_h(i,j,k) = 0.0 str_xx(i,j) = 0.0 endif ! Laplacian @@ -887,8 +865,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, Ah = CS%Ah_bg_xx(i,j) endif ! Smagorinsky_Ah or Leith_Ah - if (use_MEKE_Au) Ah = Ah + MEKE%Au(i,j) ! *Add* the MEKE contribution - if (CS%better_bound_Ah) then Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j)) endif @@ -905,8 +881,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) bhstr_xx(i,j) = bhstr_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) - else - Ah_h(i,j,k) = 0.0 endif ! biharmonic enddo ; enddo @@ -1053,12 +1027,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, else Ah = CS%Ah_bg_xy(I,J) endif ! Smagorinsky_Ah or Leith_Ah - - if (use_MEKE_Au) then ! *Add* the MEKE contribution - Ah = Ah + 0.25*( (MEKE%Au(I,J)+MEKE%Au(I+1,J+1)) & - +(MEKE%Au(I+1,J)+MEKE%Au(I,J+1)) ) - endif - if (CS%better_bound_Ah) then Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xy(I,J)) endif @@ -1085,10 +1053,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, do j=js,je ; do i=is,ie ! Diagnose -Kh * |del u|^2 - Ah * |del^2 u|^2 - diss_rate(i,j,k) = -Kh_h(i,j,k) * grad_vel_mag_h(i,j) - & + FrictWork_diss(i,j,k) = -Kh_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * & + (dudx(i,j)**2 + dvdy(i,j)**2 + & + (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & + (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) - & Ah_h(i,j,k) * ((0.5*(u0(I,j) + u0(I-1,j)))**2 + & (0.5*(v0(i,J) + v0(i,J-1)))**2) - FrictWork_diss(i,j,k) = diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then ! This is the maximum possible amount of energy that can be converted @@ -1096,15 +1066,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, max_diss_rate(i,j,k) = 2.0*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) * (MIN(G%bathyT(i,j)/H0,1.0)**2) FrictWorkMax(i,j,k) = max_diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 - - ! Determine how much work GME needs to do to reach the "target" ratio between - ! the amount of work actually done and the maximum allowed by theory. Note that - ! we need to add the FrictWork done by the dissipation operators, since this work - ! is done only for numerical stability and is therefore spurious + ! Determine how much work GME needs to do to reach the "target" ratio between + ! the amount of work actually done and the maximum allowed by theory. Note that + ! we need to add the FrictWork done by the dissipation operators, since this work + ! is done only for numerical stability and is therefore spurious if (CS%use_GME) then - target_diss_rate_GME(i,j,k) = FWfrac * max_diss_rate(i,j,k) - diss_rate(i,j,k) - target_FrictWork_GME(i,j,k) = target_diss_rate_GME(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 - endif + target_FrictWork_GME(i,j,k) = FWfrac * FrictWorkMax(i,j,k) - FrictWork_diss(i,j,k) + endif endif ; endif @@ -1131,6 +1099,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! apply mask GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) + GME_coeff_limiter = 2e5 ! 1e6 + + ! simple way to limit this coeff GME_coeff = MIN(GME_coeff,GME_coeff_limiter) if ((CS%id_GME_coeff_h>0) .or. find_FrictWork) GME_coeff_h(i,j,k) = GME_coeff @@ -1302,9 +1273,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, else do j=js,je ; do i=is,ie ! MEKE%mom_src now is sign definite because it only uses the dissipation - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + MAX(-FrictWorkMax(i,j,k),FrictWork_diss(i,j,k)) + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork_diss(i,j,k) enddo ; enddo - if (CS%use_GME) then if (associated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie From 434ff081cb98c93214e873acda0d2dd79917b498 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 3 May 2019 16:11:38 -0600 Subject: [PATCH 076/106] Willy was silly. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 34d9234313..5203fa718e 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1269,6 +1269,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (k==1) then do j=js,je ; do i=is,ie MEKE%mom_src(i,j) = 0. + MEKE%GME_snk(i,j) = 0. enddo ; enddo endif if (MEKE%backscatter_Ro_c /= 0.) then @@ -1310,7 +1311,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%use_GME) then if (associated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie - ! MEKE%mom_src now is sign definite because it only uses the dissipation MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + FrictWork_GME(i,j,k) enddo ; enddo endif From 434ffe779181d6eb6d8181225ab698cfdbe6dcac Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Mon, 6 May 2019 09:30:36 -0600 Subject: [PATCH 077/106] Working configuration of MEKE/GME. Has biharmonic MEKE viscosity and a GME sink term. --- src/parameterizations/lateral/MOM_MEKE.F90 | 30 +++++- .../lateral/MOM_MEKE_types.F90 | 1 + .../lateral/MOM_hor_visc.F90 | 91 ++++++++++++++----- 3 files changed, 93 insertions(+), 29 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 3882e2c974..a02eed93af 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -85,6 +85,7 @@ module MOM_MEKE type(group_pass_type) :: pass_MEKE !< Type for group halo pass calls type(group_pass_type) :: pass_Kh !< Type for group halo pass calls type(group_pass_type) :: pass_Ku !< Type for group halo pass calls + type(group_pass_type) :: pass_Au !< Type for group halo pass calls type(group_pass_type) :: pass_del2MEKE !< Type for group halo pass calls end type MEKE_CS @@ -565,9 +566,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) if (CS%viscosity_coeff/=0.) then do j=js,je ; do i=is,ie MEKE%Ku(i,j) = CS%viscosity_coeff*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j) + MEKE%Au(i,j) = CS%viscosity_coeff*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j)**3 enddo ; enddo call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_Ku, G%Domain) + call do_group_pass(CS%pass_Au, G%Domain) call cpu_clock_end(CS%id_clock_pass) endif @@ -578,6 +581,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) if (CS%id_Ut>0) call post_data(CS%id_Ut, sqrt(max(0.,2.0*MEKE%MEKE*barotrFac2)), CS%diag) if (CS%id_Kh>0) call post_data(CS%id_Kh, MEKE%Kh, CS%diag) if (CS%id_Ku>0) call post_data(CS%id_Ku, MEKE%Ku, CS%diag) + if (CS%id_Au>0) call post_data(CS%id_Au, MEKE%Au, CS%diag) if (CS%id_KhMEKE_u>0) call post_data(CS%id_KhMEKE_u, Kh_u, CS%diag) if (CS%id_KhMEKE_v>0) call post_data(CS%id_KhMEKE_v, Kh_v, CS%diag) if (CS%id_src>0) call post_data(CS%id_src, src, CS%diag) @@ -719,7 +723,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) else EKE = 0. endif - MEKE%MEKE(i,j) = EKE +! MEKE%MEKE(i,j) = EKE + MEKE%MEKE(i,j) = (G%Zd_to_m*G%bathyT(i,j)*SN / (8*CS%cdrag))**2 enddo ; enddo end subroutine MEKE_equilibrium @@ -839,7 +844,7 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. ! Local variables integer :: is, ie, js, je, isd, ied, jsd, jed, nz - logical :: laplacian, useVarMix, coldStart + logical :: laplacian, biharmonic, useVarMix, coldStart ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_MEKE" ! This module's name. @@ -1004,8 +1009,10 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "the velocity field to the bottom stress.", units="nondim", & default=0.003) call get_param(param_file, mdl, "LAPLACIAN", laplacian, default=.false., do_not_log=.true.) - if (CS%viscosity_coeff/=0. .and. .not. laplacian) call MOM_error(FATAL, & - "LAPLACIAN must be true if MEKE_VISCOSITY_COEFF is true.") + call get_param(param_file, mdl, "BIHARMONIC", biharmonic, default=.false., do_not_log=.true.) + + if (CS%viscosity_coeff/=0. .and. .not. laplacian .and. .not. biharmonic) call MOM_error(FATAL, & + "Either LAPLACIAN or BIHARMONIC must be true if MEKE_VISCOSITY_COEFF is true.") call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) @@ -1027,6 +1034,10 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) call create_group_pass(CS%pass_Ku, MEKE%Ku, G%Domain) call do_group_pass(CS%pass_Ku, G%Domain) endif + if (associated(MEKE%Au)) then + call create_group_pass(CS%pass_Au, MEKE%Au, G%Domain) + call do_group_pass(CS%pass_Au, G%Domain) + endif if (allocated(CS%del2MEKE)) then call create_group_pass(CS%pass_del2MEKE, CS%del2MEKE, G%Domain) call do_group_pass(CS%pass_del2MEKE, G%Domain) @@ -1043,6 +1054,9 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) CS%id_Ku = register_diag_field('ocean_model', 'MEKE_KU', diag%axesT1, Time, & 'MEKE derived lateral viscosity', 'm2 s-1') if (.not. associated(MEKE%Ku)) CS%id_Ku = -1 + CS%id_Au = register_diag_field('ocean_model', 'MEKE_AU', diag%axesT1, Time, & + 'MEKE derived lateral biharmonic viscosity', 'm4 s-1') + if (.not. associated(MEKE%Au)) CS%id_Au = -1 CS%id_Ue = register_diag_field('ocean_model', 'MEKE_Ue', diag%axesT1, Time, & 'MEKE derived eddy-velocity scale', 'm s-1') if (.not. associated(MEKE%MEKE)) CS%id_Ue = -1 @@ -1149,9 +1163,14 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) allocate(MEKE%Rd_dx_h(isd:ied,jsd:jed)) ; MEKE%Rd_dx_h(:,:) = 0.0 if (MEKE_viscCoeff/=0.) then allocate(MEKE%Ku(isd:ied,jsd:jed)) ; MEKE%Ku(:,:) = 0.0 - vd = var_desc("MEKE_Ah", "m2 s-1", hor_grid='h', z_grid='1', & + vd = var_desc("MEKE_Ku", "m2 s-1", hor_grid='h', z_grid='1', & longname="Lateral viscosity from Mesoscale Eddy Kinetic Energy") call register_restart_field(MEKE%Ku, vd, .false., restart_CS) + + allocate(MEKE%Au(isd:ied,jsd:jed)) ; MEKE%Au(:,:) = 0.0 + vd = var_desc("MEKE_Au", "m4 s-1", hor_grid='h', z_grid='1', & + longname="Lateral biharmonic viscosity from Mesoscale Eddy Kinetic Energy") + call register_restart_field(MEKE%Au, vd, .false., restart_CS) endif end subroutine MEKE_alloc_register_restart @@ -1172,6 +1191,7 @@ subroutine MEKE_end(MEKE, CS) if (associated(MEKE%GME_snk)) deallocate(MEKE%GME_snk) if (associated(MEKE%Kh)) deallocate(MEKE%Kh) if (associated(MEKE%Ku)) deallocate(MEKE%Ku) + if (associated(MEKE%Au)) deallocate(MEKE%Au) if (allocated(CS%del2MEKE)) deallocate(CS%del2MEKE) deallocate(MEKE) diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index d87d4b810f..e5d0ce9072 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -18,6 +18,7 @@ module MOM_MEKE_types real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient in m2 s-1. !! This viscosity can be negative when representing backscatter !! from unresolved eddies (see Jansen and Held, 2014). + real, dimension(:,:), pointer :: Au => NULL() !< The MEKE-derived lateral biharmonic viscosity coefficient in m4 s-1. ! Parameters real :: KhTh_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTh, nondim real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr, nondim. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index b73c5227fa..90dac27aff 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -245,7 +245,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points (m-1 s-1) grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points (m-1 s-1) grad_div_mag_h, & ! Magnitude of divergence gradient at h-points (m-1 s-1) - dudx, dvdy ! components in the horizontal tension (s-1) + dudx, dvdy, & ! components in the horizontal tension (s-1) + grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points (s-2) + grad_vel_mag_bt_h, & ! Magnitude of the barotropic velocity gradient tensor squared at h-points (s-2) + max_diss_rate_bt ! maximum possible energy dissipated by barotropic lateral friction (m2 s-3) real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) @@ -262,7 +265,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points (m-1 s-1) grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points (m-1 s-1) grad_div_mag_q, & ! Magnitude of divergence gradient at q-points (m-1 s-1) - hq ! harmonic mean of the harmonic means of the u- & v point thicknesses, in H; This form guarantees that hq/hu < 4. + grad_vel_mag_q, & ! Magnitude of the velocity gradient tensor squared at q-points (s-2) + hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses, in H; This form guarantees that hq/hu < 4. + grad_vel_mag_bt_q ! Magnitude of the barotropic velocity gradient tensor squared at q-points (s-2) real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & Ah_q, & ! biharmonic viscosity at corner points (m4/s) @@ -277,11 +282,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points (m4/s) Kh_h, & ! Laplacian viscosity at thickness points (m2/s) - FrictWork, & ! energy flux by parameterized shear production (W/m2) - FrictWork_diss, & ! MKE dissipated by parameterized shear production (m3 s-3) - FrictWorkMax, & ! maximum possible energy dissipated by lateral friction (m3 s-3) - FrictWork_GME, & ! MKE added by parameterized shear production in GME (m3 s-3) - target_FrictWork_GME, & ! target amount of energy to add via GME (m3 s-3) + diss_rate, & ! MKE dissipated by parameterized shear production (m2 s-3) + max_diss_rate, & ! maximum possible energy dissipated by lateral friction (m2 s-3) + target_diss_rate_GME, & ! target amount of energy to add via GME (m2 s-3) + FrictWork, & ! work done by MKE dissipation mechanisms (W/m2) + FrictWork_diss, & ! negative definite work done by MKE dissipation mechanisms (W/m2) + FrictWorkMax, & ! maximum possible work done by MKE dissipation mechanisms (W/m2) + FrictWork_GME, & ! work done by GME (W/m2) + target_FrictWork_GME, & ! target amount of work for GME to do (W/m2) div_xx_h ! horizontal divergence (s-1) !real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & @@ -326,6 +334,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, logical :: find_FrictWork logical :: apply_OBC = .false. logical :: use_MEKE_Ku + logical :: use_MEKE_Au integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k, n real :: inv_PI3, inv_PI6 @@ -366,11 +375,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! Toggle whether to use a Laplacian viscosity derived from MEKE use_MEKE_Ku = associated(MEKE%Ku) + use_MEKE_Au = associated(MEKE%Au) !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & -!$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, hq, & +!$OMP find_FrictWork,FrictWork,use_MEKE_Ku, +!$OMP use_MEKE_Au, MEKE, hq, & !$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & @@ -432,7 +443,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif ! Get thickness diffusivity for use in GME - ! call thickness_diffuse_get_KH(thickness_diffuse, KH_u_GME, KH_v_GME, G) +! call thickness_diffuse_get_KH(thickness_diffuse, KH_u_GME, KH_v_GME, G) + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 grad_vel_mag_bt_h(i,j) = dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & @@ -452,10 +464,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo -! halo updates (presently not used since GME is now hooked to MEKE) + ! halo updates (presently not used since GME is now hooked to MEKE) ! call pass_vector(KH_u_GME, KH_v_GME, G%Domain) ! call pass_vector(VarMix%slope_x, VarMix%slope_y, G%Domain) ! call pass_vector(VarMix%N2_u, VarMix%N2_v, G%Domain) + endif ! use_GME do k=1,nz @@ -480,6 +493,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo + if ((find_FrictWork) .or. (CS%use_GME)) then + do j=js,je ; do i=is,ie + grad_vel_mag_h(i,j) = (dudx(i,j)**2 + dvdy(i,j)**2 + & + (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & + (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) + enddo ; enddo + endif + ! Interpolate the thicknesses to velocity points. ! The extra wide halos are to accommodate the cross-corner-point projections ! in OBCs, which are not ordinarily be necessary, and might not be necessary @@ -834,6 +855,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, str_xx(i,j) = -Kh * sh_xx(i,j) else ! not Laplacian + Kh_h(i,j,k) = 0.0 str_xx(i,j) = 0.0 endif ! Laplacian @@ -865,6 +887,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, Ah = CS%Ah_bg_xx(i,j) endif ! Smagorinsky_Ah or Leith_Ah + if (use_MEKE_Au) Ah = Ah + MEKE%Au(i,j) ! *Add* the MEKE contribution + if (CS%better_bound_Ah) then Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j)) endif @@ -881,6 +905,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) bhstr_xx(i,j) = bhstr_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) + else + Ah_h(i,j,k) = 0.0 endif ! biharmonic enddo ; enddo @@ -1027,6 +1053,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, else Ah = CS%Ah_bg_xy(I,J) endif ! Smagorinsky_Ah or Leith_Ah + + if (use_MEKE_Au) then ! *Add* the MEKE contribution + Ah = Ah + 0.25*( (MEKE%Au(I,J)+MEKE%Au(I+1,J+1)) & + +(MEKE%Au(I+1,J)+MEKE%Au(I,J+1)) ) + endif + if (CS%better_bound_Ah) then Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xy(I,J)) endif @@ -1053,12 +1085,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, do j=js,je ; do i=is,ie ! Diagnose -Kh * |del u|^2 - Ah * |del^2 u|^2 - FrictWork_diss(i,j,k) = -Kh_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * & - (dudx(i,j)**2 + dvdy(i,j)**2 + & - (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & - (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) - & + diss_rate(i,j,k) = -Kh_h(i,j,k) * grad_vel_mag_h(i,j) - & Ah_h(i,j,k) * ((0.5*(u0(I,j) + u0(I-1,j)))**2 + & (0.5*(v0(i,J) + v0(i,J-1)))**2) + FrictWork_diss(i,j,k) = diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then ! This is the maximum possible amount of energy that can be converted @@ -1066,13 +1096,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, max_diss_rate(i,j,k) = 2.0*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) * (MIN(G%bathyT(i,j)/H0,1.0)**2) FrictWorkMax(i,j,k) = max_diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 - ! Determine how much work GME needs to do to reach the "target" ratio between - ! the amount of work actually done and the maximum allowed by theory. Note that - ! we need to add the FrictWork done by the dissipation operators, since this work - ! is done only for numerical stability and is therefore spurious + + ! Determine how much work GME needs to do to reach the "target" ratio between + ! the amount of work actually done and the maximum allowed by theory. Note that + ! we need to add the FrictWork done by the dissipation operators, since this work + ! is done only for numerical stability and is therefore spurious if (CS%use_GME) then - target_FrictWork_GME(i,j,k) = FWfrac * FrictWorkMax(i,j,k) - FrictWork_diss(i,j,k) - endif + target_diss_rate_GME(i,j,k) = FWfrac * max_diss_rate(i,j,k) - diss_rate(i,j,k) + target_FrictWork_GME(i,j,k) = target_diss_rate_GME(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 + endif endif ; endif @@ -1099,9 +1131,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! apply mask GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) - GME_coeff_limiter = 2e5 ! 1e6 - - ! simple way to limit this coeff GME_coeff = MIN(GME_coeff,GME_coeff_limiter) if ((CS%id_GME_coeff_h>0) .or. find_FrictWork) GME_coeff_h(i,j,k) = GME_coeff @@ -1239,6 +1268,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (k==1) then do j=js,je ; do i=is,ie MEKE%mom_src(i,j) = 0. + MEKE%GME_snk(i,j) = 0. enddo ; enddo endif if (MEKE%backscatter_Ro_c /= 0.) then @@ -1273,8 +1303,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, else do j=js,je ; do i=is,ie ! MEKE%mom_src now is sign definite because it only uses the dissipation - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork_diss(i,j,k) + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + MAX(-FrictWorkMax(i,j,k),FrictWork_diss(i,j,k)) enddo ; enddo + if (CS%use_GME) then if (associated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie @@ -1283,6 +1314,18 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo endif endif + +! do j=js,je ; do i=is,ie +! ! MEKE%mom_src now is sign definite because it only uses the dissipation +! MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + MAX(-FrictWorkMax(i,j,k),FrictWork_diss(i,j,k)) +! enddo ; enddo +! if (CS%use_GME) then +! do j=js,je ; do i=is,ie +! ! MEKE%mom_src now is sign definite because it only uses the dissipation +! MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork_GME(i,j,k) +! enddo ; enddo +! endif + endif endif ; endif From 4c15159ca62d7a94c1fc948ad439adc1c760dc5a Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Mon, 6 May 2019 10:20:05 -0600 Subject: [PATCH 078/106] Added a "next-to_boundary" mask that should help with fixing abnormally large values of the velocity gradient tensor magnitude next to land. --- .../lateral/MOM_hor_visc.F90 | 63 ++++++++++++------- 1 file changed, 42 insertions(+), 21 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 90dac27aff..547b75bc09 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -248,8 +248,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, dudx, dvdy, & ! components in the horizontal tension (s-1) grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points (s-2) grad_vel_mag_bt_h, & ! Magnitude of the barotropic velocity gradient tensor squared at h-points (s-2) - max_diss_rate_bt ! maximum possible energy dissipated by barotropic lateral friction (m2 s-3) - + grad_d2vel_mag_h, & ! Magnitude of the Laplacian of the velocity vector, squared (m-2 s-2) + max_diss_rate_bt, & ! maximum possible energy dissipated by barotropic lateral friction (m2 s-3) + boundary_mask ! A mask that zeroes out cells with at least one land edge + real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain (s-1) dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain (s-1) @@ -402,9 +404,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, GME_coeff_q(:,:,:) = 0.0 str_xx_GME(:,:) = 0.0 str_xy_GME(:,:) = 0.0 + + do j=js,je ; do i=is,ie + boundary_mask(i,j) = (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) + enddo ; enddo + + call pass_var(boundary_mask, G%Domain, complete=.true.) + ! Get barotropic velocities and their gradients call barotropic_get_tav(Barotropic, ubtav, vbtav, G) - call pass_vector(ubtav, vbtav, G%Domain) do j=js,je ; do i=is,ie @@ -445,10 +453,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! Get thickness diffusivity for use in GME ! call thickness_diffuse_get_KH(thickness_diffuse, KH_u_GME, KH_v_GME, G) - do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - grad_vel_mag_bt_h(i,j) = dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + grad_vel_mag_bt_h(i,j) = boundary_mask(i,j) * (dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & - (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2 + (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2) enddo ; enddo if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then @@ -458,9 +466,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif ; endif do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_vel_mag_bt_q(I,J) = dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & + grad_vel_mag_bt_q(I,J) = boundary_mask(i,j) * (dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & - (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2 + (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2) enddo ; enddo @@ -492,15 +500,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) enddo ; enddo - - if ((find_FrictWork) .or. (CS%use_GME)) then - do j=js,je ; do i=is,ie - grad_vel_mag_h(i,j) = (dudx(i,j)**2 + dvdy(i,j)**2 + & - (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & - (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) - enddo ; enddo - endif - ! Interpolate the thicknesses to velocity points. ! The extra wide halos are to accommodate the cross-corner-point projections ! in OBCs, which are not ordinarily be necessary, and might not be necessary @@ -1083,11 +1082,33 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, call pass_var(dvdx, G%Domain, position=CORNER, complete=.true.) call pass_var(dudy, G%Domain, position=CORNER, complete=.true.) + if (CS%Laplacian) then + do j=js,je ; do i=is,ie + grad_vel_mag_h(i,j) = boundary_mask(i,j) * (dudx(i,j)**2 + dvdy(i,j)**2 + & + (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & + (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) + enddo ; enddo + else + do j=js,je ; do i=is,ie + grad_vel_mag_h(i,j) = 0.0 + enddo ; enddo + endif + + if (CS%biharmonic) then + do j=js,je ; do i=is,ie + grad_d2vel_mag_h(i,j) = boundary_mask(i,j) * ((0.5*(u0(I,j) + u0(I-1,j)))**2 + & + (0.5*(v0(i,J) + v0(i,J-1)))**2) + enddo ; enddo + else + do j=js,je ; do i=is,ie + grad_d2vel_mag_h(i,j) = 0.0 + enddo ; enddo + endif + do j=js,je ; do i=is,ie ! Diagnose -Kh * |del u|^2 - Ah * |del^2 u|^2 diss_rate(i,j,k) = -Kh_h(i,j,k) * grad_vel_mag_h(i,j) - & - Ah_h(i,j,k) * ((0.5*(u0(I,j) + u0(I-1,j)))**2 + & - (0.5*(v0(i,J) + v0(i,J-1)))**2) + Ah_h(i,j,k) * grad_d2vel_mag_h(i,j) FrictWork_diss(i,j,k) = diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then @@ -1129,7 +1150,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif ! apply mask - GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) + GME_coeff = GME_coeff * boundary_mask(i,j) GME_coeff = MIN(GME_coeff,GME_coeff_limiter) @@ -1149,7 +1170,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif ! apply mask - GME_coeff = GME_coeff * (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) + GME_coeff = GME_coeff * boundary_mask(i,j) GME_coeff = MIN(GME_coeff,GME_coeff_limiter) From d449d37f894f141653266fe2433bc50671ac4579 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 10 May 2019 13:22:09 -0600 Subject: [PATCH 079/106] Set default of USE_NET_FW_ADJUSTMENT_SIGN_BUG to false in NUOPC cap --- config_src/nuopc_driver/MOM_surface_forcing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 57da9d5a31..aecfd419da 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -1086,7 +1086,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "USE_NET_FW_ADJUSTMENT_SIGN_BUG", & CS%use_net_FW_adjustment_sign_bug, & "If true, use the wrong sign for the adjustment to\n"//& - "the net fresh-water.", default=.true.) + "the net fresh-water.", default=.false.) call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", & CS%adjust_net_fresh_water_by_scaling, & "If true, adjustments to net fresh water to achieve zero net are\n"//& From eb301fe3976e48fbdbb0715a92404029e239fd2c Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 13 May 2019 18:21:45 -0600 Subject: [PATCH 080/106] skip first tstep and double second tstep --- config_src/nuopc_driver/mom_cap.F90 | 46 +++++++++++++++++++++++++++-- 1 file changed, 43 insertions(+), 3 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 09af1d4cba..45c1b9df87 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1764,6 +1764,7 @@ subroutine ModelAdvance(gcomp, rc) ! local variables integer :: userRc logical :: existflag, isPresent, isSet + logical :: do_advance = .true. type(ESMF_Clock) :: clock!< ESMF Clock class definition type(ESMF_Alarm) :: alarm type(ESMF_State) :: importState, exportState @@ -1846,8 +1847,45 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out - Time = esmf2fms_time(currTime) - Time_step_coupled = esmf2fms_time(timeStep) + !--------------- + ! Apply ocean lag at startup: + !--------------- + + if (trim(runtype) == "initial") then + + ! Do not call MOM6 timestepping routine if the first cpl tstep of a startup run + if (currTime == startTime) then + call ESMF_LogWrite("MOM6 - Skipping the first coupling timestep", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + do_advance = .false. + else + do_advance = .true. + endif + + ! If the second cpl tstep of a startup run, step back a cpl tstep and advance for two cpl tsteps + if (currTime == startTime + timeStep) then + call ESMF_LogWrite("MOM6 - Stepping back one coupling timestep", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + Time = esmf2fms_time(currTime-timeStep) ! i.e., startTime + + call ESMF_LogWrite("MOM6 - doubling the coupling timestep", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + Time_step_coupled = 2 * esmf2fms_time(timeStep) + else + Time_step_coupled = esmf2fms_time(timeStep) + Time = esmf2fms_time(currTime) + endif + endif + !--------------- ! Write diagnostics for import @@ -1890,7 +1928,9 @@ 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) + if (do_advance) then + call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) + endif if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") !--------------- From 0ae751e7b6203c82f22ffc9ed855d53f4eef5bb1 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 13 May 2019 18:32:28 -0600 Subject: [PATCH 081/106] apply ocean lag to cesm runs only --- config_src/nuopc_driver/mom_cap.F90 | 64 ++++++++++++++++------------- 1 file changed, 35 insertions(+), 29 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 45c1b9df87..f394f9f5bf 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1851,39 +1851,45 @@ subroutine ModelAdvance(gcomp, rc) ! Apply ocean lag at startup: !--------------- - if (trim(runtype) == "initial") then + if (cesm_coupled) then + if (trim(runtype) == "initial") then - ! Do not call MOM6 timestepping routine if the first cpl tstep of a startup run - if (currTime == startTime) then - call ESMF_LogWrite("MOM6 - Skipping the first coupling timestep", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - do_advance = .false. - else - do_advance = .true. - endif + ! Do not call MOM6 timestepping routine if the first cpl tstep of a startup run + if (currTime == startTime) then + call ESMF_LogWrite("MOM6 - Skipping the first coupling timestep", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + do_advance = .false. + else + do_advance = .true. + endif - ! If the second cpl tstep of a startup run, step back a cpl tstep and advance for two cpl tsteps - if (currTime == startTime + timeStep) then - call ESMF_LogWrite("MOM6 - Stepping back one coupling timestep", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - Time = esmf2fms_time(currTime-timeStep) ! i.e., startTime + ! If the second cpl tstep of a startup run, step back a cpl tstep and advance for two cpl tsteps + if (currTime == startTime + timeStep) then + call ESMF_LogWrite("MOM6 - Stepping back one coupling timestep", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + Time = esmf2fms_time(currTime-timeStep) ! i.e., startTime - call ESMF_LogWrite("MOM6 - doubling the coupling timestep", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - Time_step_coupled = 2 * esmf2fms_time(timeStep) - else - Time_step_coupled = esmf2fms_time(timeStep) - Time = esmf2fms_time(currTime) + call ESMF_LogWrite("MOM6 - doubling the coupling timestep", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + Time_step_coupled = 2 * esmf2fms_time(timeStep) + else + Time_step_coupled = esmf2fms_time(timeStep) + Time = esmf2fms_time(currTime) + endif endif + + else ! non-cesm runs: + Time_step_coupled = esmf2fms_time(timeStep) + Time = esmf2fms_time(currTime) endif From b2ff365ee3cd256df6bed806d84c4719bda628e2 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 15 May 2019 13:05:39 -0600 Subject: [PATCH 082/106] fix ocean lag logic for restart runs --- config_src/nuopc_driver/mom_cap.F90 | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index f394f9f5bf..3992aae530 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1847,8 +1847,11 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out + Time_step_coupled = esmf2fms_time(timeStep) + Time = esmf2fms_time(currTime) + !--------------- - ! Apply ocean lag at startup: + ! Apply ocean lag for startup runs: !--------------- if (cesm_coupled) then @@ -1881,15 +1884,8 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out Time_step_coupled = 2 * esmf2fms_time(timeStep) - else - Time_step_coupled = esmf2fms_time(timeStep) - Time = esmf2fms_time(currTime) endif endif - - else ! non-cesm runs: - Time_step_coupled = esmf2fms_time(timeStep) - Time = esmf2fms_time(currTime) endif From 59944eb27c956390ad67e98f94bab36e089888f5 Mon Sep 17 00:00:00 2001 From: Scott Bachman Date: Thu, 30 May 2019 16:29:55 -0600 Subject: [PATCH 083/106] Added GEOMETRIC as an option for MEKE. Also added biharmonic MEKE viscosity and the option to use a non-MEKE thickness diffusivity to diffuse MEKE. Split MEKE viscosity options into parts concerning Ku and Au. --- src/parameterizations/lateral/MOM_MEKE.F90 | 124 +++++++++++++----- .../lateral/MOM_MEKE_types.F90 | 1 + .../lateral/MOM_hor_visc.F90 | 90 +++++-------- .../lateral/MOM_thickness_diffuse.F90 | 70 ++++++++-- 4 files changed, 182 insertions(+), 103 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index f5a2b6c1f9..8106ebd8bf 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -11,6 +11,7 @@ module MOM_MEKE use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_domains, only : create_group_pass, do_group_pass use MOM_domains, only : group_pass_type +use MOM_domains, only : pass_var, pass_vector use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, MOM_mesg use MOM_file_parser, only : read_param, get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type @@ -43,6 +44,8 @@ module MOM_MEKE real :: MEKE_Ct !< Coefficient in the \f$\gamma_{bt}\f$ expression [nondim] logical :: visc_drag !< If true use the vertvisc_type to calculate bottom drag. logical :: Jansen15_drag !< If true use the bottom drag formulation from Jansen et al. (2015) + logical :: MEKE_GEOMETRIC !< If true, uses the GM coefficient formulation from the GEOMETRIC + !! framework (Marshall et al., 2012) logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the MEKE GM source term. logical :: Rd_as_max_scale !< If true the length scale can not exceed the @@ -57,8 +60,11 @@ module MOM_MEKE real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) [m4 s-1] real :: KhMEKE_Fac !< A factor relating MEKE%Kh to the diffusivity used for !! MEKE itself [nondim]. - real :: viscosity_coeff !< The scaling coefficient in the expression for - !! viscosity used to parameterize lateral momentum mixing + real :: viscosity_coeff_Ku !< The scaling coefficient in the expression for + !! viscosity used to parameterize lateral harmonic momentum mixing + !! by unresolved eddies represented by MEKE. + real :: viscosity_coeff_Au !< The scaling coefficient in the expression for + !! viscosity used to parameterize lateral biharmonic momentum mixing !! by unresolved eddies represented by MEKE. real :: Lfixed !< Fixed mixing length scale [m]. real :: aDeform !< Weighting towards deformation scale of mixing length [nondim] @@ -89,6 +95,7 @@ module MOM_MEKE integer :: id_clock_pass !< Clock for group pass calls type(group_pass_type) :: pass_MEKE !< Type for group halo pass calls type(group_pass_type) :: pass_Kh !< Type for group halo pass calls + type(group_pass_type) :: pass_Kh_diff !< Type for group halo pass calls type(group_pass_type) :: pass_Ku !< Type for group halo pass calls type(group_pass_type) :: pass_Au !< Type for group halo pass calls type(group_pass_type) :: pass_del2MEKE !< Type for group halo pass calls @@ -104,8 +111,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: SN_u !< Eady growth rate at u-points [s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: SN_v !< Eady growth rate at v-points [s-1]. type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. real, intent(in) :: dt !< Model(baroclinic) time-step [s]. type(MEKE_CS), pointer :: CS !< MEKE control structure. @@ -126,6 +133,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h LmixScale, & ! Square of eddy mixing length, in m2. barotrFac2, & ! Ratio of EKE_barotropic / EKE (nondim)/ bottomFac2 ! Ratio of EKE_bottom / EKE (nondim)/ + real, dimension(SZIB_(G),SZJ_(G)) :: & MEKE_uflux, & ! The zonal diffusive flux of MEKE [kg m2 s-3]. Kh_u, & ! The zonal diffusivity that is actually used [m2 s-1]. @@ -425,6 +433,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Limit Kh to avoid CFL violations. if (associated(MEKE%Kh)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) + if (associated(MEKE%Kh_diff)) & + Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) Inv_Kh_max = 2.0*sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & max(G%IareaT(i,j),G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max @@ -438,6 +448,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do J=js-1,je ; do i=is,ie if (associated(MEKE%Kh)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) + if (associated(MEKE%Kh_diff)) & + Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & max(G%IareaT(i,j),G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max @@ -491,7 +503,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%Jansen15_drag) then do j=js,je ; do i=is,ie ldamping = CS%MEKE_damping + drag_rate(i,j) - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - MIN(MEKE%MEKE(i,j),sdt_damp*drag_rate(i,j)) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) -sdt_damp*drag_rate(i,j) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo else @@ -508,6 +520,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP do endif endif ! MEKE_KH>=0 + + do j=js,je ; do i=is,ie + MEKE%MEKE(i,j) = MAX(MEKE%MEKE(i,j),0.0) + enddo ; enddo + !$OMP end parallel call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_MEKE, G%Domain) @@ -515,43 +532,53 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate diffusivity for main model to use if (CS%MEKE_KhCoeff>0.) then - if (CS%use_old_lscale) then - if (CS%Rd_as_max_scale) then - !$OMP parallel do default(shared) - do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = (CS%MEKE_KhCoeff & + if (.not.CS%MEKE_GEOMETRIC) then + if (CS%use_old_lscale) then + if (CS%Rd_as_max_scale) then + !$OMP parallel do default(shared) + do j=js,je ; do i=is,ie + MEKE%Kh(i,j) = (CS%MEKE_KhCoeff & * sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j))) & * min(MEKE%Rd_dx_h(i,j), 1.0) - enddo ; enddo + enddo ; enddo + else + !$OMP parallel do default(shared) + do j=js,je ; do i=is,ie + MEKE%Kh(i,j) = CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) + enddo ; enddo + endif else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) + MEKE%Kh(i,j) = (CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j)))*LmixScale(i,j)) enddo ; enddo endif - else - !$OMP parallel do default(shared) - do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = (CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j)))*LmixScale(i,j)) - enddo ; enddo - endif - call cpu_clock_begin(CS%id_clock_pass) - call do_group_pass(CS%pass_Kh, G%Domain) - call cpu_clock_end(CS%id_clock_pass) + call cpu_clock_begin(CS%id_clock_pass) + call do_group_pass(CS%pass_Kh, G%Domain) + call cpu_clock_end(CS%id_clock_pass) + endif endif ! Calculate viscosity for the main model to use - if (CS%viscosity_coeff/=0.) then + if (CS%viscosity_coeff_Ku /=0.) then do j=js,je ; do i=is,ie - MEKE%Ku(i,j) = CS%viscosity_coeff*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j) - MEKE%Au(i,j) = CS%viscosity_coeff*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j)**3 + MEKE%Ku(i,j) = CS%viscosity_coeff_Ku*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j) enddo ; enddo call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_Ku, G%Domain) + call cpu_clock_end(CS%id_clock_pass) + endif + + if (CS%viscosity_coeff_Au /=0.) then + do j=js,je ; do i=is,ie + MEKE%Au(i,j) = CS%viscosity_coeff_Au*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j)**3 + enddo ; enddo + call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_Au, G%Domain) call cpu_clock_end(CS%id_clock_pass) endif + ! Offer fields for averaging. if (CS%id_MEKE>0) call post_data(CS%id_MEKE, MEKE%MEKE, CS%diag) if (CS%id_Ue>0) call post_data(CS%id_Ue, sqrt(max(0.,2.0*MEKE%MEKE)), CS%diag) @@ -897,6 +924,9 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "into MEKE by the thickness mixing parameterization. \n"//& "If MEKE_GMCOEFF is negative, this conversion is not \n"//& "used or calculated.", units="nondim", default=-1.0) + call get_param(param_file, mdl, "MEKE_GEOMETRIC", CS%MEKE_GEOMETRIC, & + "If MEKE_GEOMETRIC is true, uses the GM coefficient formulation \n"//& + "from the GEOMETRIC framework (Marshall et al., 2012).", default=.false.) call get_param(param_file, mdl, "MEKE_FRCOEFF", CS%MEKE_FrCoeff, & "The efficiency of the conversion of mean energy into \n"//& "MEKE. If MEKE_FRCOEFF is negative, this conversion \n"//& @@ -955,9 +985,15 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "If true, the length scale used by MEKE is the minimum of\n"//& "the deformation radius or grid-spacing. Only used if\n"//& "MEKE_OLD_LSCALE=True", units="nondim", default=.false.) - call get_param(param_file, mdl, "MEKE_VISCOSITY_COEFF", CS%viscosity_coeff, & + call get_param(param_file, mdl, "MEKE_VISCOSITY_COEFF_KU", CS%viscosity_coeff_Ku, & "If non-zero, is the scaling coefficient in the expression for\n"//& - "viscosity used to parameterize lateral momentum mixing by\n"//& + "viscosity used to parameterize harmonic lateral momentum mixing by\n"//& + "unresolved eddies represented by MEKE. Can be negative to\n"//& + "represent backscatter from the unresolved eddies.", & + units="nondim", default=0.0) + call get_param(param_file, mdl, "MEKE_VISCOSITY_COEFF_AU", CS%viscosity_coeff_Au, & + "If non-zero, is the scaling coefficient in the expression for\n"//& + "viscosity used to parameterize biharmonic lateral momentum mixing by\n"//& "unresolved eddies represented by MEKE. Can be negative to\n"//& "represent backscatter from the unresolved eddies.", & units="nondim", default=0.0) @@ -989,7 +1025,7 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "If true, initialize EKE to zero. Otherwise a local equilibrium solution\n"//& "is used as an initial condition for EKE.", default=.false.) call get_param(param_file, mdl, "MEKE_BACKSCAT_RO_C", MEKE%backscatter_Ro_c, & - "The coefficient in the Rossby number function for scaling the buharmonic\n"//& + "The coefficient in the Rossby number function for scaling the biharmonic\n"//& "frictional energy source. Setting to non-zero enables the Rossby number function.", & units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_BACKSCAT_RO_POW", MEKE%backscatter_Ro_pow, & @@ -1014,8 +1050,11 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) call get_param(param_file, mdl, "LAPLACIAN", laplacian, default=.false., do_not_log=.true.) call get_param(param_file, mdl, "BIHARMONIC", biharmonic, default=.false., do_not_log=.true.) - if (CS%viscosity_coeff/=0. .and. .not. laplacian .and. .not. biharmonic) call MOM_error(FATAL, & - "Either LAPLACIAN or BIHARMONIC must be true if MEKE_VISCOSITY_COEFF is true.") + if (CS%viscosity_coeff_Ku/=0. .and. .not. laplacian) call MOM_error(FATAL, & + "LAPLACIAN must be true if MEKE_VISCOSITY_COEFF_KU is true.") + + if (CS%viscosity_coeff_Au/=0. .and. .not. biharmonic) call MOM_error(FATAL, & + "BIHARMONIC must be true if MEKE_VISCOSITY_COEFF_AU is true.") call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) @@ -1033,6 +1072,10 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) call do_group_pass(CS%pass_Kh, G%Domain) endif + if (associated(MEKE%Kh_diff)) then + call create_group_pass(CS%pass_Kh_diff, MEKE%Kh_diff, G%Domain) + call do_group_pass(CS%pass_Kh_diff, G%Domain) + endif if (associated(MEKE%Ku)) then call create_group_pass(CS%pass_Ku, MEKE%Ku, G%Domain) call do_group_pass(CS%pass_Ku, G%Domain) @@ -1118,7 +1161,8 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. ! Local variables type(vardesc) :: vd - real :: MEKE_GMcoeff, MEKE_FrCoeff, MEKE_GMECoeff, MEKE_KHCoeff, MEKE_viscCoeff + real :: MEKE_GMcoeff, MEKE_FrCoeff, MEKE_GMECoeff, MEKE_KHCoeff, MEKE_viscCoeff_Ku, MEKE_viscCoeff_Au + logical :: Use_KH_in_MEKE logical :: useMEKE integer :: isd, ied, jsd, jed @@ -1130,8 +1174,9 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) MEKE_FrCoeff =-1.; call read_param(param_file,"MEKE_FRCOEFF",MEKE_FrCoeff) MEKE_GMEcoeff =-1.; call read_param(param_file,"MEKE_GMECOEFF",MEKE_GMEcoeff) MEKE_KhCoeff =1.; call read_param(param_file,"MEKE_KHCOEFF",MEKE_KhCoeff) - MEKE_viscCoeff =0.; call read_param(param_file,"MEKE_VISCOSITY_COEFF",MEKE_viscCoeff) - + MEKE_viscCoeff_Ku =0.; call read_param(param_file,"MEKE_VISCOSITY_COEFF_KU",MEKE_viscCoeff_Ku) + MEKE_viscCoeff_Au =0.; call read_param(param_file,"MEKE_VISCOSITY_COEFF_AU",MEKE_viscCoeff_Au) + Use_KH_in_MEKE = .false.; call read_param(param_file,"USE_KH_IN_MEKE", Use_KH_in_MEKE) ! Allocate control structure if (associated(MEKE)) then call MOM_error(WARNING, "MEKE_alloc_register_restart called with an associated "// & @@ -1150,8 +1195,8 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) call register_restart_field(MEKE%MEKE, vd, .false., restart_CS) if (MEKE_GMcoeff>=0.) then allocate(MEKE%GM_src(isd:ied,jsd:jed)) ; MEKE%GM_src(:,:) = 0.0 - endif - if (MEKE_FrCoeff>=0.) then + endif + if (MEKE_FrCoeff>=0. .or. MEKE_GMECoeff>=0.) then allocate(MEKE%mom_src(isd:ied,jsd:jed)) ; MEKE%mom_src(:,:) = 0.0 endif if (MEKE_GMECoeff>=0.) then @@ -1164,12 +1209,20 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) call register_restart_field(MEKE%Kh, vd, .false., restart_CS) endif allocate(MEKE%Rd_dx_h(isd:ied,jsd:jed)) ; MEKE%Rd_dx_h(:,:) = 0.0 - if (MEKE_viscCoeff/=0.) then + if (MEKE_viscCoeff_Ku/=0.) then allocate(MEKE%Ku(isd:ied,jsd:jed)) ; MEKE%Ku(:,:) = 0.0 vd = var_desc("MEKE_Ku", "m2 s-1", hor_grid='h', z_grid='1', & longname="Lateral viscosity from Mesoscale Eddy Kinetic Energy") call register_restart_field(MEKE%Ku, vd, .false., restart_CS) + endif + if (Use_Kh_in_MEKE) then + allocate(MEKE%Kh_diff(isd:ied,jsd:jed)) ; MEKE%Kh_diff(:,:) = 0.0 + vd = var_desc("MEKE_Kh_diff", "m2 s-1",hor_grid='h',z_grid='1', & + longname="Copy of thickness diffusivity for diffusing MEKE") + call register_restart_field(MEKE%Kh_diff, vd, .false., restart_CS) + endif + if (MEKE_viscCoeff_Au/=0.) then allocate(MEKE%Au(isd:ied,jsd:jed)) ; MEKE%Au(:,:) = 0.0 vd = var_desc("MEKE_Au", "m4 s-1", hor_grid='h', z_grid='1', & longname="Lateral biharmonic viscosity from Mesoscale Eddy Kinetic Energy") @@ -1193,6 +1246,7 @@ subroutine MEKE_end(MEKE, CS) if (associated(MEKE%mom_src)) deallocate(MEKE%mom_src) if (associated(MEKE%GME_snk)) deallocate(MEKE%GME_snk) if (associated(MEKE%Kh)) deallocate(MEKE%Kh) + if (associated(MEKE%Kh_diff)) deallocate(MEKE%Kh_diff) if (associated(MEKE%Ku)) deallocate(MEKE%Ku) if (associated(MEKE%Au)) deallocate(MEKE%Au) if (allocated(CS%del2MEKE)) deallocate(CS%del2MEKE) diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 2a5bd3a92f..0f4c58b68c 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -13,6 +13,7 @@ module MOM_MEKE_types mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations, in W m-2. GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations, in W m-2. Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient in m2 s-1. + Kh_diff => NULL(), & !< Uses the non-MEKE-derived thickness diffusion coefficient to diffuse MEKE, in m2 s-1. Rd_dx_h => NULL() !< The deformation radius compared with the grid spacing, nondim. !! Rd_dx_h is copied from VarMix_CS. real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient [m2 s-1]. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index f84df14b69..2a2625c599 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -167,7 +167,7 @@ module MOM_hor_visc integer :: id_GME_coeff_h = -1, id_GME_coeff_q = -1 integer :: id_vort_xy_q = -1, id_div_xx_h = -1 integer :: id_FrictWork = -1, id_FrictWorkIntz = -1 - integer :: id_FrictWorkMax = -1, id_target_FrictWork_GME = -1 + integer :: id_FrictWorkMax = -1 integer :: id_FrictWork_diss = -1, id_FrictWork_GME !!@} @@ -287,12 +287,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, Kh_h, & ! Laplacian viscosity at thickness points (m2/s) diss_rate, & ! MKE dissipated by parameterized shear production (m2 s-3) max_diss_rate, & ! maximum possible energy dissipated by lateral friction (m2 s-3) - target_diss_rate_GME, & ! target amount of energy to add via GME (m2 s-3) + target_diss_rate_GME, & ! the maximum theoretical dissipation plus the amount spuriously dissipated + ! by friction (m2 s-3) FrictWork, & ! work done by MKE dissipation mechanisms (W/m2) FrictWork_diss, & ! negative definite work done by MKE dissipation mechanisms (W/m2) FrictWorkMax, & ! maximum possible work done by MKE dissipation mechanisms (W/m2) FrictWork_GME, & ! work done by GME (W/m2) - target_FrictWork_GME, & ! target amount of work for GME to do (W/m2) div_xx_h ! horizontal divergence (s-1) !real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & @@ -350,6 +350,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, inv_PI6 = inv_PI3**2 epsilon = 1.e-7 + Ah_h(:,:,:) = 0.0 + Kh_h(:,:,:) = 0.0 + if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then apply_OBC = OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally apply_OBC = .true. @@ -394,10 +397,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, !$OMP div_xx, div_xx_dx, div_xx_dy,local_strain, & !$OMP Shear_mag, h2uq, h2vq, Kh_scale, hrat_min) + do j=js,je ; do i=is,ie + boundary_mask(i,j) = (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) + enddo ; enddo + if (CS%use_GME) then ! GME tapers off above this depth H0 = 1000.0 - FWfrac = 0.1 + FWfrac = 1.0 GME_coeff_limiter = 1e7 ! initialize diag. array with zeros @@ -406,11 +413,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, str_xx_GME(:,:) = 0.0 str_xy_GME(:,:) = 0.0 - do j=js,je ; do i=is,ie - boundary_mask(i,j) = (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) - enddo ; enddo - - call pass_var(boundary_mask, G%Domain, complete=.true.) +! call pass_var(boundary_mask, G%Domain, complete=.true.) ! Get barotropic velocities and their gradients call barotropic_get_tav(Barotropic, ubtav, vbtav, G) @@ -472,12 +475,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2) enddo ; enddo - - ! halo updates (presently not used since GME is now hooked to MEKE) -! call pass_vector(KH_u_GME, KH_v_GME, G%Domain) -! call pass_vector(VarMix%slope_x, VarMix%slope_y, G%Domain) -! call pass_vector(VarMix%N2_u, VarMix%N2_v, G%Domain) - endif ! use_GME do k=1,nz @@ -812,7 +809,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then - !vert_vort_mag = MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j), beta_h(i,j)*3) vert_vort_mag = MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j),3*grad_vort_mag_h_2d(i,j)) else vert_vort_mag = grad_vort_mag_h(i,j) + grad_div_mag_h(i,j) @@ -855,7 +851,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, str_xx(i,j) = -Kh * sh_xx(i,j) else ! not Laplacian - Kh_h(i,j,k) = 0.0 str_xx(i,j) = 0.0 endif ! Laplacian @@ -905,8 +900,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) bhstr_xx(i,j) = bhstr_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) - else - Ah_h(i,j,k) = 0.0 endif ! biharmonic enddo ; enddo @@ -951,15 +944,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then vert_vort_mag = MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), 3*grad_vort_mag_q_2d(I,J)) - !vert_vort_mag = MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), beta_q(I,J)*3) else vert_vort_mag = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) endif endif h2uq = 4.0 * h_u(I,j) * h_u(I,j+1) h2vq = 4.0 * h_v(i,J) * h_v(i+1,J) - !hq = 2.0 * h2uq * h2vq / (h_neglect3 + (h2uq + h2vq) * & - ! ((h(i,j,k) + h(i+1,j+1,k)) + (h(i,j+1,k) + h(i+1,j,k)))) hq(I,J) = 2.0 * h2uq * h2vq / (h_neglect3 + (h2uq + h2vq) * & ((h_u(I,j) + h_u(I,j+1)) + (h_v(i,J) + h_v(i+1,J)))) @@ -1110,14 +1100,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! Diagnose -Kh * |del u|^2 - Ah * |del^2 u|^2 diss_rate(i,j,k) = -Kh_h(i,j,k) * grad_vel_mag_h(i,j) - & Ah_h(i,j,k) * grad_d2vel_mag_h(i,j) - FrictWork_diss(i,j,k) = diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then ! This is the maximum possible amount of energy that can be converted ! per unit time, according to theory (multiplied by h) - max_diss_rate(i,j,k) = 2.0*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) * (MIN(G%bathyT(i,j)/H0,1.0)**2) - - FrictWorkMax(i,j,k) = max_diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 + max_diss_rate(i,j,k) = 2.0*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) + FrictWork_diss(i,j,k) = diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 + FrictWorkMax(i,j,k) = -max_diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 ! Determine how much work GME needs to do to reach the "target" ratio between ! the amount of work actually done and the maximum allowed by theory. Note that @@ -1125,9 +1114,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! is done only for numerical stability and is therefore spurious if (CS%use_GME) then target_diss_rate_GME(i,j,k) = FWfrac * max_diss_rate(i,j,k) - diss_rate(i,j,k) - target_FrictWork_GME(i,j,k) = target_diss_rate_GME(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 endif + else + FrictWork_diss(i,j,k) = diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 endif ; endif enddo ; enddo @@ -1139,13 +1129,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (.not. (associated(MEKE))) call MOM_error(FATAL, & "MEKE must be enabled for GME to be used.") - if (.not. (associated(MEKE%mom_src))) call MOM_error(FATAL, & - "MEKE%mom_src must be enabled for GME to be used.") - do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_h(i,j)>0) ) then GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_h(i,j) +! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * FWfrac*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_h(i,j) else GME_coeff = 0.0 endif @@ -1153,7 +1141,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! apply mask GME_coeff = GME_coeff * boundary_mask(i,j) - GME_coeff = MIN(GME_coeff,GME_coeff_limiter) + GME_coeff = MIN(GME_coeff, GME_coeff_limiter) if ((CS%id_GME_coeff_h>0) .or. find_FrictWork) GME_coeff_h(i,j,k) = GME_coeff @@ -1166,6 +1154,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_q(i,j)>0) ) then GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_q(I,J) +! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * FWfrac*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_q(I,J) else GME_coeff = 0.0 endif @@ -1173,7 +1162,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, ! apply mask GME_coeff = GME_coeff * boundary_mask(i,j) - GME_coeff = MIN(GME_coeff,GME_coeff_limiter) + GME_coeff = MIN(GME_coeff, GME_coeff_limiter) if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) @@ -1325,31 +1314,20 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, enddo ; enddo else do j=js,je ; do i=is,ie - ! MEKE%mom_src now is sign definite because it only uses the dissipation - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + MAX(-FrictWorkMax(i,j,k),FrictWork_diss(i,j,k)) + ! MEKE%mom_src now is sign definite because it only uses the dissipation + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + MAX(FrictWork_diss(i,j,k), FrictWorkMax(i,j,k)) enddo ; enddo + endif ! MEKE%backscatter - if (CS%use_GME) then - if (associated(MEKE%GME_snk)) then - do j=js,je ; do i=is,ie - MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + FrictWork_GME(i,j,k) - enddo ; enddo - endif + if (CS%use_GME .and. associated(MEKE)) then + if (associated(MEKE%GME_snk)) then + do j=js,je ; do i=is,ie + MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + FrictWork_GME(i,j,k) + enddo ; enddo endif - -! do j=js,je ; do i=is,ie -! ! MEKE%mom_src now is sign definite because it only uses the dissipation -! MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + MAX(-FrictWorkMax(i,j,k),FrictWork_diss(i,j,k)) -! enddo ; enddo -! if (CS%use_GME) then -! do j=js,je ; do i=is,ie -! ! MEKE%mom_src now is sign definite because it only uses the dissipation -! MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork_GME(i,j,k) -! enddo ; enddo -! endif - endif - endif ; endif + + endif ; endif ! find_FrictWork and associated(mom_src) enddo ! end of k loop @@ -1360,7 +1338,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%id_FrictWorkMax>0) call post_data(CS%id_FrictWorkMax, FrictWorkMax, CS%diag) if (CS%id_FrictWork_diss>0) call post_data(CS%id_FrictWork_diss, FrictWork_diss, CS%diag) if (CS%id_FrictWork_GME>0) call post_data(CS%id_FrictWork_GME, FrictWork_GME, CS%diag) - if (CS%id_target_FrictWork_GME>0) call post_data(CS%id_target_FrictWork_GME, target_FrictWork_GME, CS%diag) if (CS%id_Ah_h>0) call post_data(CS%id_Ah_h, Ah_h, CS%diag) if (CS%id_div_xx_h>0) call post_data(CS%id_div_xx_h, div_xx_h, CS%diag) if (CS%id_vort_xy_q>0) call post_data(CS%id_vort_xy_q, vort_xy_q, CS%diag) @@ -1583,7 +1560,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) "the grid spacing to calculate the biharmonic viscosity. \n"//& "The final viscosity is the largest of this scaled \n"//& "viscosity, the Smagorinsky and Leith viscosities, and AH.", & - units="m s-1", default=0.0) + units="m s-1", default=0.1) call get_param(param_file, mdl, "SMAGORINSKY_AH", CS%Smagorinsky_Ah, & "If true, use a biharmonic Smagorinsky nonlinear eddy \n"//& "viscosity.", default=.false.) @@ -2055,9 +2032,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) CS%id_GME_coeff_q = register_diag_field('ocean_model', 'GME_coeff_q', diag%axesBL, Time, & 'GME coefficient at q Points', 'm^2 s-1') - CS%id_target_FrictWork_GME = register_diag_field('ocean_model','target_FrictWork_GME',diag%axesTL,Time,& - 'Target for the amount of integral work done by lateral friction terms in GME', 'W m-2') - CS%id_FrictWork_GME = register_diag_field('ocean_model','FrictWork_GME',diag%axesTL,Time,& 'Integral work done by lateral friction terms in GME (excluding diffusion of energy)', 'W m-2') endif diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index f7d008f366..52ca7a7b19 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -61,6 +61,11 @@ module MOM_thickness_diffuse logical :: debug !< write verbose checksums for debugging purposes logical :: use_GME_thickness_diffuse !< If true, passes GM coefficients to MOM_hor_visc for use !! with GME closure. + logical :: MEKE_GEOMETRIC !< If true, uses the GM coefficient formulation from the GEOMETRIC + !! framework (Marshall et al., 2012) + real :: MEKE_GEOMETRIC_alpha !< The nondimensional coefficient governing the efficiency of + !! the GEOMETRIC thickness difussion [nondim] + logical :: Use_KH_in_MEKE !! If true, uses the thickness diffusivity calculated here to diffuse MEKE. logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the GM source term. type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics @@ -139,6 +144,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: hv(SZI_(G), SZJ_(G)) ! v-thickness [H ~> m or kg m-2] real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] + real :: epsilon if (.not. associated(CS)) call MOM_error(FATAL, "MOM_thickness_diffuse:"// & "Module must be initialized before it is used.") @@ -170,6 +176,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp cg1 => null() endif + epsilon = 1.e-6 + !$OMP parallel do default(none) shared(is,ie,js,je,KH_u_CFL,dt,G,CS) do j=js,je ; do I=is-1,ie KH_u_CFL(I,j) = (0.25*CS%max_Khth_CFL) / & @@ -205,9 +213,16 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then !$OMP do - do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) - enddo ; enddo + if (CS%MEKE_GEOMETRIC) then + do j=js,je ; do I=is-1,ie + Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & + (VarMix%SN_u(I,j) + epsilon) + enddo ; enddo + else + do j=js,je ; do I=is-1,ie + Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + enddo ; enddo + endif endif ; endif if (Resoln_scaled) then @@ -276,9 +291,16 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp endif if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then !$OMP do - do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) - enddo ; enddo + if (CS%MEKE_GEOMETRIC) then + do j=js-1,je ; do I=is,ie + Khth_Loc(I,j) = Khth_Loc(I,j) + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & + (VarMix%SN_v(i,J) + epsilon) + enddo ; enddo + else + do J=js-1,je ; do i=is,ie + Khth_Loc(i,j) = Khth_Loc(i,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + enddo ; enddo + endif endif ; endif if (Resoln_scaled) then @@ -335,6 +357,17 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo ; enddo endif + if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then +!$OMP do + if (CS%MEKE_GEOMETRIC) then + do j=js,je ; do I=is,ie + MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * MEKE%MEKE(i,j) / & + (0.25*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + epsilon) + enddo ; enddo + endif + endif ; endif + + !$OMP do do K=1,nz+1 ; do j=js,je ; do I=is-1,ie ; int_slope_u(I,j,K) = 0.0 ; enddo ; enddo ; enddo !$OMP do @@ -394,7 +427,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! in the case where KH_u and KH_v are depth independent. Otherwise, ! if use thickness weighted average, the variations of thickness with ! depth will place a spurious depth dependence to the diagnosed KH_t. - if (CS%id_KH_t > 0 .or. CS%id_KH_t1 > 0) then + if (CS%id_KH_t > 0 .or. CS%id_KH_t1 > 0 .or. CS%Use_KH_in_MEKE) then + MEKE%Kh_diff(:,:) = 0.0 do k=1,nz ! thicknesses across u and v faces, converted to 0/1 mask ! layer average of the interface diffusivities KH_u and KH_v @@ -413,9 +447,14 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp KH_t(i,j,k) = ((hu(I-1,j)*KH_u_lay(i-1,j)+hu(I,j)*KH_u_lay(I,j)) & +(hv(i,J-1)*KH_v_lay(i,J-1)+hv(i,J)*KH_v_lay(i,J))) & / (hu(I-1,j)+hu(I,j)+hv(i,J-1)+hv(i,J)+h_neglect) + MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + KH_t(i,j,k) * h(i,j,k) enddo ; enddo enddo + do j=js,je ; do i=is,ie + MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) / MAX(1.0,G%bathyT(i,j)) + enddo ; enddo + if (CS%id_KH_t > 0) call post_data(CS%id_KH_t, KH_t, CS%diag) if (CS%id_KH_t1 > 0) call post_data(CS%id_KH_t1, KH_t(:,:,1), CS%diag) endif @@ -1869,12 +1908,23 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) - call get_param(param_file, mdl, "USE_GME", CS%use_GME_thickness_diffuse, & - "If true, use the GM+E backscatter scheme in association \n"//& - "with the Gent and McWilliams parameterization.", default=.false.) call get_param(param_file, mdl, "MEKE_GM_SRC_ALT", CS%GM_src_alt, & "If true, use the GM energy conversion form S^2*N^2*kappa rather \n"//& "than the streamfunction for the GM source term.", default=.false.) + call get_param(param_file, mdl, "MEKE_GEOMETRIC", CS%MEKE_GEOMETRIC, & + "If true, uses the GM coefficient formulation \n"//& + "from the GEOMETRIC framework (Marshall et al., 2012).", default=.false.) + call get_param(param_file, mdl, "MEKE_GEOMETRIC_ALPHA", CS%MEKE_GEOMETRIC_alpha, & + "The nondimensional coefficient governing the efficiency of the GEOMETRIC \n"//& + "thickness diffusion.", units="nondim", default=0.05) + call get_param(param_file, mdl, "USE_KH_IN_MEKE", CS%Use_KH_in_MEKE, & + "If true, uses the thickness diffusivity calculated here to diffuse \n"//& + "MEKE.", default=.false.) + + call get_param(param_file, mdl, "USE_GME", CS%use_GME_thickness_diffuse, & + "If true, use the GM+E backscatter scheme in association \n"//& + "with the Gent and McWilliams parameterization.", default=.false.) + if (CS%use_GME_thickness_diffuse) then call safe_alloc_ptr(CS%KH_u_GME,G%IsdB,G%IedB,G%jsd,G%jed,G%ke+1) call safe_alloc_ptr(CS%KH_v_GME,G%isd,G%ied,G%JsdB,G%JedB,G%ke+1) From 35eccc07e3220b33380acf7b41c71dc2d2f79698 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 3 Jun 2019 12:21:46 -0600 Subject: [PATCH 084/106] Ensures that MEKE%Kh_diff is only used when USE_KH_IN_MEKE = True --- .../lateral/MOM_thickness_diffuse.F90 | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 52ca7a7b19..614f3b329d 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -144,7 +144,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: hv(SZI_(G), SZJ_(G)) ! v-thickness [H ~> m or kg m-2] real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] - real :: epsilon + real :: epsilon if (.not. associated(CS)) call MOM_error(FATAL, "MOM_thickness_diffuse:"// & "Module must be initialized before it is used.") @@ -428,7 +428,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! if use thickness weighted average, the variations of thickness with ! depth will place a spurious depth dependence to the diagnosed KH_t. if (CS%id_KH_t > 0 .or. CS%id_KH_t1 > 0 .or. CS%Use_KH_in_MEKE) then - MEKE%Kh_diff(:,:) = 0.0 do k=1,nz ! thicknesses across u and v faces, converted to 0/1 mask ! layer average of the interface diffusivities KH_u and KH_v @@ -447,13 +446,21 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp KH_t(i,j,k) = ((hu(I-1,j)*KH_u_lay(i-1,j)+hu(I,j)*KH_u_lay(I,j)) & +(hv(i,J-1)*KH_v_lay(i,J-1)+hv(i,J)*KH_v_lay(i,J))) & / (hu(I-1,j)+hu(I,j)+hv(i,J-1)+hv(i,J)+h_neglect) - MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + KH_t(i,j,k) * h(i,j,k) enddo ; enddo enddo - do j=js,je ; do i=is,ie - MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) / MAX(1.0,G%bathyT(i,j)) - enddo ; enddo + if (CS%Use_KH_in_MEKE) then + MEKE%Kh_diff(:,:) = 0.0 + do k=1,nz + do j=js,je ; do i=is,ie + MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + KH_t(i,j,k) * h(i,j,k) + enddo; enddo + enddo + + do j=js,je ; do i=is,ie + MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) / MAX(1.0,G%bathyT(i,j)) + enddo ; enddo + endif if (CS%id_KH_t > 0) call post_data(CS%id_KH_t, KH_t, CS%diag) if (CS%id_KH_t1 > 0) call post_data(CS%id_KH_t1, KH_t(:,:,1), CS%diag) From 3d997ee713f6ad28e3d79e6ff033b33ed439ef36 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 3 Jun 2019 12:54:54 -0600 Subject: [PATCH 085/106] Fixes doxygen syntax --- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 4 ++-- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 5ef6347ebb..a2bb22cbaf 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -127,8 +127,8 @@ module MOM_lateral_mixing_coeffs real :: Visbeck_S_max !< Upper bound on slope used in Eady growth rate [nondim]. ! Leith parameters - logical :: use_QG_Leith_GM !! If true, uses the QG Leith viscosity as the GM coefficient - logical :: use_beta_in_QG_Leith !! If true, includes the beta term in the QG Leith GM coefficient + logical :: use_QG_Leith_GM !< If true, uses the QG Leith viscosity as the GM coefficient + logical :: use_beta_in_QG_Leith !< If true, includes the beta term in the QG Leith GM coefficient ! Diagnostics !>@{ diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 614f3b329d..14637d15cd 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -65,7 +65,7 @@ module MOM_thickness_diffuse !! framework (Marshall et al., 2012) real :: MEKE_GEOMETRIC_alpha !< The nondimensional coefficient governing the efficiency of !! the GEOMETRIC thickness difussion [nondim] - logical :: Use_KH_in_MEKE !! If true, uses the thickness diffusivity calculated here to diffuse MEKE. + logical :: Use_KH_in_MEKE !< If true, uses the thickness diffusivity calculated here to diffuse MEKE. logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the GM source term. type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics From 4dd50c1526428f30d16f4ae0c6719eb47bfb8fe7 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 3 Jun 2019 13:07:17 -0600 Subject: [PATCH 086/106] Fixes additional doxygen syntax --- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index a2bb22cbaf..564034311e 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -740,8 +740,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow (m s-1) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (m or kg m-2) integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vort_xy_dx !< x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: vort_xy_dy !< y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) ! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity at h-points (m2 s-1) From 1388ce7ff1fe598eaf24c844d00c667576c34e0f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 3 Jun 2019 13:27:03 -0600 Subject: [PATCH 087/106] Removes trailing space --- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 8106ebd8bf..e24f1e7a0a 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1195,7 +1195,7 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) call register_restart_field(MEKE%MEKE, vd, .false., restart_CS) if (MEKE_GMcoeff>=0.) then allocate(MEKE%GM_src(isd:ied,jsd:jed)) ; MEKE%GM_src(:,:) = 0.0 - endif + endif if (MEKE_FrCoeff>=0. .or. MEKE_GMECoeff>=0.) then allocate(MEKE%mom_src(isd:ied,jsd:jed)) ; MEKE%mom_src(:,:) = 0.0 endif From b3c0b690755eeebb6996ffef3db0aa889c7b74bf Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 4 Jun 2019 08:28:32 -0600 Subject: [PATCH 088/106] Fixes unregistered diagnostic id --- src/parameterizations/lateral/MOM_hor_visc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 2a2625c599..f2238a0ed5 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -168,7 +168,7 @@ module MOM_hor_visc integer :: id_vort_xy_q = -1, id_div_xx_h = -1 integer :: id_FrictWork = -1, id_FrictWorkIntz = -1 integer :: id_FrictWorkMax = -1 - integer :: id_FrictWork_diss = -1, id_FrictWork_GME + integer :: id_FrictWork_diss = -1, id_FrictWork_GME = -1 !!@} From f52375b15fb2c702fc3f505f202f5a049b340d4e Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 6 Jun 2019 13:10:45 -0600 Subject: [PATCH 089/106] Changes logic of an if statement in calc_slope_functions to avoid change in answers --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 564034311e..09deb9cd60 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -416,15 +416,12 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& "Module must be initialized before it is used.") - if (CS%calculate_Eady_growth_rate .or. CS%use_stored_slopes & - .or. CS%use_GME_VarMix) then + if (CS%calculate_Eady_growth_rate) then call find_eta(h, tv, G, GV, US, e, halo_size=2) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & - CS%slope_x, CS%slope_y, CS%N2_u, CS%N2_v, 1) - if (CS%calculate_Eady_growth_rate) then - call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, CS%N2_u, CS%N2_v, G, GV, CS) - endif + CS%slope_x, CS%slope_y, N2_u, N2_v, 1) + call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS) ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) else !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) From f74be3f4293795fc3d8f601bde0628b9c791ef82 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 6 Jun 2019 13:13:05 -0600 Subject: [PATCH 090/106] Deletes code related to GME_Varmix --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 09deb9cd60..9977cf9c1f 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -55,8 +55,6 @@ 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_GME_VarMix !< If true, calculates slopes and Brunt-Vaisala frequency for use with - !! the GME closure. real, dimension(:,:), pointer :: & SN_u => NULL(), & !< S*N at u-points [s-1] SN_v => NULL(), & !< S*N at v-points [s-1] @@ -1121,14 +1119,6 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) oneOrTwo = 2.0 endif - call get_param(param_file, mdl, "USE_GME", CS%use_GME_VarMix, & - "If true, use the GM+E backscatter scheme in association \n"//& - "with the Gent and McWilliams parameterization.", default=.false.) - - if (CS%use_GME_VarMix .and. .not. CS%use_stored_slopes) & - call MOM_error(FATAL,"ERROR: use_stored_slopes must be TRUE when "// & - "using GME.") - do J=js-1,Jeq ; do I=is-1,Ieq CS%f2_dx2_q(I,J) = (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * & max(US%s_to_T**2 * G%CoriolisBu(I,J)**2, absurdly_small_freq2) From 25ea4dc2bad679450b05d9a81140f5b2e32cec2a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 7 Jun 2019 14:30:21 -0600 Subject: [PATCH 091/106] Changes in MEKE * Adds missing drag term to second part of split timestep. * Removes limiter preventing MEKE from going negative. * Reverts back to original method of initial, equilibrium solution. --- src/parameterizations/lateral/MOM_MEKE.F90 | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index e24f1e7a0a..da0310c012 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -507,6 +507,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo else + do j=js,je ; do i=is,ie + drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & + + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) + enddo ; enddo do j=js,je ; do i=is,ie ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) if (MEKE%MEKE(i,j)<0.) ldamping = 0. @@ -521,9 +525,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif endif ! MEKE_KH>=0 - do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = MAX(MEKE%MEKE(i,j),0.0) - enddo ; enddo + ! do j=js,je ; do i=is,ie + ! MEKE%MEKE(i,j) = MAX(MEKE%MEKE(i,j),0.0) + ! enddo ; enddo !$OMP end parallel call cpu_clock_begin(CS%id_clock_pass) @@ -738,8 +742,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m else EKE = 0. endif -! MEKE%MEKE(i,j) = EKE - MEKE%MEKE(i,j) = (US%Z_to_m*G%bathyT(i,j)*SN / (8*CS%cdrag))**2 + MEKE%MEKE(i,j) = EKE +! MEKE%MEKE(i,j) = (US%Z_to_m*G%bathyT(i,j)*SN / (8*CS%cdrag))**2 enddo ; enddo end subroutine MEKE_equilibrium From 2d2f83fced777b8730a01f33f0f7873ebe3e443d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 7 Jun 2019 15:52:41 -0600 Subject: [PATCH 092/106] Changes the way of counting the work --- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 14637d15cd..9c3259e1f2 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -1261,7 +1261,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif - if (find_work) then ; do j=js,je ; do i=is,ie ; do k=nz,1,-1 + !if (find_work) then ; do j=js,je ; do i=is,ie ; do k=nz,1,-1 + if (find_work) then ; do j=js,je ; do i=is,ie ! Note that the units of Work_v and Work_u are W, while Work_h is W m-2. Work_h = 0.5 * G%IareaT(i,j) * & ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) @@ -1277,7 +1278,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h endif endif ; endif - enddo ; enddo ; enddo ; endif + !enddo ; enddo ; enddo ; endif + enddo ; enddo ; endif if (CS%id_slope_x > 0) call post_data(CS%id_slope_x, CS%diagSlopeX, CS%diag) if (CS%id_slope_y > 0) call post_data(CS%id_slope_y, CS%diagSlopeY, CS%diag) From a995acffe76cd152866e226c7eb8cf2650691103 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 10 Jun 2019 11:47:24 -0600 Subject: [PATCH 093/106] Reverts biharmonic constants to the origial definition --- .../lateral/MOM_hor_visc.F90 | 57 ++++++++++--------- 1 file changed, 30 insertions(+), 27 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index f2238a0ed5..7d0b5a8dca 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -149,13 +149,15 @@ module MOM_hor_visc Laplac2_const_xx, & !< Laplacian metric-dependent constants (nondim) Biharm5_const_xx, & !< Biharmonic metric-dependent constants (nondim) Laplac3_const_xx, & !< Laplacian metric-dependent constants (nondim) - Biharm6_const_xx !< Biharmonic metric-dependent constants (nondim) + Biharm_const_xx, & !< Biharmonic metric-dependent constants (nondim) + Biharm_const2_xx !< Biharmonic metric-dependent constants (nondim) real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & Laplac2_const_xy, & !< Laplacian metric-dependent constants (nondim) Biharm5_const_xy, & !< Biharmonic metric-dependent constants (nondim) Laplac3_const_xy, & !< Laplacian metric-dependent constants (nondim) - Biharm6_const_xy !< Biharmonic metric-dependent constants (nondim) + Biharm_const_xy, & !< Biharmonic metric-dependent constants (nondim) + Biharm_const2_xy !< Biharmonic metric-dependent constants (nondim) type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics @@ -340,14 +342,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, logical :: use_MEKE_Au integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k, n - real :: inv_PI3, inv_PI6 + real :: inv_PI3, inv_PI2, inv_PI5 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB h_neglect = GV%H_subroundoff h_neglect3 = h_neglect**3 inv_PI3 = 1.0/((4.0*atan(1.0))**3) - inv_PI6 = inv_PI3**2 + inv_PI2 = 1.0/((4.0*atan(1.0))**2) + inv_PI5 = inv_PI3 * inv_PI2 epsilon = 1.e-7 Ah_h(:,:,:) = 0.0 @@ -868,13 +871,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if ((CS%Smagorinsky_Ah) .or. (CS%Leith_Ah)) then if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then - AhSm = Shear_mag * (CS%Biharm5_const_xx(i,j) + & - CS%Biharm5_const2_xx(i,j)*Shear_mag) + AhSm = Shear_mag * (CS%Biharm_const_xx(i,j) + & + CS%Biharm_const2_xx(i,j)*Shear_mag) else - AhSm = CS%Biharm5_const_xx(i,j) * Shear_mag + AhSm = CS%Biharm_const_xx(i,j) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = CS%Biharm6_const_xx(i,j) * vert_vort_mag*inv_PI6 + if (CS%Leith_Ah) AhLth = CS%Biharm5_const_xx(i,j) * vert_vort_mag*inv_PI5 Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm),AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xx(i,j)) @@ -1030,13 +1033,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, if (CS%Smagorinsky_Ah .or. CS%Leith_Ah) then if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then - AhSm = Shear_mag * (CS%Biharm5_const_xy(I,J) + & - CS%Biharm5_const2_xy(I,J)*Shear_mag) + AhSm = Shear_mag * (CS%Biharm_const_xy(I,J) + & + CS%Biharm_const2_xy(I,J)*Shear_mag) else - AhSm = CS%Biharm5_const_xy(I,J) * Shear_mag + AhSm = CS%Biharm_const_xy(I,J) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = CS%Biharm6_const_xy(I,J) * vert_vort_mag * inv_PI6 + if (CS%Leith_Ah) AhLth = CS%Biharm5_const_xy(I,J) * vert_vort_mag * inv_PI5 Ah = MAX(MAX(CS%Ah_bg_xy(I,J), AhSm),AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xy(I,J)) @@ -1729,16 +1732,16 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) ALLOC_(CS%Ah_Max_xy(IsdB:IedB,JsdB:JedB)) ; CS%Ah_Max_xy(:,:) = 0.0 endif if (CS%Smagorinsky_Ah) then - ALLOC_(CS%Biharm5_const_xx(isd:ied,jsd:jed)) ; CS%Biharm5_const_xx(:,:) = 0.0 - ALLOC_(CS%Biharm5_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Biharm5_const_xy(:,:) = 0.0 + ALLOC_(CS%Biharm_const_xx(isd:ied,jsd:jed)) ; CS%Biharm_const_xx(:,:) = 0.0 + ALLOC_(CS%Biharm_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%Biharm_const_xy(:,:) = 0.0 if (CS%bound_Coriolis) then - ALLOC_(CS%Biharm5_const2_xx(isd:ied,jsd:jed)) ; CS%Biharm5_const2_xx(:,:) = 0.0 - ALLOC_(CS%Biharm5_const2_xy(IsdB:IedB,JsdB:JedB)) ; CS%Biharm5_const2_xy(:,:) = 0.0 + ALLOC_(CS%Biharm_const2_xx(isd:ied,jsd:jed)) ; CS%Biharm_const2_xx(:,:) = 0.0 + ALLOC_(CS%Biharm_const2_xy(IsdB:IedB,JsdB:JedB)) ; CS%Biharm_const2_xy(:,:) = 0.0 endif endif if (CS%Leith_Ah) then - ALLOC_(CS%biharm6_const_xx(isd:ied,jsd:jed)) ; CS%biharm6_const_xx(:,:) = 0.0 - ALLOC_(CS%biharm6_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm6_const_xy(:,:) = 0.0 + ALLOC_(CS%biharm5_const_xx(isd:ied,jsd:jed)) ; CS%biharm5_const_xx(:,:) = 0.0 + ALLOC_(CS%biharm5_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm5_const_xy(:,:) = 0.0 endif endif @@ -1863,16 +1866,16 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) if (CS%Smagorinsky_Ah) then - CS%Biharm5_const_xx(i,j) = Smag_bi_const * (grid_sp_h3 * grid_sp_h2) + CS%Biharm_const_xx(i,j) = Smag_bi_const * (grid_sp_h2 * grid_sp_h2) if (CS%bound_Coriolis) then fmax = MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) - CS%Biharm5_const2_xx(i,j) = (grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & - (fmax * BoundCorConst) + CS%Biharm_const2_xx(i,j) = (grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & + (fmax * BoundCorConst) endif endif if (CS%Leith_Ah) then - CS%biharm6_const_xx(i,j) = Leith_bi_const * (grid_sp_h3**2) + CS%biharm5_const_xx(i,j) = Leith_bi_const * (grid_sp_h3 * grid_sp_h2) endif CS%Ah_bg_xx(i,j) = MAX(Ah, Ah_vel_scale * grid_sp_h2 * sqrt(grid_sp_h2)) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then @@ -1885,14 +1888,14 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) if (CS%Smagorinsky_Ah) then - CS%Biharm5_const_xy(I,J) = Smag_bi_const * (grid_sp_q3 * grid_sp_q2) + CS%Biharm_const_xy(I,J) = Smag_bi_const * (grid_sp_q2 * grid_sp_q2) if (CS%bound_Coriolis) then - CS%Biharm5_const2_xy(I,J) = (grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & - (abs(G%CoriolisBu(I,J)) * BoundCorConst) + CS%Biharm_const2_xy(I,J) = (grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & + (abs(US%s_to_T*G%CoriolisBu(I,J)) * BoundCorConst) endif endif if (CS%Leith_Ah) then - CS%biharm6_const_xy(i,j) = Leith_bi_const * (grid_sp_q3**2) + CS%biharm5_const_xy(i,j) = Leith_bi_const * (grid_sp_q3 * grid_sp_q2) endif CS%Ah_bg_xy(I,J) = MAX(Ah, Ah_vel_scale * grid_sp_q2 * sqrt(grid_sp_q2)) @@ -2188,7 +2191,7 @@ subroutine hor_visc_end(CS) endif endif if (CS%Leith_Ah) then - DEALLOC_(CS%Biharm6_const_xx) ; DEALLOC_(CS%Biharm6_const_xy) + DEALLOC_(CS%Biharm_const_xx) ; DEALLOC_(CS%Biharm_const_xy) endif endif if (CS%anisotropic) then From 22b66954384bbfff363872632b897ec4b20a17c9 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 11 Jun 2019 13:23:19 -0600 Subject: [PATCH 094/106] Remove trailing space --- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 9c3259e1f2..7a85292e54 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -1262,7 +1262,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !if (find_work) then ; do j=js,je ; do i=is,ie ; do k=nz,1,-1 - if (find_work) then ; do j=js,je ; do i=is,ie + if (find_work) then ; do j=js,je ; do i=is,ie ! Note that the units of Work_v and Work_u are W, while Work_h is W m-2. Work_h = 0.5 * G%IareaT(i,j) * & ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) From 2ada29a35d78f14d7aed254746116ae677fc46d0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 21 Jun 2019 13:44:09 -0600 Subject: [PATCH 095/106] Adds MEKE_VISCOSITY_COEFF_AU and MEKE_VISCOSITY_COEFF_KU into the MEKE documentation --- src/parameterizations/lateral/MOM_MEKE.F90 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index da0310c012..21ad5a9800 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1420,9 +1420,13 @@ end subroutine MEKE_end !! \subsection section_MEKE_viscosity Viscosity derived from MEKE !! !! As for \f$ \kappa_M \f$, the predicted eddy velocity scale can be -!! used to form an eddy viscosity: +!! used to form a harmonic eddy viscosity, !! -!! \f[ \kappa_u = \gamma_u \sqrt{ U_e^2 A_\Delta } . \f] +!! \f[ \kappa_u = \gamma_u \sqrt{ U_e^2 A_\Delta } \f] +!! +!! as well as a biharmonic eddy viscosity, +!! +!! \f[ \kappa_4 = \gamma_4 \sqrt{ U_e^2 A_\Delta^3 } \f] !! !! \subsection section_MEKE_limit_case Limit cases for local source-dissipative balance !! @@ -1459,7 +1463,8 @@ end subroutine MEKE_end !! | \f$ \kappa_4 \f$ | MEKE_K4 | !! | \f$ \gamma_\kappa \f$ | MEKE_KHCOEFF | !! | \f$ \gamma_M \f$ | MEKE_KHMEKE_FAC | -!! | \f$ \gamma_u \f$ | MEKE_VISCOSITY_COEFF | +!! | \f$ \gamma_u \f$ | MEKE_VISCOSITY_COEFF_KU | +!! | \f$ \gamma_4 \f$ | MEKE_VISCOSITY_COEFF_AU | !! | \f$ \gamma_{min}^2 \f$| MEKE_MIN_GAMMA2 | !! | \f$ \alpha_d \f$ | MEKE_ALPHA_DEFORM | !! | \f$ \alpha_f \f$ | MEKE_ALPHA_FRICT | From 062e3b0d0045817993e21f7b1357e252d4d75198 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 21 Jun 2019 13:49:32 -0600 Subject: [PATCH 096/106] Obsolete parameter MEKE_VISCOSITY_COEFF --- src/diagnostics/MOM_obsolete_params.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 7c1ee90f12..4d968cb4bb 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -69,6 +69,9 @@ subroutine find_obsolete_params(param_file) hint="Instead use OBC_SEGMENT_XXX_DATA.") call obsolete_char(param_file, "EXTEND_OBC_SEGMENTS", & hint="This option is no longer needed, nor supported.") + call obsolete_char(param_file, "MEKE_VISCOSITY_COEFF", & + hint="This option has been replaced by MEKE_VISCOSITY_COEFF_KU and" & + " MEKE_VISCOSITY_COEFF_AU. Please set these parameters instead.") nseg = 0 call read_param(param_file, "OBC_NUMBER_OF_SEGMENTS", nseg) do l_seg = 1,nseg From afb07fb9779ed6e95618c1a8c6ad880c378b71d6 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 21 Jun 2019 14:08:08 -0600 Subject: [PATCH 097/106] Add MEKE_GEOMETRIC_EPSILON Delete hard-coded epsilon and added a new user parameter to specify this constant. --- .../lateral/MOM_thickness_diffuse.F90 | 23 +++++++++++++------ 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 7a85292e54..68b747182d 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -63,8 +63,10 @@ module MOM_thickness_diffuse !! with GME closure. logical :: MEKE_GEOMETRIC !< If true, uses the GM coefficient formulation from the GEOMETRIC !! framework (Marshall et al., 2012) - real :: MEKE_GEOMETRIC_alpha !< The nondimensional coefficient governing the efficiency of + real :: MEKE_GEOMETRIC_alpha!< The nondimensional coefficient governing the efficiency of !! the GEOMETRIC thickness difussion [nondim] + real :: MEKE_GEOMETRIC_epsilon !< Minimum Eady growth rate for the GEOMETRIC thickness + !! diffusivity [s-1]. logical :: Use_KH_in_MEKE !< If true, uses the thickness diffusivity calculated here to diffuse MEKE. logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the GM source term. @@ -144,7 +146,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: hv(SZI_(G), SZJ_(G)) ! v-thickness [H ~> m or kg m-2] real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] - real :: epsilon if (.not. associated(CS)) call MOM_error(FATAL, "MOM_thickness_diffuse:"// & "Module must be initialized before it is used.") @@ -176,7 +177,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp cg1 => null() endif - epsilon = 1.e-6 !$OMP parallel do default(none) shared(is,ie,js,je,KH_u_CFL,dt,G,CS) do j=js,je ; do I=is-1,ie @@ -216,7 +216,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (CS%MEKE_GEOMETRIC) then do j=js,je ; do I=is-1,ie Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & - (VarMix%SN_u(I,j) + epsilon) + (VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do j=js,je ; do I=is-1,ie @@ -294,7 +294,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (CS%MEKE_GEOMETRIC) then do j=js-1,je ; do I=is,ie Khth_Loc(I,j) = Khth_Loc(I,j) + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & - (VarMix%SN_v(i,J) + epsilon) + (VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do J=js-1,je ; do i=is,ie @@ -362,7 +362,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (CS%MEKE_GEOMETRIC) then do j=js,je ; do I=is,ie MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * MEKE%MEKE(i,j) / & - (0.25*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + epsilon) + (0.25*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + & + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo endif endif ; endif @@ -1923,9 +1924,17 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "MEKE_GEOMETRIC", CS%MEKE_GEOMETRIC, & "If true, uses the GM coefficient formulation \n"//& "from the GEOMETRIC framework (Marshall et al., 2012).", default=.false.) - call get_param(param_file, mdl, "MEKE_GEOMETRIC_ALPHA", CS%MEKE_GEOMETRIC_alpha, & + if (CS%MEKE_GEOMETRIC) then + + call get_param(param_file, mdl, "MEKE_GEOMETRIC_EPSILON", CS%MEKE_GEOMETRIC_epsilon, & + "Minimum Eady growth rate used in the calculation of \n"//& + "GEOMETRIC thickness diffusivity.", units="s-1", default=1.0e-7) + + call get_param(param_file, mdl, "MEKE_GEOMETRIC_ALPHA", CS%MEKE_GEOMETRIC_alpha, & "The nondimensional coefficient governing the efficiency of the GEOMETRIC \n"//& "thickness diffusion.", units="nondim", default=0.05) + endif + call get_param(param_file, mdl, "USE_KH_IN_MEKE", CS%Use_KH_in_MEKE, & "If true, uses the thickness diffusivity calculated here to diffuse \n"//& "MEKE.", default=.false.) From 89168bf1fc86f9109e5eb6269574a57618796371 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 21 Jun 2019 14:50:55 -0600 Subject: [PATCH 098/106] move OMP calls below GME and above the K-loop --- .../lateral/MOM_hor_visc.F90 | 27 +++++++++---------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 7d0b5a8dca..2b6c207e55 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -386,20 +386,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, use_MEKE_Ku = associated(MEKE%Ku) use_MEKE_Au = associated(MEKE%Au) -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & -!$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & -!$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & -!$OMP find_FrictWork,FrictWork,use_MEKE_Ku, & -!$OMP use_MEKE_Au, MEKE, hq, & -!$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & -!$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & -!$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & -!$OMP sh_xx_bt, sh_xy_bt, dvdx_bt, dudy_bt, & -!$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & -!$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & -!$OMP div_xx, div_xx_dx, div_xx_dy,local_strain, & -!$OMP Shear_mag, h2uq, h2vq, Kh_scale, hrat_min) - do j=js,je ; do i=is,ie boundary_mask(i,j) = (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) enddo ; enddo @@ -480,6 +466,19 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, endif ! use_GME + !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & + !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & + !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & + !$OMP find_FrictWork,FrictWork,use_MEKE_Ku, & + !$OMP use_MEKE_Au, MEKE, hq, & + !$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & + !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & + !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & + !$OMP sh_xx_bt, sh_xy_bt, dvdx_bt, dudy_bt, & + !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & + !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & + !$OMP div_xx, div_xx_dx, div_xx_dy,local_strain, & + !$OMP Shear_mag, h2uq, h2vq, Kh_scale, hrat_min) do k=1,nz ! The following are the forms of the horizontal tension and horizontal From 98373e8da98cfe4679f7bb59129ebd8ce9094f6c Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 21 Jun 2019 15:28:15 -0600 Subject: [PATCH 099/106] Fix hint syntax in MOM_obsolete_param --- src/diagnostics/MOM_obsolete_params.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 4d968cb4bb..23d6f19e4e 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -70,7 +70,7 @@ subroutine find_obsolete_params(param_file) call obsolete_char(param_file, "EXTEND_OBC_SEGMENTS", & hint="This option is no longer needed, nor supported.") call obsolete_char(param_file, "MEKE_VISCOSITY_COEFF", & - hint="This option has been replaced by MEKE_VISCOSITY_COEFF_KU and" & + hint="This option has been replaced by MEKE_VISCOSITY_COEFF_KU and \n" //& " MEKE_VISCOSITY_COEFF_AU. Please set these parameters instead.") nseg = 0 call read_param(param_file, "OBC_NUMBER_OF_SEGMENTS", nseg) From 2a9d421af0ac08754a936b1438fb034ddf837285 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 26 Jun 2019 11:34:26 -0600 Subject: [PATCH 100/106] Set default AH_VEL_SCALE back to zero --- src/parameterizations/lateral/MOM_hor_visc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 2b6c207e55..bc281b48a1 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1562,7 +1562,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) "the grid spacing to calculate the biharmonic viscosity. \n"//& "The final viscosity is the largest of this scaled \n"//& "viscosity, the Smagorinsky and Leith viscosities, and AH.", & - units="m s-1", default=0.1) + units="m s-1", default=0.0) call get_param(param_file, mdl, "SMAGORINSKY_AH", CS%Smagorinsky_Ah, & "If true, use a biharmonic Smagorinsky nonlinear eddy \n"//& "viscosity.", default=.false.) From 1a71a555e0b787220054de5072c5bb0446e5686b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 27 Jun 2019 09:54:54 -0600 Subject: [PATCH 101/106] Remove thickness_diffuse_CS from horizontal_viscosity --- src/core/MOM_dynamics_split_RK2.F90 | 6 +++--- src/core/MOM_dynamics_unsplit.F90 | 2 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- src/parameterizations/lateral/MOM_hor_visc.F90 | 4 +--- 4 files changed, 6 insertions(+), 8 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 31cb35b54d..54ce838a4b 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -689,7 +689,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! diffu = horizontal viscosity terms (u_av) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_av, v_av, h_av, CS%diffu, CS%diffv, & - MEKE, Varmix, CS%barotropic_CSp, thickness_diffuse_CSp, & + MEKE, Varmix, CS%barotropic_CSp, & G, GV, US, CS%hor_visc_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_horvisc) if (showCallTree) call callTree_wayPoint("done with horizontal_viscosity (step_MOM_dyn_split_RK2)") @@ -1153,8 +1153,8 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) & call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & - CS%barotropic_CSp, thickness_diffuse_CSp, & - G, GV, US, CS%hor_visc_CSp, OBC=CS%OBC) + CS%barotropic_CSp, G, GV, US, CS%hor_visc_CSp, & + OBC=CS%OBC) if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then CS%u_av(:,:,:) = u(:,:,:) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index afdc99f2d7..999464ac77 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -260,7 +260,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, & - Barotropic, thickness_diffuse, G, GV, US, CS%hor_visc_CSp) + Barotropic, G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index f88c08ac45..28efd09bc3 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -271,7 +271,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_in, v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & - Barotropic, thickness_diffuse, G, GV, US, CS%hor_visc_CSp) + Barotropic, G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) call pass_vector(CS%diffu, CS%diffv, G%Domain, clock=id_clock_pass) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index bc281b48a1..59cd7d83de 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -191,7 +191,7 @@ module MOM_hor_visc !! v[is-2:ie+2,js-2:je+2] !! h[is-1:ie+1,js-1:je+1] subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, & - thickness_diffuse, G, GV, US, CS, OBC) + G, GV, US, CS, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -213,8 +213,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, !! specify the spatially variable viscosities type(barotropic_CS), pointer :: Barotropic !< Pointer to a structure containing !! barotropic velocities - type(thickness_diffuse_CS), pointer :: thickness_diffuse !< Pointer to a structure containing - !! interface height diffusivities type(hor_visc_CS), pointer :: CS !< Control structure returned by a previous type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type !! call to hor_visc_init. From 0d1fbff65a0a2b145f4d4416d40c9d19ed092f8e Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 27 Jun 2019 10:36:06 -0600 Subject: [PATCH 102/106] Issue FATAL error if SPLIT=False and USE_GME=True --- .../lateral/MOM_hor_visc.F90 | 20 ++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 59cd7d83de..b0244965bb 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -190,8 +190,8 @@ module MOM_hor_visc !! u[is-2:ie+2,js-2:je+2] !! v[is-2:ie+2,js-2:je+2] !! h[is-1:ie+1,js-1:je+1] -subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, & - G, GV, US, CS, OBC) +subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, & + CS, OBC, Barotropic) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -199,7 +199,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thicknesses, in H + intent(inout) :: h !< Layer thicknesses, in H !! (usually m or kg m-2). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: diffu !< Zonal acceleration due to convergence of @@ -211,12 +211,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, Barotropic, !! related to Mesoscale Eddy Kinetic Energy. type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that !! specify the spatially variable viscosities - type(barotropic_CS), pointer :: Barotropic !< Pointer to a structure containing - !! barotropic velocities type(hor_visc_CS), pointer :: CS !< Control structure returned by a previous type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type !! call to hor_visc_init. type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type + type(barotropic_CS), optional, pointer :: Barotropic !< Pointer to a structure containing + !! barotropic velocities. ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & @@ -1407,6 +1407,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) logical :: get_all ! If true, read and log all parameters, regardless of ! whether they are used, to enable spell-checking of ! valid parameters. + logical :: split ! If true, use the split time stepping scheme. + ! If false and USE_GME = True, issue a FATAL error. character(len=64) :: inputdir, filename real :: deg2rad ! Converts degrees to radians real :: slat_fn ! sin(lat)**Kh_pwr_of_sine @@ -1639,6 +1641,14 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) "If true, use the GM+E backscatter scheme in association \n"//& "with the Gent and McWilliams parameterization.", default=.false.) + if (CS%use_GME) then + call get_param(param_file, mdl, "SPLIT", split, & + "Use the split time stepping if true.", default=.true., & + do_not_log=.true.) + if (.not. split) call MOM_error(FATAL,"ERROR: Currently, USE_GME = True "// & + "cannot be used with SPLIT=False.") + endif + if (CS%bound_Kh .or. CS%bound_Ah .or. CS%better_bound_Kh .or. CS%better_bound_Ah) & call get_param(param_file, mdl, "DT", dt, & "The (baroclinic) dynamics time step.", units = "s", & From 31dfefd928cfb374b6ac93d2328a1bd029d19edc Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 27 Jun 2019 11:27:36 -0600 Subject: [PATCH 103/106] Removes Barotropic and thickness_diffuse from MOM_dynamics_unsplit* --- src/core/MOM.F90 | 6 ++---- src/core/MOM_dynamics_unsplit.F90 | 8 ++------ src/core/MOM_dynamics_unsplit_RK2.F90 | 8 ++------ 3 files changed, 6 insertions(+), 16 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 75ad9c427f..3364943222 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -999,13 +999,11 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%use_RK2) then call step_MOM_dyn_unsplit_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE, & - CS%Barotropic_CSp, CS%thickness_diffuse_CSp) + CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE) else call step_MOM_dyn_unsplit(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE, & - CS%Barotropic_CSp, CS%thickness_diffuse_CSp, Waves=Waves) + CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE, Waves=Waves) endif if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_unsplit (step_MOM)") diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 999464ac77..dd03e11f42 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -183,7 +183,7 @@ module MOM_dynamics_unsplit !! 3rd order (for the inviscid momentum equations) order scheme subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, US, CS, & - VarMix, MEKE, Barotropic, thickness_diffuse, Waves) + VarMix, MEKE, Waves) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -218,10 +218,6 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! that specify the spatially variable viscosities. type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing !! fields related to the Mesoscale Eddy Kinetic Energy. - type(barotropic_CS), pointer :: Barotropic!< Pointer to a structure containing - !! barotropic velocities - type(thickness_diffuse_CS), pointer :: thickness_diffuse!< Pointer to a structure containing - !! interface height diffusivities type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions @@ -260,7 +256,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, & - Barotropic, G, GV, US, CS%hor_visc_CSp) + G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 28efd09bc3..2cb22b12fe 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -186,7 +186,7 @@ module MOM_dynamics_unsplit_RK2 !> Step the MOM6 dynamics using an unsplit quasi-2nd order Runge-Kutta scheme subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, US, CS, & - VarMix, MEKE, Barotropic, thickness_diffuse) + VarMix, MEKE) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -232,10 +232,6 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing !! fields related to the Mesoscale !! Eddy Kinetic Energy. - type(barotropic_CS), pointer :: Barotropic!< Pointer to a structure containing - !! barotropic velocities - type(thickness_diffuse_CS), pointer :: thickness_diffuse!< Pointer to a structure containing - !! interface height diffusivities ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up @@ -271,7 +267,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_in, v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & - Barotropic, G, GV, US, CS%hor_visc_CSp) + G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) call pass_vector(CS%diffu, CS%diffv, G%Domain, clock=id_clock_pass) From 47886e32fc3800d04384b507a3d08fca3031018d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 27 Jun 2019 11:29:04 -0600 Subject: [PATCH 104/106] Changes Barotropic to BT in horizontal_viscosity --- src/parameterizations/lateral/MOM_hor_visc.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index b0244965bb..977d9b9228 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -191,7 +191,7 @@ module MOM_hor_visc !! v[is-2:ie+2,js-2:je+2] !! h[is-1:ie+1,js-1:je+1] subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, & - CS, OBC, Barotropic) + CS, OBC, BT) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -215,7 +215,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type !! call to hor_visc_init. type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type - type(barotropic_CS), optional, pointer :: Barotropic !< Pointer to a structure containing + type(barotropic_CS), optional, pointer :: BT !< Pointer to a structure containing !! barotropic velocities. ! Local variables @@ -403,7 +403,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! call pass_var(boundary_mask, G%Domain, complete=.true.) ! Get barotropic velocities and their gradients - call barotropic_get_tav(Barotropic, ubtav, vbtav, G) + call barotropic_get_tav(BT, ubtav, vbtav, G) call pass_vector(ubtav, vbtav, G%Domain) do j=js,je ; do i=is,ie From 8f96916212b46f2572953ed3c12f30a7ce575440 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 27 Jun 2019 11:30:49 -0600 Subject: [PATCH 105/106] Passes optional arg. (BT=CS%barotropic_CSp) in calls to horizontal_viscosity --- src/core/MOM_dynamics_split_RK2.F90 | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 54ce838a4b..eb90bf472f 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -689,8 +689,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! diffu = horizontal viscosity terms (u_av) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_av, v_av, h_av, CS%diffu, CS%diffv, & - MEKE, Varmix, CS%barotropic_CSp, & - G, GV, US, CS%hor_visc_CSp, OBC=CS%OBC) + MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, & + OBC=CS%OBC, BT=CS%barotropic_CSp) call cpu_clock_end(id_clock_horvisc) if (showCallTree) call callTree_wayPoint("done with horizontal_viscosity (step_MOM_dyn_split_RK2)") @@ -1147,14 +1147,11 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%barotropic_CSp, restart_CS, calc_dtbt, CS%BT_cont, & CS%tides_CSp) -! CS%barotropic_CSp => Barotropic_CSp -! CS%thickness_diffuse_CSp => thickness_diffuse_CSp - if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) & call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & - CS%barotropic_CSp, G, GV, US, CS%hor_visc_CSp, & - OBC=CS%OBC) + G, GV, US, CS%hor_visc_CSp, & + OBC=CS%OBC, BT=CS%barotropic_CSp) if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then CS%u_av(:,:,:) = u(:,:,:) From 5c42192ffe66122e0dd935c5c60ab945e25fb1b4 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 28 Jun 2019 11:35:10 -0400 Subject: [PATCH 106/106] Removes trailing space --- src/core/MOM_dynamics_split_RK2.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index eb90bf472f..2422ac7028 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1150,7 +1150,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) & call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & - G, GV, US, CS%hor_visc_CSp, & + G, GV, US, CS%hor_visc_CSp, & OBC=CS%OBC, BT=CS%barotropic_CSp) if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then