\hypertarget{namespacemom__tracer__hor__diff}{}\section{mom\+\_\+tracer\+\_\+hor\+\_\+diff Module Reference}
\label{namespacemom__tracer__hor__diff}\index{mom\+\_\+tracer\+\_\+hor\+\_\+diff@{mom\+\_\+tracer\+\_\+hor\+\_\+diff}}


\subsection{Detailed Description}
Main routine for lateral (along surface or neutral) diffusion of tracers. 

\hypertarget{namespacemom__tracer__hor__diff_section_intro}{}\subsection{Introduction to the module}\label{namespacemom__tracer__hor__diff_section_intro}
\begin{DoxyVerb}This module contains subroutines that handle horizontal
\end{DoxyVerb}
 diffusion (i.\+e., isoneutral or along layer) of tracers.

Each of the tracers are subject to Fickian along-\/coordinate diffusion if Khtr is defined and positive. The tracer diffusion can use a suitable number of iterations to guarantee stability with an arbitrarily large time step. \subsection*{Data Types}
\begin{DoxyCompactItemize}
\item 
type \hyperlink{structmom__tracer__hor__diff_1_1p2d}{p2d}
\begin{DoxyCompactList}\small\item\em A type that can be used to create arrays of pointers to 2D arrays. \end{DoxyCompactList}\item 
type \hyperlink{structmom__tracer__hor__diff_1_1p2di}{p2di}
\begin{DoxyCompactList}\small\item\em A type that can be used to create arrays of pointers to 2D integer arrays. \end{DoxyCompactList}\item 
type \hyperlink{structmom__tracer__hor__diff_1_1tracer__hor__diff__cs}{tracer\+\_\+hor\+\_\+diff\+\_\+cs}
\begin{DoxyCompactList}\small\item\em The control structure for along-\/layer and epineutral tracer diffusion. \end{DoxyCompactList}\end{DoxyCompactItemize}
\subsection*{Functions/\+Subroutines}
\begin{DoxyCompactItemize}
\item 
subroutine, public \hyperlink{namespacemom__tracer__hor__diff_a098229e37012e7bd93d13036bfc864ac}{tracer\+\_\+hordiff} (h, dt, M\+E\+KE, Var\+Mix, G, GV, US, CS, Reg, tv, do\+\_\+online\+\_\+flag, read\+\_\+khdt\+\_\+x, read\+\_\+khdt\+\_\+y)
\begin{DoxyCompactList}\small\item\em Compute along-\/coordinate diffusion of all tracers using the diffusivity in CSKh\+Tr, or using space-\/dependent diffusivity. Multiple iterations are used (if necessary) so that there is no limit on the acceptable time increment. \end{DoxyCompactList}\item 
subroutine \hyperlink{namespacemom__tracer__hor__diff_af6d8a8262d4c1030fc02aae4cd062821}{tracer\+\_\+epipycnal\+\_\+ml\+\_\+diff} (h, dt, Tr, ntr, khdt\+\_\+epi\+\_\+x, khdt\+\_\+epi\+\_\+y, G, GV, US, CS, tv, num\+\_\+itts)
\begin{DoxyCompactList}\small\item\em This subroutine does epipycnal diffusion of all tracers between the mixed and buffer layers and the interior, using the diffusivity in CSKh\+Tr. Multiple iterations are used (if necessary) so that there is no limit on the acceptable time increment. \end{DoxyCompactList}\item 
subroutine, public \hyperlink{namespacemom__tracer__hor__diff_a87eed0408da0c4732372732b34451b73}{tracer\+\_\+hor\+\_\+diff\+\_\+init} (Time, G, US, param\+\_\+file, diag, E\+OS, diabatic\+\_\+\+C\+Sp, CS)
\begin{DoxyCompactList}\small\item\em Initialize lateral tracer diffusion module. \end{DoxyCompactList}\item 
subroutine, public \hyperlink{namespacemom__tracer__hor__diff_a715439f7286842d78d2ce52b7e5371a4}{tracer\+\_\+hor\+\_\+diff\+\_\+end} (CS)
\end{DoxyCompactItemize}
\subsection*{Variables}
\textbf{ }\par
\begin{DoxyCompactItemize}
\item 
\mbox{\Hypertarget{namespacemom__tracer__hor__diff_ad2e47d2af24603c7e589ee65ad33901b}\label{namespacemom__tracer__hor__diff_ad2e47d2af24603c7e589ee65ad33901b}} 
integer \hyperlink{namespacemom__tracer__hor__diff_ad2e47d2af24603c7e589ee65ad33901b}{id\+\_\+clock\+\_\+diffuse}
\begin{DoxyCompactList}\small\item\em C\+PU time clocks. \end{DoxyCompactList}\item 
\mbox{\Hypertarget{namespacemom__tracer__hor__diff_afb8e3e165b35c4b6e220afe5706cd69a}\label{namespacemom__tracer__hor__diff_afb8e3e165b35c4b6e220afe5706cd69a}} 
integer \hyperlink{namespacemom__tracer__hor__diff_afb8e3e165b35c4b6e220afe5706cd69a}{id\+\_\+clock\+\_\+epimix}
\begin{DoxyCompactList}\small\item\em C\+PU time clocks. \end{DoxyCompactList}\item 
\mbox{\Hypertarget{namespacemom__tracer__hor__diff_ac92a65798be694ec5a56720c56e38603}\label{namespacemom__tracer__hor__diff_ac92a65798be694ec5a56720c56e38603}} 
integer \hyperlink{namespacemom__tracer__hor__diff_ac92a65798be694ec5a56720c56e38603}{id\+\_\+clock\+\_\+pass}
\begin{DoxyCompactList}\small\item\em C\+PU time clocks. \end{DoxyCompactList}\item 
\mbox{\Hypertarget{namespacemom__tracer__hor__diff_a75364bb3145fbbf8bc8bffeaa4bc10fd}\label{namespacemom__tracer__hor__diff_a75364bb3145fbbf8bc8bffeaa4bc10fd}} 
integer \hyperlink{namespacemom__tracer__hor__diff_a75364bb3145fbbf8bc8bffeaa4bc10fd}{id\+\_\+clock\+\_\+sync}
\begin{DoxyCompactList}\small\item\em C\+PU time clocks. \end{DoxyCompactList}\end{DoxyCompactItemize}



\subsection{Function/\+Subroutine Documentation}
\mbox{\Hypertarget{namespacemom__tracer__hor__diff_af6d8a8262d4c1030fc02aae4cd062821}\label{namespacemom__tracer__hor__diff_af6d8a8262d4c1030fc02aae4cd062821}} 
\index{mom\+\_\+tracer\+\_\+hor\+\_\+diff@{mom\+\_\+tracer\+\_\+hor\+\_\+diff}!tracer\+\_\+epipycnal\+\_\+ml\+\_\+diff@{tracer\+\_\+epipycnal\+\_\+ml\+\_\+diff}}
\index{tracer\+\_\+epipycnal\+\_\+ml\+\_\+diff@{tracer\+\_\+epipycnal\+\_\+ml\+\_\+diff}!mom\+\_\+tracer\+\_\+hor\+\_\+diff@{mom\+\_\+tracer\+\_\+hor\+\_\+diff}}
\subsubsection{\texorpdfstring{tracer\+\_\+epipycnal\+\_\+ml\+\_\+diff()}{tracer\_epipycnal\_ml\_diff()}}
{\footnotesize\ttfamily subroutine mom\+\_\+tracer\+\_\+hor\+\_\+diff\+::tracer\+\_\+epipycnal\+\_\+ml\+\_\+diff (\begin{DoxyParamCaption}\item[{real, dimension(szi\+\_\+(g),szj\+\_\+(g),szk\+\_\+(g)), intent(in)}]{h,  }\item[{real, intent(in)}]{dt,  }\item[{type(tracer\+\_\+type), dimension(\+:), intent(inout)}]{Tr,  }\item[{integer, intent(in)}]{ntr,  }\item[{real, dimension(szib\+\_\+(g),szj\+\_\+(g)), intent(in)}]{khdt\+\_\+epi\+\_\+x,  }\item[{real, dimension(szi\+\_\+(g),szjb\+\_\+(g)), intent(in)}]{khdt\+\_\+epi\+\_\+y,  }\item[{type(ocean\+\_\+grid\+\_\+type), intent(inout)}]{G,  }\item[{type(verticalgrid\+\_\+type), intent(in)}]{GV,  }\item[{type(unit\+\_\+scale\+\_\+type), intent(in)}]{US,  }\item[{type(\hyperlink{structmom__tracer__hor__diff_1_1tracer__hor__diff__cs}{tracer\+\_\+hor\+\_\+diff\+\_\+cs}), intent(inout)}]{CS,  }\item[{type(thermo\+\_\+var\+\_\+ptrs), intent(in)}]{tv,  }\item[{integer, intent(in)}]{num\+\_\+itts }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}}



This subroutine does epipycnal diffusion of all tracers between the mixed and buffer layers and the interior, using the diffusivity in CSKh\+Tr. Multiple iterations are used (if necessary) so that there is no limit on the acceptable time increment. 


\begin{DoxyParams}[1]{Parameters}
\mbox{\tt in,out}  & {\em g} & ocean grid structure\\
\hline
\mbox{\tt in}  & {\em gv} & ocean vertical grid structure\\
\hline
\mbox{\tt in}  & {\em h} & layer thickness \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}\\
\hline
\mbox{\tt in}  & {\em dt} & time step \mbox{[}T $\sim$$>$ s\mbox{]}\\
\hline
\mbox{\tt in,out}  & {\em tr} & tracer array\\
\hline
\mbox{\tt in}  & {\em ntr} & number of tracers\\
\hline
\mbox{\tt in}  & {\em khdt\+\_\+epi\+\_\+x} & Zonal epipycnal diffusivity times a time step and the ratio of the open face width over the distance between adjacent tracer points \mbox{[}L2 $\sim$$>$ m2\mbox{]}\\
\hline
\mbox{\tt in}  & {\em khdt\+\_\+epi\+\_\+y} & Meridional epipycnal diffusivity times a time step and the ratio of the open face width over the distance between adjacent tracer points \mbox{[}L2 $\sim$$>$ m2\mbox{]}\\
\hline
\mbox{\tt in}  & {\em us} & A dimensional unit scaling type\\
\hline
\mbox{\tt in,out}  & {\em cs} & module control structure\\
\hline
\mbox{\tt in}  & {\em tv} & thermodynamic structure\\
\hline
\mbox{\tt in}  & {\em num\+\_\+itts} & number of iterations (usually=1) \\
\hline
\end{DoxyParams}


Definition at line 589 of file M\+O\+M\+\_\+tracer\+\_\+hor\+\_\+diff.\+F90.


\begin{DoxyCode}
589   \textcolor{keywordtype}{type}(ocean\_grid\_type),                    \textcolor{keywordtype}{intent(inout)} :: g\textcolor{comment}{          !< ocean grid structure}
590   \textcolor{keywordtype}{type}(verticalgrid\_type),                  \textcolor{keywordtype}{intent(in)}    :: gv\textcolor{comment}{         !< ocean vertical grid structure}
591   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G),SZK\_(G))}, \textcolor{keywordtype}{intent(in)}    :: h\textcolor{comment}{          !< layer thickness [H ~> m or kg
       m-2]}
592   \textcolor{keywordtype}{real},                                     \textcolor{keywordtype}{intent(in)}    :: dt\textcolor{comment}{         !< time step [T ~> s]}
593   \textcolor{keywordtype}{type}(tracer\_type),                        \textcolor{keywordtype}{intent(inout)} :: tr(:)\textcolor{comment}{      !< tracer array}
594   \textcolor{keywordtype}{integer},                                  \textcolor{keywordtype}{intent(in)}    :: ntr\textcolor{comment}{        !< number of tracers}
595   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G))},        \textcolor{keywordtype}{intent(in)}    :: khdt\_epi\_x\textcolor{comment}{ !< Zonal epipycnal diffusivity
       times}
596 \textcolor{comment}{                                                           !! a time step and the ratio of the open face
       width over}
597 \textcolor{comment}{                                                           !! the distance between adjacent tracer points
       [L2 ~> m2]}
598   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G))},        \textcolor{keywordtype}{intent(in)}    :: khdt\_epi\_y\textcolor{comment}{ !< Meridional epipycnal diffusivity
       times}
599 \textcolor{comment}{                                                           !! a time step and the ratio of the open face
       width over}
600 \textcolor{comment}{                                                           !! the distance between adjacent tracer points
       [L2 ~> m2]}
