\hypertarget{namespacemom__hor__visc}{}\section{mom\+\_\+hor\+\_\+visc Module Reference} \label{namespacemom__hor__visc}\index{mom\+\_\+hor\+\_\+visc@{mom\+\_\+hor\+\_\+visc}} \subsection{Detailed Description} Calculates horizontal viscosity and viscous stresses. This module contains the subroutine \hyperlink{namespacemom__hor__visc_ab3a26095634db15095b980e45137e1f1}{horizontal\+\_\+viscosity()} that calculates the effects of horizontal viscosity, including parameterizations of the value of the viscosity itself. \hyperlink{namespacemom__hor__visc_ab3a26095634db15095b980e45137e1f1}{horizontal\+\_\+viscosity()} calculates the acceleration due to some combination of a biharmonic viscosity and a Laplacian viscosity. Either or both may use a coefficient that depends on the shear and strain of the flow. All metric terms are retained. The Laplacian is calculated as the divergence of a stress tensor, using the form suggested by Smagorinsky (1993). The biharmonic is calculated by twice applying the divergence of the stress tensor that is used to calculate the Laplacian, but without the dependence on thickness in the first pass. This form permits a variable viscosity, and indicates no acceleration for either resting fluid or solid body rotation. The form of the viscous accelerations is discussed extensively in Griffies and Hallberg (2000), and the implementation here follows that discussion closely. We use the notation of Smith and Mc\+Williams (2003) with the exception that the isotropic viscosity is $\kappa_h$.\hypertarget{namespacemom__hor__visc_section_horizontal_viscosity}{}\subsection{Horizontal viscosity in M\+OM}\label{namespacemom__hor__visc_section_horizontal_viscosity} In general, the horizontal stress tensor can be written as \[ {\bf \sigma} = \begin{pmatrix} \frac{1}{2} \left( \sigma_D + \sigma_T \right) & \frac{1}{2} \sigma_S \\\\ \frac{1}{2} \sigma_S & \frac{1}{2} \left( \sigma_D - \sigma_T \right) \end{pmatrix} \] where $\sigma_D$, $\sigma_T$ and $\sigma_S$ are stresses associated with invariant factors in the strain-\/rate tensor. For a Newtonian fluid, the stress tensor is usually linearly related to the strain-\/rate tensor. The horizontal strain-\/rate tensor is \[ \dot{\bf e} = \begin{pmatrix} \frac{1}{2} \left( \dot{e}_D + \dot{e}_T \right) & \frac{1}{2} \dot{e}_S \\\\ \frac{1}{2} \dot{e}_S & \frac{1}{2} \left( \dot{e}_D - \dot{e}_T \right) \end{pmatrix} \] where $\dot{e}_D = \partial_x u + \partial_y v$ is the horizontal divergence, $\dot{e}_T = \partial_x u - \partial_y v$ is the horizontal tension, and $\dot{e}_S = \partial_y u + \partial_x v$ is the horizontal shear strain. The trace of the stress tensor, $tr(\bf \sigma) = \sigma_D$, is usually absorbed into the pressure and only the deviatoric stress tensor considered. From here on, we drop $\sigma_D$. The trace of the strain tensor, $tr(\bf e) = \dot{e}_D$ is non-\/zero for horizontally divergent flow but only enters the stress tensor through $\sigma_D$ and so we will drop $\sigma_D$ from calculations of the strain tensor in the code. Therefore the horizontal stress tensor can be considered to be \[ {\bf \sigma} = \begin{pmatrix} \frac{1}{2} \sigma_T & \frac{1}{2} \sigma_S \\\\ \frac{1}{2} \sigma_S & - \frac{1}{2} \sigma_T \end{pmatrix} .\] The stresses above are linearly related to the strain through a viscosity coefficient, $\kappa_h$\+: \begin{eqnarray*} \sigma_T & = & 2 \kappa_h \dot{e}_T \\\\ \sigma_S & = & 2 \kappa_h \dot{e}_S . \end{eqnarray*} The viscosity $\kappa_h$ may either be a constant or variable. For example, $\kappa_h$ may vary with the shear, as proposed by Smagorinsky (1993). The accelerations resulting form the divergence of the stress tensor are \begin{eqnarray*} \hat{\bf x} \cdot \left( \nabla \cdot {\bf \sigma} \right) & = & \partial_x \left( \frac{1}{2} \sigma_T \right) + \partial_y \left( \frac{1}{2} \sigma_S \right) \\\\ & = & \partial_x \left( \kappa_h \dot{e}_T \right) + \partial_y \left( \kappa_h \dot{e}_S \right) \\\\ \hat{\bf y} \cdot \left( \nabla \cdot {\bf \sigma} \right) & = & \partial_x \left( \frac{1}{2} \sigma_S \right) + \partial_y \left( \frac{1}{2} \sigma_T \right) \\\\ & = & \partial_x \left( \kappa_h \dot{e}_S \right) + \partial_y \left( - \kappa_h \dot{e}_T \right) . \end{eqnarray*} The form of the Laplacian viscosity in general coordinates is\+: \begin{eqnarray*} \hat{\bf x} \cdot \left( \nabla \cdot \sigma \right) & = & \frac{1}{h} \left[ \partial_x \left( \kappa_h h \dot{e}_T \right) + \partial_y \left( \kappa_h h \dot{e}_S \right) \right] \\\\ \hat{\bf y} \cdot \left( \nabla \cdot \sigma \right) & = & \frac{1}{h} \left[ \partial_x \left( \kappa_h h \dot{e}_S \right) - \partial_y \left( \kappa_h h \dot{e}_T \right) \right] . \end{eqnarray*}\hypertarget{namespacemom__hor__visc_section_laplacian_viscosity_coefficient}{}\subsubsection{Laplacian viscosity coefficient}\label{namespacemom__hor__visc_section_laplacian_viscosity_coefficient} The horizontal viscosity coefficient, $\kappa_h$, can have multiple components. The isotropic components are\+: \begin{DoxyItemize} \item A uniform background component, $\kappa_{bg}$. \item A constant but spatially variable 2D map, $\kappa_{2d}(x,y)$. \item A \textquotesingle{}\textquotesingle{}M\+I\+C\+OM\textquotesingle{}\textquotesingle{} viscosity, $U_\nu \Delta(x,y)$, which uses a constant velocity scale, $U_\nu$ and a measure of the grid-\/spacing $\Delta(x,y)^2 = \frac{2 \Delta x^2 \Delta y^2}{\Delta x^2 + \Delta y^2}$. \item A function of latitude, $\kappa_{\phi}(x,y) = \kappa_{\pi/2} |\sin(\phi)|^n$. \item A dynamic Smagorinsky viscosity, $\kappa_{Sm}(x,y,t) = C_{Sm} \Delta^2 \sqrt{\dot{e}_T^2 + \dot{e}_S^2}$. \item A dynamic Leith viscosity, $\kappa_{Lth}(x,y,t) = C_{Lth} \Delta^3 \sqrt{|\nabla \zeta|^2 + |\nabla \dot{e}_D|^2}$. \end{DoxyItemize} A maximum stable viscosity, $\kappa_{max}(x,y)$ is calculated based on the grid-\/spacing and time-\/step and used to clip calculated viscosities. The static components of $\kappa_h$ are first combined as follows\+: \[ \kappa_{static} = \min \left[ \max\left( \kappa_{bg}, U_\nu \Delta(x,y), \kappa_{2d}(x,y), \kappa_\phi(x,y) \right) , \kappa_{max}(x,y) \right] \] and stored in the module control structure as variables {\ttfamily Kh\+\_\+bg\+\_\+xx} and {\ttfamily Kh\+\_\+bg\+\_\+xy} for the tension (h-\/points) and shear (q-\/points) components respectively. The full viscosity includes the dynamic components as follows\+: \[ \kappa_h(x,y,t) = r(\Delta,L_d) \max \left( \kappa_{static}, \kappa_{Sm}, \kappa_{Lth} \right) \] where $r(\Delta,L_d)$ is a resolution function. The dynamic Smagorinsky and Leith viscosity schemes are exclusive with each other.\hypertarget{namespacemom__hor__visc_section_viscous_boundary_conditions}{}\subsubsection{Viscous boundary conditions}\label{namespacemom__hor__visc_section_viscous_boundary_conditions} Free slip boundary conditions have been coded, although no slip boundary conditions can be used with the Laplacian viscosity based on the 2D land-\/sea mask. For a western boundary, for example, the boundary conditions with the biharmonic operator would be written as\+: \[ \partial_x v = 0 ; \partial_x^3 v = 0 ; u = 0 ; \partial_x^2 u = 0 , \] while for a Laplacian operator, they are simply \[ \partial_x v = 0 ; u = 0 . \] These boundary conditions are largely dictated by the use of an Arakawa C-\/grid and by the varying layer thickness.\hypertarget{namespacemom__hor__visc_section_anisotropic_viscosity}{}\subsubsection{Anisotropic viscosity}\label{namespacemom__hor__visc_section_anisotropic_viscosity} Large et al., 2001, proposed enhancing viscosity in a particular direction and the approach was generalized in Smith and Mc\+Williams, 2003. We use the second form of their two coefficient anisotropic viscosity (section 4.\+3). We also replace their $A^\prime$ and \$D\$ such that $2A^\prime = 2 \kappa_h + D$ and $\kappa_a = D$ so that $\kappa_h$ can be considered the isotropic viscosity and $\kappa_a=D$ can be consider the anisotropic viscosity. The direction of anisotropy is defined by a unit vector $\hat{\bf n}=(n_1,n_2)$. The contributions to the stress tensor are \[ \begin{pmatrix} \sigma_T \\\\ \sigma_S \end{pmatrix} = \left[ \begin{pmatrix} 2 \kappa_h + \kappa_a & 0 \\\\ 0 & 2 \kappa_h \end{pmatrix} + 2 \kappa_a n_1 n_2 \begin{pmatrix} - 2 n_1 n_2 & n_1^2 - n_2^2 \\\\ n_1^2 - n_2^2 & 2 n_1 n_2 \end{pmatrix} \right] \begin{pmatrix} \dot{e}_T \\\\ \dot{e}_S \end{pmatrix} \] Dissipation of kinetic energy requires $\kappa_h \geq 0$ and $2 \kappa_h + \kappa_a \geq 0$. Note that when anisotropy is aligned with the x-\/direction, $n_1 = \pm 1$, then $n_2 = 0$ and the cross terms vanish. The accelerations in this aligned limit with constant coefficients become \begin{eqnarray*} \hat{\bf x} \cdot \nabla \cdot {\bf \sigma} & = & \partial_x \left( \left( \kappa_h + \frac{1}{2} \kappa_a \right) \dot{e}_T \right) + \partial_y \left( \kappa_h \dot{e}_S \right) \\\\ & = & \left( \kappa_h + \kappa_a \right) \partial_{xx} u + \kappa_h \partial_{yy} u - \frac{1}{2} \kappa_a \partial_x \left( \partial_x u + \partial_y v \right) \\\\ \hat{\bf y} \cdot \nabla \cdot {\bf \sigma} & = & \partial_x \left( \kappa_h \dot{e}_S \right) - \partial_y \left( \left( \kappa_h + \frac{1}{2} \kappa_a \right) \dot{e}_T \right) \\\\ & = & \kappa_h \partial_{xx} v + \left( \kappa_h + \kappa_a \right) \partial_{yy} v - \frac{1}{2} \kappa_a \partial_y \left( \partial_x u + \partial_y v \right) \end{eqnarray*} which has contributions akin to a negative divergence damping (a divergence enhancement?) but which is weaker than the enhanced tension terms by half.\hypertarget{namespacemom__hor__visc_section_viscous_discretization}{}\subsubsection{Discretization}\label{namespacemom__hor__visc_section_viscous_discretization} The horizontal tension, $\dot{e}_T$, is stored in variable {\ttfamily sh\+\_\+xx} and discretized as \[ \dot{e}_T = \frac{\Delta y}{\Delta x} \delta_i \left( \frac{1}{\Delta y} u \right) - \frac{\Delta x}{\Delta y} \delta_j \left( \frac{1}{\Delta x} v \right) . \] The horizontal divergent strain, $\dot{e}_D$, is stored in variable {\ttfamily div\+\_\+xx} and discretized as \[ \dot{e}_D = \frac{1}{h A} \left( \delta_i \left( \overline{h}^i \Delta y \, u \right) + \delta_j \left( \overline{h}^j\Delta x \, v \right) \right) . \] Note that for expediency this is the exact discretization used in the continuity equation. The horizontal shear strain, $\dot{e}_S$, is stored in variable {\ttfamily sh\+\_\+xy} and discretized as \[ \dot{e}_S = v_x + u_y \] where \begin{align*} v_x &= \frac{\Delta y}{\Delta x} \delta_i \left( \frac{1}{\Delta y} v \right) \\\\ u_y &= \frac{\Delta x}{\Delta y} \delta_j \left( \frac{1}{\Delta x} u \right) \end{align*} which are calculated separately so that no-\/slip or free-\/slip boundary conditions can be applied to $v_x$ and $u_y$ where appropriate. The tendency for the x-\/component of the divergence of stress is stored in variable {\ttfamily diffu} and discretized as \[ \hat{\bf x} \cdot \left( \nabla \cdot {\bf \sigma} \right) = \frac{1}{A \overline{h}^i} \left( \frac{1}{\Delta y} \delta_i \left( h \Delta y^2 \kappa_h \dot{e}_T \right) + \frac{1}{\Delta x} \delta_j \left( \tilde{h}^{ij} \Delta x^2 \kappa_h \dot{e}_S \right) \right) . \] The tendency for the y-\/component of the divergence of stress is stored in variable {\ttfamily diffv} and discretized as \[ \hat{\bf y} \cdot \left( \nabla \cdot {\bf \sigma} \right) = \frac{1}{A \overline{h}^j} \left( \frac{1}{\Delta y} \delta_i \left( \tilde{h}^{ij} \Delta y^2 A_M \dot{e}_S \right) - \frac{1}{\Delta x} \delta_j \left( h \Delta x^2 A_M \dot{e}_T \right) \right) . \]\hypertarget{namespacemom__hor__visc_section_viscous_refs}{}\subsubsection{References}\label{namespacemom__hor__visc_section_viscous_refs} Griffies, S.\+M., and Hallberg, R.\+W., 2000\+: Biharmonic friction with a Smagorinsky-\/like viscosity for use in large-\/scale eddy-\/permitting ocean models. Monthly Weather Review, 128(8), 2935-\/2946. \href{https://doi.org/10.1175/1520-0493(2000)128%3C2935:BFWASL%3E2.0.CO;2}{\tt https\+://doi.\+org/10.\+1175/1520-\/0493(2000)128\%3\+C2935\+:\+B\+F\+W\+A\+S\+L\%3\+E2.\+0.\+C\+O;2} Large, W.\+G., Danabasoglu, G., Mc\+Williams, J.\+C., Gent, P.\+R. and Bryan, F.\+O., 2001\+: Equatorial circulation of a global ocean climate model with anisotropic horizontal viscosity. Journal of Physical Oceanography, 31(2), pp.\+518-\/536. \href{https://doi.org/10.1175/1520-0485(2001)031%3C0518:ECOAGO%3E2.0.CO;2}{\tt https\+://doi.\+org/10.\+1175/1520-\/0485(2001)031\%3\+C0518\+:\+E\+C\+O\+A\+G\+O\%3\+E2.\+0.\+C\+O;2} Smagorinsky, J., 1993\+: Some historical remarks on the use of nonlinear viscosities. Large eddy simulation of complex engineering and geophysical flows, 1, 69-\/106. Smith, R.\+D., and Mc\+Williams, J.\+C., 2003\+: Anisotropic horizontal viscosity for ocean models. Ocean Modelling, 5(2), 129-\/156. \href{https://doi.org/10.1016/S1463-5003(02)00016-1}{\tt https\+://doi.\+org/10.\+1016/\+S1463-\/5003(02)00016-\/1} \subsection*{Data Types} \begin{DoxyCompactItemize} \item type \hyperlink{structmom__hor__visc_1_1hor__visc__cs}{hor\+\_\+visc\+\_\+cs} \begin{DoxyCompactList}\small\item\em Control structure for horizontal viscosity. \end{DoxyCompactList}\end{DoxyCompactItemize} \subsection*{Functions/\+Subroutines} \begin{DoxyCompactItemize} \item subroutine, public \hyperlink{namespacemom__hor__visc_ab3a26095634db15095b980e45137e1f1}{horizontal\+\_\+viscosity} (u, v, h, diffu, diffv, M\+E\+KE, Var\+Mix, G, GV, US, CS, O\+BC, BT, TD, A\+Dp) \begin{DoxyCompactList}\small\item\em Calculates the acceleration due to the horizontal viscosity. \end{DoxyCompactList}\item subroutine, public \hyperlink{namespacemom__hor__visc_ae9e2abbb7908dbd548c8f6ce335c5303}{hor\+\_\+visc\+\_\+init} (Time, G, US, param\+\_\+file, diag, CS, M\+E\+KE, A\+Dp) \begin{DoxyCompactList}\small\item\em Allocates space for and calculates static variables used by \hyperlink{namespacemom__hor__visc_ab3a26095634db15095b980e45137e1f1}{horizontal\+\_\+viscosity()}. hor\+\_\+visc\+\_\+init calculates and stores the values of a number of metric functions that are used in \hyperlink{namespacemom__hor__visc_ab3a26095634db15095b980e45137e1f1}{horizontal\+\_\+viscosity()}. \end{DoxyCompactList}\item subroutine \hyperlink{namespacemom__hor__visc_abbd712954c311516d28c7d6a46e6c381}{align\+\_\+aniso\+\_\+tensor\+\_\+to\+\_\+grid} (CS, n1, n2) \begin{DoxyCompactList}\small\item\em Calculates factors in the anisotropic orientation tensor to be align with the grid. With n1=1 and n2=0, this recovers the approach of Large et al, 2001. \end{DoxyCompactList}\item subroutine \hyperlink{namespacemom__hor__visc_a686fed1d7dd5311ab016b6f637aa7304}{smooth\+\_\+gme} (CS, G, G\+M\+E\+\_\+flux\+\_\+h, G\+M\+E\+\_\+flux\+\_\+q) \begin{DoxyCompactList}\small\item\em Apply a 1-\/1-\/4-\/1-\/1 Laplacian filter one time on G\+ME diffusive flux to reduce any horizontal two-\/grid-\/point noise. \end{DoxyCompactList}\item subroutine, public \hyperlink{namespacemom__hor__visc_a677ff53dc44cfbf175d9d02627aa92fd}{hor\+\_\+visc\+\_\+end} (CS) \begin{DoxyCompactList}\small\item\em Deallocates any variables allocated in hor\+\_\+visc\+\_\+init. \end{DoxyCompactList}\end{DoxyCompactItemize} \subsection{Function/\+Subroutine Documentation} \mbox{\Hypertarget{namespacemom__hor__visc_abbd712954c311516d28c7d6a46e6c381}\label{namespacemom__hor__visc_abbd712954c311516d28c7d6a46e6c381}} \index{mom\+\_\+hor\+\_\+visc@{mom\+\_\+hor\+\_\+visc}!align\+\_\+aniso\+\_\+tensor\+\_\+to\+\_\+grid@{align\+\_\+aniso\+\_\+tensor\+\_\+to\+\_\+grid}} \index{align\+\_\+aniso\+\_\+tensor\+\_\+to\+\_\+grid@{align\+\_\+aniso\+\_\+tensor\+\_\+to\+\_\+grid}!mom\+\_\+hor\+\_\+visc@{mom\+\_\+hor\+\_\+visc}} \subsubsection{\texorpdfstring{align\+\_\+aniso\+\_\+tensor\+\_\+to\+\_\+grid()}{align\_aniso\_tensor\_to\_grid()}} {\footnotesize\ttfamily subroutine mom\+\_\+hor\+\_\+visc\+::align\+\_\+aniso\+\_\+tensor\+\_\+to\+\_\+grid (\begin{DoxyParamCaption}\item[{type(\hyperlink{structmom__hor__visc_1_1hor__visc__cs}{hor\+\_\+visc\+\_\+cs}), pointer}]{CS, }\item[{real, intent(in)}]{n1, }\item[{real, intent(in)}]{n2 }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} Calculates factors in the anisotropic orientation tensor to be align with the grid. With n1=1 and n2=0, this recovers the approach of Large et al, 2001. \begin{DoxyParams}[1]{Parameters} & {\em cs} & Control structure for horizontal viscosity\\ \hline \mbox{\tt in} & {\em n1} & i-\/component of direction vector \mbox{[}nondim\mbox{]}\\ \hline \mbox{\tt in} & {\em n2} & j-\/component of direction vector \mbox{[}nondim\mbox{]} \\ \hline \end{DoxyParams} Definition at line 2176 of file M\+O\+M\+\_\+hor\+\_\+visc.\+F90. \begin{DoxyCode} 2176 \textcolor{keywordtype}{type}(hor\_visc\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< Control structure for horizontal viscosity} 2177 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(in)} :: n1\textcolor{comment}{ !< i-component of direction vector [nondim]} 2178 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(in)} :: n2\textcolor{comment}{ !< j-component of direction vector [nondim]} 2179 \textcolor{comment}{! Local variables} 2180 \textcolor{keywordtype}{real} :: recip\_n2\_norm 2181 \textcolor{comment}{! For normalizing n=(n1,n2) in case arguments are not a unit vector} 2182 recip\_n2\_norm = n1**2 + n2**2 2183 \textcolor{keywordflow}{if} (recip\_n2\_norm > 0.) recip\_n2\_norm = 1./recip\_n2\_norm 2184 cs%n1n2\_h(:,:) = 2. * ( n1 * n2 ) * recip\_n2\_norm 2185 cs%n1n2\_q(:,:) = 2. * ( n1 * n2 ) * recip\_n2\_norm 2186 cs%n1n1\_m\_n2n2\_h(:,:) = ( n1 * n1 - n2 * n2 ) * recip\_n2\_norm 2187 cs%n1n1\_m\_n2n2\_q(:,:) = ( n1 * n1 - n2 * n2 ) * recip\_n2\_norm \end{DoxyCode} \mbox{\Hypertarget{namespacemom__hor__visc_a677ff53dc44cfbf175d9d02627aa92fd}\label{namespacemom__hor__visc_a677ff53dc44cfbf175d9d02627aa92fd}} \index{mom\+\_\+hor\+\_\+visc@{mom\+\_\+hor\+\_\+visc}!hor\+\_\+visc\+\_\+end@{hor\+\_\+visc\+\_\+end}} \index{hor\+\_\+visc\+\_\+end@{hor\+\_\+visc\+\_\+end}!mom\+\_\+hor\+\_\+visc@{mom\+\_\+hor\+\_\+visc}} \subsubsection{\texorpdfstring{hor\+\_\+visc\+\_\+end()}{hor\_visc\_end()}} {\footnotesize\ttfamily subroutine, public mom\+\_\+hor\+\_\+visc\+::hor\+\_\+visc\+\_\+end (\begin{DoxyParamCaption}\item[{type(\hyperlink{structmom__hor__visc_1_1hor__visc__cs}{hor\+\_\+visc\+\_\+cs}), pointer}]{CS }\end{DoxyParamCaption})} Deallocates any variables allocated in hor\+\_\+visc\+\_\+init. \begin{DoxyParams}{Parameters} {\em cs} & The control structure returned by a previous call to hor\+\_\+visc\+\_\+init. \\ \hline \end{DoxyParams} Definition at line 2253 of file M\+O\+M\+\_\+hor\+\_\+visc.\+F90. \begin{DoxyCode} 2253 \textcolor{keywordtype}{type}(hor\_visc\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< The control structure returned by a} 2254 \textcolor{comment}{ !! previous call to hor\_visc\_init.} 2255 \textcolor{keywordflow}{if} (cs%Laplacian .or. cs%biharmonic) \textcolor{keywordflow}{then} 2256 dealloc\_(cs%dx2h) ; dealloc\_(cs%dx2q) ; dealloc\_(cs%dy2h) ; dealloc\_(cs%dy2q) 2257 dealloc\_(cs%dx\_dyT) ; dealloc\_(cs%dy\_dxT) ; dealloc\_(cs%dx\_dyBu) ; dealloc\_(cs%dy\_dxBu) 2258 dealloc\_(cs%reduction\_xx) ; dealloc\_(cs%reduction\_xy) 2259 \textcolor{keywordflow}{ endif} 2260 \textcolor{keywordflow}{if} (cs%Laplacian) \textcolor{keywordflow}{then} 2261 dealloc\_(cs%Kh\_bg\_xx) ; dealloc\_(cs%Kh\_bg\_xy) 2262 dealloc\_(cs%grid\_sp\_h2) 2263 \textcolor{keywordflow}{if} (cs%bound\_Kh) \textcolor{keywordflow}{then} 2264 dealloc\_(cs%Kh\_Max\_xx) ; dealloc\_(cs%Kh\_Max\_xy) 2265 \textcolor{keywordflow}{ endif} 2266 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Kh) \textcolor{keywordflow}{then} 2267 dealloc\_(cs%Laplac2\_const\_xx) ; dealloc\_(cs%Laplac2\_const\_xy) 2268 \textcolor{keywordflow}{ endif} 2269 \textcolor{keywordflow}{if} (cs%Leith\_Kh) \textcolor{keywordflow}{then} 2270 dealloc\_(cs%Laplac3\_const\_xx) ; dealloc\_(cs%Laplac3\_const\_xy) 2271 \textcolor{keywordflow}{ endif} 2272 \textcolor{keywordflow}{ endif} 2273 \textcolor{keywordflow}{if} (cs%biharmonic) \textcolor{keywordflow}{then} 2274 dealloc\_(cs%grid\_sp\_h3) 2275 dealloc\_(cs%Idx2dyCu) ; dealloc\_(cs%Idx2dyCv) 2276 dealloc\_(cs%Idxdy2u) ; dealloc\_(cs%Idxdy2v) 2277 dealloc\_(cs%Ah\_bg\_xx) ; dealloc\_(cs%Ah\_bg\_xy) 2278 \textcolor{keywordflow}{if} (cs%bound\_Ah) \textcolor{keywordflow}{then} 2279 dealloc\_(cs%Ah\_Max\_xx) ; dealloc\_(cs%Ah\_Max\_xy) 2280 \textcolor{keywordflow}{ endif} 2281 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Ah) \textcolor{keywordflow}{then} 2282 dealloc\_(cs%Biharm6\_const\_xx) ; dealloc\_(cs%Biharm6\_const\_xy) 2283 \textcolor{keywordflow}{ endif} 2284 \textcolor{keywordflow}{if} (cs%Leith\_Ah) \textcolor{keywordflow}{then} 2285 dealloc\_(cs%Biharm\_const\_xx) ; dealloc\_(cs%Biharm\_const\_xy) 2286 \textcolor{keywordflow}{ endif} 2287 \textcolor{keywordflow}{if} (cs%Re\_Ah > 0.0) \textcolor{keywordflow}{then} 2288 dealloc\_(cs%Re\_Ah\_const\_xx) ; dealloc\_(cs%Re\_Ah\_const\_xy) 2289 \textcolor{keywordflow}{ endif} 2290 \textcolor{keywordflow}{ endif} 2291 \textcolor{keywordflow}{if} (cs%anisotropic) \textcolor{keywordflow}{then} 2292 dealloc\_(cs%n1n2\_h) 2293 dealloc\_(cs%n1n2\_q) 2294 dealloc\_(cs%n1n1\_m\_n2n2\_h) 2295 dealloc\_(cs%n1n1\_m\_n2n2\_q) 2296 \textcolor{keywordflow}{ endif} 2297 \textcolor{keyword}{deallocate}(cs) \end{DoxyCode} \mbox{\Hypertarget{namespacemom__hor__visc_ae9e2abbb7908dbd548c8f6ce335c5303}\label{namespacemom__hor__visc_ae9e2abbb7908dbd548c8f6ce335c5303}} \index{mom\+\_\+hor\+\_\+visc@{mom\+\_\+hor\+\_\+visc}!hor\+\_\+visc\+\_\+init@{hor\+\_\+visc\+\_\+init}} \index{hor\+\_\+visc\+\_\+init@{hor\+\_\+visc\+\_\+init}!mom\+\_\+hor\+\_\+visc@{mom\+\_\+hor\+\_\+visc}} \subsubsection{\texorpdfstring{hor\+\_\+visc\+\_\+init()}{hor\_visc\_init()}} {\footnotesize\ttfamily subroutine, public mom\+\_\+hor\+\_\+visc\+::hor\+\_\+visc\+\_\+init (\begin{DoxyParamCaption}\item[{type(time\+\_\+type), intent(in)}]{Time, }\item[{type(ocean\+\_\+grid\+\_\+type), intent(inout)}]{G, }\item[{type(unit\+\_\+scale\+\_\+type), intent(in)}]{US, }\item[{type(param\+\_\+file\+\_\+type), intent(in)}]{param\+\_\+file, }\item[{type(diag\+\_\+ctrl), intent(inout), target}]{diag, }\item[{type(\hyperlink{structmom__hor__visc_1_1hor__visc__cs}{hor\+\_\+visc\+\_\+cs}), pointer}]{CS, }\item[{type(meke\+\_\+type), pointer}]{M\+E\+KE, }\item[{type(accel\+\_\+diag\+\_\+ptrs), optional, pointer}]{A\+Dp }\end{DoxyParamCaption})} Allocates space for and calculates static variables used by \hyperlink{namespacemom__hor__visc_ab3a26095634db15095b980e45137e1f1}{horizontal\+\_\+viscosity()}. hor\+\_\+visc\+\_\+init calculates and stores the values of a number of metric functions that are used in \hyperlink{namespacemom__hor__visc_ab3a26095634db15095b980e45137e1f1}{horizontal\+\_\+viscosity()}. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in} & {\em time} & Current model time.\\ \hline \mbox{\tt in,out} & {\em g} & The ocean\textquotesingle{}s grid structure.\\ \hline \mbox{\tt in} & {\em us} & A dimensional unit scaling type\\ \hline \mbox{\tt in} & {\em param\+\_\+file} & A structure to parse for run-\/time parameters.\\ \hline \mbox{\tt in,out} & {\em diag} & Structure to regulate diagnostic output.\\ \hline & {\em cs} & Pointer to the control structure for this module\\ \hline & {\em meke} & M\+E\+KE data\\ \hline & {\em adp} & Acceleration diagnostic pointers \\ \hline \end{DoxyParams} Definition at line 1418 of file M\+O\+M\+\_\+hor\+\_\+visc.\+F90. \begin{DoxyCode} 1418 \textcolor{keywordtype}{type}(time\_type), \textcolor{keywordtype}{intent(in)} :: time\textcolor{comment}{ !< Current model time.} 1419 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(inout)} :: g\textcolor{comment}{ !< The ocean's grid structure.} 1420 \textcolor{keywordtype}{type}(unit\_scale\_type), \textcolor{keywordtype}{intent(in)} :: us\textcolor{comment}{ !< A dimensional unit scaling type} 1421 \textcolor{keywordtype}{type}(param\_file\_type), \textcolor{keywordtype}{intent(in)} :: param\_file\textcolor{comment}{ !< A structure to parse for run-time} 1422 \textcolor{comment}{ !! parameters.} 1423 \textcolor{keywordtype}{type}(diag\_ctrl), \textcolor{keywordtype}{target}, \textcolor{keywordtype}{intent(inout)} :: diag\textcolor{comment}{ !< Structure to regulate diagnostic output.} 1424 \textcolor{keywordtype}{type}(hor\_visc\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< Pointer to the control structure for this module} 1425 \textcolor{keywordtype}{type}(meke\_type), \textcolor{keywordtype}{pointer} :: meke\textcolor{comment}{ !< MEKE data} 1426 \textcolor{keywordtype}{type}(accel\_diag\_ptrs), \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: adp\textcolor{comment}{ !< Acceleration diagnostic pointers} 1427 \textcolor{comment}{! Local variables} 1428 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G))} :: u0u, u0v 1429 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G))} :: v0u, v0v 1430 \textcolor{comment}{! u0v is the Laplacian sensitivities to the v velocities} 1431 \textcolor{comment}{! at u points [L-2 ~> m-2], with u0u, v0u, and v0v defined similarly.} 1432 \textcolor{keywordtype}{real} :: grid\_sp\_h2 \textcolor{comment}{! Harmonic mean of the squares of the grid [L2 ~> m2]} 1433 \textcolor{keywordtype}{real} :: grid\_sp\_h3 \textcolor{comment}{! Harmonic mean of the squares of the grid^(3/2) [L3 ~> m3]} 1434 \textcolor{keywordtype}{real} :: grid\_sp\_q2 \textcolor{comment}{! spacings at h and q points [L2 ~> m2]} 1435 \textcolor{keywordtype}{real} :: grid\_sp\_q3 \textcolor{comment}{! spacings at h and q points^(3/2) [L3 ~> m3]} 1436 \textcolor{keywordtype}{real} :: min\_grid\_sp\_h2 \textcolor{comment}{! Minimum value of grid\_sp\_h2 [L2 ~> m2]} 1437 \textcolor{keywordtype}{real} :: min\_grid\_sp\_h4 \textcolor{comment}{! Minimum value of grid\_sp\_h2**2 [L4 ~> m4]} 1438 \textcolor{keywordtype}{real} :: kh\_limit \textcolor{comment}{! A coefficient [T-1 ~> s-1] used, along with the} 1439 \textcolor{comment}{! grid spacing, to limit Laplacian viscosity.} 1440 \textcolor{keywordtype}{real} :: fmax \textcolor{comment}{! maximum absolute value of f at the four} 1441 \textcolor{comment}{! vorticity points around a thickness point [T-1 ~> s-1]} 1442 \textcolor{keywordtype}{real} :: boundcorconst \textcolor{comment}{! A constant used when using viscosity to bound the Coriolis accelerations} 1443 \textcolor{comment}{! [T2 L-2 ~> s2 m-2]} 1444 \textcolor{keywordtype}{real} :: ah\_limit \textcolor{comment}{! coefficient [T-1 ~> s-1] used, along with the} 1445 \textcolor{comment}{! grid spacing, to limit biharmonic viscosity} 1446 \textcolor{keywordtype}{real} :: kh \textcolor{comment}{! Lapacian horizontal viscosity [L2 T-1 ~> m2 s-1]} 1447 \textcolor{keywordtype}{real} :: ah \textcolor{comment}{! biharmonic horizontal viscosity [L4 T-1 ~> m4 s-1]} 1448 \textcolor{keywordtype}{real} :: kh\_vel\_scale \textcolor{comment}{! this speed [L T-1 ~> m s-1] times grid spacing gives Lap visc} 1449 \textcolor{keywordtype}{real} :: ah\_vel\_scale \textcolor{comment}{! this speed [L T-1 ~> m s-1] times grid spacing cubed gives bih visc} 1450 \textcolor{keywordtype}{real} :: ah\_time\_scale \textcolor{comment}{! damping time-scale for biharmonic visc [T ~> s]} 1451 \textcolor{keywordtype}{real} :: smag\_lap\_const \textcolor{comment}{! nondimensional Laplacian Smagorinsky constant} 1452 \textcolor{keywordtype}{real} :: smag\_bi\_const \textcolor{comment}{! nondimensional biharmonic Smagorinsky constant} 1453 \textcolor{keywordtype}{real} :: leith\_lap\_const \textcolor{comment}{! nondimensional Laplacian Leith constant} 1454 \textcolor{keywordtype}{real} :: leith\_bi\_const \textcolor{comment}{! nondimensional biharmonic Leith constant} 1455 \textcolor{keywordtype}{real} :: dt \textcolor{comment}{! The dynamics time step [T ~> s]} 1456 \textcolor{keywordtype}{real} :: idt \textcolor{comment}{! The inverse of dt [T-1 ~> s-1]} 1457 \textcolor{keywordtype}{real} :: denom \textcolor{comment}{! work variable; the denominator of a fraction} 1458 \textcolor{keywordtype}{real} :: maxvel \textcolor{comment}{! largest permitted velocity components [m s-1]} 1459 \textcolor{keywordtype}{real} :: bound\_cor\_vel \textcolor{comment}{! grid-scale velocity variations at which value} 1460 \textcolor{comment}{! the quadratically varying biharmonic viscosity} 1461 \textcolor{comment}{! balances Coriolis acceleration [L T-1 ~> m s-1]} 1462 \textcolor{keywordtype}{real} :: kh\_sin\_lat \textcolor{comment}{! Amplitude of latitudinally dependent viscosity [L2 T-1 ~> m2 s-1]} 1463 \textcolor{keywordtype}{real} :: kh\_pwr\_of\_sine \textcolor{comment}{! Power used to raise sin(lat) when using Kh\_sin\_lat} 1464 \textcolor{keywordtype}{logical} :: bound\_cor\_def \textcolor{comment}{! parameter setting of BOUND\_CORIOLIS} 1465 \textcolor{keywordtype}{logical} :: get\_all \textcolor{comment}{! If true, read and log all parameters, regardless of} 1466 \textcolor{comment}{! whether they are used, to enable spell-checking of} 1467 \textcolor{comment}{! valid parameters.} 1468 \textcolor{keywordtype}{logical} :: split \textcolor{comment}{! If true, use the split time stepping scheme.} 1469 \textcolor{comment}{! If false and USE\_GME = True, issue a FATAL error.} 1470 \textcolor{keywordtype}{logical} :: default\_2018\_answers 1471 \textcolor{keywordtype}{character(len=64)} :: inputdir, filename 1472 \textcolor{keywordtype}{real} :: deg2rad \textcolor{comment}{! Converts degrees to radians} 1473 \textcolor{keywordtype}{real} :: slat\_fn \textcolor{comment}{! sin(lat)**Kh\_pwr\_of\_sine} 1474 \textcolor{keywordtype}{real} :: aniso\_grid\_dir(2) \textcolor{comment}{! Vector (n1,n2) for anisotropic direction} 1475 \textcolor{keywordtype}{integer} :: aniso\_mode \textcolor{comment}{! Selects the mode for setting the anisotropic direction} 1476 \textcolor{keywordtype}{integer} :: is, ie, js, je, isq, ieq, jsq, jeq, nz 1477 \textcolor{keywordtype}{integer} :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb 1478 \textcolor{keywordtype}{integer} :: i, j 1479 \textcolor{comment}{! This include declares and sets the variable "version".} 1480 \textcolor{preprocessor}{#include "version\_variable.h"} 1481 \textcolor{preprocessor}{} \textcolor{keywordtype}{character(len=40)} :: mdl = \textcolor{stringliteral}{"MOM\_hor\_visc"} \textcolor{comment}{! module name} 1482 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke 1483 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB 1484 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed 1485 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB 1486 \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(cs)) \textcolor{keywordflow}{then} 1487 \textcolor{keyword}{call }mom\_error(warning, \textcolor{stringliteral}{"hor\_visc\_init called with an associated "}// & 1488 \textcolor{stringliteral}{"control structure."}) 1489 \textcolor{keywordflow}{return} 1490 \textcolor{keywordflow}{ endif} 1491 \textcolor{keyword}{allocate}(cs) 1492 cs%diag => diag 1493 \textcolor{comment}{! Read parameters and write them to the model log.} 1494 \textcolor{keyword}{call }log\_version(param\_file, mdl, version, \textcolor{stringliteral}{""}) 1495 \textcolor{comment}{! It is not clear whether these initialization lines are needed for the} 1496 \textcolor{comment}{! cases where the corresponding parameters are not read.} 1497 cs%bound\_Kh = .false. ; cs%better\_bound\_Kh = .false. ; cs%Smagorinsky\_Kh = .false. ; cs%Leith\_Kh = .false . 1498 cs%bound\_Ah = .false. ; cs%better\_bound\_Ah = .false. ; cs%Smagorinsky\_Ah = .false. ; cs%Leith\_Ah = .false . 1499 cs%use\_QG\_Leith\_visc = .false. 1500 cs%bound\_Coriolis = .false. 1501 cs%Modified\_Leith = .false. 1502 cs%anisotropic = .false. 1503 cs%dynamic\_aniso = .false. 1504 kh = 0.0 ; ah = 0.0 1505 \textcolor{comment}{! If GET\_ALL\_PARAMS is true, all parameters are read in all cases to enable} 1506 \textcolor{comment}{! parameter spelling checks.} 1507 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"GET\_ALL\_PARAMS"}, get\_all, default=.false.) 1508 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"DEFAULT\_2018\_ANSWERS"}, default\_2018\_answers, & 1509 \textcolor{stringliteral}{"This sets the default value for the various \_2018\_ANSWERS parameters."}, & 1510 default=.false.) 1511 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"HOR\_VISC\_2018\_ANSWERS"}, cs%answers\_2018, & 1512 \textcolor{stringliteral}{"If true, use the order of arithmetic and expressions that recover the "}//& 1513 \textcolor{stringliteral}{"answers from the end of 2018. Otherwise, use updated and more robust "}//& 1514 \textcolor{stringliteral}{"forms of the same expressions."}, default=default\_2018\_answers) 1515 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"DEBUG"}, cs%debug, default=.false.) 1516 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"LAPLACIAN"}, cs%Laplacian, & 1517 \textcolor{stringliteral}{"If true, use a Laplacian horizontal viscosity."}, & 1518 default=.false.) 1519 \textcolor{keywordflow}{if} (cs%Laplacian .or. get\_all) \textcolor{keywordflow}{then} 1520 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"KH"}, kh, & 1521 \textcolor{stringliteral}{"The background Laplacian horizontal viscosity."}, & 1522 units = \textcolor{stringliteral}{"m2 s-1"}, default=0.0, scale=us%m\_to\_L**2*us%T\_to\_s) 1523 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"KH\_BG\_MIN"}, cs%Kh\_bg\_min, & 1524 \textcolor{stringliteral}{"The minimum value allowed for Laplacian horizontal viscosity, KH."}, & 1525 units = \textcolor{stringliteral}{"m2 s-1"}, default=0.0, scale=us%m\_to\_L**2*us%T\_to\_s) 1526 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"KH\_VEL\_SCALE"}, kh\_vel\_scale, & 1527 \textcolor{stringliteral}{"The velocity scale which is multiplied by the grid "}//& 1528 \textcolor{stringliteral}{"spacing to calculate the Laplacian viscosity. "}//& 1529 \textcolor{stringliteral}{"The final viscosity is the largest of this scaled "}//& 1530 \textcolor{stringliteral}{"viscosity, the Smagorinsky and Leith viscosities, and KH."}, & 1531 units=\textcolor{stringliteral}{"m s-1"}, default=0.0, scale=us%m\_s\_to\_L\_T) 1532 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"KH\_SIN\_LAT"}, kh\_sin\_lat, & 1533 \textcolor{stringliteral}{"The amplitude of a latitudinally-dependent background "}//& 1534 \textcolor{stringliteral}{"viscosity of the form KH\_SIN\_LAT*(SIN(LAT)**KH\_PWR\_OF\_SINE)."}, & 1535 units = \textcolor{stringliteral}{"m2 s-1"}, default=0.0, scale=us%m\_to\_L**2*us%T\_to\_s) 1536 \textcolor{keywordflow}{if} (kh\_sin\_lat>0. .or. get\_all) & 1537 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"KH\_PWR\_OF\_SINE"}, kh\_pwr\_of\_sine, & 1538 \textcolor{stringliteral}{"The power used to raise SIN(LAT) when using a latitudinally "}//& 1539 \textcolor{stringliteral}{"dependent background viscosity."}, & 1540 units = \textcolor{stringliteral}{"nondim"}, default=4.0) 1541 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"SMAGORINSKY\_KH"}, cs%Smagorinsky\_Kh, & 1542 \textcolor{stringliteral}{"If true, use a Smagorinsky nonlinear eddy viscosity."}, & 1543 default=.false.) 1544 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Kh .or. get\_all) & 1545 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"SMAG\_LAP\_CONST"}, smag\_lap\_const, & 1546 \textcolor{stringliteral}{"The nondimensional Laplacian Smagorinsky constant, "}//& 1547 \textcolor{stringliteral}{"often 0.15."}, units=\textcolor{stringliteral}{"nondim"}, default=0.0, & 1548 fail\_if\_missing = cs%Smagorinsky\_Kh) 1549 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"LEITH\_KH"}, cs%Leith\_Kh, & 1550 \textcolor{stringliteral}{"If true, use a Leith nonlinear eddy viscosity."}, & 1551 default=.false.) 1552 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"MODIFIED\_LEITH"}, cs%Modified\_Leith, & 1553 \textcolor{stringliteral}{"If true, add a term to Leith viscosity which is "}//& 1554 \textcolor{stringliteral}{"proportional to the gradient of divergence."}, & 1555 default=.false.) 1556 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"RES\_SCALE\_MEKE\_VISC"}, cs%res\_scale\_MEKE, & 1557 \textcolor{stringliteral}{"If true, the viscosity contribution from MEKE is scaled by "}//& 1558 \textcolor{stringliteral}{"the resolution function."}, default=.false.) 1559 \textcolor{keywordflow}{if} (cs%Leith\_Kh .or. get\_all) \textcolor{keywordflow}{then} 1560 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"LEITH\_LAP\_CONST"}, leith\_lap\_const, & 1561 \textcolor{stringliteral}{"The nondimensional Laplacian Leith constant, "}//& 1562 \textcolor{stringliteral}{"often set to 1.0"}, units=\textcolor{stringliteral}{"nondim"}, default=0.0, & 1563 fail\_if\_missing = cs%Leith\_Kh) 1564 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"USE\_QG\_LEITH\_VISC"}, cs%use\_QG\_Leith\_visc, & 1565 \textcolor{stringliteral}{"If true, use QG Leith nonlinear eddy viscosity."}, & 1566 default=.false.) 1567 \textcolor{keywordflow}{if} (cs%use\_QG\_Leith\_visc .and. .not. cs%Leith\_Kh) \textcolor{keyword}{call }mom\_error(fatal, & 1568 \textcolor{stringliteral}{"MOM\_lateral\_mixing\_coeffs.F90, VarMix\_init:"}//& 1569 \textcolor{stringliteral}{"LEITH\_KH must be True when USE\_QG\_LEITH\_VISC=True."}) 1570 \textcolor{keywordflow}{ endif} 1571 \textcolor{keywordflow}{if} (cs%Leith\_Kh .or. cs%Leith\_Ah .or. get\_all) \textcolor{keywordflow}{then} 1572 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"USE\_BETA\_IN\_LEITH"}, cs%use\_beta\_in\_Leith, & 1573 \textcolor{stringliteral}{"If true, include the beta term in the Leith nonlinear eddy viscosity."}, & 1574 default=cs%Leith\_Kh) 1575 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"MODIFIED\_LEITH"}, cs%modified\_Leith, & 1576 \textcolor{stringliteral}{"If true, add a term to Leith viscosity which is \(\backslash\)n"}//& 1577 \textcolor{stringliteral}{"proportional to the gradient of divergence."}, & 1578 default=.false.) 1579 \textcolor{keywordflow}{ endif} 1580 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BOUND\_KH"}, cs%bound\_Kh, & 1581 \textcolor{stringliteral}{"If true, the Laplacian coefficient is locally limited "}//& 1582 \textcolor{stringliteral}{"to be stable."}, default=.true.) 1583 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BETTER\_BOUND\_KH"}, cs%better\_bound\_Kh, & 1584 \textcolor{stringliteral}{"If true, the Laplacian coefficient is locally limited "}//& 1585 \textcolor{stringliteral}{"to be stable with a better bounding than just BOUND\_KH."}, & 1586 default=cs%bound\_Kh) 1587 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"ANISOTROPIC\_VISCOSITY"}, cs%anisotropic, & 1588 \textcolor{stringliteral}{"If true, allow anistropic viscosity in the Laplacian "}//& 1589 \textcolor{stringliteral}{"horizontal viscosity."}, default=.false.) 1590 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"ADD\_LES\_VISCOSITY"}, cs%add\_LES\_viscosity, & 1591 \textcolor{stringliteral}{"If true, adds the viscosity from Smagorinsky and Leith to the "}//& 1592 \textcolor{stringliteral}{"background viscosity instead of taking the maximum."}, default=.false.) 1593 \textcolor{keywordflow}{ endif} 1594 \textcolor{keywordflow}{if} (cs%anisotropic .or. get\_all) \textcolor{keywordflow}{then} 1595 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"KH\_ANISO"}, cs%Kh\_aniso, & 1596 \textcolor{stringliteral}{"The background Laplacian anisotropic horizontal viscosity."}, & 1597 units = \textcolor{stringliteral}{"m2 s-1"}, default=0.0, scale=us%m\_to\_L**2*us%T\_to\_s) 1598 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"ANISOTROPIC\_MODE"}, aniso\_mode, & 1599 \textcolor{stringliteral}{"Selects the mode for setting the direction of anistropy.\(\backslash\)n"}//& 1600 \textcolor{stringliteral}{"\(\backslash\)t 0 - Points along the grid i-direction.\(\backslash\)n"}//& 1601 \textcolor{stringliteral}{"\(\backslash\)t 1 - Points towards East.\(\backslash\)n"}//& 1602 \textcolor{stringliteral}{"\(\backslash\)t 2 - Points along the flow direction, U/|U|."}, & 1603 default=0) 1604 \textcolor{keywordflow}{select case} (aniso\_mode) 1605 \textcolor{keywordflow}{case} (0) 1606 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"ANISO\_GRID\_DIR"}, aniso\_grid\_dir, & 1607 \textcolor{stringliteral}{"The vector pointing in the direction of anistropy for "}//& 1608 \textcolor{stringliteral}{"horizont viscosity. n1,n2 are the i,j components relative "}//& 1609 \textcolor{stringliteral}{"to the grid."}, units = \textcolor{stringliteral}{"nondim"}, fail\_if\_missing=.true.) 1610 \textcolor{keywordflow}{case} (1) 1611 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"ANISO\_GRID\_DIR"}, aniso\_grid\_dir, & 1612 \textcolor{stringliteral}{"The vector pointing in the direction of anistropy for "}//& 1613 \textcolor{stringliteral}{"horizont viscosity. n1,n2 are the i,j components relative "}//& 1614 \textcolor{stringliteral}{"to the spherical coordinates."}, units = \textcolor{stringliteral}{"nondim"}, fail\_if\_missing=.true.) 1615 \textcolor{keywordflow}{ end select} 1616 \textcolor{keywordflow}{ endif} 1617 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BIHARMONIC"}, cs%biharmonic, & 1618 \textcolor{stringliteral}{"If true, use a biharmonic horizontal viscosity. "}//& 1619 \textcolor{stringliteral}{"BIHARMONIC may be used with LAPLACIAN."}, & 1620 default=.true.) 1621 \textcolor{keywordflow}{if} (cs%biharmonic .or. get\_all) \textcolor{keywordflow}{then} 1622 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"AH"}, ah, & 1623 \textcolor{stringliteral}{"The background biharmonic horizontal viscosity."}, & 1624 units = \textcolor{stringliteral}{"m4 s-1"}, default=0.0, scale=us%m\_to\_L**4*us%T\_to\_s) 1625 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"AH\_VEL\_SCALE"}, ah\_vel\_scale, & 1626 \textcolor{stringliteral}{"The velocity scale which is multiplied by the cube of "}//& 1627 \textcolor{stringliteral}{"the grid spacing to calculate the biharmonic viscosity. "}//& 1628 \textcolor{stringliteral}{"The final viscosity is the largest of this scaled "}//& 1629 \textcolor{stringliteral}{"viscosity, the Smagorinsky and Leith viscosities, and AH."}, & 1630 units=\textcolor{stringliteral}{"m s-1"}, default=0.0, scale=us%m\_s\_to\_L\_T) 1631 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"AH\_TIME\_SCALE"}, ah\_time\_scale, & 1632 \textcolor{stringliteral}{"A time scale whose inverse is multiplied by the fourth "}//& 1633 \textcolor{stringliteral}{"power of the grid spacing to calculate biharmonic viscosity. "}//& 1634 \textcolor{stringliteral}{"The final viscosity is the largest of all viscosity "}//& 1635 \textcolor{stringliteral}{"formulations in use. 0.0 means that it's not used."}, & 1636 units=\textcolor{stringliteral}{"s"}, default=0.0, scale=us%s\_to\_T) 1637 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"SMAGORINSKY\_AH"}, cs%Smagorinsky\_Ah, & 1638 \textcolor{stringliteral}{"If true, use a biharmonic Smagorinsky nonlinear eddy "}//& 1639 \textcolor{stringliteral}{"viscosity."}, default=.false.) 1640 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"LEITH\_AH"}, cs%Leith\_Ah, & 1641 \textcolor{stringliteral}{"If true, use a biharmonic Leith nonlinear eddy "}//& 1642 \textcolor{stringliteral}{"viscosity."}, default=.false.) 1643 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BOUND\_AH"}, cs%bound\_Ah, & 1644 \textcolor{stringliteral}{"If true, the biharmonic coefficient is locally limited "}//& 1645 \textcolor{stringliteral}{"to be stable."}, default=.true.) 1646 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BETTER\_BOUND\_AH"}, cs%better\_bound\_Ah, & 1647 \textcolor{stringliteral}{"If true, the biharmonic coefficient is locally limited "}//& 1648 \textcolor{stringliteral}{"to be stable with a better bounding than just BOUND\_AH."}, & 1649 default=cs%bound\_Ah) 1650 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"RE\_AH"}, cs%Re\_Ah, & 1651 \textcolor{stringliteral}{"If nonzero, the biharmonic coefficient is scaled "}//& 1652 \textcolor{stringliteral}{"so that the biharmonic Reynolds number is equal to this."}, & 1653 units=\textcolor{stringliteral}{"nondim"}, default=0.0) 1654 1655 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Ah .or. get\_all) \textcolor{keywordflow}{then} 1656 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"SMAG\_BI\_CONST"},smag\_bi\_const, & 1657 \textcolor{stringliteral}{"The nondimensional biharmonic Smagorinsky constant, "}//& 1658 \textcolor{stringliteral}{"typically 0.015 - 0.06."}, units=\textcolor{stringliteral}{"nondim"}, default=0.0, & 1659 fail\_if\_missing = cs%Smagorinsky\_Ah) 1660 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BOUND\_CORIOLIS"}, bound\_cor\_def, default=.false.) 1661 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BOUND\_CORIOLIS\_BIHARM"}, cs%bound\_Coriolis, & 1662 \textcolor{stringliteral}{"If true use a viscosity that increases with the square "}//& 1663 \textcolor{stringliteral}{"of the velocity shears, so that the resulting viscous "}//& 1664 \textcolor{stringliteral}{"drag is of comparable magnitude to the Coriolis terms "}//& 1665 \textcolor{stringliteral}{"when the velocity differences between adjacent grid "}//& 1666 \textcolor{stringliteral}{"points is 0.5*BOUND\_CORIOLIS\_VEL. The default is the "}//& 1667 \textcolor{stringliteral}{"value of BOUND\_CORIOLIS (or false)."}, default=bound\_cor\_def) 1668 \textcolor{keywordflow}{if} (cs%bound\_Coriolis .or. get\_all) \textcolor{keywordflow}{then} 1669 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"MAXVEL"}, maxvel, default=3.0e8) 1670 bound\_cor\_vel = maxvel 1671 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BOUND\_CORIOLIS\_VEL"}, bound\_cor\_vel, & 1672 \textcolor{stringliteral}{"The velocity scale at which BOUND\_CORIOLIS\_BIHARM causes "}//& 1673 \textcolor{stringliteral}{"the biharmonic drag to have comparable magnitude to the "}//& 1674 \textcolor{stringliteral}{"Coriolis acceleration. The default is set by MAXVEL."}, & 1675 units=\textcolor{stringliteral}{"m s-1"}, default=maxvel, scale=us%m\_s\_to\_L\_T) 1676 \textcolor{keywordflow}{ endif} 1677 \textcolor{keywordflow}{ endif} 1678 \textcolor{keywordflow}{if} (cs%Leith\_Ah .or. get\_all) & 1679 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"LEITH\_BI\_CONST"}, leith\_bi\_const, & 1680 \textcolor{stringliteral}{"The nondimensional biharmonic Leith constant, "}//& 1681 \textcolor{stringliteral}{"typical values are thus far undetermined."}, units=\textcolor{stringliteral}{"nondim"}, default=0.0, & 1682 fail\_if\_missing = cs%Leith\_Ah) 1683 \textcolor{keywordflow}{ endif} 1684 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"USE\_LAND\_MASK\_FOR\_HVISC"}, cs%use\_land\_mask, & 1685 \textcolor{stringliteral}{"If true, use Use the land mask for the computation of thicknesses "}//& 1686 \textcolor{stringliteral}{"at velocity locations. This eliminates the dependence on arbitrary "}//& 1687 \textcolor{stringliteral}{"values over land or outside of the domain."}, default=.true.) 1688 \textcolor{keywordflow}{if} (cs%better\_bound\_Ah .or. cs%better\_bound\_Kh .or. get\_all) & 1689 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"HORVISC\_BOUND\_COEF"}, cs%bound\_coef, & 1690 \textcolor{stringliteral}{"The nondimensional coefficient of the ratio of the "}//& 1691 \textcolor{stringliteral}{"viscosity bounds to the theoretical maximum for "}//& 1692 \textcolor{stringliteral}{"stability without considering other terms."}, units=\textcolor{stringliteral}{"nondim"}, & 1693 default=0.8) 1694 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"NOSLIP"}, cs%no\_slip, & 1695 \textcolor{stringliteral}{"If true, no slip boundary conditions are used; otherwise "}//& 1696 \textcolor{stringliteral}{"free slip boundary conditions are assumed. The "}//& 1697 \textcolor{stringliteral}{"implementation of the free slip BCs on a C-grid is much "}//& 1698 \textcolor{stringliteral}{"cleaner than the no slip BCs. The use of free slip BCs "}//& 1699 \textcolor{stringliteral}{"is strongly encouraged, and no slip BCs are not used with "}//& 1700 \textcolor{stringliteral}{"the biharmonic viscosity."}, default=.false.) 1701 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"USE\_KH\_BG\_2D"}, cs%use\_Kh\_bg\_2d, & 1702 \textcolor{stringliteral}{"If true, read a file containing 2-d background harmonic "}//& 1703 \textcolor{stringliteral}{"viscosities. The final viscosity is the maximum of the other "}//& 1704 \textcolor{stringliteral}{"terms and this background value."}, default=.false.) 1705 1706 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"USE\_GME"}, cs%use\_GME, & 1707 \textcolor{stringliteral}{"If true, use the GM+E backscatter scheme in association \(\backslash\)n"}//& 1708 \textcolor{stringliteral}{"with the Gent and McWilliams parameterization."}, default=.false.) 1709 \textcolor{keywordflow}{if} (cs%use\_GME) \textcolor{keywordflow}{then} 1710 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"SPLIT"}, split, & 1711 \textcolor{stringliteral}{"Use the split time stepping if true."}, default=.true., & 1712 do\_not\_log=.true.) 1713 \textcolor{keywordflow}{if} (.not. split) \textcolor{keyword}{call }mom\_error(fatal,\textcolor{stringliteral}{"ERROR: Currently, USE\_GME = True "}// & 1714 \textcolor{stringliteral}{"cannot be used with SPLIT=False."}) 1715 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"GME\_H0"}, cs%GME\_h0, & 1716 \textcolor{stringliteral}{"The strength of GME tapers quadratically to zero when the bathymetric "}//& 1717 \textcolor{stringliteral}{"depth is shallower than GME\_H0."}, units=\textcolor{stringliteral}{"m"}, scale=us%m\_to\_Z, & 1718 default=1000.0) 1719 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"GME\_EFFICIENCY"}, cs%GME\_efficiency, & 1720 \textcolor{stringliteral}{"The nondimensional prefactor multiplying the GME coefficient."}, & 1721 units=\textcolor{stringliteral}{"nondim"}, default=1.0) 1722 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"GME\_LIMITER"}, cs%GME\_limiter, & 1723 \textcolor{stringliteral}{"The absolute maximum value the GME coefficient is allowed to take."}, & 1724 units=\textcolor{stringliteral}{"m2 s-1"}, scale=us%m\_to\_L**2*us%T\_to\_s, default=1.0e7) 1725 \textcolor{keywordflow}{ endif} 1726 \textcolor{keywordflow}{if} (cs%Laplacian .or. cs%biharmonic) \textcolor{keywordflow}{then} 1727 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"DT"}, dt, & 1728 \textcolor{stringliteral}{"The (baroclinic) dynamics time step."}, units=\textcolor{stringliteral}{"s"}, scale=us%s\_to\_T, & 1729 fail\_if\_missing=.true.) 1730 idt = 1.0 / dt 1731 \textcolor{keywordflow}{ endif} 1732 \textcolor{keywordflow}{if} (cs%no\_slip .and. cs%biharmonic) & 1733 \textcolor{keyword}{call }mom\_error(fatal,\textcolor{stringliteral}{"ERROR: NOSLIP and BIHARMONIC cannot be defined "}// & 1734 \textcolor{stringliteral}{"at the same time in MOM."}) 1735 \textcolor{keywordflow}{if} (.not.(cs%Laplacian .or. cs%biharmonic)) \textcolor{keywordflow}{then} 1736 \textcolor{comment}{! Only issue inviscid warning if not in single column mode (usually 2x2 domain)} 1737 \textcolor{keywordflow}{if} ( max(g%domain%niglobal, g%domain%njglobal)>2 ) \textcolor{keyword}{call }mom\_error(warning, & 1738 \textcolor{stringliteral}{"hor\_visc\_init: It is usually a very bad idea not to use either "}//& 1739 \textcolor{stringliteral}{"LAPLACIAN or BIHARMONIC viscosity."}) 1740 \textcolor{keywordflow}{return} \textcolor{comment}{! We are not using either Laplacian or Bi-harmonic lateral viscosity} 1741 \textcolor{keywordflow}{ endif} 1742 deg2rad = atan(1.0) / 45. 1743 alloc\_(cs%dx2h(isd:ied,jsd:jed)) ; cs%dx2h(:,:) = 0.0 1744 alloc\_(cs%dy2h(isd:ied,jsd:jed)) ; cs%dy2h(:,:) = 0.0 1745 alloc\_(cs%dx2q(isdb:iedb,jsdb:jedb)) ; cs%dx2q(:,:) = 0.0 1746 alloc\_(cs%dy2q(isdb:iedb,jsdb:jedb)) ; cs%dy2q(:,:) = 0.0 1747 alloc\_(cs%dx\_dyT(isd:ied,jsd:jed)) ; cs%dx\_dyT(:,:) = 0.0 1748 alloc\_(cs%dy\_dxT(isd:ied,jsd:jed)) ; cs%dy\_dxT(:,:) = 0.0 1749 alloc\_(cs%dx\_dyBu(isdb:iedb,jsdb:jedb)) ; cs%dx\_dyBu(:,:) = 0.0 1750 alloc\_(cs%dy\_dxBu(isdb:iedb,jsdb:jedb)) ; cs%dy\_dxBu(:,:) = 0.0 1751 \textcolor{keywordflow}{if} (cs%Laplacian) \textcolor{keywordflow}{then} 1752 alloc\_(cs%grid\_sp\_h2(isd:ied,jsd:jed)) ; cs%grid\_sp\_h2(:,:) = 0.0 1753 alloc\_(cs%Kh\_bg\_xx(isd:ied,jsd:jed)) ; cs%Kh\_bg\_xx(:,:) = 0.0 1754 alloc\_(cs%Kh\_bg\_xy(isdb:iedb,jsdb:jedb)) ; cs%Kh\_bg\_xy(:,:) = 0.0 1755 \textcolor{keywordflow}{if} (cs%bound\_Kh .or. cs%better\_bound\_Kh) \textcolor{keywordflow}{then} 1756 alloc\_(cs%Kh\_Max\_xx(isd:ied,jsd:jed)) ; cs%Kh\_Max\_xx(:,:) = 0.0 1757 alloc\_(cs%Kh\_Max\_xy(isdb:iedb,jsdb:jedb)) ; cs%Kh\_Max\_xy(:,:) = 0.0 1758 \textcolor{keywordflow}{ endif} 1759 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Kh) \textcolor{keywordflow}{then} 1760 alloc\_(cs%Laplac2\_const\_xx(isd:ied,jsd:jed)) ; cs%Laplac2\_const\_xx(:,:) = 0.0 1761 alloc\_(cs%Laplac2\_const\_xy(isdb:iedb,jsdb:jedb)) ; cs%Laplac2\_const\_xy(:,:) = 0.0 1762 \textcolor{keywordflow}{ endif} 1763 \textcolor{keywordflow}{if} (cs%Leith\_Kh) \textcolor{keywordflow}{then} 1764 alloc\_(cs%Laplac3\_const\_xx(isd:ied,jsd:jed)) ; cs%Laplac3\_const\_xx(:,:) = 0.0 1765 alloc\_(cs%Laplac3\_const\_xy(isdb:iedb,jsdb:jedb)) ; cs%Laplac3\_const\_xy(:,:) = 0.0 1766 \textcolor{keywordflow}{ endif} 1767 \textcolor{keywordflow}{ endif} 1768 alloc\_(cs%reduction\_xx(isd:ied,jsd:jed)) ; cs%reduction\_xx(:,:) = 0.0 1769 alloc\_(cs%reduction\_xy(isdb:iedb,jsdb:jedb)) ; cs%reduction\_xy(:,:) = 0.0 1770 \textcolor{keywordflow}{if} (cs%anisotropic) \textcolor{keywordflow}{then} 1771 alloc\_(cs%n1n2\_h(isd:ied,jsd:jed)) ; cs%n1n2\_h(:,:) = 0.0 1772 alloc\_(cs%n1n1\_m\_n2n2\_h(isd:ied,jsd:jed)) ; cs%n1n1\_m\_n2n2\_h(:,:) = 0.0 1773 alloc\_(cs%n1n2\_q(isdb:iedb,jsdb:jedb)) ; cs%n1n2\_q(:,:) = 0.0 1774 alloc\_(cs%n1n1\_m\_n2n2\_q(isdb:iedb,jsdb:jedb)) ; cs%n1n1\_m\_n2n2\_q(:,:) = 0.0 1775 \textcolor{keywordflow}{select case} (aniso\_mode) 1776 \textcolor{keywordflow}{case} (0) 1777 \textcolor{keyword}{call }align\_aniso\_tensor\_to\_grid(cs, aniso\_grid\_dir(1), aniso\_grid\_dir(2)) 1778 \textcolor{keywordflow}{case} (1) 1779 \textcolor{comment}{! call align\_aniso\_tensor\_to\_grid(CS, aniso\_grid\_dir(1), aniso\_grid\_dir(2))} 1780 \textcolor{keywordflow}{case} (2) 1781 cs%dynamic\_aniso = .true. 1782 \textcolor{keywordflow}{ case default} 1783 \textcolor{keyword}{call }mom\_error(fatal, \textcolor{stringliteral}{"MOM\_hor\_visc: "}//& 1784 \textcolor{stringliteral}{"Runtime parameter ANISOTROPIC\_MODE is out of range."}) 1785 \textcolor{keywordflow}{ end select} 1786 \textcolor{keywordflow}{ endif} 1787 \textcolor{keywordflow}{if} (cs%use\_Kh\_bg\_2d) \textcolor{keywordflow}{then} 1788 alloc\_(cs%Kh\_bg\_2d(isd:ied,jsd:jed)) ; cs%Kh\_bg\_2d(:,:) = 0.0 1789 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"KH\_BG\_2D\_FILENAME"}, filename, & 1790 \textcolor{stringliteral}{'The filename containing a 2d map of "Kh".'}, & 1791 default=\textcolor{stringliteral}{'KH\_background\_2d.nc'}) 1792 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"INPUTDIR"}, inputdir, default=\textcolor{stringliteral}{"."}) 1793 inputdir = slasher(inputdir) 1794 \textcolor{keyword}{call }mom\_read\_data(trim(inputdir)//trim(filename), \textcolor{stringliteral}{'Kh'}, cs%Kh\_bg\_2d, & 1795 g%domain, timelevel=1, scale=us%m\_to\_L**2*us%T\_to\_s) 1796 \textcolor{keyword}{call }pass\_var(cs%Kh\_bg\_2d, g%domain) 1797 \textcolor{keywordflow}{ endif} 1798 \textcolor{keywordflow}{if} (cs%biharmonic) \textcolor{keywordflow}{then} 1799 alloc\_(cs%Idx2dyCu(isdb:iedb,jsd:jed)) ; cs%Idx2dyCu(:,:) = 0.0 1800 alloc\_(cs%Idx2dyCv(isd:ied,jsdb:jedb)) ; cs%Idx2dyCv(:,:) = 0.0 1801 alloc\_(cs%Idxdy2u(isdb:iedb,jsd:jed)) ; cs%Idxdy2u(:,:) = 0.0 1802 alloc\_(cs%Idxdy2v(isd:ied,jsdb:jedb)) ; cs%Idxdy2v(:,:) = 0.0 1803 alloc\_(cs%Ah\_bg\_xx(isd:ied,jsd:jed)) ; cs%Ah\_bg\_xx(:,:) = 0.0 1804 alloc\_(cs%Ah\_bg\_xy(isdb:iedb,jsdb:jedb)) ; cs%Ah\_bg\_xy(:,:) = 0.0 1805 alloc\_(cs%grid\_sp\_h3(isd:ied,jsd:jed)) ; cs%grid\_sp\_h3(:,:) = 0.0 1806 \textcolor{keywordflow}{if} (cs%bound\_Ah .or. cs%better\_bound\_Ah) \textcolor{keywordflow}{then} 1807 alloc\_(cs%Ah\_Max\_xx(isd:ied,jsd:jed)) ; cs%Ah\_Max\_xx(:,:) = 0.0 1808 alloc\_(cs%Ah\_Max\_xy(isdb:iedb,jsdb:jedb)) ; cs%Ah\_Max\_xy(:,:) = 0.0 1809 \textcolor{keywordflow}{ endif} 1810 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Ah) \textcolor{keywordflow}{then} 1811 alloc\_(cs%Biharm\_const\_xx(isd:ied,jsd:jed)) ; cs%Biharm\_const\_xx(:,:) = 0.0 1812 alloc\_(cs%Biharm\_const\_xy(isdb:iedb,jsdb:jedb)) ; cs%Biharm\_const\_xy(:,:) = 0.0 1813 \textcolor{keywordflow}{if} (cs%bound\_Coriolis) \textcolor{keywordflow}{then} 1814 alloc\_(cs%Biharm\_const2\_xx(isd:ied,jsd:jed)) ; cs%Biharm\_const2\_xx(:,:) = 0.0 1815 alloc\_(cs%Biharm\_const2\_xy(isdb:iedb,jsdb:jedb)) ; cs%Biharm\_const2\_xy(:,:) = 0.0 1816 \textcolor{keywordflow}{ endif} 1817 \textcolor{keywordflow}{ endif} 1818 \textcolor{keywordflow}{if} (cs%Leith\_Ah) \textcolor{keywordflow}{then} 1819 alloc\_(cs%biharm6\_const\_xx(isd:ied,jsd:jed)) ; cs%biharm6\_const\_xx(:,:) = 0.0 1820 alloc\_(cs%biharm6\_const\_xy(isdb:iedb,jsdb:jedb)) ; cs%biharm6\_const\_xy(:,:) = 0.0 1821 \textcolor{keywordflow}{ endif} 1822 \textcolor{keywordflow}{if} (cs%Re\_Ah > 0.0) \textcolor{keywordflow}{then} 1823 alloc\_(cs%Re\_Ah\_const\_xx(isd:ied,jsd:jed)); cs%Re\_Ah\_const\_xx(:,:) = 0.0 1824 alloc\_(cs%Re\_Ah\_const\_xy(isdb:iedb,jsdb:jedb)); cs%Re\_Ah\_const\_xy(:,:) = 0.0 1825 \textcolor{keywordflow}{ endif} 1826 \textcolor{keywordflow}{ endif} 1827 \textcolor{keywordflow}{do} j=js-2,jeq+1 ; \textcolor{keywordflow}{do} i=is-2,ieq+1 1828 cs%dx2q(i,j) = g%dxBu(i,j)*g%dxBu(i,j) ; cs%dy2q(i,j) = g%dyBu(i,j)*g%dyBu(i,j) 1829 cs%DX\_dyBu(i,j) = g%dxBu(i,j)*g%IdyBu(i,j) ; cs%DY\_dxBu(i,j) = g%dyBu(i,j)*g%IdxBu(i,j) 1830 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1831 \textcolor{keywordflow}{do} j=jsq-1,jeq+2 ; \textcolor{keywordflow}{do} i=isq-1,ieq+2 1832 cs%dx2h(i,j) = g%dxT(i,j)*g%dxT(i,j) ; cs%dy2h(i,j) = g%dyT(i,j)*g%dyT(i,j) 1833 cs%DX\_dyT(i,j) = g%dxT(i,j)*g%IdyT(i,j) ; cs%DY\_dxT(i,j) = g%dyT(i,j)*g%IdxT(i,j) 1834 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1835 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 1836 cs%reduction\_xx(i,j) = 1.0 1837 \textcolor{keywordflow}{if} ((g%dy\_Cu(i,j) > 0.0) .and. (g%dy\_Cu(i,j) < g%dyCu(i,j)) .and. & 1838 (g%dy\_Cu(i,j) < g%dyCu(i,j) * cs%reduction\_xx(i,j))) & 1839 cs%reduction\_xx(i,j) = g%dy\_Cu(i,j) / (g%dyCu(i,j)) 1840 \textcolor{keywordflow}{if} ((g%dy\_Cu(i-1,j) > 0.0) .and. (g%dy\_Cu(i-1,j) < g%dyCu(i-1,j)) .and. & 1841 (g%dy\_Cu(i-1,j) < g%dyCu(i-1,j) * cs%reduction\_xx(i,j))) & 1842 cs%reduction\_xx(i,j) = g%dy\_Cu(i-1,j) / (g%dyCu(i-1,j)) 1843 \textcolor{keywordflow}{if} ((g%dx\_Cv(i,j) > 0.0) .and. (g%dx\_Cv(i,j) < g%dxCv(i,j)) .and. & 1844 (g%dx\_Cv(i,j) < g%dxCv(i,j) * cs%reduction\_xx(i,j))) & 1845 cs%reduction\_xx(i,j) = g%dx\_Cv(i,j) / (g%dxCv(i,j)) 1846 \textcolor{keywordflow}{if} ((g%dx\_Cv(i,j-1) > 0.0) .and. (g%dx\_Cv(i,j-1) < g%dxCv(i,j-1)) .and. & 1847 (g%dx\_Cv(i,j-1) < g%dxCv(i,j-1) * cs%reduction\_xx(i,j))) & 1848 cs%reduction\_xx(i,j) = g%dx\_Cv(i,j-1) / (g%dxCv(i,j-1)) 1849 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1850 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 1851 cs%reduction\_xy(i,j) = 1.0 1852 \textcolor{keywordflow}{if} ((g%dy\_Cu(i,j) > 0.0) .and. (g%dy\_Cu(i,j) < g%dyCu(i,j)) .and. & 1853 (g%dy\_Cu(i,j) < g%dyCu(i,j) * cs%reduction\_xy(i,j))) & 1854 cs%reduction\_xy(i,j) = g%dy\_Cu(i,j) / (g%dyCu(i,j)) 1855 \textcolor{keywordflow}{if} ((g%dy\_Cu(i,j+1) > 0.0) .and. (g%dy\_Cu(i,j+1) < g%dyCu(i,j+1)) .and. & 1856 (g%dy\_Cu(i,j+1) < g%dyCu(i,j+1) * cs%reduction\_xy(i,j))) & 1857 cs%reduction\_xy(i,j) = g%dy\_Cu(i,j+1) / (g%dyCu(i,j+1)) 1858 \textcolor{keywordflow}{if} ((g%dx\_Cv(i,j) > 0.0) .and. (g%dx\_Cv(i,j) < g%dxCv(i,j)) .and. & 1859 (g%dx\_Cv(i,j) < g%dxCv(i,j) * cs%reduction\_xy(i,j))) & 1860 cs%reduction\_xy(i,j) = g%dx\_Cv(i,j) / (g%dxCv(i,j)) 1861 \textcolor{keywordflow}{if} ((g%dx\_Cv(i+1,j) > 0.0) .and. (g%dx\_Cv(i+1,j) < g%dxCv(i+1,j)) .and. & 1862 (g%dx\_Cv(i+1,j) < g%dxCv(i+1,j) * cs%reduction\_xy(i,j))) & 1863 cs%reduction\_xy(i,j) = g%dx\_Cv(i+1,j) / (g%dxCv(i+1,j)) 1864 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1865 \textcolor{keywordflow}{if} (cs%Laplacian) \textcolor{keywordflow}{then} 1866 \textcolor{comment}{! The 0.3 below was 0.4 in MOM1.10. The change in hq requires} 1867 \textcolor{comment}{! this to be less than 1/3, rather than 1/2 as before.} 1868 \textcolor{keywordflow}{if} (cs%bound\_Kh .or. cs%bound\_Ah) kh\_limit = 0.3 / (dt*4.0) 1869 \textcolor{comment}{! Calculate and store the background viscosity at h-points} 1870 1871 min\_grid\_sp\_h2 = huge(1.) 1872 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 1873 \textcolor{comment}{! Static factors in the Smagorinsky and Leith schemes} 1874 grid\_sp\_h2 = (2.0*cs%dx2h(i,j)*cs%dy2h(i,j)) / (cs%dx2h(i,j) + cs%dy2h(i,j)) 1875 cs%grid\_sp\_h2(i,j) = grid\_sp\_h2 1876 grid\_sp\_h3 = grid\_sp\_h2*sqrt(grid\_sp\_h2) 1877 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Kh) cs%Laplac2\_const\_xx(i,j) = smag\_lap\_const * grid\_sp\_h2 1878 \textcolor{keywordflow}{if} (cs%Leith\_Kh) cs%Laplac3\_const\_xx(i,j) = leith\_lap\_const * grid\_sp\_h3 1879 \textcolor{comment}{! Maximum of constant background and MICOM viscosity} 1880 cs%Kh\_bg\_xx(i,j) = max(kh, kh\_vel\_scale * sqrt(grid\_sp\_h2)) 1881 \textcolor{comment}{! Use the larger of the above and values read from a file} 1882 \textcolor{keywordflow}{if} (cs%use\_Kh\_bg\_2d) cs%Kh\_bg\_xx(i,j) = max(cs%Kh\_bg\_2d(i,j), cs%Kh\_bg\_xx(i,j)) 1883 \textcolor{comment}{! Use the larger of the above and a function of sin(latitude)} 1884 \textcolor{keywordflow}{if} (kh\_sin\_lat>0.) \textcolor{keywordflow}{then} 1885 slat\_fn = abs( sin( deg2rad * g%geoLatT(i,j) ) ) ** kh\_pwr\_of\_sine 1886 cs%Kh\_bg\_xx(i,j) = max(kh\_sin\_lat * slat\_fn, cs%Kh\_bg\_xx(i,j)) 1887 \textcolor{keywordflow}{ endif} 1888 \textcolor{keywordflow}{if} (cs%bound\_Kh .and. .not.cs%better\_bound\_Kh) \textcolor{keywordflow}{then} 1889 \textcolor{comment}{! Limit the background viscosity to be numerically stable} 1890 cs%Kh\_Max\_xx(i,j) = kh\_limit * grid\_sp\_h2 1891 cs%Kh\_bg\_xx(i,j) = min(cs%Kh\_bg\_xx(i,j), cs%Kh\_Max\_xx(i,j)) 1892 \textcolor{keywordflow}{ endif} 1893 min\_grid\_sp\_h2 = min(grid\_sp\_h2, min\_grid\_sp\_h2) 1894 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1895 \textcolor{keyword}{call }min\_across\_pes(min\_grid\_sp\_h2) 1896 1897 \textcolor{comment}{! Calculate and store the background viscosity at q-points} 1898 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 1899 \textcolor{comment}{! Static factors in the Smagorinsky and Leith schemes} 1900 grid\_sp\_q2 = (2.0*cs%dx2q(i,j)*cs%dy2q(i,j)) / (cs%dx2q(i,j) + cs%dy2q(i,j)) 1901 grid\_sp\_q3 = grid\_sp\_q2*sqrt(grid\_sp\_q2) 1902 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Kh) cs%Laplac2\_const\_xy(i,j) = smag\_lap\_const * grid\_sp\_q2 1903 \textcolor{keywordflow}{if} (cs%Leith\_Kh) cs%Laplac3\_const\_xy(i,j) = leith\_lap\_const * grid\_sp\_q3 1904 \textcolor{comment}{! Maximum of constant background and MICOM viscosity} 1905 cs%Kh\_bg\_xy(i,j) = max(kh, kh\_vel\_scale * sqrt(grid\_sp\_q2)) 1906 \textcolor{comment}{! Use the larger of the above and values read from a file} 1907 \textcolor{keywordflow}{if} (cs%use\_Kh\_bg\_2d) \textcolor{keywordflow}{then} 1908 cs%Kh\_bg\_xy(i,j) = max(cs%Kh\_bg\_xy(i,j), & 1909 0.25*((cs%Kh\_bg\_2d(i,j) + cs%Kh\_bg\_2d(i+1,j+1)) + & 1910 (cs%Kh\_bg\_2d(i+1,j) + cs%Kh\_bg\_2d(i,j+1))) ) 1911 \textcolor{keywordflow}{ endif} 1912 1913 \textcolor{comment}{! Use the larger of the above and a function of sin(latitude)} 1914 \textcolor{keywordflow}{if} (kh\_sin\_lat>0.) \textcolor{keywordflow}{then} 1915 slat\_fn = abs( sin( deg2rad * g%geoLatBu(i,j) ) ) ** kh\_pwr\_of\_sine 1916 cs%Kh\_bg\_xy(i,j) = max(kh\_sin\_lat * slat\_fn, cs%Kh\_bg\_xy(i,j)) 1917 \textcolor{keywordflow}{ endif} 1918 \textcolor{keywordflow}{if} (cs%bound\_Kh .and. .not.cs%better\_bound\_Kh) \textcolor{keywordflow}{then} 1919 \textcolor{comment}{! Limit the background viscosity to be numerically stable} 1920 cs%Kh\_Max\_xy(i,j) = kh\_limit * grid\_sp\_q2 1921 cs%Kh\_bg\_xy(i,j) = min(cs%Kh\_bg\_xy(i,j), cs%Kh\_Max\_xy(i,j)) 1922 \textcolor{keywordflow}{ endif} 1923 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1924 \textcolor{keywordflow}{ endif} 1925 \textcolor{keywordflow}{if} (cs%biharmonic) \textcolor{keywordflow}{then} 1926 \textcolor{keywordflow}{do} j=js-1,jeq+1 ; \textcolor{keywordflow}{do} i=isq-1,ieq+1 1927 cs%Idx2dyCu(i,j) = (g%IdxCu(i,j)*g%IdxCu(i,j)) * g%IdyCu(i,j) 1928 cs%Idxdy2u(i,j) = g%IdxCu(i,j) * (g%IdyCu(i,j)*g%IdyCu(i,j)) 1929 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1930 \textcolor{keywordflow}{do} j=jsq-1,jeq+1 ; \textcolor{keywordflow}{do} i=is-1,ieq+1 1931 cs%Idx2dyCv(i,j) = (g%IdxCv(i,j)*g%IdxCv(i,j)) * g%IdyCv(i,j) 1932 cs%Idxdy2v(i,j) = g%IdxCv(i,j) * (g%IdyCv(i,j)*g%IdyCv(i,j)) 1933 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1934 cs%Ah\_bg\_xy(:,:) = 0.0 1935 \textcolor{comment}{! The 0.3 below was 0.4 in MOM1.10. The change in hq requires} 1936 \textcolor{comment}{! this to be less than 1/3, rather than 1/2 as before.} 1937 \textcolor{keywordflow}{if} (cs%better\_bound\_Ah .or. cs%bound\_Ah) ah\_limit = 0.3 / (dt*64.0) 1938 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Ah .and. cs%bound\_Coriolis) & 1939 boundcorconst = 1.0 / (5.0*(bound\_cor\_vel*bound\_cor\_vel)) 1940 1941 min\_grid\_sp\_h4 = huge(1.) 1942 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 1943 grid\_sp\_h2 = (2.0*cs%dx2h(i,j)*cs%dy2h(i,j)) / (cs%dx2h(i,j)+cs%dy2h(i,j)) 1944 grid\_sp\_h3 = grid\_sp\_h2*sqrt(grid\_sp\_h2) 1945 cs%grid\_sp\_h3(i,j) = grid\_sp\_h3 1946 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Ah) \textcolor{keywordflow}{then} 1947 cs%Biharm\_const\_xx(i,j) = smag\_bi\_const * (grid\_sp\_h2 * grid\_sp\_h2) 1948 \textcolor{keywordflow}{if} (cs%bound\_Coriolis) \textcolor{keywordflow}{then} 1949 fmax = max(abs(g%CoriolisBu(i-1,j-1)), abs(g%CoriolisBu(i,j-1)), & 1950 abs(g%CoriolisBu(i-1,j)), abs(g%CoriolisBu(i,j))) 1951 cs%Biharm\_const2\_xx(i,j) = (grid\_sp\_h2 * grid\_sp\_h2 * grid\_sp\_h2) * & 1952 (fmax * boundcorconst) 1953 \textcolor{keywordflow}{ endif} 1954 \textcolor{keywordflow}{ endif} 1955 \textcolor{keywordflow}{if} (cs%Leith\_Ah) \textcolor{keywordflow}{then} 1956 cs%biharm6\_const\_xx(i,j) = leith\_bi\_const * (grid\_sp\_h3 * grid\_sp\_h3) 1957 \textcolor{keywordflow}{ endif} 1958 cs%Ah\_bg\_xx(i,j) = max(ah, ah\_vel\_scale * grid\_sp\_h2 * sqrt(grid\_sp\_h2)) 1959 \textcolor{keywordflow}{if} (cs%Re\_Ah > 0.0) cs%Re\_Ah\_const\_xx(i,j) = grid\_sp\_h3 / cs%Re\_Ah 1960 \textcolor{keywordflow}{if} (ah\_time\_scale > 0.) cs%Ah\_bg\_xx(i,j) = & 1961 max(cs%Ah\_bg\_xx(i,j), (grid\_sp\_h2 * grid\_sp\_h2) / ah\_time\_scale) 1962 \textcolor{keywordflow}{if} (cs%bound\_Ah .and. .not.cs%better\_bound\_Ah) \textcolor{keywordflow}{then} 1963 cs%Ah\_Max\_xx(i,j) = ah\_limit * (grid\_sp\_h2 * grid\_sp\_h2) 1964 cs%Ah\_bg\_xx(i,j) = min(cs%Ah\_bg\_xx(i,j), cs%Ah\_Max\_xx(i,j)) 1965 \textcolor{keywordflow}{ endif} 1966 min\_grid\_sp\_h4 = min(grid\_sp\_h2**2, min\_grid\_sp\_h4) 1967 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1968 \textcolor{keyword}{call }min\_across\_pes(min\_grid\_sp\_h4) 1969 1970 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 1971 grid\_sp\_q2 = (2.0*cs%dx2q(i,j)*cs%dy2q(i,j)) / (cs%dx2q(i,j)+cs%dy2q(i,j)) 1972 grid\_sp\_q3 = grid\_sp\_q2*sqrt(grid\_sp\_q2) 1973 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Ah) \textcolor{keywordflow}{then} 1974 cs%Biharm\_const\_xy(i,j) = smag\_bi\_const * (grid\_sp\_q2 * grid\_sp\_q2) 1975 \textcolor{keywordflow}{if} (cs%bound\_Coriolis) \textcolor{keywordflow}{then} 1976 cs%Biharm\_const2\_xy(i,j) = (grid\_sp\_q2 * grid\_sp\_q2 * grid\_sp\_q2) * & 1977 (abs(g%CoriolisBu(i,j)) * boundcorconst) 1978 \textcolor{keywordflow}{ endif} 1979 \textcolor{keywordflow}{ endif} 1980 \textcolor{keywordflow}{if} (cs%Leith\_Ah) \textcolor{keywordflow}{then} 1981 cs%biharm6\_const\_xy(i,j) = leith\_bi\_const * (grid\_sp\_q3 * grid\_sp\_q3) 1982 \textcolor{keywordflow}{ endif} 1983 cs%Ah\_bg\_xy(i,j) = max(ah, ah\_vel\_scale * grid\_sp\_q2 * sqrt(grid\_sp\_q2)) 1984 \textcolor{keywordflow}{if} (cs%Re\_Ah > 0.0) cs%Re\_Ah\_const\_xy(i,j) = grid\_sp\_q3 / cs%Re\_Ah 1985 \textcolor{keywordflow}{if} (ah\_time\_scale > 0.) cs%Ah\_bg\_xy(i,j) = & 1986 max(cs%Ah\_bg\_xy(i,j), (grid\_sp\_q2 * grid\_sp\_q2) / ah\_time\_scale) 1987 \textcolor{keywordflow}{if} (cs%bound\_Ah .and. .not.cs%better\_bound\_Ah) \textcolor{keywordflow}{then} 1988 cs%Ah\_Max\_xy(i,j) = ah\_limit * (grid\_sp\_q2 * grid\_sp\_q2) 1989 cs%Ah\_bg\_xy(i,j) = min(cs%Ah\_bg\_xy(i,j), cs%Ah\_Max\_xy(i,j)) 1990 \textcolor{keywordflow}{ endif} 1991 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1992 \textcolor{keywordflow}{ endif} 1993 \textcolor{comment}{! The Laplacian bounds should avoid overshoots when CS%bound\_coef < 1.} 1994 \textcolor{keywordflow}{if} (cs%Laplacian .and. cs%better\_bound\_Kh) \textcolor{keywordflow}{then} 1995 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 1996 denom = max( & 1997 (cs%dy2h(i,j) * cs%DY\_dxT(i,j) * (g%IdyCu(i,j) + g%IdyCu(i-1,j)) * & 1998 max(g%IdyCu(i,j)*g%IareaCu(i,j), g%IdyCu(i-1,j)*g%IareaCu(i-1,j)) ), & 1999 (cs%dx2h(i,j) * cs%DX\_dyT(i,j) * (g%IdxCv(i,j) + g%IdxCv(i,j-1)) * & 2000 max(g%IdxCv(i,j)*g%IareaCv(i,j), g%IdxCv(i,j-1)*g%IareaCv(i,j-1)) ) ) 2001 cs%Kh\_Max\_xx(i,j) = 0.0 2002 \textcolor{keywordflow}{if} (denom > 0.0) & 2003 cs%Kh\_Max\_xx(i,j) = cs%bound\_coef * 0.25 * idt / denom 2004 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2005 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 2006 denom = max( & 2007 (cs%dx2q(i,j) * cs%DX\_dyBu(i,j) * (g%IdxCu(i,j+1) + g%IdxCu(i,j)) * & 2008 max(g%IdxCu(i,j)*g%IareaCu(i,j), g%IdxCu(i,j+1)*g%IareaCu(i,j+1)) ), & 2009 (cs%dy2q(i,j) * cs%DY\_dxBu(i,j) * (g%IdyCv(i+1,j) + g%IdyCv(i,j)) * & 2010 max(g%IdyCv(i,j)*g%IareaCv(i,j), g%IdyCv(i+1,j)*g%IareaCv(i+1,j)) ) ) 2011 cs%Kh\_Max\_xy(i,j) = 0.0 2012 \textcolor{keywordflow}{if} (denom > 0.0) & 2013 cs%Kh\_Max\_xy(i,j) = cs%bound\_coef * 0.25 * idt / denom 2014 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2015 \textcolor{keywordflow}{if} (cs%debug) \textcolor{keywordflow}{then} 2016 \textcolor{keyword}{call }hchksum(cs%Kh\_Max\_xx, \textcolor{stringliteral}{"Kh\_Max\_xx"}, g%HI, haloshift=0, scale=us%L\_to\_m**2*us%s\_to\_T) 2017 \textcolor{keyword}{call }bchksum(cs%Kh\_Max\_xy, \textcolor{stringliteral}{"Kh\_Max\_xy"}, g%HI, haloshift=0, scale=us%L\_to\_m**2*us%s\_to\_T) 2018 \textcolor{keywordflow}{ endif} 2019 \textcolor{keywordflow}{ endif} 2020 \textcolor{comment}{! The biharmonic bounds should avoid overshoots when CS%bound\_coef < 0.5, but} 2021 \textcolor{comment}{! empirically work for CS%bound\_coef <~ 1.0} 2022 \textcolor{keywordflow}{if} (cs%biharmonic .and. cs%better\_bound\_Ah) \textcolor{keywordflow}{then} 2023 \textcolor{keywordflow}{do} j=js-1,jeq+1 ; \textcolor{keywordflow}{do} i=isq-1,ieq+1 2024 u0u(i,j) = (cs%Idxdy2u(i,j)*(cs%dy2h(i+1,j)*cs%DY\_dxT(i+1,j)*(g%IdyCu(i+1,j) + g%IdyCu(i,j)) + & 2025 cs%dy2h(i,j) * cs%DY\_dxT(i,j) * (g%IdyCu(i,j) + g%IdyCu(i-1,j)) ) + & 2026 cs%Idx2dyCu(i,j)*(cs%dx2q(i,j) * cs%DX\_dyBu(i,j) * (g%IdxCu(i,j+1) + g%IdxCu(i,j)) + & 2027 cs%dx2q(i,j-1)*cs%DX\_dyBu(i,j-1)*(g%IdxCu(i,j) + g%IdxCu(i,j-1)) ) ) 2028 u0v(i,j) = (cs%Idxdy2u(i,j)*(cs%dy2h(i+1,j)*cs%DX\_dyT(i+1,j)*(g%IdxCv(i+1,j) + g%IdxCv(i+1,j-1)) + & 2029 cs%dy2h(i,j) * cs%DX\_dyT(i,j) * (g%IdxCv(i,j) + g%IdxCv(i,j-1)) ) + & 2030 cs%Idx2dyCu(i,j)*(cs%dx2q(i,j) * cs%DY\_dxBu(i,j) * (g%IdyCv(i+1,j) + g%IdyCv(i,j)) + & 2031 cs%dx2q(i,j-1)*cs%DY\_dxBu(i,j-1)*(g%IdyCv(i+1,j-1) + g%IdyCv(i,j-1)) ) ) 2032 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2033 \textcolor{keywordflow}{do} j=jsq-1,jeq+1 ; \textcolor{keywordflow}{do} i=is-1,ieq+1 2034 v0u(i,j) = (cs%Idxdy2v(i,j)*(cs%dy2q(i,j) * cs%DX\_dyBu(i,j) * (g%IdxCu(i,j+1) + g%IdxCu(i,j)) + & 2035 cs%dy2q(i-1,j)*cs%DX\_dyBu(i-1,j)*(g%IdxCu(i-1,j+1) + g%IdxCu(i-1,j)) ) + & 2036 cs%Idx2dyCv(i,j)*(cs%dx2h(i,j+1)*cs%DY\_dxT(i,j+1)*(g%IdyCu(i,j+1) + g%IdyCu(i-1,j+1)) + & 2037 cs%dx2h(i,j) * cs%DY\_dxT(i,j) * (g%IdyCu(i,j) + g%IdyCu(i-1,j)) ) ) 2038 v0v(i,j) = (cs%Idxdy2v(i,j)*(cs%dy2q(i,j) * cs%DY\_dxBu(i,j) * (g%IdyCv(i+1,j) + g%IdyCv(i,j)) + & 2039 cs%dy2q(i-1,j)*cs%DY\_dxBu(i-1,j)*(g%IdyCv(i,j) + g%IdyCv(i-1,j)) ) + & 2040 cs%Idx2dyCv(i,j)*(cs%dx2h(i,j+1)*cs%DX\_dyT(i,j+1)*(g%IdxCv(i,j+1) + g%IdxCv(i,j)) + & 2041 cs%dx2h(i,j) * cs%DX\_dyT(i,j) * (g%IdxCv(i,j) + g%IdxCv(i,j-1)) ) ) 2042 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2043 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 2044 denom = max( & 2045 (cs%dy2h(i,j) * & 2046 (cs%DY\_dxT(i,j)*(g%IdyCu(i,j)*u0u(i,j) + g%IdyCu(i-1,j)*u0u(i-1,j)) + & 2047 cs%DX\_dyT(i,j)*(g%IdxCv(i,j)*v0u(i,j) + g%IdxCv(i,j-1)*v0u(i,j-1))) * & 2048 max(g%IdyCu(i,j)*g%IareaCu(i,j), g%IdyCu(i-1,j)*g%IareaCu(i-1,j)) ), & 2049 (cs%dx2h(i,j) * & 2050 (cs%DY\_dxT(i,j)*(g%IdyCu(i,j)*u0v(i,j) + g%IdyCu(i-1,j)*u0v(i-1,j)) + & 2051 cs%DX\_dyT(i,j)*(g%IdxCv(i,j)*v0v(i,j) + g%IdxCv(i,j-1)*v0v(i,j-1))) * & 2052 max(g%IdxCv(i,j)*g%IareaCv(i,j), g%IdxCv(i,j-1)*g%IareaCv(i,j-1)) ) ) 2053 cs%Ah\_Max\_xx(i,j) = 0.0 2054 \textcolor{keywordflow}{if} (denom > 0.0) & 2055 cs%Ah\_Max\_xx(i,j) = cs%bound\_coef * 0.5 * idt / denom 2056 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2057 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 2058 denom = max( & 2059 (cs%dx2q(i,j) * & 2060 (cs%DX\_dyBu(i,j)*(u0u(i,j+1)*g%IdxCu(i,j+1) + u0u(i,j)*g%IdxCu(i,j)) + & 2061 cs%DY\_dxBu(i,j)*(v0u(i+1,j)*g%IdyCv(i+1,j) + v0u(i,j)*g%IdyCv(i,j))) * & 2062 max(g%IdxCu(i,j)*g%IareaCu(i,j), g%IdxCu(i,j+1)*g%IareaCu(i,j+1)) ), & 2063 (cs%dy2q(i,j) * & 2064 (cs%DX\_dyBu(i,j)*(u0v(i,j+1)*g%IdxCu(i,j+1) + u0v(i,j)*g%IdxCu(i,j)) + & 2065 cs%DY\_dxBu(i,j)*(v0v(i+1,j)*g%IdyCv(i+1,j) + v0v(i,j)*g%IdyCv(i,j))) * & 2066 max(g%IdyCv(i,j)*g%IareaCv(i,j), g%IdyCv(i+1,j)*g%IareaCv(i+1,j)) ) ) 2067 cs%Ah\_Max\_xy(i,j) = 0.0 2068 \textcolor{keywordflow}{if} (denom > 0.0) & 2069 cs%Ah\_Max\_xy(i,j) = cs%bound\_coef * 0.5 * idt / denom 2070 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2071 \textcolor{keywordflow}{if} (cs%debug) \textcolor{keywordflow}{then} 2072 \textcolor{keyword}{call }hchksum(cs%Ah\_Max\_xx, \textcolor{stringliteral}{"Ah\_Max\_xx"}, g%HI, haloshift=0, scale=us%L\_to\_m**4*us%s\_to\_T) 2073 \textcolor{keyword}{call }bchksum(cs%Ah\_Max\_xy, \textcolor{stringliteral}{"Ah\_Max\_xy"}, g%HI, haloshift=0, scale=us%L\_to\_m**4*us%s\_to\_T) 2074 \textcolor{keywordflow}{ endif} 2075 \textcolor{keywordflow}{ endif} 2076 \textcolor{comment}{! Register fields for output from this module.} 2077 cs%id\_diffu = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'diffu'}, diag%axesCuL, time, & 2078 \textcolor{stringliteral}{'Zonal Acceleration from Horizontal Viscosity'}, \textcolor{stringliteral}{'m s-2'}, conversion=us%L\_T2\_to\_m\_s2) 2079 cs%id\_diffv = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'diffv'}, diag%axesCvL, time, & 2080 \textcolor{stringliteral}{'Meridional Acceleration from Horizontal Viscosity'}, \textcolor{stringliteral}{'m s-2'}, conversion=us%L\_T2\_to\_m\_s2) 2081 2082 \textcolor{comment}{!CS%id\_hf\_diffu = register\_diag\_field('ocean\_model', 'hf\_diffu', diag%axesCuL, Time, &} 2083 \textcolor{comment}{! 'Fractional Thickness-weighted Zonal Acceleration from Horizontal Viscosity', 'm s-2', &} 2084 \textcolor{comment}{! v\_extensive=.true., conversion=US%L\_T2\_to\_m\_s2)} 2085 \textcolor{comment}{!if ((CS%id\_hf\_diffu > 0) .and. (present(ADp))) then} 2086 \textcolor{comment}{! call safe\_alloc\_ptr(CS%hf\_diffu,G%IsdB,G%IedB,G%jsd,G%jed,G%ke)} 2087 \textcolor{comment}{! call safe\_alloc\_ptr(ADp%diag\_hfrac\_u,G%IsdB,G%IedB,G%jsd,G%jed,G%ke)} 2088 \textcolor{comment}{!endif} 2089 2090 \textcolor{comment}{!CS%id\_hf\_diffv = register\_diag\_field('ocean\_model', 'hf\_diffv', diag%axesCvL, Time, &} 2091 \textcolor{comment}{! 'Fractional Thickness-weighted Meridional Acceleration from Horizontal Viscosity', 'm s-2', &} 2092 \textcolor{comment}{! v\_extensive=.true., conversion=US%L\_T2\_to\_m\_s2)} 2093 \textcolor{comment}{!if ((CS%id\_hf\_diffv > 0) .and. (present(ADp))) then} 2094 \textcolor{comment}{! call safe\_alloc\_ptr(CS%hf\_diffv,G%isd,G%ied,G%JsdB,G%JedB,G%ke)} 2095 \textcolor{comment}{! call safe\_alloc\_ptr(ADp%diag\_hfrac\_v,G%isd,G%ied,G%JsdB,G%JedB,G%ke)} 2096 \textcolor{comment}{!endif} 2097 2098 cs%id\_hf\_diffu\_2d = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'hf\_diffu\_2d'}, diag%axesCu1, time, & 2099 \textcolor{stringliteral}{'Depth-sum Fractional Thickness-weighted Zonal Acceleration from Horizontal Viscosity'}, \textcolor{stringliteral}{'m s-2'}, & 2100 conversion=us%L\_T2\_to\_m\_s2) 2101 \textcolor{keywordflow}{if} ((cs%id\_hf\_diffu\_2d > 0) .and. (\textcolor{keyword}{present}(adp))) \textcolor{keywordflow}{then} 2102 \textcolor{keyword}{call }safe\_alloc\_ptr(adp%diag\_hfrac\_u,g%IsdB,g%IedB,g%jsd,g%jed,g%ke) 2103 \textcolor{keywordflow}{ endif} 2104 2105 cs%id\_hf\_diffv\_2d = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'hf\_diffv\_2d'}, diag%axesCv1, time, & 2106 \textcolor{stringliteral}{'Depth-sum Fractional Thickness-weighted Meridional Acceleration from Horizontal Viscosity'}, \textcolor{stringliteral}{'m s-2'}, & 2107 conversion=us%L\_T2\_to\_m\_s2) 2108 \textcolor{keywordflow}{if} ((cs%id\_hf\_diffv\_2d > 0) .and. (\textcolor{keyword}{present}(adp))) \textcolor{keywordflow}{then} 2109 \textcolor{keyword}{call }safe\_alloc\_ptr(adp%diag\_hfrac\_v,g%isd,g%ied,g%JsdB,g%JedB,g%ke) 2110 \textcolor{keywordflow}{ endif} 2111 2112 \textcolor{keywordflow}{if} (cs%biharmonic) \textcolor{keywordflow}{then} 2113 cs%id\_Ah\_h = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'Ahh'}, diag%axesTL, time, & 2114 \textcolor{stringliteral}{'Biharmonic Horizontal Viscosity at h Points'}, \textcolor{stringliteral}{'m4 s-1'}, conversion=us%L\_to\_m**4*us%s\_to\_T, & 2115 cmor\_field\_name=\textcolor{stringliteral}{'difmxybo'}, & 2116 cmor\_long\_name=\textcolor{stringliteral}{'Ocean lateral biharmonic viscosity'}, & 2117 cmor\_standard\_name=\textcolor{stringliteral}{'ocean\_momentum\_xy\_biharmonic\_diffusivity'}) 2118 cs%id\_Ah\_q = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'Ahq'}, diag%axesBL, time, & 2119 \textcolor{stringliteral}{'Biharmonic Horizontal Viscosity at q Points'}, \textcolor{stringliteral}{'m4 s-1'}, conversion=us%L\_to\_m**4*us%s\_to\_T) 2120 cs%id\_grid\_Re\_Ah = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'grid\_Re\_Ah'}, diag%axesTL, time, & 2121 \textcolor{stringliteral}{'Grid Reynolds number for the Biharmonic horizontal viscosity at h points'}, \textcolor{stringliteral}{'nondim'}) 2122 2123 \textcolor{keywordflow}{if} (cs%id\_grid\_Re\_Ah > 0) & 2124 \textcolor{comment}{! Compute the smallest biharmonic viscosity capable of modifying the} 2125 \textcolor{comment}{! velocity at floating point precision.} 2126 cs%min\_grid\_Ah = spacing(1.) * min\_grid\_sp\_h4 * idt 2127 \textcolor{keywordflow}{ endif} 2128 \textcolor{keywordflow}{if} (cs%Laplacian) \textcolor{keywordflow}{then} 2129 cs%id\_Kh\_h = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'Khh'}, diag%axesTL, time, & 2130 \textcolor{stringliteral}{'Laplacian Horizontal Viscosity at h Points'}, \textcolor{stringliteral}{'m2 s-1'}, conversion=us%L\_to\_m**2*us%s\_to\_T, & 2131 cmor\_field\_name=\textcolor{stringliteral}{'difmxylo'}, & 2132 cmor\_long\_name=\textcolor{stringliteral}{'Ocean lateral Laplacian viscosity'}, & 2133 cmor\_standard\_name=\textcolor{stringliteral}{'ocean\_momentum\_xy\_laplacian\_diffusivity'}) 2134 cs%id\_Kh\_q = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'Khq'}, diag%axesBL, time, & 2135 \textcolor{stringliteral}{'Laplacian Horizontal Viscosity at q Points'}, \textcolor{stringliteral}{'m2 s-1'}, conversion=us%L\_to\_m**2*us%s\_to\_T) 2136 cs%id\_grid\_Re\_Kh = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'grid\_Re\_Kh'}, diag%axesTL, time, & 2137 \textcolor{stringliteral}{'Grid Reynolds number for the Laplacian horizontal viscosity at h points'}, \textcolor{stringliteral}{'nondim'}) 2138 cs%id\_vort\_xy\_q = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'vort\_xy\_q'}, diag%axesBL, time, & 2139 \textcolor{stringliteral}{'Vertical vorticity at q Points'}, \textcolor{stringliteral}{'s-1'}, conversion=us%s\_to\_T) 2140 cs%id\_div\_xx\_h = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'div\_xx\_h'}, diag%axesTL, time, & 2141 \textcolor{stringliteral}{'Horizontal divergence at h Points'}, \textcolor{stringliteral}{'s-1'}, conversion=us%s\_to\_T) 2142 cs%id\_sh\_xy\_q = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'sh\_xy\_q'}, diag%axesBL, time, & 2143 \textcolor{stringliteral}{'Shearing strain at q Points'}, \textcolor{stringliteral}{'s-1'}, conversion=us%s\_to\_T) 2144 cs%id\_sh\_xx\_h = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'sh\_xx\_h'}, diag%axesTL, time, & 2145 \textcolor{stringliteral}{'Horizontal tension at h Points'}, \textcolor{stringliteral}{'s-1'}, conversion=us%s\_to\_T) 2146 2147 \textcolor{keywordflow}{if} (cs%id\_grid\_Re\_Kh > 0) & 2148 \textcolor{comment}{! Compute a smallest Laplacian viscosity capable of modifying the} 2149 \textcolor{comment}{! velocity at floating point precision.} 2150 cs%min\_grid\_Kh = spacing(1.) * min\_grid\_sp\_h2 * idt 2151 \textcolor{keywordflow}{ endif} 2152 \textcolor{keywordflow}{if} (cs%use\_GME) \textcolor{keywordflow}{then} 2153 cs%id\_GME\_coeff\_h = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'GME\_coeff\_h'}, diag%axesTL, time, & 2154 \textcolor{stringliteral}{'GME coefficient at h Points'}, \textcolor{stringliteral}{'m2 s-1'}, conversion=us%L\_to\_m**2*us%s\_to\_T) 2155 cs%id\_GME\_coeff\_q = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'GME\_coeff\_q'}, diag%axesBL, time, & 2156 \textcolor{stringliteral}{'GME coefficient at q Points'}, \textcolor{stringliteral}{'m2 s-1'}, conversion=us%L\_to\_m**2*us%s\_to\_T) 2157 cs%id\_FrictWork\_GME = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'},\textcolor{stringliteral}{'FrictWork\_GME'},diag%axesTL,time,& 2158 \textcolor{stringliteral}{'Integral work done by lateral friction terms in GME (excluding diffusion of energy)'}, & 2159 \textcolor{stringliteral}{'W m-2'}, conversion=us%RZ3\_T3\_to\_W\_m2*us%L\_to\_Z**2) 2160 \textcolor{keywordflow}{ endif} 2161 cs%id\_FrictWork = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'},\textcolor{stringliteral}{'FrictWork'},diag%axesTL,time,& 2162 \textcolor{stringliteral}{'Integral work done by lateral friction terms'}, & 2163 \textcolor{stringliteral}{'W m-2'}, conversion=us%RZ3\_T3\_to\_W\_m2*us%L\_to\_Z**2) 2164 cs%id\_FrictWorkIntz = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'},\textcolor{stringliteral}{'FrictWorkIntz'},diag%axesT1,time, & 2165 \textcolor{stringliteral}{'Depth integrated work done by lateral friction'}, & 2166 \textcolor{stringliteral}{'W m-2'}, conversion=us%RZ3\_T3\_to\_W\_m2*us%L\_to\_Z**2, & 2167 cmor\_field\_name=\textcolor{stringliteral}{'dispkexyfo'}, & 2168 cmor\_long\_name=\textcolor{stringliteral}{'Depth integrated ocean kinetic energy dissipation due to lateral friction'},& 2169 cmor\_standard\_name=\textcolor{stringliteral}{'ocean\_kinetic\_energy\_dissipation\_per\_unit\_area\_due\_to\_xy\_friction'}) 2170 \textcolor{keywordflow}{if} (cs%Laplacian .or. get\_all) \textcolor{keywordflow}{then} 2171 \textcolor{keywordflow}{ endif} \end{DoxyCode} \mbox{\Hypertarget{namespacemom__hor__visc_ab3a26095634db15095b980e45137e1f1}\label{namespacemom__hor__visc_ab3a26095634db15095b980e45137e1f1}} \index{mom\+\_\+hor\+\_\+visc@{mom\+\_\+hor\+\_\+visc}!horizontal\+\_\+viscosity@{horizontal\+\_\+viscosity}} \index{horizontal\+\_\+viscosity@{horizontal\+\_\+viscosity}!mom\+\_\+hor\+\_\+visc@{mom\+\_\+hor\+\_\+visc}} \subsubsection{\texorpdfstring{horizontal\+\_\+viscosity()}{horizontal\_viscosity()}} {\footnotesize\ttfamily subroutine, public mom\+\_\+hor\+\_\+visc\+::horizontal\+\_\+viscosity (\begin{DoxyParamCaption}\item[{real, dimension( g \%isdb\+: g \%iedb, g \%jsd\+: g \%jed, g \%ke), intent(in)}]{u, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsdb\+: g \%jedb, g \%ke), intent(in)}]{v, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsd\+: g \%jed, g \%ke), intent(inout)}]{h, }\item[{real, dimension( g \%isdb\+: g \%iedb, g \%jsd\+: g \%jed, g \%ke), intent(out)}]{diffu, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsdb\+: g \%jedb, g \%ke), intent(out)}]{diffv, }\item[{type(meke\+\_\+type), pointer}]{M\+E\+KE, }\item[{type(varmix\+\_\+cs), pointer}]{Var\+Mix, }\item[{type(ocean\+\_\+grid\+\_\+type), intent(in)}]{G, }\item[{type(verticalgrid\+\_\+type), intent(in)}]{GV, }\item[{type(unit\+\_\+scale\+\_\+type), intent(in)}]{US, }\item[{type(\hyperlink{structmom__hor__visc_1_1hor__visc__cs}{hor\+\_\+visc\+\_\+cs}), pointer}]{CS, }\item[{type(ocean\+\_\+obc\+\_\+type), optional, pointer}]{O\+BC, }\item[{type(barotropic\+\_\+cs), optional, pointer}]{BT, }\item[{type(thickness\+\_\+diffuse\+\_\+cs), optional, pointer}]{TD, }\item[{type(accel\+\_\+diag\+\_\+ptrs), optional, pointer}]{A\+Dp }\end{DoxyParamCaption})} Calculates the acceleration due to the horizontal viscosity. A combination of biharmonic and Laplacian forms can be used. The coefficient may either be a constant or a shear-\/dependent form. The biharmonic is determined by twice taking the divergence of an appropriately defined stress tensor. The Laplacian is determined by doing so once. To work, the following fields must be set outside of the usual is\+:ie range before this subroutine is called\+: u\mbox{[}is-\/2\+:ie+2,js-\/2\+:je+2\mbox{]} v\mbox{[}is-\/2\+:ie+2,js-\/2\+:je+2\mbox{]} h\mbox{[}is-\/1\+:ie+1,js-\/1\+:je+1\mbox{]} \begin{DoxyParams}[1]{Parameters} \mbox{\tt in} & {\em g} & The ocean\textquotesingle{}s grid structure.\\ \hline \mbox{\tt in} & {\em gv} & The ocean\textquotesingle{}s vertical grid structure.\\ \hline \mbox{\tt in} & {\em u} & The zonal velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em v} & The meridional velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in,out} & {\em h} & Layer thicknesses \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline \mbox{\tt out} & {\em diffu} & Zonal acceleration due to convergence of\\ \hline \mbox{\tt out} & {\em diffv} & Meridional acceleration due to convergence\\ \hline & {\em meke} & Pointer to a structure containing fields related to Mesoscale Eddy Kinetic Energy.\\ \hline & {\em varmix} & Pointer to a structure with fields that specify the spatially variable viscosities\\ \hline \mbox{\tt in} & {\em us} & A dimensional unit scaling type\\ \hline & {\em cs} & Control structure returned by a previous call to hor\+\_\+visc\+\_\+init.\\ \hline & {\em obc} & Pointer to an open boundary condition type\\ \hline & {\em bt} & Pointer to a structure containing barotropic velocities.\\ \hline & {\em td} & Pointer to a structure containing thickness diffusivities.\\ \hline & {\em adp} & Acceleration diagnostic pointers \\ \hline \end{DoxyParams} Definition at line 217 of file M\+O\+M\+\_\+hor\+\_\+visc.\+F90. \begin{DoxyCode} 217 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(in)} :: g\textcolor{comment}{ !< The ocean's grid structure.} 218 \textcolor{keywordtype}{type}(verticalgrid\_type), \textcolor{keywordtype}{intent(in)} :: gv\textcolor{comment}{ !< The ocean's vertical grid structure.} 219 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G),SZK\_(G))}, & 220 \textcolor{keywordtype}{intent(in)} :: u\textcolor{comment}{ !< The zonal velocity [L T-1 ~> m s-1].} 221 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G),SZK\_(G))}, & 222 \textcolor{keywordtype}{intent(in)} :: v\textcolor{comment}{ !< The meridional velocity [L T-1 ~> m s-1].} 223 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G),SZK\_(G))}, & 224 \textcolor{keywordtype}{intent(inout)} :: h\textcolor{comment}{ !< Layer thicknesses [H ~> m or kg m-2].} 225 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G),SZK\_(G))}, & 226 \textcolor{keywordtype}{intent(out)} :: diffu\textcolor{comment}{ !< Zonal acceleration due to convergence of} 227 \textcolor{comment}{ !! along-coordinate stress tensor [L T-2 ~> m s-2]} 228 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G),SZK\_(G))}, & 229 \textcolor{keywordtype}{intent(out)} :: diffv\textcolor{comment}{ !< Meridional acceleration due to convergence} 230 \textcolor{comment}{ !! of along-coordinate stress tensor [L T-2 ~> m s-2].} 231 \textcolor{keywordtype}{type}(meke\_type), \textcolor{keywordtype}{pointer} :: meke\textcolor{comment}{ !< Pointer to a structure containing fields} 232 \textcolor{comment}{ !! related to Mesoscale Eddy Kinetic Energy.} 233 \textcolor{keywordtype}{type}(varmix\_cs), \textcolor{keywordtype}{pointer} :: varmix\textcolor{comment}{ !< Pointer to a structure with fields that} 234 \textcolor{comment}{ !! specify the spatially variable viscosities} 235 \textcolor{keywordtype}{type}(unit\_scale\_type), \textcolor{keywordtype}{intent(in)} :: us\textcolor{comment}{ !< A dimensional unit scaling type} 236 \textcolor{keywordtype}{type}(hor\_visc\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< Control structure returned by a previous} 237 \textcolor{comment}{ !! call to hor\_visc\_init.} 238 \textcolor{keywordtype}{type}(ocean\_obc\_type), \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: obc\textcolor{comment}{ !< Pointer to an open boundary condition type} 239 \textcolor{keywordtype}{type}(barotropic\_cs), \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: bt\textcolor{comment}{ !< Pointer to a structure containing} 240 \textcolor{comment}{ !! barotropic velocities.} 241 \textcolor{keywordtype}{type}(thickness\_diffuse\_cs), \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: td\textcolor{comment}{ !< Pointer to a structure containing} 242 \textcolor{comment}{ !! thickness diffusivities.} 243 \textcolor{keywordtype}{type}(accel\_diag\_ptrs), \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: adp\textcolor{comment}{ !< Acceleration diagnostic pointers} 244 245 \textcolor{comment}{! Local variables} 246 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G))} :: & 247 del2u, & \textcolor{comment}{! The u-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1]} 248 h\_u, & \textcolor{comment}{! Thickness interpolated to u points [H ~> m or kg m-2].} 249 vort\_xy\_dy, & \textcolor{comment}{! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1]} 250 div\_xx\_dx, & \textcolor{comment}{! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1]} 251 ubtav \textcolor{comment}{! zonal barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1]} 252 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G))} :: & 253 del2v, & \textcolor{comment}{! The v-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1]} 254 h\_v, & \textcolor{comment}{! Thickness interpolated to v points [H ~> m or kg m-2].} 255 vort\_xy\_dx, & \textcolor{comment}{! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1]} 256 div\_xx\_dy, & \textcolor{comment}{! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1]} 257 vbtav \textcolor{comment}{! meridional barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1]} 258 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G))} :: & 259 dudx\_bt, dvdy\_bt, & \textcolor{comment}{! components in the barotropic horizontal tension [T-1 ~> s-1]} 260 div\_xx, & \textcolor{comment}{! Estimate of horizontal divergence at h-points [T-1 ~> s-1]} 261 sh\_xx, & \textcolor{comment}{! horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1]} 262 sh\_xx\_bt, & \textcolor{comment}{! barotropic horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1]} 263 str\_xx,& \textcolor{comment}{! str\_xx is the diagonal term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2]} 264 str\_xx\_gme,& \textcolor{comment}{! smoothed diagonal term in the stress tensor from GME [H L2 T-2 ~> m3 s-2 or kg s-2]} 265 bhstr\_xx, & \textcolor{comment}{! A copy of str\_xx that only contains the biharmonic contribution [H L2 T-2 ~> m3 s-2 or kg s-2]} 266 frictworkintz, & \textcolor{comment}{! depth integrated energy dissipated by lateral friction [R L2 T-3 ~> W m-2]} 267 \textcolor{comment}{! Leith\_Kh\_h, & ! Leith Laplacian viscosity at h-points [L2 T-1 ~> m2 s-1]} 268 \textcolor{comment}{! Leith\_Ah\_h, & ! Leith bi-harmonic viscosity at h-points [L4 T-1 ~> m4 s-1]} 269 grad\_vort\_mag\_h, & \textcolor{comment}{! Magnitude of vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1]} 270 grad\_vort\_mag\_h\_2d, & \textcolor{comment}{! Magnitude of 2d vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1]} 271 del2vort\_h, & \textcolor{comment}{! Laplacian of vorticity at h-points [L-2 T-1 ~> m-2 s-1]} 272 grad\_div\_mag\_h, & \textcolor{comment}{! Magnitude of divergence gradient at h-points [L-1 T-1 ~> m-1 s-1]} 273 dudx, dvdy, & \textcolor{comment}{! components in the horizontal tension [T-1 ~> s-1]} 274 grad\_vel\_mag\_h, & \textcolor{comment}{! Magnitude of the velocity gradient tensor squared at h-points [T-2 ~> s-2]} 275 grad\_vel\_mag\_bt\_h, & \textcolor{comment}{! Magnitude of the barotropic velocity gradient tensor squared at h-points [T-2 ~> s-2]} 276 grad\_d2vel\_mag\_h, & \textcolor{comment}{! Magnitude of the Laplacian of the velocity vector, squared [L-2 T-2 ~> m-2 s-2]} 277 boundary\_mask\_h \textcolor{comment}{! A mask that zeroes out cells with at least one land edge [nondim]} 278 279 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{allocatable}, \textcolor{keywordtype}{dimension(:,:)} :: hf\_diffu\_2d \textcolor{comment}{! Depth sum of hf\_diffu [L T-2 ~> m s-2]} 280 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{allocatable}, \textcolor{keywordtype}{dimension(:,:)} :: hf\_diffv\_2d \textcolor{comment}{! Depth sum of hf\_diffv [L T-2 ~> m s-2]} 281 282 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJB\_(G))} :: & 283 dvdx, dudy, & \textcolor{comment}{! components in the shearing strain [T-1 ~> s-1]} 284 ddel2vdx, ddel2udy, & \textcolor{comment}{! Components in the biharmonic equivalent of the shearing strain [L-2 T-1 ~> m-2 s-1]} 285 dvdx\_bt, dudy\_bt, & \textcolor{comment}{! components in the barotropic shearing strain [T-1 ~> s-1]} 286 sh\_xy, & \textcolor{comment}{! horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1]} 287 sh\_xy\_bt, & \textcolor{comment}{! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [T-1 ~> s-1]} 288 str\_xy, & \textcolor{comment}{! str\_xy is the cross term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2]} 289 str\_xy\_gme, & \textcolor{comment}{! smoothed cross term in the stress tensor from GME [H L2 T-2 ~> m3 s-2 or kg s-2]} 290 bhstr\_xy, & \textcolor{comment}{! A copy of str\_xy that only contains the biharmonic contribution [H L2 T-2 ~> m3 s-2 or kg s-2]} 291 vort\_xy, & \textcolor{comment}{! Vertical vorticity (dv/dx - du/dy) including metric terms [T-1 ~> s-1]} 292 leith\_kh\_q, & \textcolor{comment}{! Leith Laplacian viscosity at q-points [L2 T-1 ~> m2 s-1]} 293 leith\_ah\_q, & \textcolor{comment}{! Leith bi-harmonic viscosity at q-points [L4 T-1 ~> m4 s-1]} 294 grad\_vort\_mag\_q, & \textcolor{comment}{! Magnitude of vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1]} 295 grad\_vort\_mag\_q\_2d, & \textcolor{comment}{! Magnitude of 2d vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1]} 296 del2vort\_q, & \textcolor{comment}{! Laplacian of vorticity at q-points [L-2 T-1 ~> m-2 s-1]} 297 grad\_div\_mag\_q, & \textcolor{comment}{! Magnitude of divergence gradient at q-points [L-1 T-1 ~> m-1 s-1]} 298 grad\_vel\_mag\_q, & \textcolor{comment}{! Magnitude of the velocity gradient tensor squared at q-points [T-2 ~> s-2]} 299 hq, & \textcolor{comment}{! harmonic mean of the harmonic means of the u- & v point thicknesses [H ~> m or kg m-2]} 300 \textcolor{comment}{! This form guarantees that hq/hu < 4.} 301 grad\_vel\_mag\_bt\_q, & \textcolor{comment}{! Magnitude of the barotropic velocity gradient tensor squared at q-points [T-2 ~> s-2]} 302 boundary\_mask\_q \textcolor{comment}{! A mask that zeroes out cells with at least one land edge [nondim]} 303 304 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJB\_(G),SZK\_(G))} :: & 305 ah\_q, & \textcolor{comment}{! biharmonic viscosity at corner points [L4 T-1 ~> m4 s-1]} 306 kh\_q, & \textcolor{comment}{! Laplacian viscosity at corner points [L2 T-1 ~> m2 s-1]} 307 vort\_xy\_q, & \textcolor{comment}{! vertical vorticity at corner points [T-1 ~> s-1]} 308 sh\_xy\_q, & \textcolor{comment}{! horizontal shearing strain at corner points [T-1 ~> s-1]} 309 gme\_coeff\_q, & !< GME coeff. at q-points [L2 T-1 ~> m2 s-1] 310 max\_diss\_rate\_q \textcolor{comment}{! maximum possible energy dissipated by lateral friction [L2 T-3 ~> m2 s-3]} 311 312 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G),SZK\_(G)+1)} :: & 313 kh\_u\_gme\textcolor{comment}{ !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1]} 314 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G),SZK\_(G)+1)} :: & 315 kh\_v\_gme\textcolor{comment}{ !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1]} 316 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G),SZK\_(G))} :: & 317 ah\_h, & \textcolor{comment}{! biharmonic viscosity at thickness points [L4 T-1 ~> m4 s-1]} 318 kh\_h, & \textcolor{comment}{! Laplacian viscosity at thickness points [L2 T-1 ~> m2 s-1]} 319 max\_diss\_rate\_h, & \textcolor{comment}{! maximum possible energy dissipated by lateral friction [L2 T-3 ~> m2 s-3]} 320 frictwork, & \textcolor{comment}{! work done by MKE dissipation mechanisms [R L2 T-3 ~> W m-2]} 321 frictwork\_gme, & \textcolor{comment}{! work done by GME [R L2 T-3 ~> W m-2]} 322 div\_xx\_h, & \textcolor{comment}{! horizontal divergence [T-1 ~> s-1]} 323 sh\_xx\_h \textcolor{comment}{! horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1]} 324 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G),SZK\_(G))} :: & 325 grid\_re\_kh, & !< Grid Reynolds number for Laplacian horizontal viscosity at h points [nondim] 326 grid\_re\_ah, & !< Grid Reynolds number for Biharmonic horizontal viscosity at h points [nondim] 327 gme\_coeff\_h\textcolor{comment}{ !< GME coeff. at h-points [L2 T-1 ~> m2 s-1]} 328 \textcolor{keywordtype}{real} :: ah \textcolor{comment}{! biharmonic viscosity [L4 T-1 ~> m4 s-1]} 329 \textcolor{keywordtype}{real} :: kh \textcolor{comment}{! Laplacian viscosity [L2 T-1 ~> m2 s-1]} 330 \textcolor{keywordtype}{real} :: ahsm \textcolor{comment}{! Smagorinsky biharmonic viscosity [L4 T-1 ~> m4 s-1]} 331 \textcolor{keywordtype}{real} :: ahlth \textcolor{comment}{! 2D Leith biharmonic viscosity [L4 T-1 ~> m4 s-1]} 332 \textcolor{keywordtype}{real} :: mod\_leith \textcolor{comment}{! nondimensional coefficient for divergence part of modified Leith} 333 \textcolor{comment}{! viscosity. Here set equal to nondimensional Laplacian Leith constant.} 334 \textcolor{comment}{! This is set equal to zero if modified Leith is not used.} 335 \textcolor{keywordtype}{real} :: shear\_mag \textcolor{comment}{! magnitude of the shear [T-1 ~> s-1]} 336 \textcolor{keywordtype}{real} :: vert\_vort\_mag \textcolor{comment}{! magnitude of the vertical vorticity gradient [L-1 T-1 ~> m-1 s-1]} 337 \textcolor{keywordtype}{real} :: h2uq, h2vq \textcolor{comment}{! temporary variables [H2 ~> m2 or kg2 m-4].} 338 \textcolor{keywordtype}{real} :: hu, hv \textcolor{comment}{! Thicknesses interpolated by arithmetic means to corner} 339 \textcolor{comment}{! points; these are first interpolated to u or v velocity} 340 \textcolor{comment}{! points where masks are applied [H ~> m or kg m-2].} 341 \textcolor{keywordtype}{real} :: h\_neglect \textcolor{comment}{! thickness so small it can be lost in roundoff and so neglected [H ~> m or kg m-2]} 342 \textcolor{keywordtype}{real} :: h\_neglect3 \textcolor{comment}{! h\_neglect^3 [H3 ~> m3 or kg3 m-6]} 343 \textcolor{keywordtype}{real} :: hrat\_min \textcolor{comment}{! minimum thicknesses at the 4 neighboring} 344 \textcolor{comment}{! velocity points divided by the thickness at the stress} 345 \textcolor{comment}{! point (h or q point) [nondim]} 346 \textcolor{keywordtype}{real} :: visc\_bound\_rem \textcolor{comment}{! fraction of overall viscous bounds that} 347 \textcolor{comment}{! remain to be applied [nondim]} 348 \textcolor{keywordtype}{real} :: kh\_scale \textcolor{comment}{! A factor between 0 and 1 by which the horizontal} 349 \textcolor{comment}{! Laplacian viscosity is rescaled [nondim]} 350 \textcolor{keywordtype}{real} :: roscl \textcolor{comment}{! The scaling function for MEKE source term [nondim]} 351 \textcolor{keywordtype}{real} :: fath \textcolor{comment}{! abs(f) at h-point for MEKE source term [T-1 ~> s-1]} 352 \textcolor{keywordtype}{real} :: local\_strain \textcolor{comment}{! Local variable for interpolating computed strain rates [T-1 ~> s-1].} 353 \textcolor{keywordtype}{real} :: meke\_res\_fn \textcolor{comment}{! A copy of the resolution scaling factor if being applied to MEKE. Otherwise =1.} 354 \textcolor{keywordtype}{real} :: gme\_coeff \textcolor{comment}{! The GME (negative) viscosity coefficient [L2 T-1 ~> m2 s-1]} 355 \textcolor{keywordtype}{real} :: gme\_coeff\_limiter \textcolor{comment}{! Maximum permitted value of the GME coefficient [L2 T-1 ~> m2 s-1]} 356 \textcolor{keywordtype}{real} :: fwfrac \textcolor{comment}{! Fraction of maximum theoretical energy transfer to use when scaling GME coefficient [nondim]} 357 \textcolor{keywordtype}{real} :: dy\_dxbu \textcolor{comment}{! Ratio of meridional over zonal grid spacing at vertices [nondim]} 358 \textcolor{keywordtype}{real} :: dx\_dybu \textcolor{comment}{! Ratio of zonal over meridiononal grid spacing at vertices [nondim]} 359 \textcolor{keywordtype}{real} :: dy\_dxcv \textcolor{comment}{! Ratio of meridional over zonal grid spacing at faces [nondim]} 360 \textcolor{keywordtype}{real} :: dx\_dycu \textcolor{comment}{! Ratio of zonal over meridional grid spacing at faces [nondim]} 361 \textcolor{keywordtype}{real} :: sh\_f\_pow \textcolor{comment}{! The ratio of shear over the absolute value of f raised to some power and rescaled [nondim]} 362 \textcolor{keywordtype}{real} :: backscat\_subround \textcolor{comment}{! The ratio of f over Shear\_mag that is so small that the backscatter} 363 \textcolor{comment}{! calculation gives the same value as if f were 0 [nondim].} 364 \textcolor{keywordtype}{real} :: h0\_gme \textcolor{comment}{! Depth used to scale down GME coefficient in shallow areas [Z ~> m]} 365 \textcolor{keywordtype}{real} :: ke \textcolor{comment}{! Local kinetic energy [L2 T-2 ~> m2 s-2]} 366 367 \textcolor{keywordtype}{logical} :: rescale\_kh, legacy\_bound 368 \textcolor{keywordtype}{logical} :: find\_frictwork 369 \textcolor{keywordtype}{logical} :: apply\_obc = .false. 370 \textcolor{keywordtype}{logical} :: use\_meke\_ku 371 \textcolor{keywordtype}{logical} :: use\_meke\_au 372 \textcolor{keywordtype}{integer} :: is, ie, js, je, isq, ieq, jsq, jeq, nz 373 \textcolor{keywordtype}{integer} :: i, j, k, n 374 \textcolor{keywordtype}{real} :: inv\_pi3, inv\_pi2, inv\_pi6 375 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke 376 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB 377 378 h\_neglect = gv%H\_subroundoff 379 h\_neglect3 = h\_neglect**3 380 inv\_pi3 = 1.0/((4.0*atan(1.0))**3) 381 inv\_pi2 = 1.0/((4.0*atan(1.0))**2) 382 inv\_pi6 = inv\_pi3 * inv\_pi3 383 384 ah\_h(:,:,:) = 0.0 385 kh\_h(:,:,:) = 0.0 386 387 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(obc)) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(obc)) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (obc%OBC\_pe) \textcolor{keywordflow}{then} 388 apply\_obc = obc%Flather\_u\_BCs\_exist\_globally .or. obc%Flather\_v\_BCs\_exist\_globally 389 apply\_obc = .true. 390 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ endif} 391 392 \textcolor{keywordflow}{if} (.not.\textcolor{keyword}{associated}(cs)) \textcolor{keyword}{call }mom\_error(fatal, & 393 \textcolor{stringliteral}{"MOM\_hor\_visc: Module must be initialized before it is used."}) 394 \textcolor{keywordflow}{if} (.not.(cs%Laplacian .or. cs%biharmonic)) \textcolor{keywordflow}{return} 395 396 find\_frictwork = (cs%id\_FrictWork > 0) 397 \textcolor{keywordflow}{if} (cs%id\_FrictWorkIntz > 0) find\_frictwork = .true. 398 \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(meke)) \textcolor{keywordflow}{then} 399 \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(meke%mom\_src)) find\_frictwork = .true. 400 backscat\_subround = 0.0 401 \textcolor{keywordflow}{if} (find\_frictwork .and. \textcolor{keyword}{associated}(meke%mom\_src) .and. (meke%backscatter\_Ro\_c > 0.0) .and. & 402 (meke%backscatter\_Ro\_Pow /= 0.0)) & 403 backscat\_subround = (1.0e-16/meke%backscatter\_Ro\_c)**(1.0/meke%backscatter\_Ro\_Pow) 404 \textcolor{keywordflow}{ endif} 405 406 rescale\_kh = .false. 407 \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(varmix)) \textcolor{keywordflow}{then} 408 rescale\_kh = varmix%Resoln\_scaled\_Kh 409 \textcolor{keywordflow}{if} (rescale\_kh .and. & 410 (.not.\textcolor{keyword}{associated}(varmix%Res\_fn\_h) .or. .not.\textcolor{keyword}{associated}(varmix%Res\_fn\_q))) & 411 \textcolor{keyword}{call }mom\_error(fatal, \textcolor{stringliteral}{"MOM\_hor\_visc: VarMix%Res\_fn\_h and "} //& 412 \textcolor{stringliteral}{"VarMix%Res\_fn\_q both need to be associated with Resoln\_scaled\_Kh."}) 413 \textcolor{keywordflow}{ endif} 414 legacy\_bound = (cs%Smagorinsky\_Kh .or. cs%Leith\_Kh) .and. & 415 (cs%bound\_Kh .and. .not.cs%better\_bound\_Kh) 416 417 \textcolor{comment}{! Toggle whether to use a Laplacian viscosity derived from MEKE} 418 use\_meke\_ku = \textcolor{keyword}{associated}(meke%Ku) 419 use\_meke\_au = \textcolor{keyword}{associated}(meke%Au) 420 421 \textcolor{keywordflow}{if} (cs%use\_GME) \textcolor{keywordflow}{then} 422 \textcolor{keywordflow}{do} j=jsq-1,jeq+2 ; \textcolor{keywordflow}{do} i=isq-1,ieq+2 423 boundary\_mask\_h(i,j) = (g%mask2dCu(i,j) * g%mask2dCv(i,j) * g%mask2dCu(i-1,j) * g%mask2dCv(i,j-1)) 424 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 425 426 \textcolor{keywordflow}{do} j=js-2,jeq+1 ; \textcolor{keywordflow}{do} i=is-2,ieq+1 427 boundary\_mask\_q(i,j) = (g%mask2dCv(i,j) * g%mask2dCv(i+1,j) * g%mask2dCu(i,j) * g%mask2dCu(i,j-1)) 428 \textcolor{keyword}{ end}do; enddo 429 430 \textcolor{comment}{! initialize diag. array with zeros} 431 gme\_coeff\_h(:,:,:) = 0.0 432 gme\_coeff\_q(:,:,:) = 0.0 433 str\_xx\_gme(:,:) = 0.0 434 str\_xy\_gme(:,:) = 0.0 435 436 \textcolor{comment}{! Get barotropic velocities and their gradients} 437 \textcolor{keyword}{call }barotropic\_get\_tav(bt, ubtav, vbtav, g, us) 438 \textcolor{keyword}{call }pass\_vector(ubtav, vbtav, g%Domain) 439 440 \textcolor{keywordflow}{do} j=js-1,je+2 ; \textcolor{keywordflow}{do} i=is-1,ie+2 441 dudx\_bt(i,j) = cs%DY\_dxT(i,j)*(g%IdyCu(i,j) * ubtav(i,j) - & 442 g%IdyCu(i-1,j) * ubtav(i-1,j)) 443 dvdy\_bt(i,j) = cs%DX\_dyT(i,j)*(g%IdxCv(i,j) * vbtav(i,j) - & 444 g%IdxCv(i,j-1) * vbtav(i,j-1)) 445 \textcolor{keyword}{ end}do; enddo 446 447 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 448 sh\_xx\_bt(i,j) = dudx\_bt(i,j) - dvdy\_bt(i,j) 449 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 450 451 \textcolor{comment}{! Components for the barotropic shearing strain} 452 \textcolor{keywordflow}{do} j=js-2,jeq+1 ; \textcolor{keywordflow}{do} i=is-2,ieq+1 453 dvdx\_bt(i,j) = cs%DY\_dxBu(i,j)*(vbtav(i+1,j)*g%IdyCv(i+1,j) & 454 - vbtav(i,j)*g%IdyCv(i,j)) 455 dudy\_bt(i,j) = cs%DX\_dyBu(i,j)*(ubtav(i,j+1)*g%IdxCu(i,j+1) & 456 - ubtav(i,j)*g%IdxCu(i,j)) 457 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 458 459 \textcolor{keyword}{call }pass\_vector(dudx\_bt, dvdy\_bt, g%Domain, stagger=bgrid\_ne) 460 \textcolor{keyword}{call }pass\_vector(dvdx\_bt, dudy\_bt, g%Domain, stagger=agrid) 461 462 \textcolor{keywordflow}{if} (cs%no\_slip) \textcolor{keywordflow}{then} 463 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 464 sh\_xy\_bt(i,j) = (2.0-g%mask2dBu(i,j)) * ( dvdx\_bt(i,j) + dudy\_bt(i,j) ) 465 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 466 \textcolor{keywordflow}{else} 467 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 468 sh\_xy\_bt(i,j) = g%mask2dBu(i,j) * ( dvdx\_bt(i,j) + dudy\_bt(i,j) ) 469 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 470 \textcolor{keywordflow}{ endif} 471 472 \textcolor{keywordflow}{do} j=jsq-1,jeq+2 ; \textcolor{keywordflow}{do} i=isq-1,ieq+2 473 grad\_vel\_mag\_bt\_h(i,j) = boundary\_mask\_h(i,j) * (dudx\_bt(i,j)**2 + dvdy\_bt(i,j)**2 + & 474 (0.25*((dvdx\_bt(i,j)+dvdx\_bt(i-1,j-1))+(dvdx\_bt(i,j-1)+dvdx\_bt(i-1,j))))**2 + & 475 (0.25*((dudy\_bt(i,j)+dudy\_bt(i-1,j-1))+(dudy\_bt(i,j-1)+dudy\_bt(i-1,j))))**2) 476 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 477 478 \textcolor{keywordflow}{do} j=js-2,jeq+1 ; \textcolor{keywordflow}{do} i=is-2,ieq+1 479 grad\_vel\_mag\_bt\_q(i,j) = boundary\_mask\_q(i,j) * (dvdx\_bt(i,j)**2 + dudy\_bt(i,j)**2 + & 480 (0.25*((dudx\_bt(i,j)+dudx\_bt(i+1,j+1))+(dudx\_bt(i,j+1)+dudx\_bt(i+1,j))))**2 + & 481 (0.25*((dvdy\_bt(i,j)+dvdy\_bt(i+1,j+1))+(dvdy\_bt(i,j+1)+dvdy\_bt(i+1,j))))**2) 482 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 483 484 \textcolor{keywordflow}{ endif} \textcolor{comment}{! use\_GME} 485 486 \textcolor{comment}{!$OMP parallel do default(none) &} 487 \textcolor{comment}{!$OMP shared( &} 488 \textcolor{comment}{!$OMP CS, G, GV, US, OBC, VarMix, MEKE, u, v, h, &} 489 \textcolor{comment}{!$OMP is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, &} 490 \textcolor{comment}{!$OMP apply\_OBC, rescale\_Kh, legacy\_bound, find\_FrictWork, &} 491 \textcolor{comment}{!$OMP use\_MEKE\_Ku, use\_MEKE\_Au, boundary\_mask\_h, boundary\_mask\_q, &} 492 \textcolor{comment}{!$OMP backscat\_subround, GME\_coeff\_limiter, &} 493 \textcolor{comment}{!$OMP h\_neglect, h\_neglect3, FWfrac, inv\_PI3, inv\_PI6, H0\_GME, &} 494 \textcolor{comment}{!$OMP diffu, diffv, max\_diss\_rate\_h, max\_diss\_rate\_q, &} 495 \textcolor{comment}{!$OMP Kh\_h, Kh\_q, Ah\_h, Ah\_q, FrictWork, FrictWork\_GME, &} 496 \textcolor{comment}{!$OMP div\_xx\_h, sh\_xx\_h, vort\_xy\_q, sh\_xy\_q, GME\_coeff\_h, GME\_coeff\_q, &} 497 \textcolor{comment}{!$OMP TD, KH\_u\_GME, KH\_v\_GME, grid\_Re\_Kh, grid\_Re\_Ah &} 498 \textcolor{comment}{!$OMP ) &} 499 \textcolor{comment}{!$OMP private( &} 500 \textcolor{comment}{!$OMP i, j, k, n, &} 501 \textcolor{comment}{!$OMP dudx, dudy, dvdx, dvdy, sh\_xx, sh\_xy, h\_u, h\_v, &} 502 \textcolor{comment}{!$OMP Del2u, Del2v, DY\_dxBu, DX\_dyBu, sh\_xx\_bt, sh\_xy\_bt, &} 503 \textcolor{comment}{!$OMP str\_xx, str\_xy, bhstr\_xx, bhstr\_xy, str\_xx\_GME, str\_xy\_GME, &} 504 \textcolor{comment}{!$OMP vort\_xy, vort\_xy\_dx, vort\_xy\_dy, div\_xx, div\_xx\_dx, div\_xx\_dy, &} 505 \textcolor{comment}{!$OMP grad\_div\_mag\_h, grad\_div\_mag\_q, grad\_vort\_mag\_h, grad\_vort\_mag\_q, &} 506 \textcolor{comment}{!$OMP grad\_vort\_mag\_h\_2d, grad\_vort\_mag\_q\_2d, &} 507 \textcolor{comment}{!$OMP grad\_vel\_mag\_h, grad\_vel\_mag\_q, &} 508 \textcolor{comment}{!$OMP grad\_vel\_mag\_bt\_h, grad\_vel\_mag\_bt\_q, grad\_d2vel\_mag\_h, &} 509 \textcolor{comment}{!$OMP meke\_res\_fn, Shear\_mag, vert\_vort\_mag, hrat\_min, visc\_bound\_rem, &} 510 \textcolor{comment}{!$OMP Kh, Ah, AhSm, AhLth, local\_strain, Sh\_F\_pow, &} 511 \textcolor{comment}{!$OMP dDel2vdx, dDel2udy, DY\_dxCv, DX\_dyCu, Del2vort\_q, Del2vort\_h, KE, &} 512 \textcolor{comment}{!$OMP h2uq, h2vq, hu, hv, hq, FatH, RoScl, GME\_coeff &} 513 \textcolor{comment}{!$OMP )} 514 \textcolor{keywordflow}{do} k=1,nz 515 516 \textcolor{comment}{! The following are the forms of the horizontal tension and horizontal} 517 \textcolor{comment}{! shearing strain advocated by Smagorinsky (1993) and discussed in} 518 \textcolor{comment}{! Griffies and Hallberg (2000).} 519 520 \textcolor{comment}{! Calculate horizontal tension} 521 \textcolor{keywordflow}{do} j=jsq-1,jeq+2 ; \textcolor{keywordflow}{do} i=isq-1,ieq+2 522 dudx(i,j) = cs%DY\_dxT(i,j)*(g%IdyCu(i,j) * u(i,j,k) - & 523 g%IdyCu(i-1,j) * u(i-1,j,k)) 524 dvdy(i,j) = cs%DX\_dyT(i,j)*(g%IdxCv(i,j) * v(i,j,k) - & 525 g%IdxCv(i,j-1) * v(i,j-1,k)) 526 sh\_xx(i,j) = dudx(i,j) - dvdy(i,j) 527 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 528 529 \textcolor{comment}{! Components for the shearing strain} 530 \textcolor{keywordflow}{do} j=jsq-2,jeq+2 ; \textcolor{keywordflow}{do} i=isq-2,ieq+2 531 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)) 532 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)) 533 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 534 535 \textcolor{comment}{! Interpolate the thicknesses to velocity points.} 536 \textcolor{comment}{! The extra wide halos are to accommodate the cross-corner-point projections} 537 \textcolor{comment}{! in OBCs, which are not ordinarily be necessary, and might not be necessary} 538 \textcolor{comment}{! even with OBCs if the accelerations are zeroed at OBC points, in which} 539 \textcolor{comment}{! case the j-loop for h\_u could collapse to j=js=1,je+1. -RWH} 540 \textcolor{keywordflow}{if} (cs%use\_land\_mask) \textcolor{keywordflow}{then} 541 \textcolor{keywordflow}{do} j=js-2,je+2 ; \textcolor{keywordflow}{do} i=isq-1,ieq+1 542 h\_u(i,j) = 0.5 * (g%mask2dT(i,j)*h(i,j,k) + g%mask2dT(i+1,j)*h(i+1,j,k)) 543 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 544 \textcolor{keywordflow}{do} j=jsq-1,jeq+1 ; \textcolor{keywordflow}{do} i=is-2,ie+2 545 h\_v(i,j) = 0.5 * (g%mask2dT(i,j)*h(i,j,k) + g%mask2dT(i,j+1)*h(i,j+1,k)) 546 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 547 \textcolor{keywordflow}{else} 548 \textcolor{keywordflow}{do} j=js-2,je+2 ; \textcolor{keywordflow}{do} i=isq-1,ieq+1 549 h\_u(i,j) = 0.5 * (h(i,j,k) + h(i+1,j,k)) 550 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 551 \textcolor{keywordflow}{do} j=jsq-1,jeq+1 ; \textcolor{keywordflow}{do} i=is-2,ie+2 552 h\_v(i,j) = 0.5 * (h(i,j,k) + h(i,j+1,k)) 553 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 554 \textcolor{keywordflow}{ endif} 555 556 \textcolor{comment}{! Adjust contributions to shearing strain and interpolated values of} 557 \textcolor{comment}{! thicknesses on open boundaries.} 558 \textcolor{keywordflow}{if} (apply\_obc) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{do} n=1,obc%number\_of\_segments 559 j = obc%segment(n)%HI%JsdB ; i = obc%segment(n)%HI%IsdB 560 \textcolor{keywordflow}{if} (obc%zero\_strain .or. obc%freeslip\_strain .or. obc%computed\_strain) \textcolor{keywordflow}{then} 561 \textcolor{keywordflow}{if} (obc%segment(n)%is\_N\_or\_S .and. (j >= js-2) .and. (j <= jeq+1)) \textcolor{keywordflow}{then} 562 \textcolor{keywordflow}{do} i=obc%segment(n)%HI%IsdB,obc%segment(n)%HI%IedB 563 \textcolor{keywordflow}{if} (obc%zero\_strain) \textcolor{keywordflow}{then} 564 dvdx(i,j) = 0. ; dudy(i,j) = 0. 565 \textcolor{keywordflow}{elseif} (obc%freeslip\_strain) \textcolor{keywordflow}{then} 566 dudy(i,j) = 0. 567 \textcolor{keywordflow}{elseif} (obc%computed\_strain) \textcolor{keywordflow}{then} 568 \textcolor{keywordflow}{if} (obc%segment(n)%direction == obc\_direction\_n) \textcolor{keywordflow}{then} 569 dudy(i,j) = 2.0*cs%DX\_dyBu(i,j)* & 570 (obc%segment(n)%tangential\_vel(i,j,k) - u(i,j,k))*g%IdxCu(i,j) 571 \textcolor{keywordflow}{else} 572 dudy(i,j) = 2.0*cs%DX\_dyBu(i,j)* & 573 (u(i,j+1,k) - obc%segment(n)%tangential\_vel(i,j,k))*g%IdxCu(i,j+1) 574 \textcolor{keywordflow}{ endif} 575 \textcolor{keywordflow}{elseif} (obc%specified\_strain) \textcolor{keywordflow}{then} 576 \textcolor{keywordflow}{if} (obc%segment(n)%direction == obc\_direction\_n) \textcolor{keywordflow}{then} 577 dudy(i,j) = cs%DX\_dyBu(i,j)*obc%segment(n)%tangential\_grad(i,j,k)*g%IdxCu(i,j)*g%dxBu(i,j) 578 \textcolor{keywordflow}{else} 579 dudy(i,j) = cs%DX\_dyBu(i,j)*obc%segment(n)%tangential\_grad(i,j,k)*g%IdxCu(i,j+1)*g%dxBu(i,j ) 580 \textcolor{keywordflow}{ endif} 581 \textcolor{keywordflow}{ endif} 582 \textcolor{keywordflow}{ enddo} 583 \textcolor{keywordflow}{elseif} (obc%segment(n)%is\_E\_or\_W .and. (i >= is-2) .and. (i <= ieq+1)) \textcolor{keywordflow}{then} 584 \textcolor{keywordflow}{do} j=obc%segment(n)%HI%JsdB,obc%segment(n)%HI%JedB 585 \textcolor{keywordflow}{if} (obc%zero\_strain) \textcolor{keywordflow}{then} 586 dvdx(i,j) = 0. ; dudy(i,j) = 0. 587 \textcolor{keywordflow}{elseif} (obc%freeslip\_strain) \textcolor{keywordflow}{then} 588 dvdx(i,j) = 0. 589 \textcolor{keywordflow}{elseif} (obc%computed\_strain) \textcolor{keywordflow}{then} 590 \textcolor{keywordflow}{if} (obc%segment(n)%direction == obc\_direction\_e) \textcolor{keywordflow}{then} 591 dvdx(i,j) = 2.0*cs%DY\_dxBu(i,j)* & 592 (obc%segment(n)%tangential\_vel(i,j,k) - v(i,j,k))*g%IdyCv(i,j) 593 \textcolor{keywordflow}{else} 594 dvdx(i,j) = 2.0*cs%DY\_dxBu(i,j)* & 595 (v(i+1,j,k) - obc%segment(n)%tangential\_vel(i,j,k))*g%IdyCv(i+1,j) 596 \textcolor{keywordflow}{ endif} 597 \textcolor{keywordflow}{elseif} (obc%specified\_strain) \textcolor{keywordflow}{then} 598 \textcolor{keywordflow}{if} (obc%segment(n)%direction == obc\_direction\_e) \textcolor{keywordflow}{then} 599 dvdx(i,j) = cs%DY\_dxBu(i,j)*obc%segment(n)%tangential\_grad(i,j,k)*g%IdyCv(i,j)*g%dxBu(i,j) 600 \textcolor{keywordflow}{else} 601 dvdx(i,j) = cs%DY\_dxBu(i,j)*obc%segment(n)%tangential\_grad(i,j,k)*g%IdyCv(i+1,j)*g%dxBu(i,j ) 602 \textcolor{keywordflow}{ endif} 603 \textcolor{keywordflow}{ endif} 604 \textcolor{keywordflow}{ enddo} 605 \textcolor{keywordflow}{ endif} 606 \textcolor{keywordflow}{ endif} 607 608 609 \textcolor{keywordflow}{if} (obc%segment(n)%direction == obc\_direction\_n) \textcolor{keywordflow}{then} 610 \textcolor{comment}{! There are extra wide halos here to accommodate the cross-corner-point} 611 \textcolor{comment}{! OBC projections, but they might not be necessary if the accelerations} 612 \textcolor{comment}{! are always zeroed out at OBC points, in which case the i-loop below} 613 \textcolor{comment}{! becomes do i=is-1,ie+1. -RWH} 614 \textcolor{keywordflow}{if} ((j >= jsq-1) .and. (j <= jeq+1)) \textcolor{keywordflow}{then} 615 \textcolor{keywordflow}{do} i = max(is-2,obc%segment(n)%HI%isd), min(ie+2,obc%segment(n)%HI%ied) 616 h\_v(i,j) = h(i,j,k) 617 \textcolor{keywordflow}{ enddo} 618 \textcolor{keywordflow}{ endif} 619 \textcolor{keywordflow}{elseif} (obc%segment(n)%direction == obc\_direction\_s) \textcolor{keywordflow}{then} 620 \textcolor{keywordflow}{if} ((j >= jsq-1) .and. (j <= jeq+1)) \textcolor{keywordflow}{then} 621 \textcolor{keywordflow}{do} i = max(is-2,obc%segment(n)%HI%isd), min(ie+2,obc%segment(n)%HI%ied) 622 h\_v(i,j) = h(i,j+1,k) 623 \textcolor{keywordflow}{ enddo} 624 \textcolor{keywordflow}{ endif} 625 \textcolor{keywordflow}{elseif} (obc%segment(n)%direction == obc\_direction\_e) \textcolor{keywordflow}{then} 626 \textcolor{keywordflow}{if} ((i >= isq-1) .and. (i <= ieq+1)) \textcolor{keywordflow}{then} 627 \textcolor{keywordflow}{do} j = max(js-2,obc%segment(n)%HI%jsd), min(je+2,obc%segment(n)%HI%jed) 628 h\_u(i,j) = h(i,j,k) 629 \textcolor{keywordflow}{ enddo} 630 \textcolor{keywordflow}{ endif} 631 \textcolor{keywordflow}{elseif} (obc%segment(n)%direction == obc\_direction\_w) \textcolor{keywordflow}{then} 632 \textcolor{keywordflow}{if} ((i >= isq-1) .and. (i <= ieq+1)) \textcolor{keywordflow}{then} 633 \textcolor{keywordflow}{do} j = max(js-2,obc%segment(n)%HI%jsd), min(je+2,obc%segment(n)%HI%jed) 634 h\_u(i,j) = h(i+1,j,k) 635 \textcolor{keywordflow}{ enddo} 636 \textcolor{keywordflow}{ endif} 637 \textcolor{keywordflow}{ endif} 638 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ endif} 639 \textcolor{comment}{! Now project thicknesses across corner points on OBCs.} 640 \textcolor{keywordflow}{if} (apply\_obc) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{do} n=1,obc%number\_of\_segments 641 j = obc%segment(n)%HI%JsdB ; i = obc%segment(n)%HI%IsdB 642 \textcolor{keywordflow}{if} (obc%segment(n)%direction == obc\_direction\_n) \textcolor{keywordflow}{then} 643 \textcolor{keywordflow}{if} ((j >= js-2) .and. (j <= je)) \textcolor{keywordflow}{then} 644 \textcolor{keywordflow}{do} i = max(isq-1,obc%segment(n)%HI%IsdB), min(ieq+1,obc%segment(n)%HI%IedB) 645 h\_u(i,j+1) = h\_u(i,j) 646 \textcolor{keywordflow}{ enddo} 647 \textcolor{keywordflow}{ endif} 648 \textcolor{keywordflow}{elseif} (obc%segment(n)%direction == obc\_direction\_s) \textcolor{keywordflow}{then} 649 \textcolor{keywordflow}{if} ((j >= js-1) .and. (j <= je+1)) \textcolor{keywordflow}{then} 650 \textcolor{keywordflow}{do} i = max(isq-1,obc%segment(n)%HI%isd), min(ieq+1,obc%segment(n)%HI%ied) 651 h\_u(i,j) = h\_u(i,j+1) 652 \textcolor{keywordflow}{ enddo} 653 \textcolor{keywordflow}{ endif} 654 \textcolor{keywordflow}{elseif} (obc%segment(n)%direction == obc\_direction\_e) \textcolor{keywordflow}{then} 655 \textcolor{keywordflow}{if} ((i >= is-2) .and. (i <= ie)) \textcolor{keywordflow}{then} 656 \textcolor{keywordflow}{do} j = max(jsq-1,obc%segment(n)%HI%jsd), min(jeq+1,obc%segment(n)%HI%jed) 657 h\_v(i+1,j) = h\_v(i,j) 658 \textcolor{keywordflow}{ enddo} 659 \textcolor{keywordflow}{ endif} 660 \textcolor{keywordflow}{elseif} (obc%segment(n)%direction == obc\_direction\_w) \textcolor{keywordflow}{then} 661 \textcolor{keywordflow}{if} ((i >= is-1) .and. (i <= ie+1)) \textcolor{keywordflow}{then} 662 \textcolor{keywordflow}{do} j = max(jsq-1,obc%segment(n)%HI%jsd), min(jeq+1,obc%segment(n)%HI%jed) 663 h\_v(i,j) = h\_v(i+1,j) 664 \textcolor{keywordflow}{ enddo} 665 \textcolor{keywordflow}{ endif} 666 \textcolor{keywordflow}{ endif} 667 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ endif} 668 669 \textcolor{comment}{! Shearing strain (including no-slip boundary conditions at the 2-D land-sea mask).} 670 \textcolor{comment}{! dudy and dvdx include modifications at OBCs from above.} 671 \textcolor{keywordflow}{if} (cs%no\_slip) \textcolor{keywordflow}{then} 672 \textcolor{keywordflow}{do} j=js-2,jeq+1 ; \textcolor{keywordflow}{do} i=is-2,ieq+1 673 sh\_xy(i,j) = (2.0-g%mask2dBu(i,j)) * ( dvdx(i,j) + dudy(i,j) ) 674 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 675 \textcolor{keywordflow}{else} 676 \textcolor{keywordflow}{do} j=js-2,jeq+1 ; \textcolor{keywordflow}{do} i=is-2,ieq+1 677 sh\_xy(i,j) = g%mask2dBu(i,j) * ( dvdx(i,j) + dudy(i,j) ) 678 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 679 \textcolor{keywordflow}{ endif} 680 681 \textcolor{comment}{! Evaluate Del2u = x.Div(Grad u) and Del2v = y.Div( Grad u)} 682 \textcolor{keywordflow}{if} (cs%biharmonic) \textcolor{keywordflow}{then} 683 \textcolor{keywordflow}{do} j=js-1,jeq+1 ; \textcolor{keywordflow}{do} i=isq-1,ieq+1 684 del2u(i,j) = cs%Idxdy2u(i,j)*(cs%dy2h(i+1,j)*sh\_xx(i+1,j) - cs%dy2h(i,j)*sh\_xx(i,j)) + & 685 cs%Idx2dyCu(i,j)*(cs%dx2q(i,j)*sh\_xy(i,j) - cs%dx2q(i,j-1)*sh\_xy(i,j-1)) 686 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 687 \textcolor{keywordflow}{do} j=jsq-1,jeq+1 ; \textcolor{keywordflow}{do} i=is-1,ieq+1 688 del2v(i,j) = cs%Idxdy2v(i,j)*(cs%dy2q(i,j)*sh\_xy(i,j) - cs%dy2q(i-1,j)*sh\_xy(i-1,j)) - & 689 cs%Idx2dyCv(i,j)*(cs%dx2h(i,j+1)*sh\_xx(i,j+1) - cs%dx2h(i,j)*sh\_xx(i,j)) 690 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 691 \textcolor{keywordflow}{if} (apply\_obc) then; \textcolor{keywordflow}{if} (obc%zero\_biharmonic) \textcolor{keywordflow}{then} 692 \textcolor{keywordflow}{do} n=1,obc%number\_of\_segments 693 i = obc%segment(n)%HI%IsdB ; j = obc%segment(n)%HI%JsdB 694 \textcolor{keywordflow}{if} (obc%segment(n)%is\_N\_or\_S .and. (j >= jsq-1) .and. (j <= jeq+1)) \textcolor{keywordflow}{then} 695 \textcolor{keywordflow}{do} i=obc%segment(n)%HI%isd,obc%segment(n)%HI%ied 696 del2v(i,j) = 0. 697 \textcolor{keywordflow}{ enddo} 698 \textcolor{keywordflow}{elseif} (obc%segment(n)%is\_E\_or\_W .and. (i >= isq-1) .and. (i <= ieq+1)) \textcolor{keywordflow}{then} 699 \textcolor{keywordflow}{do} j=obc%segment(n)%HI%jsd,obc%segment(n)%HI%jed 700 del2u(i,j) = 0. 701 \textcolor{keywordflow}{ enddo} 702 \textcolor{keywordflow}{ endif} 703 \textcolor{keywordflow}{ enddo} 704 \textcolor{keyword}{ end}if; endif 705 \textcolor{keywordflow}{ endif} 706 707 \textcolor{comment}{! Vorticity} 708 \textcolor{keywordflow}{if} (cs%no\_slip) \textcolor{keywordflow}{then} 709 \textcolor{keywordflow}{do} j=jsq-2,jeq+2 ; \textcolor{keywordflow}{do} i=isq-2,ieq+2 710 vort\_xy(i,j) = (2.0-g%mask2dBu(i,j)) * ( dvdx(i,j) - dudy(i,j) ) 711 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 712 \textcolor{keywordflow}{else} 713 \textcolor{keywordflow}{do} j=jsq-2,jeq+2 ; \textcolor{keywordflow}{do} i=isq-2,ieq+2 714 vort\_xy(i,j) = g%mask2dBu(i,j) * ( dvdx(i,j) - dudy(i,j) ) 715 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 716 \textcolor{keywordflow}{ endif} 717 718 \textcolor{comment}{! Divergence} 719 \textcolor{keywordflow}{do} j=jsq-1,jeq+2 ; \textcolor{keywordflow}{do} i=isq-1,ieq+2 720 div\_xx(i,j) = dudx(i,j) + dvdy(i,j) 721 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 722 723 \textcolor{keywordflow}{if} ((cs%Leith\_Kh) .or. (cs%Leith\_Ah)) \textcolor{keywordflow}{then} 724 725 \textcolor{comment}{! Vorticity gradient} 726 \textcolor{keywordflow}{do} j=jsq-1,jeq+1 ; \textcolor{keywordflow}{do} i=isq-1,ieq+2 727 dy\_dxbu = g%dyBu(i,j) * g%IdxBu(i,j) 728 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)) 729 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 730 731 \textcolor{keywordflow}{do} j=jsq-1,jeq+2 ; \textcolor{keywordflow}{do} i=isq-1,ieq+1 732 dx\_dybu = g%dxBu(i,j) * g%IdyBu(i,j) 733 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)) 734 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 735 736 \textcolor{comment}{! Laplacian of vorticity} 737 \textcolor{keywordflow}{do} j=jsq-1,jeq+1 ; \textcolor{keywordflow}{do} i=isq-1,ieq+1 738 dy\_dxbu = g%dyBu(i,j) * g%IdxBu(i,j) 739 dx\_dybu = g%dxBu(i,j) * g%IdyBu(i,j) 740 741 del2vort\_q(i,j) = dy\_dxbu * (vort\_xy\_dx(i+1,j) * g%IdyCv(i+1,j) - vort\_xy\_dx(i,j) * g%IdyCv(i,j)) + & 742 dx\_dybu * (vort\_xy\_dy(i,j+1) * g%IdyCu(i,j+1) - vort\_xy\_dy(i,j) * g%IdyCu(i,j)) 743 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 744 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 745 del2vort\_h(i,j) = 0.25*(del2vort\_q(i,j) + del2vort\_q(i-1,j) + del2vort\_q(i,j-1) + del2vort\_q(i-1,j- 1)) 746 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 747 748 \textcolor{keywordflow}{if} (cs%modified\_Leith) \textcolor{keywordflow}{then} 749 750 \textcolor{comment}{! Divergence gradient} 751 \textcolor{keywordflow}{do} j=jsq-1,jeq+2 ; \textcolor{keywordflow}{do} i=isq-1,ieq+1 752 div\_xx\_dx(i,j) = g%IdxCu(i,j)*(div\_xx(i+1,j) - div\_xx(i,j)) 753 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 754 \textcolor{keywordflow}{do} j=jsq-1,jeq+1 ; \textcolor{keywordflow}{do} i=isq-1,ieq+2 755 div\_xx\_dy(i,j) = g%IdyCv(i,j)*(div\_xx(i,j+1) - div\_xx(i,j)) 756 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 757 758 \textcolor{comment}{! Magnitude of divergence gradient} 759 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 760 grad\_div\_mag\_h(i,j) =sqrt((0.5*(div\_xx\_dx(i,j) + div\_xx\_dx(i-1,j)))**2 + & 761 (0.5 * (div\_xx\_dy(i,j) + div\_xx\_dy(i,j-1)))**2) 762 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 763 \textcolor{comment}{!do J=js-1,Jeq ; do I=is-1,Ieq} 764 \textcolor{keywordflow}{do} j=jsq-1,jeq+1 ; \textcolor{keywordflow}{do} i=isq-1,ieq+1 765 grad\_div\_mag\_q(i,j) =sqrt((0.5*(div\_xx\_dx(i,j) + div\_xx\_dx(i,j+1)))**2 + & 766 (0.5 * (div\_xx\_dy(i,j) + div\_xx\_dy(i+1,j)))**2) 767 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 768 769 \textcolor{keywordflow}{else} 770 771 \textcolor{keywordflow}{do} j=jsq-1,jeq+2 ; \textcolor{keywordflow}{do} i=is-2,ieq+1 772 div\_xx\_dx(i,j) = 0.0 773 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 774 \textcolor{keywordflow}{do} j=jsq-1,jeq+1 ; \textcolor{keywordflow}{do} i=isq-1,ieq+2 775 div\_xx\_dy(i,j) = 0.0 776 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 777 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 778 grad\_div\_mag\_h(i,j) = 0.0 779 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 780 \textcolor{keywordflow}{do} j=jsq-1,jeq+1 ; \textcolor{keywordflow}{do} i=isq-1,ieq+1 781 grad\_div\_mag\_q(i,j) = 0.0 782 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 783 784 \textcolor{keywordflow}{ endif} \textcolor{comment}{! CS%modified\_Leith} 785 786 \textcolor{comment}{! Add in beta for the Leith viscosity} 787 \textcolor{keywordflow}{if} (cs%use\_beta\_in\_Leith) \textcolor{keywordflow}{then} 788 \textcolor{keywordflow}{do} j=js-2,jeq+1 ; \textcolor{keywordflow}{do} i=is-1,ieq+1 789 vort\_xy\_dx(i,j) = vort\_xy\_dx(i,j) + 0.5 * ( g%dF\_dx(i,j) + g%dF\_dx(i,j+1)) 790 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 791 \textcolor{keywordflow}{do} j=js-1,jeq+1 ; \textcolor{keywordflow}{do} i=is-2,ieq+1 792 vort\_xy\_dy(i,j) = vort\_xy\_dy(i,j) + 0.5 * ( g%dF\_dy(i,j) + g%dF\_dy(i+1,j)) 793 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 794 \textcolor{keywordflow}{ endif} \textcolor{comment}{! CS%use\_beta\_in\_Leith} 795 796 \textcolor{keywordflow}{if} (cs%use\_QG\_Leith\_visc) \textcolor{keywordflow}{then} 797 798 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 799 grad\_vort\_mag\_h\_2d(i,j) = sqrt((0.5*(vort\_xy\_dx(i,j) + vort\_xy\_dx(i,j-1)))**2 + & 800 (0.5*(vort\_xy\_dy(i,j) + vort\_xy\_dy(i-1,j)))**2 ) 801 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 802 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 803 grad\_vort\_mag\_q\_2d(i,j) = sqrt((0.5*(vort\_xy\_dx(i,j) + vort\_xy\_dx(i+1,j)))**2 + & 804 (0.5*(vort\_xy\_dy(i,j) + vort\_xy\_dy(i,j+1)))**2 ) 805 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 806 807 \textcolor{comment}{! This accumulates terms, some of which are in VarMix, so rescaling can not be done here.} 808 \textcolor{keyword}{call }calc\_qg\_leith\_viscosity(varmix, g, gv, us, h, k, div\_xx\_dx, div\_xx\_dy, & 809 vort\_xy\_dx, vort\_xy\_dy) 810 811 \textcolor{keywordflow}{ endif} 812 813 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 814 grad\_vort\_mag\_h(i,j) = sqrt((0.5*(vort\_xy\_dx(i,j) + vort\_xy\_dx(i,j-1)))**2 + & 815 (0.5*(vort\_xy\_dy(i,j) + vort\_xy\_dy(i-1,j)))**2 ) 816 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 817 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 818 grad\_vort\_mag\_q(i,j) = sqrt((0.5*(vort\_xy\_dx(i,j) + vort\_xy\_dx(i+1,j)))**2 + & 819 (0.5*(vort\_xy\_dy(i,j) + vort\_xy\_dy(i,j+1)))**2 ) 820 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 821 822 \textcolor{keywordflow}{ endif} \textcolor{comment}{! CS%Leith\_Kh} 823 824 meke\_res\_fn = 1. 825 826 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 827 \textcolor{keywordflow}{if} ((cs%Smagorinsky\_Kh) .or. (cs%Smagorinsky\_Ah)) \textcolor{keywordflow}{then} 828 shear\_mag = sqrt(sh\_xx(i,j)*sh\_xx(i,j) + & 829 0.25*((sh\_xy(i-1,j-1)*sh\_xy(i-1,j-1) + sh\_xy(i,j)*sh\_xy(i,j)) + & 830 (sh\_xy(i-1,j)*sh\_xy(i-1,j) + sh\_xy(i,j-1)*sh\_xy(i,j-1)))) 831 \textcolor{keywordflow}{ endif} 832 \textcolor{keywordflow}{if} ((cs%Leith\_Kh) .or. (cs%Leith\_Ah)) \textcolor{keywordflow}{then} 833 \textcolor{keywordflow}{if} (cs%use\_QG\_Leith\_visc) \textcolor{keywordflow}{then} 834 vert\_vort\_mag = min(grad\_vort\_mag\_h(i,j) + grad\_div\_mag\_h(i,j),3.*grad\_vort\_mag\_h\_2d(i,j)) 835 \textcolor{keywordflow}{else} 836 vert\_vort\_mag = (grad\_vort\_mag\_h(i,j) + grad\_div\_mag\_h(i,j)) 837 \textcolor{keywordflow}{ endif} 838 \textcolor{keywordflow}{ endif} 839 \textcolor{keywordflow}{if} (cs%better\_bound\_Ah .or. cs%better\_bound\_Kh) \textcolor{keywordflow}{then} 840 hrat\_min = min(1.0, min(h\_u(i,j), h\_u(i-1,j), h\_v(i,j), h\_v(i,j-1)) / & 841 (h(i,j,k) + h\_neglect) ) 842 visc\_bound\_rem = 1.0 843 \textcolor{keywordflow}{ endif} 844 845 \textcolor{keywordflow}{if} (cs%Laplacian) \textcolor{keywordflow}{then} 846 \textcolor{comment}{! Determine the Laplacian viscosity at h points, using the} 847 \textcolor{comment}{! largest value from several parameterizations.} 848 kh = cs%Kh\_bg\_xx(i,j) \textcolor{comment}{! Static (pre-computed) background viscosity} 849 \textcolor{keywordflow}{if} (cs%add\_LES\_viscosity) \textcolor{keywordflow}{then} 850 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Kh) kh = kh + cs%Laplac2\_const\_xx(i,j) * shear\_mag 851 \textcolor{keywordflow}{if} (cs%Leith\_Kh) kh = kh + cs%Laplac3\_const\_xx(i,j) * vert\_vort\_mag*inv\_pi3 852 \textcolor{keywordflow}{else} 853 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Kh) kh = max( kh, cs%Laplac2\_const\_xx(i,j) * shear\_mag ) 854 \textcolor{keywordflow}{if} (cs%Leith\_Kh) kh = max( kh, cs%Laplac3\_const\_xx(i,j) * vert\_vort\_mag*inv\_pi3) 855 \textcolor{keywordflow}{ endif} 856 \textcolor{comment}{! All viscosity contributions above are subject to resolution scaling} 857 \textcolor{keywordflow}{if} (rescale\_kh) kh = varmix%Res\_fn\_h(i,j) * kh 858 \textcolor{keywordflow}{if} (cs%res\_scale\_MEKE) meke\_res\_fn = varmix%Res\_fn\_h(i,j) 859 \textcolor{comment}{! Older method of bounding for stability} 860 \textcolor{keywordflow}{if} (legacy\_bound) kh = min(kh, cs%Kh\_Max\_xx(i,j)) 861 kh = max( kh, cs%Kh\_bg\_min ) \textcolor{comment}{! Place a floor on the viscosity, if desired.} 862 \textcolor{keywordflow}{if} (use\_meke\_ku) & 863 kh = kh + meke%Ku(i,j) * meke\_res\_fn \textcolor{comment}{! *Add* the MEKE contribution (might be negative)} 864 \textcolor{keywordflow}{if} (cs%anisotropic) kh = kh + cs%Kh\_aniso * ( 1. - cs%n1n2\_h(i,j)**2 ) \textcolor{comment}{! *Add* the tension component} 865 \textcolor{comment}{! of anisotropic viscosity} 866 867 \textcolor{comment}{! Newer method of bounding for stability} 868 \textcolor{keywordflow}{if} (cs%better\_bound\_Kh) \textcolor{keywordflow}{then} 869 \textcolor{keywordflow}{if} (kh >= hrat\_min*cs%Kh\_Max\_xx(i,j)) \textcolor{keywordflow}{then} 870 visc\_bound\_rem = 0.0 871 kh = hrat\_min*cs%Kh\_Max\_xx(i,j) 872 \textcolor{keywordflow}{else} 873 visc\_bound\_rem = 1.0 - kh / (hrat\_min*cs%Kh\_Max\_xx(i,j)) 874 \textcolor{keywordflow}{ endif} 875 \textcolor{keywordflow}{ endif} 876 877 \textcolor{keywordflow}{if} ((cs%id\_Kh\_h>0) .or. find\_frictwork .or. cs%debug) kh\_h(i,j,k) = kh 878 879 \textcolor{keywordflow}{if} (cs%id\_grid\_Re\_Kh>0) \textcolor{keywordflow}{then} 880 ke = 0.125*((u(i,j,k)+u(i-1,j,k))**2 + (v(i,j,k)+v(i,j-1,k))**2) 881 grid\_re\_kh(i,j,k) = (sqrt(ke) * sqrt(cs%grid\_sp\_h2(i,j))) & 882 / max(kh, cs%min\_grid\_Kh) 883 \textcolor{keywordflow}{ endif} 884 885 \textcolor{keywordflow}{if} (cs%id\_div\_xx\_h>0) div\_xx\_h(i,j,k) = div\_xx(i,j) 886 \textcolor{keywordflow}{if} (cs%id\_sh\_xx\_h>0) sh\_xx\_h(i,j,k) = sh\_xx(i,j) 887 888 str\_xx(i,j) = -kh * sh\_xx(i,j) 889 \textcolor{keywordflow}{else} \textcolor{comment}{! not Laplacian} 890 str\_xx(i,j) = 0.0 891 \textcolor{keywordflow}{ endif} \textcolor{comment}{! Laplacian} 892 893 \textcolor{keywordflow}{if} (cs%anisotropic) \textcolor{keywordflow}{then} 894 \textcolor{comment}{! Shearing-strain averaged to h-points} 895 local\_strain = 0.25 * ( (sh\_xy(i,j) + sh\_xy(i-1,j-1)) + (sh\_xy(i-1,j) + sh\_xy(i,j-1)) ) 896 \textcolor{comment}{! *Add* the shear-strain contribution to the xx-component of stress} 897 str\_xx(i,j) = str\_xx(i,j) - cs%Kh\_aniso * cs%n1n2\_h(i,j) * cs%n1n1\_m\_n2n2\_h(i,j) * local\_strain 898 \textcolor{keywordflow}{ endif} 899 900 \textcolor{keywordflow}{if} (cs%biharmonic) \textcolor{keywordflow}{then} 901 \textcolor{comment}{! Determine the biharmonic viscosity at h points, using the} 902 \textcolor{comment}{! largest value from several parameterizations.} 903 ahsm = 0.0; ahlth = 0.0 904 \textcolor{keywordflow}{if} ((cs%Smagorinsky\_Ah) .or. (cs%Leith\_Ah)) \textcolor{keywordflow}{then} 905 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Ah) \textcolor{keywordflow}{then} 906 \textcolor{keywordflow}{if} (cs%bound\_Coriolis) \textcolor{keywordflow}{then} 907 ahsm = shear\_mag * (cs%Biharm\_const\_xx(i,j) + & 908 cs%Biharm\_const2\_xx(i,j)*shear\_mag) 909 \textcolor{keywordflow}{else} 910 ahsm = cs%Biharm\_const\_xx(i,j) * shear\_mag 911 \textcolor{keywordflow}{ endif} 912 \textcolor{keywordflow}{ endif} 913 \textcolor{keywordflow}{if} (cs%Leith\_Ah) ahlth = cs%Biharm6\_const\_xx(i,j) * abs(del2vort\_h(i,j)) * inv\_pi6 914 ah = max(max(cs%Ah\_bg\_xx(i,j), ahsm), ahlth) 915 \textcolor{keywordflow}{if} (cs%bound\_Ah .and. .not.cs%better\_bound\_Ah) & 916 ah = min(ah, cs%Ah\_Max\_xx(i,j)) 917 \textcolor{keywordflow}{else} 918 ah = cs%Ah\_bg\_xx(i,j) 919 \textcolor{keywordflow}{ endif} \textcolor{comment}{! Smagorinsky\_Ah or Leith\_Ah} 920 921 \textcolor{keywordflow}{if} (use\_meke\_au) ah = ah + meke%Au(i,j) \textcolor{comment}{! *Add* the MEKE contribution} 922 923 \textcolor{keywordflow}{if} (cs%Re\_Ah > 0.0) \textcolor{keywordflow}{then} 924 ke = 0.125*((u(i,j,k)+u(i-1,j,k))**2 + (v(i,j,k)+v(i,j-1,k))**2) 925 ah = sqrt(ke) * cs%Re\_Ah\_const\_xx(i,j) 926 \textcolor{keywordflow}{ endif} 927 928 \textcolor{keywordflow}{if} (cs%better\_bound\_Ah) \textcolor{keywordflow}{then} 929 ah = min(ah, visc\_bound\_rem*hrat\_min*cs%Ah\_Max\_xx(i,j)) 930 \textcolor{keywordflow}{ endif} 931 932 \textcolor{keywordflow}{if} ((cs%id\_Ah\_h>0) .or. find\_frictwork .or. cs%debug) ah\_h(i,j,k) = ah 933 934 \textcolor{keywordflow}{if} (cs%id\_grid\_Re\_Ah>0) \textcolor{keywordflow}{then} 935 ke = 0.125*((u(i,j,k)+u(i-1,j,k))**2 + (v(i,j,k)+v(i,j-1,k))**2) 936 grid\_re\_ah(i,j,k) = (sqrt(ke) * cs%grid\_sp\_h3(i,j)) & 937 / max(ah, cs%min\_grid\_Ah) 938 \textcolor{keywordflow}{ endif} 939 940 str\_xx(i,j) = str\_xx(i,j) + ah * & 941 (cs%DY\_dxT(i,j) * (g%IdyCu(i,j)*del2u(i,j) - g%IdyCu(i-1,j)*del2u(i-1,j)) - & 942 cs%DX\_dyT(i,j) * (g%IdxCv(i,j)*del2v(i,j) - g%IdxCv(i,j-1)*del2v(i,j-1))) 943 944 \textcolor{comment}{! Keep a copy of the biharmonic contribution for backscatter parameterization} 945 bhstr\_xx(i,j) = ah * & 946 (cs%DY\_dxT(i,j) * (g%IdyCu(i,j)*del2u(i,j) - g%IdyCu(i-1,j)*del2u(i-1,j)) - & 947 cs%DX\_dyT(i,j) * (g%IdxCv(i,j)*del2v(i,j) - g%IdxCv(i,j-1)*del2v(i,j-1))) 948 bhstr\_xx(i,j) = bhstr\_xx(i,j) * (h(i,j,k) * cs%reduction\_xx(i,j)) 949 950 \textcolor{keywordflow}{ endif} \textcolor{comment}{! biharmonic} 951 952 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 953 954 \textcolor{keywordflow}{if} (cs%biharmonic) \textcolor{keywordflow}{then} 955 \textcolor{comment}{! Gradient of Laplacian, for use in bi-harmonic term} 956 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 957 ddel2vdx(i,j) = cs%DY\_dxBu(i,j)*(del2v(i+1,j)*g%IdyCv(i+1,j) - del2v(i,j)*g%IdyCv(i,j)) 958 ddel2udy(i,j) = cs%DX\_dyBu(i,j)*(del2u(i,j+1)*g%IdxCu(i,j+1) - del2u(i,j)*g%IdxCu(i,j)) 959 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 960 \textcolor{comment}{! Adjust contributions to shearing strain on open boundaries.} 961 \textcolor{keywordflow}{if} (apply\_obc) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (obc%zero\_strain .or. obc%freeslip\_strain) \textcolor{keywordflow}{then} 962 \textcolor{keywordflow}{do} n=1,obc%number\_of\_segments 963 j = obc%segment(n)%HI%JsdB ; i = obc%segment(n)%HI%IsdB 964 \textcolor{keywordflow}{if} (obc%segment(n)%is\_N\_or\_S .and. (j >= js-1) .and. (j <= jeq)) \textcolor{keywordflow}{then} 965 \textcolor{keywordflow}{do} i=obc%segment(n)%HI%IsdB,obc%segment(n)%HI%IedB 966 \textcolor{keywordflow}{if} (obc%zero\_strain) \textcolor{keywordflow}{then} 967 ddel2vdx(i,j) = 0. ; ddel2udy(i,j) = 0. 968 \textcolor{keywordflow}{elseif} (obc%freeslip\_strain) \textcolor{keywordflow}{then} 969 ddel2udy(i,j) = 0. 970 \textcolor{keywordflow}{ endif} 971 \textcolor{keywordflow}{ enddo} 972 \textcolor{keywordflow}{elseif} (obc%segment(n)%is\_E\_or\_W .and. (i >= is-1) .and. (i <= ieq)) \textcolor{keywordflow}{then} 973 \textcolor{keywordflow}{do} j=obc%segment(n)%HI%JsdB,obc%segment(n)%HI%JedB 974 \textcolor{keywordflow}{if} (obc%zero\_strain) \textcolor{keywordflow}{then} 975 ddel2vdx(i,j) = 0. ; ddel2udy(i,j) = 0. 976 \textcolor{keywordflow}{elseif} (obc%freeslip\_strain) \textcolor{keywordflow}{then} 977 ddel2vdx(i,j) = 0. 978 \textcolor{keywordflow}{ endif} 979 \textcolor{keywordflow}{ enddo} 980 \textcolor{keywordflow}{ endif} 981 \textcolor{keywordflow}{ enddo} 982 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ endif} 983 \textcolor{keywordflow}{ endif} 984 985 meke\_res\_fn = 1. 986 987 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 988 \textcolor{keywordflow}{if} ((cs%Smagorinsky\_Kh) .or. (cs%Smagorinsky\_Ah)) \textcolor{keywordflow}{then} 989 shear\_mag = sqrt(sh\_xy(i,j)*sh\_xy(i,j) + & 990 0.25*((sh\_xx(i,j)*sh\_xx(i,j) + sh\_xx(i+1,j+1)*sh\_xx(i+1,j+1)) + & 991 (sh\_xx(i,j+1)*sh\_xx(i,j+1) + sh\_xx(i+1,j)*sh\_xx(i+1,j)))) 992 \textcolor{keywordflow}{ endif} 993 \textcolor{keywordflow}{if} ((cs%Leith\_Kh) .or. (cs%Leith\_Ah)) \textcolor{keywordflow}{then} 994 \textcolor{keywordflow}{if} (cs%use\_QG\_Leith\_visc) \textcolor{keywordflow}{then} 995 vert\_vort\_mag = min(grad\_vort\_mag\_q(i,j) + grad\_div\_mag\_q(i,j), 3.*grad\_vort\_mag\_q\_2d(i,j)) 996 \textcolor{keywordflow}{else} 997 vert\_vort\_mag = (grad\_vort\_mag\_q(i,j) + grad\_div\_mag\_q(i,j)) 998 \textcolor{keywordflow}{ endif} 999 \textcolor{keywordflow}{ endif} 1000 h2uq = 4.0 * h\_u(i,j) * h\_u(i,j+1) 1001 h2vq = 4.0 * h\_v(i,j) * h\_v(i+1,j) 1002 hq(i,j) = 2.0 * h2uq * h2vq / (h\_neglect3 + (h2uq + h2vq) * & 1003 ((h\_u(i,j) + h\_u(i,j+1)) + (h\_v(i,j) + h\_v(i+1,j)))) 1004 1005 \textcolor{keywordflow}{if} (cs%better\_bound\_Ah .or. cs%better\_bound\_Kh) \textcolor{keywordflow}{then} 1006 hrat\_min = min(1.0, min(h\_u(i,j), h\_u(i,j+1), h\_v(i,j), h\_v(i+1,j)) / & 1007 (hq(i,j) + h\_neglect) ) 1008 visc\_bound\_rem = 1.0 1009 \textcolor{keywordflow}{ endif} 1010 1011 \textcolor{keywordflow}{if} (cs%no\_slip .and. (g%mask2dBu(i,j) < 0.5)) \textcolor{keywordflow}{then} 1012 \textcolor{keywordflow}{if} ((g%mask2dCu(i,j) + g%mask2dCu(i,j+1)) + & 1013 (g%mask2dCv(i,j) + g%mask2dCv(i+1,j)) > 0.0) \textcolor{keywordflow}{then} 1014 \textcolor{comment}{! This is a coastal vorticity point, so modify hq and hrat\_min.} 1015 1016 hu = g%mask2dCu(i,j) * h\_u(i,j) + g%mask2dCu(i,j+1) * h\_u(i,j+1) 1017 hv = g%mask2dCv(i,j) * h\_v(i,j) + g%mask2dCv(i+1,j) * h\_v(i+1,j) 1018 \textcolor{keywordflow}{if} ((g%mask2dCu(i,j) + g%mask2dCu(i,j+1)) * & 1019 (g%mask2dCv(i,j) + g%mask2dCv(i+1,j)) == 0.0) \textcolor{keywordflow}{then} 1020 \textcolor{comment}{! Only one of hu and hv is nonzero, so just add them.} 1021 hq(i,j) = hu + hv 1022 hrat\_min = 1.0 1023 \textcolor{keywordflow}{else} 1024 \textcolor{comment}{! Both hu and hv are nonzero, so take the harmonic mean.} 1025 hq(i,j) = 2.0 * (hu * hv) / ((hu + hv) + h\_neglect) 1026 hrat\_min = min(1.0, min(hu, hv) / (hq(i,j) + h\_neglect) ) 1027 \textcolor{keywordflow}{ endif} 1028 \textcolor{keywordflow}{ endif} 1029 \textcolor{keywordflow}{ endif} 1030 1031 \textcolor{keywordflow}{if} (cs%Laplacian) \textcolor{keywordflow}{then} 1032 \textcolor{comment}{! Determine the Laplacian viscosity at q points, using the} 1033 \textcolor{comment}{! largest value from several parameterizations.} 1034 kh = cs%Kh\_bg\_xy(i,j) \textcolor{comment}{! Static (pre-computed) background viscosity} 1035 \textcolor{keywordflow}{if} (cs%add\_LES\_viscosity) \textcolor{keywordflow}{then} 1036 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Kh) kh = kh + cs%Laplac2\_const\_xx(i,j) * shear\_mag 1037 \textcolor{keywordflow}{if} (cs%Leith\_Kh) kh = kh + cs%Laplac3\_const\_xx(i,j) * vert\_vort\_mag*inv\_pi3 1038 \textcolor{keywordflow}{else} 1039 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Kh) kh = max( kh, cs%Laplac2\_const\_xy(i,j) * shear\_mag ) 1040 \textcolor{keywordflow}{if} (cs%Leith\_Kh) kh = max( kh, cs%Laplac3\_const\_xy(i,j) * vert\_vort\_mag*inv\_pi3) 1041 \textcolor{keywordflow}{ endif} 1042 \textcolor{comment}{! All viscosity contributions above are subject to resolution scaling} 1043 \textcolor{keywordflow}{if} (rescale\_kh) kh = varmix%Res\_fn\_q(i,j) * kh 1044 \textcolor{keywordflow}{if} (cs%res\_scale\_MEKE) meke\_res\_fn = varmix%Res\_fn\_q(i,j) 1045 \textcolor{comment}{! Older method of bounding for stability} 1046 \textcolor{keywordflow}{if} (legacy\_bound) kh = min(kh, cs%Kh\_Max\_xy(i,j)) 1047 kh = max( kh, cs%Kh\_bg\_min ) \textcolor{comment}{! Place a floor on the viscosity, if desired.} 1048 \textcolor{keywordflow}{if} (use\_meke\_ku) \textcolor{keywordflow}{then} \textcolor{comment}{! *Add* the MEKE contribution (might be negative)} 1049 kh = kh + 0.25*( (meke%Ku(i,j) + meke%Ku(i+1,j+1)) + & 1050 (meke%Ku(i+1,j) + meke%Ku(i,j+1)) ) * meke\_res\_fn 1051 \textcolor{keywordflow}{ endif} 1052 \textcolor{comment}{! Older method of bounding for stability} 1053 \textcolor{keywordflow}{if} (cs%anisotropic) kh = kh + cs%Kh\_aniso * cs%n1n2\_q(i,j)**2 \textcolor{comment}{! *Add* the shear component} 1054 \textcolor{comment}{! of anisotropic viscosity} 1055 1056 \textcolor{comment}{! Newer method of bounding for stability} 1057 \textcolor{keywordflow}{if} (cs%better\_bound\_Kh) \textcolor{keywordflow}{then} 1058 \textcolor{keywordflow}{if} (kh >= hrat\_min*cs%Kh\_Max\_xy(i,j)) \textcolor{keywordflow}{then} 1059 visc\_bound\_rem = 0.0 1060 kh = hrat\_min*cs%Kh\_Max\_xy(i,j) 1061 \textcolor{keywordflow}{elseif} (cs%Kh\_Max\_xy(i,j)>0.) \textcolor{keywordflow}{then} 1062 visc\_bound\_rem = 1.0 - kh / (hrat\_min*cs%Kh\_Max\_xy(i,j)) 1063 \textcolor{keywordflow}{ endif} 1064 \textcolor{keywordflow}{ endif} 1065 1066 \textcolor{keywordflow}{if} (cs%id\_Kh\_q>0 .or. cs%debug) kh\_q(i,j,k) = kh 1067 \textcolor{keywordflow}{if} (cs%id\_vort\_xy\_q>0) vort\_xy\_q(i,j,k) = vort\_xy(i,j) 1068 \textcolor{keywordflow}{if} (cs%id\_sh\_xy\_q>0) sh\_xy\_q(i,j,k) = sh\_xy(i,j) 1069 1070 str\_xy(i,j) = -kh * sh\_xy(i,j) 1071 \textcolor{keywordflow}{else} \textcolor{comment}{! not Laplacian} 1072 str\_xy(i,j) = 0.0 1073 \textcolor{keywordflow}{ endif} \textcolor{comment}{! Laplacian} 1074 1075 \textcolor{keywordflow}{if} (cs%anisotropic) \textcolor{keywordflow}{then} 1076 \textcolor{comment}{! Horizontal-tension averaged to q-points} 1077 local\_strain = 0.25 * ( (sh\_xx(i,j) + sh\_xx(i+1,j+1)) + (sh\_xx(i+1,j) + sh\_xx(i,j+1)) ) 1078 \textcolor{comment}{! *Add* the tension contribution to the xy-component of stress} 1079 str\_xy(i,j) = str\_xy(i,j) - cs%Kh\_aniso * cs%n1n2\_q(i,j) * cs%n1n1\_m\_n2n2\_q(i,j) * local\_strain 1080 \textcolor{keywordflow}{ endif} 1081 1082 \textcolor{keywordflow}{if} (cs%biharmonic) \textcolor{keywordflow}{then} 1083 \textcolor{comment}{! Determine the biharmonic viscosity at q points, using the} 1084 \textcolor{comment}{! largest value from several parameterizations.} 1085 ahsm = 0.0 ; ahlth = 0.0 1086 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Ah .or. cs%Leith\_Ah) \textcolor{keywordflow}{then} 1087 \textcolor{keywordflow}{if} (cs%Smagorinsky\_Ah) \textcolor{keywordflow}{then} 1088 \textcolor{keywordflow}{if} (cs%bound\_Coriolis) \textcolor{keywordflow}{then} 1089 ahsm = shear\_mag * (cs%Biharm\_const\_xy(i,j) + & 1090 cs%Biharm\_const2\_xy(i,j)*shear\_mag) 1091 \textcolor{keywordflow}{else} 1092 ahsm = cs%Biharm\_const\_xy(i,j) * shear\_mag 1093 \textcolor{keywordflow}{ endif} 1094 \textcolor{keywordflow}{ endif} 1095 \textcolor{keywordflow}{if} (cs%Leith\_Ah) ahlth = cs%Biharm6\_const\_xy(i,j) * abs(del2vort\_q(i,j)) * inv\_pi6 1096 ah = max(max(cs%Ah\_bg\_xy(i,j), ahsm), ahlth) 1097 \textcolor{keywordflow}{if} (cs%bound\_Ah .and. .not.cs%better\_bound\_Ah) & 1098 ah = min(ah, cs%Ah\_Max\_xy(i,j)) 1099 \textcolor{keywordflow}{else} 1100 ah = cs%Ah\_bg\_xy(i,j) 1101 \textcolor{keywordflow}{ endif} \textcolor{comment}{! Smagorinsky\_Ah or Leith\_Ah} 1102 1103 \textcolor{keywordflow}{if} (use\_meke\_au) \textcolor{keywordflow}{then} \textcolor{comment}{! *Add* the MEKE contribution} 1104 ah = ah + 0.25*( (meke%Au(i,j) + meke%Au(i+1,j+1)) + & 1105 (meke%Au(i+1,j) + meke%Au(i,j+1)) ) 1106 \textcolor{keywordflow}{ endif} 1107 1108 \textcolor{keywordflow}{if} (cs%Re\_Ah > 0.0) \textcolor{keywordflow}{then} 1109 ke = 0.125*((u(i,j,k)+u(i,j+1,k))**2 + (v(i,j,k)+v(i+1,j,k))**2) 1110 ah = sqrt(ke) * cs%Re\_Ah\_const\_xy(i,j) 1111 \textcolor{keywordflow}{ endif} 1112 1113 \textcolor{keywordflow}{if} (cs%better\_bound\_Ah) \textcolor{keywordflow}{then} 1114 ah = min(ah, visc\_bound\_rem*hrat\_min*cs%Ah\_Max\_xy(i,j)) 1115 \textcolor{keywordflow}{ endif} 1116 1117 \textcolor{keywordflow}{if} (cs%id\_Ah\_q>0 .or. cs%debug) ah\_q(i,j,k) = ah 1118 1119 str\_xy(i,j) = str\_xy(i,j) + ah * ( ddel2vdx(i,j) + ddel2udy(i,j) ) 1120 1121 \textcolor{comment}{! Keep a copy of the biharmonic contribution for backscatter parameterization} 1122 bhstr\_xy(i,j) = ah * ( ddel2vdx(i,j) + ddel2udy(i,j) ) * & 1123 (hq(i,j) * g%mask2dBu(i,j) * cs%reduction\_xy(i,j)) 1124 1125 \textcolor{keywordflow}{ endif} \textcolor{comment}{! biharmonic} 1126 1127 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1128 1129 \textcolor{keywordflow}{if} (cs%use\_GME) \textcolor{keywordflow}{then} 1130 \textcolor{keyword}{call }thickness\_diffuse\_get\_kh(td, kh\_u\_gme, kh\_v\_gme, g) 1131 \textcolor{keyword}{call }pass\_vector(kh\_u\_gme, kh\_v\_gme, g%Domain) 1132 1133 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 1134 \textcolor{keywordflow}{if} (grad\_vel\_mag\_bt\_h(i,j)>0) \textcolor{keywordflow}{then} 1135 gme\_coeff = cs%GME\_efficiency * (min(g%bathyT(i,j)/cs%GME\_h0,1.0)**2) * & 1136 (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))) 1137 \textcolor{keywordflow}{else} 1138 gme\_coeff = 0.0 1139 \textcolor{keywordflow}{ endif} 1140 1141 \textcolor{comment}{! apply mask} 1142 gme\_coeff = gme\_coeff * boundary\_mask\_h(i,j) 1143 gme\_coeff = min(gme\_coeff, cs%GME\_limiter) 1144 1145 \textcolor{keywordflow}{if} ((cs%id\_GME\_coeff\_h>0) .or. find\_frictwork) gme\_coeff\_h(i,j,k) = gme\_coeff 1146 str\_xx\_gme(i,j) = gme\_coeff * sh\_xx\_bt(i,j) 1147 1148 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1149 1150 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 1151 \textcolor{keywordflow}{if} (grad\_vel\_mag\_bt\_q(i,j)>0) \textcolor{keywordflow}{then} 1152 gme\_coeff = cs%GME\_efficiency * (min(g%bathyT(i,j)/cs%GME\_h0,1.0)**2) * & 1153 (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))) 1154 \textcolor{keywordflow}{else} 1155 gme\_coeff = 0.0 1156 \textcolor{keywordflow}{ endif} 1157 1158 \textcolor{comment}{! apply mask} 1159 gme\_coeff = gme\_coeff * boundary\_mask\_q(i,j) 1160 gme\_coeff = min(gme\_coeff, cs%GME\_limiter) 1161 1162 \textcolor{keywordflow}{if} (cs%id\_GME\_coeff\_q>0) gme\_coeff\_q(i,j,k) = gme\_coeff 1163 str\_xy\_gme(i,j) = gme\_coeff * sh\_xy\_bt(i,j) 1164 1165 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1166 1167 \textcolor{comment}{! Applying GME diagonal term. This is linear and the arguments can be rescaled.} 1168 \textcolor{keyword}{call }smooth\_gme(cs,g,gme\_flux\_h=str\_xx\_gme) 1169 \textcolor{keyword}{call }smooth\_gme(cs,g,gme\_flux\_q=str\_xy\_gme) 1170 1171 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 1172 str\_xx(i,j) = (str\_xx(i,j) + str\_xx\_gme(i,j)) * (h(i,j,k) * cs%reduction\_xx(i,j)) 1173 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1174 1175 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 1176 \textcolor{comment}{! GME is applied below} 1177 \textcolor{keywordflow}{if} (cs%no\_slip) \textcolor{keywordflow}{then} 1178 str\_xy(i,j) = (str\_xy(i,j) + str\_xy\_gme(i,j)) * (hq(i,j) * cs%reduction\_xy(i,j)) 1179 \textcolor{keywordflow}{else} 1180 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) ) 1181 \textcolor{keywordflow}{ endif} 1182 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1183 1184 \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(meke%GME\_snk)) \textcolor{keywordflow}{then} 1185 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 1186 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) 1187 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1188 \textcolor{keywordflow}{ endif} 1189 1190 \textcolor{keywordflow}{else} \textcolor{comment}{! use\_GME} 1191 \textcolor{keywordflow}{do} j=jsq,jeq+1 ; \textcolor{keywordflow}{do} i=isq,ieq+1 1192 str\_xx(i,j) = str\_xx(i,j) * (h(i,j,k) * cs%reduction\_xx(i,j)) 1193 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1194 1195 \textcolor{keywordflow}{do} j=js-1,jeq ; \textcolor{keywordflow}{do} i=is-1,ieq 1196 \textcolor{keywordflow}{if} (cs%no\_slip) \textcolor{keywordflow}{then} 1197 str\_xy(i,j) = str\_xy(i,j) * (hq(i,j) * cs%reduction\_xy(i,j)) 1198 \textcolor{keywordflow}{else} 1199 str\_xy(i,j) = str\_xy(i,j) * (hq(i,j) * g%mask2dBu(i,j) * cs%reduction\_xy(i,j)) 1200 \textcolor{keywordflow}{ endif} 1201 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1202 1203 \textcolor{keywordflow}{ endif} \textcolor{comment}{! use\_GME} 1204 1205 \textcolor{comment}{! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent.} 1206 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=isq,ieq 1207 diffu(i,j,k) = ((g%IdyCu(i,j)*(cs%dy2h(i,j) *str\_xx(i,j) - & 1208 cs%dy2h(i+1,j)*str\_xx(i+1,j)) + & 1209 g%IdxCu(i,j)*(cs%dx2q(i,j-1)*str\_xy(i,j-1) - & 1210 cs%dx2q(i,j) *str\_xy(i,j))) * & 1211 g%IareaCu(i,j)) / (h\_u(i,j) + h\_neglect) 1212 1213 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1214 \textcolor{keywordflow}{if} (apply\_obc) \textcolor{keywordflow}{then} 1215 \textcolor{comment}{! This is not the right boundary condition. If all the masking of tendencies are done} 1216 \textcolor{comment}{! correctly later then eliminating this block should not change answers.} 1217 \textcolor{keywordflow}{do} n=1,obc%number\_of\_segments 1218 \textcolor{keywordflow}{if} (obc%segment(n)%is\_E\_or\_W) \textcolor{keywordflow}{then} 1219 i = obc%segment(n)%HI%IsdB 1220 \textcolor{keywordflow}{do} j=obc%segment(n)%HI%jsd,obc%segment(n)%HI%jed 1221 diffu(i,j,k) = 0. 1222 \textcolor{keywordflow}{ enddo} 1223 \textcolor{keywordflow}{ endif} 1224 \textcolor{keywordflow}{ enddo} 1225 \textcolor{keywordflow}{ endif} 1226 1227 \textcolor{comment}{! Evaluate 1/h y.Div(h Grad u) or the biharmonic equivalent.} 1228 \textcolor{keywordflow}{do} j=jsq,jeq ; \textcolor{keywordflow}{do} i=is,ie 1229 diffv(i,j,k) = ((g%IdyCv(i,j)*(cs%dy2q(i-1,j)*str\_xy(i-1,j) - & 1230 cs%dy2q(i,j) *str\_xy(i,j)) - & 1231 g%IdxCv(i,j)*(cs%dx2h(i,j) *str\_xx(i,j) - & 1232 cs%dx2h(i,j+1)*str\_xx(i,j+1))) * & 1233 g%IareaCv(i,j)) / (h\_v(i,j) + h\_neglect) 1234 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1235 \textcolor{keywordflow}{if} (apply\_obc) \textcolor{keywordflow}{then} 1236 \textcolor{comment}{! This is not the right boundary condition. If all the masking of tendencies are done} 1237 \textcolor{comment}{! correctly later then eliminating this block should not change answers.} 1238 \textcolor{keywordflow}{do} n=1,obc%number\_of\_segments 1239 \textcolor{keywordflow}{if} (obc%segment(n)%is\_N\_or\_S) \textcolor{keywordflow}{then} 1240 j = obc%segment(n)%HI%JsdB 1241 \textcolor{keywordflow}{do} i=obc%segment(n)%HI%isd,obc%segment(n)%HI%ied 1242 diffv(i,j,k) = 0. 1243 \textcolor{keywordflow}{ enddo} 1244 \textcolor{keywordflow}{ endif} 1245 \textcolor{keywordflow}{ enddo} 1246 \textcolor{keywordflow}{ endif} 1247 1248 \textcolor{keywordflow}{if} (find\_frictwork) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 1249 \textcolor{comment}{! Diagnose str\_xx*d\_x u - str\_yy*d\_y v + str\_xy*(d\_y u + d\_x v)} 1250 \textcolor{comment}{! This is the old formulation that includes energy diffusion} 1251 frictwork(i,j,k) = gv%H\_to\_RZ * ( & 1252 (str\_xx(i,j)*(u(i,j,k)-u(i-1,j,k))*g%IdxT(i,j) & 1253 -str\_xx(i,j)*(v(i,j,k)-v(i,j-1,k))*g%IdyT(i,j)) & 1254 +0.25*((str\_xy(i,j)*( & 1255 (u(i,j+1,k)-u(i,j,k))*g%IdyBu(i,j) & 1256 +(v(i+1,j,k)-v(i,j,k))*g%IdxBu(i,j) ) & 1257 +str\_xy(i-1,j-1)*( & 1258 (u(i-1,j,k)-u(i-1,j-1,k))*g%IdyBu(i-1,j-1) & 1259 +(v(i,j-1,k)-v(i-1,j-1,k))*g%IdxBu(i-1,j-1) )) & 1260 +(str\_xy(i-1,j)*( & 1261 (u(i-1,j+1,k)-u(i-1,j,k))*g%IdyBu(i-1,j) & 1262 +(v(i,j,k)-v(i-1,j,k))*g%IdxBu(i-1,j) ) & 1263 +str\_xy(i,j-1)*( & 1264 (u(i,j,k)-u(i,j-1,k))*g%IdyBu(i,j-1) & 1265 +(v(i+1,j-1,k)-v(i,j-1,k))*g%IdxBu(i,j-1) )) ) ) 1266 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ endif} 1267 1268 \textcolor{comment}{! Make a similar calculation as for FrictWork above but accumulating into} 1269 \textcolor{comment}{! the vertically integrated MEKE source term, and adjusting for any} 1270 \textcolor{comment}{! energy loss seen as a reduction in the (biharmonic) frictional source term.} 1271 \textcolor{keywordflow}{if} (find\_frictwork .and. \textcolor{keyword}{associated}(meke)) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(meke%mom\_src)) \textcolor{keywordflow}{then} 1272 \textcolor{keywordflow}{if} (k==1) \textcolor{keywordflow}{then} 1273 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 1274 meke%mom\_src(i,j) = 0. 1275 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1276 \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(meke%GME\_snk)) \textcolor{keywordflow}{then} 1277 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 1278 meke%GME\_snk(i,j) = 0. 1279 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1280 \textcolor{keywordflow}{ endif} 1281 \textcolor{keywordflow}{ endif} 1282 \textcolor{keywordflow}{if} (meke%backscatter\_Ro\_c /= 0.) \textcolor{keywordflow}{then} 1283 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 1284 fath = 0.25*( (abs(g%CoriolisBu(i-1,j-1)) + abs(g%CoriolisBu(i,j))) + & 1285 (abs(g%CoriolisBu(i-1,j)) + abs(g%CoriolisBu(i,j-1))) ) 1286 shear\_mag = sqrt(sh\_xx(i,j)*sh\_xx(i,j) + & 1287 0.25*((sh\_xy(i-1,j-1)*sh\_xy(i-1,j-1) + sh\_xy(i,j)*sh\_xy(i,j)) + & 1288 (sh\_xy(i-1,j)*sh\_xy(i-1,j) + sh\_xy(i,j-1)*sh\_xy(i,j-1)))) 1289 \textcolor{keywordflow}{if} (cs%answers\_2018) \textcolor{keywordflow}{then} 1290 fath = (us%s\_to\_T*fath)**meke%backscatter\_Ro\_pow \textcolor{comment}{! f^n} 1291 \textcolor{comment}{! Note the hard-coded dimensional constant in the following line that can not} 1292 \textcolor{comment}{! be rescaled for dimensional consistency.} 1293 shear\_mag = ( ( (us%s\_to\_T*shear\_mag)**meke%backscatter\_Ro\_pow ) + 1.e-30 ) & 1294 * meke%backscatter\_Ro\_c \textcolor{comment}{! c * D^n} 1295 \textcolor{comment}{! The Rossby number function is g(Ro) = 1/(1+c.Ro^n)} 1296 \textcolor{comment}{! RoScl = 1 - g(Ro)} 1297 roscl = shear\_mag / ( fath + shear\_mag ) \textcolor{comment}{! = 1 - f^n/(f^n+c*D^n)} 1298 \textcolor{keywordflow}{else} 1299 \textcolor{keywordflow}{if} (fath <= backscat\_subround*shear\_mag) \textcolor{keywordflow}{then} 1300 roscl = 1.0 1301 \textcolor{keywordflow}{else} 1302 sh\_f\_pow = meke%backscatter\_Ro\_c * (shear\_mag / fath)**meke%backscatter\_Ro\_pow 1303 roscl = sh\_f\_pow / (1.0 + sh\_f\_pow) \textcolor{comment}{! = 1 - f^n/(f^n+c*D^n)} 1304 \textcolor{keywordflow}{ endif} 1305 \textcolor{keywordflow}{ endif} 1306 1307 1308 meke%mom\_src(i,j) = meke%mom\_src(i,j) + gv%H\_to\_RZ * ( & 1309 ((str\_xx(i,j)-roscl*bhstr\_xx(i,j))*(u(i,j,k)-u(i-1,j,k))*g%IdxT(i,j) & 1310 -(str\_xx(i,j)-roscl*bhstr\_xx(i,j))*(v(i,j,k)-v(i,j-1,k))*g%IdyT(i,j)) & 1311 +0.25*(((str\_xy(i,j)-roscl*bhstr\_xy(i,j))*( & 1312 (u(i,j+1,k)-u(i,j,k))*g%IdyBu(i,j) & 1313 +(v(i+1,j,k)-v(i,j,k))*g%IdxBu(i,j) ) & 1314 +(str\_xy(i-1,j-1)-roscl*bhstr\_xy(i-1,j-1))*( & 1315 (u(i-1,j,k)-u(i-1,j-1,k))*g%IdyBu(i-1,j-1) & 1316 +(v(i,j-1,k)-v(i-1,j-1,k))*g%IdxBu(i-1,j-1) )) & 1317 +((str\_xy(i-1,j)-roscl*bhstr\_xy(i-1,j))*( & 1318 (u(i-1,j+1,k)-u(i-1,j,k))*g%IdyBu(i-1,j) & 1319 +(v(i,j,k)-v(i-1,j,k))*g%IdxBu(i-1,j) ) & 1320 +(str\_xy(i,j-1)-roscl*bhstr\_xy(i,j-1))*( & 1321 (u(i,j,k)-u(i,j-1,k))*g%IdyBu(i,j-1) & 1322 +(v(i+1,j-1,k)-v(i,j-1,k))*g%IdxBu(i,j-1) )) ) ) 1323 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1324 \textcolor{keywordflow}{ endif} \textcolor{comment}{! MEKE%backscatter\_Ro\_c} 1325 1326 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 1327 meke%mom\_src(i,j) = meke%mom\_src(i,j) + frictwork(i,j,k) 1328 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1329 1330 \textcolor{keywordflow}{if} (cs%use\_GME .and. \textcolor{keyword}{associated}(meke)) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(meke%GME\_snk)) \textcolor{keywordflow}{then} 1331 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 1332 meke%GME\_snk(i,j) = meke%GME\_snk(i,j) + frictwork\_gme(i,j,k) 1333 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1334 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ endif} 1335 1336 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ endif} \textcolor{comment}{! find\_FrictWork and associated(mom\_src)} 1337 1338 \textcolor{keywordflow}{ enddo} \textcolor{comment}{! end of k loop} 1339 1340 \textcolor{comment}{! Offer fields for diagnostic averaging.} 1341 \textcolor{keywordflow}{if} (cs%id\_diffu>0) \textcolor{keyword}{call }post\_data(cs%id\_diffu, diffu, cs%diag) 1342 \textcolor{keywordflow}{if} (cs%id\_diffv>0) \textcolor{keyword}{call }post\_data(cs%id\_diffv, diffv, cs%diag) 1343 \textcolor{keywordflow}{if} (cs%id\_FrictWork>0) \textcolor{keyword}{call }post\_data(cs%id\_FrictWork, frictwork, cs%diag) 1344 \textcolor{keywordflow}{if} (cs%id\_FrictWork\_GME>0) \textcolor{keyword}{call }post\_data(cs%id\_FrictWork\_GME, frictwork\_gme, cs%diag) 1345 \textcolor{keywordflow}{if} (cs%id\_Ah\_h>0) \textcolor{keyword}{call }post\_data(cs%id\_Ah\_h, ah\_h, cs%diag) 1346 \textcolor{keywordflow}{if} (cs%id\_grid\_Re\_Ah>0) \textcolor{keyword}{call }post\_data(cs%id\_grid\_Re\_Ah, grid\_re\_ah, cs%diag) 1347 \textcolor{keywordflow}{if} (cs%id\_div\_xx\_h>0) \textcolor{keyword}{call }post\_data(cs%id\_div\_xx\_h, div\_xx\_h, cs%diag) 1348 \textcolor{keywordflow}{if} (cs%id\_vort\_xy\_q>0) \textcolor{keyword}{call }post\_data(cs%id\_vort\_xy\_q, vort\_xy\_q, cs%diag) 1349 \textcolor{keywordflow}{if} (cs%id\_sh\_xx\_h>0) \textcolor{keyword}{call }post\_data(cs%id\_sh\_xx\_h, sh\_xx\_h, cs%diag) 1350 \textcolor{keywordflow}{if} (cs%id\_sh\_xy\_q>0) \textcolor{keyword}{call }post\_data(cs%id\_sh\_xy\_q, sh\_xy\_q, cs%diag) 1351 \textcolor{keywordflow}{if} (cs%id\_Ah\_q>0) \textcolor{keyword}{call }post\_data(cs%id\_Ah\_q, ah\_q, cs%diag) 1352 \textcolor{keywordflow}{if} (cs%id\_Kh\_h>0) \textcolor{keyword}{call }post\_data(cs%id\_Kh\_h, kh\_h, cs%diag) 1353 \textcolor{keywordflow}{if} (cs%id\_grid\_Re\_Kh>0) \textcolor{keyword}{call }post\_data(cs%id\_grid\_Re\_Kh, grid\_re\_kh, cs%diag) 1354 \textcolor{keywordflow}{if} (cs%id\_Kh\_q>0) \textcolor{keyword}{call }post\_data(cs%id\_Kh\_q, kh\_q, cs%diag) 1355 \textcolor{keywordflow}{if} (cs%id\_GME\_coeff\_h > 0) \textcolor{keyword}{call }post\_data(cs%id\_GME\_coeff\_h, gme\_coeff\_h, cs%diag) 1356 \textcolor{keywordflow}{if} (cs%id\_GME\_coeff\_q > 0) \textcolor{keyword}{call }post\_data(cs%id\_GME\_coeff\_q, gme\_coeff\_q, cs%diag) 1357 1358 \textcolor{keywordflow}{if} (cs%debug) \textcolor{keywordflow}{then} 1359 \textcolor{keywordflow}{if} (cs%Laplacian) \textcolor{keywordflow}{then} 1360 \textcolor{keyword}{call }hchksum(kh\_h, \textcolor{stringliteral}{"Kh\_h"}, g%HI, haloshift=0, scale=us%L\_to\_m**2*us%s\_to\_T) 1361 \textcolor{keyword}{call }bchksum(kh\_q, \textcolor{stringliteral}{"Kh\_q"}, g%HI, haloshift=0, scale=us%L\_to\_m**2*us%s\_to\_T) 1362 \textcolor{keywordflow}{ endif} 1363 \textcolor{keywordflow}{if} (cs%biharmonic) \textcolor{keyword}{call }hchksum(ah\_h, \textcolor{stringliteral}{"Ah\_h"}, g%HI, haloshift=0, scale=us%L\_to\_m**4*us%s\_to\_T) 1364 \textcolor{keywordflow}{if} (cs%biharmonic) \textcolor{keyword}{call }bchksum(ah\_q, \textcolor{stringliteral}{"Ah\_q"}, g%HI, haloshift=0, scale=us%L\_to\_m**4*us%s\_to\_T) 1365 \textcolor{keywordflow}{ endif} 1366 1367 \textcolor{keywordflow}{if} (cs%id\_FrictWorkIntz > 0) \textcolor{keywordflow}{then} 1368 \textcolor{keywordflow}{do} j=js,je 1369 \textcolor{keywordflow}{do} i=is,ie ; frictworkintz(i,j) = frictwork(i,j,1) ;\textcolor{keywordflow}{ enddo} 1370 \textcolor{keywordflow}{do} k=2,nz ; \textcolor{keywordflow}{do} i=is,ie 1371 frictworkintz(i,j) = frictworkintz(i,j) + frictwork(i,j,k) 1372 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1373 \textcolor{keywordflow}{ enddo} 1374 \textcolor{keyword}{call }post\_data(cs%id\_FrictWorkIntz, frictworkintz, cs%diag) 1375 \textcolor{keywordflow}{ endif} 1376 1377 \textcolor{comment}{! Diagnostics for terms multiplied by fractional thicknesses} 1378 1379 \textcolor{comment}{! 3D diagnostics hf\_diffu(diffv) are commented because there is no clarity on proper remapping grid option.} 1380 \textcolor{comment}{! The code is retained for degugging purposes in the future.} 1381 \textcolor{comment}{!if (present(ADp) .and. (CS%id\_hf\_diffu > 0)) then} 1382 \textcolor{comment}{! do k=1,nz ; do j=js,je ; do I=Isq,Ieq} 1383 \textcolor{comment}{! CS%hf\_diffu(I,j,k) = diffu(I,j,k) * ADp%diag\_hfrac\_u(I,j,k)} 1384 \textcolor{comment}{! enddo ; enddo ; enddo} 1385 \textcolor{comment}{! call post\_data(CS%id\_hf\_diffu, CS%hf\_diffu, CS%diag)} 1386 \textcolor{comment}{!endif} 1387 \textcolor{comment}{!if (present(ADp) .and. (CS%id\_hf\_diffv > 0)) then} 1388 \textcolor{comment}{! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie} 1389 \textcolor{comment}{! CS%hf\_diffv(i,J,k) = diffv(i,J,k) * ADp%diag\_hfrac\_v(i,J,k)} 1390 \textcolor{comment}{! enddo ; enddo ; enddo} 1391 \textcolor{comment}{! call post\_data(CS%id\_hf\_diffv, CS%hf\_diffv, CS%diag)} 1392 \textcolor{comment}{!endif} 1393 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(adp) .and. (cs%id\_hf\_diffu\_2d > 0)) \textcolor{keywordflow}{then} 1394 \textcolor{keyword}{allocate}(hf\_diffu\_2d(g%IsdB:g%IedB,g%jsd:g%jed)) 1395 hf\_diffu\_2d(:,:) = 0.0 1396 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=isq,ieq 1397 hf\_diffu\_2d(i,j) = hf\_diffu\_2d(i,j) + diffu(i,j,k) * adp%diag\_hfrac\_u(i,j,k) 1398 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1399 \textcolor{keyword}{call }post\_data(cs%id\_hf\_diffu\_2d, hf\_diffu\_2d, cs%diag) 1400 \textcolor{keyword}{deallocate}(hf\_diffu\_2d) 1401 \textcolor{keywordflow}{ endif} 1402 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(adp) .and. (cs%id\_hf\_diffv\_2d > 0)) \textcolor{keywordflow}{then} 1403 \textcolor{keyword}{allocate}(hf\_diffv\_2d(g%isd:g%ied,g%JsdB:g%JedB)) 1404 hf\_diffv\_2d(:,:) = 0.0 1405 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} j=jsq,jeq ; \textcolor{keywordflow}{do} i=is,ie 1406 hf\_diffv\_2d(i,j) = hf\_diffv\_2d(i,j) + diffv(i,j,k) * adp%diag\_hfrac\_v(i,j,k) 1407 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1408 \textcolor{keyword}{call }post\_data(cs%id\_hf\_diffv\_2d, hf\_diffv\_2d, cs%diag) 1409 \textcolor{keyword}{deallocate}(hf\_diffv\_2d) 1410 \textcolor{keywordflow}{ endif} 1411 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__hor__visc_a686fed1d7dd5311ab016b6f637aa7304}\label{namespacemom__hor__visc_a686fed1d7dd5311ab016b6f637aa7304}} \index{mom\+\_\+hor\+\_\+visc@{mom\+\_\+hor\+\_\+visc}!smooth\+\_\+gme@{smooth\+\_\+gme}} \index{smooth\+\_\+gme@{smooth\+\_\+gme}!mom\+\_\+hor\+\_\+visc@{mom\+\_\+hor\+\_\+visc}} \subsubsection{\texorpdfstring{smooth\+\_\+gme()}{smooth\_gme()}} {\footnotesize\ttfamily subroutine mom\+\_\+hor\+\_\+visc\+::smooth\+\_\+gme (\begin{DoxyParamCaption}\item[{type(\hyperlink{structmom__hor__visc_1_1hor__visc__cs}{hor\+\_\+visc\+\_\+cs}), pointer}]{CS, }\item[{type(ocean\+\_\+grid\+\_\+type), intent(in)}]{G, }\item[{real, dimension(szi\+\_\+(g),szj\+\_\+(g)), intent(inout), optional}]{G\+M\+E\+\_\+flux\+\_\+h, }\item[{real, dimension(szib\+\_\+(g),szjb\+\_\+(g)), intent(inout), optional}]{G\+M\+E\+\_\+flux\+\_\+q }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} Apply a 1-\/1-\/4-\/1-\/1 Laplacian filter one time on G\+ME diffusive flux to reduce any horizontal two-\/grid-\/point noise. \begin{DoxyParams}[1]{Parameters} & {\em cs} & Control structure\\ \hline \mbox{\tt in} & {\em g} & Ocean grid\\ \hline \mbox{\tt in,out} & {\em gme\+\_\+flux\+\_\+h} & G\+ME diffusive flux at h points\\ \hline \mbox{\tt in,out} & {\em gme\+\_\+flux\+\_\+q} & G\+ME diffusive flux at q points \\ \hline \end{DoxyParams} Definition at line 2192 of file M\+O\+M\+\_\+hor\+\_\+visc.\+F90. \begin{DoxyCode} 2192 \textcolor{comment}{! Arguments} 2193 \textcolor{keywordtype}{type}(hor\_visc\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< Control structure} 2194 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(in)} :: g\textcolor{comment}{ !< Ocean grid} 2195 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G))}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(inout)} :: gme\_flux\_h\textcolor{comment}{!< GME diffusive flux} 2196 \textcolor{comment}{ !! at h points} 2197 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJB\_(G))}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(inout)} :: gme\_flux\_q\textcolor{comment}{!< GME diffusive flux} 2198 \textcolor{comment}{ !! at q points} 2199 \textcolor{comment}{! local variables} 2200 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G))} :: gme\_flux\_h\_original 2201 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJB\_(G))} :: gme\_flux\_q\_original 2202 \textcolor{keywordtype}{real} :: wc, ww, we, wn, ws \textcolor{comment}{! averaging weights for smoothing} 2203 \textcolor{keywordtype}{integer} :: i, j, k, s 2204 \textcolor{keywordflow}{do} s=1,1 2205 \textcolor{comment}{! Update halos} 2206 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(gme\_flux\_h)) \textcolor{keywordflow}{then} 2207 \textcolor{keyword}{call }pass\_var(gme\_flux\_h, g%Domain) 2208 gme\_flux\_h\_original = gme\_flux\_h 2209 \textcolor{comment}{! apply smoothing on GME} 2210 \textcolor{keywordflow}{do} j = g%jsc, g%jec 2211 \textcolor{keywordflow}{do} i = g%isc, g%iec 2212 \textcolor{comment}{! skip land points} 2213 \textcolor{keywordflow}{if} (g%mask2dT(i,j)==0.) cycle 2214 \textcolor{comment}{! compute weights} 2215 ww = 0.125 * g%mask2dT(i-1,j) 2216 we = 0.125 * g%mask2dT(i+1,j) 2217 ws = 0.125 * g%mask2dT(i,j-1) 2218 wn = 0.125 * g%mask2dT(i,j+1) 2219 wc = 1.0 - (ww+we+wn+ws) 2220 gme\_flux\_h(i,j) = wc * gme\_flux\_h\_original(i,j) & 2221 + ww * gme\_flux\_h\_original(i-1,j) & 2222 + we * gme\_flux\_h\_original(i+1,j) & 2223 + ws * gme\_flux\_h\_original(i,j-1) & 2224 + wn * gme\_flux\_h\_original(i,j+1) 2225 \textcolor{keyword}{ end}do; enddo 2226 \textcolor{keywordflow}{ endif} 2227 \textcolor{comment}{! Update halos} 2228 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(gme\_flux\_q)) \textcolor{keywordflow}{then} 2229 \textcolor{keyword}{call }pass\_var(gme\_flux\_q, g%Domain, position=corner, complete=.true.) 2230 gme\_flux\_q\_original = gme\_flux\_q 2231 \textcolor{comment}{! apply smoothing on GME} 2232 \textcolor{keywordflow}{do} j = g%JscB, g%JecB 2233 \textcolor{keywordflow}{do} i = g%IscB, g%IecB 2234 \textcolor{comment}{! skip land points} 2235 \textcolor{keywordflow}{if} (g%mask2dBu(i,j)==0.) cycle 2236 \textcolor{comment}{! compute weights} 2237 ww = 0.125 * g%mask2dBu(i-1,j) 2238 we = 0.125 * g%mask2dBu(i+1,j) 2239 ws = 0.125 * g%mask2dBu(i,j-1) 2240 wn = 0.125 * g%mask2dBu(i,j+1) 2241 wc = 1.0 - (ww+we+wn+ws) 2242 gme\_flux\_q(i,j) = wc * gme\_flux\_q\_original(i,j) & 2243 + ww * gme\_flux\_q\_original(i-1,j) & 2244 + we * gme\_flux\_q\_original(i+1,j) & 2245 + ws * gme\_flux\_q\_original(i,j-1) & 2246 + wn * gme\_flux\_q\_original(i,j+1) 2247 \textcolor{keyword}{ end}do; enddo 2248 \textcolor{keywordflow}{ endif} 2249 \textcolor{keywordflow}{ enddo} \textcolor{comment}{! s-loop} \end{DoxyCode}