\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}