601   \textcolor{keywordtype}{type}(unit\_scale\_type),                    \textcolor{keywordtype}{intent(in)}    :: us\textcolor{comment}{ !< A dimensional unit scaling type}
602   \textcolor{keywordtype}{type}(tracer\_hor\_diff\_cs),                 \textcolor{keywordtype}{intent(inout)} :: cs\textcolor{comment}{         !< module control structure}
603   \textcolor{keywordtype}{type}(thermo\_var\_ptrs),                    \textcolor{keywordtype}{intent(in)}    :: tv\textcolor{comment}{         !< thermodynamic structure}
604   \textcolor{keywordtype}{integer},                                  \textcolor{keywordtype}{intent(in)}    :: num\_itts\textcolor{comment}{   !< number of iterations (usually=1)}
605 
606 
607   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G), SZJ\_(G))} :: &
608     rml\_max  \textcolor{comment}{! The maximum coordinate density within the mixed layer [R ~> kg m-3].}
609   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G), SZJ\_(G), max(1,GV%nk\_rho\_varies))} :: &
610     rho\_coord \textcolor{comment}{! The coordinate density that is used to mix along [R ~> kg m-3].}
611 
612   \textcolor{comment}{! The naming mnemonic is a=above,b=below,L=Left,R=Right,u=u-point,v=v-point.}
613   \textcolor{comment}{! These are 1-D arrays of pointers to 2-d arrays to minimize memory usage.}
614   \textcolor{keywordtype}{type}(p2d), \textcolor{keywordtype}{dimension(SZJ\_(G))} :: &
615     deep\_wt\_lu, deep\_wt\_ru, &  \textcolor{comment}{! The relative weighting of the deeper of a pair [nondim].}
616     hp\_lu, hp\_ru       \textcolor{comment}{! The total thickness on each side for each pair [H ~> m or kg m-2].}
617 
618   \textcolor{keywordtype}{type}(p2d), \textcolor{keywordtype}{dimension(SZJB\_(G))} :: &
619     deep\_wt\_lv, deep\_wt\_rv, & \textcolor{comment}{! The relative weighting of the deeper of a pair [nondim].}
620     hp\_lv, hp\_rv       \textcolor{comment}{! The total thickness on each side for each pair [H ~> m or kg m-2].}
621 
622   \textcolor{keywordtype}{type}(p2di), \textcolor{keywordtype}{dimension(SZJ\_(G))} :: &
623     k0b\_lu, k0a\_lu, &  \textcolor{comment}{! The original k-indices of the layers that participate}
624     k0b\_ru, k0a\_ru     \textcolor{comment}{! in each pair of mixing at u-faces.}
625   \textcolor{keywordtype}{type}(p2di), \textcolor{keywordtype}{dimension(SZJB\_(G))} :: &
626     k0b\_lv, k0a\_lv, &  \textcolor{comment}{! The original k-indices of the layers that participate}
627     k0b\_rv, k0a\_rv     \textcolor{comment}{! in each pair of mixing at v-faces.}
628 
629   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G), SZJ\_(G), SZK\_(G))} :: &
630     tr\_flux\_conv  \textcolor{comment}{! The flux convergence of tracers [conc H L2 ~> conc m3 or conc kg]}
631   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G), SZJ\_(G), SZK\_(G))} :: tr\_flux\_3d, tr\_adj\_vert\_l, tr\_adj\_vert\_r
632 
633   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G), SZK\_(G), SZJ\_(G))} :: &
634     rho\_srt, & \textcolor{comment}{! The density of each layer of the sorted columns [R ~> kg m-3].}
635     h\_srt      \textcolor{comment}{! The thickness of each layer of the sorted columns [H ~> m or kg m-2].}
636   \textcolor{keywordtype}{integer}, \textcolor{keywordtype}{dimension(SZI\_(G), SZK\_(G), SZJ\_(G))} :: &
637     k0\_srt     \textcolor{comment}{! The original k-index that each layer of the sorted column}
638                \textcolor{comment}{! corresponds to.}
639 
640   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZK\_(G))} :: &
641     h\_demand\_l, & \textcolor{comment}{! The thickness in the left (\_L) or right (\_R) column that}
642     h\_demand\_r, & \textcolor{comment}{! is demanded to match the thickness in the counterpart [H ~> m or kg m-2].}
643     h\_used\_l, &   \textcolor{comment}{! The summed thickness from the left or right columns that}
644     h\_used\_r, &   \textcolor{comment}{! have actually been used [H ~> m or kg m-2].}
645     h\_supply\_frac\_l, &  \textcolor{comment}{! The fraction of the demanded thickness that can}
646     h\_supply\_frac\_r     \textcolor{comment}{! actually be supplied from a layer.}
647   \textcolor{keywordtype}{integer}, \textcolor{keywordtype}{dimension(SZI\_(G), SZJ\_(G))}  :: &
648     num\_srt, &   \textcolor{comment}{! The number of layers that are sorted in each column.}
649     k\_end\_srt, & \textcolor{comment}{! The maximum index in each column that might need to be}
650                  \textcolor{comment}{! sorted, based on neighboring values of max\_kRho}
651     max\_krho     \textcolor{comment}{! The index of the layer whose target density is just denser}
652                  \textcolor{comment}{! than the densest part of the mixed layer.}
653   \textcolor{keywordtype}{integer}, \textcolor{keywordtype}{dimension(SZJ\_(G))}           :: &
654     max\_srt      \textcolor{comment}{! The maximum value of num\_srt in a k-row.}
655   \textcolor{keywordtype}{integer}, \textcolor{keywordtype}{dimension(SZIB\_(G), SZJ\_(G))} :: &
656     npu          \textcolor{comment}{! The number of epipycnal pairings at each u-point.}
657   \textcolor{keywordtype}{integer}, \textcolor{keywordtype}{dimension(SZI\_(G), SZJB\_(G))} :: &
658     npv          \textcolor{comment}{! The number of epipycnal pairings at each v-point.}
659   \textcolor{keywordtype}{real} :: h\_exclude    \textcolor{comment}{! A thickness that layers must attain to be considered}
660                        \textcolor{comment}{! for inclusion in mixing [H ~> m or kg m-2].}
661   \textcolor{keywordtype}{real} :: idt        \textcolor{comment}{! The inverse of the time step [T-1 ~> s-1].}
662   \textcolor{keywordtype}{real} :: i\_maxitt   \textcolor{comment}{! The inverse of the maximum number of iterations.}
663   \textcolor{keywordtype}{real} :: rho\_pair, rho\_a, rho\_b  \textcolor{comment}{! Temporary densities [R ~> kg m-3].}
664   \textcolor{keywordtype}{real} :: tr\_min\_face  \textcolor{comment}{! The minimum and maximum tracer concentrations}
665   \textcolor{keywordtype}{real} :: tr\_max\_face  \textcolor{comment}{! associated with a pairing [Conc]}
666   \textcolor{keywordtype}{real} :: tr\_la, tr\_lb \textcolor{comment}{! The 4 tracer concentrations that might be}
667   \textcolor{keywordtype}{real} :: tr\_ra, tr\_rb \textcolor{comment}{! associated with a pairing [Conc]}
668   \textcolor{keywordtype}{real} :: tr\_av\_l    \textcolor{comment}{! The average tracer concentrations on the left and right}
669   \textcolor{keywordtype}{real} :: tr\_av\_r    \textcolor{comment}{! sides of a pairing [Conc].}
670   \textcolor{keywordtype}{real} :: tr\_flux    \textcolor{comment}{! The tracer flux from left to right in a pair [conc H L2 ~> conc m3 or conc kg].}
671   \textcolor{keywordtype}{real} :: tr\_adj\_vert  \textcolor{comment}{! A downward vertical adjustment to Tr\_flux between the}
672                      \textcolor{comment}{! two cells that make up one side of the pairing [conc H L2 ~> conc m3 or conc kg].}
673   \textcolor{keywordtype}{real} :: h\_l, h\_r   \textcolor{comment}{! Thicknesses to the left and right [H ~> m or kg m-2].}
674   \textcolor{keywordtype}{real} :: wt\_a, wt\_b \textcolor{comment}{! Fractional weights of layers above and below [nondim].}
675   \textcolor{keywordtype}{real} :: vol        \textcolor{comment}{! A cell volume or mass [H L2 ~> m3 or kg].}
676 
677   \textcolor{comment}{! The total number of pairings is usually much less than twice the number of layers, but}
678   \textcolor{comment}{! the memory in these 1-d columns of pairings can be allocated generously for safety.}
679   \textcolor{keywordtype}{integer}, \textcolor{keywordtype}{dimension(SZK\_(G)*2)} :: &
680     kbs\_lp, &   \textcolor{comment}{! The sorted indices of the Left and Right columns for}
681     kbs\_rp      \textcolor{comment}{! each pairing.}
682   \textcolor{keywordtype}{logical}, \textcolor{keywordtype}{dimension(SZK\_(G)*2)} :: &
683     left\_set, &  \textcolor{comment}{! If true, the left or right point determines the density of}
684     right\_set    \textcolor{comment}{! of the trio.  If densities are exactly equal, both are true.}
685 
686   \textcolor{keywordtype}{real} :: tmp
687   \textcolor{keywordtype}{real} :: p\_ref\_cv(szi\_(g)) \textcolor{comment}{! The reference pressure for the coordinate density [R L2 T-2 ~> Pa]}
688 
689   \textcolor{keywordtype}{integer}, \textcolor{keywordtype}{dimension(2)} :: eosdom \textcolor{comment}{! The i-computational domain for the equation of state}
690   \textcolor{keywordtype}{integer} :: k\_max, k\_min, k\_test, itmp
691   \textcolor{keywordtype}{integer} :: i, j, k, k2, m, is, ie, js, je, nz, nkmb
692   \textcolor{keywordtype}{integer} :: isd, ied, jsd, jed, isdb, iedb, k\_size
693   \textcolor{keywordtype}{integer} :: kl, kr, kla, klb, kra, krb, np, itt, ns, max\_itt
694   \textcolor{keywordtype}{integer} :: pemax\_krho
695   \textcolor{keywordtype}{integer} :: isv, iev, jsv, jev \textcolor{comment}{! The valid range of the indices.}
696 
697   is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
698   isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
699   isdb = g%IsdB ; iedb = g%IedB
700   idt = 1.0 / dt
701   nkmb = gv%nk\_rho\_varies
702 
703   \textcolor{keywordflow}{if} (num\_itts <= 1) \textcolor{keywordflow}{then}
704     max\_itt = 1 ; i\_maxitt = 1.0
705   \textcolor{keywordflow}{else}
706     max\_itt = num\_itts ; i\_maxitt = 1.0 / (\textcolor{keywordtype}{real}(max\_itt))
707 \textcolor{keywordflow}{  endif}
708 
709   \textcolor{keywordflow}{do} i=is-2,ie+2 ; p\_ref\_cv(i) = tv%P\_Ref ;\textcolor{keywordflow}{ enddo}
710   eosdom(:) = eos\_domain(g%HI,halo=2)
711 
712   \textcolor{keyword}{call }do\_group\_pass(cs%pass\_t, g%Domain, clock=id\_clock\_pass)
713   \textcolor{comment}{! Determine which layers the mixed- and buffer-layers map into...}
714   \textcolor{comment}{!$OMP parallel do default(shared)}
715   \textcolor{keywordflow}{do} k=1,nkmb ; \textcolor{keywordflow}{do} j=js-2,je+2
716     \textcolor{keyword}{call }calculate\_density(tv%T(:,j,k),tv%S(:,j,k), p\_ref\_cv, rho\_coord(:,j,k), &
717                            tv%eqn\_of\_state, eosdom)
718 \textcolor{keywordflow}{  enddo} ;\textcolor{keywordflow}{ enddo}
719 
720   \textcolor{keywordflow}{do} j=js-2,je+2 ; \textcolor{keywordflow}{do} i=is-2,ie+2
721     rml\_max(i,j) = rho\_coord(i,j,1)
722     num\_srt(i,j) = 0 ; max\_krho(i,j) = 0
723 \textcolor{keywordflow}{  enddo} ;\textcolor{keywordflow}{ enddo}
724   \textcolor{keywordflow}{do} k=2,nkmb ; \textcolor{keywordflow}{do} j=js-2,je+2 ; \textcolor{keywordflow}{do} i=is-2,ie+2
725     \textcolor{keywordflow}{if} (rml\_max(i,j) < rho\_coord(i,j,k)) rml\_max(i,j) = rho\_coord(i,j,k)
726 \textcolor{keywordflow}{  enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo}
727   \textcolor{comment}{!   Use bracketing and bisection to find the k-level that the densest of the}
728   \textcolor{comment}{! mixed and buffer layer corresponds to, such that:}
729   \textcolor{comment}{!     GV%Rlay(max\_kRho-1) < Rml\_max <= GV%Rlay(max\_kRho)}
730   \textcolor{comment}{!$OMP parallel do default(shared) private(k\_min,k\_max,k\_test)}
731   \textcolor{keywordflow}{do} j=js-2,je+2 ; \textcolor{keywordflow}{do} i=is-2,ie+2 ; \textcolor{keywordflow}{if} (g%mask2dT(i,j) > 0.5) \textcolor{keywordflow}{then}
732     \textcolor{keywordflow}{if} ((rml\_max(i,j) > gv%Rlay(nz)) .or. (nkmb+1 > nz)) \textcolor{keywordflow}{then} ; max\_krho(i,j) = nz+1
733     \textcolor{keywordflow}{elseif} ((rml\_max(i,j) <= gv%Rlay(nkmb+1)) .or. (nkmb+2 > nz)) \textcolor{keywordflow}{then} ; max\_krho(i,j) = nkmb+1
734     \textcolor{keywordflow}{else}
735       k\_min = nkmb+2 ; k\_max = nz
736       \textcolor{keywordflow}{do}
737         k\_test = (k\_min + k\_max) / 2
738         \textcolor{keywordflow}{if} (rml\_max(i,j) <= gv%Rlay(k\_test-1)) \textcolor{keywordflow}{then} ; k\_max = k\_test-1
739         \textcolor{keywordflow}{elseif} (gv%Rlay(k\_test) < rml\_max(i,j)) \textcolor{keywordflow}{then} ; k\_min = k\_test+1
740         \textcolor{keywordflow}{else} ; max\_krho(i,j) = k\_test ; \textcolor{keywordflow}{exit} ;\textcolor{keywordflow}{ endif}
741 
742         \textcolor{keywordflow}{if} (k\_min == k\_max) \textcolor{keywordflow}{then} ; max\_krho(i,j) = k\_max ; \textcolor{keywordflow}{exit} ;\textcolor{keywordflow}{ endif}
743 \textcolor{keywordflow}{      enddo}
744 \textcolor{keywordflow}{    endif}
745 \textcolor{keywordflow}{  endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo}
746 
747   pemax\_krho = 0
748   \textcolor{keywordflow}{do} j=js-1,je+1 ; \textcolor{keywordflow}{do} i=is-1,ie+1
749     k\_end\_srt(i,j) = max(max\_krho(i,j), max\_krho(i-1,j), max\_krho(i+1,j), &
750                          max\_krho(i,j-1), max\_krho(i,j+1))
751     \textcolor{keywordflow}{if} (pemax\_krho < k\_end\_srt(i,j)) pemax\_krho = k\_end\_srt(i,j)
752 \textcolor{keywordflow}{  enddo} ;\textcolor{keywordflow}{ enddo}
753   \textcolor{keywordflow}{if} (pemax\_krho > nz) pemax\_krho = nz \textcolor{comment}{! PEmax\_kRho could have been nz+1.}
754 
755   h\_exclude = 10.0*(gv%Angstrom\_H + gv%H\_subroundoff)
756   \textcolor{comment}{!$OMP parallel default(shared) private(ns,tmp,itmp)}
757   \textcolor{comment}{!$OMP do}
758   \textcolor{keywordflow}{do} j=js-1,je+1
759     \textcolor{keywordflow}{do} k=1,nkmb ; \textcolor{keywordflow}{do} i=is-1,ie+1 ; \textcolor{keywordflow}{if} (g%mask2dT(i,j) > 0.5) \textcolor{keywordflow}{then}
760       \textcolor{keywordflow}{if} (h(i,j,k) > h\_exclude) \textcolor{keywordflow}{then}
761         num\_srt(i,j) = num\_srt(i,j) + 1 ; ns = num\_srt(i,j)
762         k0\_srt(i,ns,j) = k
763         rho\_srt(i,ns,j) = rho\_coord(i,j,k)
764         h\_srt(i,ns,j) = h(i,j,k)
765 \textcolor{keywordflow}{      endif}
766 \textcolor{keywordflow}{    endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo}
767     \textcolor{keywordflow}{do} k=nkmb+1,pemax\_krho ; \textcolor{keywordflow}{do} i=is-1,ie+1 ; \textcolor{keywordflow}{if} (g%mask2dT(i,j) > 0.5) \textcolor{keywordflow}{then}
768       \textcolor{keywordflow}{if} ((k<=k\_end\_srt(i,j)) .and. (h(i,j,k) > h\_exclude)) \textcolor{keywordflow}{then}
769         num\_srt(i,j) = num\_srt(i,j) + 1 ; ns = num\_srt(i,j)
770         k0\_srt(i,ns,j) = k
771         rho\_srt(i,ns,j) = gv%Rlay(k)
772         h\_srt(i,ns,j) = h(i,j,k)
773 \textcolor{keywordflow}{      endif}
774 \textcolor{keywordflow}{    endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo}
775 \textcolor{keywordflow}{  enddo}
776   \textcolor{comment}{! Sort each column by increasing density.  This should already be close,}
777   \textcolor{comment}{! and the size of the arrays are small, so straight insertion is used.}
778   \textcolor{comment}{!$OMP do}
779    \textcolor{keywordflow}{do} j=js-1,je+1; \textcolor{keywordflow}{do} i=is-1,ie+1
780     \textcolor{keywordflow}{do} k=2,num\_srt(i,j) ; \textcolor{keywordflow}{if} (rho\_srt(i,k,j) < rho\_srt(i,k-1,j)) \textcolor{keywordflow}{then}
781       \textcolor{comment}{! The last segment needs to be shuffled earlier in the list.}
782       \textcolor{keywordflow}{do} k2 = k,2,-1 ; \textcolor{keywordflow}{if} (rho\_srt(i,k2,j) >= rho\_srt(i,k2-1,j)) \textcolor{keywordflow}{exit}
783         itmp = k0\_srt(i,k2-1,j) ; k0\_srt(i,k2-1,j) = k0\_srt(i,k2,j) ; k0\_srt(i,k2,j) = itmp
784         tmp = rho\_srt(i,k2-1,j) ; rho\_srt(i,k2-1,j) = rho\_srt(i,k2,j) ; rho\_srt(i,k2,j) = tmp
785         tmp = h\_srt(i,k2-1,j) ; h\_srt(i,k2-1,j) = h\_srt(i,k2,j) ; h\_srt(i,k2,j) = tmp
786 \textcolor{keywordflow}{      enddo}
787 \textcolor{keywordflow}{    endif} ;\textcolor{keywordflow}{ enddo}
788 \textcolor{keywordflow}{  enddo} ;\textcolor{keywordflow}{ enddo}
789   \textcolor{comment}{!$OMP do}
790   \textcolor{keywordflow}{do} j=js-1,je+1
791     max\_srt(j) = 0
792     \textcolor{keywordflow}{do} i=is-1,ie+1 ; max\_srt(j) = max(max\_srt(j), num\_srt(i,j)) ;\textcolor{keywordflow}{ enddo}
793 \textcolor{keywordflow}{  enddo}
794   \textcolor{comment}{!$OMP end parallel}
795 
796   \textcolor{keywordflow}{do} j=js,je
797     k\_size = max(2*max\_srt(j),1)
798     \textcolor{keyword}{allocate}(deep\_wt\_lu(j)%p(isdb:iedb,k\_size))
799     \textcolor{keyword}{allocate}(deep\_wt\_ru(j)%p(isdb:iedb,k\_size))
800     \textcolor{keyword}{allocate}(hp\_lu(j)%p(isdb:iedb,k\_size))
801     \textcolor{keyword}{allocate}(hp\_ru(j)%p(isdb:iedb,k\_size))
802     \textcolor{keyword}{allocate}(k0a\_lu(j)%p(isdb:iedb,k\_size))
803     \textcolor{keyword}{allocate}(k0a\_ru(j)%p(isdb:iedb,k\_size))
804     \textcolor{keyword}{allocate}(k0b\_lu(j)%p(isdb:iedb,k\_size))
805     \textcolor{keyword}{allocate}(k0b\_ru(j)%p(isdb:iedb,k\_size))
806 \textcolor{keywordflow}{  enddo}
807 
808 \textcolor{comment}{!$OMP parallel do default(none) shared(is,ie,js,je,G,num\_srt,rho\_srt,k0b\_Lu,k0\_srt, &}
809 \textcolor{comment}{!$OMP                                  k0b\_Ru,k0a\_Lu,k0a\_Ru,deep\_wt\_Lu,deep\_wt\_Ru,  &}
810 \textcolor{comment}{!$OMP                                  h\_srt,nkmb,nPu,hP\_Lu,hP\_Ru)                  &}
811 \textcolor{comment}{!$OMP                          private(h\_demand\_L,h\_used\_L,h\_demand\_R,h\_used\_R,     &}
812 \textcolor{comment}{!$OMP                                  kR,kL,nP,rho\_pair,kbs\_Lp,kbs\_Rp,rho\_a,rho\_b, &}
813 \textcolor{comment}{!$OMP                                  wt\_b,left\_set,right\_set,h\_supply\_frac\_R,     &}
814 \textcolor{comment}{!$OMP                                  h\_supply\_frac\_L)}
815   \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; \textcolor{keywordflow}{if} (g%mask2dCu(i,j) > 0.5) \textcolor{keywordflow}{then}
816     \textcolor{comment}{! Set up the pairings for fluxes through the zonal faces.}
817 
818     \textcolor{keywordflow}{do} k=1,num\_srt(i,j)   ; h\_demand\_l(k) = 0.0 ; h\_used\_l(k) = 0.0 ;\textcolor{keywordflow}{ enddo}
819     \textcolor{keywordflow}{do} k=1,num\_srt(i+1,j) ; h\_demand\_r(k) = 0.0 ; h\_used\_r(k) = 0.0 ;\textcolor{keywordflow}{ enddo}
820 
821     \textcolor{comment}{! First merge the left and right lists into a single, sorted list.}
822 
823     \textcolor{comment}{!   Discard any layers that are lighter than the lightest in the other}
824     \textcolor{comment}{! column.  They can only participate in mixing as the lighter part of a}
825     \textcolor{comment}{! pair of points.}
826     \textcolor{keywordflow}{if} (rho\_srt(i,1,j) < rho\_srt(i+1,1,j)) \textcolor{keywordflow}{then}
827       kr = 1
828       \textcolor{keywordflow}{do} kl=2,num\_srt(i,j) ; \textcolor{keywordflow}{if} (rho\_srt(i,kl,j) >= rho\_srt(i+1,1,j)) \textcolor{keywordflow}{exit} ;\textcolor{keywordflow}{ enddo}
829     \textcolor{keywordflow}{elseif} (rho\_srt(i+1,1,j) < rho\_srt(i,1,j)) \textcolor{keywordflow}{then}
830       kl = 1
831       \textcolor{keywordflow}{do} kr=2,num\_srt(i+1,j) ; \textcolor{keywordflow}{if} (rho\_srt(i+1,kr,j) >= rho\_srt(i,1,j)) \textcolor{keywordflow}{exit} ;\textcolor{keywordflow}{ enddo}
832     \textcolor{keywordflow}{else}
833       kl = 1 ; kr = 1
834 \textcolor{keywordflow}{    endif}
835     np = 0
836     \textcolor{keywordflow}{do} \textcolor{comment}{! Loop to accumulate pairs of columns.}
837       \textcolor{keywordflow}{if} ((kl > num\_srt(i,j)) .or. (kr > num\_srt(i+1,j))) \textcolor{keywordflow}{exit}
838 
839       \textcolor{keywordflow}{if} (rho\_srt(i,kl,j) > rho\_srt(i+1,kr,j)) \textcolor{keywordflow}{then}
840       \textcolor{comment}{! The right point is lighter and defines the density for this trio.}
841         np = np+1 ; k = np
842         rho\_pair = rho\_srt(i+1,kr,j)
843 
844         k0b\_lu(j)%p(i,k) = k0\_srt(i,kl,j) ; k0b\_ru(j)%p(i,k) = k0\_srt(i+1,kr,j)
845         k0a\_lu(j)%p(i,k) = k0\_srt(i,kl-1,j) ; k0a\_ru(j)%p(i,k) = k0b\_ru(j)%p(i,k)
846         kbs\_lp(k) = kl ; kbs\_rp(k) = kr
847 
848         rho\_a = rho\_srt(i,kl-1,j) ; rho\_b = rho\_srt(i,kl,j)
849         wt\_b = 1.0 ; \textcolor{keywordflow}{if} (abs(rho\_a - rho\_b) > abs(rho\_pair - rho\_a)) &
850           wt\_b = (rho\_pair - rho\_a) / (rho\_b - rho\_a)
851         deep\_wt\_lu(j)%p(i,k) = wt\_b ; deep\_wt\_ru(j)%p(i,k) = 1.0
852 
853         h\_demand\_l(kl) = h\_demand\_l(kl) + 0.5*h\_srt(i+1,kr,j) * wt\_b
854         h\_demand\_l(kl-1) = h\_demand\_l(kl-1) + 0.5*h\_srt(i+1,kr,j) * (1.0-wt\_b)
855 
856         kr = kr+1 ; left\_set(k) = .false. ; right\_set(k) = .true.
857       \textcolor{keywordflow}{elseif} (rho\_srt(i,kl,j) < rho\_srt(i+1,kr,j)) \textcolor{keywordflow}{then}
858       \textcolor{comment}{! The left point is lighter and defines the density for this trio.}
859         np = np+1 ; k = np
860         rho\_pair = rho\_srt(i,kl,j)
861         k0b\_lu(j)%p(i,k) = k0\_srt(i,kl,j) ; k0b\_ru(j)%p(i,k) = k0\_srt(i+1,kr,j)
862         k0a\_lu(j)%p(i,k) = k0b\_lu(j)%p(i,k) ; k0a\_ru(j)%p(i,k) = k0\_srt(i+1,kr-1,j)
863 
864         kbs\_lp(k) = kl ; kbs\_rp(k) = kr
865 
866         rho\_a = rho\_srt(i+1,kr-1,j) ; rho\_b = rho\_srt(i+1,kr,j)
867         wt\_b = 1.0 ; \textcolor{keywordflow}{if} (abs(rho\_a - rho\_b) > abs(rho\_pair - rho\_a)) &
868           wt\_b = (rho\_pair - rho\_a) / (rho\_b - rho\_a)
869         deep\_wt\_lu(j)%p(i,k) = 1.0 ; deep\_wt\_ru(j)%p(i,k) = wt\_b
870 
871         h\_demand\_r(kr) = h\_demand\_r(kr) + 0.5*h\_srt(i,kl,j) * wt\_b
872         h\_demand\_r(kr-1) = h\_demand\_r(kr-1) + 0.5*h\_srt(i,kl,j) * (1.0-wt\_b)
873 
874         kl = kl+1 ; left\_set(k) = .true. ; right\_set(k) = .false.
875       \textcolor{keywordflow}{elseif} ((k0\_srt(i,kl,j) <= nkmb) .or. (k0\_srt(i+1,kr,j) <= nkmb)) \textcolor{keywordflow}{then}
876         \textcolor{comment}{! The densities are exactly equal and one layer is above the interior.}
877         np = np+1 ; k = np
878         k0b\_lu(j)%p(i,k) = k0\_srt(i,kl,j) ; k0b\_ru(j)%p(i,k) = k0\_srt(i+1,kr,j)
879         k0a\_lu(j)%p(i,k) = k0b\_lu(j)%p(i,k) ; k0a\_ru(j)%p(i,k) = k0b\_ru(j)%p(i,k)
880         kbs\_lp(k) = kl ; kbs\_rp(k) = kr
881         deep\_wt\_lu(j)%p(i,k) = 1.0 ; deep\_wt\_ru(j)%p(i,k) = 1.0
882 
883         h\_demand\_l(kl) = h\_demand\_l(kl) + 0.5*h\_srt(i+1,kr,j)
884         h\_demand\_r(kr) = h\_demand\_r(kr) + 0.5*h\_srt(i,kl,j)
885 
886         kl = kl+1 ; kr = kr+1 ; left\_set(k) = .true. ; right\_set(k) = .true.
887       \textcolor{keywordflow}{else} \textcolor{comment}{! The densities are exactly equal and in the interior.}
888         \textcolor{comment}{! Mixing in this case has already occurred, so accumulate the thickness}
889         \textcolor{comment}{! demanded for that mixing and skip onward.}
890         h\_demand\_l(kl) = h\_demand\_l(kl) + 0.5*h\_srt(i+1,kr,j)
891         h\_demand\_r(kr) = h\_demand\_r(kr) + 0.5*h\_srt(i,kl,j)
892 
893         kl = kl+1 ; kr = kr+1
894 \textcolor{keywordflow}{      endif}
895 \textcolor{keywordflow}{    enddo} \textcolor{comment}{! Loop to accumulate pairs of columns.}
896     npu(i,j) = np \textcolor{comment}{! This is the number of active pairings.}
897 
898     \textcolor{comment}{! Determine what fraction of the thickness "demand" can be supplied.}
899     \textcolor{keywordflow}{do} k=1,num\_srt(i+1,j)
900       h\_supply\_frac\_r(k) = 1.0
901       \textcolor{keywordflow}{if} (h\_demand\_r(k) > 0.5*h\_srt(i+1,k,j)) &
902         h\_supply\_frac\_r(k) = 0.5*h\_srt(i+1,k,j) / h\_demand\_r(k)
903 \textcolor{keywordflow}{    enddo}
904     \textcolor{keywordflow}{do} k=1,num\_srt(i,j)
905       h\_supply\_frac\_l(k) = 1.0
906       \textcolor{keywordflow}{if} (h\_demand\_l(k) > 0.5*h\_srt(i,k,j)) &
907         h\_supply\_frac\_l(k) = 0.5*h\_srt(i,k,j) / h\_demand\_l(k)
908 \textcolor{keywordflow}{    enddo}
909 
910     \textcolor{comment}{!  Distribute the "exported" thicknesses proportionately.}
911     \textcolor{keywordflow}{do} k=1,npu(i,j)
912       kl = kbs\_lp(k) ; kr = kbs\_rp(k)
913       hp\_lu(j)%p(i,k) = 0.0 ; hp\_ru(j)%p(i,k) = 0.0
914       \textcolor{keywordflow}{if} (left\_set(k)) \textcolor{keywordflow}{then} \textcolor{comment}{! Add the contributing thicknesses on the right.}
915         \textcolor{keywordflow}{if} (deep\_wt\_ru(j)%p(i,k) < 1.0) \textcolor{keywordflow}{then}
916           hp\_ru(j)%p(i,k) = 0.5*h\_srt(i,kl,j) * min(h\_supply\_frac\_r(kr), h\_supply\_frac\_r(kr-1))
917           wt\_b = deep\_wt\_ru(j)%p(i,k)
918           h\_used\_r(kr-1) = h\_used\_r(kr-1) + (1.0 - wt\_b)*hp\_ru(j)%p(i,k)
919           h\_used\_r(kr) = h\_used\_r(kr) + wt\_b*hp\_ru(j)%p(i,k)
920         \textcolor{keywordflow}{else}
921           hp\_ru(j)%p(i,k) = 0.5*h\_srt(i,kl,j) * h\_supply\_frac\_r(kr)
922           h\_used\_r(kr) = h\_used\_r(kr) + hp\_ru(j)%p(i,k)
923 \textcolor{keywordflow}{        endif}
924 \textcolor{keywordflow}{      endif}
925       \textcolor{keywordflow}{if} (right\_set(k)) \textcolor{keywordflow}{then} \textcolor{comment}{! Add the contributing thicknesses on the left.}
926         \textcolor{keywordflow}{if} (deep\_wt\_lu(j)%p(i,k) < 1.0) \textcolor{keywordflow}{then}
927           hp\_lu(j)%p(i,k) = 0.5*h\_srt(i+1,kr,j) * min(h\_supply\_frac\_l(kl), h\_supply\_frac\_l(kl-1))
928           wt\_b = deep\_wt\_lu(j)%p(i,k)
929           h\_used\_l(kl-1) = h\_used\_l(kl-1) + (1.0 - wt\_b)*hp\_lu(j)%p(i,k)
930           h\_used\_l(kl) = h\_used\_l(kl) + wt\_b*hp\_lu(j)%p(i,k)
931         \textcolor{keywordflow}{else}
932           hp\_lu(j)%p(i,k) = 0.5*h\_srt(i+1,kr,j) * h\_supply\_frac\_l(kl)
933           h\_used\_l(kl) = h\_used\_l(kl) + hp\_lu(j)%p(i,k)
934 \textcolor{keywordflow}{        endif}
935 \textcolor{keywordflow}{      endif}
936 \textcolor{keywordflow}{    enddo}
937 
938     \textcolor{comment}{!   The left-over thickness (at least half the layer thickness) is now}
939     \textcolor{comment}{! added to the thicknesses of the importing columns.}
940     \textcolor{keywordflow}{do} k=1,npu(i,j)
941       \textcolor{keywordflow}{if} (left\_set(k)) hp\_lu(j)%p(i,k) = hp\_lu(j)%p(i,k) + &
942                            (h\_srt(i,kbs\_lp(k),j) - h\_used\_l(kbs\_lp(k)))
943       \textcolor{keywordflow}{if} (right\_set(k)) hp\_ru(j)%p(i,k) = hp\_ru(j)%p(i,k) + &
944                             (h\_srt(i+1,kbs\_rp(k),j) - h\_used\_r(kbs\_rp(k)))
945 \textcolor{keywordflow}{    enddo}
946 
947 \textcolor{keywordflow}{  endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} \textcolor{comment}{! i- & j- loops over zonal faces.}
948 
949   \textcolor{keywordflow}{do} j=js-1,je
950     k\_size = max(max\_srt(j)+max\_srt(j+1),1)
951     \textcolor{keyword}{allocate}(deep\_wt\_lv(j)%p(isd:ied,k\_size))
952     \textcolor{keyword}{allocate}(deep\_wt\_rv(j)%p(isd:ied,k\_size))
953     \textcolor{keyword}{allocate}(hp\_lv(j)%p(isd:ied,k\_size))
954     \textcolor{keyword}{allocate}(hp\_rv(j)%p(isd:ied,k\_size))
955     \textcolor{keyword}{allocate}(k0a\_lv(j)%p(isd:ied,k\_size))
956     \textcolor{keyword}{allocate}(k0a\_rv(j)%p(isd:ied,k\_size))
957     \textcolor{keyword}{allocate}(k0b\_lv(j)%p(isd:ied,k\_size))
958     \textcolor{keyword}{allocate}(k0b\_rv(j)%p(isd:ied,k\_size))
959 \textcolor{keywordflow}{  enddo}
960 
961 \textcolor{comment}{!$OMP parallel do default(none) shared(is,ie,js,je,G,num\_srt,rho\_srt,k0b\_Lv,k0b\_Rv, &}
962 \textcolor{comment}{!$OMP                                  k0\_srt,k0a\_Lv,k0a\_Rv,deep\_wt\_Lv,deep\_wt\_Rv,  &}
963 \textcolor{comment}{!$OMP                                  h\_srt,nkmb,nPv,hP\_Lv,hP\_Rv)                  &}
964 \textcolor{comment}{!$OMP                          private(h\_demand\_L,h\_used\_L,h\_demand\_R,h\_used\_R,     &}
965 \textcolor{comment}{!$OMP                                  kR,kL,nP,rho\_pair,kbs\_Lp,kbs\_Rp,rho\_a,rho\_b, &}
966 \textcolor{comment}{!$OMP                                  wt\_b,left\_set,right\_set,h\_supply\_frac\_R,     &}
967 \textcolor{comment}{!$OMP                                  h\_supply\_frac\_L)}
968   \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; \textcolor{keywordflow}{if} (g%mask2dCv(i,j) > 0.5) \textcolor{keywordflow}{then}
969     \textcolor{comment}{! Set up the pairings for fluxes through the meridional faces.}
970 
971     \textcolor{keywordflow}{do} k=1,num\_srt(i,j)   ; h\_demand\_l(k) = 0.0 ; h\_used\_l(k) = 0.0 ;\textcolor{keywordflow}{ enddo}
972     \textcolor{keywordflow}{do} k=1,num\_srt(i,j+1) ; h\_demand\_r(k) = 0.0 ; h\_used\_r(k) = 0.0 ;\textcolor{keywordflow}{ enddo}
973 
974     \textcolor{comment}{! First merge the left and right lists into a single, sorted list.}
975 
976     \textcolor{comment}{!   Discard any layers that are lighter than the lightest in the other}
977     \textcolor{comment}{! column.  They can only participate in mixing as the lighter part of a}
978     \textcolor{comment}{! pair of points.}
979     \textcolor{keywordflow}{if} (rho\_srt(i,1,j) < rho\_srt(i,1,j+1)) \textcolor{keywordflow}{then}
980       kr = 1
981       \textcolor{keywordflow}{do} kl=2,num\_srt(i,j) ; \textcolor{keywordflow}{if} (rho\_srt(i,kl,j) >= rho\_srt(i,1,j+1)) \textcolor{keywordflow}{exit} ;\textcolor{keywordflow}{ enddo}
982     \textcolor{keywordflow}{elseif} (rho\_srt(i,1,j+1) < rho\_srt(i,1,j)) \textcolor{keywordflow}{then}
983       kl = 1
984       \textcolor{keywordflow}{do} kr=2,num\_srt(i,j+1) ; \textcolor{keywordflow}{if} (rho\_srt(i,kr,j+1) >= rho\_srt(i,1,j)) \textcolor{keywordflow}{exit} ;\textcolor{keywordflow}{ enddo}
985     \textcolor{keywordflow}{else}
986       kl = 1 ; kr = 1
987 \textcolor{keywordflow}{    endif}
988     np = 0
989     \textcolor{keywordflow}{do} \textcolor{comment}{! Loop to accumulate pairs of columns.}
990       \textcolor{keywordflow}{if} ((kl > num\_srt(i,j)) .or. (kr > num\_srt(i,j+1))) \textcolor{keywordflow}{exit}
991 
992       \textcolor{keywordflow}{if} (rho\_srt(i,kl,j) > rho\_srt(i,kr,j+1)) \textcolor{keywordflow}{then}
993       \textcolor{comment}{! The right point is lighter and defines the density for this trio.}
994         np = np+1 ; k = np
995         rho\_pair = rho\_srt(i,kr,j+1)
996 
997         k0b\_lv(j)%p(i,k) = k0\_srt(i,kl,j)   ; k0b\_rv(j)%p(i,k) = k0\_srt(i,kr,j+1)
998         k0a\_lv(j)%p(i,k) = k0\_srt(i,kl-1,j) ; k0a\_rv(j)%p(i,k) = k0b\_rv(j)%p(i,k)
999         kbs\_lp(k) = kl ; kbs\_rp(k) = kr
1000 
1001         rho\_a = rho\_srt(i,kl-1,j) ; rho\_b = rho\_srt(i,kl,j)
1002         wt\_b = 1.0 ; \textcolor{keywordflow}{if} (abs(rho\_a - rho\_b) > abs(rho\_pair - rho\_a)) &
1003           wt\_b = (rho\_pair - rho\_a) / (rho\_b - rho\_a)
1004         deep\_wt\_lv(j)%p(i,k) = wt\_b ; deep\_wt\_rv(j)%p(i,k) = 1.0
1005 
1006         h\_demand\_l(kl) = h\_demand\_l(kl) + 0.5*h\_srt(i,kr,j+1) * wt\_b
1007         h\_demand\_l(kl-1) = h\_demand\_l(kl-1) + 0.5*h\_srt(i,kr,j+1) * (1.0-wt\_b)
1008 
1009         kr = kr+1 ; left\_set(k) = .false. ; right\_set(k) = .true.
1010       \textcolor{keywordflow}{elseif} (rho\_srt(i,kl,j) < rho\_srt(i,kr,j+1)) \textcolor{keywordflow}{then}
1011       \textcolor{comment}{! The left point is lighter and defines the density for this trio.}
1012         np = np+1 ; k = np
1013         rho\_pair = rho\_srt(i,kl,j)
1014         k0b\_lv(j)%p(i,k) = k0\_srt(i,kl,j) ; k0b\_rv(j)%p(i,k) = k0\_srt(i,kr,j+1)
1015         k0a\_lv(j)%p(i,k) = k0b\_lv(j)%p(i,k) ; k0a\_rv(j)%p(i,k) = k0\_srt(i,kr-1,j+1)
1016 
1017         kbs\_lp(k) = kl ; kbs\_rp(k) = kr
1018 
1019         rho\_a = rho\_srt(i,kr-1,j+1) ; rho\_b = rho\_srt(i,kr,j+1)
1020         wt\_b = 1.0 ; \textcolor{keywordflow}{if} (abs(rho\_a - rho\_b) > abs(rho\_pair - rho\_a)) &
1021           wt\_b = (rho\_pair - rho\_a) / (rho\_b - rho\_a)
1022         deep\_wt\_lv(j)%p(i,k) = 1.0 ; deep\_wt\_rv(j)%p(i,k) = wt\_b
1023 
1024         h\_demand\_r(kr) = h\_demand\_r(kr) + 0.5*h\_srt(i,kl,j) * wt\_b
1025         h\_demand\_r(kr-1) = h\_demand\_r(kr-1) + 0.5*h\_srt(i,kl,j) * (1.0-wt\_b)
1026 
1027         kl = kl+1 ; left\_set(k) = .true. ; right\_set(k) = .false.
1028       \textcolor{keywordflow}{elseif} ((k0\_srt(i,kl,j) <= nkmb) .or. (k0\_srt(i,kr,j+1) <= nkmb)) \textcolor{keywordflow}{then}
1029         \textcolor{comment}{! The densities are exactly equal and one layer is above the interior.}
1030         np = np+1 ; k = np
1031         k0b\_lv(j)%p(i,k) = k0\_srt(i,kl,j) ; k0b\_rv(j)%p(i,k) = k0\_srt(i,kr,j+1)
1032         k0a\_lv(j)%p(i,k) = k0b\_lv(j)%p(i,k)  ; k0a\_rv(j)%p(i,k) = k0b\_rv(j)%p(i,k)
1033         kbs\_lp(k) = kl ; kbs\_rp(k) = kr
1034         deep\_wt\_lv(j)%p(i,k) = 1.0 ; deep\_wt\_rv(j)%p(i,k) = 1.0
1035 
1036         h\_demand\_l(kl) = h\_demand\_l(kl) + 0.5*h\_srt(i,kr,j+1)
1037         h\_demand\_r(kr) = h\_demand\_r(kr) + 0.5*h\_srt(i,kl,j)
1038 
1039         kl = kl+1 ; kr = kr+1 ; left\_set(k) = .true. ; right\_set(k) = .true.
1040       \textcolor{keywordflow}{else} \textcolor{comment}{! The densities are exactly equal and in the interior.}
1041         \textcolor{comment}{! Mixing in this case has already occurred, so accumulate the thickness}
1042         \textcolor{comment}{! demanded for that mixing and skip onward.}
1043         h\_demand\_l(kl) = h\_demand\_l(kl) + 0.5*h\_srt(i,kr,j+1)
1044         h\_demand\_r(kr) = h\_demand\_r(kr) + 0.5*h\_srt(i,kl,j)
1045 
1046         kl = kl+1 ; kr = kr+1
1047 \textcolor{keywordflow}{      endif}
1048 \textcolor{keywordflow}{    enddo} \textcolor{comment}{! Loop to accumulate pairs of columns.}
1049     npv(i,j) = np \textcolor{comment}{! This is the number of active pairings.}
1050 
1051     \textcolor{comment}{! Determine what fraction of the thickness "demand" can be supplied.}
1052     \textcolor{keywordflow}{do} k=1,num\_srt(i,j+1)
1053       h\_supply\_frac\_r(k) = 1.0
1054       \textcolor{keywordflow}{if} (h\_demand\_r(k) > 0.5*h\_srt(i,k,j+1)) &
1055         h\_supply\_frac\_r(k) = 0.5*h\_srt(i,k,j+1) / h\_demand\_r(k)
1056 \textcolor{keywordflow}{    enddo}
1057     \textcolor{keywordflow}{do} k=1,num\_srt(i,j)
1058       h\_supply\_frac\_l(k) = 1.0
1059       \textcolor{keywordflow}{if} (h\_demand\_l(k) > 0.5*h\_srt(i,k,j)) &
1060         h\_supply\_frac\_l(k) = 0.5*h\_srt(i,k,j) / h\_demand\_l(k)
1061 \textcolor{keywordflow}{    enddo}
1062 
1063     \textcolor{comment}{!  Distribute the "exported" thicknesses proportionately.}
1064     \textcolor{keywordflow}{do} k=1,npv(i,j)
1065       kl = kbs\_lp(k) ; kr = kbs\_rp(k)
1066       hp\_lv(j)%p(i,k) = 0.0 ; hp\_rv(j)%p(i,k) = 0.0
1067       \textcolor{keywordflow}{if} (left\_set(k)) \textcolor{keywordflow}{then} \textcolor{comment}{! Add the contributing thicknesses on the right.}
1068         \textcolor{keywordflow}{if} (deep\_wt\_rv(j)%p(i,k) < 1.0) \textcolor{keywordflow}{then}
1069           hp\_rv(j)%p(i,k) = 0.5*h\_srt(i,kl,j) * min(h\_supply\_frac\_r(kr), h\_supply\_frac\_r(kr-1))
1070           wt\_b = deep\_wt\_rv(j)%p(i,k)
1071           h\_used\_r(kr-1) = h\_used\_r(kr-1) + (1.0 - wt\_b) * hp\_rv(j)%p(i,k)
1072           h\_used\_r(kr) = h\_used\_r(kr) + wt\_b * hp\_rv(j)%p(i,k)
1073         \textcolor{keywordflow}{else}
1074           hp\_rv(j)%p(i,k) = 0.5*h\_srt(i,kl,j) * h\_supply\_frac\_r(kr)
1075           h\_used\_r(kr) = h\_used\_r(kr) + hp\_rv(j)%p(i,k)
1076 \textcolor{keywordflow}{        endif}
1077 \textcolor{keywordflow}{      endif}
1078       \textcolor{keywordflow}{if} (right\_set(k)) \textcolor{keywordflow}{then} \textcolor{comment}{! Add the contributing thicknesses on the left.}
1079         \textcolor{keywordflow}{if} (deep\_wt\_lv(j)%p(i,k) < 1.0) \textcolor{keywordflow}{then}
1080           hp\_lv(j)%p(i,k) = 0.5*h\_srt(i,kr,j+1) * min(h\_supply\_frac\_l(kl), h\_supply\_frac\_l(kl-1))
1081           wt\_b = deep\_wt\_lv(j)%p(i,k)
1082           h\_used\_l(kl-1) = h\_used\_l(kl-1) + (1.0 - wt\_b) * hp\_lv(j)%p(i,k)
1083           h\_used\_l(kl) = h\_used\_l(kl) + wt\_b * hp\_lv(j)%p(i,k)
1084         \textcolor{keywordflow}{else}
1085           hp\_lv(j)%p(i,k) = 0.5*h\_srt(i,kr,j+1) * h\_supply\_frac\_l(kl)
1086           h\_used\_l(kl) = h\_used\_l(kl) + hp\_lv(j)%p(i,k)
1087 \textcolor{keywordflow}{        endif}
1088 \textcolor{keywordflow}{      endif}
1089 \textcolor{keywordflow}{    enddo}
1090 
1091     \textcolor{comment}{!   The left-over thickness (at least half the layer thickness) is now}
1092     \textcolor{comment}{! added to the thicknesses of the importing columns.}
1093     \textcolor{keywordflow}{do} k=1,npv(i,j)
1094       \textcolor{keywordflow}{if} (left\_set(k)) hp\_lv(j)%p(i,k) = hp\_lv(j)%p(i,k) + &
1095                             (h\_srt(i,kbs\_lp(k),j) - h\_used\_l(kbs\_lp(k)))
1096       \textcolor{keywordflow}{if} (right\_set(k)) hp\_rv(j)%p(i,k) = hp\_rv(j)%p(i,k) + &
1097                              (h\_srt(i,kbs\_rp(k),j+1) - h\_used\_r(kbs\_rp(k)))
1098 \textcolor{keywordflow}{    enddo}
1099 
1100 
1101 \textcolor{keywordflow}{  endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} \textcolor{comment}{! i- & j- loops over meridional faces.}
1102 
1103 \textcolor{comment}{! The tracer-specific calculations start here.}
1104 
1105   \textcolor{comment}{! Zero out tracer tendencies.}
1106   \textcolor{keywordflow}{do} k=1,pemax\_krho ; \textcolor{keywordflow}{do} j=js-1,je+1 ; \textcolor{keywordflow}{do} i=is-1,ie+1
1107     tr\_flux\_conv(i,j,k) = 0.0
1108 \textcolor{keywordflow}{  enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo}
1109 
1110   \textcolor{keywordflow}{do} itt=1,max\_itt
1111 
1112     \textcolor{keywordflow}{if} (itt > 1) \textcolor{keywordflow}{then} \textcolor{comment}{! The halos have already been filled if itt==1.}
1113       \textcolor{keyword}{call }do\_group\_pass(cs%pass\_t, g%Domain, clock=id\_clock\_pass)
1114 \textcolor{keywordflow}{    endif}
1115 
1116     \textcolor{keywordflow}{do} m=1,ntr
1117 \textcolor{comment}{!$OMP parallel do default(none) shared(is,ie,js,je,G,Tr,nkmb,nPu,m,max\_kRho,nz,h,h\_exclude, &}
1118 \textcolor{comment}{!$OMP                                  k0b\_Lu,k0b\_Ru,deep\_wt\_Lu,k0a\_Lu,deep\_wt\_Ru,k0a\_Ru,   &}
1119 \textcolor{comment}{!$OMP                                  hP\_Lu,hP\_Ru,I\_maxitt,khdt\_epi\_x,tr\_flux\_conv,Idt) &}
1120 \textcolor{comment}{!$OMP                          private(Tr\_min\_face,Tr\_max\_face,kLa,kLb,kRa,kRb,Tr\_La, &}
1121 \textcolor{comment}{!$OMP                                     Tr\_Lb,Tr\_Ra,Tr\_Rb,Tr\_av\_L,wt\_b,Tr\_av\_R,h\_L,h\_R, &}
1122 \textcolor{comment}{!$OMP                                     Tr\_flux,Tr\_adj\_vert,wt\_a,vol)}
1123       \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; \textcolor{keywordflow}{if} (g%mask2dCu(i,j) > 0.5) \textcolor{keywordflow}{then}
1124         \textcolor{comment}{! Determine the fluxes through the zonal faces.}
1125 
1126         \textcolor{comment}{! Find the acceptable range of tracer concentration around this face.}
1127         \textcolor{keywordflow}{if} (npu(i,j) >= 1) \textcolor{keywordflow}{then}
1128           tr\_min\_face = min(tr(m)%t(i,j,1), tr(m)%t(i+1,j,1))
1129           tr\_max\_face = max(tr(m)%t(i,j,1), tr(m)%t(i+1,j,1))
1130           \textcolor{keywordflow}{do} k=2,nkmb
1131             tr\_min\_face = min(tr\_min\_face, tr(m)%t(i,j,k), tr(m)%t(i+1,j,k))
1132             tr\_max\_face = max(tr\_max\_face, tr(m)%t(i,j,k), tr(m)%t(i+1,j,k))
1133 \textcolor{keywordflow}{          enddo}
1134 
1135           \textcolor{comment}{! Include the next two layers denser than the densest buffer layer.}
1136           kla = nkmb+1 ; \textcolor{keywordflow}{if} (max\_krho(i,j) < nz+1) kla = max\_krho(i,j)
1137           klb = kla ; \textcolor{keywordflow}{if} (max\_krho(i,j) < nz) klb = max\_krho(i,j)+1
1138           kra = nkmb+1 ; \textcolor{keywordflow}{if} (max\_krho(i+1,j) < nz+1) kra = max\_krho(i+1,j)
1139           krb = kra ; \textcolor{keywordflow}{if} (max\_krho(i+1,j) < nz) krb = max\_krho(i+1,j)+1
1140           tr\_la = tr\_min\_face ; tr\_lb = tr\_la ; tr\_ra = tr\_la ; tr\_rb = tr\_la
1141           \textcolor{keywordflow}{if} (h(i,j,kla) > h\_exclude) tr\_la = tr(m)%t(i,j,kla)
1142           \textcolor{keywordflow}{if} (h(i,j,klb) > h\_exclude) tr\_la = tr(m)%t(i,j,klb)
1143           \textcolor{keywordflow}{if} (h(i+1,j,kra) > h\_exclude) tr\_ra = tr(m)%t(i+1,j,kra)
1144           \textcolor{keywordflow}{if} (h(i+1,j,krb) > h\_exclude) tr\_rb = tr(m)%t(i+1,j,krb)
1145           tr\_min\_face = min(tr\_min\_face, tr\_la, tr\_lb, tr\_ra, tr\_rb)
1146           tr\_max\_face = max(tr\_max\_face, tr\_la, tr\_lb, tr\_ra, tr\_rb)
1147 
1148           \textcolor{comment}{! Include all points in diffusive pairings at this face.}
1149           \textcolor{keywordflow}{do} k=1,npu(i,j)
1150             tr\_lb = tr(m)%t(i,j,k0b\_lu(j)%p(i,k))
1151             tr\_rb = tr(m)%t(i+1,j,k0b\_ru(j)%p(i,k))
1152             tr\_la = tr\_lb ; tr\_ra = tr\_rb
1153             \textcolor{keywordflow}{if} (deep\_wt\_lu(j)%p(i,k) < 1.0) tr\_la = tr(m)%t(i,j,k0a\_lu(j)%p(i,k))
1154             \textcolor{keywordflow}{if} (deep\_wt\_ru(j)%p(i,k) < 1.0) tr\_ra = tr(m)%t(i+1,j,k0a\_ru(j)%p(i,k))
1155             tr\_min\_face = min(tr\_min\_face, tr\_la, tr\_lb, tr\_ra, tr\_rb)
1156             tr\_max\_face = max(tr\_max\_face, tr\_la, tr\_lb, tr\_ra, tr\_rb)
1157 \textcolor{keywordflow}{          enddo}
1158 \textcolor{keywordflow}{        endif}
1159 
1160         \textcolor{keywordflow}{do} k=1,npu(i,j)
1161           klb = k0b\_lu(j)%p(i,k) ; tr\_lb = tr(m)%t(i,j,klb) ; tr\_av\_l = tr\_lb
1162           \textcolor{keywordflow}{if} (deep\_wt\_lu(j)%p(i,k) < 1.0) \textcolor{keywordflow}{then}
1163             kla = k0a\_lu(j)%p(i,k) ; tr\_la = tr(m)%t(i,j,kla)
1164             wt\_b = deep\_wt\_lu(j)%p(i,k)
1165             tr\_av\_l = wt\_b*tr\_lb + (1.0-wt\_b)*tr\_la
1166 \textcolor{keywordflow}{          endif}
1167 
1168           krb = k0b\_ru(j)%p(i,k) ; tr\_rb = tr(m)%t(i+1,j,krb) ; tr\_av\_r = tr\_rb
1169           \textcolor{keywordflow}{if} (deep\_wt\_ru(j)%p(i,k) < 1.0) \textcolor{keywordflow}{then}
1170             kra = k0a\_ru(j)%p(i,k) ; tr\_ra = tr(m)%t(i+1,j,kra)
1171             wt\_b = deep\_wt\_ru(j)%p(i,k)
1172             tr\_av\_r = wt\_b*tr\_rb + (1.0-wt\_b)*tr\_ra
1173 \textcolor{keywordflow}{          endif}
1174 
1175           h\_l = hp\_lu(j)%p(i,k) ; h\_r = hp\_ru(j)%p(i,k)
1176           tr\_flux = i\_maxitt * khdt\_epi\_x(i,j) * (tr\_av\_l - tr\_av\_r) * &
1177             ((2.0 * h\_l * h\_r) / (h\_l + h\_r))
1178 
1179 
1180           \textcolor{keywordflow}{if} (deep\_wt\_lu(j)%p(i,k) >= 1.0) \textcolor{keywordflow}{then}
1181             tr\_flux\_conv(i,j,klb) = tr\_flux\_conv(i,j,klb) - tr\_flux
1182           \textcolor{keywordflow}{else}
1183             tr\_adj\_vert = 0.0
1184             wt\_b = deep\_wt\_lu(j)%p(i,k) ; wt\_a = 1.0 - wt\_b
1185             vol = hp\_lu(j)%p(i,k) * g%areaT(i,j)
1186 
1187             \textcolor{comment}{!   Ensure that the tracer flux does not drive the tracer values}
1188             \textcolor{comment}{! outside of the range Tr\_min\_face <= Tr <= Tr\_max\_face, or if it}
1189             \textcolor{comment}{! does that the concentration in both contributing pieces exceed}
1190             \textcolor{comment}{! this range equally. With down-gradient fluxes and the initial tracer}
1191             \textcolor{comment}{! concentrations determining the valid range, the latter condition}
1192             \textcolor{comment}{! only enters for large values of the effective diffusive CFL number.}
1193             \textcolor{keywordflow}{if} (tr\_flux > 0.0) \textcolor{keywordflow}{then}
1194               \textcolor{keywordflow}{if} (tr\_la < tr\_lb) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (vol*(tr\_la-tr\_min\_face) < tr\_flux) &
1195                 tr\_adj\_vert = -wt\_a * min(tr\_flux - vol * (tr\_la-tr\_min\_face), &
1196                                           (vol*wt\_b) * (tr\_lb - tr\_la))
1197               \textcolor{keywordflow}{else} ; \textcolor{keywordflow}{if} (vol*(tr\_lb-tr\_min\_face) < tr\_flux) &
1198                 tr\_adj\_vert = wt\_b * min(tr\_flux - vol * (tr\_lb-tr\_min\_face), &
1199                                          (vol*wt\_a) * (tr\_la - tr\_lb))
1200 \textcolor{keywordflow}{              endif}
1201             \textcolor{keywordflow}{elseif} (tr\_flux < 0.0) \textcolor{keywordflow}{then}
1202               \textcolor{keywordflow}{if} (tr\_la > tr\_lb) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (vol * (tr\_max\_face-tr\_la) < -tr\_flux) &
1203                 tr\_adj\_vert = wt\_a * min(-tr\_flux - vol * (tr\_max\_face-tr\_la), &
1204                                          (vol*wt\_b) * (tr\_la - tr\_lb))
1205               \textcolor{keywordflow}{else} ; \textcolor{keywordflow}{if} (vol*(tr\_max\_face-tr\_lb) < -tr\_flux) &
1206                 tr\_adj\_vert = -wt\_b * min(-tr\_flux - vol * (tr\_max\_face-tr\_lb), &
1207                                           (vol*wt\_a)*(tr\_lb - tr\_la))
1208 \textcolor{keywordflow}{              endif}
1209 \textcolor{keywordflow}{            endif}
1210 
1211             tr\_flux\_conv(i,j,kla) = tr\_flux\_conv(i,j,kla) - (wt\_a*tr\_flux + tr\_adj\_vert)
1212             tr\_flux\_conv(i,j,klb) = tr\_flux\_conv(i,j,klb) - (wt\_b*tr\_flux - tr\_adj\_vert)
1213 \textcolor{keywordflow}{          endif}
1214 
1215           \textcolor{keywordflow}{if} (deep\_wt\_ru(j)%p(i,k) >= 1.0) \textcolor{keywordflow}{then}
1216             tr\_flux\_conv(i+1,j,krb) = tr\_flux\_conv(i+1,j,krb) + tr\_flux
1217           \textcolor{keywordflow}{else}
1218             tr\_adj\_vert = 0.0
1219             wt\_b = deep\_wt\_ru(j)%p(i,k) ; wt\_a = 1.0 - wt\_b
1220             vol = hp\_ru(j)%p(i,k) * g%areaT(i+1,j)
1221 
1222             \textcolor{comment}{!   Ensure that the tracer flux does not drive the tracer values}
1223             \textcolor{comment}{! outside of the range Tr\_min\_face <= Tr <= Tr\_max\_face, or if it}
1224             \textcolor{comment}{! does that the concentration in both contributing pieces exceed}
1225             \textcolor{comment}{! this range equally. With down-gradient fluxes and the initial tracer}
1226             \textcolor{comment}{! concentrations determining the valid range, the latter condition}
1227             \textcolor{comment}{! only enters for large values of the effective diffusive CFL number.}
1228             \textcolor{keywordflow}{if} (tr\_flux < 0.0) \textcolor{keywordflow}{then}
1229               \textcolor{keywordflow}{if} (tr\_ra < tr\_rb) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (vol * (tr\_ra-tr\_min\_face) < -tr\_flux) &
1230                 tr\_adj\_vert = -wt\_a * min(-tr\_flux - vol * (tr\_ra-tr\_min\_face), &
1231                                           (vol*wt\_b) * (tr\_rb - tr\_ra))
1232               \textcolor{keywordflow}{else} ; \textcolor{keywordflow}{if} (vol*(tr\_rb-tr\_min\_face) < (-tr\_flux)) &
1233                 tr\_adj\_vert = wt\_b * min(-tr\_flux - vol * (tr\_rb-tr\_min\_face), &
1234                                          (vol*wt\_a) * (tr\_ra - tr\_rb))
1235 \textcolor{keywordflow}{              endif}
1236             \textcolor{keywordflow}{elseif} (tr\_flux > 0.0) \textcolor{keywordflow}{then}
1237               \textcolor{keywordflow}{if} (tr\_ra > tr\_rb) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (vol * (tr\_max\_face-tr\_ra) < tr\_flux) &
1238                 tr\_adj\_vert = wt\_a * min(tr\_flux - vol * (tr\_max\_face-tr\_ra), &
1239                                          (vol*wt\_b) * (tr\_ra - tr\_rb))
1240               \textcolor{keywordflow}{else} ; \textcolor{keywordflow}{if} (vol*(tr\_max\_face-tr\_rb) < tr\_flux) &
1241                 tr\_adj\_vert = -wt\_b * min(tr\_flux - vol * (tr\_max\_face-tr\_rb), &
1242                                           (vol*wt\_a)*(tr\_rb - tr\_ra))
1243 \textcolor{keywordflow}{              endif}
1244 \textcolor{keywordflow}{            endif}
1245 
1246             tr\_flux\_conv(i+1,j,kra) = tr\_flux\_conv(i+1,j,kra) + &
1247                                             (wt\_a*tr\_flux - tr\_adj\_vert)
1248             tr\_flux\_conv(i+1,j,krb) = tr\_flux\_conv(i+1,j,krb) + &
1249                                             (wt\_b*tr\_flux + tr\_adj\_vert)
1250 \textcolor{keywordflow}{          endif}
1251           \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(tr(m)%df2d\_x)) &
1252             tr(m)%df2d\_x(i,j) = tr(m)%df2d\_x(i,j) + tr\_flux * idt
1253 \textcolor{keywordflow}{        enddo} \textcolor{comment}{! Loop over pairings at faces.}
1254 \textcolor{keywordflow}{      endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} \textcolor{comment}{! i- & j- loops over zonal faces.}
1255 
1256 \textcolor{comment}{!$OMP parallel do default(none) shared(is,ie,js,je,G,Tr,nkmb,nPv,m,max\_kRho,nz,h,h\_exclude, &}
1257 \textcolor{comment}{!$OMP                                  k0b\_Lv,k0b\_Rv,deep\_wt\_Lv,k0a\_Lv,deep\_wt\_Rv,k0a\_Rv,   &}
1258 \textcolor{comment}{!$OMP                                  hP\_Lv,hP\_Rv,I\_maxitt,khdt\_epi\_y,Tr\_flux\_3d,          &}
1259 \textcolor{comment}{!$OMP                                  Tr\_adj\_vert\_L,Tr\_adj\_vert\_R,Idt)                     &}
1260 \textcolor{comment}{!$OMP                          private(Tr\_min\_face,Tr\_max\_face,kLa,kLb,kRa,kRb,             &}
1261 \textcolor{comment}{!$OMP                                  Tr\_La,Tr\_Lb,Tr\_Ra,Tr\_Rb,Tr\_av\_L,wt\_b,Tr\_av\_R,        &}
1262 \textcolor{comment}{!$OMP                                  h\_L,h\_R,Tr\_flux,Tr\_adj\_vert,wt\_a,vol)}
1263       \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; \textcolor{keywordflow}{if} (g%mask2dCv(i,j) > 0.5) \textcolor{keywordflow}{then}
1264         \textcolor{comment}{! Determine the fluxes through the meridional faces.}
1265 
1266         \textcolor{comment}{! Find the acceptable range of tracer concentration around this face.}
1267         \textcolor{keywordflow}{if} (npv(i,j) >= 1) \textcolor{keywordflow}{then}
1268           tr\_min\_face = min(tr(m)%t(i,j,1), tr(m)%t(i,j+1,1))
1269           tr\_max\_face = max(tr(m)%t(i,j,1), tr(m)%t(i,j+1,1))
1270           \textcolor{keywordflow}{do} k=2,nkmb
1271             tr\_min\_face = min(tr\_min\_face, tr(m)%t(i,j,k), tr(m)%t(i,j+1,k))
1272             tr\_max\_face = max(tr\_max\_face, tr(m)%t(i,j,k), tr(m)%t(i,j+1,k))
1273 \textcolor{keywordflow}{          enddo}
1274 
1275           \textcolor{comment}{! Include the next two layers denser than the densest buffer layer.}
1276           kla = nkmb+1 ; \textcolor{keywordflow}{if} (max\_krho(i,j) < nz+1) kla = max\_krho(i,j)
1277           klb = kla ; \textcolor{keywordflow}{if} (max\_krho(i,j) < nz) klb = max\_krho(i,j)+1
1278           kra = nkmb+1 ; \textcolor{keywordflow}{if} (max\_krho(i,j+1) < nz+1) kra = max\_krho(i,j+1)
1279           krb = kra ; \textcolor{keywordflow}{if} (max\_krho(i,j+1) < nz) krb = max\_krho(i,j+1)+1
1280           tr\_la = tr\_min\_face ; tr\_lb = tr\_la ; tr\_ra = tr\_la ; tr\_rb = tr\_la
1281           \textcolor{keywordflow}{if} (h(i,j,kla) > h\_exclude) tr\_la = tr(m)%t(i,j,kla)
1282           \textcolor{keywordflow}{if} (h(i,j,klb) > h\_exclude) tr\_la = tr(m)%t(i,j,klb)
1283           \textcolor{keywordflow}{if} (h(i,j+1,kra) > h\_exclude) tr\_ra = tr(m)%t(i,j+1,kra)
1284           \textcolor{keywordflow}{if} (h(i,j+1,krb) > h\_exclude) tr\_rb = tr(m)%t(i,j+1,krb)
1285           tr\_min\_face = min(tr\_min\_face, tr\_la, tr\_lb, tr\_ra, tr\_rb)
1286           tr\_max\_face = max(tr\_max\_face, tr\_la, tr\_lb, tr\_ra, tr\_rb)
1287 
1288           \textcolor{comment}{! Include all points in diffusive pairings at this face.}
1289           \textcolor{keywordflow}{do} k=1,npv(i,j)
1290             tr\_lb = tr(m)%t(i,j,k0b\_lv(j)%p(i,k)) ; tr\_rb = tr(m)%t(i,j+1,k0b\_rv(j)%p(i,k))
1291             tr\_la = tr\_lb ; tr\_ra = tr\_rb
1292             \textcolor{keywordflow}{if} (deep\_wt\_lv(j)%p(i,k) < 1.0) tr\_la = tr(m)%t(i,j,k0a\_lv(j)%p(i,k))
1293             \textcolor{keywordflow}{if} (deep\_wt\_rv(j)%p(i,k) < 1.0) tr\_ra = tr(m)%t(i,j+1,k0a\_rv(j)%p(i,k))
1294             tr\_min\_face = min(tr\_min\_face, tr\_la, tr\_lb, tr\_ra, tr\_rb)
1295             tr\_max\_face = max(tr\_max\_face, tr\_la, tr\_lb, tr\_ra, tr\_rb)
1296 \textcolor{keywordflow}{          enddo}
1297 \textcolor{keywordflow}{        endif}
1298 
1299         \textcolor{keywordflow}{do} k=1,npv(i,j)
1300           klb = k0b\_lv(j)%p(i,k) ; tr\_lb = tr(m)%t(i,j,klb) ; tr\_av\_l = tr\_lb
1301           \textcolor{keywordflow}{if} (deep\_wt\_lv(j)%p(i,k) < 1.0) \textcolor{keywordflow}{then}
1302             kla = k0a\_lv(j)%p(i,k) ; tr\_la = tr(m)%t(i,j,kla)
1303             wt\_b = deep\_wt\_lv(j)%p(i,k)
1304             tr\_av\_l = wt\_b * tr\_lb + (1.0-wt\_b) * tr\_la
1305 \textcolor{keywordflow}{          endif}
1306 
1307           krb = k0b\_rv(j)%p(i,k) ; tr\_rb = tr(m)%t(i,j+1,krb) ; tr\_av\_r = tr\_rb
1308           \textcolor{keywordflow}{if} (deep\_wt\_rv(j)%p(i,k) < 1.0) \textcolor{keywordflow}{then}
1309             kra = k0a\_rv(j)%p(i,k) ; tr\_ra = tr(m)%t(i,j+1,kra)
1310             wt\_b = deep\_wt\_rv(j)%p(i,k)
1311             tr\_av\_r = wt\_b * tr\_rb + (1.0-wt\_b) * tr\_ra
1312 \textcolor{keywordflow}{          endif}
1313 
1314           h\_l = hp\_lv(j)%p(i,k) ; h\_r = hp\_rv(j)%p(i,k)
1315           tr\_flux = i\_maxitt * ((2.0 * h\_l * h\_r) / (h\_l + h\_r)) * &
1316                     khdt\_epi\_y(i,j) * (tr\_av\_l - tr\_av\_r)
1317           tr\_flux\_3d(i,j,k) = tr\_flux
1318 
1319           \textcolor{keywordflow}{if} (deep\_wt\_lv(j)%p(i,k) < 1.0) \textcolor{keywordflow}{then}
1320             tr\_adj\_vert = 0.0
1321             wt\_b = deep\_wt\_lv(j)%p(i,k) ; wt\_a = 1.0 - wt\_b
1322             vol = hp\_lv(j)%p(i,k) * g%areaT(i,j)
1323 
1324             \textcolor{comment}{!   Ensure that the tracer flux does not drive the tracer values}
1325             \textcolor{comment}{! outside of the range Tr\_min\_face <= Tr <= Tr\_max\_face.}
1326             \textcolor{keywordflow}{if} (tr\_flux > 0.0) \textcolor{keywordflow}{then}
1327               \textcolor{keywordflow}{if} (tr\_la < tr\_lb) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (vol * (tr\_la-tr\_min\_face) < tr\_flux) &
1328                 tr\_adj\_vert = -wt\_a * min(tr\_flux - vol * (tr\_la-tr\_min\_face), &
1329                                           (vol*wt\_b) * (tr\_lb - tr\_la))
1330               \textcolor{keywordflow}{else} ; \textcolor{keywordflow}{if} (vol*(tr\_lb-tr\_min\_face) < tr\_flux) &
1331                 tr\_adj\_vert = wt\_b * min(tr\_flux - vol * (tr\_lb-tr\_min\_face), &
1332                                          (vol*wt\_a) * (tr\_la - tr\_lb))
1333 \textcolor{keywordflow}{              endif}
1334             \textcolor{keywordflow}{elseif} (tr\_flux < 0.0) \textcolor{keywordflow}{then}
1335               \textcolor{keywordflow}{if} (tr\_la > tr\_lb) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (vol * (tr\_max\_face-tr\_la) < -tr\_flux) &
1336                 tr\_adj\_vert = wt\_a * min(-tr\_flux - vol * (tr\_max\_face-tr\_la), &
1337                                          (vol*wt\_b) * (tr\_la - tr\_lb))
1338               \textcolor{keywordflow}{else} ; \textcolor{keywordflow}{if} (vol*(tr\_max\_face-tr\_lb) < -tr\_flux) &
1339                 tr\_adj\_vert = -wt\_b * min(-tr\_flux - vol * (tr\_max\_face-tr\_lb), &
1340                                           (vol*wt\_a)*(tr\_lb - tr\_la))
1341 \textcolor{keywordflow}{              endif}
1342 \textcolor{keywordflow}{            endif}
1343             tr\_adj\_vert\_l(i,j,k) = tr\_adj\_vert
1344 \textcolor{keywordflow}{          endif}
1345 
1346           \textcolor{keywordflow}{if} (deep\_wt\_rv(j)%p(i,k) < 1.0) \textcolor{keywordflow}{then}
1347             tr\_adj\_vert = 0.0
1348             wt\_b = deep\_wt\_rv(j)%p(i,k) ; wt\_a = 1.0 - wt\_b
1349             vol = hp\_rv(j)%p(i,k) * g%areaT(i,j+1)
1350 
1351             \textcolor{comment}{!   Ensure that the tracer flux does not drive the tracer values}
1352             \textcolor{comment}{! outside of the range Tr\_min\_face <= Tr <= Tr\_max\_face.}
1353             \textcolor{keywordflow}{if} (tr\_flux < 0.0) \textcolor{keywordflow}{then}
1354               \textcolor{keywordflow}{if} (tr\_ra < tr\_rb) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (vol * (tr\_ra-tr\_min\_face) < -tr\_flux) &
1355                 tr\_adj\_vert = -wt\_a * min(-tr\_flux - vol * (tr\_ra-tr\_min\_face), &
1356                                           (vol*wt\_b) * (tr\_rb - tr\_ra))
1357               \textcolor{keywordflow}{else} ; \textcolor{keywordflow}{if} (vol*(tr\_rb-tr\_min\_face) < (-tr\_flux)) &
1358                 tr\_adj\_vert = wt\_b * min(-tr\_flux - vol * (tr\_rb-tr\_min\_face), &
1359                                          (vol*wt\_a) * (tr\_ra - tr\_rb))
1360 \textcolor{keywordflow}{              endif}
1361             \textcolor{keywordflow}{elseif} (tr\_flux > 0.0) \textcolor{keywordflow}{then}
1362               \textcolor{keywordflow}{if} (tr\_ra > tr\_rb) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (vol * (tr\_max\_face-tr\_ra) < tr\_flux) &
1363                 tr\_adj\_vert = wt\_a * min(tr\_flux - vol * (tr\_max\_face-tr\_ra), &
1364                                          (vol*wt\_b) * (tr\_ra - tr\_rb))
1365               \textcolor{keywordflow}{else} ; \textcolor{keywordflow}{if} (vol*(tr\_max\_face-tr\_rb) < tr\_flux) &
1366                 tr\_adj\_vert = -wt\_b * min(tr\_flux - vol * (tr\_max\_face-tr\_rb), &
1367                                           (vol*wt\_a)*(tr\_rb - tr\_ra))
1368 \textcolor{keywordflow}{              endif}
1369 \textcolor{keywordflow}{            endif}
1370             tr\_adj\_vert\_r(i,j,k) = tr\_adj\_vert
1371 \textcolor{keywordflow}{          endif}
1372           \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(tr(m)%df2d\_y)) &
1373             tr(m)%df2d\_y(i,j) = tr(m)%df2d\_y(i,j) + tr\_flux * idt
1374 \textcolor{keywordflow}{        enddo} \textcolor{comment}{! Loop over pairings at faces.}
1375 \textcolor{keywordflow}{      endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} \textcolor{comment}{! i- & j- loops over meridional faces.}
1376 \textcolor{comment}{!$OMP parallel do default(none) shared(is,ie,js,je,G,nPv,k0b\_Lv,k0b\_Rv,deep\_wt\_Lv,  &}
1377 \textcolor{comment}{!$OMP                                  tr\_flux\_conv,Tr\_flux\_3d,k0a\_Lv,Tr\_adj\_vert\_L,&}
1378 \textcolor{comment}{!$OMP                                  deep\_wt\_Rv,k0a\_Rv,Tr\_adj\_vert\_R) &}
1379 \textcolor{comment}{!$OMP                          private(kLa,kLb,kRa,kRb,wt\_b,wt\_a)}
1380       \textcolor{keywordflow}{do} i=is,ie ; \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{if} (g%mask2dCv(i,j) > 0.5) \textcolor{keywordflow}{then}
1381         \textcolor{keywordflow}{do} k=1,npv(i,j)
1382           klb = k0b\_lv(j)%p(i,k); krb = k0b\_rv(j)%p(i,k)
1383           \textcolor{keywordflow}{if} (deep\_wt\_lv(j)%p(i,k) >= 1.0) \textcolor{keywordflow}{then}
1384             tr\_flux\_conv(i,j,klb) = tr\_flux\_conv(i,j,klb) - tr\_flux\_3d(i,j,k)
1385           \textcolor{keywordflow}{else}
1386             kla = k0a\_lv(j)%p(i,k)
1387             wt\_b = deep\_wt\_lv(j)%p(i,k) ; wt\_a = 1.0 - wt\_b
1388             tr\_flux\_conv(i,j,kla) = tr\_flux\_conv(i,j,kla) - (wt\_a*tr\_flux\_3d(i,j,k) + tr\_adj\_vert\_l(i,j,k))
1389             tr\_flux\_conv(i,j,klb) = tr\_flux\_conv(i,j,klb) - (wt\_b*tr\_flux\_3d(i,j,k) - tr\_adj\_vert\_l(i,j,k))
1390 \textcolor{keywordflow}{          endif}
1391           \textcolor{keywordflow}{if} (deep\_wt\_rv(j)%p(i,k) >= 1.0) \textcolor{keywordflow}{then}
1392             tr\_flux\_conv(i,j+1,krb) = tr\_flux\_conv(i,j+1,krb) + tr\_flux\_3d(i,j,k)
1393           \textcolor{keywordflow}{else}
1394             kra = k0a\_rv(j)%p(i,k)
1395             wt\_b = deep\_wt\_rv(j)%p(i,k) ; wt\_a = 1.0 - wt\_b
1396             tr\_flux\_conv(i,j+1,kra) = tr\_flux\_conv(i,j+1,kra) + &
1397                                             (wt\_a*tr\_flux\_3d(i,j,k) - tr\_adj\_vert\_r(i,j,k))
1398             tr\_flux\_conv(i,j+1,krb) = tr\_flux\_conv(i,j+1,krb) + &
1399                                             (wt\_b*tr\_flux\_3d(i,j,k) + tr\_adj\_vert\_r(i,j,k))
1400 \textcolor{keywordflow}{          endif}
1401 \textcolor{keywordflow}{        enddo}
1402 \textcolor{keywordflow}{      endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo}
1403 \textcolor{comment}{!$OMP parallel do default(none) shared(PEmax\_kRho,is,ie,js,je,G,h,Tr,tr\_flux\_conv,m)}
1404       \textcolor{keywordflow}{do} k=1,pemax\_krho ; \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie
1405         \textcolor{keywordflow}{if} ((g%mask2dT(i,j) > 0.5) .and. (h(i,j,k) > 0.0)) \textcolor{keywordflow}{then}
1406           tr(m)%t(i,j,k) = tr(m)%t(i,j,k) + tr\_flux\_conv(i,j,k) / &
1407                                             (h(i,j,k)*g%areaT(i,j))
1408           tr\_flux\_conv(i,j,k) = 0.0
1409 \textcolor{keywordflow}{        endif}
1410 \textcolor{keywordflow}{      enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo}
1411 
1412 \textcolor{keywordflow}{    enddo} \textcolor{comment}{! Loop over tracers}
1413 \textcolor{keywordflow}{  enddo} \textcolor{comment}{! Loop over iterations}
1414 
1415   \textcolor{keywordflow}{do} j=js,je
1416     \textcolor{keyword}{deallocate}(deep\_wt\_lu(j)%p) ; \textcolor{keyword}{deallocate}(deep\_wt\_ru(j)%p)
1417     \textcolor{keyword}{deallocate}(hp\_lu(j)%p)  ; \textcolor{keyword}{deallocate}(hp\_ru(j)%p)
1418     \textcolor{keyword}{deallocate}(k0a\_lu(j)%p) ; \textcolor{keyword}{deallocate}(k0a\_ru(j)%p)
1419     \textcolor{keyword}{deallocate}(k0b\_lu(j)%p) ; \textcolor{keyword}{deallocate}(k0b\_ru(j)%p)
1420 \textcolor{keywordflow}{  enddo}
1421 
1422   \textcolor{keywordflow}{do} j=js-1,je
1423     \textcolor{keyword}{deallocate}(deep\_wt\_lv(j)%p) ; \textcolor{keyword}{deallocate}(deep\_wt\_rv(j)%p)
1424     \textcolor{keyword}{deallocate}(hp\_lv(j)%p)  ; \textcolor{keyword}{deallocate}(hp\_rv(j)%p)
1425     \textcolor{keyword}{deallocate}(k0a\_lv(j)%p) ; \textcolor{keyword}{deallocate}(k0a\_rv(j)%p)
1426     \textcolor{keyword}{deallocate}(k0b\_lv(j)%p) ; \textcolor{keyword}{deallocate}(k0b\_rv(j)%p)
1427 \textcolor{keywordflow}{  enddo}
1428 
\end{DoxyCode}
\mbox{\Hypertarget{namespacemom__tracer__hor__diff_a715439f7286842d78d2ce52b7e5371a4}\label{namespacemom__tracer__hor__diff_a715439f7286842d78d2ce52b7e5371a4}} 
\index{mom\+\_\+tracer\+\_\+hor\+\_\+diff@{mom\+\_\+tracer\+\_\+hor\+\_\+diff}!tracer\+\_\+hor\+\_\+diff\+\_\+end@{tracer\+\_\+hor\+\_\+diff\+\_\+end}}
\index{tracer\+\_\+hor\+\_\+diff\+\_\+end@{tracer\+\_\+hor\+\_\+diff\+\_\+end}!mom\+\_\+tracer\+\_\+hor\+\_\+diff@{mom\+\_\+tracer\+\_\+hor\+\_\+diff}}
\subsubsection{\texorpdfstring{tracer\+\_\+hor\+\_\+diff\+\_\+end()}{tracer\_hor\_diff\_end()}}
{\footnotesize\ttfamily subroutine, public mom\+\_\+tracer\+\_\+hor\+\_\+diff\+::tracer\+\_\+hor\+\_\+diff\+\_\+end (\begin{DoxyParamCaption}\item[{type(\hyperlink{structmom__tracer__hor__diff_1_1tracer__hor__diff__cs}{tracer\+\_\+hor\+\_\+diff\+\_\+cs}), pointer}]{CS }\end{DoxyParamCaption})}


