diff --git a/.travis.yml b/.travis.yml index 5c5c31a6a4..1d200d1899 100644 --- a/.travis.yml +++ b/.travis.yml @@ -49,7 +49,7 @@ jobs: - stage: check and compile env: JOB="Code style compliance" script: - - ./.testing/trailer.py -e TEOS10 src config_src + - ./.testing/trailer.py -e TEOS10 -l 120 src config_src - stage: check and compile env: JOB="Doxygen" script: diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 919ad02820..efba8e8e8d 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -270,7 +270,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, 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. + hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses [H ~> m or kg m-2] + ! This form guarantees that hq/hu < 4. grad_vel_mag_bt_q ! Magnitude of the barotropic velocity gradient tensor squared at q-points [s-2] real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & @@ -1900,8 +1901,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%Smagorinsky_Ah) then 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))) + fmax = US%s_to_T*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) * & (fmax * BoundCorConst) endif diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 853072f28c..3a7d2a01a1 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -180,7 +180,8 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct) else ! Use EBT to get vertical structure first and then re-calculate cg1 using first baroclinic mode - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct, use_ebt_mode=.true.) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct, & + use_ebt_mode=.true.) call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) endif call pass_var(CS%ebt_struct, G%Domain) @@ -729,43 +730,51 @@ end subroutine calc_slope_functions_using_just_e !> Calculates the Leith Laplacian and bi-harmonic viscosity coefficients subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_xy_dx, vort_xy_dy) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< 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),SZJ_(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(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) -! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Ah_q !< Leith bi-harmonic viscosity at q-points (m4 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),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence + !! (d/dx(du/dx + dv/dy)) [m-1 s-1] + 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] +! 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) - dslopey_dz, & ! z-derivative of y-slope at v-points (m-1) - 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) +! 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 [H ~> 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) +! 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) - 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) + h_at_u, & ! Thickness at u-points [H ~> m or kg m-2] + beta_u, & ! Beta at u-points [m-1 s-1] + grad_vort_mag_u, & ! mag. of vort. grad. at u-points [s-1] + grad_div_mag_u ! mag. of div. grad. at u-points [s-1] +! 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,nz diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index da18462da6..3ebf159e3d 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -215,7 +215,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & + Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + & + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & (VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else @@ -293,8 +294,9 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js-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) + CS%MEKE_GEOMETRIC_epsilon) + Khth_Loc(I,j) = Khth_Loc(I,j) + & + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & + (VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do J=js-1,je ; do i=is,ie @@ -525,12 +527,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV type(MEKE_type), pointer :: MEKE !< MEKE control structure type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: int_slope_u !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from the - !! interface slopes without consideration of + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration of !! density gradients. real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: int_slope_v !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from the - !! interface slopes without consideration of + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration of !! 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 @@ -1344,13 +1346,13 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV real, intent(in) :: dt !< Time increment [s] type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from the - !! interface slopes without consideration of - !! density gradients. + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration + !! of density gradients. real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: int_slope_v !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from the - !! interface slopes without consideration of - !! density gradients. + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration + !! of density gradients. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & de_top ! The distances between the top of a layer and the top of the diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index b056ae3a76..decb834a6a 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -64,12 +64,14 @@ module RGC_tracer !> This subroutine is used to register tracer fields function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI ! Initializes the NTR tracer fields in tr(:,:,:,:) -! and it sets up the tracer output. +!! and it sets up the tracer output. subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & layer_CSp, sponge_CSp) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - logical, intent(in) :: restart !< .true. if the fields have already been read from a restart file. - type(time_type), target, intent(in) :: day !< Time of the start of the run. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. - type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, where, and what open boundary conditions are used. This is not being used for now. - type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call to RGC_register_tracer. - type(sponge_CS), pointer :: layer_CSp !< A pointer to the control structure - type(ALE_sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for the sponges, if they are in use. Otherwise this may be unassociated. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + logical, intent(in) :: restart !< .true. if the fields have already + !! been read from a restart file. + type(time_type), target, intent(in) :: day !< Time of the start of the run. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thickness, in m or kg m-2. + type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies + !! whether, where, and what open boundary + !! conditions are used. This is not being used for now. + type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to RGC_register_tracer. + type(sponge_CS), pointer :: layer_CSp !< A pointer to the control structure + type(ALE_sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for the + !! sponges, if they are in use. Otherwise this may be unassociated. real, allocatable :: temp(:,:,:) real, pointer, dimension(:,:,:) :: & @@ -265,8 +273,8 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & end subroutine initialize_RGC_tracer !> This subroutine applies diapycnal diffusion and any other column -! tracer physics or chemistry to the tracers from this file. -! This is a simple example of a set of advected passive tracers. +!! tracer physics or chemistry to the tracers from this file. +!! This is a simple example of a set of advected passive tracers. subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -283,20 +291,15 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call [s]. - type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call. - real, optional,intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can be fluxed out of the top layer in a timestep [nondim]. - real, optional,intent(in) :: minimum_forcing_depth !< The smallest depth over which fluxes can be applied [m]. - -! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. -! (in) h_new - Layer thickness after entrainment, in m or kg m-2. -! (in) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in m or kg m-2. -! (in) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible + !! forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call [s]. + type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call. + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can be + !! fluxed out of the top layer in a timestep [nondim]. + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which fluxes + !! can be applied [m]. + ! The arguments to this subroutine are redundant in that ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1]