\begin{DoxyParams}{Parameters}
{\em cs} & module control structure \\
\hline
\end{DoxyParams}


Definition at line 1554 of file M\+O\+M\+\_\+tracer\+\_\+hor\+\_\+diff.\+F90.


\begin{DoxyCode}
1554   \textcolor{keywordtype}{type}(tracer\_hor\_diff\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< module control structure}
1555 
1556   \textcolor{keyword}{call }neutral\_diffusion\_end(cs%neutral\_diffusion\_CSp)
1557   \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(cs)) \textcolor{keyword}{deallocate}(cs)
1558 
\end{DoxyCode}
\mbox{\Hypertarget{namespacemom__tracer__hor__diff_a87eed0408da0c4732372732b34451b73}\label{namespacemom__tracer__hor__diff_a87eed0408da0c4732372732b34451b73}} 
\index{mom\+\_\+tracer\+\_\+hor\+\_\+diff@{mom\+\_\+tracer\+\_\+hor\+\_\+diff}!tracer\+\_\+hor\+\_\+diff\+\_\+init@{tracer\+\_\+hor\+\_\+diff\+\_\+init}}
\index{tracer\+\_\+hor\+\_\+diff\+\_\+init@{tracer\+\_\+hor\+\_\+diff\+\_\+init}!mom\+\_\+tracer\+\_\+hor\+\_\+diff@{mom\+\_\+tracer\+\_\+hor\+\_\+diff}}
\subsubsection{\texorpdfstring{tracer\+\_\+hor\+\_\+diff\+\_\+init()}{tracer\_hor\_diff\_init()}}
{\footnotesize\ttfamily subroutine, public mom\+\_\+tracer\+\_\+hor\+\_\+diff\+::tracer\+\_\+hor\+\_\+diff\+\_\+init (\begin{DoxyParamCaption}\item[{type(time\+\_\+type), intent(in), target}]{Time,  }\item[{type(ocean\+\_\+grid\+\_\+type), intent(in)}]{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(eos\+\_\+type), intent(in), target}]{E\+OS,  }\item[{type(diabatic\+\_\+cs), intent(in), pointer}]{diabatic\+\_\+\+C\+Sp,  }\item[{type(\hyperlink{structmom__tracer__hor__diff_1_1tracer__hor__diff__cs}{tracer\+\_\+hor\+\_\+diff\+\_\+cs}), pointer}]{CS }\end{DoxyParamCaption})}



Initialize lateral tracer diffusion module. 


\begin{DoxyParams}[1]{Parameters}
\mbox{\tt in}  & {\em time} & current model time\\
\hline
\mbox{\tt in}  & {\em g} & ocean grid structure\\
\hline
\mbox{\tt in}  & {\em us} & A dimensional unit scaling type\\
\hline
\mbox{\tt in,out}  & {\em diag} & diagnostic control\\
\hline
\mbox{\tt in}  & {\em eos} & Equation of state CS\\
\hline
\mbox{\tt in}  & {\em diabatic\+\_\+csp} & Equation of state CS\\
\hline
\mbox{\tt in}  & {\em param\+\_\+file} & parameter file\\
\hline
 & {\em cs} & horz diffusion control structure \\
\hline
\end{DoxyParams}


Definition at line 1434 of file M\+O\+M\+\_\+tracer\+\_\+hor\+\_\+diff.\+F90.


\begin{DoxyCode}
1434   \textcolor{keywordtype}{type}(time\_type), \textcolor{keywordtype}{target},    \textcolor{keywordtype}{intent(in)}    :: time\textcolor{comment}{       !< current model time}
1435   \textcolor{keywordtype}{type}(ocean\_grid\_type),      \textcolor{keywordtype}{intent(in)}    :: g\textcolor{comment}{          !< ocean grid structure}
1436   \textcolor{keywordtype}{type}(unit\_scale\_type),      \textcolor{keywordtype}{intent(in)}    :: us\textcolor{comment}{         !< A dimensional unit scaling type}
1437   \textcolor{keywordtype}{type}(diag\_ctrl), \textcolor{keywordtype}{target},    \textcolor{keywordtype}{intent(inout)} :: diag\textcolor{comment}{       !< diagnostic control}
1438   \textcolor{keywordtype}{type}(eos\_type),  \textcolor{keywordtype}{target},    \textcolor{keywordtype}{intent(in)}    :: eos\textcolor{comment}{        !< Equation of state CS}
1439   \textcolor{keywordtype}{type}(diabatic\_cs), \textcolor{keywordtype}{pointer}, \textcolor{keywordtype}{intent(in)}    :: diabatic\_csp\textcolor{comment}{ !< Equation of state CS}
1440   \textcolor{keywordtype}{type}(param\_file\_type),      \textcolor{keywordtype}{intent(in)}    :: param\_file\textcolor{comment}{ !< parameter file}
1441   \textcolor{keywordtype}{type}(tracer\_hor\_diff\_cs),   \textcolor{keywordtype}{pointer}       :: cs\textcolor{comment}{         !< horz diffusion control structure}
1442 
1443 \textcolor{comment}{! This include declares and sets the variable "version".}
1444 \textcolor{preprocessor}{#include "version\_variable.h"}
1445 \textcolor{preprocessor}{}  \textcolor{keywordtype}{character(len=40)}  :: mdl = \textcolor{stringliteral}{"MOM\_tracer\_hor\_diff"} \textcolor{comment}{! This module's name.}
1446   \textcolor{keywordtype}{character(len=256)} :: mesg    \textcolor{comment}{! Message for error messages.}
1447 
1448   \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(cs)) \textcolor{keywordflow}{then}
1449     \textcolor{keyword}{call }mom\_error(warning, \textcolor{stringliteral}{"tracer\_hor\_diff\_init called with associated control structure."})
1450     \textcolor{keywordflow}{return}
1451 \textcolor{keywordflow}{  endif}
1452   \textcolor{keyword}{allocate}(cs)
1453 
1454   cs%diag => diag
1455   cs%show\_call\_tree = calltree\_showquery()
1456 
1457   \textcolor{comment}{! Read all relevant parameters and write them to the model log.}
1458   \textcolor{keyword}{call }log\_version(param\_file, mdl, version, \textcolor{stringliteral}{""})
1459   \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"KHTR"}, cs%KhTr, &
1460                  \textcolor{stringliteral}{"The background along-isopycnal tracer diffusivity."}, &
1461                  units=\textcolor{stringliteral}{"m2 s-1"}, default=0.0, scale=us%m\_to\_L**2*us%T\_to\_s)
1462   \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"KHTR\_SLOPE\_CFF"}, cs%KhTr\_Slope\_Cff, &
1463                  \textcolor{stringliteral}{"The scaling coefficient for along-isopycnal tracer "}//&
1464                  \textcolor{stringliteral}{"diffusivity using a shear-based (Visbeck-like) "}//&
1465                  \textcolor{stringliteral}{"parameterization.  A non-zero value enables this param."}, &
1466                  units=\textcolor{stringliteral}{"nondim"}, default=0.0)
1467   \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"KHTR\_MIN"}, cs%KhTr\_Min, &
1468                  \textcolor{stringliteral}{"The minimum along-isopycnal tracer diffusivity."}, &
1469                  units=\textcolor{stringliteral}{"m2 s-1"}, default=0.0, scale=us%m\_to\_L**2*us%T\_to\_s)
1470   \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"KHTR\_MAX"}, cs%KhTr\_Max, &
1471                  \textcolor{stringliteral}{"The maximum along-isopycnal tracer diffusivity."}, &
1472                  units=\textcolor{stringliteral}{"m2 s-1"}, default=0.0, scale=us%m\_to\_L**2*us%T\_to\_s)
1473   \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"KHTR\_PASSIVITY\_COEFF"}, cs%KhTr\_passivity\_coeff, &
1474                  \textcolor{stringliteral}{"The coefficient that scales deformation radius over "}//&
1475                  \textcolor{stringliteral}{"grid-spacing in passivity, where passivity is the ratio "}//&
1476                  \textcolor{stringliteral}{"between along isopycnal mixing of tracers to thickness mixing. "}//&
1477                  \textcolor{stringliteral}{"A non-zero value enables this parameterization."}, &
1478                  units=\textcolor{stringliteral}{"nondim"}, default=0.0)
1479   \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"KHTR\_PASSIVITY\_MIN"}, cs%KhTr\_passivity\_min, &
1480                  \textcolor{stringliteral}{"The minimum passivity which is the ratio between "}//&
1481                  \textcolor{stringliteral}{"along isopycnal mixing of tracers to thickness mixing."}, &
1482                  units=\textcolor{stringliteral}{"nondim"}, default=0.5)
1483   \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"DIFFUSE\_ML\_TO\_INTERIOR"}, cs%Diffuse\_ML\_interior, &
1484                  \textcolor{stringliteral}{"If true, enable epipycnal mixing between the surface "}//&
1485                  \textcolor{stringliteral}{"boundary layer and the interior."}, default=.false.)
1486   \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"CHECK\_DIFFUSIVE\_CFL"}, cs%check\_diffusive\_CFL, &
1487                  \textcolor{stringliteral}{"If true, use enough iterations the diffusion to ensure "}//&
1488                  \textcolor{stringliteral}{"that the diffusive equivalent of the CFL limit is not "}//&
1489                  \textcolor{stringliteral}{"violated.  If false, always use the greater of 1 or "}//&
1490                  \textcolor{stringliteral}{"MAX\_TR\_DIFFUSION\_CFL iteration."}, default=.false.)
1491   \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"MAX\_TR\_DIFFUSION\_CFL"}, cs%max\_diff\_CFL, &
1492                  \textcolor{stringliteral}{"If positive, locally limit the along-isopycnal tracer "}//&
1493                  \textcolor{stringliteral}{"diffusivity to keep the diffusive CFL locally at or "}//&
1494                  \textcolor{stringliteral}{"below this value.  The number of diffusive iterations "}//&
1495                  \textcolor{stringliteral}{"is often this value or the next greater integer."}, &
1496                  units=\textcolor{stringliteral}{"nondim"}, default=-1.0)
1497   \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"RECALC\_NEUTRAL\_SURF"}, cs%recalc\_neutral\_surf, &
1498                  \textcolor{stringliteral}{"If true, then recalculate the neutral surfaces if the \(\backslash\)n"}//&
1499                  \textcolor{stringliteral}{"diffusive CFL is exceeded. If false, assume that the  \(\backslash\)n"}//&
1500                  \textcolor{stringliteral}{"positions of the surfaces do not change \(\backslash\)n"}, default = .false.)
1501   cs%ML\_KhTR\_scale = 1.0
1502   \textcolor{keywordflow}{if} (cs%Diffuse\_ML\_interior) \textcolor{keywordflow}{then}
1503     \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"ML\_KHTR\_SCALE"}, cs%ML\_KhTR\_scale, &
1504                  \textcolor{stringliteral}{"With Diffuse\_ML\_interior, the ratio of the truly "}//&
1505                  \textcolor{stringliteral}{"horizontal diffusivity in the mixed layer to the "}//&
1506                  \textcolor{stringliteral}{"epipycnal diffusivity.  The valid range is 0 to 1."}, &
1507                  units=\textcolor{stringliteral}{"nondim"}, default=1.0)
1508 \textcolor{keywordflow}{  endif}
1509 
1510   cs%use\_neutral\_diffusion = neutral\_diffusion\_init(time, g, us, param\_file, diag, eos, &
1511                                                     diabatic\_csp, cs%neutral\_diffusion\_CSp )
1512   \textcolor{keywordflow}{if} (cs%use\_neutral\_diffusion .and. cs%Diffuse\_ML\_interior) \textcolor{keyword}{call }mom\_error(fatal, \textcolor{stringliteral}{"MOM\_tracer\_hor\_diff: "}/
      / &
1513        \textcolor{stringliteral}{"USE\_NEUTRAL\_DIFFUSION and DIFFUSE\_ML\_TO\_INTERIOR are mutually exclusive!"})
1514   cs%use\_lateral\_boundary\_diffusion = lateral\_boundary\_diffusion\_init(time, g, param\_file, diag, 
      diabatic\_csp, &
1515                                                                 cs%lateral\_boundary\_diffusion\_CSp)
1516   \textcolor{keywordflow}{if} (cs%use\_neutral\_diffusion .and. cs%Diffuse\_ML\_interior) \textcolor{keyword}{call }mom\_error(fatal, \textcolor{stringliteral}{"MOM\_tracer\_hor\_diff: "}/
      / &
1517        \textcolor{stringliteral}{"USE\_LATERAL\_BOUNDARY\_DIFFUSION and DIFFUSE\_ML\_TO\_INTERIOR are mutually exclusive!"})
1518 
1519   \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"DEBUG"}, cs%debug, default=.false.)
1520 
1521   id\_clock\_diffuse = cpu\_clock\_id(\textcolor{stringliteral}{'(Ocean diffuse tracer)'},          grain=clock\_module)
1522   id\_clock\_epimix  = cpu\_clock\_id(\textcolor{stringliteral}{'(Ocean epipycnal diffuse tracer)'},grain=clock\_module)
1523   id\_clock\_pass    = cpu\_clock\_id(\textcolor{stringliteral}{'(Ocean tracer halo updates)'},     grain=clock\_routine)
1524   id\_clock\_sync    = cpu\_clock\_id(\textcolor{stringliteral}{'(Ocean tracer global synch)'},     grain=clock\_routine)
1525 
1526   cs%id\_KhTr\_u = -1
1527   cs%id\_KhTr\_v = -1
1528   cs%id\_KhTr\_h = -1
1529   cs%id\_CFL    = -1
1530 
1531   cs%id\_KhTr\_u = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'KHTR\_u'}, diag%axesCu1, time, &
1532      \textcolor{stringliteral}{'Epipycnal tracer diffusivity at zonal faces of tracer cell'}, \textcolor{stringliteral}{'m2 s-1'}, conversion=us%L\_to\_m**2*us
      %s\_to\_T)
1533   cs%id\_KhTr\_v = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'KHTR\_v'}, diag%axesCv1, time, &
1534      \textcolor{stringliteral}{'Epipycnal tracer diffusivity at meridional faces of tracer cell'}, \textcolor{stringliteral}{'m2 s-1'}, conversion=us%L\_to\_m**2*
      us%s\_to\_T)
1535   cs%id\_KhTr\_h = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'KHTR\_h'}, diag%axesT1, time, &
1536      \textcolor{stringliteral}{'Epipycnal tracer diffusivity at tracer cell center'}, \textcolor{stringliteral}{'m2 s-1'}, conversion=us%L\_to\_m**2*us%s\_to\_T, &
1537      cmor\_field\_name=\textcolor{stringliteral}{'diftrelo'},                                                &
1538      cmor\_standard\_name= \textcolor{stringliteral}{'ocean\_tracer\_epineutral\_laplacian\_diffusivity'},       &
1539      cmor\_long\_name = \textcolor{stringliteral}{'Ocean Tracer Epineutral Laplacian Diffusivity'})
1540 
1541   cs%id\_khdt\_x = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'KHDT\_x'}, diag%axesCu1, time, &
1542      \textcolor{stringliteral}{'Epipycnal tracer diffusivity operator at zonal faces of tracer cell'}, \textcolor{stringliteral}{'m2'}, conversion=us%L\_to\_m**2)
1543   cs%id\_khdt\_y = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'KHDT\_y'}, diag%axesCv1, time, &
1544      \textcolor{stringliteral}{'Epipycnal tracer diffusivity operator at meridional faces of tracer cell'}, \textcolor{stringliteral}{'m2'}, conversion=us%L\_to\_m
      **2)
1545   \textcolor{keywordflow}{if} (cs%check\_diffusive\_CFL) \textcolor{keywordflow}{then}
1546     cs%id\_CFL = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'CFL\_lateral\_diff'}, diag%axesT1, time,&
1547        \textcolor{stringliteral}{'Grid CFL number for lateral/neutral tracer diffusion'}, \textcolor{stringliteral}{'nondim'})
1548 \textcolor{keywordflow}{  endif}
1549 
1550 
\end{DoxyCode}
\mbox{\Hypertarget{namespacemom__tracer__hor__diff_a098229e37012e7bd93d13036bfc864ac}\label{namespacemom__tracer__hor__diff_a098229e37012e7bd93d13036bfc864ac}} 
\index{mom\+\_\+tracer\+\_\+hor\+\_\+diff@{mom\+\_\+tracer\+\_\+hor\+\_\+diff}!tracer\+\_\+hordiff@{tracer\+\_\+hordiff}}
\index{tracer\+\_\+hordiff@{tracer\+\_\+hordiff}!mom\+\_\+tracer\+\_\+hor\+\_\+diff@{mom\+\_\+tracer\+\_\+hor\+\_\+diff}}
\subsubsection{\texorpdfstring{tracer\+\_\+hordiff()}{tracer\_hordiff()}}
{\footnotesize\ttfamily subroutine, public mom\+\_\+tracer\+\_\+hor\+\_\+diff\+::tracer\+\_\+hordiff (\begin{DoxyParamCaption}\item[{real, dimension( g \%isd\+: g \%ied, g \%jsd\+: g \%jed, g \%ke), intent(in)}]{h,  }\item[{real, intent(in)}]{dt,  }\item[{type(meke\+\_\+type), pointer}]{M\+E\+KE,  }\item[{type(varmix\+\_\+cs), pointer}]{Var\+Mix,  }\item[{type(ocean\+\_\+grid\+\_\+type), intent(inout)}]{G,  }\item[{type(verticalgrid\+\_\+type), intent(in)}]{GV,  }\item[{type(unit\+\_\+scale\+\_\+type), intent(in)}]{US,  }\item[{type(\hyperlink{structmom__tracer__hor__diff_1_1tracer__hor__diff__cs}{tracer\+\_\+hor\+\_\+diff\+\_\+cs}), pointer}]{CS,  }\item[{type(tracer\+\_\+registry\+\_\+type), pointer}]{Reg,  }\item[{type(thermo\+\_\+var\+\_\+ptrs), intent(in)}]{tv,  }\item[{logical, intent(in), optional}]{do\+\_\+online\+\_\+flag,  }\item[{real, dimension( g \%isdb\+: g \%iedb, g \%jsd\+: g \%jed), intent(in), optional}]{read\+\_\+khdt\+\_\+x,  }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsdb\+: g \%jedb), intent(in), optional}]{read\+\_\+khdt\+\_\+y }\end{DoxyParamCaption})}



Compute along-\/coordinate diffusion of all tracers using the diffusivity in CSKh\+Tr, or using space-\/dependent diffusivity. Multiple iterations are used (if necessary) so that there is no limit on the acceptable time increment. 


\begin{DoxyParams}[1]{Parameters}
\mbox{\tt in,out}  & {\em g} & Grid type\\
\hline
\mbox{\tt in}  & {\em h} & Layer thickness \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}\\
\hline
\mbox{\tt in}  & {\em dt} & time step \mbox{[}T $\sim$$>$ s\mbox{]}\\
\hline
 & {\em meke} & M\+E\+KE type\\
\hline
 & {\em varmix} & Variable mixing type\\
\hline
\mbox{\tt in}  & {\em gv} & ocean vertical grid structure\\
\hline
\mbox{\tt in}  & {\em us} & A dimensional unit scaling type\\
\hline
 & {\em cs} & module control structure\\
\hline
 & {\em reg} & registered tracers\\
\hline
\mbox{\tt in}  & {\em tv} & A structure containing pointers to any available thermodynamic fields, including potential temp and salinity or mixed layer density. Absent fields have N\+U\+LL ptrs, and these may (probably will) point to some of the same arrays as Tr does. tv is required for epipycnal mixing between mixed layer and the interior.\\
\hline
\mbox{\tt in}  & {\em do\+\_\+online\+\_\+flag} & If present and true, do online tracer transport with stored velocities.\\
\hline
\mbox{\tt in}  & {\em read\+\_\+khdt\+\_\+x} & If present, these are the zonal\\
\hline
\mbox{\tt in}  & {\em read\+\_\+khdt\+\_\+y} & If present, these are the meridional \\
\hline
\end{DoxyParams}


Definition at line 107 of file M\+O\+M\+\_\+tracer\+\_\+hor\+\_\+diff.\+F90.


\begin{DoxyCode}
107   \textcolor{keywordtype}{type}(ocean\_grid\_type),      \textcolor{keywordtype}{intent(inout)} :: g\textcolor{comment}{       !< Grid type}
108   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G),SZK\_(G))}, &
109                               \textcolor{keywordtype}{intent(in)}    :: h\textcolor{comment}{       !< Layer thickness [H ~> m or kg m-2]}
110   \textcolor{keywordtype}{real},                       \textcolor{keywordtype}{intent(in)}    :: dt\textcolor{comment}{      !< time step [T ~> s]}
111   \textcolor{keywordtype}{type}(meke\_type),            \textcolor{keywordtype}{pointer}       :: meke\textcolor{comment}{    !< MEKE type}
112   \textcolor{keywordtype}{type}(varmix\_cs),            \textcolor{keywordtype}{pointer}       :: varmix\textcolor{comment}{  !< Variable mixing type}
113   \textcolor{keywordtype}{type}(verticalgrid\_type),    \textcolor{keywordtype}{intent(in)}    :: gv\textcolor{comment}{      !< ocean vertical grid structure}
114   \textcolor{keywordtype}{type}(unit\_scale\_type),      \textcolor{keywordtype}{intent(in)}    :: us\textcolor{comment}{      !< A dimensional unit scaling type}
115   \textcolor{keywordtype}{type}(tracer\_hor\_diff\_cs),   \textcolor{keywordtype}{pointer}       :: cs\textcolor{comment}{      !< module control structure}
116   \textcolor{keywordtype}{type}(tracer\_registry\_type), \textcolor{keywordtype}{pointer}       :: reg\textcolor{comment}{     !< registered tracers}
117   \textcolor{keywordtype}{type}(thermo\_var\_ptrs),      \textcolor{keywordtype}{intent(in)}    :: tv\textcolor{comment}{      !< A structure containing pointers to any available}
118 \textcolor{comment}{                                                       !! thermodynamic fields, including potential temp
       and}
119 \textcolor{comment}{                                                       !! salinity or mixed layer density. Absent fields
       have}
120 \textcolor{comment}{                                                       !! NULL ptrs, and these may (probably will) point to}
121 \textcolor{comment}{                                                       !! some of the same arrays as Tr does.  tv is
       required}
122 \textcolor{comment}{                                                       !! for epipycnal mixing between mixed layer and the
       interior.}
123   \textcolor{comment}{! Optional inputs for offline tracer transport}
124   \textcolor{keywordtype}{logical},          \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)}    :: do\_online\_flag\textcolor{comment}{ !< If present and true, do online}
125 \textcolor{comment}{                                                       !! tracer transport with stored velocities.}
126   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G))}, &
127                     \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)}    :: read\_khdt\_x\textcolor{comment}{ !< If present, these are the zonal}
128 \textcolor{comment}{                                                       !! diffusivities from previous run.}
129   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G))}, &
130                     \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)}    :: read\_khdt\_y\textcolor{comment}{ !< If present, these are the meridional}
131 \textcolor{comment}{                                                       !! diffusivities from previous run.}
132 
133 
134   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G))} :: &
135     ihdxdy, &     \textcolor{comment}{! The inverse of the volume or mass of fluid in a layer in a}
136                   \textcolor{comment}{! grid cell [H-1 L-2 ~> m-3 or kg-1].}
137     kh\_h, &       \textcolor{comment}{! The tracer diffusivity averaged to tracer points [L2 T-1 ~> m2 s-1].}
138     cfl, &        \textcolor{comment}{! A diffusive CFL number for each cell [nondim].}
139     dtr           \textcolor{comment}{! The change in a tracer's concentration, in units of concentration [Conc].}
140 
141   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G))} :: &
142     khdt\_x, &     \textcolor{comment}{! The value of Khtr*dt times the open face width divided by}
143                   \textcolor{comment}{! the distance between adjacent tracer points [L2 ~> m2].}
144     coef\_x, &     \textcolor{comment}{! The coefficients relating zonal tracer differences to time-integrated}
145                   \textcolor{comment}{! fluxes, in [L2 ~> m2] for some schemes and [H L2 ~> m3 or kg] for others.}
146     kh\_u          \textcolor{comment}{! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1].}
147   \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G))} :: &
148     khdt\_y, &     \textcolor{comment}{! The value of Khtr*dt times the open face width divided by}
149                   \textcolor{comment}{! the distance between adjacent tracer points [L2 ~> m2].}
150     coef\_y, &     \textcolor{comment}{! The coefficients relating meridional tracer differences to time-integrated}
151                   \textcolor{comment}{! fluxes, in [L2 ~> m2] for some schemes and [H L2 ~> m3 or kg] for others.}
152     kh\_v          \textcolor{comment}{! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1].}
153 
154   \textcolor{keywordtype}{real} :: khdt\_max \textcolor{comment}{! The local limiting value of khdt\_x or khdt\_y [L2 ~> m2].}
155   \textcolor{keywordtype}{real} :: max\_cfl \textcolor{comment}{! The global maximum of the diffusive CFL number.}
156   \textcolor{keywordtype}{logical} :: use\_varmix, resoln\_scaled, do\_online, use\_eady
157   \textcolor{keywordtype}{integer} :: s\_idx, t\_idx \textcolor{comment}{! Indices for temperature and salinity if needed}
158   \textcolor{keywordtype}{integer} :: i, j, k, m, is, ie, js, je, nz, ntr, itt, num\_itts
159   \textcolor{keywordtype}{real} :: i\_numitts  \textcolor{comment}{! The inverse of the number of iterations, num\_itts.}
160   \textcolor{keywordtype}{real} :: scale      \textcolor{comment}{! The fraction of khdt\_x or khdt\_y that is applied in this}
161                      \textcolor{comment}{! layer for this iteration [nondim].}
162   \textcolor{keywordtype}{real} :: idt        \textcolor{comment}{! The inverse of the time step [T-1 ~> s-1].}
163   \textcolor{keywordtype}{real} :: h\_neglect  \textcolor{comment}{! A thickness that is so small it is usually lost}
164                      \textcolor{comment}{! in roundoff and can be neglected [H ~> m or kg m-2].}
165   \textcolor{keywordtype}{real} :: kh\_loc     \textcolor{comment}{! The local value of Kh [L2 T-1 ~> m2 s-1].}
166   \textcolor{keywordtype}{real} :: res\_fn     \textcolor{comment}{! The local value of the resolution function [nondim].}
167   \textcolor{keywordtype}{real} :: rd\_dx      \textcolor{comment}{! The local value of deformation radius over grid-spacing [nondim].}
168   \textcolor{keywordtype}{real} :: normalize  \textcolor{comment}{! normalization used for diagnostic Kh\_h; diffusivity averaged to h-points.}
169 
170   is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
171 
172   do\_online = .true.
173   \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(do\_online\_flag)) do\_online = do\_online\_flag
174 
175   \textcolor{keywordflow}{if} (.not. \textcolor{keyword}{associated}(cs)) \textcolor{keyword}{call }mom\_error(fatal, \textcolor{stringliteral}{"MOM\_tracer\_hor\_diff: "}// &
176        \textcolor{stringliteral}{"register\_tracer must be called before tracer\_hordiff."})
177   \textcolor{keywordflow}{if} (loc(reg)==0) \textcolor{keyword}{call }mom\_error(fatal, \textcolor{stringliteral}{"MOM\_tracer\_hor\_diff: "}// &
178        \textcolor{stringliteral}{"register\_tracer must be called before tracer\_hordiff."})
179   \textcolor{keywordflow}{if} ((reg%ntr==0) .or. ((cs%KhTr <= 0.0) .and. .not.\textcolor{keyword}{associated}(varmix)) ) \textcolor{keywordflow}{return}
180 
181   \textcolor{keywordflow}{if} (cs%show\_call\_tree) \textcolor{keyword}{call }calltree\_enter(\textcolor{stringliteral}{"tracer\_hordiff(), MOM\_tracer\_hor\_diff.F90"})
182 
183   \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_diffuse)
184 
185   ntr = reg%ntr
186   idt = 1.0 / dt
187   h\_neglect = gv%H\_subroundoff
188 
189   \textcolor{keywordflow}{if} (cs%Diffuse\_ML\_interior .and. cs%first\_call) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (is\_root\_pe()) \textcolor{keywordflow}{then}
190     \textcolor{keywordflow}{do} m=1,ntr ; \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(reg%Tr(m)%df\_x) .or. \textcolor{keyword}{associated}(reg%Tr(m)%df\_y)) &
191       \textcolor{keyword}{call }mom\_error(warning, \textcolor{stringliteral}{"tracer\_hordiff: Tracer "}//trim(reg%Tr(m)%name)// &
192           \textcolor{stringliteral}{" has associated 3-d diffusive flux diagnostics.  These are not "}//&
193           \textcolor{stringliteral}{"valid when DIFFUSE\_ML\_TO\_INTERIOR is defined. Use 2-d tracer "}//&
194           \textcolor{stringliteral}{"diffusion diagnostics instead to get accurate total fluxes."})
195 \textcolor{keywordflow}{    enddo}
196 \textcolor{keywordflow}{  endif} ;\textcolor{keywordflow}{ endif}
197   cs%first\_call = .false.
198 
199   \textcolor{keywordflow}{if} (cs%debug) \textcolor{keyword}{call }mom\_tracer\_chksum(\textcolor{stringliteral}{"Before tracer diffusion "}, reg%Tr, ntr, g)
200 
201   use\_varmix = .false. ; resoln\_scaled = .false. ; use\_eady = .false.
202   \textcolor{keywordflow}{if} (\textcolor{keyword}{Associated}(varmix)) \textcolor{keywordflow}{then}
203     use\_varmix = varmix%use\_variable\_mixing
204     resoln\_scaled = varmix%Resoln\_scaled\_KhTr
205     use\_eady = cs%KhTr\_Slope\_Cff > 0.
206 \textcolor{keywordflow}{  endif}
207 
208   \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_pass)
209   \textcolor{keywordflow}{do} m=1,ntr
210     \textcolor{keyword}{call }create\_group\_pass(cs%pass\_t, reg%Tr(m)%t(:,:,:), g%Domain)
211 \textcolor{keywordflow}{  enddo}
212   \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_pass)
213 
214   \textcolor{keywordflow}{if} (cs%show\_call\_tree) \textcolor{keyword}{call }calltree\_waypoint(\textcolor{stringliteral}{"Calculating diffusivity (tracer\_hordiff)"})
215 
216   \textcolor{keywordflow}{if} (do\_online) \textcolor{keywordflow}{then}
217     \textcolor{keywordflow}{if} (use\_varmix) \textcolor{keywordflow}{then}
218       \textcolor{comment}{!$OMP parallel do default(shared) private(Kh\_loc,Rd\_dx)}
219       \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie
220         kh\_loc = cs%KhTr
221         \textcolor{keywordflow}{if} (use\_eady) kh\_loc = kh\_loc + cs%KhTr\_Slope\_Cff*varmix%L2u(i,j)*varmix%SN\_u(i,j)
222         \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(meke%Kh)) &
223           kh\_loc = kh\_loc + meke%KhTr\_fac*sqrt(meke%Kh(i,j)*meke%Kh(i+1,j))
224         \textcolor{keywordflow}{if} (cs%KhTr\_max > 0.) kh\_loc = min(kh\_loc, cs%KhTr\_max)
225         \textcolor{keywordflow}{if} (resoln\_scaled) &
226           kh\_loc = kh\_loc * 0.5*(varmix%Res\_fn\_h(i,j) + varmix%Res\_fn\_h(i+1,j))
227         kh\_u(i,j) = max(kh\_loc, cs%KhTr\_min)
228         \textcolor{keywordflow}{if} (cs%KhTr\_passivity\_coeff>0.) \textcolor{keywordflow}{then} \textcolor{comment}{! Apply passivity}
229           rd\_dx=0.5*( varmix%Rd\_dx\_h(i,j)+varmix%Rd\_dx\_h(i+1,j) ) \textcolor{comment}{! Rd/dx at u-points}
230           kh\_loc = kh\_u(i,j)*max( cs%KhTr\_passivity\_min, cs%KhTr\_passivity\_coeff*rd\_dx )
231           \textcolor{keywordflow}{if} (cs%KhTr\_max > 0.) kh\_loc = min(kh\_loc, cs%KhTr\_max) \textcolor{comment}{! Re-apply max}
232           kh\_u(i,j) = max(kh\_loc, cs%KhTr\_min) \textcolor{comment}{! Re-apply min}
233 \textcolor{keywordflow}{        endif}
234 \textcolor{keywordflow}{      enddo} ;\textcolor{keywordflow}{ enddo}
235       \textcolor{comment}{!$OMP parallel do default(shared) private(Kh\_loc,Rd\_dx)}
236       \textcolor{keywordflow}{do} j=js-1,je ;  \textcolor{keywordflow}{do} i=is,ie
237         kh\_loc = cs%KhTr
238         \textcolor{keywordflow}{if} (use\_eady) kh\_loc = kh\_loc + cs%KhTr\_Slope\_Cff*varmix%L2v(i,j)*varmix%SN\_v(i,j)
239         \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(meke%Kh)) &
240           kh\_loc = kh\_loc + meke%KhTr\_fac*sqrt(meke%Kh(i,j)*meke%Kh(i,j+1))
241         \textcolor{keywordflow}{if} (cs%KhTr\_max > 0.) kh\_loc = min(kh\_loc, cs%KhTr\_max)
242         \textcolor{keywordflow}{if} (resoln\_scaled) &
243           kh\_loc = kh\_loc * 0.5*(varmix%Res\_fn\_h(i,j) + varmix%Res\_fn\_h(i,j+1))
244         kh\_v(i,j) = max(kh\_loc, cs%KhTr\_min)
245         \textcolor{keywordflow}{if} (cs%KhTr\_passivity\_coeff>0.) \textcolor{keywordflow}{then} \textcolor{comment}{! Apply passivity}
246           rd\_dx = 0.5*( varmix%Rd\_dx\_h(i,j)+varmix%Rd\_dx\_h(i,j+1) ) \textcolor{comment}{! Rd/dx at v-points}
247           kh\_loc = kh\_v(i,j)*max( cs%KhTr\_passivity\_min, cs%KhTr\_passivity\_coeff*rd\_dx )
248           \textcolor{keywordflow}{if} (cs%KhTr\_max > 0.) kh\_loc = min(kh\_loc, cs%KhTr\_max) \textcolor{comment}{! Re-apply max}
249           kh\_v(i,j) = max(kh\_loc, cs%KhTr\_min) \textcolor{comment}{! Re-apply min}
250 \textcolor{keywordflow}{        endif}
251 \textcolor{keywordflow}{      enddo} ;\textcolor{keywordflow}{ enddo}
252 
253       \textcolor{comment}{!$OMP parallel do default(shared)}
254       \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie
255         khdt\_x(i,j) = dt*(kh\_u(i,j)*(g%dy\_Cu(i,j)*g%IdxCu(i,j)))
256 \textcolor{keywordflow}{      enddo} ;\textcolor{keywordflow}{ enddo}
257       \textcolor{comment}{!$OMP parallel do default(shared)}
258       \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie
259         khdt\_y(i,j) = dt*(kh\_v(i,j)*(g%dx\_Cv(i,j)*g%IdyCv(i,j)))
260 \textcolor{keywordflow}{      enddo} ;\textcolor{keywordflow}{ enddo}
261     \textcolor{keywordflow}{elseif} (resoln\_scaled) \textcolor{keywordflow}{then}
262       \textcolor{comment}{!$OMP parallel do default(shared) private(Res\_fn)}
263       \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie
264         res\_fn = 0.5 * (varmix%Res\_fn\_h(i,j) + varmix%Res\_fn\_h(i+1,j))
265         kh\_u(i,j) = max(cs%KhTr * res\_fn, cs%KhTr\_min)
266         khdt\_x(i,j) = dt*(cs%KhTr*(g%dy\_Cu(i,j)*g%IdxCu(i,j))) * res\_fn
267 \textcolor{keywordflow}{      enddo} ;\textcolor{keywordflow}{ enddo}
268       \textcolor{comment}{!$OMP parallel do default(shared) private(Res\_fn)}
269       \textcolor{keywordflow}{do} j=js-1,je ;  \textcolor{keywordflow}{do} i=is,ie
270         res\_fn = 0.5*(varmix%Res\_fn\_h(i,j) + varmix%Res\_fn\_h(i,j+1))
271         kh\_v(i,j) = max(cs%KhTr * res\_fn, cs%KhTr\_min)
272         khdt\_y(i,j) = dt*(cs%KhTr*(g%dx\_Cv(i,j)*g%IdyCv(i,j))) * res\_fn
273 \textcolor{keywordflow}{      enddo} ;\textcolor{keywordflow}{ enddo}
274     \textcolor{keywordflow}{else}  \textcolor{comment}{! Use a simple constant diffusivity.}
275       \textcolor{keywordflow}{if} (cs%id\_KhTr\_u > 0) \textcolor{keywordflow}{then}
276         \textcolor{comment}{!$OMP parallel do default(shared)}
277         \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie
278           kh\_u(i,j) = cs%KhTr
279           khdt\_x(i,j) = dt*(cs%KhTr*(g%dy\_Cu(i,j)*g%IdxCu(i,j)))
280 \textcolor{keywordflow}{        enddo} ;\textcolor{keywordflow}{ enddo}
281       \textcolor{keywordflow}{else}
282         \textcolor{comment}{!$OMP parallel do default(shared)}
283         \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie
284           khdt\_x(i,j) = dt*(cs%KhTr*(g%dy\_Cu(i,j)*g%IdxCu(i,j)))
285 \textcolor{keywordflow}{        enddo} ;\textcolor{keywordflow}{ enddo}
286 \textcolor{keywordflow}{      endif}
287       \textcolor{keywordflow}{if} (cs%id\_KhTr\_v > 0) \textcolor{keywordflow}{then}
288         \textcolor{comment}{!$OMP parallel do default(shared)}
289         \textcolor{keywordflow}{do} j=js-1,je ;  \textcolor{keywordflow}{do} i=is,ie
290           kh\_v(i,j) = cs%KhTr
291           khdt\_y(i,j) = dt*(cs%KhTr*(g%dx\_Cv(i,j)*g%IdyCv(i,j)))
292 \textcolor{keywordflow}{        enddo} ;\textcolor{keywordflow}{ enddo}
293       \textcolor{keywordflow}{else}
294         \textcolor{comment}{!$OMP parallel do default(shared)}
295         \textcolor{keywordflow}{do} j=js-1,je ;  \textcolor{keywordflow}{do} i=is,ie
296           khdt\_y(i,j) = dt*(cs%KhTr*(g%dx\_Cv(i,j)*g%IdyCv(i,j)))
297 \textcolor{keywordflow}{        enddo} ;\textcolor{keywordflow}{ enddo}
298 \textcolor{keywordflow}{      endif}
299 \textcolor{keywordflow}{    endif} \textcolor{comment}{! VarMix}
300 
301     \textcolor{keywordflow}{if} (cs%max\_diff\_CFL > 0.0) \textcolor{keywordflow}{then}
302       \textcolor{keywordflow}{if} ((cs%id\_KhTr\_u > 0) .or. (cs%id\_KhTr\_h > 0)) \textcolor{keywordflow}{then}
303         \textcolor{comment}{!$OMP parallel do default(shared) private(khdt\_max)}
304         \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie
305           khdt\_max = 0.125*cs%max\_diff\_CFL * min(g%areaT(i,j), g%areaT(i+1,j))
306           \textcolor{keywordflow}{if} (khdt\_x(i,j) > khdt\_max) \textcolor{keywordflow}{then}
307             khdt\_x(i,j) = khdt\_max
308             \textcolor{keywordflow}{if} (dt*(g%dy\_Cu(i,j)*g%IdxCu(i,j)) > 0.0) &
309               kh\_u(i,j) = khdt\_x(i,j) / (dt*(g%dy\_Cu(i,j)*g%IdxCu(i,j)))
310 \textcolor{keywordflow}{          endif}
311 \textcolor{keywordflow}{        enddo} ;\textcolor{keywordflow}{ enddo}
312       \textcolor{keywordflow}{else}
313         \textcolor{comment}{!$OMP parallel do default(shared) private(khdt\_max)}
314         \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie
315           khdt\_max = 0.125*cs%max\_diff\_CFL * min(g%areaT(i,j), g%areaT(i+1,j))
316           khdt\_x(i,j) = min(khdt\_x(i,j), khdt\_max)
317 \textcolor{keywordflow}{        enddo} ;\textcolor{keywordflow}{ enddo}
318 \textcolor{keywordflow}{      endif}
319       \textcolor{keywordflow}{if} ((cs%id\_KhTr\_v > 0) .or. (cs%id\_KhTr\_h > 0)) \textcolor{keywordflow}{then}
320         \textcolor{comment}{!$OMP parallel do default(shared) private(khdt\_max)}
321         \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie
322           khdt\_max = 0.125*cs%max\_diff\_CFL * min(g%areaT(i,j), g%areaT(i,j+1))
323           \textcolor{keywordflow}{if} (khdt\_y(i,j) > khdt\_max) \textcolor{keywordflow}{then}
324             khdt\_y(i,j) = khdt\_max
325             \textcolor{keywordflow}{if} (dt*(g%dx\_Cv(i,j)*g%IdyCv(i,j)) > 0.0) &
326               kh\_v(i,j) = khdt\_y(i,j) / (dt*(g%dx\_Cv(i,j)*g%IdyCv(i,j)))
327 \textcolor{keywordflow}{          endif}
328 \textcolor{keywordflow}{        enddo} ;\textcolor{keywordflow}{ enddo}
329       \textcolor{keywordflow}{else}
330         \textcolor{comment}{!$OMP parallel do default(shared) private(khdt\_max)}
331         \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie
332           khdt\_max = 0.125*cs%max\_diff\_CFL * min(g%areaT(i,j), g%areaT(i,j+1))
333           khdt\_y(i,j) = min(khdt\_y(i,j), khdt\_max)
334 \textcolor{keywordflow}{        enddo} ;\textcolor{keywordflow}{ enddo}
335 \textcolor{keywordflow}{      endif}
336 \textcolor{keywordflow}{    endif}
337 
338   \textcolor{keywordflow}{else} \textcolor{comment}{! .not. do\_online}
339     \textcolor{comment}{!$OMP parallel do default(shared)}
340     \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie
341       khdt\_x(i,j) = us%m\_to\_L**2*read\_khdt\_x(i,j)
342 \textcolor{keywordflow}{    enddo} ;\textcolor{keywordflow}{ enddo}
343     \textcolor{comment}{!$OMP parallel do default(shared)}
344     \textcolor{keywordflow}{do} j=js-1,je ;  \textcolor{keywordflow}{do} i=is,ie
345       khdt\_y(i,j) = us%m\_to\_L**2*read\_khdt\_y(i,j)
346 \textcolor{keywordflow}{    enddo} ;\textcolor{keywordflow}{ enddo}
347     \textcolor{keyword}{call }pass\_vector(khdt\_x, khdt\_y, g%Domain)
348 \textcolor{keywordflow}{  endif} \textcolor{comment}{! do\_online}
349 
350   \textcolor{keywordflow}{if} (cs%check\_diffusive\_CFL) \textcolor{keywordflow}{then}
351     \textcolor{keywordflow}{if} (cs%show\_call\_tree) \textcolor{keyword}{call }calltree\_waypoint(\textcolor{stringliteral}{"Checking diffusive CFL (tracer\_hordiff)"})
352     max\_cfl = 0.0
353     \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie
354       cfl(i,j) = 2.0*((khdt\_x(i-1,j) + khdt\_x(i,j)) + &
355                       (khdt\_y(i,j-1) + khdt\_y(i,j))) * g%IareaT(i,j)
356       \textcolor{keywordflow}{if} (max\_cfl < cfl(i,j)) max\_cfl = cfl(i,j)
357 \textcolor{keywordflow}{    enddo} ;\textcolor{keywordflow}{ enddo}
358     \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_sync)
359     \textcolor{keyword}{call }max\_across\_pes(max\_cfl)
360     \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_sync)
361     num\_itts = max(1, ceiling(max\_cfl - 4.0*epsilon(max\_cfl)))
362     i\_numitts = 1.0 / (\textcolor{keywordtype}{real}(num\_itts))
363     \textcolor{keywordflow}{if} (cs%id\_CFL > 0) \textcolor{keyword}{call }post\_data(cs%id\_CFL, cfl, cs%diag, mask=g%mask2dT)
364   \textcolor{keywordflow}{elseif} (cs%max\_diff\_CFL > 0.0) \textcolor{keywordflow}{then}
365     num\_itts = max(1, ceiling(cs%max\_diff\_CFL - 4.0*epsilon(cs%max\_diff\_CFL)))
366     i\_numitts = 1.0 / (\textcolor{keywordtype}{real}(num\_itts))
367   \textcolor{keywordflow}{else}
368     num\_itts = 1 ; i\_numitts = 1.0
369 \textcolor{keywordflow}{  endif}
370 
371   \textcolor{keywordflow}{do} m=1,ntr
372     \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(reg%Tr(m)%df\_x)) \textcolor{keywordflow}{then}
373       \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie
374         reg%Tr(m)%df\_x(i,j,k) = 0.0
375 \textcolor{keywordflow}{      enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo}
376 \textcolor{keywordflow}{    endif}
377     \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(reg%Tr(m)%df\_y)) \textcolor{keywordflow}{then}
378       \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie
379         reg%Tr(m)%df\_y(i,j,k) = 0.0
380 \textcolor{keywordflow}{      enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo}
381 \textcolor{keywordflow}{    endif}
382     \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(reg%Tr(m)%df2d\_x)) \textcolor{keywordflow}{then}
383       \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; reg%Tr(m)%df2d\_x(i,j) = 0.0 ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo}
384 \textcolor{keywordflow}{    endif}
385     \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(reg%Tr(m)%df2d\_y)) \textcolor{keywordflow}{then}
386       \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; reg%Tr(m)%df2d\_y(i,j) = 0.0 ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo}
387 \textcolor{keywordflow}{    endif}
388 \textcolor{keywordflow}{  enddo}
389 
390   \textcolor{keywordflow}{if} (cs%use\_lateral\_boundary\_diffusion) \textcolor{keywordflow}{then}
391 
392     \textcolor{keywordflow}{if} (cs%show\_call\_tree) \textcolor{keyword}{call }calltree\_waypoint(\textcolor{stringliteral}{"Calling lateral boundary mixing (tracer\_hordiff)"})
393 
394     \textcolor{keyword}{call }do\_group\_pass(cs%pass\_t, g%Domain, clock=id\_clock\_pass)
395 
396     \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie
397       coef\_y(i,j) = i\_numitts * khdt\_y(i,j)
398 \textcolor{keywordflow}{    enddo} ;\textcolor{keywordflow}{ enddo}
399     \textcolor{keywordflow}{do} j=js,je
400       \textcolor{keywordflow}{do} i=is-1,ie
401         coef\_x(i,j) = i\_numitts * khdt\_x(i,j)
402 \textcolor{keywordflow}{      enddo}
403 \textcolor{keywordflow}{    enddo}
404 
405     \textcolor{keywordflow}{do} itt=1,num\_itts
406       \textcolor{keywordflow}{if} (cs%show\_call\_tree) \textcolor{keyword}{call }calltree\_waypoint(\textcolor{stringliteral}{"Calling lateral boundary diffusion (tracer\_hordiff)"},
      itt)
407       \textcolor{keywordflow}{if} (itt>1) \textcolor{keywordflow}{then} \textcolor{comment}{! Update halos for subsequent iterations}
408         \textcolor{keyword}{call }do\_group\_pass(cs%pass\_t, g%Domain, clock=id\_clock\_pass)
409 \textcolor{keywordflow}{      endif}
410       \textcolor{keyword}{call }lateral\_boundary\_diffusion(g, gv, us, h, coef\_x, coef\_y, i\_numitts*dt, reg, &
411                                      cs%lateral\_boundary\_diffusion\_CSp)
412 \textcolor{keywordflow}{    enddo} \textcolor{comment}{! itt}
413 \textcolor{keywordflow}{  endif}
414 
415   \textcolor{keywordflow}{if} (cs%use\_neutral\_diffusion) \textcolor{keywordflow}{then}
416 
417     \textcolor{keywordflow}{if} (cs%show\_call\_tree) \textcolor{keyword}{call }calltree\_waypoint(\textcolor{stringliteral}{"Calling neutral diffusion coeffs (tracer\_hordiff)"})
418 
419     \textcolor{keyword}{call }do\_group\_pass(cs%pass\_t, g%Domain, clock=id\_clock\_pass)
420     \textcolor{comment}{! We are assuming that neutral surfaces do not evolve (much) as a result of multiple}
421     \textcolor{comment}{! lateral diffusion iterations. Otherwise the call to neutral\_diffusion\_calc\_coeffs()}
422     \textcolor{comment}{! would be inside the itt-loop. -AJA}
423 
424     \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(tv%p\_surf)) \textcolor{keywordflow}{then}
425       \textcolor{keyword}{call }neutral\_diffusion\_calc\_coeffs(g, gv, us, h, tv%T, tv%S, cs%neutral\_diffusion\_CSp, p\_surf=tv
      %p\_surf)
426     \textcolor{keywordflow}{else}
427       \textcolor{keyword}{call }neutral\_diffusion\_calc\_coeffs(g, gv, us, h, tv%T, tv%S, cs%neutral\_diffusion\_CSp)
428 \textcolor{keywordflow}{    endif}
429     \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie
430       coef\_y(i,j) = i\_numitts * khdt\_y(i,j)
431 \textcolor{keywordflow}{    enddo} ;\textcolor{keywordflow}{ enddo}
432     \textcolor{keywordflow}{do} j=js,je
433       \textcolor{keywordflow}{do} i=is-1,ie
434         coef\_x(i,j) = i\_numitts * khdt\_x(i,j)
435 \textcolor{keywordflow}{      enddo}
436 \textcolor{keywordflow}{    enddo}
437 
438     \textcolor{keywordflow}{do} itt=1,num\_itts
439       \textcolor{keywordflow}{if} (cs%show\_call\_tree) \textcolor{keyword}{call }calltree\_waypoint(\textcolor{stringliteral}{"Calling neutral diffusion (tracer\_hordiff)"},itt)
440       \textcolor{keywordflow}{if} (itt>1) \textcolor{keywordflow}{then} \textcolor{comment}{! Update halos for subsequent iterations}
441         \textcolor{keyword}{call }do\_group\_pass(cs%pass\_t, g%Domain, clock=id\_clock\_pass)
442         \textcolor{keywordflow}{if} (cs%recalc\_neutral\_surf) \textcolor{keywordflow}{then}
443           \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(tv%p\_surf)) \textcolor{keywordflow}{then}
444             \textcolor{keyword}{call }neutral\_diffusion\_calc\_coeffs(g, gv, us, h, tv%T, tv%S, cs%neutral\_diffusion\_CSp, p\_surf=
      tv%p\_surf)
445           \textcolor{keywordflow}{else}
446             \textcolor{keyword}{call }neutral\_diffusion\_calc\_coeffs(g, gv, us, h, tv%T, tv%S, cs%neutral\_diffusion\_CSp)
447 \textcolor{keywordflow}{          endif}
448 \textcolor{keywordflow}{        endif}
449 \textcolor{keywordflow}{      endif}
450       \textcolor{keyword}{call }neutral\_diffusion(g, gv,  h, coef\_x, coef\_y, i\_numitts*dt, reg, us, cs%neutral\_diffusion\_CSp)
451 \textcolor{keywordflow}{    enddo} \textcolor{comment}{! itt}
452 
453   \textcolor{keywordflow}{else}    \textcolor{comment}{! following if not using neutral diffusion, but instead along-surface diffusion}
454 
455     \textcolor{keywordflow}{if} (cs%show\_call\_tree) \textcolor{keyword}{call }calltree\_waypoint(\textcolor{stringliteral}{"Calculating horizontal diffusion (tracer\_hordiff)"})
456     \textcolor{keywordflow}{do} itt=1,num\_itts
457       \textcolor{keyword}{call }do\_group\_pass(cs%pass\_t, g%Domain, clock=id\_clock\_pass)
458       \textcolor{comment}{!$OMP parallel do default(shared) private(scale,Coef\_y,Coef\_x,Ihdxdy,dTr)}
459       \textcolor{keywordflow}{do} k=1,nz
460         scale = i\_numitts
461         \textcolor{keywordflow}{if} (cs%Diffuse\_ML\_interior) \textcolor{keywordflow}{then}
462           \textcolor{keywordflow}{if} (k<=gv%nkml) \textcolor{keywordflow}{then}
463             \textcolor{keywordflow}{if} (cs%ML\_KhTr\_scale <= 0.0) cycle
464             scale = i\_numitts * cs%ML\_KhTr\_scale
465 \textcolor{keywordflow}{          endif}
466           \textcolor{keywordflow}{if} ((k>gv%nkml) .and. (k<=gv%nk\_rho\_varies)) cycle
467 \textcolor{keywordflow}{        endif}
468 
469         \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie
470           coef\_y(i,j) = ((scale * khdt\_y(i,j))*2.0*(h(i,j,k)*h(i,j+1,k))) / &
471                                                    (h(i,j,k)+h(i,j+1,k)+h\_neglect)
472 \textcolor{keywordflow}{        enddo} ;\textcolor{keywordflow}{ enddo}
473 
474         \textcolor{keywordflow}{do} j=js,je
475           \textcolor{keywordflow}{do} i=is-1,ie
476             coef\_x(i,j) = ((scale * khdt\_x(i,j))*2.0*(h(i,j,k)*h(i+1,j,k))) / &
477                                                      (h(i,j,k)+h(i+1,j,k)+h\_neglect)
478 \textcolor{keywordflow}{          enddo}
479 
480           \textcolor{keywordflow}{do} i=is,ie
481             ihdxdy(i,j) = g%IareaT(i,j) / (h(i,j,k)+h\_neglect)
482 \textcolor{keywordflow}{          enddo}
483 \textcolor{keywordflow}{        enddo}
484 
485         \textcolor{keywordflow}{do} m=1,ntr
486           \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie
487             dtr(i,j) = ihdxdy(i,j) * &
488               ((coef\_x(i-1,j) * (reg%Tr(m)%t(i-1,j,k) - reg%Tr(m)%t(i,j,k)) - &
489                 coef\_x(i,j) * (reg%Tr(m)%t(i,j,k) - reg%Tr(m)%t(i+1,j,k))) + &
490                (coef\_y(i,j-1) * (reg%Tr(m)%t(i,j-1,k) - reg%Tr(m)%t(i,j,k)) - &
491                 coef\_y(i,j) * (reg%Tr(m)%t(i,j,k) - reg%Tr(m)%t(i,j+1,k))))
492 \textcolor{keywordflow}{          enddo} ;\textcolor{keywordflow}{ enddo}
493           \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(reg%Tr(m)%df\_x)) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=g%IscB,g%IecB
494             reg%Tr(m)%df\_x(i,j,k) = reg%Tr(m)%df\_x(i,j,k) + coef\_x(i,j) &
495                 * (reg%Tr(m)%t(i,j,k) - reg%Tr(m)%t(i+1,j,k)) * idt
496 \textcolor{keywordflow}{          enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ endif}
497           \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(reg%Tr(m)%df\_y)) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{do} j=g%JscB,g%JecB ; \textcolor{keywordflow}{do} i=is,ie
498             reg%Tr(m)%df\_y(i,j,k) = reg%Tr(m)%df\_y(i,j,k) + coef\_y(i,j) &
499                 * (reg%Tr(m)%t(i,j,k) - reg%Tr(m)%t(i,j+1,k)) * idt
500 \textcolor{keywordflow}{          enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ endif}
501           \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(reg%Tr(m)%df2d\_x)) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=g%IscB,g%IecB
502             reg%Tr(m)%df2d\_x(i,j) = reg%Tr(m)%df2d\_x(i,j) + coef\_x(i,j) &
503                 * (reg%Tr(m)%t(i,j,k) - reg%Tr(m)%t(i+1,j,k)) * idt
504 \textcolor{keywordflow}{          enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ endif}
505           \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(reg%Tr(m)%df2d\_y)) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{do} j=g%JscB,g%JecB ; \textcolor{keywordflow}{do} i=is,ie
506             reg%Tr(m)%df2d\_y(i,j) = reg%Tr(m)%df2d\_y(i,j) + coef\_y(i,j) &
507                 * (reg%Tr(m)%t(i,j,k) - reg%Tr(m)%t(i,j+1,k)) * idt
508 \textcolor{keywordflow}{          enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ endif}
509           \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie
510             reg%Tr(m)%t(i,j,k) = reg%Tr(m)%t(i,j,k) + dtr(i,j)
511 \textcolor{keywordflow}{          enddo} ;\textcolor{keywordflow}{ enddo}
512 \textcolor{keywordflow}{        enddo}
513 
514 \textcolor{keywordflow}{      enddo} \textcolor{comment}{! End of k loop.}
515 
516 \textcolor{keywordflow}{    enddo} \textcolor{comment}{! End of "while" loop.}
517 
518 \textcolor{keywordflow}{  endif}   \textcolor{comment}{! endif for CS%use\_neutral\_diffusion}
519   \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_diffuse)
520 
521 
522   \textcolor{keywordflow}{if} (cs%Diffuse\_ML\_interior) \textcolor{keywordflow}{then}
523     \textcolor{keywordflow}{if} (cs%show\_call\_tree) \textcolor{keyword}{call }calltree\_waypoint(\textcolor{stringliteral}{"Calling epipycnal\_ML\_diff (tracer\_hordiff)"})
524     \textcolor{keywordflow}{if} (cs%debug) \textcolor{keyword}{call }mom\_tracer\_chksum(\textcolor{stringliteral}{"Before epipycnal diff "}, reg%Tr, ntr, g)
525 
526     \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_epimix)
527     \textcolor{keyword}{call }tracer\_epipycnal\_ml\_diff(h, dt, reg%Tr, ntr, khdt\_x, khdt\_y, g, gv, us, &
528                                   cs, tv, num\_itts)
529     \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_epimix)
530 \textcolor{keywordflow}{  endif}
531 
532   \textcolor{keywordflow}{if} (cs%debug) \textcolor{keyword}{call }mom\_tracer\_chksum(\textcolor{stringliteral}{"After tracer diffusion "}, reg%Tr, ntr, g)
533 
534   \textcolor{comment}{! post diagnostics for 2d tracer diffusivity}
535   \textcolor{keywordflow}{if} (cs%id\_KhTr\_u > 0) \textcolor{keywordflow}{then}
536     \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie
537       kh\_u(i,j) = g%mask2dCu(i,j)*kh\_u(i,j)
538 \textcolor{keywordflow}{    enddo} ;\textcolor{keywordflow}{ enddo}
539     \textcolor{keyword}{call }post\_data(cs%id\_KhTr\_u, kh\_u, cs%diag, mask=g%mask2dCu)
540 \textcolor{keywordflow}{  endif}
541   \textcolor{keywordflow}{if} (cs%id\_KhTr\_v > 0) \textcolor{keywordflow}{then}
542     \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie
543       kh\_v(i,j) = g%mask2dCv(i,j)*kh\_v(i,j)
544 \textcolor{keywordflow}{    enddo} ;\textcolor{keywordflow}{ enddo}
545     \textcolor{keyword}{call }post\_data(cs%id\_KhTr\_v, kh\_v, cs%diag, mask=g%mask2dCv)
546 \textcolor{keywordflow}{  endif}
547   \textcolor{keywordflow}{if} (cs%id\_KhTr\_h > 0) \textcolor{keywordflow}{then}
548     kh\_h(:,:) = 0.0
549     \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie
550       kh\_u(i,j) = g%mask2dCu(i,j)*kh\_u(i,j)
551 \textcolor{keywordflow}{    enddo} ;\textcolor{keywordflow}{ enddo}
552     \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie
553       kh\_v(i,j) = g%mask2dCv(i,j)*kh\_v(i,j)
554 \textcolor{keywordflow}{    enddo} ;\textcolor{keywordflow}{ enddo}
555     \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie
556       normalize = 1.0 / ((g%mask2dCu(i-1,j)+g%mask2dCu(i,j)) + &
557                   (g%mask2dCv(i,j-1)+g%mask2dCv(i,j)) + gv%H\_subroundoff)
558       kh\_h(i,j) = normalize*g%mask2dT(i,j)*((kh\_u(i-1,j)+kh\_u(i,j)) + &
559                                             (kh\_v(i,j-1)+kh\_v(i,j)))
560 \textcolor{keywordflow}{    enddo} ;\textcolor{keywordflow}{ enddo}
561     \textcolor{keyword}{call }post\_data(cs%id\_KhTr\_h, kh\_h, cs%diag, mask=g%mask2dT)
562 \textcolor{keywordflow}{  endif}
563 
564 
565   \textcolor{keywordflow}{if} (cs%debug) \textcolor{keywordflow}{then}
566     \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"After tracer diffusion khdt\_[xy]"}, khdt\_x, khdt\_y, &
567                   g%HI, haloshift=0, symmetric=.true., scale=us%L\_to\_m**2, &
568                   scalar\_pair=.true.)
569     \textcolor{keywordflow}{if} (cs%use\_neutral\_diffusion) \textcolor{keywordflow}{then}
570       \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"After tracer diffusion Coef\_[xy]"}, coef\_x, coef\_y, &
571                     g%HI, haloshift=0, symmetric=.true., scale=us%L\_to\_m**2, &
572                     scalar\_pair=.true.)
573 \textcolor{keywordflow}{    endif}
574 \textcolor{keywordflow}{  endif}
575 
576   \textcolor{keywordflow}{if} (cs%id\_khdt\_x > 0) \textcolor{keyword}{call }post\_data(cs%id\_khdt\_x, khdt\_x, cs%diag)
577   \textcolor{keywordflow}{if} (cs%id\_khdt\_y > 0) \textcolor{keyword}{call }post\_data(cs%id\_khdt\_y, khdt\_y, cs%diag)
578 
579   \textcolor{keywordflow}{if} (cs%show\_call\_tree) \textcolor{keyword}{call }calltree\_leave(\textcolor{stringliteral}{"tracer\_hordiff()"})
580 
\end{DoxyCode}
