\hypertarget{namespacemom__barotropic}{}\section{mom\+\_\+barotropic Module Reference} \label{namespacemom__barotropic}\index{mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsection{Detailed Description} Baropotric solver. By Robert Hallberg, April 1994 -\/ January 2007. This program contains the subroutines that time steps the linearized barotropic equations. btstep is used to actually time step the barotropic equations, and contains most of the substance of this module. btstep uses a forwards-\/backwards based scheme to time step the barotropic equations, returning the layers\textquotesingle{} accelerations due to the barotropic changes in the ocean state, the final free surface height (or column mass), and the volume (or mass) fluxes summed through the layers and averaged over the baroclinic time step. As input, btstep takes the initial 3-\/D velocities, the inital free surface height, the 3-\/D accelerations of the layers, and the external forcing. Everything in btstep is cast in terms of anomalies, so if everything is in balance, there is explicitly no acceleration due to btstep. The spatial discretization of the continuity equation is second order accurate. A flux conservative form is used to guarantee global conservation of volume. The spatial discretization of the momentum equation is second order accurate. The Coriolis force is written in a form which does not contribute to the energy tendency and which conserves linearized potential vorticity, f/D. These terms are exactly removed from the baroclinic momentum equations, so the linearization of vorticity advection will not degrade the overall solution. btcalc calculates the fractional thickness of each layer at the velocity points, for later use in calculating the barotropic velocities and the averaged accelerations. Harmonic mean thicknesses (i.\+e. 2$\ast$h\+\_\+\+L$\ast$h\+\_\+\+R/(h\+\_\+L + h\+\_\+R)) are used to avoid overly strong weighting of overly thin layers. This may later be relaxed to use thicknesses determined from the continuity equations. bt\+\_\+mass\+\_\+source determines the real mass sources for the barotropic solver, along with the corrective pseudo-\/fluxes that keep the barotropic and baroclinic estimates of the free surface height close to each other. Given the layer thicknesses and the free surface height that correspond to each other, it calculates a corrective mass source that is added to the barotropic continuity$\ast$ equation, and optionally adjusts a slowly varying correction rate. Newer algorithmic changes have deemphasized the need for this, but it is still here to add net water sources to the barotropic solver.$\ast$ barotropic\+\_\+init allocates and initializes any barotropic arrays that have not been read from a restart file, reads parameters from the inputfile, and sets up diagnostic fields. barotropic\+\_\+end deallocates anything allocated in barotropic\+\_\+init or register\+\_\+barotropic\+\_\+restarts. register\+\_\+barotropic\+\_\+restarts is used to indicate any fields that are private to the barotropic solver that need to be included in the restart files, and to ensure that they are read. \subsection*{Data Types} \begin{DoxyCompactItemize} \item type \hyperlink{structmom__barotropic_1_1barotropic__cs}{barotropic\+\_\+cs} \begin{DoxyCompactList}\small\item\em The barotropic stepping control stucture. \end{DoxyCompactList}\item type \hyperlink{structmom__barotropic_1_1bt__obc__type}{bt\+\_\+obc\+\_\+type} \begin{DoxyCompactList}\small\item\em The barotropic stepping open boundary condition type. \end{DoxyCompactList}\item type \hyperlink{structmom__barotropic_1_1local__bt__cont__u__type}{local\+\_\+bt\+\_\+cont\+\_\+u\+\_\+type} \begin{DoxyCompactList}\small\item\em A desciption of the functional dependence of transport at a u-\/point. \end{DoxyCompactList}\item type \hyperlink{structmom__barotropic_1_1local__bt__cont__v__type}{local\+\_\+bt\+\_\+cont\+\_\+v\+\_\+type} \begin{DoxyCompactList}\small\item\em A desciption of the functional dependence of transport at a v-\/point. \end{DoxyCompactList}\item type \hyperlink{structmom__barotropic_1_1memory__size__type}{memory\+\_\+size\+\_\+type} \begin{DoxyCompactList}\small\item\em A container for passing around active tracer point memory limits. \end{DoxyCompactList}\end{DoxyCompactItemize} \subsection*{Functions/\+Subroutines} \begin{DoxyCompactItemize} \item subroutine, public \hyperlink{namespacemom__barotropic_ac60353f002de5980317d117a3db1a075}{btstep} (U\+\_\+in, V\+\_\+in, eta\+\_\+in, dt, bc\+\_\+accel\+\_\+u, bc\+\_\+accel\+\_\+v, forces, pbce, eta\+\_\+\+P\+F\+\_\+in, U\+\_\+\+Cor, V\+\_\+\+Cor, accel\+\_\+layer\+\_\+u, accel\+\_\+layer\+\_\+v, eta\+\_\+out, uhbtav, vhbtav, G, GV, US, CS, visc\+\_\+rem\+\_\+u, visc\+\_\+rem\+\_\+v, etaav, A\+Dp, O\+BC, B\+T\+\_\+cont, eta\+\_\+\+P\+F\+\_\+start, taux\+\_\+bot, tauy\+\_\+bot, uh0, vh0, u\+\_\+uh0, v\+\_\+vh0) \begin{DoxyCompactList}\small\item\em This subroutine time steps the barotropic equations explicitly. For gravity waves, anything between a forwards-\/backwards scheme and a simulated backwards Euler scheme is used, with bebt between 0.\+0 and 1.\+0 determining the scheme. In practice, bebt must be of order 0.\+2 or greater. A forwards-\/backwards treatment of the Coriolis terms is always used. \end{DoxyCompactList}\item subroutine, public \hyperlink{namespacemom__barotropic_a486257b675aa4e81c2d1634b5288a67f}{set\+\_\+dtbt} (G, GV, US, CS, eta, pbce, B\+T\+\_\+cont, gtot\+\_\+est, S\+S\+H\+\_\+add) \begin{DoxyCompactList}\small\item\em This subroutine automatically determines an optimal value for dtbt based on some state of the ocean. \end{DoxyCompactList}\item subroutine \hyperlink{namespacemom__barotropic_ac9d3db838f0cbee31785077b261c0ad1}{apply\+\_\+velocity\+\_\+obcs} (O\+BC, ubt, vbt, uhbt, vhbt, ubt\+\_\+trans, vbt\+\_\+trans, eta, ubt\+\_\+old, vbt\+\_\+old, B\+T\+\_\+\+O\+BC, G, MS, US, halo, dtbt, bebt, use\+\_\+\+B\+T\+\_\+cont, integral\+\_\+\+B\+T\+\_\+cont, dt\+\_\+elapsed, Datu, Datv, B\+T\+C\+L\+\_\+u, B\+T\+C\+L\+\_\+v, uhbt0, vhbt0, ubt\+\_\+int, vbt\+\_\+int, uhbt\+\_\+int, vhbt\+\_\+int) \begin{DoxyCompactList}\small\item\em The following 4 subroutines apply the open boundary conditions. This subroutine applies the open boundary conditions on barotropic velocities and mass transports, as developed by Mehmet Ilicak. \end{DoxyCompactList}\item subroutine \hyperlink{namespacemom__barotropic_af8296e1b2f7a24a091c7ad563393edb0}{set\+\_\+up\+\_\+bt\+\_\+obc} (O\+BC, eta, B\+T\+\_\+\+O\+BC, B\+T\+\_\+\+Domain, G, GV, US, MS, halo, use\+\_\+\+B\+T\+\_\+cont, integral\+\_\+\+B\+T\+\_\+cont, dt\+\_\+baroclinic, Datu, Datv, B\+T\+C\+L\+\_\+u, B\+T\+C\+L\+\_\+v) \begin{DoxyCompactList}\small\item\em This subroutine sets up the private structure used to apply the open boundary conditions, as developed by Mehmet Ilicak. \end{DoxyCompactList}\item subroutine \hyperlink{namespacemom__barotropic_ac8250401fa646cce0f3108587caf19be}{destroy\+\_\+bt\+\_\+obc} (B\+T\+\_\+\+O\+BC) \begin{DoxyCompactList}\small\item\em Clean up the B\+T\+\_\+\+O\+BC memory. \end{DoxyCompactList}\item subroutine, public \hyperlink{namespacemom__barotropic_aa60ee766449413de40cdbc19964a6556}{btcalc} (h, G, GV, CS, h\+\_\+u, h\+\_\+v, may\+\_\+use\+\_\+default, O\+BC) \begin{DoxyCompactList}\small\item\em btcalc calculates the barotropic velocities from the full velocity and thickness fields, determines the fraction of the total water column in each layer at velocity points, and determines a corrective fictitious mass source that will drive the barotropic estimate of the free surface height toward the baroclinic estimate. \end{DoxyCompactList}\item real function \hyperlink{namespacemom__barotropic_a8ad2b12e885746401a97fd65ad189722}{find\+\_\+uhbt} (u, B\+TC) \begin{DoxyCompactList}\small\item\em The function find\+\_\+uhbt determines the zonal transport for a given velocity, or with I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT=True it determines the time-\/integrated zonal transport for a given time-\/integrated velocity. \end{DoxyCompactList}\item real function \hyperlink{namespacemom__barotropic_abcc5b7bef6e5c17630b05962d61995e3}{find\+\_\+duhbt\+\_\+du} (u, B\+TC) \begin{DoxyCompactList}\small\item\em The function find\+\_\+duhbt\+\_\+du determines the marginal zonal face area for a given velocity, or with I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT=True for a given time-\/integrated velocity. \end{DoxyCompactList}\item real function \hyperlink{namespacemom__barotropic_a0311f0f3d4e27f4017582d6a8c01298c}{uhbt\+\_\+to\+\_\+ubt} (uhbt, B\+TC, guess) \begin{DoxyCompactList}\small\item\em This function inverts the transport function to determine the barotopic velocity that is consistent with a given transport, or if I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT=True this finds the time-\/integrated velocity that is consistent with a time-\/integrated transport. \end{DoxyCompactList}\item real function \hyperlink{namespacemom__barotropic_ae96b701027f6f77feed0f68515b31e55}{find\+\_\+vhbt} (v, B\+TC) \begin{DoxyCompactList}\small\item\em The function find\+\_\+vhbt determines the meridional transport for a given velocity, or with I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT=True it determines the time-\/integrated meridional transport for a given time-\/integrated velocity. \end{DoxyCompactList}\item real function \hyperlink{namespacemom__barotropic_a951d827a745c277e8950a091c060ee86}{find\+\_\+dvhbt\+\_\+dv} (v, B\+TC) \begin{DoxyCompactList}\small\item\em The function find\+\_\+dvhbt\+\_\+dv determines the marginal meridional face area for a given velocity, or with I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT=True for a given time-\/integrated velocity. \end{DoxyCompactList}\item real function \hyperlink{namespacemom__barotropic_aeed3e618781611b448105a122e1a358c}{vhbt\+\_\+to\+\_\+vbt} (vhbt, B\+TC, guess) \begin{DoxyCompactList}\small\item\em This function inverts the transport function to determine the barotopic velocity that is consistent with a given transport, or if I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT=True this finds the time-\/integrated velocity that is consistent with a time-\/integrated transport. \end{DoxyCompactList}\item subroutine \hyperlink{namespacemom__barotropic_a2be327af11ae54368acd32a3ba360ac4}{set\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types} (B\+T\+\_\+cont, B\+T\+C\+L\+\_\+u, B\+T\+C\+L\+\_\+v, G, US, MS, B\+T\+\_\+\+Domain, halo, dt\+\_\+baroclinic) \begin{DoxyCompactList}\small\item\em This subroutine sets up reordered versions of the B\+T\+\_\+cont type in the local\+\_\+\+B\+T\+\_\+cont types, which have wide halos properly filled in. \end{DoxyCompactList}\item subroutine \hyperlink{namespacemom__barotropic_a6cf9cc852f7d2fb328fae4cad1c287c1}{adjust\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types} (ubt, uhbt, vbt, vhbt, B\+T\+C\+L\+\_\+u, B\+T\+C\+L\+\_\+v, G, US, MS, halo, dt\+\_\+baroclinic) \begin{DoxyCompactList}\small\item\em Adjust\+\_\+local\+\_\+\+B\+T\+\_\+cont\+\_\+types expands the range of velocities with a cubic curve translating velocities into transports to match the inital values of velocities and summed transports when the velocities are larger than the first guesses of the cubic transition velocities used to set up the local\+\_\+\+B\+T\+\_\+cont types. \end{DoxyCompactList}\item subroutine \hyperlink{namespacemom__barotropic_ac7100cec548b4bf6d69d4a52e074a04f}{bt\+\_\+cont\+\_\+to\+\_\+face\+\_\+areas} (B\+T\+\_\+cont, Datu, Datv, G, US, MS, halo, maximize) \begin{DoxyCompactList}\small\item\em This subroutine uses the B\+T\+CL types to find typical or maximum face areas, which can then be used for finding wave speeds, etc. \end{DoxyCompactList}\item subroutine \hyperlink{namespacemom__barotropic_af1813744cf2034c2413ef904bf628263}{swap} (a, b) \begin{DoxyCompactList}\small\item\em Swap the values of two real variables. \end{DoxyCompactList}\item subroutine \hyperlink{namespacemom__barotropic_aba29d11dc2530622be997c069fb932ae}{find\+\_\+face\+\_\+areas} (Datu, Datv, G, GV, US, CS, MS, eta, halo, add\+\_\+max) \begin{DoxyCompactList}\small\item\em This subroutine determines the open face areas of cells for calculating the barotropic transport. \end{DoxyCompactList}\item subroutine, public \hyperlink{namespacemom__barotropic_a856387dc8ee2b7b50ea2bd9fca16db78}{bt\+\_\+mass\+\_\+source} (h, eta, set\+\_\+cor, G, GV, CS) \begin{DoxyCompactList}\small\item\em bt\+\_\+mass\+\_\+source determines the appropriately limited mass source for the barotropic solver, along with a corrective fictitious mass source that will drive the barotropic estimate of the free surface height toward the baroclinic estimate. \end{DoxyCompactList}\item subroutine, public \hyperlink{namespacemom__barotropic_a59244968890766632554a6d271ec4499}{barotropic\+\_\+init} (u, v, h, eta, Time, G, GV, US, param\+\_\+file, diag, CS, restart\+\_\+\+CS, calc\+\_\+dtbt, B\+T\+\_\+cont, tides\+\_\+\+C\+Sp) \begin{DoxyCompactList}\small\item\em barotropic\+\_\+init initializes a number of time-\/invariant fields used in the barotropic calculation and initializes any barotropic fields that have not already been initialized. \end{DoxyCompactList}\item subroutine, public \hyperlink{namespacemom__barotropic_aa059fdf7e6002b13d942f96ef17a5db6}{barotropic\+\_\+get\+\_\+tav} (CS, ubtav, vbtav, G, US) \begin{DoxyCompactList}\small\item\em Copies ubtav and vbtav from private type into arrays. \end{DoxyCompactList}\item subroutine, public \hyperlink{namespacemom__barotropic_aee694cdef3a20b960aff1ec4fa5da28f}{barotropic\+\_\+end} (CS) \begin{DoxyCompactList}\small\item\em Clean up the barotropic control structure. \end{DoxyCompactList}\item subroutine, public \hyperlink{namespacemom__barotropic_a28fa2e7600a471735c3b827ac08ed94b}{register\+\_\+barotropic\+\_\+restarts} (HI, GV, param\+\_\+file, CS, restart\+\_\+\+CS) \begin{DoxyCompactList}\small\item\em This subroutine is used to register any fields from \hyperlink{MOM__barotropic_8F90_source}{M\+O\+M\+\_\+barotropic.\+F90} that should be written to or read from the restart file. \end{DoxyCompactList}\end{DoxyCompactItemize} \subsection*{Variables} \textbf{ }\par \begin{DoxyCompactItemize} \item \mbox{\Hypertarget{namespacemom__barotropic_ae71abf473e3483226651abb790cf1e2b}\label{namespacemom__barotropic_ae71abf473e3483226651abb790cf1e2b}} integer \hyperlink{namespacemom__barotropic_ae71abf473e3483226651abb790cf1e2b}{id\+\_\+clock\+\_\+sync} =-\/1 \begin{DoxyCompactList}\small\item\em C\+PU time clock I\+Ds. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_a30989767cf3f852158de8fdbcbb6a272}\label{namespacemom__barotropic_a30989767cf3f852158de8fdbcbb6a272}} integer \hyperlink{namespacemom__barotropic_a30989767cf3f852158de8fdbcbb6a272}{id\+\_\+clock\+\_\+calc} =-\/1 \begin{DoxyCompactList}\small\item\em C\+PU time clock I\+Ds. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_abc096fcad8b8bf59f220d00adfce9de8}\label{namespacemom__barotropic_abc096fcad8b8bf59f220d00adfce9de8}} integer \hyperlink{namespacemom__barotropic_abc096fcad8b8bf59f220d00adfce9de8}{id\+\_\+clock\+\_\+calc\+\_\+pre} =-\/1 \begin{DoxyCompactList}\small\item\em C\+PU time clock I\+Ds. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_a0b999fb31c536d29b1d6503bb4501abc}\label{namespacemom__barotropic_a0b999fb31c536d29b1d6503bb4501abc}} integer \hyperlink{namespacemom__barotropic_a0b999fb31c536d29b1d6503bb4501abc}{id\+\_\+clock\+\_\+calc\+\_\+post} =-\/1 \begin{DoxyCompactList}\small\item\em C\+PU time clock I\+Ds. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_a2df2b958844a4701d4584219b168bd1a}\label{namespacemom__barotropic_a2df2b958844a4701d4584219b168bd1a}} integer \hyperlink{namespacemom__barotropic_a2df2b958844a4701d4584219b168bd1a}{id\+\_\+clock\+\_\+pass\+\_\+step} =-\/1 \begin{DoxyCompactList}\small\item\em C\+PU time clock I\+Ds. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_a97318a4f938ac5caccd486bac83867ca}\label{namespacemom__barotropic_a97318a4f938ac5caccd486bac83867ca}} integer \hyperlink{namespacemom__barotropic_a97318a4f938ac5caccd486bac83867ca}{id\+\_\+clock\+\_\+pass\+\_\+pre} =-\/1 \begin{DoxyCompactList}\small\item\em C\+PU time clock I\+Ds. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_a12c05c28cd9c104c180f45c5b666b92a}\label{namespacemom__barotropic_a12c05c28cd9c104c180f45c5b666b92a}} integer \hyperlink{namespacemom__barotropic_a12c05c28cd9c104c180f45c5b666b92a}{id\+\_\+clock\+\_\+pass\+\_\+post} =-\/1 \begin{DoxyCompactList}\small\item\em C\+PU time clock I\+Ds. \end{DoxyCompactList}\end{DoxyCompactItemize} \textbf{ }\par \begin{DoxyCompactItemize} \item \mbox{\Hypertarget{namespacemom__barotropic_af7eb111a979084e72d6b3474d07bce8f}\label{namespacemom__barotropic_af7eb111a979084e72d6b3474d07bce8f}} integer, parameter \hyperlink{namespacemom__barotropic_af7eb111a979084e72d6b3474d07bce8f}{harmonic} = 1 \begin{DoxyCompactList}\small\item\em Enumeration values for various schemes. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_a735fe88440ec7db07f6640ae9f7b039a}\label{namespacemom__barotropic_a735fe88440ec7db07f6640ae9f7b039a}} integer, parameter \hyperlink{namespacemom__barotropic_a735fe88440ec7db07f6640ae9f7b039a}{arithmetic} = 2 \begin{DoxyCompactList}\small\item\em Enumeration values for various schemes. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_a2e9f6ac6029c84484a0f812a218e9744}\label{namespacemom__barotropic_a2e9f6ac6029c84484a0f812a218e9744}} integer, parameter \hyperlink{namespacemom__barotropic_a2e9f6ac6029c84484a0f812a218e9744}{hybrid} = 3 \begin{DoxyCompactList}\small\item\em Enumeration values for various schemes. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_ae6d8f02c3c032f7d1bee65d44ba7051c}\label{namespacemom__barotropic_ae6d8f02c3c032f7d1bee65d44ba7051c}} integer, parameter \hyperlink{namespacemom__barotropic_ae6d8f02c3c032f7d1bee65d44ba7051c}{from\+\_\+bt\+\_\+cont} = 4 \begin{DoxyCompactList}\small\item\em Enumeration values for various schemes. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_a43b704235c923945333ed5db9508ceb5}\label{namespacemom__barotropic_a43b704235c923945333ed5db9508ceb5}} integer, parameter \hyperlink{namespacemom__barotropic_a43b704235c923945333ed5db9508ceb5}{hybrid\+\_\+bt\+\_\+cont} = 5 \begin{DoxyCompactList}\small\item\em Enumeration values for various schemes. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_a67640d662625af66dca3192d66977674}\label{namespacemom__barotropic_a67640d662625af66dca3192d66977674}} character $\ast$(20), parameter \hyperlink{namespacemom__barotropic_a67640d662625af66dca3192d66977674}{hybrid\+\_\+string} = \char`\"{}H\+Y\+B\+R\+ID\char`\"{} \begin{DoxyCompactList}\small\item\em Enumeration values for various schemes. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_a59ac414d21b35014c3f3a29ad7d7291f}\label{namespacemom__barotropic_a59ac414d21b35014c3f3a29ad7d7291f}} character $\ast$(20), parameter \hyperlink{namespacemom__barotropic_a59ac414d21b35014c3f3a29ad7d7291f}{harmonic\+\_\+string} = \char`\"{}H\+A\+R\+M\+O\+N\+IC\char`\"{} \begin{DoxyCompactList}\small\item\em Enumeration values for various schemes. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_a9a0a9a3013efa01f7bf1f59f53d8405c}\label{namespacemom__barotropic_a9a0a9a3013efa01f7bf1f59f53d8405c}} character $\ast$(20), parameter \hyperlink{namespacemom__barotropic_a9a0a9a3013efa01f7bf1f59f53d8405c}{arithmetic\+\_\+string} = \char`\"{}A\+R\+I\+T\+H\+M\+E\+T\+IC\char`\"{} \begin{DoxyCompactList}\small\item\em Enumeration values for various schemes. \end{DoxyCompactList}\item \mbox{\Hypertarget{namespacemom__barotropic_aedbe3a001b7245a84315fb2a9c9ccde7}\label{namespacemom__barotropic_aedbe3a001b7245a84315fb2a9c9ccde7}} character $\ast$(20), parameter \hyperlink{namespacemom__barotropic_aedbe3a001b7245a84315fb2a9c9ccde7}{bt\+\_\+cont\+\_\+string} = \char`\"{}F\+R\+O\+M\+\_\+\+B\+T\+\_\+\+C\+O\+NT\char`\"{} \begin{DoxyCompactList}\small\item\em Enumeration values for various schemes. \end{DoxyCompactList}\end{DoxyCompactItemize} \subsection{Function/\+Subroutine Documentation} \mbox{\Hypertarget{namespacemom__barotropic_a6cf9cc852f7d2fb328fae4cad1c287c1}\label{namespacemom__barotropic_a6cf9cc852f7d2fb328fae4cad1c287c1}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!adjust\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types@{adjust\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types}} \index{adjust\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types@{adjust\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{adjust\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types()}{adjust\_local\_bt\_cont\_types()}} {\footnotesize\ttfamily subroutine mom\+\_\+barotropic\+::adjust\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types (\begin{DoxyParamCaption}\item[{real, dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(in)}]{ubt, }\item[{real, dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(in)}]{uhbt, }\item[{real, dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(in)}]{vbt, }\item[{real, dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(in)}]{vhbt, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__u__type}{local\+\_\+bt\+\_\+cont\+\_\+u\+\_\+type}), dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(out)}]{B\+T\+C\+L\+\_\+u, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__v__type}{local\+\_\+bt\+\_\+cont\+\_\+v\+\_\+type}), dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(out)}]{B\+T\+C\+L\+\_\+v, }\item[{type(ocean\+\_\+grid\+\_\+type), intent(in)}]{G, }\item[{type(unit\+\_\+scale\+\_\+type), intent(in)}]{US, }\item[{type(\hyperlink{structmom__barotropic_1_1memory__size__type}{memory\+\_\+size\+\_\+type}), intent(in)}]{MS, }\item[{integer, intent(in), optional}]{halo, }\item[{real, intent(in), optional}]{dt\+\_\+baroclinic }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} Adjust\+\_\+local\+\_\+\+B\+T\+\_\+cont\+\_\+types expands the range of velocities with a cubic curve translating velocities into transports to match the inital values of velocities and summed transports when the velocities are larger than the first guesses of the cubic transition velocities used to set up the local\+\_\+\+B\+T\+\_\+cont types. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in} & {\em ms} & A type that describes the memory sizes of the argument arrays.\\ \hline \mbox{\tt in} & {\em ubt} & The linearization zonal barotropic velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em uhbt} & The linearization zonal barotropic transport\\ \hline \mbox{\tt in} & {\em vbt} & The linearization meridional barotropic velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em vhbt} & The linearization meridional barotropic transport\\ \hline \mbox{\tt out} & {\em btcl\+\_\+u} & A structure with the u information from B\+T\+\_\+cont.\\ \hline \mbox{\tt out} & {\em btcl\+\_\+v} & A structure with the v information from B\+T\+\_\+cont.\\ \hline \mbox{\tt in} & {\em g} & The ocean\textquotesingle{}s grid structure.\\ \hline \mbox{\tt in} & {\em us} & A dimensional unit scaling type\\ \hline \mbox{\tt in} & {\em halo} & The extra halo size to use here.\\ \hline \mbox{\tt in} & {\em dt\+\_\+baroclinic} & The baroclinic time step \mbox{[}T $\sim$$>$ s\mbox{]}, which is provided if I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+N\+T\+I\+N\+U\+I\+TY is true. \\ \hline \end{DoxyParams} Definition at line 3897 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 3897 \textcolor{keywordtype}{type}(memory\_size\_type), \textcolor{keywordtype}{intent(in)} :: ms\textcolor{comment}{ !< A type that describes the memory sizes of the argument arrays.} 3898 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, & 3899 \textcolor{keywordtype}{intent(in)} :: ubt\textcolor{comment}{ !< The linearization zonal barotropic velocity [L T-1 ~> m s-1].} 3900 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, & 3901 \textcolor{keywordtype}{intent(in)} :: uhbt\textcolor{comment}{ !< The linearization zonal barotropic transport} 3902 \textcolor{comment}{ !! [H L2 T-1 ~> m3 s-1 or kg s-1].} 3903 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, & 3904 \textcolor{keywordtype}{intent(in)} :: vbt\textcolor{comment}{ !< The linearization meridional barotropic velocity [L T-1 ~> m s-1].} 3905 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, & 3906 \textcolor{keywordtype}{intent(in)} :: vhbt\textcolor{comment}{ !< The linearization meridional barotropic transport} 3907 \textcolor{comment}{ !! [H L2 T-1 ~> m3 s-1 or kg s-1].} 3908 \textcolor{keywordtype}{type}(local\_bt\_cont\_u\_type), \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, & 3909 \textcolor{keywordtype}{intent(out)} :: btcl\_u\textcolor{comment}{ !< A structure with the u information from BT\_cont.} 3910 \textcolor{keywordtype}{type}(local\_bt\_cont\_v\_type), \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, & 3911 \textcolor{keywordtype}{intent(out)} :: btcl\_v\textcolor{comment}{ !< A structure with the v information from BT\_cont.} 3912 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(in)} :: g\textcolor{comment}{ !< The ocean's grid structure.} 3913 \textcolor{keywordtype}{type}(unit\_scale\_type), \textcolor{keywordtype}{intent(in)} :: us\textcolor{comment}{ !< A dimensional unit scaling type} 3914 \textcolor{keywordtype}{integer}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: halo\textcolor{comment}{ !< The extra halo size to use here.} 3915 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: dt\_baroclinic\textcolor{comment}{ !< The baroclinic time step [T ~> s], which is} 3916 \textcolor{comment}{ !! provided if INTEGRAL\_BT\_CONTINUITY is true.} 3917 3918 \textcolor{comment}{! Local variables} 3919 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))} :: & 3920 u\_polarity, ubt\_ee, ubt\_ww, fa\_u\_ee, fa\_u\_e0, fa\_u\_w0, fa\_u\_ww 3921 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))} :: & 3922 v\_polarity, vbt\_nn, vbt\_ss, fa\_v\_nn, fa\_v\_n0, fa\_v\_s0, fa\_v\_ss 3923 \textcolor{keywordtype}{real} :: dt \textcolor{comment}{! The baroclinic timestep [T ~> s] or 1.0 [nondim]} 3924 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{parameter} :: c1\_3 = 1.0/3.0 3925 \textcolor{keywordtype}{integer} :: i, j, is, ie, js, je, hs 3926 3927 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec 3928 hs = 1 ; \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(halo)) hs = max(halo,0) 3929 dt = 1.0 ; \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(dt\_baroclinic)) dt = dt\_baroclinic 3930 3931 \textcolor{comment}{!$OMP parallel do default(shared)} 3932 \textcolor{keywordflow}{do} j=js-hs,je+hs ; \textcolor{keywordflow}{do} i=is-hs-1,ie+hs 3933 \textcolor{keywordflow}{if} ((dt*ubt(i,j) > btcl\_u(i,j)%uBT\_WW) .and. (dt*uhbt(i,j) > btcl\_u(i,j)%uh\_WW)) \textcolor{keywordflow}{then} 3934 \textcolor{comment}{! Expand the cubic fit to use this new point. ubt is negative.} 3935 btcl\_u(i,j)%ubt\_WW = dt * ubt(i,j) 3936 \textcolor{keywordflow}{if} (3.0*uhbt(i,j) < 2.0*ubt(i,j) * btcl\_u(i,j)%FA\_u\_W0) \textcolor{keywordflow}{then} 3937 \textcolor{comment}{! No further bounding is needed.} 3938 btcl\_u(i,j)%uh\_crvW = (uhbt(i,j) - ubt(i,j) * btcl\_u(i,j)%FA\_u\_W0) / (dt**2 * ubt(i,j)**3) 3939 \textcolor{keywordflow}{else} \textcolor{comment}{! This should not happen often!} 3940 btcl\_u(i,j)%FA\_u\_W0 = 1.5*uhbt(i,j) / ubt(i,j) 3941 btcl\_u(i,j)%uh\_crvW = -0.5*uhbt(i,j) / (dt**2 * ubt(i,j)**3) 3942 \textcolor{keywordflow}{ endif} 3943 btcl\_u(i,j)%uh\_WW = dt * uhbt(i,j) 3944 \textcolor{comment}{! I don't know whether this is helpful.} 3945 \textcolor{comment}{! BTCL\_u(I,j)%FA\_u\_WW = min(BTCL\_u(I,j)%FA\_u\_WW, uhbt(I,j) / ubt(I,j))} 3946 \textcolor{keywordflow}{elseif} ((dt*ubt(i,j) < btcl\_u(i,j)%uBT\_EE) .and. (dt*uhbt(i,j) < btcl\_u(i,j)%uh\_EE)) \textcolor{keywordflow}{then} 3947 \textcolor{comment}{! Expand the cubic fit to use this new point. ubt is negative.} 3948 btcl\_u(i,j)%ubt\_EE = dt * ubt(i,j) 3949 \textcolor{keywordflow}{if} (3.0*uhbt(i,j) < 2.0*ubt(i,j) * btcl\_u(i,j)%FA\_u\_E0) \textcolor{keywordflow}{then} 3950 \textcolor{comment}{! No further bounding is needed.} 3951 btcl\_u(i,j)%uh\_crvE = (uhbt(i,j) - ubt(i,j) * btcl\_u(i,j)%FA\_u\_E0) / (dt**2 * ubt(i,j)**3) 3952 \textcolor{keywordflow}{else} \textcolor{comment}{! This should not happen often!} 3953 btcl\_u(i,j)%FA\_u\_E0 = 1.5*uhbt(i,j) / ubt(i,j) 3954 btcl\_u(i,j)%uh\_crvE = -0.5*uhbt(i,j) / (dt**2 * ubt(i,j)**3) 3955 \textcolor{keywordflow}{ endif} 3956 btcl\_u(i,j)%uh\_EE = dt * uhbt(i,j) 3957 \textcolor{comment}{! I don't know whether this is helpful.} 3958 \textcolor{comment}{! BTCL\_u(I,j)%FA\_u\_EE = min(BTCL\_u(I,j)%FA\_u\_EE, uhbt(I,j) / ubt(I,j))} 3959 \textcolor{keywordflow}{ endif} 3960 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3961 \textcolor{comment}{!$OMP parallel do default(shared)} 3962 \textcolor{keywordflow}{do} j=js-hs-1,je+hs ; \textcolor{keywordflow}{do} i=is-hs,ie+hs 3963 \textcolor{keywordflow}{if} ((dt*vbt(i,j) > btcl\_v(i,j)%vBT\_SS) .and. (dt*vhbt(i,j) > btcl\_v(i,j)%vh\_SS)) \textcolor{keywordflow}{then} 3964 \textcolor{comment}{! Expand the cubic fit to use this new point. vbt is negative.} 3965 btcl\_v(i,j)%vbt\_SS = dt * vbt(i,j) 3966 \textcolor{keywordflow}{if} (3.0*vhbt(i,j) < 2.0*vbt(i,j) * btcl\_v(i,j)%FA\_v\_S0) \textcolor{keywordflow}{then} 3967 \textcolor{comment}{! No further bounding is needed.} 3968 btcl\_v(i,j)%vh\_crvS = (vhbt(i,j) - vbt(i,j) * btcl\_v(i,j)%FA\_v\_S0) / (dt**2 * vbt(i,j)**3) 3969 \textcolor{keywordflow}{else} \textcolor{comment}{! This should not happen often!} 3970 btcl\_v(i,j)%FA\_v\_S0 = 1.5*vhbt(i,j) / (vbt(i,j)) 3971 btcl\_v(i,j)%vh\_crvS = -0.5*vhbt(i,j) / (dt**2 * vbt(i,j)**3) 3972 \textcolor{keywordflow}{ endif} 3973 btcl\_v(i,j)%vh\_SS = dt * vhbt(i,j) 3974 \textcolor{comment}{! I don't know whether this is helpful.} 3975 \textcolor{comment}{! BTCL\_v(i,J)%FA\_v\_SS = min(BTCL\_v(i,J)%FA\_v\_SS, vhbt(i,J) / vbt(i,J))} 3976 \textcolor{keywordflow}{elseif} ((dt*vbt(i,j) < btcl\_v(i,j)%vBT\_NN) .and. (dt*vhbt(i,j) < btcl\_v(i,j)%vh\_NN)) \textcolor{keywordflow}{then} 3977 \textcolor{comment}{! Expand the cubic fit to use this new point. vbt is negative.} 3978 btcl\_v(i,j)%vbt\_NN = dt * vbt(i,j) 3979 \textcolor{keywordflow}{if} (3.0*vhbt(i,j) < 2.0*vbt(i,j) * btcl\_v(i,j)%FA\_v\_N0) \textcolor{keywordflow}{then} 3980 \textcolor{comment}{! No further bounding is needed.} 3981 btcl\_v(i,j)%vh\_crvN = (vhbt(i,j) - vbt(i,j) * btcl\_v(i,j)%FA\_v\_N0) / (dt**2 * vbt(i,j)**3) 3982 \textcolor{keywordflow}{else} \textcolor{comment}{! This should not happen often!} 3983 btcl\_v(i,j)%FA\_v\_N0 = 1.5*vhbt(i,j) / (vbt(i,j)) 3984 btcl\_v(i,j)%vh\_crvN = -0.5*vhbt(i,j) / (dt**2 * vbt(i,j)**3) 3985 \textcolor{keywordflow}{ endif} 3986 btcl\_v(i,j)%vh\_NN = dt * vhbt(i,j) 3987 \textcolor{comment}{! I don't know whether this is helpful.} 3988 \textcolor{comment}{! BTCL\_v(i,J)%FA\_v\_NN = min(BTCL\_v(i,J)%FA\_v\_NN, vhbt(i,J) / vbt(i,J))} 3989 \textcolor{keywordflow}{ endif} 3990 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3991 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_ac9d3db838f0cbee31785077b261c0ad1}\label{namespacemom__barotropic_ac9d3db838f0cbee31785077b261c0ad1}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!apply\+\_\+velocity\+\_\+obcs@{apply\+\_\+velocity\+\_\+obcs}} \index{apply\+\_\+velocity\+\_\+obcs@{apply\+\_\+velocity\+\_\+obcs}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{apply\+\_\+velocity\+\_\+obcs()}{apply\_velocity\_obcs()}} {\footnotesize\ttfamily subroutine mom\+\_\+barotropic\+::apply\+\_\+velocity\+\_\+obcs (\begin{DoxyParamCaption}\item[{type(ocean\+\_\+obc\+\_\+type), pointer}]{O\+BC, }\item[{real, dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(inout)}]{ubt, }\item[{real, dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(inout)}]{vbt, }\item[{real, dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(inout)}]{uhbt, }\item[{real, dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(inout)}]{vhbt, }\item[{real, dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(inout)}]{ubt\+\_\+trans, }\item[{real, dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(inout)}]{vbt\+\_\+trans, }\item[{real, dimension(sziw\+\_\+(ms),szjw\+\_\+(ms)), intent(in)}]{eta, }\item[{real, dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(in)}]{ubt\+\_\+old, }\item[{real, dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(in)}]{vbt\+\_\+old, }\item[{type(\hyperlink{structmom__barotropic_1_1bt__obc__type}{bt\+\_\+obc\+\_\+type}), intent(in)}]{B\+T\+\_\+\+O\+BC, }\item[{type(ocean\+\_\+grid\+\_\+type), intent(inout)}]{G, }\item[{type(\hyperlink{structmom__barotropic_1_1memory__size__type}{memory\+\_\+size\+\_\+type}), intent(in)}]{MS, }\item[{type(unit\+\_\+scale\+\_\+type), intent(in)}]{US, }\item[{integer, intent(in)}]{halo, }\item[{real, intent(in)}]{dtbt, }\item[{real, intent(in)}]{bebt, }\item[{logical, intent(in)}]{use\+\_\+\+B\+T\+\_\+cont, }\item[{logical, intent(in)}]{integral\+\_\+\+B\+T\+\_\+cont, }\item[{real, intent(in)}]{dt\+\_\+elapsed, }\item[{real, dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(in)}]{Datu, }\item[{real, dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(in)}]{Datv, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__u__type}{local\+\_\+bt\+\_\+cont\+\_\+u\+\_\+type}), dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(in)}]{B\+T\+C\+L\+\_\+u, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__v__type}{local\+\_\+bt\+\_\+cont\+\_\+v\+\_\+type}), dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(in)}]{B\+T\+C\+L\+\_\+v, }\item[{real, dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(in)}]{uhbt0, }\item[{real, dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(in)}]{vhbt0, }\item[{real, dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(in)}]{ubt\+\_\+int, }\item[{real, dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(in)}]{vbt\+\_\+int, }\item[{real, dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(in)}]{uhbt\+\_\+int, }\item[{real, dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(in)}]{vhbt\+\_\+int }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} The following 4 subroutines apply the open boundary conditions. This subroutine applies the open boundary conditions on barotropic velocities and mass transports, as developed by Mehmet Ilicak. \begin{DoxyParams}[1]{Parameters} & {\em obc} & An associated pointer to an O\+BC type.\\ \hline \mbox{\tt in,out} & {\em g} & The ocean\textquotesingle{}s grid structure.\\ \hline \mbox{\tt in} & {\em ms} & A type that describes the memory sizes of the argument arrays.\\ \hline \mbox{\tt in,out} & {\em ubt} & the zonal barotropic velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in,out} & {\em uhbt} & the zonal barotropic transport \mbox{[}H L2 T-\/1 $\sim$$>$ m3 s-\/1 or kg s-\/1\mbox{]}.\\ \hline \mbox{\tt in,out} & {\em ubt\+\_\+trans} & The zonal barotropic velocity used in transport \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in,out} & {\em vbt} & The meridional barotropic velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in,out} & {\em vhbt} & the meridional barotropic transport \mbox{[}H L2 T-\/1 $\sim$$>$ m3 s-\/1 or kg s-\/1\mbox{]}.\\ \hline \mbox{\tt in,out} & {\em vbt\+\_\+trans} & the meridional BT velocity used in transports \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em eta} & The barotropic free surface height anomaly or column mass anomaly \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline \mbox{\tt in} & {\em ubt\+\_\+old} & The starting value of ubt in a barotropic step \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em vbt\+\_\+old} & The starting value of vbt in a barotropic step \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em bt\+\_\+obc} & A structure with the private barotropic arrays related to the open boundary conditions, set by set\+\_\+up\+\_\+\+B\+T\+\_\+\+O\+BC.\\ \hline \mbox{\tt in} & {\em us} & A dimensional unit scaling type\\ \hline \mbox{\tt in} & {\em halo} & The extra halo size to use here.\\ \hline \mbox{\tt in} & {\em dtbt} & The time step \mbox{[}T $\sim$$>$ s\mbox{]}.\\ \hline \mbox{\tt in} & {\em bebt} & The fractional weighting of the future velocity in determining the transport.\\ \hline \mbox{\tt in} & {\em use\+\_\+bt\+\_\+cont} & If true, use the B\+T\+\_\+cont\+\_\+types to calculate transports.\\ \hline \mbox{\tt in} & {\em integral\+\_\+bt\+\_\+cont} & If true, update the barotropic continuity equation directly from the initial condition using the time-\/integrated barotropic velocity.\\ \hline \mbox{\tt in} & {\em dt\+\_\+elapsed} & The amount of time in the barotropic stepping that will have elapsed \mbox{[}T $\sim$$>$ s\mbox{]}.\\ \hline \mbox{\tt in} & {\em datu} & A fixed estimate of the face areas at u points \mbox{[}H L $\sim$$>$ m2 or kg m-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em datv} & A fixed estimate of the face areas at v points \mbox{[}H L $\sim$$>$ m2 or kg m-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em btcl\+\_\+u} & Structure of information used for a dynamic estimate of the face areas at u-\/points.\\ \hline \mbox{\tt in} & {\em btcl\+\_\+v} & Structure of information used for a dynamic estimate of the face areas at v-\/points.\\ \hline \mbox{\tt in} & {\em uhbt0} & A correction to the zonal transport so that the barotropic functions agree with the sum of the layer transports \mbox{[}H L2 T-\/1 $\sim$$>$ m3 s-\/1 or kg s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em vhbt0} & A correction to the meridional transport so that the barotropic functions agree with the sum of the layer transports \mbox{[}H L2 T-\/1 $\sim$$>$ m3 s-\/1 or kg s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em ubt\+\_\+int} & The time-\/integrated zonal barotropic velocity before this update \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em uhbt\+\_\+int} & The time-\/integrated zonal barotropic transport \mbox{[}H L2 T-\/1 $\sim$$>$ m3 s-\/1 or kg s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em vbt\+\_\+int} & The time-\/integrated meridional barotropic velocity before this update \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em vhbt\+\_\+int} & The time-\/integrated meridional barotropic transport \mbox{[}H L2 T-\/1 $\sim$$>$ m3 s-\/1 or kg s-\/1\mbox{]}. \\ \hline \end{DoxyParams} Definition at line 2766 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 2766 \textcolor{keywordtype}{type}(ocean\_obc\_type), \textcolor{keywordtype}{pointer} :: obc\textcolor{comment}{ !< An associated pointer to an OBC type.} 2767 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(inout)} :: g\textcolor{comment}{ !< The ocean's grid structure.} 2768 \textcolor{keywordtype}{type}(memory\_size\_type), \textcolor{keywordtype}{intent(in)} :: ms\textcolor{comment}{ !< A type that describes the memory sizes of} 2769 \textcolor{comment}{ !! the argument arrays.} 2770 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(inout)} :: ubt\textcolor{comment}{ !< the zonal barotropic velocity [L T-1 ~> m s-1].} 2771 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(inout)} :: uhbt\textcolor{comment}{ !< the zonal barotropic transport} 2772 \textcolor{comment}{ !! [H L2 T-1 ~> m3 s-1 or kg s-1].} 2773 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(inout)} :: ubt\_trans\textcolor{comment}{ !< The zonal barotropic velocity used in} 2774 \textcolor{comment}{ !! transport [L T-1 ~> m s-1].} 2775 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, \textcolor{keywordtype}{intent(inout)} :: vbt\textcolor{comment}{ !< The meridional barotropic velocity} 2776 \textcolor{comment}{ !! [L T-1 ~> m s-1].} 2777 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, \textcolor{keywordtype}{intent(inout)} :: vhbt\textcolor{comment}{ !< the meridional barotropic transport} 2778 \textcolor{comment}{ !! [H L2 T-1 ~> m3 s-1 or kg s-1].} 2779 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, \textcolor{keywordtype}{intent(inout)} :: vbt\_trans\textcolor{comment}{ !< the meridional BT velocity used in} 2780 \textcolor{comment}{ !! transports [L T-1 ~> m s-1].} 2781 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: eta\textcolor{comment}{ !< The barotropic free surface height anomaly or} 2782 \textcolor{comment}{ !! column mass anomaly [H ~> m or kg m-2].} 2783 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: ubt\_old\textcolor{comment}{ !< The starting value of ubt in a barotropic} 2784 \textcolor{comment}{ !! step [L T-1 ~> m s-1].} 2785 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: vbt\_old\textcolor{comment}{ !< The starting value of vbt in a barotropic} 2786 \textcolor{comment}{ !! step [L T-1 ~> m s-1].} 2787 \textcolor{keywordtype}{type}(bt\_obc\_type), \textcolor{keywordtype}{intent(in)} :: bt\_obc\textcolor{comment}{ !< A structure with the private barotropic arrays} 2788 \textcolor{comment}{ !! related to the open boundary conditions,} 2789 \textcolor{comment}{ !! set by set\_up\_BT\_OBC.} 2790 \textcolor{keywordtype}{type}(unit\_scale\_type), \textcolor{keywordtype}{intent(in)} :: us\textcolor{comment}{ !< A dimensional unit scaling type} 2791 \textcolor{keywordtype}{integer}, \textcolor{keywordtype}{intent(in)} :: halo\textcolor{comment}{ !< The extra halo size to use here.} 2792 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(in)} :: dtbt\textcolor{comment}{ !< The time step [T ~> s].} 2793 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(in)} :: bebt\textcolor{comment}{ !< The fractional weighting of the future velocity} 2794 \textcolor{comment}{ !! in determining the transport.} 2795 \textcolor{keywordtype}{logical}, \textcolor{keywordtype}{intent(in)} :: use\_bt\_cont\textcolor{comment}{ !< If true, use the BT\_cont\_types to calculate} 2796 \textcolor{comment}{ !! transports.} 2797 \textcolor{keywordtype}{logical}, \textcolor{keywordtype}{intent(in)} :: integral\_bt\_cont\textcolor{comment}{ !< If true, update the barotropic continuity} 2798 \textcolor{comment}{ !! equation directly from the initial condition} 2799 \textcolor{comment}{ !! using the time-integrated barotropic velocity.} 2800 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(in)} :: dt\_elapsed\textcolor{comment}{ !< The amount of time in the barotropic stepping} 2801 \textcolor{comment}{ !! that will have elapsed [T ~> s].} 2802 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: datu\textcolor{comment}{ !< A fixed estimate of the face areas at u points} 2803 \textcolor{comment}{ !! [H L ~> m2 or kg m-1].} 2804 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: datv\textcolor{comment}{ !< A fixed estimate of the face areas at v points} 2805 \textcolor{comment}{ !! [H L ~> m2 or kg m-1].} 2806 \textcolor{keywordtype}{type}(local\_bt\_cont\_u\_type), \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: btcl\_u\textcolor{comment}{ !< Structure of information used} 2807 \textcolor{comment}{ !! for a dynamic estimate of the face areas at} 2808 \textcolor{comment}{ !! u-points.} 2809 \textcolor{keywordtype}{type}(local\_bt\_cont\_v\_type), \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: btcl\_v\textcolor{comment}{ !< Structure of information used} 2810 \textcolor{comment}{ !! for a dynamic estimate of the face areas at} 2811 \textcolor{comment}{ !! v-points.} 2812 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: uhbt0\textcolor{comment}{ !< A correction to the zonal transport so that} 2813 \textcolor{comment}{ !! the barotropic functions agree with the sum} 2814 \textcolor{comment}{ !! of the layer transports} 2815 \textcolor{comment}{ !! [H L2 T-1 ~> m3 s-1 or kg s-1].} 2816 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: vhbt0\textcolor{comment}{ !< A correction to the meridional transport so that} 2817 \textcolor{comment}{ !! the barotropic functions agree with the sum} 2818 \textcolor{comment}{ !! of the layer transports} 2819 \textcolor{comment}{ !! [H L2 T-1 ~> m3 s-1 or kg s-1].} 2820 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: ubt\_int\textcolor{comment}{ !< The time-integrated zonal barotropic} 2821 \textcolor{comment}{ !! velocity before this update [L T-1 ~> m s-1].} 2822 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: uhbt\_int\textcolor{comment}{ !< The time-integrated zonal barotropic} 2823 \textcolor{comment}{ !! transport [H L2 T-1 ~> m3 s-1 or kg s-1].} 2824 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: vbt\_int\textcolor{comment}{ !< The time-integrated meridional barotropic} 2825 \textcolor{comment}{ !! velocity before this update [L T-1 ~> m s-1].} 2826 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: vhbt\_int\textcolor{comment}{ !< The time-integrated meridional barotropic} 2827 \textcolor{comment}{ !! transport [H L2 T-1 ~> m3 s-1 or kg s-1].} 2828 2829 \textcolor{comment}{! Local variables} 2830 \textcolor{keywordtype}{real} :: vel\_prev \textcolor{comment}{! The previous velocity [L T-1 ~> m s-1].} 2831 \textcolor{keywordtype}{real} :: vel\_trans \textcolor{comment}{! The combination of the previous and current velocity} 2832 \textcolor{comment}{! that does the mass transport [L T-1 ~> m s-1].} 2833 \textcolor{keywordtype}{real} :: h\_u \textcolor{comment}{! The total thickness at the u-point [H ~> m or kg m-2].} 2834 \textcolor{keywordtype}{real} :: h\_v \textcolor{comment}{! The total thickness at the v-point [H ~> m or kg m-2].} 2835 \textcolor{keywordtype}{real} :: cfl \textcolor{comment}{! The CFL number at the point in question [nondim]} 2836 \textcolor{keywordtype}{real} :: u\_inlet \textcolor{comment}{! The zonal inflow velocity [L T-1 ~> m s-1]} 2837 \textcolor{keywordtype}{real} :: v\_inlet \textcolor{comment}{! The meridional inflow velocity [L T-1 ~> m s-1]} 2838 \textcolor{keywordtype}{real} :: uhbt\_int\_new \textcolor{comment}{! The updated time-integrated zonal transport [H L2 ~> m3]} 2839 \textcolor{keywordtype}{real} :: vhbt\_int\_new \textcolor{comment}{! The updated time-integrated meridional transport [H L2 ~> m3]} 2840 \textcolor{keywordtype}{real} :: h\_in \textcolor{comment}{! The inflow thickess [H ~> m or kg m-2].} 2841 \textcolor{keywordtype}{real} :: cff, cx, cy, tau 2842 \textcolor{keywordtype}{real} :: dhdt, dhdx, dhdy 2843 \textcolor{keywordtype}{real} :: idtbt \textcolor{comment}{! The inverse of the barotropic time step [T-1 ~> s-1]} 2844 \textcolor{keywordtype}{integer} :: i, j, is, ie, js, je 2845 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJB\_(G))} :: grad 2846 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{parameter} :: eps = 1.0e-20 2847 is = g%isc-halo ; ie = g%iec+halo ; js = g%jsc-halo ; je = g%jec+halo 2848 2849 \textcolor{keywordflow}{if} (.not.(bt\_obc%apply\_u\_OBCs .or. bt\_obc%apply\_v\_OBCs)) \textcolor{keywordflow}{return} 2850 2851 idtbt = 1.0 / dtbt 2852 2853 \textcolor{keywordflow}{if} (bt\_obc%apply\_u\_OBCs) \textcolor{keywordflow}{then} 2854 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; \textcolor{keywordflow}{if} (obc%segnum\_u(i,j) /= obc\_none) \textcolor{keywordflow}{then} 2855 \textcolor{keywordflow}{if} (obc%segment(obc%segnum\_u(i,j))%specified) \textcolor{keywordflow}{then} 2856 uhbt(i,j) = bt\_obc%uhbt(i,j) 2857 ubt(i,j) = bt\_obc%ubt\_outer(i,j) 2858 vel\_trans = ubt(i,j) 2859 \textcolor{keywordflow}{elseif} (obc%segment(obc%segnum\_u(i,j))%direction == obc\_direction\_e) \textcolor{keywordflow}{then} 2860 \textcolor{keywordflow}{if} (obc%segment(obc%segnum\_u(i,j))%Flather) \textcolor{keywordflow}{then} 2861 cfl = dtbt * bt\_obc%Cg\_u(i,j) * g%IdxCu(i,j) \textcolor{comment}{! CFL} 2862 u\_inlet = cfl*ubt\_old(i-1,j) + (1.0-cfl)*ubt\_old(i,j) \textcolor{comment}{! Valid for cfl<1} 2863 h\_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) \textcolor{comment}{! internal} 2864 h\_u = bt\_obc%H\_u(i,j) 2865 vel\_prev = ubt(i,j) 2866 ubt(i,j) = 0.5*((u\_inlet + bt\_obc%ubt\_outer(i,j)) + & 2867 (bt\_obc%Cg\_u(i,j)/h\_u) * (h\_in-bt\_obc%eta\_outer\_u(i,j))) 2868 vel\_trans = (1.0-bebt)*vel\_prev + bebt*ubt(i,j) 2869 \textcolor{keywordflow}{elseif} (obc%segment(obc%segnum\_u(i,j))%gradient) \textcolor{keywordflow}{then} 2870 ubt(i,j) = ubt(i-1,j) 2871 vel\_trans = ubt(i,j) 2872 \textcolor{keywordflow}{ endif} 2873 \textcolor{keywordflow}{elseif} (obc%segment(obc%segnum\_u(i,j))%direction == obc\_direction\_w) \textcolor{keywordflow}{then} 2874 \textcolor{keywordflow}{if} (obc%segment(obc%segnum\_u(i,j))%Flather) \textcolor{keywordflow}{then} 2875 cfl = dtbt * bt\_obc%Cg\_u(i,j) * g%IdxCu(i,j) \textcolor{comment}{! CFL} 2876 u\_inlet = cfl*ubt\_old(i+1,j) + (1.0-cfl)*ubt\_old(i,j) \textcolor{comment}{! Valid for cfl<1} 2877 h\_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) \textcolor{comment}{! external} 2878 2879 h\_u = bt\_obc%H\_u(i,j) 2880 vel\_prev = ubt(i,j) 2881 ubt(i,j) = 0.5*((u\_inlet + bt\_obc%ubt\_outer(i,j)) + & 2882 (bt\_obc%Cg\_u(i,j)/h\_u) * (bt\_obc%eta\_outer\_u(i,j)-h\_in)) 2883 2884 vel\_trans = (1.0-bebt)*vel\_prev + bebt*ubt(i,j) 2885 \textcolor{keywordflow}{elseif} (obc%segment(obc%segnum\_u(i,j))%gradient) \textcolor{keywordflow}{then} 2886 ubt(i,j) = ubt(i+1,j) 2887 vel\_trans = ubt(i,j) 2888 \textcolor{keywordflow}{ endif} 2889 \textcolor{keywordflow}{ endif} 2890 2891 \textcolor{keywordflow}{if} (.not. obc%segment(obc%segnum\_u(i,j))%specified) \textcolor{keywordflow}{then} 2892 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 2893 uhbt\_int\_new = find\_uhbt(ubt\_int(i,j) + dtbt*vel\_trans, btcl\_u(i,j)) + & 2894 dt\_elapsed*uhbt0(i,j) 2895 uhbt(i,j) = (uhbt\_int\_new - uhbt\_int(i,j)) * idtbt 2896 \textcolor{keywordflow}{elseif} (use\_bt\_cont) \textcolor{keywordflow}{then} 2897 uhbt(i,j) = find\_uhbt(vel\_trans, btcl\_u(i,j)) + uhbt0(i,j) 2898 \textcolor{keywordflow}{else} 2899 uhbt(i,j) = datu(i,j)*vel\_trans + uhbt0(i,j) 2900 \textcolor{keywordflow}{ endif} 2901 \textcolor{keywordflow}{ endif} 2902 2903 ubt\_trans(i,j) = vel\_trans 2904 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2905 \textcolor{keywordflow}{ endif} 2906 2907 \textcolor{keywordflow}{if} (bt\_obc%apply\_v\_OBCs) \textcolor{keywordflow}{then} 2908 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; \textcolor{keywordflow}{if} (obc%segnum\_v(i,j) /= obc\_none) \textcolor{keywordflow}{then} 2909 \textcolor{keywordflow}{if} (obc%segment(obc%segnum\_v(i,j))%specified) \textcolor{keywordflow}{then} 2910 vhbt(i,j) = bt\_obc%vhbt(i,j) 2911 vbt(i,j) = bt\_obc%vbt\_outer(i,j) 2912 vel\_trans = vbt(i,j) 2913 \textcolor{keywordflow}{elseif} (obc%segment(obc%segnum\_v(i,j))%direction == obc\_direction\_n) \textcolor{keywordflow}{then} 2914 \textcolor{keywordflow}{if} (obc%segment(obc%segnum\_v(i,j))%Flather) \textcolor{keywordflow}{then} 2915 cfl = dtbt * bt\_obc%Cg\_v(i,j) * g%IdyCv(i,j) \textcolor{comment}{! CFL} 2916 v\_inlet = cfl*vbt\_old(i,j-1) + (1.0-cfl)*vbt\_old(i,j) \textcolor{comment}{! Valid for cfl<1} 2917 h\_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) \textcolor{comment}{! internal} 2918 2919 h\_v = bt\_obc%H\_v(i,j) 2920 vel\_prev = vbt(i,j) 2921 vbt(i,j) = 0.5*((v\_inlet + bt\_obc%vbt\_outer(i,j)) + & 2922 (bt\_obc%Cg\_v(i,j)/h\_v) * (h\_in-bt\_obc%eta\_outer\_v(i,j))) 2923 2924 vel\_trans = (1.0-bebt)*vel\_prev + bebt*vbt(i,j) 2925 \textcolor{keywordflow}{elseif} (obc%segment(obc%segnum\_v(i,j))%gradient) \textcolor{keywordflow}{then} 2926 vbt(i,j) = vbt(i,j-1) 2927 vel\_trans = vbt(i,j) 2928 \textcolor{keywordflow}{ endif} 2929 \textcolor{keywordflow}{elseif} (obc%segment(obc%segnum\_v(i,j))%direction == obc\_direction\_s) \textcolor{keywordflow}{then} 2930 \textcolor{keywordflow}{if} (obc%segment(obc%segnum\_v(i,j))%Flather) \textcolor{keywordflow}{then} 2931 cfl = dtbt * bt\_obc%Cg\_v(i,j) * g%IdyCv(i,j) \textcolor{comment}{! CFL} 2932 v\_inlet = cfl*vbt\_old(i,j+1) + (1.0-cfl)*vbt\_old(i,j) \textcolor{comment}{! Valid for cfl <1} 2933 h\_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) \textcolor{comment}{! internal} 2934 2935 h\_v = bt\_obc%H\_v(i,j) 2936 vel\_prev = vbt(i,j) 2937 vbt(i,j) = 0.5*((v\_inlet + bt\_obc%vbt\_outer(i,j)) + & 2938 (bt\_obc%Cg\_v(i,j)/h\_v) * (bt\_obc%eta\_outer\_v(i,j)-h\_in)) 2939 2940 vel\_trans = (1.0-bebt)*vel\_prev + bebt*vbt(i,j) 2941 \textcolor{keywordflow}{elseif} (obc%segment(obc%segnum\_v(i,j))%gradient) \textcolor{keywordflow}{then} 2942 vbt(i,j) = vbt(i,j+1) 2943 vel\_trans = vbt(i,j) 2944 \textcolor{keywordflow}{ endif} 2945 \textcolor{keywordflow}{ endif} 2946 2947 \textcolor{keywordflow}{if} (.not. obc%segment(obc%segnum\_v(i,j))%specified) \textcolor{keywordflow}{then} 2948 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 2949 vhbt\_int\_new = find\_vhbt(vbt\_int(i,j) + dtbt*vel\_trans, btcl\_v(i,j)) + & 2950 dt\_elapsed*vhbt0(i,j) 2951 vhbt(i,j) = (vhbt\_int\_new - vhbt\_int(i,j)) * idtbt 2952 \textcolor{keywordflow}{elseif} (use\_bt\_cont) \textcolor{keywordflow}{then} 2953 vhbt(i,j) = find\_vhbt(vel\_trans, btcl\_v(i,j)) + vhbt0(i,j) 2954 \textcolor{keywordflow}{else} 2955 vhbt(i,j) = vel\_trans*datv(i,j) + vhbt0(i,j) 2956 \textcolor{keywordflow}{ endif} 2957 \textcolor{keywordflow}{ endif} 2958 2959 vbt\_trans(i,j) = vel\_trans 2960 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2961 \textcolor{keywordflow}{ endif} 2962 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_aee694cdef3a20b960aff1ec4fa5da28f}\label{namespacemom__barotropic_aee694cdef3a20b960aff1ec4fa5da28f}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!barotropic\+\_\+end@{barotropic\+\_\+end}} \index{barotropic\+\_\+end@{barotropic\+\_\+end}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{barotropic\+\_\+end()}{barotropic\_end()}} {\footnotesize\ttfamily subroutine, public mom\+\_\+barotropic\+::barotropic\+\_\+end (\begin{DoxyParamCaption}\item[{type(\hyperlink{structmom__barotropic_1_1barotropic__cs}{barotropic\+\_\+cs}), pointer}]{CS }\end{DoxyParamCaption})} Clean up the barotropic control structure. \begin{DoxyParams}{Parameters} {\em cs} & Control structure to clear out. \\ \hline \end{DoxyParams} Definition at line 4947 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 4947 \textcolor{keywordtype}{type}(barotropic\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< Control structure to clear out.} 4948 dealloc\_(cs%frhatu) ; dealloc\_(cs%frhatv) 4949 dealloc\_(cs%IDatu) ; dealloc\_(cs%IDatv) 4950 dealloc\_(cs%ubtav) ; dealloc\_(cs%vbtav) 4951 dealloc\_(cs%eta\_cor) 4952 dealloc\_(cs%ua\_polarity) ; dealloc\_(cs%va\_polarity) 4953 \textcolor{keywordflow}{if} (cs%bound\_BT\_corr) \textcolor{keywordflow}{then} 4954 dealloc\_(cs%eta\_cor\_bound) 4955 \textcolor{keywordflow}{ endif} 4956 4957 \textcolor{keyword}{call }destroy\_bt\_obc(cs%BT\_OBC) 4958 4959 \textcolor{keyword}{deallocate}(cs) \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_aa059fdf7e6002b13d942f96ef17a5db6}\label{namespacemom__barotropic_aa059fdf7e6002b13d942f96ef17a5db6}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!barotropic\+\_\+get\+\_\+tav@{barotropic\+\_\+get\+\_\+tav}} \index{barotropic\+\_\+get\+\_\+tav@{barotropic\+\_\+get\+\_\+tav}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{barotropic\+\_\+get\+\_\+tav()}{barotropic\_get\_tav()}} {\footnotesize\ttfamily subroutine, public mom\+\_\+barotropic\+::barotropic\+\_\+get\+\_\+tav (\begin{DoxyParamCaption}\item[{type(\hyperlink{structmom__barotropic_1_1barotropic__cs}{barotropic\+\_\+cs}), pointer}]{CS, }\item[{real, dimension( g \%isdb\+: g \%iedb, g \%jsd\+: g \%jed), intent(inout)}]{ubtav, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsdb\+: g \%jedb), intent(inout)}]{vbtav, }\item[{type(ocean\+\_\+grid\+\_\+type), intent(in)}]{G, }\item[{type(unit\+\_\+scale\+\_\+type), intent(in)}]{US }\end{DoxyParamCaption})} Copies ubtav and vbtav from private type into arrays. \begin{DoxyParams}[1]{Parameters} & {\em cs} & Control structure for this module\\ \hline \mbox{\tt in} & {\em g} & Grid structure\\ \hline \mbox{\tt in,out} & {\em ubtav} & Zonal barotropic velocity averaged over a baroclinic timestep \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}\\ \hline \mbox{\tt in,out} & {\em vbtav} & Meridional barotropic velocity averaged over a baroclinic timestep \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}\\ \hline \mbox{\tt in} & {\em us} & A dimensional unit scaling type \\ \hline \end{DoxyParams} Definition at line 4924 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 4924 \textcolor{keywordtype}{type}(barotropic\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< Control structure for this module} 4925 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(in)} :: g\textcolor{comment}{ !< Grid structure} 4926 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G))}, \textcolor{keywordtype}{intent(inout)} :: ubtav\textcolor{comment}{ !< Zonal barotropic velocity averaged} 4927 \textcolor{comment}{ !! over a baroclinic timestep [L T-1 ~> m s-1]} 4928 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G))}, \textcolor{keywordtype}{intent(inout)} :: vbtav\textcolor{comment}{ !< Meridional barotropic velocity averaged} 4929 \textcolor{comment}{ !! over a baroclinic timestep [L T-1 ~> m s-1]} 4930 \textcolor{keywordtype}{type}(unit\_scale\_type), \textcolor{keywordtype}{intent(in)} :: us\textcolor{comment}{ !< A dimensional unit scaling type} 4931 \textcolor{comment}{! Local variables} 4932 \textcolor{keywordtype}{integer} :: i,j 4933 4934 \textcolor{keywordflow}{do} j=g%jsc,g%jec ; \textcolor{keywordflow}{do} i=g%isc-1,g%iec 4935 ubtav(i,j) = cs%ubtav(i,j) 4936 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4937 4938 \textcolor{keywordflow}{do} j=g%jsc-1,g%jec ; \textcolor{keywordflow}{do} i=g%isc,g%iec 4939 vbtav(i,j) = cs%vbtav(i,j) 4940 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4941 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_a59244968890766632554a6d271ec4499}\label{namespacemom__barotropic_a59244968890766632554a6d271ec4499}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!barotropic\+\_\+init@{barotropic\+\_\+init}} \index{barotropic\+\_\+init@{barotropic\+\_\+init}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{barotropic\+\_\+init()}{barotropic\_init()}} {\footnotesize\ttfamily subroutine, public mom\+\_\+barotropic\+::barotropic\+\_\+init (\begin{DoxyParamCaption}\item[{real, dimension(szib\+\_\+(g),szj\+\_\+(g),szk\+\_\+(g)), intent(in)}]{u, }\item[{real, dimension(szi\+\_\+(g),szjb\+\_\+(g),szk\+\_\+(g)), intent(in)}]{v, }\item[{real, dimension(szi\+\_\+(g),szj\+\_\+(g),szk\+\_\+(g)), intent(in)}]{h, }\item[{real, dimension(szi\+\_\+(g),szj\+\_\+(g)), intent(in)}]{eta, }\item[{type(time\+\_\+type), intent(in), target}]{Time, }\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(param\+\_\+file\+\_\+type), intent(in)}]{param\+\_\+file, }\item[{type(diag\+\_\+ctrl), intent(inout), target}]{diag, }\item[{type(\hyperlink{structmom__barotropic_1_1barotropic__cs}{barotropic\+\_\+cs}), pointer}]{CS, }\item[{type(mom\+\_\+restart\+\_\+cs), pointer}]{restart\+\_\+\+CS, }\item[{logical, intent(out)}]{calc\+\_\+dtbt, }\item[{type(bt\+\_\+cont\+\_\+type), optional, pointer}]{B\+T\+\_\+cont, }\item[{type(tidal\+\_\+forcing\+\_\+cs), optional, pointer}]{tides\+\_\+\+C\+Sp }\end{DoxyParamCaption})} barotropic\+\_\+init initializes a number of time-\/invariant fields used in the barotropic calculation and initializes any barotropic fields that have not already been initialized. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in,out} & {\em g} & The ocean\textquotesingle{}s grid structure.\\ \hline \mbox{\tt in} & {\em gv} & The ocean\textquotesingle{}s vertical grid structure.\\ \hline \mbox{\tt in} & {\em us} & A dimensional unit scaling type\\ \hline \mbox{\tt in} & {\em u} & The zonal velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em v} & The meridional velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em h} & Layer thicknesses \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline \mbox{\tt in} & {\em eta} & Free surface height or column mass anomaly\\ \hline \mbox{\tt in} & {\em time} & The current model time.\\ \hline \mbox{\tt in} & {\em param\+\_\+file} & A structure to parse for run-\/time parameters.\\ \hline \mbox{\tt in,out} & {\em diag} & A structure that is used to regulate diagnostic output.\\ \hline & {\em cs} & A pointer to the control structure for this module that is set in register\+\_\+barotropic\+\_\+restarts.\\ \hline & {\em restart\+\_\+cs} & A pointer to the restart control structure.\\ \hline \mbox{\tt out} & {\em calc\+\_\+dtbt} & If true, the barotropic time step must be recalculated before stepping.\\ \hline & {\em bt\+\_\+cont} & A structure with elements that describe the\\ \hline & {\em tides\+\_\+csp} & A pointer to the control structure of the \\ \hline \end{DoxyParams} Definition at line 4206 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 4206 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(inout)} :: g\textcolor{comment}{ !< The ocean's grid structure.} 4207 \textcolor{keywordtype}{type}(verticalgrid\_type), \textcolor{keywordtype}{intent(in)} :: gv\textcolor{comment}{ !< The ocean's vertical grid structure.} 4208 \textcolor{keywordtype}{type}(unit\_scale\_type), \textcolor{keywordtype}{intent(in)} :: us\textcolor{comment}{ !< A dimensional unit scaling type} 4209 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G),SZK\_(G))}, & 4210 \textcolor{keywordtype}{intent(in)} :: u\textcolor{comment}{ !< The zonal velocity [L T-1 ~> m s-1].} 4211 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G),SZK\_(G))}, & 4212 \textcolor{keywordtype}{intent(in)} :: v\textcolor{comment}{ !< The meridional velocity [L T-1 ~> m s-1].} 4213 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G),SZK\_(G))}, & 4214 \textcolor{keywordtype}{intent(in)} :: h\textcolor{comment}{ !< Layer thicknesses [H ~> m or kg m-2].} 4215 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G))}, & 4216 \textcolor{keywordtype}{intent(in)} :: eta\textcolor{comment}{ !< Free surface height or column mass anomaly} 4217 \textcolor{comment}{ !! [Z ~> m] or [H ~> kg m-2].} 4218 \textcolor{keywordtype}{type}(time\_type), \textcolor{keywordtype}{target}, \textcolor{keywordtype}{intent(in)} :: time\textcolor{comment}{ !< The current model time.} 4219 \textcolor{keywordtype}{type}(param\_file\_type), \textcolor{keywordtype}{intent(in)} :: param\_file\textcolor{comment}{ !< A structure to parse for run-time parameters.} 4220 \textcolor{keywordtype}{type}(diag\_ctrl), \textcolor{keywordtype}{target}, \textcolor{keywordtype}{intent(inout)} :: diag\textcolor{comment}{ !< A structure that is used to regulate diagnostic} 4221 \textcolor{comment}{ !! output.} 4222 \textcolor{keywordtype}{type}(barotropic\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< A pointer to the control structure for this module} 4223 \textcolor{comment}{ !! that is set in register\_barotropic\_restarts.} 4224 \textcolor{keywordtype}{type}(mom\_restart\_cs), \textcolor{keywordtype}{pointer} :: restart\_cs\textcolor{comment}{ !< A pointer to the restart control structure.} 4225 \textcolor{keywordtype}{logical}, \textcolor{keywordtype}{intent(out)} :: calc\_dtbt\textcolor{comment}{ !< If true, the barotropic time step must} 4226 \textcolor{comment}{ !! be recalculated before stepping.} 4227 \textcolor{keywordtype}{type}(bt\_cont\_type), \textcolor{keywordtype}{optional}, & 4228 \textcolor{keywordtype}{pointer} :: bt\_cont\textcolor{comment}{ !< A structure with elements that describe the} 4229 \textcolor{comment}{ !! effective open face areas as a function of} 4230 \textcolor{comment}{ !! barotropic flow.} 4231 \textcolor{keywordtype}{type}(tidal\_forcing\_cs), \textcolor{keywordtype}{optional}, & 4232 \textcolor{keywordtype}{pointer} :: tides\_csp\textcolor{comment}{ !< A pointer to the control structure of the} 4233 \textcolor{comment}{ !! tide module.} 4234 4235 \textcolor{comment}{! This include declares and sets the variable "version".} 4236 \textcolor{preprocessor}{#include "version\_variable.h"} 4237 \textcolor{preprocessor}{} \textcolor{comment}{! Local variables} 4238 \textcolor{keywordtype}{character(len=40)} :: mdl = \textcolor{stringliteral}{"MOM\_barotropic"} \textcolor{comment}{! This module's name.} 4239 \textcolor{keywordtype}{real} :: datu(szibs\_(g),szj\_(g)) \textcolor{comment}{! Zonal open face area [H L ~> m2 or kg m-1].} 4240 \textcolor{keywordtype}{real} :: datv(szi\_(g),szjbs\_(g)) \textcolor{comment}{! Meridional open face area [H L ~> m2 or kg m-1].} 4241 \textcolor{keywordtype}{real} :: gtot\_estimate \textcolor{comment}{! Summed GV%g\_prime [L2 Z-1 T-2 ~> m s-2], to give an upper-bound estimate for pbce.} 4242 \textcolor{keywordtype}{real} :: ssh\_extra \textcolor{comment}{! An estimate of how much higher SSH might get, for use} 4243 \textcolor{comment}{! in calculating the safe external wave speed [Z ~> m].} 4244 \textcolor{keywordtype}{real} :: dtbt\_input \textcolor{comment}{! The input value of DTBT, [nondim] if negative or [s] if positive.} 4245 \textcolor{keywordtype}{real} :: dtbt\_tmp \textcolor{comment}{! A temporary copy of CS%dtbt read from a restart file [T ~> s]} 4246 \textcolor{keywordtype}{real} :: wave\_drag\_scale \textcolor{comment}{! A scaling factor for the barotropic linear wave drag} 4247 \textcolor{comment}{! piston velocities.} 4248 \textcolor{keywordtype}{character(len=200)} :: inputdir \textcolor{comment}{! The directory in which to find input files.} 4249 \textcolor{keywordtype}{character(len=200)} :: wave\_drag\_file \textcolor{comment}{! The file from which to read the wave} 4250 \textcolor{comment}{! drag piston velocity.} 4251 \textcolor{keywordtype}{character(len=80)} :: wave\_drag\_var \textcolor{comment}{! The wave drag piston velocity variable} 4252 \textcolor{comment}{! name in wave\_drag\_file.} 4253 \textcolor{keywordtype}{real} :: vel\_rescale \textcolor{comment}{! A rescaling factor for horizontal velocity from the representation in} 4254 \textcolor{comment}{! a restart file to the internal representation in this run.} 4255 \textcolor{keywordtype}{real} :: uh\_rescale \textcolor{comment}{! A rescaling factor for thickness transports from the representation in} 4256 \textcolor{comment}{! a restart file to the internal representation in this run.} 4257 \textcolor{keywordtype}{real} :: mean\_sl \textcolor{comment}{! The mean sea level that is used along with the bathymetry to estimate the} 4258 \textcolor{comment}{! geometry when LINEARIZED\_BT\_CORIOLIS is true or BT\_NONLIN\_STRESS is false [Z ~> m].} 4259 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{allocatable}, \textcolor{keywordtype}{dimension(:,:)} :: lin\_drag\_h 4260 \textcolor{keywordtype}{type}(memory\_size\_type) :: ms 4261 \textcolor{keywordtype}{type}(group\_pass\_type) :: pass\_static\_data, pass\_q\_d\_cor 4262 \textcolor{keywordtype}{type}(group\_pass\_type) :: pass\_bt\_hbt\_btav, pass\_a\_polarity 4263 \textcolor{keywordtype}{logical} :: default\_2018\_answers \textcolor{comment}{! The default setting for the various 2018\_ANSWERS flags.} 4264 \textcolor{keywordtype}{logical} :: apply\_bt\_drag, use\_bt\_cont\_type 4265 \textcolor{keywordtype}{character(len=48)} :: thickness\_units, flux\_units 4266 \textcolor{keywordtype}{character*(40)} :: hvel\_str 4267 \textcolor{keywordtype}{integer} :: is, ie, js, je, isq, ieq, jsq, jeq, nz 4268 \textcolor{keywordtype}{integer} :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb 4269 \textcolor{keywordtype}{integer} :: isdw, iedw, jsdw, jedw 4270 \textcolor{keywordtype}{integer} :: i, j, k 4271 \textcolor{keywordtype}{integer} :: wd\_halos(2), bt\_halo\_sz 4272 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed 4273 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB 4274 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke 4275 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB 4276 ms%isdw = g%isd ; ms%iedw = g%ied ; ms%jsdw = g%jsd ; ms%jedw = g%jed 4277 4278 \textcolor{keywordflow}{if} (cs%module\_is\_initialized) \textcolor{keywordflow}{then} 4279 \textcolor{keyword}{call }mom\_error(warning, \textcolor{stringliteral}{"barotropic\_init called with a control structure "}// & 4280 \textcolor{stringliteral}{"that has already been initialized."}) 4281 \textcolor{keywordflow}{return} 4282 \textcolor{keywordflow}{ endif} 4283 cs%module\_is\_initialized = .true. 4284 4285 cs%diag => diag ; cs%Time => time 4286 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(tides\_csp)) \textcolor{keywordflow}{then} 4287 \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(tides\_csp)) cs%tides\_CSp => tides\_csp 4288 \textcolor{keywordflow}{ endif} 4289 4290 \textcolor{comment}{! Read all relevant parameters and write them to the model log.} 4291 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"SPLIT"}, cs%split, default=.true., do\_not\_log=.true.) 4292 \textcolor{keyword}{call }log\_version(param\_file, mdl, version, \textcolor{stringliteral}{""}, log\_to\_all=.true., layout=cs%split, & 4293 debugging=cs%split, all\_default=.not.cs%split) 4294 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"SPLIT"}, cs%split, & 4295 \textcolor{stringliteral}{"Use the split time stepping if true."}, default=.true.) 4296 \textcolor{keywordflow}{if} (.not.cs%split) \textcolor{keywordflow}{return} 4297 4298 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"USE\_BT\_CONT\_TYPE"}, use\_bt\_cont\_type, & 4299 \textcolor{stringliteral}{"If true, use a structure with elements that describe "}//& 4300 \textcolor{stringliteral}{"effective face areas from the summed continuity solver "}//& 4301 \textcolor{stringliteral}{"as a function the barotropic flow in coupling between "}//& 4302 \textcolor{stringliteral}{"the barotropic and baroclinic flow. This is only used "}//& 4303 \textcolor{stringliteral}{"if SPLIT is true."}, default=.true.) 4304 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"INTEGRAL\_BT\_CONTINUITY"}, cs%integral\_bt\_cont, & 4305 \textcolor{stringliteral}{"If true, use the time-integrated velocity over the barotropic steps "}//& 4306 \textcolor{stringliteral}{"to determine the integrated transports used to update the continuity "}//& 4307 \textcolor{stringliteral}{"equation. Otherwise the transports are the sum of the transports based on "}//& 4308 \textcolor{stringliteral}{"a series of instantaneous velocities and the BT\_CONT\_TYPE for transports. "}//& 4309 \textcolor{stringliteral}{"This is only valid if USE\_BT\_CONT\_TYPE = True."}, & 4310 default=.false., do\_not\_log=.not.use\_bt\_cont\_type) 4311 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BOUND\_BT\_CORRECTION"}, cs%bound\_BT\_corr, & 4312 \textcolor{stringliteral}{"If true, the corrective pseudo mass-fluxes into the "}//& 4313 \textcolor{stringliteral}{"barotropic solver are limited to values that require "}//& 4314 \textcolor{stringliteral}{"less than maxCFL\_BT\_cont to be accommodated."},default=.false.) 4315 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BT\_CONT\_CORR\_BOUNDS"}, cs%BT\_cont\_bounds, & 4316 \textcolor{stringliteral}{"If true, and BOUND\_BT\_CORRECTION is true, use the "}//& 4317 \textcolor{stringliteral}{"BT\_cont\_type variables to set limits determined by "}//& 4318 \textcolor{stringliteral}{"MAXCFL\_BT\_CONT on the CFL number of the velocities "}//& 4319 \textcolor{stringliteral}{"that are likely to be driven by the corrective mass fluxes."}, & 4320 default=.true., do\_not\_log=.not.cs%bound\_BT\_corr) 4321 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"ADJUST\_BT\_CONT"}, cs%adjust\_BT\_cont, & 4322 \textcolor{stringliteral}{"If true, adjust the curve fit to the BT\_cont type "}//& 4323 \textcolor{stringliteral}{"that is used by the barotropic solver to match the "}//& 4324 \textcolor{stringliteral}{"transport about which the flow is being linearized."}, & 4325 default=.false., do\_not\_log=.not.use\_bt\_cont\_type) 4326 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"GRADUAL\_BT\_ICS"}, cs%gradual\_BT\_ICs, & 4327 \textcolor{stringliteral}{"If true, adjust the initial conditions for the "}//& 4328 \textcolor{stringliteral}{"barotropic solver to the values from the layered "}//& 4329 \textcolor{stringliteral}{"solution over a whole timestep instead of instantly. "}//& 4330 \textcolor{stringliteral}{"This is a decent approximation to the inclusion of "}//& 4331 \textcolor{stringliteral}{"sum(u dh\_dt) while also correcting for truncation errors."}, & 4332 default=.false.) 4333 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BT\_USE\_VISC\_REM\_U\_UH0"}, cs%visc\_rem\_u\_uh0, & 4334 \textcolor{stringliteral}{"If true, use the viscous remnants when estimating the "}//& 4335 \textcolor{stringliteral}{"barotropic velocities that were used to calculate uh0 "}//& 4336 \textcolor{stringliteral}{"and vh0. False is probably the better choice."}, default=.false.) 4337 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BT\_USE\_WIDE\_HALOS"}, cs%use\_wide\_halos, & 4338 \textcolor{stringliteral}{"If true, use wide halos and march in during the "}//& 4339 \textcolor{stringliteral}{"barotropic time stepping for efficiency."}, default=.true., & 4340 layoutparam=.true.) 4341 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BTHALO"}, bt\_halo\_sz, & 4342 \textcolor{stringliteral}{"The minimum halo size for the barotropic solver."}, default=0, & 4343 layoutparam=.true.) 4344 \textcolor{preprocessor}{#ifdef STATIC\_MEMORY\_} 4345 \textcolor{preprocessor}{} \textcolor{keywordflow}{if} ((bt\_halo\_sz > 0) .and. (bt\_halo\_sz /= bthalo\_)) \textcolor{keyword}{call }mom\_error(fatal, & 4346 \textcolor{stringliteral}{"barotropic\_init: Run-time values of BTHALO must agree with the "}//& 4347 \textcolor{stringliteral}{"macro BTHALO\_ with STATIC\_MEMORY\_."}) 4348 wd\_halos(1) = whaloi\_+nihalo\_ ; wd\_halos(2) = whaloj\_+njhalo\_ 4349 \textcolor{preprocessor}{#else} 4350 \textcolor{preprocessor}{} wd\_halos(1) = bt\_halo\_sz; wd\_halos(2) = bt\_halo\_sz 4351 \textcolor{preprocessor}{#endif} 4352 \textcolor{preprocessor}{} \textcolor{keyword}{call }log\_param(param\_file, mdl, \textcolor{stringliteral}{"!BT x-halo"}, wd\_halos(1), & 4353 \textcolor{stringliteral}{"The barotropic x-halo size that is actually used."}, & 4354 layoutparam=.true.) 4355 \textcolor{keyword}{call }log\_param(param\_file, mdl, \textcolor{stringliteral}{"!BT y-halo"}, wd\_halos(2), & 4356 \textcolor{stringliteral}{"The barotropic y-halo size that is actually used."}, & 4357 layoutparam=.true.) 4358 4359 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"NONLINEAR\_BT\_CONTINUITY"}, cs%Nonlinear\_continuity, & 4360 \textcolor{stringliteral}{"If true, use nonlinear transports in the barotropic "}//& 4361 \textcolor{stringliteral}{"continuity equation. This does not apply if "}//& 4362 \textcolor{stringliteral}{"USE\_BT\_CONT\_TYPE is true."}, default=.false., do\_not\_log=use\_bt\_cont\_type) 4363 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"NONLIN\_BT\_CONT\_UPDATE\_PERIOD"}, cs%Nonlin\_cont\_update\_period, & 4364 \textcolor{stringliteral}{"If NONLINEAR\_BT\_CONTINUITY is true, this is the number "}//& 4365 \textcolor{stringliteral}{"of barotropic time steps between updates to the face "}//& 4366 \textcolor{stringliteral}{"areas, or 0 to update only before the barotropic stepping."}, & 4367 units=\textcolor{stringliteral}{"nondim"}, default=1, do\_not\_log=.not.cs%Nonlinear\_continuity) 4368 4369 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BT\_PROJECT\_VELOCITY"}, cs%BT\_project\_velocity,& 4370 \textcolor{stringliteral}{"If true, step the barotropic velocity first and project "}//& 4371 \textcolor{stringliteral}{"out the velocity tendency by 1+BEBT when calculating the "}//& 4372 \textcolor{stringliteral}{"transport. The default (false) is to use a predictor "}//& 4373 \textcolor{stringliteral}{"continuity step to find the pressure field, and then "}//& 4374 \textcolor{stringliteral}{"to do a corrector continuity step using a weighted "}//& 4375 \textcolor{stringliteral}{"average of the old and new velocities, with weights "}//& 4376 \textcolor{stringliteral}{"of (1-BEBT) and BEBT."}, default=.false.) 4377 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BT\_NONLIN\_STRESS"}, cs%nonlin\_stress, & 4378 \textcolor{stringliteral}{"If true, use the full depth of the ocean at the start of the barotropic "}//& 4379 \textcolor{stringliteral}{"step when calculating the surface stress contribution to the barotropic "}//& 4380 \textcolor{stringliteral}{"acclerations. Otherwise use the depth based on bathyT."}, default=.false.) 4381 4382 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"DYNAMIC\_SURFACE\_PRESSURE"}, cs%dynamic\_psurf, & 4383 \textcolor{stringliteral}{"If true, add a dynamic pressure due to a viscous ice "}//& 4384 \textcolor{stringliteral}{"shelf, for instance."}, default=.false.) 4385 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"ICE\_LENGTH\_DYN\_PSURF"}, cs%ice\_strength\_length, & 4386 \textcolor{stringliteral}{"The length scale at which the Rayleigh damping rate due "}//& 4387 \textcolor{stringliteral}{"to the ice strength should be the same as if a Laplacian "}//& 4388 \textcolor{stringliteral}{"were applied, if DYNAMIC\_SURFACE\_PRESSURE is true."}, & 4389 units=\textcolor{stringliteral}{"m"}, default=1.0e4, scale=us%m\_to\_L, do\_not\_log=.not.cs%dynamic\_psurf) 4390 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"DEPTH\_MIN\_DYN\_PSURF"}, cs%Dmin\_dyn\_psurf, & 4391 \textcolor{stringliteral}{"The minimum depth to use in limiting the size of the "}//& 4392 \textcolor{stringliteral}{"dynamic surface pressure for stability, if "}//& 4393 \textcolor{stringliteral}{"DYNAMIC\_SURFACE\_PRESSURE is true.."}, & 4394 units=\textcolor{stringliteral}{"m"}, default=1.0e-6, scale=us%m\_to\_Z, do\_not\_log=.not.cs%dynamic\_psurf) 4395 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"CONST\_DYN\_PSURF"}, cs%const\_dyn\_psurf, & 4396 \textcolor{stringliteral}{"The constant that scales the dynamic surface pressure, "}//& 4397 \textcolor{stringliteral}{"if DYNAMIC\_SURFACE\_PRESSURE is true. Stable values "}//& 4398 \textcolor{stringliteral}{"are < ~1.0."}, units=\textcolor{stringliteral}{"nondim"}, default=0.9, do\_not\_log=.not.cs%dynamic\_psurf) 4399 4400 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BT\_CORIOLIS\_SCALE"}, cs%BT\_Coriolis\_scale, & 4401 \textcolor{stringliteral}{"A factor by which the barotropic Coriolis anomaly terms are scaled."}, & 4402 units=\textcolor{stringliteral}{"nondim"}, default=1.0) 4403 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"DEFAULT\_2018\_ANSWERS"}, default\_2018\_answers, & 4404 \textcolor{stringliteral}{"This sets the default value for the various \_2018\_ANSWERS parameters."}, & 4405 default=.false.) 4406 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BAROTROPIC\_2018\_ANSWERS"}, cs%answers\_2018, & 4407 \textcolor{stringliteral}{"If true, use expressions for the barotropic solver that recover the answers "}//& 4408 \textcolor{stringliteral}{"from the end of 2018. Otherwise, use more efficient or general expressions."}, & 4409 default=default\_2018\_answers) 4410 4411 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"TIDES"}, cs%tides, & 4412 \textcolor{stringliteral}{"If true, apply tidal momentum forcing."}, default=.false.) 4413 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"SADOURNY"}, cs%Sadourny, & 4414 \textcolor{stringliteral}{"If true, the Coriolis terms are discretized with the "}//& 4415 \textcolor{stringliteral}{"Sadourny (1975) energy conserving scheme, otherwise "}//& 4416 \textcolor{stringliteral}{"the Arakawa & Hsu scheme is used. If the internal "}//& 4417 \textcolor{stringliteral}{"deformation radius is not resolved, the Sadourny scheme "}//& 4418 \textcolor{stringliteral}{"should probably be used."}, default=.true.) 4419 4420 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BT\_THICK\_SCHEME"}, hvel\_str, & 4421 \textcolor{stringliteral}{"A string describing the scheme that is used to set the "}//& 4422 \textcolor{stringliteral}{"open face areas used for barotropic transport and the "}//& 4423 \textcolor{stringliteral}{"relative weights of the accelerations. Valid values are:\(\backslash\)n"}//& 4424 \textcolor{stringliteral}{"\(\backslash\)t ARITHMETIC - arithmetic mean layer thicknesses \(\backslash\)n"}//& 4425 \textcolor{stringliteral}{"\(\backslash\)t HARMONIC - harmonic mean layer thicknesses \(\backslash\)n"}//& 4426 \textcolor{stringliteral}{"\(\backslash\)t HYBRID (the default) - use arithmetic means for \(\backslash\)n"}//& 4427 \textcolor{stringliteral}{"\(\backslash\)t layers above the shallowest bottom, the harmonic \(\backslash\)n"}//& 4428 \textcolor{stringliteral}{"\(\backslash\)t mean for layers below, and a weighted average for \(\backslash\)n"}//& 4429 \textcolor{stringliteral}{"\(\backslash\)t layers that straddle that depth \(\backslash\)n"}//& 4430 \textcolor{stringliteral}{"\(\backslash\)t FROM\_BT\_CONT - use the average thicknesses kept \(\backslash\)n"}//& 4431 \textcolor{stringliteral}{"\(\backslash\)t in the h\_u and h\_v fields of the BT\_cont\_type"}, & 4432 default=bt\_cont\_string) 4433 \textcolor{keywordflow}{select case} (hvel\_str) 4434 \textcolor{keywordflow}{case} (hybrid\_string) ; cs%hvel\_scheme = hybrid 4435 \textcolor{keywordflow}{case} (harmonic\_string) ; cs%hvel\_scheme = harmonic 4436 \textcolor{keywordflow}{case} (arithmetic\_string) ; cs%hvel\_scheme = arithmetic 4437 \textcolor{keywordflow}{case} (bt\_cont\_string) ; cs%hvel\_scheme = from\_bt\_cont 4438 \textcolor{keywordflow}{ case default} 4439 \textcolor{keyword}{call }mom\_mesg(\textcolor{stringliteral}{'barotropic\_init: BT\_THICK\_SCHEME ="'}//trim(hvel\_str)//\textcolor{stringliteral}{'"'}, 0) 4440 \textcolor{keyword}{call }mom\_error(fatal, \textcolor{stringliteral}{"barotropic\_init: Unrecognized setting "}// & 4441 \textcolor{stringliteral}{"#define BT\_THICK\_SCHEME "}//trim(hvel\_str)//\textcolor{stringliteral}{" found in input file."}) 4442 \textcolor{keywordflow}{ end select} 4443 \textcolor{keywordflow}{if} ((cs%hvel\_scheme == from\_bt\_cont) .and. .not.use\_bt\_cont\_type) & 4444 \textcolor{keyword}{call }mom\_error(fatal, \textcolor{stringliteral}{"barotropic\_init: BT\_THICK\_SCHEME FROM\_BT\_CONT "}//& 4445 \textcolor{stringliteral}{"can only be used if USE\_BT\_CONT\_TYPE is defined."}) 4446 4447 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BT\_STRONG\_DRAG"}, cs%strong\_drag, & 4448 \textcolor{stringliteral}{"If true, use a stronger estimate of the retarding "}//& 4449 \textcolor{stringliteral}{"effects of strong bottom drag, by making it implicit "}//& 4450 \textcolor{stringliteral}{"with the barotropic time-step instead of implicit with "}//& 4451 \textcolor{stringliteral}{"the baroclinic time-step and dividing by the number of "}//& 4452 \textcolor{stringliteral}{"barotropic steps."}, default=.false.) 4453 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BT\_LINEAR\_WAVE\_DRAG"}, cs%linear\_wave\_drag, & 4454 \textcolor{stringliteral}{"If true, apply a linear drag to the barotropic velocities, "}//& 4455 \textcolor{stringliteral}{"using rates set by lin\_drag\_u & \_v divided by the depth of "}//& 4456 \textcolor{stringliteral}{"the ocean. This was introduced to facilitate tide modeling."}, & 4457 default=.false.) 4458 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BT\_WAVE\_DRAG\_FILE"}, wave\_drag\_file, & 4459 \textcolor{stringliteral}{"The name of the file with the barotropic linear wave drag "}//& 4460 \textcolor{stringliteral}{"piston velocities."}, default=\textcolor{stringliteral}{""}, do\_not\_log=.not.cs%linear\_wave\_drag) 4461 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BT\_WAVE\_DRAG\_VAR"}, wave\_drag\_var, & 4462 \textcolor{stringliteral}{"The name of the variable in BT\_WAVE\_DRAG\_FILE with the "}//& 4463 \textcolor{stringliteral}{"barotropic linear wave drag piston velocities at h points."}, & 4464 default=\textcolor{stringliteral}{"rH"}, do\_not\_log=.not.cs%linear\_wave\_drag) 4465 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BT\_WAVE\_DRAG\_SCALE"}, wave\_drag\_scale, & 4466 \textcolor{stringliteral}{"A scaling factor for the barotropic linear wave drag "}//& 4467 \textcolor{stringliteral}{"piston velocities."}, default=1.0, units=\textcolor{stringliteral}{"nondim"}, & 4468 do\_not\_log=.not.cs%linear\_wave\_drag) 4469 4470 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"CLIP\_BT\_VELOCITY"}, cs%clip\_velocity, & 4471 \textcolor{stringliteral}{"If true, limit any velocity components that exceed "}//& 4472 \textcolor{stringliteral}{"CFL\_TRUNCATE. This should only be used as a desperate "}//& 4473 \textcolor{stringliteral}{"debugging measure."}, default=.false.) 4474 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"CFL\_TRUNCATE"}, cs%CFL\_trunc, & 4475 \textcolor{stringliteral}{"The value of the CFL number that will cause velocity "}//& 4476 \textcolor{stringliteral}{"components to be truncated; instability can occur past 0.5."}, & 4477 units=\textcolor{stringliteral}{"nondim"}, default=0.5, do\_not\_log=.not.cs%clip\_velocity) 4478 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"MAXVEL"}, cs%maxvel, & 4479 \textcolor{stringliteral}{"The maximum velocity allowed before the velocity "}//& 4480 \textcolor{stringliteral}{"components are truncated."}, units=\textcolor{stringliteral}{"m s-1"}, default=3.0e8, scale=us%m\_s\_to\_L\_T, & 4481 do\_not\_log=.not.cs%clip\_velocity) 4482 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"MAXCFL\_BT\_CONT"}, cs%maxCFL\_BT\_cont, & 4483 \textcolor{stringliteral}{"The maximum permitted CFL number associated with the "}//& 4484 \textcolor{stringliteral}{"barotropic accelerations from the summed velocities "}//& 4485 \textcolor{stringliteral}{"times the time-derivatives of thicknesses."}, units=\textcolor{stringliteral}{"nondim"}, & 4486 default=0.25) 4487 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"VEL\_UNDERFLOW"}, cs%vel\_underflow, & 4488 \textcolor{stringliteral}{"A negligibly small velocity magnitude below which velocity "}//& 4489 \textcolor{stringliteral}{"components are set to 0. A reasonable value might be "}//& 4490 \textcolor{stringliteral}{"1e-30 m/s, which is less than an Angstrom divided by "}//& 4491 \textcolor{stringliteral}{"the age of the universe."}, units=\textcolor{stringliteral}{"m s-1"}, default=0.0, scale=us%m\_s\_to\_L\_T) 4492 4493 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"DT\_BT\_FILTER"}, cs%dt\_bt\_filter, & 4494 \textcolor{stringliteral}{"A time-scale over which the barotropic mode solutions "}//& 4495 \textcolor{stringliteral}{"are filtered, in seconds if positive, or as a fraction "}//& 4496 \textcolor{stringliteral}{"of DT if negative. When used this can never be taken to "}//& 4497 \textcolor{stringliteral}{"be longer than 2*dt. Set this to 0 to apply no filtering."}, & 4498 units=\textcolor{stringliteral}{"sec or nondim"}, default=-0.25) 4499 \textcolor{keywordflow}{if} (cs%dt\_bt\_filter > 0.0) cs%dt\_bt\_filter = us%s\_to\_T*cs%dt\_bt\_filter 4500 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"G\_BT\_EXTRA"}, cs%G\_extra, & 4501 \textcolor{stringliteral}{"A nondimensional factor by which gtot is enhanced."}, & 4502 units=\textcolor{stringliteral}{"nondim"}, default=0.0) 4503 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"SSH\_EXTRA"}, ssh\_extra, & 4504 \textcolor{stringliteral}{"An estimate of how much higher SSH might get, for use "}//& 4505 \textcolor{stringliteral}{"in calculating the safe external wave speed. The "}//& 4506 \textcolor{stringliteral}{"default is the minimum of 10 m or 5% of MAXIMUM\_DEPTH."}, & 4507 units=\textcolor{stringliteral}{"m"}, default=min(10.0,0.05*g%max\_depth*us%Z\_to\_m), scale=us%m\_to\_Z) 4508 4509 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"DEBUG"}, cs%debug, & 4510 \textcolor{stringliteral}{"If true, write out verbose debugging data."}, & 4511 default=.false., debuggingparam=.true.) 4512 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"DEBUG\_BT"}, cs%debug\_bt, & 4513 \textcolor{stringliteral}{"If true, write out verbose debugging data within the "}//& 4514 \textcolor{stringliteral}{"barotropic time-stepping loop. The data volume can be "}//& 4515 \textcolor{stringliteral}{"quite large if this is true."}, default=cs%debug, & 4516 debuggingparam=.true.) 4517 4518 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"LINEARIZED\_BT\_CORIOLIS"}, cs%linearized\_BT\_PV, & 4519 \textcolor{stringliteral}{"If true use the bottom depth instead of the total water column thickness "}//& 4520 \textcolor{stringliteral}{"in the barotropic Coriolis term calculations."}, default=.true.) 4521 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BEBT"}, cs%bebt, & 4522 \textcolor{stringliteral}{"BEBT determines whether the barotropic time stepping "}//& 4523 \textcolor{stringliteral}{"uses the forward-backward time-stepping scheme or a "}//& 4524 \textcolor{stringliteral}{"backward Euler scheme. BEBT is valid in the range from "}//& 4525 \textcolor{stringliteral}{"0 (for a forward-backward treatment of nonrotating "}//& 4526 \textcolor{stringliteral}{"gravity waves) to 1 (for a backward Euler treatment). "}//& 4527 \textcolor{stringliteral}{"In practice, BEBT must be greater than about 0.05."}, & 4528 units=\textcolor{stringliteral}{"nondim"}, default=0.1) 4529 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"DTBT"}, dtbt\_input, & 4530 \textcolor{stringliteral}{"The barotropic time step, in s. DTBT is only used with "}//& 4531 \textcolor{stringliteral}{"the split explicit time stepping. To set the time step "}//& 4532 \textcolor{stringliteral}{"automatically based the maximum stable value use 0, or "}//& 4533 \textcolor{stringliteral}{"a negative value gives the fraction of the stable value. "}//& 4534 \textcolor{stringliteral}{"Setting DTBT to 0 is the same as setting it to -0.98. "}//& 4535 \textcolor{stringliteral}{"The value of DTBT that will actually be used is an "}//& 4536 \textcolor{stringliteral}{"integer fraction of DT, rounding down."}, units=\textcolor{stringliteral}{"s or nondim"},& 4537 default = -0.98) 4538 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"BT\_USE\_OLD\_CORIOLIS\_BRACKET\_BUG"}, & 4539 cs%use\_old\_coriolis\_bracket\_bug , & 4540 \textcolor{stringliteral}{"If True, use an order of operations that is not bitwise "}//& 4541 \textcolor{stringliteral}{"rotationally symmetric in the meridional Coriolis term of "}//& 4542 \textcolor{stringliteral}{"the barotropic solver."}, default=.false.) 4543 4544 \textcolor{comment}{! Initialize a version of the MOM domain that is specific to the barotropic solver.} 4545 \textcolor{keyword}{call }clone\_mom\_domain(g%Domain, cs%BT\_Domain, min\_halo=wd\_halos, symmetric=.true.) 4546 \textcolor{preprocessor}{#ifdef STATIC\_MEMORY\_} 4547 \textcolor{preprocessor}{} \textcolor{keywordflow}{if} (wd\_halos(1) /= whaloi\_+nihalo\_) \textcolor{keyword}{call }mom\_error(fatal, \textcolor{stringliteral}{"barotropic\_init: "}//& 4548 \textcolor{stringliteral}{"Barotropic x-halo sizes are incorrectly resized with STATIC\_MEMORY\_."}) 4549 \textcolor{keywordflow}{if} (wd\_halos(2) /= whaloj\_+njhalo\_) \textcolor{keyword}{call }mom\_error(fatal, \textcolor{stringliteral}{"barotropic\_init: "}//& 4550 \textcolor{stringliteral}{"Barotropic y-halo sizes are incorrectly resized with STATIC\_MEMORY\_."}) 4551 \textcolor{preprocessor}{#else} 4552 \textcolor{preprocessor}{} \textcolor{keywordflow}{if} (bt\_halo\_sz > 0) \textcolor{keywordflow}{then} 4553 \textcolor{keywordflow}{if} (wd\_halos(1) > bt\_halo\_sz) & 4554 \textcolor{keyword}{call }mom\_mesg(\textcolor{stringliteral}{"barotropic\_init: barotropic x-halo size increased."}, 3) 4555 \textcolor{keywordflow}{if} (wd\_halos(2) > bt\_halo\_sz) & 4556 \textcolor{keyword}{call }mom\_mesg(\textcolor{stringliteral}{"barotropic\_init: barotropic y-halo size increased."}, 3) 4557 \textcolor{keywordflow}{ endif} 4558 \textcolor{preprocessor}{#endif} 4559 \textcolor{preprocessor}{} 4560 cs%isdw = g%isc-wd\_halos(1) ; cs%iedw = g%iec+wd\_halos(1) 4561 cs%jsdw = g%jsc-wd\_halos(2) ; cs%jedw = g%jec+wd\_halos(2) 4562 isdw = cs%isdw ; iedw = cs%iedw ; jsdw = cs%jsdw ; jedw = cs%jedw 4563 4564 alloc\_(cs%frhatu(isdb:iedb,jsd:jed,nz)) ; alloc\_(cs%frhatv(isd:ied,jsdb:jedb,nz)) 4565 alloc\_(cs%eta\_cor(isd:ied,jsd:jed)) 4566 \textcolor{keywordflow}{if} (cs%bound\_BT\_corr) \textcolor{keywordflow}{then} 4567 alloc\_(cs%eta\_cor\_bound(isd:ied,jsd:jed)) ; cs%eta\_cor\_bound(:,:) = 0.0 4568 \textcolor{keywordflow}{ endif} 4569 alloc\_(cs%IDatu(isdb:iedb,jsd:jed)) ; alloc\_(cs%IDatv(isd:ied,jsdb:jedb)) 4570 4571 alloc\_(cs%ua\_polarity(isdw:iedw,jsdw:jedw)) 4572 alloc\_(cs%va\_polarity(isdw:iedw,jsdw:jedw)) 4573 4574 cs%frhatu(:,:,:) = 0.0 ; cs%frhatv(:,:,:) = 0.0 4575 cs%eta\_cor(:,:) = 0.0 4576 cs%IDatu(:,:) = 0.0 ; cs%IDatv(:,:) = 0.0 4577 4578 cs%ua\_polarity(:,:) = 1.0 ; cs%va\_polarity(:,:) = 1.0 4579 \textcolor{keyword}{call }create\_group\_pass(pass\_a\_polarity, cs%ua\_polarity, cs%va\_polarity, cs%BT\_domain, to\_all, agrid) 4580 \textcolor{keyword}{call }do\_group\_pass(pass\_a\_polarity, cs%BT\_domain) 4581 4582 \textcolor{keywordflow}{if} (use\_bt\_cont\_type) & 4583 \textcolor{keyword}{call }alloc\_bt\_cont\_type(bt\_cont, g, (cs%hvel\_scheme == from\_bt\_cont)) 4584 4585 \textcolor{keywordflow}{if} (cs%debug) \textcolor{keywordflow}{then} \textcolor{comment}{! Make a local copy of loop ranges for chksum calls} 4586 \textcolor{keyword}{allocate}(cs%debug\_BT\_HI) 4587 cs%debug\_BT\_HI%isc=g%isc 4588 cs%debug\_BT\_HI%iec=g%iec 4589 cs%debug\_BT\_HI%jsc=g%jsc 4590 cs%debug\_BT\_HI%jec=g%jec 4591 cs%debug\_BT\_HI%IscB=g%isc-1 4592 cs%debug\_BT\_HI%IecB=g%iec 4593 cs%debug\_BT\_HI%JscB=g%jsc-1 4594 cs%debug\_BT\_HI%JecB=g%jec 4595 cs%debug\_BT\_HI%isd=cs%isdw 4596 cs%debug\_BT\_HI%ied=cs%iedw 4597 cs%debug\_BT\_HI%jsd=cs%jsdw 4598 cs%debug\_BT\_HI%jed=cs%jedw 4599 cs%debug\_BT\_HI%IsdB=cs%isdw-1 4600 cs%debug\_BT\_HI%IedB=cs%iedw 4601 cs%debug\_BT\_HI%JsdB=cs%jsdw-1 4602 cs%debug\_BT\_HI%JedB=cs%jedw 4603 cs%debug\_BT\_HI%turns = g%HI%turns 4604 \textcolor{keywordflow}{ endif} 4605 4606 \textcolor{comment}{! IareaT, IdxCu, and IdyCv need to be allocated with wide halos.} 4607 alloc\_(cs%IareaT(cs%isdw:cs%iedw,cs%jsdw:cs%jedw)) ; cs%IareaT(:,:) = 0.0 4608 alloc\_(cs%bathyT(cs%isdw:cs%iedw,cs%jsdw:cs%jedw)) ; cs%bathyT(:,:) = gv%Angstrom\_m \textcolor{comment}{!### Change to 0.0?} 4609 alloc\_(cs%IdxCu(cs%isdw-1:cs%iedw,cs%jsdw:cs%jedw)) ; cs%IdxCu(:,:) = 0.0 4610 alloc\_(cs%IdyCv(cs%isdw:cs%iedw,cs%jsdw-1:cs%jedw)) ; cs%IdyCv(:,:) = 0.0 4611 alloc\_(cs%dy\_Cu(cs%isdw-1:cs%iedw,cs%jsdw:cs%jedw)) ; cs%dy\_Cu(:,:) = 0.0 4612 alloc\_(cs%dx\_Cv(cs%isdw:cs%iedw,cs%jsdw-1:cs%jedw)) ; cs%dx\_Cv(:,:) = 0.0 4613 \textcolor{keywordflow}{do} j=g%jsd,g%jed ; \textcolor{keywordflow}{do} i=g%isd,g%ied 4614 cs%IareaT(i,j) = g%IareaT(i,j) 4615 cs%bathyT(i,j) = g%bathyT(i,j) 4616 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4617 4618 \textcolor{comment}{! Note: G%IdxCu & G%IdyCv may be valid for a smaller extent than CS%IdxCu & CS%IdyCv, even without} 4619 \textcolor{comment}{! wide halos.} 4620 \textcolor{keywordflow}{do} j=g%jsd,g%jed ; \textcolor{keywordflow}{do} i=g%IsdB,g%IedB 4621 cs%IdxCu(i,j) = g%IdxCu(i,j) ; cs%dy\_Cu(i,j) = g%dy\_Cu(i,j) 4622 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4623 \textcolor{keywordflow}{do} j=g%JsdB,g%JedB ; \textcolor{keywordflow}{do} i=g%isd,g%ied 4624 cs%IdyCv(i,j) = g%IdyCv(i,j) ; cs%dx\_Cv(i,j) = g%dx\_Cv(i,j) 4625 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4626 \textcolor{keyword}{call }create\_group\_pass(pass\_static\_data, cs%IareaT, cs%BT\_domain, to\_all) 4627 \textcolor{keyword}{call }create\_group\_pass(pass\_static\_data, cs%bathyT, cs%BT\_domain, to\_all) 4628 \textcolor{keyword}{call }create\_group\_pass(pass\_static\_data, cs%IdxCu, cs%IdyCv, cs%BT\_domain, to\_all+scalar\_pair) 4629 \textcolor{keyword}{call }create\_group\_pass(pass\_static\_data, cs%dy\_Cu, cs%dx\_Cv, cs%BT\_domain, to\_all+scalar\_pair) 4630 \textcolor{keyword}{call }do\_group\_pass(pass\_static\_data, cs%BT\_domain) 4631 4632 \textcolor{keywordflow}{if} (cs%linearized\_BT\_PV) \textcolor{keywordflow}{then} 4633 alloc\_(cs%q\_D(cs%isdw-1:cs%iedw,cs%jsdw-1:cs%jedw)) 4634 alloc\_(cs%D\_u\_Cor(cs%isdw-1:cs%iedw,cs%jsdw:cs%jedw)) 4635 alloc\_(cs%D\_v\_Cor(cs%isdw:cs%iedw,cs%jsdw-1:cs%jedw)) 4636 cs%q\_D(:,:) = 0.0 ; cs%D\_u\_Cor(:,:) = 0.0 ; cs%D\_v\_Cor(:,:) = 0.0 4637 4638 mean\_sl = g%Z\_ref 4639 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 4640 cs%D\_u\_Cor(i,j) = 0.5 * (max(mean\_sl+g%bathyT(i+1,j),0.0) + max(mean\_sl+g%bathyT(i,j),0.0)) 4641 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4642 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 4643 cs%D\_v\_Cor(i,j) = 0.5 * (max(mean\_sl+g%bathyT(i,j+1),0.0) + max(mean\_sl+g%bathyT(i,j),0.0)) 4644 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4645 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is-1,ie 4646 \textcolor{keywordflow}{if} (g%mask2dT(i,j)+g%mask2dT(i,j+1)+g%mask2dT(i+1,j)+g%mask2dT(i+1,j+1)>0.) \textcolor{keywordflow}{then} 4647 cs%q\_D(i,j) = 0.25 * (cs%BT\_Coriolis\_scale * g%CoriolisBu(i,j)) * & 4648 ((g%areaT(i,j) + g%areaT(i+1,j+1)) + (g%areaT(i+1,j) + g%areaT(i,j+1))) / & 4649 (max(((g%areaT(i,j) * max(mean\_sl+g%bathyT(i,j),0.0) + & 4650 g%areaT(i+1,j+1) * max(mean\_sl+g%bathyT(i+1,j+1),0.0)) + & 4651 (g%areaT(i+1,j) * max(mean\_sl+g%bathyT(i+1,j),0.0) + & 4652 g%areaT(i,j+1) * max(mean\_sl+g%bathyT(i,j+1),0.0))), gv%H\_to\_Z*gv%H\_subroundoff) ) 4653 \textcolor{keywordflow}{else} \textcolor{comment}{! All four h points are masked out so q\_D(I,J) will is meaningless} 4654 cs%q\_D(i,j) = 0. 4655 \textcolor{keywordflow}{ endif} 4656 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4657 \textcolor{comment}{! With very wide halos, q and D need to be calculated on the available data} 4658 \textcolor{comment}{! domain and then updated onto the full computational domain.} 4659 \textcolor{keyword}{call }create\_group\_pass(pass\_q\_d\_cor, cs%q\_D, cs%BT\_Domain, to\_all, position=corner) 4660 \textcolor{keyword}{call }create\_group\_pass(pass\_q\_d\_cor, cs%D\_u\_Cor, cs%D\_v\_Cor, cs%BT\_Domain, & 4661 to\_all+scalar\_pair) 4662 \textcolor{keyword}{call }do\_group\_pass(pass\_q\_d\_cor, cs%BT\_Domain) 4663 \textcolor{keywordflow}{ endif} 4664 4665 \textcolor{keywordflow}{if} (cs%linear\_wave\_drag) \textcolor{keywordflow}{then} 4666 alloc\_(cs%lin\_drag\_u(isdb:iedb,jsd:jed)) ; cs%lin\_drag\_u(:,:) = 0.0 4667 alloc\_(cs%lin\_drag\_v(isd:ied,jsdb:jedb)) ; cs%lin\_drag\_v(:,:) = 0.0 4668 4669 \textcolor{keywordflow}{if} (len\_trim(wave\_drag\_file) > 0) \textcolor{keywordflow}{then} 4670 inputdir = \textcolor{stringliteral}{"."} ; \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"INPUTDIR"}, inputdir) 4671 wave\_drag\_file = trim(slasher(inputdir))//trim(wave\_drag\_file) 4672 \textcolor{keyword}{call }log\_param(param\_file, mdl, \textcolor{stringliteral}{"INPUTDIR/BT\_WAVE\_DRAG\_FILE"}, wave\_drag\_file) 4673 4674 \textcolor{keyword}{allocate}(lin\_drag\_h(isd:ied,jsd:jed)) ; lin\_drag\_h(:,:) = 0.0 4675 4676 \textcolor{keyword}{call }mom\_read\_data(wave\_drag\_file, wave\_drag\_var, lin\_drag\_h, g%Domain, scale=us%m\_to\_Z*us%T\_to\_s) 4677 \textcolor{keyword}{call }pass\_var(lin\_drag\_h, g%Domain) 4678 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 4679 cs%lin\_drag\_u(i,j) = (gv%Z\_to\_H * wave\_drag\_scale) * & 4680 0.5 * (lin\_drag\_h(i,j) + lin\_drag\_h(i+1,j)) 4681 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4682 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 4683 cs%lin\_drag\_v(i,j) = (gv%Z\_to\_H * wave\_drag\_scale) * & 4684 0.5 * (lin\_drag\_h(i,j) + lin\_drag\_h(i,j+1)) 4685 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4686 \textcolor{keyword}{deallocate}(lin\_drag\_h) 4687 \textcolor{keywordflow}{ endif} 4688 \textcolor{keywordflow}{ endif} 4689 4690 cs%dtbt\_fraction = 0.98 ; \textcolor{keywordflow}{if} (dtbt\_input < 0.0) cs%dtbt\_fraction = -dtbt\_input 4691 4692 dtbt\_tmp = -1.0 4693 \textcolor{keywordflow}{if} (query\_initialized(cs%dtbt, \textcolor{stringliteral}{"DTBT"}, restart\_cs)) \textcolor{keywordflow}{then} 4694 dtbt\_tmp = cs%dtbt 4695 \textcolor{keywordflow}{if} ((us%s\_to\_T\_restart /= 0.0) .and. (us%s\_to\_T\_restart /= us%s\_to\_T)) & 4696 dtbt\_tmp = (us%s\_to\_T / us%s\_to\_T\_restart) * cs%dtbt 4697 \textcolor{keywordflow}{ endif} 4698 4699 \textcolor{comment}{! Estimate the maximum stable barotropic time step.} 4700 gtot\_estimate = 0.0 4701 \textcolor{keywordflow}{do} k=1,g%ke ; gtot\_estimate = gtot\_estimate + gv%g\_prime(k) ;\textcolor{keywordflow}{ enddo} 4702 \textcolor{keyword}{call }set\_dtbt(g, gv, us, cs, gtot\_est=gtot\_estimate, ssh\_add=ssh\_extra) 4703 4704 \textcolor{keywordflow}{if} (dtbt\_input > 0.0) \textcolor{keywordflow}{then} 4705 cs%dtbt = us%s\_to\_T * dtbt\_input 4706 \textcolor{keywordflow}{elseif} (dtbt\_tmp > 0.0) \textcolor{keywordflow}{then} 4707 cs%dtbt = dtbt\_tmp 4708 \textcolor{keywordflow}{ endif} 4709 \textcolor{keywordflow}{if} ((dtbt\_tmp > 0.0) .and. (dtbt\_input > 0.0)) calc\_dtbt = .false. 4710 4711 \textcolor{keyword}{call }log\_param(param\_file, mdl, \textcolor{stringliteral}{"DTBT as used"}, cs%dtbt*us%T\_to\_s) 4712 \textcolor{keyword}{call }log\_param(param\_file, mdl, \textcolor{stringliteral}{"estimated maximum DTBT"}, cs%dtbt\_max*us%T\_to\_s) 4713 4714 \textcolor{comment}{! ubtav and vbtav, and perhaps ubt\_IC and vbt\_IC, are allocated and} 4715 \textcolor{comment}{! initialized in register\_barotropic\_restarts.} 4716 4717 \textcolor{keywordflow}{if} (gv%Boussinesq) \textcolor{keywordflow}{then} 4718 thickness\_units = \textcolor{stringliteral}{"m"} ; flux\_units = \textcolor{stringliteral}{"m3 s-1"} 4719 \textcolor{keywordflow}{else} 4720 thickness\_units = \textcolor{stringliteral}{"kg m-2"} ; flux\_units = \textcolor{stringliteral}{"kg s-1"} 4721 \textcolor{keywordflow}{ endif} 4722 4723 cs%id\_PFu\_bt = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'PFuBT'}, diag%axesCu1, time, & 4724 \textcolor{stringliteral}{'Zonal Anomalous Barotropic Pressure Force Force Acceleration'}, \textcolor{stringliteral}{'m s-2'}, conversion=us%L\_T2\_to\_m\_s2) 4725 cs%id\_PFv\_bt = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'PFvBT'}, diag%axesCv1, time, & 4726 \textcolor{stringliteral}{'Meridional Anomalous Barotropic Pressure Force Acceleration'}, \textcolor{stringliteral}{'m s-2'}, conversion=us%L\_T2\_to\_m\_s2) 4727 cs%id\_Coru\_bt = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'CoruBT'}, diag%axesCu1, time, & 4728 \textcolor{stringliteral}{'Zonal Barotropic Coriolis Acceleration'}, \textcolor{stringliteral}{'m s-2'}, conversion=us%L\_T2\_to\_m\_s2) 4729 cs%id\_Corv\_bt = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'CorvBT'}, diag%axesCv1, time, & 4730 \textcolor{stringliteral}{'Meridional Barotropic Coriolis Acceleration'}, \textcolor{stringliteral}{'m s-2'}, conversion=us%L\_T2\_to\_m\_s2) 4731 cs%id\_uaccel = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'u\_accel\_bt'}, diag%axesCu1, time, & 4732 \textcolor{stringliteral}{'Barotropic zonal acceleration'}, \textcolor{stringliteral}{'m s-2'}, conversion=us%L\_T2\_to\_m\_s2) 4733 cs%id\_vaccel = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'v\_accel\_bt'}, diag%axesCv1, time, & 4734 \textcolor{stringliteral}{'Barotropic meridional acceleration'}, \textcolor{stringliteral}{'m s-2'}, conversion=us%L\_T2\_to\_m\_s2) 4735 cs%id\_ubtforce = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'ubtforce'}, diag%axesCu1, time, & 4736 \textcolor{stringliteral}{'Barotropic zonal acceleration from baroclinic terms'}, \textcolor{stringliteral}{'m s-2'}, conversion=us%L\_T2\_to\_m\_s2) 4737 cs%id\_vbtforce = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'vbtforce'}, diag%axesCv1, time, & 4738 \textcolor{stringliteral}{'Barotropic meridional acceleration from baroclinic terms'}, \textcolor{stringliteral}{'m s-2'}, conversion=us%L\_T2\_to\_m\_s2) 4739 cs%id\_ubtdt = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'ubt\_dt'}, diag%axesCu1, time, & 4740 \textcolor{stringliteral}{'Barotropic zonal acceleration'}, \textcolor{stringliteral}{'m s-2'}, conversion=us%L\_T2\_to\_m\_s2) 4741 cs%id\_vbtdt = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'vbt\_dt'}, diag%axesCv1, time, & 4742 \textcolor{stringliteral}{'Barotropic meridional acceleration'}, \textcolor{stringliteral}{'m s-2'}, conversion=us%L\_T2\_to\_m\_s2) 4743 4744 cs%id\_eta\_bt = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'eta\_bt'}, diag%axesT1, time, & 4745 \textcolor{stringliteral}{'Barotropic end SSH'}, thickness\_units, conversion=gv%H\_to\_m) 4746 cs%id\_ubt = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'ubt'}, diag%axesCu1, time, & 4747 \textcolor{stringliteral}{'Barotropic end zonal velocity'}, \textcolor{stringliteral}{'m s-1'}, conversion=us%L\_T\_to\_m\_s) 4748 cs%id\_vbt = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'vbt'}, diag%axesCv1, time, & 4749 \textcolor{stringliteral}{'Barotropic end meridional velocity'}, \textcolor{stringliteral}{'m s-1'}, conversion=us%L\_T\_to\_m\_s) 4750 cs%id\_eta\_st = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'eta\_st'}, diag%axesT1, time, & 4751 \textcolor{stringliteral}{'Barotropic start SSH'}, thickness\_units, conversion=gv%H\_to\_m) 4752 cs%id\_ubt\_st = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'ubt\_st'}, diag%axesCu1, time, & 4753 \textcolor{stringliteral}{'Barotropic start zonal velocity'}, \textcolor{stringliteral}{'m s-1'}, conversion=us%L\_T\_to\_m\_s) 4754 cs%id\_vbt\_st = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'vbt\_st'}, diag%axesCv1, time, & 4755 \textcolor{stringliteral}{'Barotropic start meridional velocity'}, \textcolor{stringliteral}{'m s-1'}, conversion=us%L\_T\_to\_m\_s) 4756 cs%id\_ubtav = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'ubtav'}, diag%axesCu1, time, & 4757 \textcolor{stringliteral}{'Barotropic time-average zonal velocity'}, \textcolor{stringliteral}{'m s-1'}, conversion=us%L\_T\_to\_m\_s) 4758 cs%id\_vbtav = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'vbtav'}, diag%axesCv1, time, & 4759 \textcolor{stringliteral}{'Barotropic time-average meridional velocity'}, \textcolor{stringliteral}{'m s-1'}, conversion=us%L\_T\_to\_m\_s) 4760 cs%id\_eta\_cor = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'eta\_cor'}, diag%axesT1, time, & 4761 \textcolor{stringliteral}{'Corrective mass flux'}, \textcolor{stringliteral}{'m s-1'}, conversion=gv%H\_to\_m) 4762 cs%id\_visc\_rem\_u = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'visc\_rem\_u'}, diag%axesCuL, time, & 4763 \textcolor{stringliteral}{'Viscous remnant at u'}, \textcolor{stringliteral}{'nondim'}) 4764 cs%id\_visc\_rem\_v = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'visc\_rem\_v'}, diag%axesCvL, time, & 4765 \textcolor{stringliteral}{'Viscous remnant at v'}, \textcolor{stringliteral}{'nondim'}) 4766 cs%id\_gtotn = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'gtot\_n'}, diag%axesT1, time, & 4767 \textcolor{stringliteral}{'gtot to North'}, \textcolor{stringliteral}{'m s-2'}, conversion=gv%m\_to\_H*(us%L\_T\_to\_m\_s**2)) 4768 cs%id\_gtots = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'gtot\_s'}, diag%axesT1, time, & 4769 \textcolor{stringliteral}{'gtot to South'}, \textcolor{stringliteral}{'m s-2'}, conversion=gv%m\_to\_H*(us%L\_T\_to\_m\_s**2)) 4770 cs%id\_gtote = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'gtot\_e'}, diag%axesT1, time, & 4771 \textcolor{stringliteral}{'gtot to East'}, \textcolor{stringliteral}{'m s-2'}, conversion=gv%m\_to\_H*(us%L\_T\_to\_m\_s**2)) 4772 cs%id\_gtotw = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'gtot\_w'}, diag%axesT1, time, & 4773 \textcolor{stringliteral}{'gtot to West'}, \textcolor{stringliteral}{'m s-2'}, conversion=gv%m\_to\_H*(us%L\_T\_to\_m\_s**2)) 4774 cs%id\_eta\_hifreq = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'eta\_hifreq'}, diag%axesT1, time, & 4775 \textcolor{stringliteral}{'High Frequency Barotropic SSH'}, thickness\_units, conversion=gv%H\_to\_m) 4776 cs%id\_ubt\_hifreq = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'ubt\_hifreq'}, diag%axesCu1, time, & 4777 \textcolor{stringliteral}{'High Frequency Barotropic zonal velocity'}, \textcolor{stringliteral}{'m s-1'}, conversion=us%L\_T\_to\_m\_s) 4778 cs%id\_vbt\_hifreq = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'vbt\_hifreq'}, diag%axesCv1, time, & 4779 \textcolor{stringliteral}{'High Frequency Barotropic meridional velocity'}, \textcolor{stringliteral}{'m s-1'}, conversion=us%L\_T\_to\_m\_s) 4780 cs%id\_eta\_pred\_hifreq = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'eta\_pred\_hifreq'}, diag%axesT1, time, & 4781 \textcolor{stringliteral}{'High Frequency Predictor Barotropic SSH'}, thickness\_units, & 4782 conversion=gv%H\_to\_m) 4783 cs%id\_uhbt\_hifreq = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'uhbt\_hifreq'}, diag%axesCu1, time, & 4784 \textcolor{stringliteral}{'High Frequency Barotropic zonal transport'}, \textcolor{stringliteral}{'m3 s-1'}, & 4785 conversion=gv%H\_to\_m*us%L\_to\_m*us%L\_T\_to\_m\_s) 4786 cs%id\_vhbt\_hifreq = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'vhbt\_hifreq'}, diag%axesCv1, time, & 4787 \textcolor{stringliteral}{'High Frequency Barotropic meridional transport'}, \textcolor{stringliteral}{'m3 s-1'}, & 4788 conversion=gv%H\_to\_m*us%L\_to\_m*us%L\_T\_to\_m\_s) 4789 cs%id\_frhatu = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'frhatu'}, diag%axesCuL, time, & 4790 \textcolor{stringliteral}{'Fractional thickness of layers in u-columns'}, \textcolor{stringliteral}{'nondim'}) 4791 cs%id\_frhatv = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'frhatv'}, diag%axesCvL, time, & 4792 \textcolor{stringliteral}{'Fractional thickness of layers in v-columns'}, \textcolor{stringliteral}{'nondim'}) 4793 cs%id\_frhatu1 = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'frhatu1'}, diag%axesCuL, time, & 4794 \textcolor{stringliteral}{'Predictor Fractional thickness of layers in u-columns'}, \textcolor{stringliteral}{'nondim'}) 4795 cs%id\_frhatv1 = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'frhatv1'}, diag%axesCvL, time, & 4796 \textcolor{stringliteral}{'Predictor Fractional thickness of layers in v-columns'}, \textcolor{stringliteral}{'nondim'}) 4797 cs%id\_uhbt = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'uhbt'}, diag%axesCu1, time, & 4798 \textcolor{stringliteral}{'Barotropic zonal transport averaged over a baroclinic step'}, \textcolor{stringliteral}{'m3 s-1'}, & 4799 conversion=gv%H\_to\_m*us%L\_to\_m*us%L\_T\_to\_m\_s) 4800 cs%id\_vhbt = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'vhbt'}, diag%axesCv1, time, & 4801 \textcolor{stringliteral}{'Barotropic meridional transport averaged over a baroclinic step'}, \textcolor{stringliteral}{'m3 s-1'}, & 4802 conversion=gv%H\_to\_m*us%L\_to\_m*us%L\_T\_to\_m\_s) 4803 4804 \textcolor{keywordflow}{if} (use\_bt\_cont\_type) \textcolor{keywordflow}{then} 4805 cs%id\_BTC\_FA\_u\_EE = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'BTC\_FA\_u\_EE'}, diag%axesCu1, time, & 4806 \textcolor{stringliteral}{'BTCont type far east face area'}, \textcolor{stringliteral}{'m2'}, conversion=us%L\_to\_m*gv%H\_to\_m) 4807 cs%id\_BTC\_FA\_u\_E0 = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'BTC\_FA\_u\_E0'}, diag%axesCu1, time, & 4808 \textcolor{stringliteral}{'BTCont type near east face area'}, \textcolor{stringliteral}{'m2'}, conversion=us%L\_to\_m*gv%H\_to\_m) 4809 cs%id\_BTC\_FA\_u\_WW = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'BTC\_FA\_u\_WW'}, diag%axesCu1, time, & 4810 \textcolor{stringliteral}{'BTCont type far west face area'}, \textcolor{stringliteral}{'m2'}, conversion=us%L\_to\_m*gv%H\_to\_m) 4811 cs%id\_BTC\_FA\_u\_W0 = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'BTC\_FA\_u\_W0'}, diag%axesCu1, time, & 4812 \textcolor{stringliteral}{'BTCont type near west face area'}, \textcolor{stringliteral}{'m2'}, conversion=us%L\_to\_m*gv%H\_to\_m) 4813 cs%id\_BTC\_ubt\_EE = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'BTC\_ubt\_EE'}, diag%axesCu1, time, & 4814 \textcolor{stringliteral}{'BTCont type far east velocity'}, \textcolor{stringliteral}{'m s-1'}, conversion=us%L\_T\_to\_m\_s) 4815 cs%id\_BTC\_ubt\_WW = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'BTC\_ubt\_WW'}, diag%axesCu1, time, & 4816 \textcolor{stringliteral}{'BTCont type far west velocity'}, \textcolor{stringliteral}{'m s-1'}, conversion=us%L\_T\_to\_m\_s) 4817 \textcolor{comment}{! This is a specialized diagnostic that is not being made widely available (yet).} 4818 \textcolor{comment}{! CS%id\_BTC\_FA\_u\_rat0 = register\_diag\_field('ocean\_model', 'BTC\_FA\_u\_rat0', diag%axesCu1, Time, &} 4819 \textcolor{comment}{! 'BTCont type ratio of near east and west face areas', 'nondim')} 4820 cs%id\_BTC\_FA\_v\_NN = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'BTC\_FA\_v\_NN'}, diag%axesCv1, time, & 4821 \textcolor{stringliteral}{'BTCont type far north face area'}, \textcolor{stringliteral}{'m2'}, conversion=us%L\_to\_m*gv%H\_to\_m) 4822 cs%id\_BTC\_FA\_v\_N0 = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'BTC\_FA\_v\_N0'}, diag%axesCv1, time, & 4823 \textcolor{stringliteral}{'BTCont type near north face area'}, \textcolor{stringliteral}{'m2'}, conversion=us%L\_to\_m*gv%H\_to\_m) 4824 cs%id\_BTC\_FA\_v\_SS = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'BTC\_FA\_v\_SS'}, diag%axesCv1, time, & 4825 \textcolor{stringliteral}{'BTCont type far south face area'}, \textcolor{stringliteral}{'m2'}, conversion=us%L\_to\_m*gv%H\_to\_m) 4826 cs%id\_BTC\_FA\_v\_S0 = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'BTC\_FA\_v\_S0'}, diag%axesCv1, time, & 4827 \textcolor{stringliteral}{'BTCont type near south face area'}, \textcolor{stringliteral}{'m2'}, conversion=us%L\_to\_m*gv%H\_to\_m) 4828 cs%id\_BTC\_vbt\_NN = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'BTC\_vbt\_NN'}, diag%axesCv1, time, & 4829 \textcolor{stringliteral}{'BTCont type far north velocity'}, \textcolor{stringliteral}{'m s-1'}, conversion=us%L\_T\_to\_m\_s) 4830 cs%id\_BTC\_vbt\_SS = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'BTC\_vbt\_SS'}, diag%axesCv1, time, & 4831 \textcolor{stringliteral}{'BTCont type far south velocity'}, \textcolor{stringliteral}{'m s-1'}, conversion=us%L\_T\_to\_m\_s) 4832 \textcolor{comment}{! This is a specialized diagnostic that is not being made widely available (yet).} 4833 \textcolor{comment}{! CS%id\_BTC\_FA\_v\_rat0 = register\_diag\_field('ocean\_model', 'BTC\_FA\_v\_rat0', diag%axesCv1, Time, &} 4834 \textcolor{comment}{! 'BTCont type ratio of near north and south face areas', 'nondim')} 4835 \textcolor{comment}{! CS%id\_BTC\_FA\_h\_rat0 = register\_diag\_field('ocean\_model', 'BTC\_FA\_h\_rat0', diag%axesT1, Time, &} 4836 \textcolor{comment}{! 'BTCont type maximum ratios of near face areas around cells', 'nondim')} 4837 \textcolor{keywordflow}{ endif} 4838 cs%id\_uhbt0 = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'uhbt0'}, diag%axesCu1, time, & 4839 \textcolor{stringliteral}{'Barotropic zonal transport difference'}, \textcolor{stringliteral}{'m3 s-1'}, conversion=gv%H\_to\_m*us%L\_to\_m**2*us%s\_to\_T) 4840 cs%id\_vhbt0 = register\_diag\_field(\textcolor{stringliteral}{'ocean\_model'}, \textcolor{stringliteral}{'vhbt0'}, diag%axesCv1, time, & 4841 \textcolor{stringliteral}{'Barotropic meridional transport difference'}, \textcolor{stringliteral}{'m3 s-1'}, conversion=gv%H\_to\_m*us%L\_to\_m**2*us%s\_to\_T) 4842 4843 \textcolor{keywordflow}{if} (cs%id\_frhatu1 > 0) \textcolor{keyword}{call }safe\_alloc\_ptr(cs%frhatu1, isdb,iedb,jsd,jed,nz) 4844 \textcolor{keywordflow}{if} (cs%id\_frhatv1 > 0) \textcolor{keyword}{call }safe\_alloc\_ptr(cs%frhatv1, isd,ied,jsdb,jedb,nz) 4845 4846 \textcolor{keywordflow}{if} (.NOT.query\_initialized(cs%ubtav,\textcolor{stringliteral}{"ubtav"},restart\_cs) .or. & 4847 .NOT.query\_initialized(cs%vbtav,\textcolor{stringliteral}{"vbtav"},restart\_cs)) \textcolor{keywordflow}{then} 4848 \textcolor{keyword}{call }btcalc(h, g, gv, cs, may\_use\_default=.true.) 4849 cs%ubtav(:,:) = 0.0 ; cs%vbtav(:,:) = 0.0 4850 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 4851 cs%ubtav(i,j) = cs%ubtav(i,j) + cs%frhatu(i,j,k) * u(i,j,k) 4852 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4853 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 4854 cs%vbtav(i,j) = cs%vbtav(i,j) + cs%frhatv(i,j,k) * v(i,j,k) 4855 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4856 \textcolor{keywordflow}{elseif} ((us%s\_to\_T\_restart*us%m\_to\_L\_restart /= 0.0) .and. & 4857 (us%m\_to\_L*us%s\_to\_T\_restart) /= (us%m\_to\_L\_restart*us%s\_to\_T)) \textcolor{keywordflow}{then} 4858 vel\_rescale = (us%m\_to\_L*us%s\_to\_T\_restart) / (us%m\_to\_L\_restart*us%s\_to\_T) 4859 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; cs%ubtav(i,j) = vel\_rescale * cs%ubtav(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4860 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; cs%vbtav(i,j) = vel\_rescale * cs%vbtav(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4861 \textcolor{keywordflow}{ endif} 4862 4863 \textcolor{keywordflow}{if} (cs%gradual\_BT\_ICs) \textcolor{keywordflow}{then} 4864 \textcolor{keywordflow}{if} (.NOT.query\_initialized(cs%ubt\_IC,\textcolor{stringliteral}{"ubt\_IC"},restart\_cs) .or. & 4865 .NOT.query\_initialized(cs%vbt\_IC,\textcolor{stringliteral}{"vbt\_IC"},restart\_cs)) \textcolor{keywordflow}{then} 4866 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; cs%ubt\_IC(i,j) = cs%ubtav(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4867 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; cs%vbt\_IC(i,j) = cs%vbtav(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4868 \textcolor{keywordflow}{elseif} ((us%s\_to\_T\_restart*us%m\_to\_L\_restart /= 0.0) .and. & 4869 (us%m\_to\_L*us%s\_to\_T\_restart) /= (us%m\_to\_L\_restart*us%s\_to\_T)) \textcolor{keywordflow}{then} 4870 vel\_rescale = (us%m\_to\_L*us%s\_to\_T\_restart) / (us%m\_to\_L\_restart*us%s\_to\_T) 4871 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; cs%ubt\_IC(i,j) = vel\_rescale * cs%ubt\_IC(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4872 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; cs%vbt\_IC(i,j) = vel\_rescale * cs%vbt\_IC(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4873 \textcolor{keywordflow}{ endif} 4874 \textcolor{keywordflow}{ endif} 4875 \textcolor{comment}{! Calculate other constants which are used for btstep.} 4876 4877 \textcolor{keywordflow}{if} (.not.cs%nonlin\_stress) \textcolor{keywordflow}{then} 4878 mean\_sl = g%Z\_ref 4879 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 4880 \textcolor{keywordflow}{if} (g%mask2dCu(i,j)>0.) \textcolor{keywordflow}{then} 4881 cs%IDatu(i,j) = g%mask2dCu(i,j) * 2.0 / ((g%bathyT(i+1,j) + g%bathyT(i,j)) + 2.0*mean\_sl) 4882 \textcolor{keywordflow}{else} \textcolor{comment}{! Both neighboring H points are masked out so IDatu(I,j) is meaningless} 4883 cs%IDatu(i,j) = 0. 4884 \textcolor{keywordflow}{ endif} 4885 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4886 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 4887 \textcolor{keywordflow}{if} (g%mask2dCv(i,j)>0.) \textcolor{keywordflow}{then} 4888 cs%IDatv(i,j) = g%mask2dCv(i,j) * 2.0 / ((g%bathyT(i,j+1) + g%bathyT(i,j)) + 2.0*mean\_sl) 4889 \textcolor{keywordflow}{else} \textcolor{comment}{! Both neighboring H points are masked out so IDatv(i,J) is meaningless} 4890 cs%IDatv(i,j) = 0. 4891 \textcolor{keywordflow}{ endif} 4892 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4893 \textcolor{keywordflow}{ endif} 4894 4895 \textcolor{keyword}{call }find\_face\_areas(datu, datv, g, gv, us, cs, ms, halo=1) 4896 \textcolor{keywordflow}{if} ((cs%bound\_BT\_corr) .and. .not.(use\_bt\_cont\_type .and. cs%BT\_cont\_bounds)) \textcolor{keywordflow}{then} 4897 \textcolor{comment}{! This is not used in most test cases. Were it ever to become more widely used, consider} 4898 \textcolor{comment}{! replacing maxvel with min(G%dxT(i,j),G%dyT(i,j)) * (CS%maxCFL\_BT\_cont*Idt) .} 4899 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 4900 cs%eta\_cor\_bound(i,j) = g%IareaT(i,j) * 0.1 * cs%maxvel * & 4901 ((datu(i-1,j) + datu(i,j)) + (datv(i,j) + datv(i,j-1))) 4902 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4903 \textcolor{keywordflow}{ endif} 4904 4905 \textcolor{keywordflow}{if} (cs%gradual\_BT\_ICs) & 4906 \textcolor{keyword}{call }create\_group\_pass(pass\_bt\_hbt\_btav, cs%ubt\_IC, cs%vbt\_IC, g%Domain) 4907 \textcolor{keyword}{call }create\_group\_pass(pass\_bt\_hbt\_btav, cs%ubtav, cs%vbtav, g%Domain) 4908 \textcolor{keyword}{call }do\_group\_pass(pass\_bt\_hbt\_btav, g%Domain) 4909 4910 \textcolor{comment}{! id\_clock\_pass = cpu\_clock\_id('(Ocean BT halo updates)', grain=CLOCK\_ROUTINE)} 4911 id\_clock\_calc\_pre = cpu\_clock\_id(\textcolor{stringliteral}{'(Ocean BT pre-calcs only)'}, grain=clock\_routine) 4912 id\_clock\_pass\_pre = cpu\_clock\_id(\textcolor{stringliteral}{'(Ocean BT pre-step halo updates)'}, grain=clock\_routine) 4913 id\_clock\_calc = cpu\_clock\_id(\textcolor{stringliteral}{'(Ocean BT stepping calcs only)'}, grain=clock\_routine) 4914 id\_clock\_pass\_step = cpu\_clock\_id(\textcolor{stringliteral}{'(Ocean BT stepping halo updates)'}, grain=clock\_routine) 4915 id\_clock\_calc\_post = cpu\_clock\_id(\textcolor{stringliteral}{'(Ocean BT post-calcs only)'}, grain=clock\_routine) 4916 id\_clock\_pass\_post = cpu\_clock\_id(\textcolor{stringliteral}{'(Ocean BT post-step halo updates)'}, grain=clock\_routine) 4917 \textcolor{keywordflow}{if} (dtbt\_input <= 0.0) & 4918 id\_clock\_sync = cpu\_clock\_id(\textcolor{stringliteral}{'(Ocean BT global synch)'}, grain=clock\_routine) 4919 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_ac7100cec548b4bf6d69d4a52e074a04f}\label{namespacemom__barotropic_ac7100cec548b4bf6d69d4a52e074a04f}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!bt\+\_\+cont\+\_\+to\+\_\+face\+\_\+areas@{bt\+\_\+cont\+\_\+to\+\_\+face\+\_\+areas}} \index{bt\+\_\+cont\+\_\+to\+\_\+face\+\_\+areas@{bt\+\_\+cont\+\_\+to\+\_\+face\+\_\+areas}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{bt\+\_\+cont\+\_\+to\+\_\+face\+\_\+areas()}{bt\_cont\_to\_face\_areas()}} {\footnotesize\ttfamily subroutine mom\+\_\+barotropic\+::bt\+\_\+cont\+\_\+to\+\_\+face\+\_\+areas (\begin{DoxyParamCaption}\item[{type(bt\+\_\+cont\+\_\+type), intent(inout)}]{B\+T\+\_\+cont, }\item[{real, dimension(ms\%isdw-\/1\+:ms\%iedw,ms\%jsdw\+:ms\%jedw), intent(out)}]{Datu, }\item[{real, dimension(ms\%isdw\+:ms\%iedw,ms\%jsdw-\/1\+:ms\%jedw), intent(out)}]{Datv, }\item[{type(ocean\+\_\+grid\+\_\+type), intent(in)}]{G, }\item[{type(unit\+\_\+scale\+\_\+type), intent(in)}]{US, }\item[{type(\hyperlink{structmom__barotropic_1_1memory__size__type}{memory\+\_\+size\+\_\+type}), intent(in)}]{MS, }\item[{integer, intent(in), optional}]{halo, }\item[{logical, intent(in), optional}]{maximize }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} This subroutine uses the B\+T\+CL types to find typical or maximum face areas, which can then be used for finding wave speeds, etc. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in,out} & {\em bt\+\_\+cont} & The B\+T\+\_\+cont\+\_\+type input to the barotropic solver.\\ \hline \mbox{\tt in} & {\em ms} & A type that describes the memory sizes of the argument arrays.\\ \hline \mbox{\tt out} & {\em datu} & The effective zonal face area \mbox{[}H L $\sim$$>$ m2 or kg m-\/1\mbox{]}.\\ \hline \mbox{\tt out} & {\em datv} & The effective meridional face area \mbox{[}H L $\sim$$>$ m2 or kg m-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em g} & The ocean\textquotesingle{}s grid structure.\\ \hline \mbox{\tt in} & {\em us} & A dimensional unit scaling type\\ \hline \mbox{\tt in} & {\em halo} & The extra halo size to use here.\\ \hline \mbox{\tt in} & {\em maximize} & If present and true, find the maximum face area for any velocity. \\ \hline \end{DoxyParams} Definition at line 3997 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 3997 \textcolor{keywordtype}{type}(bt\_cont\_type), \textcolor{keywordtype}{intent(inout)} :: bt\_cont\textcolor{comment}{ !< The BT\_cont\_type input to the} 3998 \textcolor{comment}{ !! barotropic solver.} 3999 \textcolor{keywordtype}{type}(memory\_size\_type), \textcolor{keywordtype}{intent(in)} :: ms\textcolor{comment}{ !< A type that describes the memory} 4000 \textcolor{comment}{ !! sizes of the argument arrays.} 4001 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw)}, & 4002 \textcolor{keywordtype}{intent(out)} :: datu\textcolor{comment}{ !< The effective zonal face area [H L ~> m2 or kg m-1].} 4003 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw)}, & 4004 \textcolor{keywordtype}{intent(out)} :: datv\textcolor{comment}{ !< The effective meridional face area [H L ~> m2 or kg m-1].} 4005 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(in)} :: g\textcolor{comment}{ !< The ocean's grid structure.} 4006 \textcolor{keywordtype}{type}(unit\_scale\_type), \textcolor{keywordtype}{intent(in)} :: us\textcolor{comment}{ !< A dimensional unit scaling type} 4007 \textcolor{keywordtype}{integer}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: halo\textcolor{comment}{ !< The extra halo size to use here.} 4008 \textcolor{keywordtype}{logical}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: maximize\textcolor{comment}{ !< If present and true, find the} 4009 \textcolor{comment}{ !! maximum face area for any velocity.} 4010 4011 \textcolor{comment}{! Local variables} 4012 \textcolor{keywordtype}{logical} :: find\_max 4013 \textcolor{keywordtype}{integer} :: i, j, is, ie, js, je, hs 4014 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec 4015 hs = 1 ; \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(halo)) hs = max(halo,0) 4016 find\_max = .false. ; \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(maximize)) find\_max = maximize 4017 4018 \textcolor{keywordflow}{if} (find\_max) \textcolor{keywordflow}{then} 4019 \textcolor{keywordflow}{do} j=js-hs,je+hs ; \textcolor{keywordflow}{do} i=is-1-hs,ie+hs 4020 datu(i,j) = max(bt\_cont%FA\_u\_EE(i,j), bt\_cont%FA\_u\_E0(i,j), & 4021 bt\_cont%FA\_u\_W0(i,j), bt\_cont%FA\_u\_WW(i,j)) 4022 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4023 \textcolor{keywordflow}{do} j=js-1-hs,je+hs ; \textcolor{keywordflow}{do} i=is-hs,ie+hs 4024 datv(i,j) = max(bt\_cont%FA\_v\_NN(i,j), bt\_cont%FA\_v\_N0(i,j), & 4025 bt\_cont%FA\_v\_S0(i,j), bt\_cont%FA\_v\_SS(i,j)) 4026 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4027 \textcolor{keywordflow}{else} 4028 \textcolor{keywordflow}{do} j=js-hs,je+hs ; \textcolor{keywordflow}{do} i=is-1-hs,ie+hs 4029 datu(i,j) = 0.5 * (bt\_cont%FA\_u\_E0(i,j) + bt\_cont%FA\_u\_W0(i,j)) 4030 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4031 \textcolor{keywordflow}{do} j=js-1-hs,je+hs ; \textcolor{keywordflow}{do} i=is-hs,ie+hs 4032 datv(i,j) = 0.5 * (bt\_cont%FA\_v\_N0(i,j) + bt\_cont%FA\_v\_S0(i,j)) 4033 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4034 \textcolor{keywordflow}{ endif} 4035 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_a856387dc8ee2b7b50ea2bd9fca16db78}\label{namespacemom__barotropic_a856387dc8ee2b7b50ea2bd9fca16db78}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!bt\+\_\+mass\+\_\+source@{bt\+\_\+mass\+\_\+source}} \index{bt\+\_\+mass\+\_\+source@{bt\+\_\+mass\+\_\+source}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{bt\+\_\+mass\+\_\+source()}{bt\_mass\_source()}} {\footnotesize\ttfamily subroutine, public mom\+\_\+barotropic\+::bt\+\_\+mass\+\_\+source (\begin{DoxyParamCaption}\item[{real, dimension(szi\+\_\+(g),szj\+\_\+(g),szk\+\_\+(g)), intent(in)}]{h, }\item[{real, dimension(szi\+\_\+(g),szj\+\_\+(g)), intent(in)}]{eta, }\item[{logical, intent(in)}]{set\+\_\+cor, }\item[{type(ocean\+\_\+grid\+\_\+type), intent(in)}]{G, }\item[{type(verticalgrid\+\_\+type), intent(in)}]{GV, }\item[{type(\hyperlink{structmom__barotropic_1_1barotropic__cs}{barotropic\+\_\+cs}), pointer}]{CS }\end{DoxyParamCaption})} bt\+\_\+mass\+\_\+source determines the appropriately limited mass source for the barotropic solver, along with a corrective fictitious mass source that will drive the barotropic estimate of the free surface height toward the baroclinic estimate. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in} & {\em g} & The ocean\textquotesingle{}s grid structure.\\ \hline \mbox{\tt in} & {\em gv} & The ocean\textquotesingle{}s vertical grid structure.\\ \hline \mbox{\tt in} & {\em h} & Layer thicknesses \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline \mbox{\tt in} & {\em eta} & The free surface height that is to be corrected \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline \mbox{\tt in} & {\em set\+\_\+cor} & A flag to indicate whether to set the corrective fluxes (and update the slowly varying part of eta\+\_\+cor) (.true.) or whether to incrementally update the corrective fluxes.\\ \hline & {\em cs} & The control structure returned by a previous call to barotropic\+\_\+init. \\ \hline \end{DoxyParams} Definition at line 4147 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 4147 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(in)} :: g\textcolor{comment}{ !< The ocean's grid structure.} 4148 \textcolor{keywordtype}{type}(verticalgrid\_type), \textcolor{keywordtype}{intent(in)} :: gv\textcolor{comment}{ !< The ocean's vertical grid structure.} 4149 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G),SZK\_(G))}, \textcolor{keywordtype}{intent(in)} :: h\textcolor{comment}{ !< Layer thicknesses [H ~> m or kg m-2].} 4150 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G))}, \textcolor{keywordtype}{intent(in)} :: eta\textcolor{comment}{ !< The free surface height that is to be} 4151 \textcolor{comment}{ !! corrected [H ~> m or kg m-2].} 4152 \textcolor{keywordtype}{logical}, \textcolor{keywordtype}{intent(in)} :: set\_cor\textcolor{comment}{ !< A flag to indicate whether to set the corrective} 4153 \textcolor{comment}{ !! fluxes (and update the slowly varying part of eta\_cor)} 4154 \textcolor{comment}{ !! (.true.) or whether to incrementally update the} 4155 \textcolor{comment}{ !! corrective fluxes.} 4156 \textcolor{keywordtype}{type}(barotropic\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< The control structure returned by a previous call} 4157 \textcolor{comment}{ !! to barotropic\_init.} 4158 4159 \textcolor{comment}{! Local variables} 4160 \textcolor{keywordtype}{real} :: h\_tot(szi\_(g)) \textcolor{comment}{! The sum of the layer thicknesses [H ~> m or kg m-2].} 4161 \textcolor{keywordtype}{real} :: eta\_h(szi\_(g)) \textcolor{comment}{! The free surface height determined from} 4162 \textcolor{comment}{! the sum of the layer thicknesses [H ~> m or kg m-2].} 4163 \textcolor{keywordtype}{real} :: d\_eta \textcolor{comment}{! The difference between estimates of the total} 4164 \textcolor{comment}{! thicknesses [H ~> m or kg m-2].} 4165 \textcolor{keywordtype}{integer} :: is, ie, js, je, nz, i, j, k 4166 4167 \textcolor{keywordflow}{if} (.not.\textcolor{keyword}{associated}(cs)) \textcolor{keyword}{call }mom\_error(fatal, \textcolor{stringliteral}{"bt\_mass\_source: "}// & 4168 \textcolor{stringliteral}{"Module MOM\_barotropic must be initialized before it is used."}) 4169 \textcolor{keywordflow}{if} (.not.cs%split) \textcolor{keywordflow}{return} 4170 4171 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke 4172 4173 \textcolor{comment}{!$OMP parallel do default(shared) private(eta\_h,h\_tot,d\_eta)} 4174 \textcolor{keywordflow}{do} j=js,je 4175 \textcolor{keywordflow}{do} i=is,ie ; h\_tot(i) = h(i,j,1) ;\textcolor{keywordflow}{ enddo} 4176 \textcolor{keywordflow}{if} (gv%Boussinesq) \textcolor{keywordflow}{then} 4177 \textcolor{keywordflow}{do} i=is,ie ; eta\_h(i) = h(i,j,1) - g%bathyT(i,j)*gv%Z\_to\_H ;\textcolor{keywordflow}{ enddo} 4178 \textcolor{keywordflow}{else} 4179 \textcolor{keywordflow}{do} i=is,ie ; eta\_h(i) = h(i,j,1) ;\textcolor{keywordflow}{ enddo} 4180 \textcolor{keywordflow}{ endif} 4181 \textcolor{keywordflow}{do} k=2,nz ; \textcolor{keywordflow}{do} i=is,ie 4182 eta\_h(i) = eta\_h(i) + h(i,j,k) 4183 h\_tot(i) = h\_tot(i) + h(i,j,k) 4184 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4185 4186 \textcolor{keywordflow}{if} (set\_cor) \textcolor{keywordflow}{then} 4187 \textcolor{keywordflow}{do} i=is,ie 4188 d\_eta = eta\_h(i) - eta(i,j) 4189 cs%eta\_cor(i,j) = d\_eta 4190 \textcolor{keywordflow}{ enddo} 4191 \textcolor{keywordflow}{else} 4192 \textcolor{keywordflow}{do} i=is,ie 4193 d\_eta = eta\_h(i) - eta(i,j) 4194 cs%eta\_cor(i,j) = cs%eta\_cor(i,j) + d\_eta 4195 \textcolor{keywordflow}{ enddo} 4196 \textcolor{keywordflow}{ endif} 4197 \textcolor{keywordflow}{ enddo} 4198 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_aa60ee766449413de40cdbc19964a6556}\label{namespacemom__barotropic_aa60ee766449413de40cdbc19964a6556}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!btcalc@{btcalc}} \index{btcalc@{btcalc}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{btcalc()}{btcalc()}} {\footnotesize\ttfamily subroutine, public mom\+\_\+barotropic\+::btcalc (\begin{DoxyParamCaption}\item[{real, dimension(szi\+\_\+(g),szj\+\_\+(g),szk\+\_\+(g)), intent(in)}]{h, }\item[{type(ocean\+\_\+grid\+\_\+type), intent(inout)}]{G, }\item[{type(verticalgrid\+\_\+type), intent(in)}]{GV, }\item[{type(\hyperlink{structmom__barotropic_1_1barotropic__cs}{barotropic\+\_\+cs}), pointer}]{CS, }\item[{real, dimension(szib\+\_\+(g),szj\+\_\+(g),szk\+\_\+(g)), intent(in), optional}]{h\+\_\+u, }\item[{real, dimension(szi\+\_\+(g),szjb\+\_\+(g),szk\+\_\+(g)), intent(in), optional}]{h\+\_\+v, }\item[{logical, intent(in), optional}]{may\+\_\+use\+\_\+default, }\item[{type(ocean\+\_\+obc\+\_\+type), optional, pointer}]{O\+BC }\end{DoxyParamCaption})} btcalc calculates the barotropic velocities from the full velocity and thickness fields, determines the fraction of the total water column in each layer at velocity points, and determines a corrective fictitious mass source that will drive the barotropic estimate of the free surface height toward the baroclinic estimate. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in,out} & {\em g} & The ocean\textquotesingle{}s grid structure.\\ \hline \mbox{\tt in} & {\em gv} & The ocean\textquotesingle{}s vertical grid structure.\\ \hline \mbox{\tt in} & {\em h} & Layer thicknesses \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline & {\em cs} & The control structure returned by a previous call to barotropic\+\_\+init.\\ \hline \mbox{\tt in} & {\em h\+\_\+u} & The specified thicknesses at u-\/points \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline \mbox{\tt in} & {\em h\+\_\+v} & The specified thicknesses at v-\/points \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline \mbox{\tt in} & {\em may\+\_\+use\+\_\+default} & An optional logical argument to indicate that the default velocity point thicknesses may be used for this particular calculation, even though the setting of CShvel\+\_\+scheme would usually require that h\+\_\+u and h\+\_\+v be passed in.\\ \hline & {\em obc} & Open boundary control structure. \\ \hline \end{DoxyParams} Definition at line 3184 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 3184 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(inout)} :: g\textcolor{comment}{ !< The ocean's grid structure.} 3185 \textcolor{keywordtype}{type}(verticalgrid\_type), \textcolor{keywordtype}{intent(in)} :: gv\textcolor{comment}{ !< The ocean's vertical grid structure.} 3186 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G),SZK\_(G))}, & 3187 \textcolor{keywordtype}{intent(in)} :: h\textcolor{comment}{ !< Layer thicknesses [H ~> m or kg m-2].} 3188 \textcolor{keywordtype}{type}(barotropic\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< The control structure returned by a previous} 3189 \textcolor{comment}{ !! call to barotropic\_init.} 3190 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G),SZK\_(G))}, & 3191 \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: h\_u\textcolor{comment}{ !< The specified thicknesses at u-points [H ~> m or kg m-2].} 3192 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G),SZK\_(G))}, & 3193 \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: h\_v\textcolor{comment}{ !< The specified thicknesses at v-points [H ~> m or kg m-2].} 3194 \textcolor{keywordtype}{logical}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: may\_use\_default\textcolor{comment}{ !< An optional logical argument} 3195 \textcolor{comment}{ !! to indicate that the default velocity point} 3196 \textcolor{comment}{ !! thicknesses may be used for this particular} 3197 \textcolor{comment}{ !! calculation, even though the setting of} 3198 \textcolor{comment}{ !! CS%hvel\_scheme would usually require that h\_u} 3199 \textcolor{comment}{ !! and h\_v be passed in.} 3200 \textcolor{keywordtype}{type}(ocean\_obc\_type), \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: obc\textcolor{comment}{ !< Open boundary control structure.} 3201 3202 \textcolor{comment}{! Local variables} 3203 \textcolor{keywordtype}{real} :: hatutot(szib\_(g)) \textcolor{comment}{! The sum of the layer thicknesses interpolated to u points [H ~> m or kg m-2].} 3204 \textcolor{keywordtype}{real} :: hatvtot(szi\_(g)) \textcolor{comment}{! The sum of the layer thicknesses interpolated to v points [H ~> m or kg m-2].} 3205 \textcolor{keywordtype}{real} :: ihatutot(szib\_(g)) \textcolor{comment}{! Ihatutot is the inverse of hatutot [H-1 ~> m-1 or m2 kg-1].} 3206 \textcolor{keywordtype}{real} :: ihatvtot(szi\_(g)) \textcolor{comment}{! Ihatvtot is the inverse of hatvtot [H-1 ~> m-1 or m2 kg-1].} 3207 \textcolor{keywordtype}{real} :: h\_arith \textcolor{comment}{! The arithmetic mean thickness [H ~> m or kg m-2].} 3208 \textcolor{keywordtype}{real} :: h\_harm \textcolor{comment}{! The harmonic mean thicknesses [H ~> m or kg m-2].} 3209 \textcolor{keywordtype}{real} :: h\_neglect \textcolor{comment}{! A thickness that is so small it is usually lost} 3210 \textcolor{comment}{! in roundoff and can be neglected [H ~> m or kg m-2].} 3211 \textcolor{keywordtype}{real} :: wt\_arith \textcolor{comment}{! The nondimensional weight for the arithmetic mean thickness.} 3212 \textcolor{comment}{! The harmonic mean uses a weight of (1 - wt\_arith).} 3213 \textcolor{keywordtype}{real} :: rh \textcolor{comment}{! A ratio of summed thicknesses, nondim.} 3214 \textcolor{keywordtype}{real} :: e\_u(szib\_(g),szk\_(g)+1) \textcolor{comment}{! The interface heights at u-velocity and} 3215 \textcolor{keywordtype}{real} :: e\_v(szi\_(g),szk\_(g)+1) \textcolor{comment}{! v-velocity points [H ~> m or kg m-2].} 3216 \textcolor{keywordtype}{real} :: d\_shallow\_u(szi\_(g)) \textcolor{comment}{! The shallower of the adjacent depths [H ~> m or kg m-2].} 3217 \textcolor{keywordtype}{real} :: d\_shallow\_v(szib\_(g))\textcolor{comment}{! The shallower of the adjacent depths [H ~> m or kg m-2].} 3218 \textcolor{keywordtype}{real} :: htot \textcolor{comment}{! The sum of the layer thicknesses [H ~> m or kg m-2].} 3219 \textcolor{keywordtype}{real} :: ihtot \textcolor{comment}{! The inverse of htot [H-1 ~> m-1 or m2 kg-1].} 3220 3221 \textcolor{keywordtype}{logical} :: use\_default, test\_dflt, apply\_obcs 3222 \textcolor{keywordtype}{integer} :: is, ie, js, je, isq, ieq, jsq, jeq, nz, i, j, k 3223 \textcolor{keywordtype}{integer} :: iss, ies, n 3224 3225 \textcolor{comment}{! This section interpolates thicknesses onto u & v grid points with the} 3226 \textcolor{comment}{! second order accurate estimate h = 2*(h+ * h-)/(h+ + h-).} 3227 \textcolor{keywordflow}{if} (.not.\textcolor{keyword}{associated}(cs)) \textcolor{keyword}{call }mom\_error(fatal, & 3228 \textcolor{stringliteral}{"btcalc: Module MOM\_barotropic must be initialized before it is used."}) 3229 \textcolor{keywordflow}{if} (.not.cs%split) \textcolor{keywordflow}{return} 3230 3231 use\_default = .false. 3232 test\_dflt = .false. ; \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(may\_use\_default)) test\_dflt = may\_use\_default 3233 3234 \textcolor{keywordflow}{if} (test\_dflt) \textcolor{keywordflow}{then} 3235 \textcolor{keywordflow}{if} (.not.((\textcolor{keyword}{present}(h\_u) .and. \textcolor{keyword}{present}(h\_v)) .or. & 3236 (cs%hvel\_scheme == harmonic) .or. (cs%hvel\_scheme == hybrid) .or.& 3237 (cs%hvel\_scheme == arithmetic))) use\_default = .true. 3238 \textcolor{keywordflow}{else} 3239 \textcolor{keywordflow}{if} (.not.((\textcolor{keyword}{present}(h\_u) .and. \textcolor{keyword}{present}(h\_v)) .or. & 3240 (cs%hvel\_scheme == harmonic) .or. (cs%hvel\_scheme == hybrid) .or.& 3241 (cs%hvel\_scheme == arithmetic))) \textcolor{keyword}{call }mom\_error(fatal, & 3242 \textcolor{stringliteral}{"btcalc: Inconsistent settings of optional arguments and hvel\_scheme."}) 3243 \textcolor{keywordflow}{ endif} 3244 3245 apply\_obcs = .false. 3246 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(obc)) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(obc)) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (obc%OBC\_pe) \textcolor{keywordflow}{then} 3247 \textcolor{comment}{! Some open boundary condition points might be in this processor's symmetric} 3248 \textcolor{comment}{! computational domain.} 3249 apply\_obcs = (obc%number\_of\_segments > 0) 3250 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ endif} 3251 3252 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke 3253 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB 3254 h\_neglect = gv%H\_subroundoff 3255 3256 \textcolor{comment}{! This estimates the fractional thickness of each layer at the velocity} 3257 \textcolor{comment}{! points, using a harmonic mean estimate.} 3258 \textcolor{comment}{!$OMP parallel do default(none) shared(is,ie,js,je,nz,h\_u,CS,h\_neglect,h,use\_default,G,GV) &} 3259 \textcolor{comment}{!$OMP private(hatutot,Ihatutot,e\_u,D\_shallow\_u,h\_arith,h\_harm,wt\_arith)} 3260 3261 \textcolor{keywordflow}{do} j=js,je 3262 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(h\_u)) \textcolor{keywordflow}{then} 3263 \textcolor{keywordflow}{do} i=is-1,ie ; hatutot(i) = h\_u(i,j,1) ;\textcolor{keywordflow}{ enddo} 3264 \textcolor{keywordflow}{do} k=2,nz ; \textcolor{keywordflow}{do} i=is-1,ie 3265 hatutot(i) = hatutot(i) + h\_u(i,j,k) 3266 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3267 \textcolor{keywordflow}{do} i=is-1,ie ; ihatutot(i) = g%mask2dCu(i,j) / (hatutot(i) + h\_neglect) ;\textcolor{keywordflow}{ enddo} 3268 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is-1,ie 3269 cs%frhatu(i,j,k) = h\_u(i,j,k) * ihatutot(i) 3270 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3271 \textcolor{keywordflow}{else} 3272 \textcolor{keywordflow}{if} (cs%hvel\_scheme == arithmetic) \textcolor{keywordflow}{then} 3273 \textcolor{keywordflow}{do} i=is-1,ie 3274 cs%frhatu(i,j,1) = 0.5 * (h(i+1,j,1) + h(i,j,1)) 3275 hatutot(i) = cs%frhatu(i,j,1) 3276 \textcolor{keywordflow}{ enddo} 3277 \textcolor{keywordflow}{do} k=2,nz ; \textcolor{keywordflow}{do} i=is-1,ie 3278 cs%frhatu(i,j,k) = 0.5 * (h(i+1,j,k) + h(i,j,k)) 3279 hatutot(i) = hatutot(i) + cs%frhatu(i,j,k) 3280 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3281 \textcolor{keywordflow}{elseif} (cs%hvel\_scheme == hybrid .or. use\_default) \textcolor{keywordflow}{then} 3282 \textcolor{keywordflow}{do} i=is-1,ie 3283 e\_u(i,nz+1) = -0.5 * gv%Z\_to\_H * (g%bathyT(i+1,j) + g%bathyT(i,j)) 3284 d\_shallow\_u(i) = -gv%Z\_to\_H * min(g%bathyT(i+1,j), g%bathyT(i,j)) 3285 hatutot(i) = 0.0 3286 \textcolor{keywordflow}{ enddo} 3287 \textcolor{keywordflow}{do} k=nz,1,-1 ; \textcolor{keywordflow}{do} i=is-1,ie 3288 e\_u(i,k) = e\_u(i,k+1) + 0.5 * (h(i+1,j,k) + h(i,j,k)) 3289 h\_arith = 0.5 * (h(i+1,j,k) + h(i,j,k)) 3290 \textcolor{keywordflow}{if} (e\_u(i,k+1) >= d\_shallow\_u(i)) \textcolor{keywordflow}{then} 3291 cs%frhatu(i,j,k) = h\_arith 3292 \textcolor{keywordflow}{else} 3293 h\_harm = (h(i+1,j,k) * h(i,j,k)) / (h\_arith + h\_neglect) 3294 \textcolor{keywordflow}{if} (e\_u(i,k) <= d\_shallow\_u(i)) \textcolor{keywordflow}{then} 3295 cs%frhatu(i,j,k) = h\_harm 3296 \textcolor{keywordflow}{else} 3297 wt\_arith = (e\_u(i,k) - d\_shallow\_u(i)) / (h\_arith + h\_neglect) 3298 cs%frhatu(i,j,k) = wt\_arith*h\_arith + (1.0-wt\_arith)*h\_harm 3299 \textcolor{keywordflow}{ endif} 3300 \textcolor{keywordflow}{ endif} 3301 hatutot(i) = hatutot(i) + cs%frhatu(i,j,k) 3302 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3303 \textcolor{keywordflow}{elseif} (cs%hvel\_scheme == harmonic) \textcolor{keywordflow}{then} 3304 \textcolor{keywordflow}{do} i=is-1,ie 3305 cs%frhatu(i,j,1) = 2.0*(h(i+1,j,1) * h(i,j,1)) / & 3306 ((h(i+1,j,1) + h(i,j,1)) + h\_neglect) 3307 hatutot(i) = cs%frhatu(i,j,1) 3308 \textcolor{keywordflow}{ enddo} 3309 \textcolor{keywordflow}{do} k=2,nz ; \textcolor{keywordflow}{do} i=is-1,ie 3310 cs%frhatu(i,j,k) = 2.0*(h(i+1,j,k) * h(i,j,k)) / & 3311 ((h(i+1,j,k) + h(i,j,k)) + h\_neglect) 3312 hatutot(i) = hatutot(i) + cs%frhatu(i,j,k) 3313 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3314 \textcolor{keywordflow}{ endif} 3315 \textcolor{keywordflow}{do} i=is-1,ie ; ihatutot(i) = g%mask2dCu(i,j) / (hatutot(i) + h\_neglect) ;\textcolor{keywordflow}{ enddo} 3316 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is-1,ie 3317 cs%frhatu(i,j,k) = cs%frhatu(i,j,k) * ihatutot(i) 3318 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3319 \textcolor{keywordflow}{ endif} 3320 \textcolor{keywordflow}{ enddo} 3321 3322 \textcolor{comment}{!$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,G,GV,h\_v,h\_neglect,h,use\_default) &} 3323 \textcolor{comment}{!$OMP private(hatvtot,Ihatvtot,e\_v,D\_shallow\_v,h\_arith,h\_harm,wt\_arith)} 3324 \textcolor{keywordflow}{do} j=js-1,je 3325 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(h\_v)) \textcolor{keywordflow}{then} 3326 \textcolor{keywordflow}{do} i=is,ie ; hatvtot(i) = h\_v(i,j,1) ;\textcolor{keywordflow}{ enddo} 3327 \textcolor{keywordflow}{do} k=2,nz ; \textcolor{keywordflow}{do} i=is,ie 3328 hatvtot(i) = hatvtot(i) + h\_v(i,j,k) 3329 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3330 \textcolor{keywordflow}{do} i=is,ie ; ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h\_neglect) ;\textcolor{keywordflow}{ enddo} 3331 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is,ie 3332 cs%frhatv(i,j,k) = h\_v(i,j,k) * ihatvtot(i) 3333 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3334 \textcolor{keywordflow}{else} 3335 \textcolor{keywordflow}{if} (cs%hvel\_scheme == arithmetic) \textcolor{keywordflow}{then} 3336 \textcolor{keywordflow}{do} i=is,ie 3337 cs%frhatv(i,j,1) = 0.5 * (h(i,j+1,1) + h(i,j,1)) 3338 hatvtot(i) = cs%frhatv(i,j,1) 3339 \textcolor{keywordflow}{ enddo} 3340 \textcolor{keywordflow}{do} k=2,nz ; \textcolor{keywordflow}{do} i=is,ie 3341 cs%frhatv(i,j,k) = 0.5 * (h(i,j+1,k) + h(i,j,k)) 3342 hatvtot(i) = hatvtot(i) + cs%frhatv(i,j,k) 3343 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3344 \textcolor{keywordflow}{elseif} (cs%hvel\_scheme == hybrid .or. use\_default) \textcolor{keywordflow}{then} 3345 \textcolor{keywordflow}{do} i=is,ie 3346 e\_v(i,nz+1) = -0.5 * gv%Z\_to\_H * (g%bathyT(i,j+1) + g%bathyT(i,j)) 3347 d\_shallow\_v(i) = -gv%Z\_to\_H * min(g%bathyT(i,j+1), g%bathyT(i,j)) 3348 hatvtot(i) = 0.0 3349 \textcolor{keywordflow}{ enddo} 3350 \textcolor{keywordflow}{do} k=nz,1,-1 ; \textcolor{keywordflow}{do} i=is,ie 3351 e\_v(i,k) = e\_v(i,k+1) + 0.5 * (h(i,j+1,k) + h(i,j,k)) 3352 h\_arith = 0.5 * (h(i,j+1,k) + h(i,j,k)) 3353 \textcolor{keywordflow}{if} (e\_v(i,k+1) >= d\_shallow\_v(i)) \textcolor{keywordflow}{then} 3354 cs%frhatv(i,j,k) = h\_arith 3355 \textcolor{keywordflow}{else} 3356 h\_harm = (h(i,j+1,k) * h(i,j,k)) / (h\_arith + h\_neglect) 3357 \textcolor{keywordflow}{if} (e\_v(i,k) <= d\_shallow\_v(i)) \textcolor{keywordflow}{then} 3358 cs%frhatv(i,j,k) = h\_harm 3359 \textcolor{keywordflow}{else} 3360 wt\_arith = (e\_v(i,k) - d\_shallow\_v(i)) / (h\_arith + h\_neglect) 3361 cs%frhatv(i,j,k) = wt\_arith*h\_arith + (1.0-wt\_arith)*h\_harm 3362 \textcolor{keywordflow}{ endif} 3363 \textcolor{keywordflow}{ endif} 3364 hatvtot(i) = hatvtot(i) + cs%frhatv(i,j,k) 3365 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3366 \textcolor{keywordflow}{elseif} (cs%hvel\_scheme == harmonic) \textcolor{keywordflow}{then} 3367 \textcolor{keywordflow}{do} i=is,ie 3368 cs%frhatv(i,j,1) = 2.0*(h(i,j+1,1) * h(i,j,1)) / & 3369 ((h(i,j+1,1) + h(i,j,1)) + h\_neglect) 3370 hatvtot(i) = cs%frhatv(i,j,1) 3371 \textcolor{keywordflow}{ enddo} 3372 \textcolor{keywordflow}{do} k=2,nz ; \textcolor{keywordflow}{do} i=is,ie 3373 cs%frhatv(i,j,k) = 2.0*(h(i,j+1,k) * h(i,j,k)) / & 3374 ((h(i,j+1,k) + h(i,j,k)) + h\_neglect) 3375 hatvtot(i) = hatvtot(i) + cs%frhatv(i,j,k) 3376 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3377 \textcolor{keywordflow}{ endif} 3378 \textcolor{keywordflow}{do} i=is,ie ; ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h\_neglect) ;\textcolor{keywordflow}{ enddo} 3379 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is,ie 3380 cs%frhatv(i,j,k) = cs%frhatv(i,j,k) * ihatvtot(i) 3381 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3382 \textcolor{keywordflow}{ endif} 3383 \textcolor{keywordflow}{ enddo} 3384 3385 \textcolor{keywordflow}{if} (apply\_obcs) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{do} n=1,obc%number\_of\_segments \textcolor{comment}{! Test for segment type?} 3386 \textcolor{keywordflow}{if} (.not. obc%segment(n)%on\_pe) cycle 3387 \textcolor{keywordflow}{if} (obc%segment(n)%direction == obc\_direction\_n) \textcolor{keywordflow}{then} 3388 j = obc%segment(n)%HI%JsdB 3389 \textcolor{keywordflow}{if} ((j >= js-1) .and. (j <= je)) \textcolor{keywordflow}{then} 3390 iss = max(is,obc%segment(n)%HI%isd) ; ies = min(ie,obc%segment(n)%HI%ied) 3391 \textcolor{keywordflow}{do} i=iss,ies ; hatvtot(i) = h(i,j,1) ;\textcolor{keywordflow}{ enddo} 3392 \textcolor{keywordflow}{do} k=2,nz ; \textcolor{keywordflow}{do} i=iss,ies 3393 hatvtot(i) = hatvtot(i) + h(i,j,k) 3394 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3395 \textcolor{keywordflow}{do} i=iss,ies 3396 ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h\_neglect) 3397 \textcolor{keywordflow}{ enddo} 3398 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=iss,ies 3399 cs%frhatv(i,j,k) = h(i,j,k) * ihatvtot(i) 3400 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3401 \textcolor{keywordflow}{ endif} 3402 \textcolor{keywordflow}{elseif} (obc%segment(n)%direction == obc\_direction\_s) \textcolor{keywordflow}{then} 3403 j = obc%segment(n)%HI%JsdB 3404 \textcolor{keywordflow}{if} ((j >= js-1) .and. (j <= je)) \textcolor{keywordflow}{then} 3405 iss = max(is,obc%segment(n)%HI%isd) ; ies = min(ie,obc%segment(n)%HI%ied) 3406 \textcolor{keywordflow}{do} i=iss,ies ; hatvtot(i) = h(i,j+1,1) ;\textcolor{keywordflow}{ enddo} 3407 \textcolor{keywordflow}{do} k=2,nz ; \textcolor{keywordflow}{do} i=iss,ies 3408 hatvtot(i) = hatvtot(i) + h(i,j+1,k) 3409 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3410 \textcolor{keywordflow}{do} i=iss,ies 3411 ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h\_neglect) 3412 \textcolor{keywordflow}{ enddo} 3413 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=iss,ies 3414 cs%frhatv(i,j,k) = h(i,j+1,k) * ihatvtot(i) 3415 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3416 \textcolor{keywordflow}{ endif} 3417 \textcolor{keywordflow}{elseif} (obc%segment(n)%direction == obc\_direction\_e) \textcolor{keywordflow}{then} 3418 i = obc%segment(n)%HI%IsdB 3419 \textcolor{keywordflow}{if} ((i >= is-1) .and. (i <= ie)) \textcolor{keywordflow}{then} 3420 \textcolor{keywordflow}{do} j = max(js,obc%segment(n)%HI%jsd), min(je,obc%segment(n)%HI%jed) 3421 htot = h(i,j,1) 3422 \textcolor{keywordflow}{do} k=2,nz ; htot = htot + h(i,j,k) ;\textcolor{keywordflow}{ enddo} 3423 ihtot = g%mask2dCu(i,j) / (htot + h\_neglect) 3424 \textcolor{keywordflow}{do} k=1,nz ; cs%frhatu(i,j,k) = h(i,j,k) * ihtot ;\textcolor{keywordflow}{ enddo} 3425 \textcolor{keywordflow}{ enddo} 3426 \textcolor{keywordflow}{ endif} 3427 \textcolor{keywordflow}{elseif} (obc%segment(n)%direction == obc\_direction\_w) \textcolor{keywordflow}{then} 3428 i = obc%segment(n)%HI%IsdB 3429 \textcolor{keywordflow}{if} ((i >= is-1) .and. (i <= ie)) \textcolor{keywordflow}{then} 3430 \textcolor{keywordflow}{do} j = max(js,obc%segment(n)%HI%jsd), min(je,obc%segment(n)%HI%jed) 3431 htot = h(i+1,j,1) 3432 \textcolor{keywordflow}{do} k=2,nz ; htot = htot + h(i+1,j,k) ;\textcolor{keywordflow}{ enddo} 3433 ihtot = g%mask2dCu(i,j) / (htot + h\_neglect) 3434 \textcolor{keywordflow}{do} k=1,nz ; cs%frhatu(i,j,k) = h(i+1,j,k) * ihtot ;\textcolor{keywordflow}{ enddo} 3435 \textcolor{keywordflow}{ enddo} 3436 \textcolor{keywordflow}{ endif} 3437 \textcolor{keywordflow}{else} 3438 \textcolor{keyword}{call }mom\_error(fatal, \textcolor{stringliteral}{"btcalc encountered and OBC segment of indeterminate direction."}) 3439 \textcolor{keywordflow}{ endif} 3440 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ endif} 3441 3442 \textcolor{keywordflow}{if} (cs%debug) \textcolor{keywordflow}{then} 3443 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"btcalc frhat[uv]"}, cs%frhatu, cs%frhatv, g%HI, & 3444 haloshift=0, symmetric=.true., omit\_corners=.true., & 3445 scalar\_pair=.true.) 3446 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(h\_u) .and. \textcolor{keyword}{present}(h\_v)) & 3447 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"btcalc h\_[uv]"}, h\_u, h\_v, g%HI, haloshift=0, & 3448 symmetric=.true., omit\_corners=.true., scale=gv%H\_to\_m, & 3449 scalar\_pair=.true.) 3450 \textcolor{keyword}{call }hchksum(h, \textcolor{stringliteral}{"btcalc h"},g%HI, haloshift=1, scale=gv%H\_to\_m) 3451 \textcolor{keywordflow}{ endif} 3452 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_ac60353f002de5980317d117a3db1a075}\label{namespacemom__barotropic_ac60353f002de5980317d117a3db1a075}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!btstep@{btstep}} \index{btstep@{btstep}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{btstep()}{btstep()}} {\footnotesize\ttfamily subroutine, public mom\+\_\+barotropic\+::btstep (\begin{DoxyParamCaption}\item[{real, dimension( g \%isdb\+: g \%iedb, g \%jsd\+: g \%jed, g \%ke), intent(in)}]{U\+\_\+in, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsdb\+: g \%jedb, g \%ke), intent(in)}]{V\+\_\+in, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsd\+: g \%jed), intent(in)}]{eta\+\_\+in, }\item[{real, intent(in)}]{dt, }\item[{real, dimension( g \%isdb\+: g \%iedb, g \%jsd\+: g \%jed, g \%ke), intent(in)}]{bc\+\_\+accel\+\_\+u, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsdb\+: g \%jedb, g \%ke), intent(in)}]{bc\+\_\+accel\+\_\+v, }\item[{type(mech\+\_\+forcing), intent(in)}]{forces, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsd\+: g \%jed, g \%ke), intent(in)}]{pbce, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsd\+: g \%jed), intent(in)}]{eta\+\_\+\+P\+F\+\_\+in, }\item[{real, dimension( g \%isdb\+: g \%iedb, g \%jsd\+: g \%jed, g \%ke), intent(in)}]{U\+\_\+\+Cor, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsdb\+: g \%jedb, g \%ke), intent(in)}]{V\+\_\+\+Cor, }\item[{real, dimension( g \%isdb\+: g \%iedb, g \%jsd\+: g \%jed, g \%ke), intent(out)}]{accel\+\_\+layer\+\_\+u, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsdb\+: g \%jedb, g \%ke), intent(out)}]{accel\+\_\+layer\+\_\+v, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsd\+: g \%jed), intent(out)}]{eta\+\_\+out, }\item[{real, dimension( g \%isdb\+: g \%iedb, g \%jsd\+: g \%jed), intent(out)}]{uhbtav, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsdb\+: g \%jedb), intent(out)}]{vhbtav, }\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__barotropic_1_1barotropic__cs}{barotropic\+\_\+cs}), pointer}]{CS, }\item[{real, dimension( g \%isdb\+: g \%iedb, g \%jsd\+: g \%jed, g \%ke), intent(in)}]{visc\+\_\+rem\+\_\+u, }\item[{real, dimension(szi\+\_\+(g),szjb\+\_\+(g),szk\+\_\+(g)), intent(in)}]{visc\+\_\+rem\+\_\+v, }\item[{real, dimension(szi\+\_\+(g),szj\+\_\+(g)), intent(out), optional}]{etaav, }\item[{type(accel\+\_\+diag\+\_\+ptrs), optional, pointer}]{A\+Dp, }\item[{type(ocean\+\_\+obc\+\_\+type), optional, pointer}]{O\+BC, }\item[{type(bt\+\_\+cont\+\_\+type), optional, pointer}]{B\+T\+\_\+cont, }\item[{real, dimension(\+:,\+:), optional, pointer}]{eta\+\_\+\+P\+F\+\_\+start, }\item[{real, dimension(\+:,\+:), optional, pointer}]{taux\+\_\+bot, }\item[{real, dimension(\+:,\+:), optional, pointer}]{tauy\+\_\+bot, }\item[{real, dimension(\+:,\+:,\+:), optional, pointer}]{uh0, }\item[{real, dimension(\+:,\+:,\+:), optional, pointer}]{vh0, }\item[{real, dimension(\+:,\+:,\+:), optional, pointer}]{u\+\_\+uh0, }\item[{real, dimension(\+:,\+:,\+:), optional, pointer}]{v\+\_\+vh0 }\end{DoxyParamCaption})} This subroutine time steps the barotropic equations explicitly. For gravity waves, anything between a forwards-\/backwards scheme and a simulated backwards Euler scheme is used, with bebt between 0.\+0 and 1.\+0 determining the scheme. In practice, bebt must be of order 0.\+2 or greater. A forwards-\/backwards treatment of the Coriolis terms is always used. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in,out} & {\em g} & The ocean\textquotesingle{}s grid structure.\\ \hline \mbox{\tt in} & {\em gv} & The ocean\textquotesingle{}s vertical grid structure.\\ \hline \mbox{\tt in} & {\em us} & A dimensional unit scaling type\\ \hline \mbox{\tt in} & {\em u\+\_\+in} & The initial (3-\/D) zonal velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em v\+\_\+in} & The initial (3-\/D) meridional velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em eta\+\_\+in} & The initial barotropic free surface height anomaly or column mass anomaly \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline \mbox{\tt in} & {\em dt} & The time increment to integrate over \mbox{[}T $\sim$$>$ s\mbox{]}.\\ \hline \mbox{\tt in} & {\em bc\+\_\+accel\+\_\+u} & The zonal baroclinic accelerations, \mbox{[}L T-\/2 $\sim$$>$ m s-\/2\mbox{]}.\\ \hline \mbox{\tt in} & {\em bc\+\_\+accel\+\_\+v} & The meridional baroclinic accelerations, \mbox{[}L T-\/2 $\sim$$>$ m s-\/2\mbox{]}.\\ \hline \mbox{\tt in} & {\em forces} & A structure with the driving mechanical forces\\ \hline \mbox{\tt in} & {\em pbce} & The baroclinic pressure anomaly in each layer due to free surface height anomalies \mbox{[}L2 H-\/1 T-\/2 $\sim$$>$ m s-\/2 or m4 kg-\/1 s-\/2\mbox{]}.\\ \hline \mbox{\tt in} & {\em eta\+\_\+pf\+\_\+in} & The 2-\/D eta field (either S\+SH anomaly or column mass anomaly) that was used to calculate the input pressure gradient accelerations (or its final value if eta\+\_\+\+P\+F\+\_\+start is provided \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}. Note\+: eta\+\_\+in, pbce, and eta\+\_\+\+P\+F\+\_\+in must have up-\/to-\/date values in the first point of their halos.\\ \hline \mbox{\tt in} & {\em u\+\_\+cor} & The (3-\/D) zonal velocities used to calculate the Coriolis terms in bc\+\_\+accel\+\_\+u \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em v\+\_\+cor} & The (3-\/D) meridional velocities used to calculate the Coriolis terms in bc\+\_\+accel\+\_\+u \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}.\\ \hline \mbox{\tt out} & {\em accel\+\_\+layer\+\_\+u} & The zonal acceleration of each layer due to the barotropic calculation \mbox{[}L T-\/2 $\sim$$>$ m s-\/2\mbox{]}.\\ \hline \mbox{\tt out} & {\em accel\+\_\+layer\+\_\+v} & The meridional acceleration of each layer due to the barotropic calculation \mbox{[}L T-\/2 $\sim$$>$ m s-\/2\mbox{]}.\\ \hline \mbox{\tt out} & {\em eta\+\_\+out} & The final barotropic free surface height anomaly or column mass anomaly \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline \mbox{\tt out} & {\em uhbtav} & the barotropic zonal volume or mass fluxes averaged through the barotropic steps \mbox{[}H L2 T-\/1 $\sim$$>$ m3 or kg s-\/1\mbox{]}.\\ \hline \mbox{\tt out} & {\em vhbtav} & the barotropic meridional volume or mass fluxes averaged through the barotropic steps \mbox{[}H L2 T-\/1 $\sim$$>$ m3 or kg s-\/1\mbox{]}.\\ \hline & {\em cs} & The control structure returned by a previous call to barotropic\+\_\+init.\\ \hline \mbox{\tt in} & {\em visc\+\_\+rem\+\_\+u} & Both the fraction of the momentum originally in a layer that remains after a time-\/step of viscosity, and the fraction of a time-\/step\textquotesingle{}s worth of a barotropic acceleration that a layer experiences after viscosity is applied, in the zonal direction. Nondimensional between 0 (at the bottom) and 1 (far above the bottom).\\ \hline \mbox{\tt in} & {\em visc\+\_\+rem\+\_\+v} & Ditto for meridional direction \mbox{[}nondim\mbox{]}.\\ \hline \mbox{\tt out} & {\em etaav} & The free surface height or column mass averaged over the barotropic integration \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline & {\em adp} & Acceleration diagnostic pointers\\ \hline & {\em obc} & The open boundary condition structure.\\ \hline & {\em bt\+\_\+cont} & A structure with elements that describe the effective open face areas as a function of barotropic flow.\\ \hline & {\em eta\+\_\+pf\+\_\+start} & The eta field consistent with the pressure gradient at the start of the barotropic stepping \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline & {\em taux\+\_\+bot} & The zonal bottom frictional stress from ocean to the seafloor \mbox{[}R L Z T-\/2 $\sim$$>$ Pa\mbox{]}.\\ \hline & {\em tauy\+\_\+bot} & The meridional bottom frictional stress from ocean to the seafloor \mbox{[}R L Z T-\/2 $\sim$$>$ Pa\mbox{]}.\\ \hline & {\em uh0} & The zonal layer transports at reference velocities \mbox{[}H L2 T-\/1 $\sim$$>$ m3 s-\/1 or kg s-\/1\mbox{]}.\\ \hline & {\em u\+\_\+uh0} & The velocities used to calculate uh0 \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]}\\ \hline & {\em vh0} & The zonal layer transports at reference velocities \mbox{[}H L2 T-\/1 $\sim$$>$ m3 s-\/1 or kg s-\/1\mbox{]}.\\ \hline & {\em v\+\_\+vh0} & The velocities used to calculate vh0 \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]} \\ \hline \end{DoxyParams} Definition at line 411 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 411 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(inout)} :: g\textcolor{comment}{ !< The ocean's grid structure.} 412 \textcolor{keywordtype}{type}(verticalgrid\_type), \textcolor{keywordtype}{intent(in)} :: gv\textcolor{comment}{ !< The ocean's vertical grid structure.} 413 \textcolor{keywordtype}{type}(unit\_scale\_type), \textcolor{keywordtype}{intent(in)} :: us\textcolor{comment}{ !< A dimensional unit scaling type} 414 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G),SZK\_(G))}, \textcolor{keywordtype}{intent(in)} :: u\_in\textcolor{comment}{ !< The initial (3-D) zonal} 415 \textcolor{comment}{ !! velocity [L T-1 ~> m s-1].} 416 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G),SZK\_(G))}, \textcolor{keywordtype}{intent(in)} :: v\_in\textcolor{comment}{ !< The initial (3-D) meridional} 417 \textcolor{comment}{ !! velocity [L T-1 ~> m s-1].} 418 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G))}, \textcolor{keywordtype}{intent(in)} :: eta\_in\textcolor{comment}{ !< The initial barotropic free surface height} 419 \textcolor{comment}{ !! anomaly or column mass anomaly [H ~> m or kg m-2].} 420 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(in)} :: dt\textcolor{comment}{ !< The time increment to integrate over [T ~> s].} 421 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G),SZK\_(G))}, \textcolor{keywordtype}{intent(in)} :: bc\_accel\_u\textcolor{comment}{ !< The zonal baroclinic accelerations,} 422 \textcolor{comment}{ !! [L T-2 ~> m s-2].} 423 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G),SZK\_(G))}, \textcolor{keywordtype}{intent(in)} :: bc\_accel\_v\textcolor{comment}{ !< The meridional baroclinic accelerations,} 424 \textcolor{comment}{ !! [L T-2 ~> m s-2].} 425 \textcolor{keywordtype}{type}(mech\_forcing), \textcolor{keywordtype}{intent(in)} :: forces\textcolor{comment}{ !< A structure with the driving mechanical forces} 426 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G),SZK\_(G))}, \textcolor{keywordtype}{intent(in)} :: pbce\textcolor{comment}{ !< The baroclinic pressure anomaly in each layer} 427 \textcolor{comment}{ !! due to free surface height anomalies} 428 \textcolor{comment}{ !! [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].} 429 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G))}, \textcolor{keywordtype}{intent(in)} :: eta\_pf\_in\textcolor{comment}{ !< The 2-D eta field (either SSH anomaly or} 430 \textcolor{comment}{ !! column mass anomaly) that was used to calculate the input} 431 \textcolor{comment}{ !! pressure gradient accelerations (or its final value if} 432 \textcolor{comment}{ !! eta\_PF\_start is provided [H ~> m or kg m-2].} 433 \textcolor{comment}{ !! Note: eta\_in, pbce, and eta\_PF\_in must have up-to-date} 434 \textcolor{comment}{ !! values in the first point of their halos.} 435 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G),SZK\_(G))}, \textcolor{keywordtype}{intent(in)} :: u\_cor\textcolor{comment}{ !< The (3-D) zonal velocities used to} 436 \textcolor{comment}{ !! calculate the Coriolis terms in bc\_accel\_u [L T-1 ~> m s-1].} 437 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G),SZK\_(G))}, \textcolor{keywordtype}{intent(in)} :: v\_cor\textcolor{comment}{ !< The (3-D) meridional velocities used to} 438 \textcolor{comment}{ !! calculate the Coriolis terms in bc\_accel\_u [L T-1 ~> m s-1].} 439 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G),SZK\_(G))}, \textcolor{keywordtype}{intent(out)} :: accel\_layer\_u\textcolor{comment}{ !< The zonal acceleration of each layer due} 440 \textcolor{comment}{ !! to the barotropic calculation [L T-2 ~> m s-2].} 441 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G),SZK\_(G))}, \textcolor{keywordtype}{intent(out)} :: accel\_layer\_v\textcolor{comment}{ !< The meridional acceleration of each layer} 442 \textcolor{comment}{ !! due to the barotropic calculation [L T-2 ~> m s-2].} 443 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G))}, \textcolor{keywordtype}{intent(out)} :: eta\_out\textcolor{comment}{ !< The final barotropic free surface} 444 \textcolor{comment}{ !! height anomaly or column mass anomaly [H ~> m or kg m-2].} 445 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G))}, \textcolor{keywordtype}{intent(out)} :: uhbtav\textcolor{comment}{ !< the barotropic zonal volume or mass} 446 \textcolor{comment}{ !! fluxes averaged through the barotropic steps} 447 \textcolor{comment}{ !! [H L2 T-1 ~> m3 or kg s-1].} 448 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G))}, \textcolor{keywordtype}{intent(out)} :: vhbtav\textcolor{comment}{ !< the barotropic meridional volume or mass} 449 \textcolor{comment}{ !! fluxes averaged through the barotropic steps} 450 \textcolor{comment}{ !! [H L2 T-1 ~> m3 or kg s-1].} 451 \textcolor{keywordtype}{type}(barotropic\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< The control structure returned by a} 452 \textcolor{comment}{ !! previous call to barotropic\_init.} 453 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G),SZK\_(G))}, \textcolor{keywordtype}{intent(in)} :: visc\_rem\_u\textcolor{comment}{ !< Both the fraction of the momentum} 454 \textcolor{comment}{ !! originally in a layer that remains after a time-step of} 455 \textcolor{comment}{ !! viscosity, and the fraction of a time-step's worth of a} 456 \textcolor{comment}{ !! barotropic acceleration that a layer experiences after} 457 \textcolor{comment}{ !! viscosity is applied, in the zonal direction. Nondimensional} 458 \textcolor{comment}{ !! between 0 (at the bottom) and 1 (far above the bottom).} 459 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G),SZK\_(G))}, \textcolor{keywordtype}{intent(in)} :: visc\_rem\_v\textcolor{comment}{ !< Ditto for meridional direction [nondim].} 460 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G))}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(out)} :: etaav\textcolor{comment}{ !< The free surface height or column mass} 461 \textcolor{comment}{ !! averaged over the barotropic integration [H ~> m or kg m-2].} 462 \textcolor{keywordtype}{type}(accel\_diag\_ptrs), \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: adp\textcolor{comment}{ !< Acceleration diagnostic pointers} 463 \textcolor{keywordtype}{type}(ocean\_obc\_type), \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: obc\textcolor{comment}{ !< The open boundary condition structure.} 464 \textcolor{keywordtype}{type}(bt\_cont\_type), \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: bt\_cont\textcolor{comment}{ !< A structure with elements that describe} 465 \textcolor{comment}{ !! the effective open face areas as a function of barotropic} 466 \textcolor{comment}{ !! flow.} 467 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(:,:)}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: eta\_pf\_start\textcolor{comment}{ !< The eta field consistent with the pressure} 468 \textcolor{comment}{ !! gradient at the start of the barotropic stepping} 469 \textcolor{comment}{ !! [H ~> m or kg m-2].} 470 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(:,:)}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: taux\_bot\textcolor{comment}{ !< The zonal bottom frictional stress from} 471 \textcolor{comment}{ !! ocean to the seafloor [R L Z T-2 ~> Pa].} 472 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(:,:)}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: tauy\_bot\textcolor{comment}{ !< The meridional bottom frictional stress} 473 \textcolor{comment}{ !! from ocean to the seafloor [R L Z T-2 ~> Pa].} 474 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(:,:,:)}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: uh0\textcolor{comment}{ !< The zonal layer transports at reference} 475 \textcolor{comment}{ !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1].} 476 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(:,:,:)}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: u\_uh0\textcolor{comment}{ !< The velocities used to calculate} 477 \textcolor{comment}{ !! uh0 [L T-1 ~> m s-1]} 478 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(:,:,:)}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: vh0\textcolor{comment}{ !< The zonal layer transports at reference} 479 \textcolor{comment}{ !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1].} 480 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(:,:,:)}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: v\_vh0\textcolor{comment}{ !< The velocities used to calculate} 481 \textcolor{comment}{ !! vh0 [L T-1 ~> m s-1]} 482 483 \textcolor{comment}{! Local variables} 484 \textcolor{keywordtype}{real} :: ubt\_cor(szib\_(g),szj\_(g)) \textcolor{comment}{! The barotropic velocities that had been} 485 \textcolor{keywordtype}{real} :: vbt\_cor(szi\_(g),szjb\_(g)) \textcolor{comment}{! used to calculate the input Coriolis} 486 \textcolor{comment}{! terms [L T-1 ~> m s-1].} 487 \textcolor{keywordtype}{real} :: wt\_u(szib\_(g),szj\_(g),szk\_(g)) \textcolor{comment}{! wt\_u and wt\_v are the} 488 \textcolor{keywordtype}{real} :: wt\_v(szi\_(g),szjb\_(g),szk\_(g)) \textcolor{comment}{! normalized weights to} 489 \textcolor{comment}{! be used in calculating barotropic velocities, possibly with} 490 \textcolor{comment}{! sums less than one due to viscous losses. Nondimensional.} 491 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIB\_(G),SZJ\_(G))} :: & 492 av\_rem\_u, & \textcolor{comment}{! The weighted average of visc\_rem\_u, nondimensional.} 493 tmp\_u, & \textcolor{comment}{! A temporary array at u points.} 494 ubt\_st, & \textcolor{comment}{! The zonal barotropic velocity at the start of timestep [L T-1 ~> m s-1].} 495 ubt\_dt \textcolor{comment}{! The zonal barotropic velocity tendency [L T-2 ~> m s-2].} 496 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJB\_(G))} :: & 497 av\_rem\_v, & \textcolor{comment}{! The weighted average of visc\_rem\_v, nondimensional.} 498 tmp\_v, & \textcolor{comment}{! A temporary array at v points.} 499 vbt\_st, & \textcolor{comment}{! The meridional barotropic velocity at the start of timestep [L T-1 ~> m s-1].} 500 vbt\_dt \textcolor{comment}{! The meridional barotropic velocity tendency [L T-2 ~> m s-2].} 501 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G))} :: & 502 tmp\_h, & \textcolor{comment}{! A temporary array at h points.} 503 e\_anom \textcolor{comment}{! The anomaly in the sea surface height or column mass} 504 \textcolor{comment}{! averaged between the beginning and end of the time step,} 505 \textcolor{comment}{! relative to eta\_PF, with SAL effects included [H ~> m or kg m-2].} 506 507 \textcolor{comment}{! These are always allocated with symmetric memory and wide halos.} 508 \textcolor{keywordtype}{real} :: q(szibw\_(cs),szjbw\_(cs)) \textcolor{comment}{! A pseudo potential vorticity [T-1 Z-1 ~> s-1 m-1]} 509 \textcolor{comment}{! or [T-1 H-1 ~> s-1 m-1 or m2 s-1 kg-1]} 510 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(CS),SZJW\_(CS))} :: & 511 ubt, & \textcolor{comment}{! The zonal barotropic velocity [L T-1 ~> m s-1].} 512 bt\_rem\_u, & \textcolor{comment}{! The fraction of the barotropic zonal velocity that remains} 513 \textcolor{comment}{! after a time step, the remainder being lost to bottom drag.} 514 \textcolor{comment}{! bt\_rem\_u is a nondimensional number between 0 and 1.} 515 bt\_force\_u, & \textcolor{comment}{! The vertical average of all of the u-accelerations that are} 516 \textcolor{comment}{! not explicitly included in the barotropic equation [L T-2 ~> m s-2].} 517 u\_accel\_bt, & \textcolor{comment}{! The difference between the zonal acceleration from the} 518 \textcolor{comment}{! barotropic calculation and BT\_force\_u [L T-2 ~> m s-2].} 519 uhbt, & \textcolor{comment}{! The zonal barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].} 520 uhbt0, & \textcolor{comment}{! The difference between the sum of the layer zonal thickness} 521 \textcolor{comment}{! fluxes and the barotropic thickness flux using the same} 522 \textcolor{comment}{! velocity [H L2 T-1 ~> m3 s-1 or kg s-1].} 523 ubt\_old, & \textcolor{comment}{! The starting value of ubt in a barotropic step [L T-1 ~> m s-1].} 524 ubt\_first, & \textcolor{comment}{! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1].} 525 ubt\_sum, & \textcolor{comment}{! The sum of ubt over the time steps [L T-1 ~> m s-1].} 526 ubt\_int, & \textcolor{comment}{! The running time integral of ubt over the time steps [L ~> m].} 527 uhbt\_sum, & \textcolor{comment}{! The sum of uhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1].} 528 uhbt\_int, & \textcolor{comment}{! The running time integral of uhbt over the time steps [H L2 ~> m3].} 529 ubt\_wtd, & \textcolor{comment}{! A weighted sum used to find the filtered final ubt [L T-1 ~> m s-1].} 530 ubt\_trans, & \textcolor{comment}{! The latest value of ubt used for a transport [L T-1 ~> m s-1].} 531 azon, bzon, & \textcolor{comment}{! \_zon & \_mer are the values of the Coriolis force which} 532 czon, dzon, & \textcolor{comment}{! are applied to the neighboring values of vbtav & ubtav,} 533 amer, bmer, & \textcolor{comment}{! respectively to get the barotropic inertial rotation} 534 cmer, dmer, & \textcolor{comment}{! [T-1 ~> s-1].} 535 cor\_u, & \textcolor{comment}{! The zonal Coriolis acceleration [L T-2 ~> m s-2].} 536 cor\_ref\_u, & \textcolor{comment}{! The zonal barotropic Coriolis acceleration due} 537 \textcolor{comment}{! to the reference velocities [L T-2 ~> m s-2].} 538 pfu, & \textcolor{comment}{! The zonal pressure force acceleration [L T-2 ~> m s-2].} 539 rayleigh\_u, & \textcolor{comment}{! A Rayleigh drag timescale operating at u-points [T-1 ~> s-1].} 540 pfu\_bt\_sum, & \textcolor{comment}{! The summed zonal barotropic pressure gradient force [L T-2 ~> m s-2].} 541 coru\_bt\_sum, & \textcolor{comment}{! The summed zonal barotropic Coriolis acceleration [L T-2 ~> m s-2].} 542 dcor\_u, & \textcolor{comment}{! An averaged depth or total thickness at u points [Z ~> m] or [H ~> m or kg m-2].} 543 datu \textcolor{comment}{! Basin depth at u-velocity grid points times the y-grid} 544 \textcolor{comment}{! spacing [H L ~> m2 or kg m-1].} 545 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(CS),SZJBW\_(CS))} :: & 546 vbt, & \textcolor{comment}{! The meridional barotropic velocity [L T-1 ~> m s-1].} 547 bt\_rem\_v, & \textcolor{comment}{! The fraction of the barotropic meridional velocity that} 548 \textcolor{comment}{! remains after a time step, the rest being lost to bottom} 549 \textcolor{comment}{! drag. bt\_rem\_v is a nondimensional number between 0 and 1.} 550 bt\_force\_v, & \textcolor{comment}{! The vertical average of all of the v-accelerations that are} 551 \textcolor{comment}{! not explicitly included in the barotropic equation [L T-2 ~> m s-2].} 552 v\_accel\_bt, & \textcolor{comment}{! The difference between the meridional acceleration from the} 553 \textcolor{comment}{! barotropic calculation and BT\_force\_v [L T-2 ~> m s-2].} 554 vhbt, & \textcolor{comment}{! The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].} 555 vhbt0, & \textcolor{comment}{! The difference between the sum of the layer meridional} 556 \textcolor{comment}{! thickness fluxes and the barotropic thickness flux using} 557 \textcolor{comment}{! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1].} 558 vbt\_old, & \textcolor{comment}{! The starting value of vbt in a barotropic step [L T-1 ~> m s-1].} 559 vbt\_first, & \textcolor{comment}{! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1].} 560 vbt\_sum, & \textcolor{comment}{! The sum of vbt over the time steps [L T-1 ~> m s-1].} 561 vbt\_int, & \textcolor{comment}{! The running time integral of vbt over the time steps [L ~> m].} 562 vhbt\_sum, & \textcolor{comment}{! The sum of vhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1].} 563 vhbt\_int, & \textcolor{comment}{! The running time integral of vhbt over the time steps [H L2 ~> m3].} 564 vbt\_wtd, & \textcolor{comment}{! A weighted sum used to find the filtered final vbt [L T-1 ~> m s-1].} 565 vbt\_trans, & \textcolor{comment}{! The latest value of vbt used for a transport [L T-1 ~> m s-1].} 566 cor\_v, & \textcolor{comment}{! The meridional Coriolis acceleration [L T-2 ~> m s-2].} 567 cor\_ref\_v, & \textcolor{comment}{! The meridional barotropic Coriolis acceleration due} 568 \textcolor{comment}{! to the reference velocities [L T-2 ~> m s-2].} 569 pfv, & \textcolor{comment}{! The meridional pressure force acceleration [L T-2 ~> m s-2].} 570 rayleigh\_v, & \textcolor{comment}{! A Rayleigh drag timescale operating at v-points [T-1 ~> s-1].} 571 pfv\_bt\_sum, & \textcolor{comment}{! The summed meridional barotropic pressure gradient force,} 572 \textcolor{comment}{! [L T-2 ~> m s-2].} 573 corv\_bt\_sum, & \textcolor{comment}{! The summed meridional barotropic Coriolis acceleration,} 574 \textcolor{comment}{! [L T-2 ~> m s-2].} 575 dcor\_v, & \textcolor{comment}{! An averaged depth or total thickness at v points [Z ~> m] or [H ~> m or kg m-2].} 576 datv \textcolor{comment}{! Basin depth at v-velocity grid points times the x-grid} 577 \textcolor{comment}{! spacing [H L ~> m2 or kg m-1].} 578 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{target}, \textcolor{keywordtype}{dimension(SZIW\_(CS),SZJW\_(CS))} :: & 579 eta, & \textcolor{comment}{! The barotropic free surface height anomaly or column mass} 580 \textcolor{comment}{! anomaly [H ~> m or kg m-2]} 581 eta\_pred \textcolor{comment}{! A predictor value of eta [H ~> m or kg m-2] like eta.} 582 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(:,:)}, \textcolor{keywordtype}{pointer} :: & 583 eta\_pf\_bt \textcolor{comment}{! A pointer to the eta array (either eta or eta\_pred) that} 584 \textcolor{comment}{! determines the barotropic pressure force [H ~> m or kg m-2]} 585 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(CS),SZJW\_(CS))} :: & 586 eta\_sum, & \textcolor{comment}{! eta summed across the timesteps [H ~> m or kg m-2].} 587 eta\_wtd, & \textcolor{comment}{! A weighted estimate used to calculate eta\_out [H ~> m or kg m-2].} 588 eta\_ic, & \textcolor{comment}{! A local copy of the initial 2-D eta field (eta\_in) [H ~> m or kg m-2]} 589 eta\_pf, & \textcolor{comment}{! A local copy of the 2-D eta field (either SSH anomaly or} 590 \textcolor{comment}{! column mass anomaly) that was used to calculate the input} 591 \textcolor{comment}{! pressure gradient accelerations [H ~> m or kg m-2].} 592 eta\_pf\_1, & \textcolor{comment}{! The initial value of eta\_PF, when interp\_eta\_PF is} 593 \textcolor{comment}{! true [H ~> m or kg m-2].} 594 d\_eta\_pf, & \textcolor{comment}{! The change in eta\_PF over the barotropic time stepping when} 595 \textcolor{comment}{! interp\_eta\_PF is true [H ~> m or kg m-2].} 596 gtot\_e, & \textcolor{comment}{! gtot\_X is the effective total reduced gravity used to relate} 597 gtot\_w, & \textcolor{comment}{! free surface height deviations to pressure forces (including} 598 gtot\_n, & \textcolor{comment}{! GFS and baroclinic contributions) in the barotropic momentum} 599 gtot\_s, & \textcolor{comment}{! equations half a grid-point in the X-direction (X is N, S, E, or W)} 600 \textcolor{comment}{! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].} 601 \textcolor{comment}{! (See Hallberg, J Comp Phys 1997 for a discussion.)} 602 eta\_src, & \textcolor{comment}{! The source of eta per barotropic timestep [H ~> m or kg m-2].} 603 dyn\_coef\_eta, & \textcolor{comment}{! The coefficient relating the changes in eta to the} 604 \textcolor{comment}{! dynamic surface pressure under rigid ice} 605 \textcolor{comment}{! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].} 606 p\_surf\_dyn \textcolor{comment}{! A dynamic surface pressure under rigid ice [L2 T-2 ~> m2 s-2].} 607 \textcolor{keywordtype}{type}(local\_bt\_cont\_u\_type), \textcolor{keywordtype}{dimension(SZIBW\_(CS),SZJW\_(CS))} :: & 608 btcl\_u \textcolor{comment}{! A repackaged version of the u-point information in BT\_cont.} 609 \textcolor{keywordtype}{type}(local\_bt\_cont\_v\_type), \textcolor{keywordtype}{dimension(SZIW\_(CS),SZJBW\_(CS))} :: & 610 btcl\_v \textcolor{comment}{! A repackaged version of the v-point information in BT\_cont.} 611 \textcolor{comment}{! End of wide-sized variables.} 612 613 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(CS),SZJW\_(CS))} :: & 614 ubt\_prev, ubt\_sum\_prev, ubt\_wtd\_prev, & \textcolor{comment}{! Previous velocities stored for OBCs [L T-1 ~> m s-1]} 615 uhbt\_prev, uhbt\_sum\_prev, & \textcolor{comment}{! Previous transports stored for OBCs [L2 H T-1 ~> m3 s-1]} 616 ubt\_int\_prev, & \textcolor{comment}{! Previous value of time-integrated velocity stored for OBCs [L ~> m]} 617 uhbt\_int\_prev \textcolor{comment}{! Previous value of time-integrated transport stored for OBCs [L2 H ~> m3]} 618 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(CS),SZJBW\_(CS))} :: & 619 vbt\_prev, vbt\_sum\_prev, vbt\_wtd\_prev, & \textcolor{comment}{! Previous velocities stored for OBCs [L T-1 ~> m s-1]} 620 vhbt\_prev, vhbt\_sum\_prev, & \textcolor{comment}{! Previous transports stored for OBCs [L2 H T-1 ~> m3 s-1]} 621 vbt\_int\_prev, & \textcolor{comment}{! Previous value of time-integrated velocity stored for OBCs [L ~> m]} 622 vhbt\_int\_prev \textcolor{comment}{! Previous value of time-integrated transport stored for OBCs [L2 H ~> m3]} 623 \textcolor{keywordtype}{real} :: mass\_to\_z \textcolor{comment}{! The depth unit conversion divided by the mean density (Rho0) [Z m-1 R-1 ~> m3 kg-1].} 624 \textcolor{keywordtype}{real} :: mass\_accel\_to\_z \textcolor{comment}{! The inverse of the mean density (Rho0) [R-1 ~> m3 kg-1].} 625 \textcolor{keywordtype}{real} :: visc\_rem \textcolor{comment}{! A work variable that may equal visc\_rem\_[uv]. Nondim.} 626 \textcolor{keywordtype}{real} :: vel\_prev \textcolor{comment}{! The previous velocity [L T-1 ~> m s-1].} 627 \textcolor{keywordtype}{real} :: dtbt \textcolor{comment}{! The barotropic time step [T ~> s].} 628 \textcolor{keywordtype}{real} :: bebt \textcolor{comment}{! A copy of CS%bebt [nondim].} 629 \textcolor{keywordtype}{real} :: be\_proj \textcolor{comment}{! The fractional amount by which velocities are projected} 630 \textcolor{comment}{! when project\_velocity is true. For now be\_proj is set} 631 \textcolor{comment}{! to equal bebt, as they have similar roles and meanings.} 632 \textcolor{keywordtype}{real} :: idt \textcolor{comment}{! The inverse of dt [T-1 ~> s-1].} 633 \textcolor{keywordtype}{real} :: det\_de \textcolor{comment}{! The partial derivative due to self-attraction and loading} 634 \textcolor{comment}{! of the reference geopotential with the sea surface height.} 635 \textcolor{comment}{! This is typically ~0.09 or less.} 636 \textcolor{keywordtype}{real} :: dgeo\_de \textcolor{comment}{! The constant of proportionality between geopotential and} 637 \textcolor{comment}{! sea surface height. It is a nondimensional number of} 638 \textcolor{comment}{! order 1. For stability, this may be made larger} 639 \textcolor{comment}{! than the physical problem would suggest.} 640 \textcolor{keywordtype}{real} :: instep \textcolor{comment}{! The inverse of the number of barotropic time steps to take.} 641 \textcolor{keywordtype}{real} :: wt\_end \textcolor{comment}{! The weighting of the final value of eta\_PF [nondim]} 642 \textcolor{keywordtype}{integer} :: nstep \textcolor{comment}{! The number of barotropic time steps to take.} 643 \textcolor{keywordtype}{type}(time\_type) :: & 644 time\_bt\_start, & \textcolor{comment}{! The starting time of the barotropic steps.} 645 time\_step\_end, & \textcolor{comment}{! The end time of a barotropic step.} 646 time\_end\_in \textcolor{comment}{! The end time for diagnostics when this routine started.} 647 \textcolor{keywordtype}{real} :: time\_int\_in \textcolor{comment}{! The diagnostics' time interval when this routine started.} 648 \textcolor{keywordtype}{real} :: htot\_avg \textcolor{comment}{! The average total thickness of the tracer columns adjacent to a} 649 \textcolor{comment}{! velocity point [H ~> m or kg m-2]} 650 \textcolor{keywordtype}{logical} :: do\_hifreq\_output \textcolor{comment}{! If true, output occurs every barotropic step.} 651 \textcolor{keywordtype}{logical} :: use\_bt\_cont, do\_ave, find\_etaav, find\_pf, find\_cor 652 \textcolor{keywordtype}{logical} :: integral\_bt\_cont \textcolor{comment}{! If true, update the barotropic continuity equation directly} 653 \textcolor{comment}{! from the initial condition using the time-integrated barotropic velocity.} 654 \textcolor{keywordtype}{logical} :: ice\_is\_rigid, nonblock\_setup, interp\_eta\_pf 655 \textcolor{keywordtype}{logical} :: project\_velocity, add\_uh0 656 657 \textcolor{keywordtype}{real} :: dyn\_coef\_max \textcolor{comment}{! The maximum stable value of dyn\_coef\_eta} 658 \textcolor{comment}{! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].} 659 \textcolor{keywordtype}{real} :: ice\_strength = 0.0 \textcolor{comment}{! The effective strength of the ice [L2 Z-1 T-2 ~> m s-2].} 660 \textcolor{keywordtype}{real} :: idt\_max2 \textcolor{comment}{! The squared inverse of the local maximum stable} 661 \textcolor{comment}{! barotropic time step [T-2 ~> s-2].} 662 \textcolor{keywordtype}{real} :: h\_min\_dyn \textcolor{comment}{! The minimum depth to use in limiting the size of the} 663 \textcolor{comment}{! dynamic surface pressure for stability [H ~> m or kg m-2].} 664 \textcolor{keywordtype}{real} :: h\_eff\_dx2 \textcolor{comment}{! The effective total thickness divided by the grid spacing} 665 \textcolor{comment}{! squared [H L-2 ~> m-1 or kg m-4].} 666 \textcolor{keywordtype}{real} :: u\_max\_cor, v\_max\_cor \textcolor{comment}{! The maximum corrective velocities [L T-1 ~> m s-1].} 667 \textcolor{keywordtype}{real} :: uint\_cor, vint\_cor \textcolor{comment}{! The maximum time-integrated corrective velocities [L ~> m].} 668 \textcolor{keywordtype}{real} :: htot \textcolor{comment}{! The total thickness [H ~> m or kg m-2].} 669 \textcolor{keywordtype}{real} :: eta\_cor\_max \textcolor{comment}{! The maximum fluid that can be added as a correction to eta [H ~> m or kg m-2].} 670 \textcolor{keywordtype}{real} :: accel\_underflow \textcolor{comment}{! An acceleration that is so small it should be zeroed out [L T-2 ~> m s-2].} 671 \textcolor{keywordtype}{real} :: h\_neglect \textcolor{comment}{! A thickness that is so small it is usually lost} 672 \textcolor{comment}{! in roundoff and can be neglected [H ~> m or kg m-2].} 673 \textcolor{keywordtype}{real} :: idtbt \textcolor{comment}{! The inverse of the barotropic time step [T-1 ~> s-1]} 674 675 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{allocatable}, \textcolor{keywordtype}{dimension(:)} :: wt\_vel, wt\_eta, wt\_accel, wt\_trans, wt\_accel2 676 \textcolor{keywordtype}{real} :: sum\_wt\_vel, sum\_wt\_eta, sum\_wt\_accel, sum\_wt\_trans 677 \textcolor{keywordtype}{real} :: i\_sum\_wt\_vel, i\_sum\_wt\_eta, i\_sum\_wt\_accel, i\_sum\_wt\_trans 678 \textcolor{keywordtype}{real} :: dt\_filt \textcolor{comment}{! The half-width of the barotropic filter [T ~> s].} 679 \textcolor{keywordtype}{real} :: trans\_wt1, trans\_wt2 \textcolor{comment}{! The weights used to compute ubt\_trans and vbt\_trans} 680 \textcolor{keywordtype}{integer} :: nfilter 681 682 \textcolor{keywordtype}{logical} :: apply\_obcs, apply\_obc\_flather, apply\_obc\_open 683 \textcolor{keywordtype}{type}(memory\_size\_type) :: ms 684 \textcolor{keywordtype}{character(len=200)} :: mesg 685 \textcolor{keywordtype}{integer} :: isv, iev, jsv, jev \textcolor{comment}{! The valid array size at the end of a step.} 686 \textcolor{keywordtype}{integer} :: stencil \textcolor{comment}{! The stencil size of the algorithm, often 1 or 2.} 687 \textcolor{keywordtype}{integer} :: isvf, ievf, jsvf, jevf, num\_cycles 688 \textcolor{keywordtype}{integer} :: i, j, k, n 689 \textcolor{keywordtype}{integer} :: is, ie, js, je, nz, isq, ieq, jsq, jeq 690 \textcolor{keywordtype}{integer} :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb 691 \textcolor{keywordtype}{integer} :: ioff, joff 692 \textcolor{keywordtype}{integer} :: l\_seg 693 694 \textcolor{keywordflow}{if} (.not.\textcolor{keyword}{associated}(cs)) \textcolor{keyword}{call }mom\_error(fatal, & 695 \textcolor{stringliteral}{"btstep: Module MOM\_barotropic must be initialized before it is used."}) 696 \textcolor{keywordflow}{if} (.not.cs%split) \textcolor{keywordflow}{return} 697 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke 698 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB 699 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed 700 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB 701 ms%isdw = cs%isdw ; ms%iedw = cs%iedw ; ms%jsdw = cs%jsdw ; ms%jedw = cs%jedw 702 h\_neglect = gv%H\_subroundoff 703 704 idt = 1.0 / dt 705 accel\_underflow = cs%vel\_underflow * idt 706 707 use\_bt\_cont = .false. 708 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(bt\_cont)) use\_bt\_cont = (\textcolor{keyword}{associated}(bt\_cont)) 709 integral\_bt\_cont = use\_bt\_cont .and. cs%integral\_BT\_cont 710 711 interp\_eta\_pf = .false. 712 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(eta\_pf\_start)) interp\_eta\_pf = (\textcolor{keyword}{associated}(eta\_pf\_start)) 713 714 project\_velocity = cs%BT\_project\_velocity 715 716 \textcolor{comment}{! Figure out the fullest arrays that could be updated.} 717 stencil = 1 718 \textcolor{keywordflow}{if} ((.not.use\_bt\_cont) .and. cs%Nonlinear\_continuity .and. & 719 (cs%Nonlin\_cont\_update\_period > 0)) stencil = 2 720 721 do\_ave = query\_averaging\_enabled(cs%diag) 722 find\_etaav = \textcolor{keyword}{present}(etaav) 723 find\_pf = (do\_ave .and. ((cs%id\_PFu\_bt > 0) .or. (cs%id\_PFv\_bt > 0))) 724 find\_cor = (do\_ave .and. ((cs%id\_Coru\_bt > 0) .or. (cs%id\_Corv\_bt > 0))) 725 726 add\_uh0 = .false. 727 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(uh0)) add\_uh0 = \textcolor{keyword}{associated}(uh0) 728 \textcolor{keywordflow}{if} (add\_uh0 .and. .not.(\textcolor{keyword}{present}(vh0) .and. \textcolor{keyword}{present}(u\_uh0) .and. & 729 \textcolor{keyword}{present}(v\_vh0))) \textcolor{keyword}{call }mom\_error(fatal, & 730 \textcolor{stringliteral}{"btstep: vh0, u\_uh0, and v\_vh0 must be present if uh0 is used."}) 731 \textcolor{keywordflow}{if} (add\_uh0 .and. .not.(\textcolor{keyword}{associated}(vh0) .and. \textcolor{keyword}{associated}(u\_uh0) .and. & 732 \textcolor{keyword}{associated}(v\_vh0))) \textcolor{keyword}{call }mom\_error(fatal, & 733 \textcolor{stringliteral}{"btstep: vh0, u\_uh0, and v\_vh0 must be associated if uh0 is used."}) 734 735 \textcolor{comment}{! This can be changed to try to optimize the performance.} 736 nonblock\_setup = g%nonblocking\_updates 737 738 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc\_pre) 739 740 apply\_obcs = .false. ; cs%BT\_OBC%apply\_u\_OBCs = .false. ; cs%BT\_OBC%apply\_v\_OBCs = .false. 741 apply\_obc\_open = .false. 742 apply\_obc\_flather = .false. 743 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(obc)) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(obc)) \textcolor{keywordflow}{then} 744 cs%BT\_OBC%apply\_u\_OBCs = obc%open\_u\_BCs\_exist\_globally .or. obc%specified\_u\_BCs\_exist\_globally 745 cs%BT\_OBC%apply\_v\_OBCs = obc%open\_v\_BCs\_exist\_globally .or. obc%specified\_v\_BCs\_exist\_globally 746 apply\_obc\_flather = open\_boundary\_query(obc, apply\_flather\_obc=.true.) 747 apply\_obc\_open = open\_boundary\_query(obc, apply\_open\_obc=.true.) 748 apply\_obcs = open\_boundary\_query(obc, apply\_specified\_obc=.true.) .or. & 749 apply\_obc\_flather .or. apply\_obc\_open 750 751 \textcolor{keywordflow}{if} (apply\_obc\_flather .and. .not.gv%Boussinesq) \textcolor{keyword}{call }mom\_error(fatal, & 752 \textcolor{stringliteral}{"btstep: Flather open boundary conditions have not yet been "}// & 753 \textcolor{stringliteral}{"implemented for a non-Boussinesq model."}) 754 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ endif} 755 756 num\_cycles = 1 757 \textcolor{keywordflow}{if} (cs%use\_wide\_halos) & 758 num\_cycles = min((is-cs%isdw) / stencil, (js-cs%jsdw) / stencil) 759 isvf = is - (num\_cycles-1)*stencil ; ievf = ie + (num\_cycles-1)*stencil 760 jsvf = js - (num\_cycles-1)*stencil ; jevf = je + (num\_cycles-1)*stencil 761 762 nstep = ceiling(dt/cs%dtbt - 0.0001) 763 \textcolor{keywordflow}{if} (is\_root\_pe() .and. (nstep /= cs%nstep\_last)) \textcolor{keywordflow}{then} 764 \textcolor{keyword}{write}(mesg,\textcolor{stringliteral}{'("btstep is using a dynamic barotropic timestep of ", ES12.6, &} 765 \textcolor{stringliteral}{}\textcolor{stringliteral}{ & " seconds, max ", ES12.6, ".")'}) (us%T\_to\_s*dt/nstep), us%T\_to\_s*cs%dtbt\_max 766 \textcolor{keyword}{call }mom\_mesg(mesg, 3) 767 \textcolor{keywordflow}{ endif} 768 cs%nstep\_last = nstep 769 770 \textcolor{comment}{! Set the actual barotropic time step.} 771 instep = 1.0 / \textcolor{keywordtype}{real}(nstep) 772 dtbt = dt * instep 773 idtbt = 1.0 / dtbt 774 bebt = cs%bebt 775 be\_proj = cs%bebt 776 mass\_accel\_to\_z = 1.0 / gv%Rho0 777 mass\_to\_z = us%m\_to\_Z / gv%Rho0 778 779 \textcolor{comment}{!--- setup the weight when computing vbt\_trans and ubt\_trans} 780 \textcolor{keywordflow}{if} (project\_velocity) \textcolor{keywordflow}{then} 781 trans\_wt1 = (1.0 + be\_proj); trans\_wt2 = -be\_proj 782 \textcolor{keywordflow}{else} 783 trans\_wt1 = bebt ; trans\_wt2 = (1.0-bebt) 784 \textcolor{keywordflow}{ endif} 785 786 do\_hifreq\_output = .false. 787 \textcolor{keywordflow}{if} ((cs%id\_ubt\_hifreq > 0) .or. (cs%id\_vbt\_hifreq > 0) .or. & 788 (cs%id\_eta\_hifreq > 0) .or. (cs%id\_eta\_pred\_hifreq > 0) .or. & 789 (cs%id\_uhbt\_hifreq > 0) .or. (cs%id\_vhbt\_hifreq > 0)) \textcolor{keywordflow}{then} 790 do\_hifreq\_output = query\_averaging\_enabled(cs%diag, time\_int\_in, time\_end\_in) 791 \textcolor{keywordflow}{if} (do\_hifreq\_output) & 792 time\_bt\_start = time\_end\_in - real\_to\_time(us%T\_to\_s*dt) 793 \textcolor{keywordflow}{ endif} 794 795 \textcolor{comment}{!--- begin setup for group halo update} 796 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_pass\_pre) 797 \textcolor{keywordflow}{if} (.not. cs%linearized\_BT\_PV) \textcolor{keywordflow}{then} 798 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_q\_DCor, q, cs%BT\_Domain, to\_all, position=corner) 799 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_q\_DCor, dcor\_u, dcor\_v, cs%BT\_Domain, & 800 to\_all+scalar\_pair) 801 \textcolor{keywordflow}{ endif} 802 \textcolor{keywordflow}{if} ((isq > is-1) .or. (jsq > js-1)) & 803 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_tmp\_uv, tmp\_u, tmp\_v, g%Domain) 804 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_gtot, gtot\_e, gtot\_n, cs%BT\_Domain, & 805 to\_all+scalar\_pair, agrid) 806 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_gtot, gtot\_w, gtot\_s, cs%BT\_Domain, & 807 to\_all+scalar\_pair, agrid) 808 809 \textcolor{keywordflow}{if} (cs%dynamic\_psurf) & 810 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_eta\_bt\_rem, dyn\_coef\_eta, cs%BT\_Domain) 811 \textcolor{keywordflow}{if} (interp\_eta\_pf) \textcolor{keywordflow}{then} 812 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_eta\_bt\_rem, eta\_pf\_1, cs%BT\_Domain) 813 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_eta\_bt\_rem, d\_eta\_pf, cs%BT\_Domain) 814 \textcolor{keywordflow}{else} 815 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_eta\_bt\_rem, eta\_pf, cs%BT\_Domain) 816 \textcolor{keywordflow}{ endif} 817 \textcolor{keywordflow}{if} (integral\_bt\_cont) & 818 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_eta\_bt\_rem, eta\_ic, cs%BT\_Domain) 819 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_eta\_bt\_rem, eta\_src, cs%BT\_Domain) 820 \textcolor{comment}{! The following halo updates are not needed without wide halos. RWH} 821 \textcolor{comment}{! We do need them after all.} 822 \textcolor{comment}{! if (ievf > ie) then} 823 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_eta\_bt\_rem, bt\_rem\_u, bt\_rem\_v, & 824 cs%BT\_Domain, to\_all+scalar\_pair) 825 \textcolor{keywordflow}{if} (cs%linear\_wave\_drag) & 826 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_eta\_bt\_rem, rayleigh\_u, rayleigh\_v, & 827 cs%BT\_Domain, to\_all+scalar\_pair) 828 \textcolor{comment}{! endif} 829 \textcolor{comment}{! The following halo update is not needed without wide halos. RWH} 830 \textcolor{keywordflow}{if} (((g%isd > cs%isdw) .or. (g%jsd > cs%jsdw)) .or. (isq <= is-1) .or. (jsq <= js-1)) & 831 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_force\_hbt0\_Cor\_ref, bt\_force\_u, bt\_force\_v, cs%BT\_Domain) 832 \textcolor{keywordflow}{if} (add\_uh0) \textcolor{keyword}{call }create\_group\_pass(cs%pass\_force\_hbt0\_Cor\_ref, uhbt0, vhbt0, cs%BT\_Domain) 833 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_force\_hbt0\_Cor\_ref, cor\_ref\_u, cor\_ref\_v, cs%BT\_Domain) 834 \textcolor{keywordflow}{if} (.not. use\_bt\_cont) \textcolor{keywordflow}{then} 835 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_Dat\_uv, datu, datv, cs%BT\_Domain, to\_all+scalar\_pair) 836 \textcolor{keywordflow}{ endif} 837 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_eta\_ubt, eta, cs%BT\_Domain) 838 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_eta\_ubt, ubt, vbt, cs%BT\_Domain) 839 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 840 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_eta\_ubt, ubt\_int, vbt\_int, cs%BT\_Domain) 841 \textcolor{comment}{! This is only needed with integral\_BT\_cont, OBCs and multiple barotropic steps between halo updates.} 842 \textcolor{keywordflow}{if} (apply\_obc\_open) & 843 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_eta\_ubt, uhbt\_int, vhbt\_int, cs%BT\_Domain) 844 \textcolor{keywordflow}{ endif} 845 846 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_ubt\_Cor, ubt\_cor, vbt\_cor, g%Domain) 847 \textcolor{comment}{! These passes occur at the end of the routine, as data is being readied to} 848 \textcolor{comment}{! share with the main part of the MOM6 code.} 849 \textcolor{keywordflow}{if} (find\_etaav) \textcolor{keywordflow}{then} 850 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_etaav, etaav, g%Domain) 851 \textcolor{keywordflow}{ endif} 852 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_e\_anom, e\_anom, g%Domain) 853 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_ubta\_uhbta, cs%ubtav, cs%vbtav, g%Domain) 854 \textcolor{keyword}{call }create\_group\_pass(cs%pass\_ubta\_uhbta, uhbtav, vhbtav, g%Domain) 855 856 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_pass\_pre) 857 \textcolor{comment}{!--- end setup for group halo update} 858 859 \textcolor{comment}{! Calculate the constant coefficients for the Coriolis force terms in the} 860 \textcolor{comment}{! barotropic momentum equations. This has to be done quite early to start} 861 \textcolor{comment}{! the halo update that needs to be completed before the next calculations.} 862 \textcolor{keywordflow}{if} (cs%linearized\_BT\_PV) \textcolor{keywordflow}{then} 863 \textcolor{comment}{!$OMP parallel do default(shared)} 864 \textcolor{keywordflow}{do} j=jsvf-2,jevf+1 ; \textcolor{keywordflow}{do} i=isvf-2,ievf+1 865 q(i,j) = cs%q\_D(i,j) 866 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 867 \textcolor{comment}{!$OMP parallel do default(shared)} 868 \textcolor{keywordflow}{do} j=jsvf-1,jevf+1 ; \textcolor{keywordflow}{do} i=isvf-2,ievf+1 869 dcor\_u(i,j) = cs%D\_u\_Cor(i,j) 870 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 871 \textcolor{comment}{!$OMP parallel do default(shared)} 872 \textcolor{keywordflow}{do} j=jsvf-2,jevf+1 ; \textcolor{keywordflow}{do} i=isvf-1,ievf+1 873 dcor\_v(i,j) = cs%D\_v\_Cor(i,j) 874 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 875 \textcolor{keywordflow}{else} 876 q(:,:) = 0.0 ; dcor\_u(:,:) = 0.0 ; dcor\_v(:,:) = 0.0 877 \textcolor{keywordflow}{if} (gv%Boussinesq) \textcolor{keywordflow}{then} 878 \textcolor{comment}{!$OMP parallel do default(shared)} 879 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 880 dcor\_u(i,j) = 0.5 * (max(gv%Z\_to\_H*g%bathyT(i+1,j) + eta\_in(i+1,j), 0.0) + & 881 max(gv%Z\_to\_H*g%bathyT(i,j) + eta\_in(i,j), 0.0) ) 882 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 883 \textcolor{comment}{!$OMP parallel do default(shared)} 884 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 885 dcor\_v(i,j) = 0.5 * (max(gv%Z\_to\_H*g%bathyT(i,j+1) + eta\_in(i+1,j), 0.0) + & 886 max(gv%Z\_to\_H*g%bathyT(i,j) + eta\_in(i,j), 0.0) ) 887 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 888 \textcolor{comment}{!$OMP parallel do default(shared)} 889 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is-1,ie 890 q(i,j) = 0.25 * (cs%BT\_Coriolis\_scale * g%CoriolisBu(i,j)) * & 891 ((g%areaT(i,j) + g%areaT(i+1,j+1)) + (g%areaT(i+1,j) + g%areaT(i,j+1))) / & 892 (max((g%areaT(i,j) * max(gv%Z\_to\_H*g%bathyT(i,j) + eta\_in(i,j), 0.0) + & 893 g%areaT(i+1,j+1) * max(gv%Z\_to\_H*g%bathyT(i+1,j+1) + eta\_in(i+1,j+1), 0.0)) + & 894 (g%areaT(i+1,j) * max(gv%Z\_to\_H*g%bathyT(i+1,j) + eta\_in(i+1,j), 0.0) + & 895 g%areaT(i,j+1) * max(gv%Z\_to\_H*g%bathyT(i,j+1) + eta\_in(i,j+1), 0.0)), h\_neglect) ) 896 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 897 \textcolor{keywordflow}{else} 898 \textcolor{comment}{!$OMP parallel do default(shared)} 899 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 900 dcor\_u(i,j) = 0.5 * (eta\_in(i+1,j) + eta\_in(i,j)) 901 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 902 \textcolor{comment}{!$OMP parallel do default(shared)} 903 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 904 dcor\_v(i,j) = 0.5 * (eta\_in(i,j+1) + eta\_in(i,j)) 905 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 906 \textcolor{comment}{!$OMP parallel do default(shared)} 907 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is-1,ie 908 q(i,j) = 0.25 * (cs%BT\_Coriolis\_scale * g%CoriolisBu(i,j)) * & 909 ((g%areaT(i,j) + g%areaT(i+1,j+1)) + (g%areaT(i+1,j) + g%areaT(i,j+1))) / & 910 (max((g%areaT(i,j) * eta\_in(i,j) + g%areaT(i+1,j+1) * eta\_in(i+1,j+1)) + & 911 (g%areaT(i+1,j) * eta\_in(i+1,j) + g%areaT(i,j+1) * eta\_in(i,j+1)), h\_neglect) ) 912 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 913 \textcolor{keywordflow}{ endif} 914 915 \textcolor{comment}{! With very wide halos, q and D need to be calculated on the available data} 916 \textcolor{comment}{! domain and then updated onto the full computational domain.} 917 \textcolor{comment}{! These calculations can be done almost immediately, but the halo updates} 918 \textcolor{comment}{! must be done before the [abcd]mer and [abcd]zon are calculated.} 919 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc\_pre) 920 \textcolor{keywordflow}{if} (nonblock\_setup) \textcolor{keywordflow}{then} 921 \textcolor{keyword}{call }start\_group\_pass(cs%pass\_q\_DCor, cs%BT\_Domain, clock=id\_clock\_pass\_pre) 922 \textcolor{keywordflow}{else} 923 \textcolor{keyword}{call }do\_group\_pass(cs%pass\_q\_DCor, cs%BT\_Domain, clock=id\_clock\_pass\_pre) 924 \textcolor{keywordflow}{ endif} 925 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc\_pre) 926 \textcolor{keywordflow}{ endif} 927 928 \textcolor{comment}{! Zero out various wide-halo arrays.} 929 \textcolor{comment}{!$OMP parallel do default(shared)} 930 \textcolor{keywordflow}{do} j=cs%jsdw,cs%jedw ; \textcolor{keywordflow}{do} i=cs%isdw,cs%iedw 931 gtot\_e(i,j) = 0.0 ; gtot\_w(i,j) = 0.0 932 gtot\_n(i,j) = 0.0 ; gtot\_s(i,j) = 0.0 933 eta(i,j) = 0.0 934 eta\_pf(i,j) = 0.0 935 \textcolor{keywordflow}{if} (interp\_eta\_pf) \textcolor{keywordflow}{then} 936 eta\_pf\_1(i,j) = 0.0 ; d\_eta\_pf(i,j) = 0.0 937 \textcolor{keywordflow}{ endif} 938 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 939 eta\_ic(i,j) = 0.0 940 \textcolor{keywordflow}{ endif} 941 p\_surf\_dyn(i,j) = 0.0 942 \textcolor{keywordflow}{if} (cs%dynamic\_psurf) dyn\_coef\_eta(i,j) = 0.0 943 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 944 \textcolor{comment}{! The halo regions of various arrays need to be initialized to} 945 \textcolor{comment}{! non-NaNs in case the neighboring domains are not part of the ocean.} 946 \textcolor{comment}{! Otherwise a halo update later on fills in the correct values.} 947 \textcolor{comment}{!$OMP parallel do default(shared)} 948 \textcolor{keywordflow}{do} j=cs%jsdw,cs%jedw ; \textcolor{keywordflow}{do} i=cs%isdw-1,cs%iedw 949 cor\_ref\_u(i,j) = 0.0 ; bt\_force\_u(i,j) = 0.0 ; ubt(i,j) = 0.0 950 datu(i,j) = 0.0 ; bt\_rem\_u(i,j) = 0.0 ; uhbt0(i,j) = 0.0 951 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 952 \textcolor{comment}{!$OMP parallel do default(shared)} 953 \textcolor{keywordflow}{do} j=cs%jsdw-1,cs%jedw ; \textcolor{keywordflow}{do} i=cs%isdw,cs%iedw 954 cor\_ref\_v(i,j) = 0.0 ; bt\_force\_v(i,j) = 0.0 ; vbt(i,j) = 0.0 955 datv(i,j) = 0.0 ; bt\_rem\_v(i,j) = 0.0 ; vhbt0(i,j) = 0.0 956 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 957 958 \textcolor{comment}{! Copy input arrays into their wide-halo counterparts.} 959 \textcolor{keywordflow}{if} (interp\_eta\_pf) \textcolor{keywordflow}{then} 960 \textcolor{comment}{!$OMP parallel do default(shared)} 961 \textcolor{keywordflow}{do} j=g%jsd,g%jed ; \textcolor{keywordflow}{do} i=g%isd,g%ied \textcolor{comment}{! Was "do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1" but doing so breaks OBC. Not sure why?} 962 eta(i,j) = eta\_in(i,j) 963 eta\_pf\_1(i,j) = eta\_pf\_start(i,j) 964 d\_eta\_pf(i,j) = eta\_pf\_in(i,j) - eta\_pf\_start(i,j) 965 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 966 \textcolor{keywordflow}{else} 967 \textcolor{comment}{!$OMP parallel do default(shared)} 968 \textcolor{keywordflow}{do} j=g%jsd,g%jed ; \textcolor{keywordflow}{do} i=g%isd,g%ied \textcolor{comment}{!: Was "do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1" but doing so breaks OBC. Not sure why?} 969 eta(i,j) = eta\_in(i,j) 970 eta\_pf(i,j) = eta\_pf\_in(i,j) 971 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 972 \textcolor{keywordflow}{ endif} 973 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 974 \textcolor{comment}{!$OMP parallel do default(shared)} 975 \textcolor{keywordflow}{do} j=g%jsd,g%jed ; \textcolor{keywordflow}{do} i=g%isd,g%ied 976 eta\_ic(i,j) = eta\_in(i,j) 977 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 978 \textcolor{keywordflow}{ endif} 979 980 \textcolor{comment}{!$OMP parallel do default(shared) private(visc\_rem)} 981 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 982 \textcolor{comment}{! rem needs greater than visc\_rem\_u and 1-Instep/visc\_rem\_u.} 983 \textcolor{comment}{! The 0.5 below is just for safety.} 984 \textcolor{keywordflow}{if} (visc\_rem\_u(i,j,k) <= 0.0) \textcolor{keywordflow}{then} ; visc\_rem = 0.0 985 \textcolor{keywordflow}{elseif} (visc\_rem\_u(i,j,k) >= 1.0) \textcolor{keywordflow}{then} ; visc\_rem = 1.0 986 \textcolor{keywordflow}{elseif} (visc\_rem\_u(i,j,k)**2 > visc\_rem\_u(i,j,k) - 0.5*instep) \textcolor{keywordflow}{then} 987 visc\_rem = visc\_rem\_u(i,j,k) 988 \textcolor{keywordflow}{else} ; visc\_rem = 1.0 - 0.5*instep/visc\_rem\_u(i,j,k) ;\textcolor{keywordflow}{ endif} 989 wt\_u(i,j,k) = cs%frhatu(i,j,k) * visc\_rem 990 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 991 \textcolor{comment}{!$OMP parallel do default(shared) private(visc\_rem)} 992 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 993 \textcolor{comment}{! rem needs greater than visc\_rem\_v and 1-Instep/visc\_rem\_v.} 994 \textcolor{keywordflow}{if} (visc\_rem\_v(i,j,k) <= 0.0) \textcolor{keywordflow}{then} ; visc\_rem = 0.0 995 \textcolor{keywordflow}{elseif} (visc\_rem\_v(i,j,k) >= 1.0) \textcolor{keywordflow}{then} ; visc\_rem = 1.0 996 \textcolor{keywordflow}{elseif} (visc\_rem\_v(i,j,k)**2 > visc\_rem\_v(i,j,k) - 0.5*instep) \textcolor{keywordflow}{then} 997 visc\_rem = visc\_rem\_v(i,j,k) 998 \textcolor{keywordflow}{else} ; visc\_rem = 1.0 - 0.5*instep/visc\_rem\_v(i,j,k) ;\textcolor{keywordflow}{ endif} 999 wt\_v(i,j,k) = cs%frhatv(i,j,k) * visc\_rem 1000 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1001 1002 \textcolor{comment}{! Use u\_Cor and v\_Cor as the reference values for the Coriolis terms,} 1003 \textcolor{comment}{! including the viscous remnant.} 1004 \textcolor{comment}{!$OMP parallel do default(shared)} 1005 \textcolor{keywordflow}{do} j=js-1,je+1 ; \textcolor{keywordflow}{do} i=is-1,ie ; ubt\_cor(i,j) = 0.0 ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1006 \textcolor{comment}{!$OMP parallel do default(shared)} 1007 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is-1,ie+1 ; vbt\_cor(i,j) = 0.0 ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1008 \textcolor{comment}{!$OMP parallel do default(shared)} 1009 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is-1,ie 1010 ubt\_cor(i,j) = ubt\_cor(i,j) + wt\_u(i,j,k) * u\_cor(i,j,k) 1011 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1012 \textcolor{comment}{!$OMP parallel do default(shared)} 1013 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is,ie 1014 vbt\_cor(i,j) = vbt\_cor(i,j) + wt\_v(i,j,k) * v\_cor(i,j,k) 1015 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1016 1017 \textcolor{comment}{! The gtot arrays are the effective layer-weighted reduced gravities for} 1018 \textcolor{comment}{! accelerations across the various faces, with names for the relative} 1019 \textcolor{comment}{! locations of the faces to the pressure point. They will have their halos} 1020 \textcolor{comment}{! updated later on.} 1021 \textcolor{comment}{!$OMP parallel do default(shared)} 1022 \textcolor{keywordflow}{do} j=js,je 1023 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is-1,ie 1024 gtot\_e(i,j) = gtot\_e(i,j) + pbce(i,j,k) * wt\_u(i,j,k) 1025 gtot\_w(i+1,j) = gtot\_w(i+1,j) + pbce(i+1,j,k) * wt\_u(i,j,k) 1026 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1027 \textcolor{keywordflow}{ enddo} 1028 \textcolor{comment}{!$OMP parallel do default(shared)} 1029 \textcolor{keywordflow}{do} j=js-1,je 1030 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is,ie 1031 gtot\_n(i,j) = gtot\_n(i,j) + pbce(i,j,k) * wt\_v(i,j,k) 1032 gtot\_s(i,j+1) = gtot\_s(i,j+1) + pbce(i,j+1,k) * wt\_v(i,j,k) 1033 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1034 \textcolor{keywordflow}{ enddo} 1035 1036 \textcolor{keywordflow}{if} (cs%tides) \textcolor{keywordflow}{then} 1037 \textcolor{keyword}{call }tidal\_forcing\_sensitivity(g, cs%tides\_CSp, det\_de) 1038 dgeo\_de = 1.0 + det\_de + cs%G\_extra 1039 \textcolor{keywordflow}{else} 1040 dgeo\_de = 1.0 + cs%G\_extra 1041 \textcolor{keywordflow}{ endif} 1042 1043 \textcolor{keywordflow}{if} (nonblock\_setup .and. .not.cs%linearized\_BT\_PV) \textcolor{keywordflow}{then} 1044 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc\_pre) 1045 \textcolor{keyword}{call }complete\_group\_pass(cs%pass\_q\_DCor, cs%BT\_Domain, clock=id\_clock\_pass\_pre) 1046 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc\_pre) 1047 \textcolor{keywordflow}{ endif} 1048 1049 \textcolor{comment}{! Calculate the open areas at the velocity points.} 1050 \textcolor{comment}{! The halo updates are needed before Datu is first used, either in set\_up\_BT\_OBC or ubt\_Cor.} 1051 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 1052 \textcolor{keyword}{call }set\_local\_bt\_cont\_types(bt\_cont, btcl\_u, btcl\_v, g, us, ms, cs%BT\_Domain, 1+ievf-ie, dt\_baroclinic =dt) 1053 \textcolor{keywordflow}{elseif} (use\_bt\_cont) \textcolor{keywordflow}{then} 1054 \textcolor{keyword}{call }set\_local\_bt\_cont\_types(bt\_cont, btcl\_u, btcl\_v, g, us, ms, cs%BT\_Domain, 1+ievf-ie) 1055 \textcolor{keywordflow}{else} 1056 \textcolor{keywordflow}{if} (cs%Nonlinear\_continuity) \textcolor{keywordflow}{then} 1057 \textcolor{keyword}{call }find\_face\_areas(datu, datv, g, gv, us, cs, ms, eta, 1) 1058 \textcolor{keywordflow}{else} 1059 \textcolor{keyword}{call }find\_face\_areas(datu, datv, g, gv, us, cs, ms, halo=1) 1060 \textcolor{keywordflow}{ endif} 1061 \textcolor{keywordflow}{ endif} 1062 1063 \textcolor{comment}{! Set up fields related to the open boundary conditions.} 1064 \textcolor{keywordflow}{if} (apply\_obcs) \textcolor{keywordflow}{then} 1065 \textcolor{keyword}{call }set\_up\_bt\_obc(obc, eta, cs%BT\_OBC, cs%BT\_Domain, g, gv, us, ms, ievf-ie, use\_bt\_cont, & 1066 integral\_bt\_cont, dt, datu, datv, btcl\_u, btcl\_v) 1067 \textcolor{keywordflow}{ endif} 1068 1069 \textcolor{comment}{! Determine the difference between the sum of the layer fluxes and the} 1070 \textcolor{comment}{! barotropic fluxes found from the same input velocities.} 1071 \textcolor{keywordflow}{if} (add\_uh0) \textcolor{keywordflow}{then} 1072 \textcolor{comment}{!$OMP parallel do default(shared)} 1073 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; uhbt(i,j) = 0.0 ; ubt(i,j) = 0.0 ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1074 \textcolor{comment}{!$OMP parallel do default(shared)} 1075 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; vhbt(i,j) = 0.0 ; vbt(i,j) = 0.0 ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1076 \textcolor{keywordflow}{if} (cs%visc\_rem\_u\_uh0) \textcolor{keywordflow}{then} 1077 \textcolor{comment}{!$OMP parallel do default(shared)} 1078 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is-1,ie 1079 uhbt(i,j) = uhbt(i,j) + uh0(i,j,k) 1080 ubt(i,j) = ubt(i,j) + wt\_u(i,j,k) * u\_uh0(i,j,k) 1081 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1082 \textcolor{comment}{!$OMP parallel do default(shared)} 1083 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is,ie 1084 vhbt(i,j) = vhbt(i,j) + vh0(i,j,k) 1085 vbt(i,j) = vbt(i,j) + wt\_v(i,j,k) * v\_vh0(i,j,k) 1086 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1087 \textcolor{keywordflow}{else} 1088 \textcolor{comment}{!$OMP parallel do default(shared)} 1089 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is-1,ie 1090 uhbt(i,j) = uhbt(i,j) + uh0(i,j,k) 1091 ubt(i,j) = ubt(i,j) + cs%frhatu(i,j,k) * u\_uh0(i,j,k) 1092 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1093 \textcolor{comment}{!$OMP parallel do default(shared)} 1094 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is,ie 1095 vhbt(i,j) = vhbt(i,j) + vh0(i,j,k) 1096 vbt(i,j) = vbt(i,j) + cs%frhatv(i,j,k) * v\_vh0(i,j,k) 1097 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1098 \textcolor{keywordflow}{ endif} 1099 \textcolor{keywordflow}{if} ((use\_bt\_cont .or. integral\_bt\_cont) .and. cs%adjust\_BT\_cont) \textcolor{keywordflow}{then} 1100 \textcolor{comment}{! Use the additional input transports to broaden the fits} 1101 \textcolor{comment}{! over which the bt\_cont\_type applies.} 1102 1103 \textcolor{comment}{! Fill in the halo data for ubt, vbt, uhbt, and vhbt.} 1104 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc\_pre) 1105 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_pass\_pre) 1106 \textcolor{keyword}{call }pass\_vector(ubt, vbt, cs%BT\_Domain, complete=.false., halo=1+ievf-ie) 1107 \textcolor{keyword}{call }pass\_vector(uhbt, vhbt, cs%BT\_Domain, complete=.true., halo=1+ievf-ie) 1108 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_pass\_pre) 1109 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc\_pre) 1110 1111 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 1112 \textcolor{keyword}{call }adjust\_local\_bt\_cont\_types(ubt, uhbt, vbt, vhbt, btcl\_u, btcl\_v, & 1113 g, us, ms, halo=1+ievf-ie, dt\_baroclinic=dt) 1114 \textcolor{keywordflow}{else} 1115 \textcolor{keyword}{call }adjust\_local\_bt\_cont\_types(ubt, uhbt, vbt, vhbt, btcl\_u, btcl\_v, & 1116 g, us, ms, halo=1+ievf-ie) 1117 \textcolor{keywordflow}{ endif} 1118 \textcolor{keywordflow}{ endif} 1119 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 1120 \textcolor{comment}{!$OMP parallel do default(shared)} 1121 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 1122 uhbt0(i,j) = uhbt(i,j) - find\_uhbt(dt*ubt(i,j), btcl\_u(i,j)) * idt 1123 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1124 \textcolor{comment}{!$OMP parallel do default(shared)} 1125 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 1126 vhbt0(i,j) = vhbt(i,j) - find\_vhbt(dt*vbt(i,j), btcl\_v(i,j)) * idt 1127 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1128 \textcolor{keywordflow}{elseif} (use\_bt\_cont) \textcolor{keywordflow}{then} 1129 \textcolor{comment}{!$OMP parallel do default(shared)} 1130 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 1131 uhbt0(i,j) = uhbt(i,j) - find\_uhbt(ubt(i,j), btcl\_u(i,j)) 1132 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1133 \textcolor{comment}{!$OMP parallel do default(shared)} 1134 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 1135 vhbt0(i,j) = vhbt(i,j) - find\_vhbt(vbt(i,j), btcl\_v(i,j)) 1136 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1137 \textcolor{keywordflow}{else} 1138 \textcolor{comment}{!$OMP parallel do default(shared)} 1139 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 1140 uhbt0(i,j) = uhbt(i,j) - datu(i,j)*ubt(i,j) 1141 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1142 \textcolor{comment}{!$OMP parallel do default(shared)} 1143 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 1144 vhbt0(i,j) = vhbt(i,j) - datv(i,j)*vbt(i,j) 1145 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1146 \textcolor{keywordflow}{ endif} 1147 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_u\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! zero out pressure force across boundary} 1148 \textcolor{comment}{!$OMP parallel do default(shared)} 1149 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; \textcolor{keywordflow}{if} (obc%segnum\_u(i,j) /= obc\_none) \textcolor{keywordflow}{then} 1150 uhbt0(i,j) = 0.0 1151 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1152 \textcolor{keywordflow}{ endif} 1153 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_v\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! zero out PF across boundary} 1154 \textcolor{comment}{!$OMP parallel do default(shared)} 1155 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; \textcolor{keywordflow}{if} (obc%segnum\_v(i,j) /= obc\_none) \textcolor{keywordflow}{then} 1156 vhbt0(i,j) = 0.0 1157 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1158 \textcolor{keywordflow}{ endif} 1159 \textcolor{keywordflow}{ endif} 1160 1161 \textcolor{comment}{! Calculate the initial barotropic velocities from the layer's velocities.} 1162 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 1163 \textcolor{comment}{!$OMP parallel do default(shared)} 1164 \textcolor{keywordflow}{do} j=jsvf-1,jevf+1 ; \textcolor{keywordflow}{do} i=isvf-2,ievf+1 1165 ubt(i,j) = 0.0 ; uhbt(i,j) = 0.0 ; u\_accel\_bt(i,j) = 0.0 1166 ubt\_int(i,j) = 0.0 ; uhbt\_int(i,j) = 0.0 1167 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1168 \textcolor{comment}{!$OMP parallel do default(shared)} 1169 \textcolor{keywordflow}{do} j=jsvf-2,jevf+1 ; \textcolor{keywordflow}{do} i=isvf-1,ievf+1 1170 vbt(i,j) = 0.0 ; vhbt(i,j) = 0.0 ; v\_accel\_bt(i,j) = 0.0 1171 vbt\_int(i,j) = 0.0 ; vhbt\_int(i,j) = 0.0 1172 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1173 \textcolor{keywordflow}{else} 1174 \textcolor{comment}{!$OMP parallel do default(shared)} 1175 \textcolor{keywordflow}{do} j=jsvf-1,jevf+1 ; \textcolor{keywordflow}{do} i=isvf-2,ievf+1 1176 ubt(i,j) = 0.0 ; uhbt(i,j) = 0.0 ; u\_accel\_bt(i,j) = 0.0 1177 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1178 \textcolor{comment}{!$OMP parallel do default(shared)} 1179 \textcolor{keywordflow}{do} j=jsvf-2,jevf+1 ; \textcolor{keywordflow}{do} i=isvf-1,ievf+1 1180 vbt(i,j) = 0.0 ; vhbt(i,j) = 0.0 ; v\_accel\_bt(i,j) = 0.0 1181 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1182 \textcolor{keywordflow}{ endif} 1183 \textcolor{comment}{!$OMP parallel do default(shared)} 1184 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is-1,ie 1185 ubt(i,j) = ubt(i,j) + wt\_u(i,j,k) * u\_in(i,j,k) 1186 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1187 \textcolor{comment}{!$OMP parallel do default(shared)} 1188 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is,ie 1189 vbt(i,j) = vbt(i,j) + wt\_v(i,j,k) * v\_in(i,j,k) 1190 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1191 \textcolor{comment}{!$OMP parallel do default(shared)} 1192 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 1193 \textcolor{keywordflow}{if} (abs(ubt(i,j)) < cs%vel\_underflow) ubt(i,j) = 0.0 1194 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1195 \textcolor{comment}{!$OMP parallel do default(shared)} 1196 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 1197 \textcolor{keywordflow}{if} (abs(vbt(i,j)) < cs%vel\_underflow) vbt(i,j) = 0.0 1198 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1199 1200 \textcolor{keywordflow}{if} (apply\_obcs) \textcolor{keywordflow}{then} 1201 ubt\_first(:,:) = ubt(:,:) ; vbt\_first(:,:) = vbt(:,:) 1202 \textcolor{keywordflow}{ endif} 1203 1204 \textcolor{comment}{! Here the vertical average accelerations due to the Coriolis, advective,} 1205 \textcolor{comment}{! pressure gradient and horizontal viscous terms in the layer momentum} 1206 \textcolor{comment}{! equations are calculated. These will be used to determine the difference} 1207 \textcolor{comment}{! between the accelerations due to the average of the layer equations and the} 1208 \textcolor{comment}{! barotropic calculation.} 1209 1210 \textcolor{comment}{!$OMP parallel do default(shared)} 1211 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; \textcolor{keywordflow}{if} (g%mask2dCu(i,j) > 0.0) \textcolor{keywordflow}{then} 1212 \textcolor{keywordflow}{if} (cs%nonlin\_stress) \textcolor{keywordflow}{then} 1213 \textcolor{keywordflow}{if} (gv%Boussinesq) \textcolor{keywordflow}{then} 1214 htot\_avg = 0.5*(max(cs%bathyT(i,j)*gv%Z\_to\_H + eta(i,j), 0.0) + & 1215 max(cs%bathyT(i+1,j)*gv%Z\_to\_H + eta(i+1,j), 0.0)) 1216 \textcolor{keywordflow}{else} 1217 htot\_avg = 0.5*(eta(i,j) + eta(i+1,j)) 1218 \textcolor{keywordflow}{ endif} 1219 \textcolor{keywordflow}{if} (htot\_avg*cs%dy\_Cu(i,j) <= 0.0) \textcolor{keywordflow}{then} 1220 cs%IDatu(i,j) = 0.0 1221 \textcolor{keywordflow}{elseif} (integral\_bt\_cont) \textcolor{keywordflow}{then} 1222 cs%IDatu(i,j) = cs%dy\_Cu(i,j) / (max(find\_duhbt\_du(ubt(i,j)*dt, btcl\_u(i,j)), & 1223 cs%dy\_Cu(i,j)*htot\_avg) ) 1224 \textcolor{keywordflow}{elseif} (use\_bt\_cont) \textcolor{keywordflow}{then} \textcolor{comment}{! Reconsider the max and whether there should be some scaling.} 1225 cs%IDatu(i,j) = cs%dy\_Cu(i,j) / (max(find\_duhbt\_du(ubt(i,j), btcl\_u(i,j)), & 1226 cs%dy\_Cu(i,j)*htot\_avg) ) 1227 \textcolor{keywordflow}{else} 1228 cs%IDatu(i,j) = 1.0 / htot\_avg 1229 \textcolor{keywordflow}{ endif} 1230 \textcolor{keywordflow}{ endif} 1231 1232 bt\_force\_u(i,j) = forces%taux(i,j) * mass\_accel\_to\_z * cs%IDatu(i,j)*visc\_rem\_u(i,j,1) 1233 \textcolor{keywordflow}{else} 1234 bt\_force\_u(i,j) = 0.0 1235 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1236 \textcolor{comment}{!$OMP parallel do default(shared)} 1237 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; \textcolor{keywordflow}{if} (g%mask2dCv(i,j) > 0.0) \textcolor{keywordflow}{then} 1238 \textcolor{keywordflow}{if} (cs%nonlin\_stress) \textcolor{keywordflow}{then} 1239 \textcolor{keywordflow}{if} (gv%Boussinesq) \textcolor{keywordflow}{then} 1240 htot\_avg = 0.5*(max(cs%bathyT(i,j)*gv%Z\_to\_H + eta(i,j), 0.0) + & 1241 max(cs%bathyT(i,j+1)*gv%Z\_to\_H + eta(i,j+1), 0.0)) 1242 \textcolor{keywordflow}{else} 1243 htot\_avg = 0.5*(eta(i,j) + eta(i,j+1)) 1244 \textcolor{keywordflow}{ endif} 1245 \textcolor{keywordflow}{if} (htot\_avg*cs%dx\_Cv(i,j) <= 0.0) \textcolor{keywordflow}{then} 1246 cs%IDatv(i,j) = 0.0 1247 \textcolor{keywordflow}{elseif} (integral\_bt\_cont) \textcolor{keywordflow}{then} 1248 cs%IDatv(i,j) = cs%dx\_Cv(i,j) / (max(find\_dvhbt\_dv(vbt(i,j)*dt, btcl\_v(i,j)), & 1249 cs%dx\_Cv(i,j)*htot\_avg) ) 1250 \textcolor{keywordflow}{elseif} (use\_bt\_cont) \textcolor{keywordflow}{then} \textcolor{comment}{! Reconsider the max and whether there should be some scaling.} 1251 cs%IDatv(i,j) = cs%dx\_Cv(i,j) / (max(find\_dvhbt\_dv(vbt(i,j), btcl\_v(i,j)), & 1252 cs%dx\_Cv(i,j)*htot\_avg) ) 1253 \textcolor{keywordflow}{else} 1254 cs%IDatv(i,j) = 1.0 / htot\_avg 1255 \textcolor{keywordflow}{ endif} 1256 \textcolor{keywordflow}{ endif} 1257 1258 bt\_force\_v(i,j) = forces%tauy(i,j) * mass\_accel\_to\_z * cs%IDatv(i,j)*visc\_rem\_v(i,j,1) 1259 \textcolor{keywordflow}{else} 1260 bt\_force\_v(i,j) = 0.0 1261 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1262 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(taux\_bot) .and. \textcolor{keyword}{present}(tauy\_bot)) \textcolor{keywordflow}{then} 1263 \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(taux\_bot) .and. \textcolor{keyword}{associated}(tauy\_bot)) \textcolor{keywordflow}{then} 1264 \textcolor{comment}{!$OMP parallel do default(shared)} 1265 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; \textcolor{keywordflow}{if} (g%mask2dCu(i,j) > 0.0) \textcolor{keywordflow}{then} 1266 bt\_force\_u(i,j) = bt\_force\_u(i,j) - taux\_bot(i,j) * mass\_to\_z * cs%IDatu(i,j) 1267 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1268 \textcolor{comment}{!$OMP parallel do default(shared)} 1269 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; \textcolor{keywordflow}{if} (g%mask2dCv(i,j) > 0.0) \textcolor{keywordflow}{then} 1270 bt\_force\_v(i,j) = bt\_force\_v(i,j) - tauy\_bot(i,j) * mass\_to\_z * cs%IDatv(i,j) 1271 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1272 \textcolor{keywordflow}{ endif} 1273 \textcolor{keywordflow}{ endif} 1274 1275 \textcolor{comment}{! bc\_accel\_u & bc\_accel\_v are only available on the potentially} 1276 \textcolor{comment}{! non-symmetric computational domain.} 1277 \textcolor{comment}{!$OMP parallel do default(shared)} 1278 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=isq,ieq 1279 bt\_force\_u(i,j) = bt\_force\_u(i,j) + wt\_u(i,j,k) * bc\_accel\_u(i,j,k) 1280 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1281 \textcolor{comment}{!$OMP parallel do default(shared)} 1282 \textcolor{keywordflow}{do} j=jsq,jeq ; \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is,ie 1283 bt\_force\_v(i,j) = bt\_force\_v(i,j) + wt\_v(i,j,k) * bc\_accel\_v(i,j,k) 1284 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1285 1286 \textcolor{keywordflow}{if} (cs%gradual\_BT\_ICs) \textcolor{keywordflow}{then} 1287 \textcolor{comment}{!$OMP parallel do default(shared)} 1288 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 1289 bt\_force\_u(i,j) = bt\_force\_u(i,j) + (ubt(i,j) - cs%ubt\_IC(i,j)) * idt 1290 ubt(i,j) = cs%ubt\_IC(i,j) 1291 \textcolor{keywordflow}{if} (abs(ubt(i,j)) < cs%vel\_underflow) ubt(i,j) = 0.0 1292 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1293 \textcolor{comment}{!$OMP parallel do default(shared)} 1294 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 1295 bt\_force\_v(i,j) = bt\_force\_v(i,j) + (vbt(i,j) - cs%vbt\_IC(i,j)) * idt 1296 vbt(i,j) = cs%vbt\_IC(i,j) 1297 \textcolor{keywordflow}{if} (abs(vbt(i,j)) < cs%vel\_underflow) vbt(i,j) = 0.0 1298 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1299 \textcolor{keywordflow}{ endif} 1300 1301 \textcolor{keywordflow}{if} ((isq > is-1) .or. (jsq > js-1)) \textcolor{keywordflow}{then} 1302 \textcolor{comment}{! Non-symmetric memory is being used, so the edge values need to be} 1303 \textcolor{comment}{! filled in with a halo update of a non-symmetric array.} 1304 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc\_pre) 1305 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_pass\_pre) 1306 tmp\_u(:,:) = 0.0 ; tmp\_v(:,:) = 0.0 1307 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=isq,ieq ; tmp\_u(i,j) = bt\_force\_u(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1308 \textcolor{keywordflow}{do} j=jsq,jeq ; \textcolor{keywordflow}{do} i=is,ie ; tmp\_v(i,j) = bt\_force\_v(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1309 \textcolor{keywordflow}{if} (nonblock\_setup) \textcolor{keywordflow}{then} 1310 \textcolor{keyword}{call }start\_group\_pass(cs%pass\_tmp\_uv, g%Domain) 1311 \textcolor{keywordflow}{else} 1312 \textcolor{keyword}{call }do\_group\_pass(cs%pass\_tmp\_uv, g%Domain) 1313 \textcolor{keywordflow}{do} j=jsd,jed ; \textcolor{keywordflow}{do} i=isdb,iedb ; bt\_force\_u(i,j) = tmp\_u(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1314 \textcolor{keywordflow}{do} j=jsdb,jedb ; \textcolor{keywordflow}{do} i=isd,ied ; bt\_force\_v(i,j) = tmp\_v(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1315 \textcolor{keywordflow}{ endif} 1316 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_pass\_pre) 1317 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc\_pre) 1318 \textcolor{keywordflow}{ endif} 1319 1320 \textcolor{keywordflow}{if} (nonblock\_setup) \textcolor{keywordflow}{then} 1321 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc\_pre) 1322 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_pass\_pre) 1323 \textcolor{keyword}{call }start\_group\_pass(cs%pass\_gtot, cs%BT\_Domain) 1324 \textcolor{keyword}{call }start\_group\_pass(cs%pass\_ubt\_Cor, g%Domain) 1325 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_pass\_pre) 1326 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc\_pre) 1327 \textcolor{keywordflow}{ endif} 1328 1329 \textcolor{comment}{! Determine the weighted Coriolis parameters for the neighboring velocities.} 1330 \textcolor{comment}{!$OMP parallel do default(shared)} 1331 \textcolor{keywordflow}{do} j=jsvf-1,jevf ; \textcolor{keywordflow}{do} i=isvf-1,ievf+1 1332 \textcolor{keywordflow}{if} (cs%Sadourny) \textcolor{keywordflow}{then} 1333 amer(i-1,j) = dcor\_u(i-1,j) * q(i-1,j) 1334 bmer(i,j) = dcor\_u(i,j) * q(i,j) 1335 cmer(i,j+1) = dcor\_u(i,j+1) * q(i,j) 1336 dmer(i-1,j+1) = dcor\_u(i-1,j+1) * q(i-1,j) 1337 \textcolor{keywordflow}{else} 1338 amer(i-1,j) = dcor\_u(i-1,j) * & 1339 ((q(i,j) + q(i-1,j-1)) + q(i-1,j)) / 3.0 1340 bmer(i,j) = dcor\_u(i,j) * & 1341 (q(i,j) + (q(i-1,j) + q(i,j-1))) / 3.0 1342 cmer(i,j+1) = dcor\_u(i,j+1) * & 1343 (q(i,j) + (q(i-1,j) + q(i,j+1))) / 3.0 1344 dmer(i-1,j+1) = dcor\_u(i-1,j+1) * & 1345 ((q(i,j) + q(i-1,j+1)) + q(i-1,j)) / 3.0 1346 \textcolor{keywordflow}{ endif} 1347 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1348 1349 \textcolor{comment}{!$OMP parallel do default(shared)} 1350 \textcolor{keywordflow}{do} j=jsvf-1,jevf+1 ; \textcolor{keywordflow}{do} i=isvf-1,ievf 1351 \textcolor{keywordflow}{if} (cs%Sadourny) \textcolor{keywordflow}{then} 1352 azon(i,j) = dcor\_v(i+1,j) * q(i,j) 1353 bzon(i,j) = dcor\_v(i,j) * q(i,j) 1354 czon(i,j) = dcor\_v(i,j-1) * q(i,j-1) 1355 dzon(i,j) = dcor\_v(i+1,j-1) * q(i,j-1) 1356 \textcolor{keywordflow}{else} 1357 azon(i,j) = dcor\_v(i+1,j) * & 1358 (q(i,j) + (q(i+1,j) + q(i,j-1))) / 3.0 1359 bzon(i,j) = dcor\_v(i,j) * & 1360 (q(i,j) + (q(i-1,j) + q(i,j-1))) / 3.0 1361 czon(i,j) = dcor\_v(i,j-1) * & 1362 ((q(i,j) + q(i-1,j-1)) + q(i,j-1)) / 3.0 1363 dzon(i,j) = dcor\_v(i+1,j-1) * & 1364 ((q(i,j) + q(i+1,j-1)) + q(i,j-1)) / 3.0 1365 \textcolor{keywordflow}{ endif} 1366 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1367 1368 \textcolor{comment}{! Complete the previously initiated message passing.} 1369 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc\_pre) 1370 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_pass\_pre) 1371 \textcolor{keywordflow}{if} (nonblock\_setup) \textcolor{keywordflow}{then} 1372 \textcolor{keywordflow}{if} ((isq > is-1) .or. (jsq > js-1)) \textcolor{keywordflow}{then} 1373 \textcolor{keyword}{call }complete\_group\_pass(cs%pass\_tmp\_uv, g%Domain) 1374 \textcolor{keywordflow}{do} j=jsd,jed ; \textcolor{keywordflow}{do} i=isdb,iedb ; bt\_force\_u(i,j) = tmp\_u(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1375 \textcolor{keywordflow}{do} j=jsdb,jedb ; \textcolor{keywordflow}{do} i=isd,ied ; bt\_force\_v(i,j) = tmp\_v(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1376 \textcolor{keywordflow}{ endif} 1377 \textcolor{keyword}{call }complete\_group\_pass(cs%pass\_gtot, cs%BT\_Domain) 1378 \textcolor{keyword}{call }complete\_group\_pass(cs%pass\_ubt\_Cor, g%Domain) 1379 \textcolor{keywordflow}{else} 1380 \textcolor{keyword}{call }do\_group\_pass(cs%pass\_gtot, cs%BT\_Domain) 1381 \textcolor{keyword}{call }do\_group\_pass(cs%pass\_ubt\_Cor, g%Domain) 1382 \textcolor{keywordflow}{ endif} 1383 \textcolor{comment}{! The various elements of gtot are positive definite but directional, so use} 1384 \textcolor{comment}{! the polarity arrays to sort out when the directions have shifted.} 1385 \textcolor{keywordflow}{do} j=jsvf-1,jevf+1 ; \textcolor{keywordflow}{do} i=isvf-1,ievf+1 1386 \textcolor{keywordflow}{if} (cs%ua\_polarity(i,j) < 0.0) \textcolor{keyword}{call }swap(gtot\_e(i,j), gtot\_w(i,j)) 1387 \textcolor{keywordflow}{if} (cs%va\_polarity(i,j) < 0.0) \textcolor{keyword}{call }swap(gtot\_n(i,j), gtot\_s(i,j)) 1388 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1389 1390 \textcolor{comment}{!$OMP parallel do default(shared)} 1391 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 1392 cor\_ref\_u(i,j) = & 1393 ((azon(i,j) * vbt\_cor(i+1,j) + czon(i,j) * vbt\_cor(i ,j-1)) + & 1394 (bzon(i,j) * vbt\_cor(i ,j) + dzon(i,j) * vbt\_cor(i+1,j-1))) 1395 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1396 \textcolor{comment}{!$OMP parallel do default(shared)} 1397 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 1398 cor\_ref\_v(i,j) = -1.0 * & 1399 ((amer(i-1,j) * ubt\_cor(i-1,j) + cmer(i ,j+1) * ubt\_cor(i ,j+1)) + & 1400 (bmer(i ,j) * ubt\_cor(i ,j) + dmer(i-1,j+1) * ubt\_cor(i-1,j+1))) 1401 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1402 1403 \textcolor{comment}{! Now start new halo updates.} 1404 \textcolor{keywordflow}{if} (nonblock\_setup) \textcolor{keywordflow}{then} 1405 \textcolor{keywordflow}{if} (.not.use\_bt\_cont) & 1406 \textcolor{keyword}{call }start\_group\_pass(cs%pass\_Dat\_uv, cs%BT\_Domain) 1407 1408 \textcolor{comment}{! The following halo update is not needed without wide halos. RWH} 1409 \textcolor{keyword}{call }start\_group\_pass(cs%pass\_force\_hbt0\_Cor\_ref, cs%BT\_Domain) 1410 \textcolor{keywordflow}{ endif} 1411 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_pass\_pre) 1412 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc\_pre) 1413 \textcolor{comment}{!$OMP parallel default(shared) private(u\_max\_cor,uint\_cor,v\_max\_cor,vint\_cor,eta\_cor\_max,Htot)} 1414 \textcolor{comment}{!$OMP do} 1415 \textcolor{keywordflow}{do} j=js-1,je+1 ; \textcolor{keywordflow}{do} i=is-1,ie ; av\_rem\_u(i,j) = 0.0 ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1416 \textcolor{comment}{!$OMP do} 1417 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is-1,ie+1 ; av\_rem\_v(i,j) = 0.0 ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1418 \textcolor{comment}{!$OMP do} 1419 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is-1,ie 1420 av\_rem\_u(i,j) = av\_rem\_u(i,j) + cs%frhatu(i,j,k) * visc\_rem\_u(i,j,k) 1421 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1422 \textcolor{comment}{!$OMP do} 1423 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} i=is,ie 1424 av\_rem\_v(i,j) = av\_rem\_v(i,j) + cs%frhatv(i,j,k) * visc\_rem\_v(i,j,k) 1425 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1426 \textcolor{keywordflow}{if} (cs%strong\_drag) \textcolor{keywordflow}{then} 1427 \textcolor{comment}{!$OMP do} 1428 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 1429 bt\_rem\_u(i,j) = g%mask2dCu(i,j) * & 1430 ((nstep * av\_rem\_u(i,j)) / (1.0 + (nstep-1)*av\_rem\_u(i,j))) 1431 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1432 \textcolor{comment}{!$OMP do} 1433 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 1434 bt\_rem\_v(i,j) = g%mask2dCv(i,j) * & 1435 ((nstep * av\_rem\_v(i,j)) / (1.0 + (nstep-1)*av\_rem\_v(i,j))) 1436 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1437 \textcolor{keywordflow}{else} 1438 \textcolor{comment}{!$OMP do} 1439 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 1440 bt\_rem\_u(i,j) = 0.0 1441 \textcolor{keywordflow}{if} (g%mask2dCu(i,j) * av\_rem\_u(i,j) > 0.0) & 1442 bt\_rem\_u(i,j) = g%mask2dCu(i,j) * (av\_rem\_u(i,j)**instep) 1443 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1444 \textcolor{comment}{!$OMP do} 1445 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 1446 bt\_rem\_v(i,j) = 0.0 1447 \textcolor{keywordflow}{if} (g%mask2dCv(i,j) * av\_rem\_v(i,j) > 0.0) & 1448 bt\_rem\_v(i,j) = g%mask2dCv(i,j) * (av\_rem\_v(i,j)**instep) 1449 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1450 \textcolor{keywordflow}{ endif} 1451 \textcolor{keywordflow}{if} (cs%linear\_wave\_drag) \textcolor{keywordflow}{then} 1452 \textcolor{comment}{!$OMP do} 1453 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; \textcolor{keywordflow}{if} (cs%lin\_drag\_u(i,j) > 0.0) \textcolor{keywordflow}{then} 1454 htot = 0.5 * (eta(i,j) + eta(i+1,j)) 1455 \textcolor{keywordflow}{if} (gv%Boussinesq) & 1456 htot = htot + 0.5*gv%Z\_to\_H * (cs%bathyT(i,j) + cs%bathyT(i+1,j)) 1457 bt\_rem\_u(i,j) = bt\_rem\_u(i,j) * (htot / (htot + cs%lin\_drag\_u(i,j) * dtbt)) 1458 1459 rayleigh\_u(i,j) = cs%lin\_drag\_u(i,j) / htot 1460 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1461 \textcolor{comment}{!$OMP do} 1462 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; \textcolor{keywordflow}{if} (cs%lin\_drag\_v(i,j) > 0.0) \textcolor{keywordflow}{then} 1463 htot = 0.5 * (eta(i,j) + eta(i,j+1)) 1464 \textcolor{keywordflow}{if} (gv%Boussinesq) & 1465 htot = htot + 0.5*gv%Z\_to\_H * (cs%bathyT(i,j) + cs%bathyT(i+1,j+1)) 1466 bt\_rem\_v(i,j) = bt\_rem\_v(i,j) * (htot / (htot + cs%lin\_drag\_v(i,j) * dtbt)) 1467 1468 rayleigh\_v(i,j) = cs%lin\_drag\_v(i,j) / htot 1469 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1470 \textcolor{keywordflow}{ endif} 1471 1472 \textcolor{comment}{! Zero out the arrays for various time-averaged quantities.} 1473 \textcolor{keywordflow}{if} (find\_etaav) \textcolor{keywordflow}{then} 1474 \textcolor{comment}{!$OMP do} 1475 \textcolor{keywordflow}{do} j=jsvf-1,jevf+1 ; \textcolor{keywordflow}{do} i=isvf-1,ievf+1 1476 eta\_sum(i,j) = 0.0 ; eta\_wtd(i,j) = 0.0 1477 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1478 \textcolor{keywordflow}{else} 1479 \textcolor{comment}{!$OMP do} 1480 \textcolor{keywordflow}{do} j=jsvf-1,jevf+1 ; \textcolor{keywordflow}{do} i=isvf-1,ievf+1 1481 eta\_wtd(i,j) = 0.0 1482 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1483 \textcolor{keywordflow}{ endif} 1484 \textcolor{comment}{!$OMP do} 1485 \textcolor{keywordflow}{do} j=jsvf-1,jevf+1 ; \textcolor{keywordflow}{do} i=isvf-1,ievf 1486 ubt\_sum(i,j) = 0.0 ; uhbt\_sum(i,j) = 0.0 1487 pfu\_bt\_sum(i,j) = 0.0 ; coru\_bt\_sum(i,j) = 0.0 1488 ubt\_wtd(i,j) = 0.0 ; ubt\_trans(i,j) = 0.0 1489 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1490 \textcolor{comment}{!$OMP do} 1491 \textcolor{keywordflow}{do} j=jsvf-1,jevf ; \textcolor{keywordflow}{do} i=isvf-1,ievf+1 1492 vbt\_sum(i,j) = 0.0 ; vhbt\_sum(i,j) = 0.0 1493 pfv\_bt\_sum(i,j) = 0.0 ; corv\_bt\_sum(i,j) = 0.0 1494 vbt\_wtd(i,j) = 0.0 ; vbt\_trans(i,j) = 0.0 1495 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1496 1497 \textcolor{comment}{! Set the mass source, after first initializing the halos to 0.} 1498 \textcolor{comment}{!$OMP do} 1499 \textcolor{keywordflow}{do} j=jsvf-1,jevf+1; \textcolor{keywordflow}{do} i=isvf-1,ievf+1 ; eta\_src(i,j) = 0.0 ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1500 \textcolor{keywordflow}{if} (cs%bound\_BT\_corr) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{if} ((use\_bt\_cont.or.integral\_bt\_cont) .and. cs%BT\_cont\_bounds) \textcolor{keywordflow}{then} 1501 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie ; \textcolor{keywordflow}{if} (g%mask2dT(i,j) > 0.0) \textcolor{keywordflow}{then} 1502 \textcolor{keywordflow}{if} (cs%eta\_cor(i,j) > 0.0) \textcolor{keywordflow}{then} 1503 \textcolor{comment}{! Limit the source (outward) correction to be a fraction the mass that} 1504 \textcolor{comment}{! can be transported out of the cell by velocities with a CFL number of CFL\_cor.} 1505 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 1506 uint\_cor = g%dxT(i,j) * cs%maxCFL\_BT\_cont 1507 vint\_cor = g%dyT(i,j) * cs%maxCFL\_BT\_cont 1508 eta\_cor\_max = (cs%IareaT(i,j) * & 1509 (((find\_uhbt(uint\_cor, btcl\_u(i,j)) + dt*uhbt0(i,j)) - & 1510 (find\_uhbt(-uint\_cor, btcl\_u(i-1,j)) + dt*uhbt0(i-1,j))) + & 1511 ((find\_vhbt(vint\_cor, btcl\_v(i,j)) + dt*vhbt0(i,j)) - & 1512 (find\_vhbt(-vint\_cor, btcl\_v(i,j-1)) + dt*vhbt0(i,j-1))) )) 1513 \textcolor{keywordflow}{else} \textcolor{comment}{! (use\_BT\_Cont) then} 1514 u\_max\_cor = g%dxT(i,j) * (cs%maxCFL\_BT\_cont*idt) 1515 v\_max\_cor = g%dyT(i,j) * (cs%maxCFL\_BT\_cont*idt) 1516 eta\_cor\_max = dt * (cs%IareaT(i,j) * & 1517 (((find\_uhbt(u\_max\_cor, btcl\_u(i,j)) + uhbt0(i,j)) - & 1518 (find\_uhbt(-u\_max\_cor, btcl\_u(i-1,j)) + uhbt0(i-1,j))) + & 1519 ((find\_vhbt(v\_max\_cor, btcl\_v(i,j)) + vhbt0(i,j)) - & 1520 (find\_vhbt(-v\_max\_cor, btcl\_v(i,j-1)) + vhbt0(i,j-1))) )) 1521 \textcolor{keywordflow}{ endif} 1522 cs%eta\_cor(i,j) = min(cs%eta\_cor(i,j), max(0.0, eta\_cor\_max)) 1523 \textcolor{keywordflow}{else} 1524 \textcolor{comment}{! Limit the sink (inward) correction to the amount of mass that is already inside the cell.} 1525 htot = eta(i,j) 1526 \textcolor{keywordflow}{if} (gv%Boussinesq) htot = cs%bathyT(i,j)*gv%Z\_to\_H + eta(i,j) 1527 1528 cs%eta\_cor(i,j) = max(cs%eta\_cor(i,j), -max(0.0,htot)) 1529 \textcolor{keywordflow}{ endif} 1530 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1531 \textcolor{keywordflow}{else} ; \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 1532 \textcolor{keywordflow}{if} (abs(cs%eta\_cor(i,j)) > dt*cs%eta\_cor\_bound(i,j)) & 1533 cs%eta\_cor(i,j) = sign(dt*cs%eta\_cor\_bound(i,j), cs%eta\_cor(i,j)) 1534 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ endif} 1535 \textcolor{comment}{!$OMP do} 1536 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 1537 eta\_src(i,j) = g%mask2dT(i,j) * (instep * cs%eta\_cor(i,j)) 1538 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1539 \textcolor{comment}{!$OMP end parallel} 1540 1541 \textcolor{keywordflow}{if} (cs%dynamic\_psurf) \textcolor{keywordflow}{then} 1542 ice\_is\_rigid = (\textcolor{keyword}{associated}(forces%rigidity\_ice\_u) .and. & 1543 \textcolor{keyword}{associated}(forces%rigidity\_ice\_v)) 1544 h\_min\_dyn = gv%Z\_to\_H * cs%Dmin\_dyn\_psurf 1545 \textcolor{keywordflow}{if} (ice\_is\_rigid .and. use\_bt\_cont) & 1546 \textcolor{keyword}{call }bt\_cont\_to\_face\_areas(bt\_cont, datu, datv, g, us, ms, 0, .true.) 1547 \textcolor{keywordflow}{if} (ice\_is\_rigid) \textcolor{keywordflow}{then} 1548 \textcolor{comment}{!$OMP parallel do default(shared) private(Idt\_max2,H\_eff\_dx2,dyn\_coef\_max,ice\_strength)} 1549 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 1550 \textcolor{comment}{! First determine the maximum stable value for dyn\_coef\_eta.} 1551 1552 \textcolor{comment}{! This estimate of the maximum stable time step is pretty accurate for} 1553 \textcolor{comment}{! gravity waves, but it is a conservative estimate since it ignores the} 1554 \textcolor{comment}{! stabilizing effect of the bottom drag.} 1555 idt\_max2 = 0.5 * (dgeo\_de * (1.0 + 2.0*bebt)) * (g%IareaT(i,j) * & 1556 ((gtot\_e(i,j) * (datu(i,j)*g%IdxCu(i,j)) + & 1557 gtot\_w(i,j) * (datu(i-1,j)*g%IdxCu(i-1,j))) + & 1558 (gtot\_n(i,j) * (datv(i,j)*g%IdyCv(i,j)) + & 1559 gtot\_s(i,j) * (datv(i,j-1)*g%IdyCv(i,j-1)))) + & 1560 ((g%CoriolisBu(i,j)**2 + g%CoriolisBu(i-1,j-1)**2) + & 1561 (g%CoriolisBu(i-1,j)**2 + g%CoriolisBu(i,j-1)**2)) * cs%BT\_Coriolis\_scale**2 ) 1562 h\_eff\_dx2 = max(h\_min\_dyn * ((g%IdxT(i,j))**2 + (g%IdyT(i,j))**2), & 1563 g%IareaT(i,j) * & 1564 ((datu(i,j)*g%IdxCu(i,j) + datu(i-1,j)*g%IdxCu(i-1,j)) + & 1565 (datv(i,j)*g%IdyCv(i,j) + datv(i,j-1)*g%IdyCv(i,j-1)) ) ) 1566 dyn\_coef\_max = cs%const\_dyn\_psurf * max(0.0, 1.0 - dtbt**2 * idt\_max2) / & 1567 (dtbt**2 * h\_eff\_dx2) 1568 1569 \textcolor{comment}{! ice\_strength has units of [L2 Z-1 T-2 ~> m s-2]. rigidity\_ice\_[uv] has units of [L4 Z-1 T-1 ~> m3 s-1].} 1570 ice\_strength = ((forces%rigidity\_ice\_u(i,j) + forces%rigidity\_ice\_u(i-1,j)) + & 1571 (forces%rigidity\_ice\_v(i,j) + forces%rigidity\_ice\_v(i,j-1))) / & 1572 (cs%ice\_strength\_length**2 * dtbt) 1573 1574 \textcolor{comment}{! Units of dyn\_coef: [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]} 1575 dyn\_coef\_eta(i,j) = min(dyn\_coef\_max, ice\_strength * gv%H\_to\_Z) 1576 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ endif} 1577 \textcolor{keywordflow}{ endif} 1578 1579 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc\_pre) 1580 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_pass\_pre) 1581 \textcolor{keywordflow}{if} (nonblock\_setup) \textcolor{keywordflow}{then} 1582 \textcolor{keyword}{call }start\_group\_pass(cs%pass\_eta\_bt\_rem, cs%BT\_Domain) 1583 \textcolor{comment}{! The following halo update is not needed without wide halos. RWH} 1584 \textcolor{keywordflow}{else} 1585 \textcolor{keyword}{call }do\_group\_pass(cs%pass\_eta\_bt\_rem, cs%BT\_Domain) 1586 \textcolor{keywordflow}{if} (.not.use\_bt\_cont) & 1587 \textcolor{keyword}{call }do\_group\_pass(cs%pass\_Dat\_uv, cs%BT\_Domain) 1588 \textcolor{keyword}{call }do\_group\_pass(cs%pass\_force\_hbt0\_Cor\_ref, cs%BT\_Domain) 1589 \textcolor{keywordflow}{ endif} 1590 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_pass\_pre) 1591 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc\_pre) 1592 1593 \textcolor{comment}{! Complete all of the outstanding halo updates.} 1594 \textcolor{keywordflow}{if} (nonblock\_setup) \textcolor{keywordflow}{then} 1595 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc\_pre) 1596 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_pass\_pre) 1597 1598 \textcolor{keywordflow}{if} (.not.use\_bt\_cont) \textcolor{keyword}{call }complete\_group\_pass(cs%pass\_Dat\_uv, cs%BT\_Domain) 1599 \textcolor{keyword}{call }complete\_group\_pass(cs%pass\_force\_hbt0\_Cor\_ref, cs%BT\_Domain) 1600 \textcolor{keyword}{call }complete\_group\_pass(cs%pass\_eta\_bt\_rem, cs%BT\_Domain) 1601 1602 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_pass\_pre) 1603 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc\_pre) 1604 \textcolor{keywordflow}{ endif} 1605 1606 \textcolor{keywordflow}{if} (cs%debug) \textcolor{keywordflow}{then} 1607 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"BT [uv]hbt"}, uhbt, vhbt, cs%debug\_BT\_HI, haloshift=0, & 1608 scale=us%s\_to\_T*us%L\_to\_m**2*gv%H\_to\_m) 1609 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"BT Initial [uv]bt"}, ubt, vbt, cs%debug\_BT\_HI, haloshift=0, scale=us%L\_T\_to\_m\_s) 1610 \textcolor{keyword}{call }hchksum(eta, \textcolor{stringliteral}{"BT Initial eta"}, cs%debug\_BT\_HI, haloshift=0, scale=gv%H\_to\_m) 1611 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"BT BT\_force\_[uv]"}, bt\_force\_u, bt\_force\_v, & 1612 cs%debug\_BT\_HI, haloshift=0, scale=us%L\_T2\_to\_m\_s2) 1613 \textcolor{keywordflow}{if} (interp\_eta\_pf) \textcolor{keywordflow}{then} 1614 \textcolor{keyword}{call }hchksum(eta\_pf\_1, \textcolor{stringliteral}{"BT eta\_PF\_1"},cs%debug\_BT\_HI,haloshift=0, scale=gv%H\_to\_m) 1615 \textcolor{keyword}{call }hchksum(d\_eta\_pf, \textcolor{stringliteral}{"BT d\_eta\_PF"},cs%debug\_BT\_HI,haloshift=0, scale=gv%H\_to\_m) 1616 \textcolor{keywordflow}{else} 1617 \textcolor{keyword}{call }hchksum(eta\_pf, \textcolor{stringliteral}{"BT eta\_PF"},cs%debug\_BT\_HI,haloshift=0, scale=gv%H\_to\_m) 1618 \textcolor{keyword}{call }hchksum(eta\_pf\_in, \textcolor{stringliteral}{"BT eta\_PF\_in"},g%HI,haloshift=0, scale=gv%H\_to\_m) 1619 \textcolor{keywordflow}{ endif} 1620 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"BT Cor\_ref\_[uv]"}, cor\_ref\_u, cor\_ref\_v, cs%debug\_BT\_HI, haloshift=0, scale=us %L\_T2\_to\_m\_s2) 1621 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"BT [uv]hbt0"}, uhbt0, vhbt0, cs%debug\_BT\_HI, haloshift=0, & 1622 scale=us%L\_to\_m**2*us%s\_to\_T*gv%H\_to\_m) 1623 \textcolor{keywordflow}{if} (.not. use\_bt\_cont) \textcolor{keywordflow}{then} 1624 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"BT Dat[uv]"}, datu, datv, cs%debug\_BT\_HI, haloshift=1, scale=us%L\_to\_m*gv%H\_to\_m) 1625 \textcolor{keywordflow}{ endif} 1626 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"BT wt\_[uv]"}, wt\_u, wt\_v, g%HI, haloshift=0, & 1627 symmetric=.true., omit\_corners=.true., scalar\_pair=.true.) 1628 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"BT frhat[uv]"}, cs%frhatu, cs%frhatv, g%HI, haloshift=0, & 1629 symmetric=.true., omit\_corners=.true., scalar\_pair=.true.) 1630 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"BT bc\_accel\_[uv]"}, bc\_accel\_u, bc\_accel\_v, g%HI, haloshift=0, scale=us%L\_T2\_to\_m\_s2) 1631 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"BT IDat[uv]"}, cs%IDatu, cs%IDatv, g%HI, haloshift=0, & 1632 scale=us%m\_to\_Z, scalar\_pair=.true.) 1633 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"BT visc\_rem\_[uv]"}, visc\_rem\_u, visc\_rem\_v, g%HI, & 1634 haloshift=1, scalar\_pair=.true.) 1635 \textcolor{keywordflow}{ endif} 1636 1637 \textcolor{keywordflow}{if} (cs%id\_ubtdt > 0) \textcolor{keywordflow}{then} 1638 \textcolor{keywordflow}{do} j=js-1,je+1 ; \textcolor{keywordflow}{do} i=is-1,ie 1639 ubt\_st(i,j) = ubt(i,j) 1640 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1641 \textcolor{keywordflow}{ endif} 1642 \textcolor{keywordflow}{if} (cs%id\_vbtdt > 0) \textcolor{keywordflow}{then} 1643 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is-1,ie+1 1644 vbt\_st(i,j) = vbt(i,j) 1645 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1646 \textcolor{keywordflow}{ endif} 1647 1648 \textcolor{keywordflow}{if} (query\_averaging\_enabled(cs%diag)) \textcolor{keywordflow}{then} 1649 \textcolor{keywordflow}{if} (cs%id\_eta\_st > 0) \textcolor{keyword}{call }post\_data(cs%id\_eta\_st, eta(isd:ied,jsd:jed), cs%diag) 1650 \textcolor{keywordflow}{if} (cs%id\_ubt\_st > 0) \textcolor{keyword}{call }post\_data(cs%id\_ubt\_st, ubt(isdb:iedb,jsd:jed), cs%diag) 1651 \textcolor{keywordflow}{if} (cs%id\_vbt\_st > 0) \textcolor{keyword}{call }post\_data(cs%id\_vbt\_st, vbt(isd:ied,jsdb:jedb), cs%diag) 1652 \textcolor{keywordflow}{ endif} 1653 1654 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc\_pre) 1655 \textcolor{keywordflow}{if} (id\_clock\_calc > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc) 1656 1657 \textcolor{keywordflow}{if} (project\_velocity) \textcolor{keywordflow}{then} ; eta\_pf\_bt => eta ; \textcolor{keywordflow}{else} ; eta\_pf\_bt => eta\_pred ;\textcolor{keywordflow}{ endif} 1658 1659 \textcolor{keywordflow}{if} (cs%dt\_bt\_filter >= 0.0) \textcolor{keywordflow}{then} 1660 dt\_filt = 0.5 * max(0.0, min(cs%dt\_bt\_filter, 2.0*dt)) 1661 \textcolor{keywordflow}{else} 1662 dt\_filt = 0.5 * max(0.0, dt * min(-cs%dt\_bt\_filter, 2.0)) 1663 \textcolor{keywordflow}{ endif} 1664 nfilter = ceiling(dt\_filt / dtbt) 1665 1666 \textcolor{keywordflow}{if} (nstep+nfilter==0 ) \textcolor{keyword}{call }mom\_error(fatal, & 1667 \textcolor{stringliteral}{"btstep: number of barotropic step (nstep+nfilter) is 0"}) 1668 1669 \textcolor{comment}{! Set up the normalized weights for the filtered velocity.} 1670 sum\_wt\_vel = 0.0 ; sum\_wt\_eta = 0.0 ; sum\_wt\_accel = 0.0 ; sum\_wt\_trans = 0.0 1671 \textcolor{keyword}{allocate}(wt\_vel(nstep+nfilter)) ; \textcolor{keyword}{allocate}(wt\_eta(nstep+nfilter)) 1672 \textcolor{keyword}{allocate}(wt\_trans(nstep+nfilter+1)) ; \textcolor{keyword}{allocate}(wt\_accel(nstep+nfilter+1)) 1673 \textcolor{keyword}{allocate}(wt\_accel2(nstep+nfilter+1)) 1674 \textcolor{keywordflow}{do} n=1,nstep+nfilter 1675 \textcolor{comment}{! Modify this to use a different filter...} 1676 1677 \textcolor{comment}{! This is a filter that ramps down linearly over a time dt\_filt.} 1678 \textcolor{keywordflow}{if} ( (n==nstep) .or. (dt\_filt - abs(n-nstep)*dtbt >= 0.0)) \textcolor{keywordflow}{then} 1679 wt\_vel(n) = 1.0 ; wt\_eta(n) = 1.0 1680 \textcolor{keywordflow}{elseif} (dtbt + dt\_filt - abs(n-nstep)*dtbt > 0.0) \textcolor{keywordflow}{then} 1681 wt\_vel(n) = 1.0 + (dt\_filt / dtbt) - abs(n-nstep) ; wt\_eta(n) = wt\_vel(n) 1682 \textcolor{keywordflow}{else} 1683 wt\_vel(n) = 0.0 ; wt\_eta(n) = 0.0 1684 \textcolor{keywordflow}{ endif} 1685 \textcolor{comment}{! This is a simple stepfunction filter.} 1686 \textcolor{comment}{! if (n < nstep-nfilter) then ; wt\_vel(n) = 0.0 ; else ; wt\_vel(n) = 1.0 ; endif} 1687 \textcolor{comment}{! wt\_eta(n) = wt\_vel(n)} 1688 1689 \textcolor{comment}{! The rest should not be changed.} 1690 sum\_wt\_vel = sum\_wt\_vel + wt\_vel(n) ; sum\_wt\_eta = sum\_wt\_eta + wt\_eta(n) 1691 \textcolor{keywordflow}{ enddo} 1692 wt\_trans(nstep+nfilter+1) = 0.0 ; wt\_accel(nstep+nfilter+1) = 0.0 1693 \textcolor{keywordflow}{do} n=nstep+nfilter,1,-1 1694 wt\_trans(n) = wt\_trans(n+1) + wt\_eta(n) 1695 wt\_accel(n) = wt\_accel(n+1) + wt\_vel(n) 1696 sum\_wt\_accel = sum\_wt\_accel + wt\_accel(n) ; sum\_wt\_trans = sum\_wt\_trans + wt\_trans(n) 1697 \textcolor{keywordflow}{ enddo} 1698 \textcolor{comment}{! Normalize the weights.} 1699 i\_sum\_wt\_vel = 1.0 / sum\_wt\_vel ; i\_sum\_wt\_accel = 1.0 / sum\_wt\_accel 1700 i\_sum\_wt\_eta = 1.0 / sum\_wt\_eta ; i\_sum\_wt\_trans = 1.0 / sum\_wt\_trans 1701 \textcolor{keywordflow}{do} n=1,nstep+nfilter 1702 wt\_vel(n) = wt\_vel(n) * i\_sum\_wt\_vel 1703 \textcolor{keywordflow}{if} (cs%answers\_2018) \textcolor{keywordflow}{then} 1704 wt\_accel2(n) = wt\_accel(n) 1705 \textcolor{comment}{! wt\_trans(n) = wt\_trans(n) * I\_sum\_wt\_trans} 1706 \textcolor{keywordflow}{else} 1707 wt\_accel2(n) = wt\_accel(n) * i\_sum\_wt\_accel 1708 wt\_trans(n) = wt\_trans(n) * i\_sum\_wt\_trans 1709 \textcolor{keywordflow}{ endif} 1710 wt\_accel(n) = wt\_accel(n) * i\_sum\_wt\_accel 1711 wt\_eta(n) = wt\_eta(n) * i\_sum\_wt\_eta 1712 \textcolor{keywordflow}{ enddo} 1713 1714 sum\_wt\_vel = 0.0 ; sum\_wt\_eta = 0.0 ; sum\_wt\_accel = 0.0 ; sum\_wt\_trans = 0.0 1715 1716 \textcolor{comment}{! The following loop contains all of the time steps.} 1717 isv=is ; iev=ie ; jsv=js ; jev=je 1718 \textcolor{keywordflow}{do} n=1,nstep+nfilter 1719 1720 sum\_wt\_vel = sum\_wt\_vel + wt\_vel(n) 1721 sum\_wt\_eta = sum\_wt\_eta + wt\_eta(n) 1722 sum\_wt\_accel = sum\_wt\_accel + wt\_accel2(n) 1723 sum\_wt\_trans = sum\_wt\_trans + wt\_trans(n) 1724 1725 \textcolor{keywordflow}{if} (cs%clip\_velocity) \textcolor{keywordflow}{then} 1726 \textcolor{keywordflow}{do} j=jsv,jev ; \textcolor{keywordflow}{do} i=isv-1,iev 1727 \textcolor{keywordflow}{if} ((ubt(i,j) * (dt * g%dy\_Cu(i,j))) * g%IareaT(i+1,j) < -cs%CFL\_trunc) \textcolor{keywordflow}{then} 1728 \textcolor{comment}{! Add some error reporting later.} 1729 ubt(i,j) = (-0.95*cs%CFL\_trunc) * (g%areaT(i+1,j) / (dt * g%dy\_Cu(i,j))) 1730 \textcolor{keywordflow}{elseif} ((ubt(i,j) * (dt * g%dy\_Cu(i,j))) * g%IareaT(i,j) > cs%CFL\_trunc) \textcolor{keywordflow}{then} 1731 \textcolor{comment}{! Add some error reporting later.} 1732 ubt(i,j) = (0.95*cs%CFL\_trunc) * (g%areaT(i,j) / (dt * g%dy\_Cu(i,j))) 1733 \textcolor{keywordflow}{ endif} 1734 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1735 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv,iev 1736 \textcolor{keywordflow}{if} ((vbt(i,j) * (dt * g%dx\_Cv(i,j))) * g%IareaT(i,j+1) < -cs%CFL\_trunc) \textcolor{keywordflow}{then} 1737 \textcolor{comment}{! Add some error reporting later.} 1738 vbt(i,j) = (-0.9*cs%CFL\_trunc) * (g%areaT(i,j+1) / (dt * g%dx\_Cv(i,j))) 1739 \textcolor{keywordflow}{elseif} ((vbt(i,j) * (dt * g%dx\_Cv(i,j))) * g%IareaT(i,j) > cs%CFL\_trunc) \textcolor{keywordflow}{then} 1740 \textcolor{comment}{! Add some error reporting later.} 1741 vbt(i,j) = (0.9*cs%CFL\_trunc) * (g%areaT(i,j) / (dt * g%dx\_Cv(i,j))) 1742 \textcolor{keywordflow}{ endif} 1743 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1744 \textcolor{keywordflow}{ endif} 1745 1746 \textcolor{keywordflow}{if} ((iev - stencil < ie) .or. (jev - stencil < je)) \textcolor{keywordflow}{then} 1747 \textcolor{keywordflow}{if} (id\_clock\_calc > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc) 1748 \textcolor{keyword}{call }do\_group\_pass(cs%pass\_eta\_ubt, cs%BT\_Domain, clock=id\_clock\_pass\_step) 1749 isv = isvf ; iev = ievf ; jsv = jsvf ; jev = jevf 1750 \textcolor{keywordflow}{if} (id\_clock\_calc > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc) 1751 \textcolor{keywordflow}{else} 1752 isv = isv+stencil ; iev = iev-stencil 1753 jsv = jsv+stencil ; jev = jev-stencil 1754 \textcolor{keywordflow}{ endif} 1755 1756 \textcolor{keywordflow}{if} ((.not.use\_bt\_cont) .and. cs%Nonlinear\_continuity .and. & 1757 (cs%Nonlin\_cont\_update\_period > 0)) \textcolor{keywordflow}{then} 1758 \textcolor{keywordflow}{if} ((n>1) .and. (mod(n-1,cs%Nonlin\_cont\_update\_period) == 0)) & 1759 \textcolor{keyword}{call }find\_face\_areas(datu, datv, g, gv, us, cs, ms, eta, 1+iev-ie) 1760 \textcolor{keywordflow}{ endif} 1761 1762 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 1763 \textcolor{comment}{!$OMP parallel do default(shared)} 1764 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-2,iev+1 1765 ubt\_int\_prev(i,j) = ubt\_int(i,j) ; uhbt\_int\_prev(i,j) = uhbt\_int(i,j) 1766 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1767 \textcolor{comment}{!$OMP parallel do default(shared)} 1768 \textcolor{keywordflow}{do} j=jsv-2,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1769 vbt\_int\_prev(i,j) = vbt\_int(i,j) ; vhbt\_int\_prev(i,j) = vhbt\_int(i,j) 1770 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1771 \textcolor{keywordflow}{ endif} 1772 1773 \textcolor{comment}{!$OMP parallel default(shared) private(vel\_prev, ioff, joff)} 1774 \textcolor{keywordflow}{if} (cs%dynamic\_psurf .or. .not.project\_velocity) \textcolor{keywordflow}{then} 1775 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 1776 \textcolor{comment}{!$OMP do} 1777 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-2,iev+1 1778 uhbt\_int(i,j) = find\_uhbt(ubt\_int(i,j) + dtbt*ubt(i,j), btcl\_u(i,j)) + n*dtbt*uhbt0(i,j) 1779 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1780 \textcolor{comment}{!$OMP end do nowait} 1781 \textcolor{comment}{!$OMP do} 1782 \textcolor{keywordflow}{do} j=jsv-2,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1783 vhbt\_int(i,j) = find\_vhbt(vbt\_int(i,j) + dtbt*vbt(i,j), btcl\_v(i,j)) + n*dtbt*vhbt0(i,j) 1784 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1785 \textcolor{comment}{!$OMP do} 1786 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1787 eta\_pred(i,j) = (eta\_ic(i,j) + n*eta\_src(i,j)) + cs%IareaT(i,j) * & 1788 ((uhbt\_int(i-1,j) - uhbt\_int(i,j)) + (vhbt\_int(i,j-1) - vhbt\_int(i,j))) 1789 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1790 \textcolor{keywordflow}{elseif} (use\_bt\_cont) \textcolor{keywordflow}{then} 1791 \textcolor{comment}{!$OMP do} 1792 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-2,iev+1 1793 uhbt(i,j) = find\_uhbt(ubt(i,j), btcl\_u(i,j)) + uhbt0(i,j) 1794 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1795 \textcolor{comment}{!$OMP do} 1796 \textcolor{keywordflow}{do} j=jsv-2,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1797 vhbt(i,j) = find\_vhbt(vbt(i,j), btcl\_v(i,j)) + vhbt0(i,j) 1798 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1799 \textcolor{comment}{!$OMP do} 1800 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1801 eta\_pred(i,j) = (eta(i,j) + eta\_src(i,j)) + (dtbt * cs%IareaT(i,j)) * & 1802 ((uhbt(i-1,j) - uhbt(i,j)) + (vhbt(i,j-1) - vhbt(i,j))) 1803 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1804 \textcolor{keywordflow}{else} 1805 \textcolor{comment}{!$OMP do} 1806 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1807 eta\_pred(i,j) = (eta(i,j) + eta\_src(i,j)) + (dtbt * cs%IareaT(i,j)) * & 1808 (((datu(i-1,j)*ubt(i-1,j) + uhbt0(i-1,j)) - & 1809 (datu(i,j)*ubt(i,j) + uhbt0(i,j))) + & 1810 ((datv(i,j-1)*vbt(i,j-1) + vhbt0(i,j-1)) - & 1811 (datv(i,j)*vbt(i,j) + vhbt0(i,j)))) 1812 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1813 \textcolor{keywordflow}{ endif} 1814 1815 \textcolor{keywordflow}{if} (cs%dynamic\_psurf) \textcolor{keywordflow}{then} 1816 \textcolor{comment}{!$OMP do} 1817 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1818 p\_surf\_dyn(i,j) = dyn\_coef\_eta(i,j) * (eta\_pred(i,j) - eta(i,j)) 1819 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1820 \textcolor{keywordflow}{ endif} 1821 \textcolor{keywordflow}{ endif} 1822 1823 \textcolor{comment}{! Recall that just outside the do n loop, there is code like...} 1824 \textcolor{comment}{! eta\_PF\_BT => eta\_pred ; if (project\_velocity) eta\_PF\_BT => eta} 1825 1826 \textcolor{keywordflow}{if} (find\_etaav) \textcolor{keywordflow}{then} 1827 \textcolor{comment}{!$OMP do} 1828 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 1829 eta\_sum(i,j) = eta\_sum(i,j) + wt\_accel2(n) * eta\_pf\_bt(i,j) 1830 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1831 \textcolor{comment}{!$OMP end do nowait} 1832 \textcolor{keywordflow}{ endif} 1833 1834 \textcolor{keywordflow}{if} (interp\_eta\_pf) \textcolor{keywordflow}{then} 1835 wt\_end = n*instep \textcolor{comment}{! This could be (n-0.5)*Instep.} 1836 \textcolor{comment}{!$OMP do} 1837 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1838 eta\_pf(i,j) = eta\_pf\_1(i,j) + wt\_end*d\_eta\_pf(i,j) 1839 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1840 \textcolor{keywordflow}{ endif} 1841 1842 \textcolor{keywordflow}{if} (apply\_obc\_flather .or. apply\_obc\_open) \textcolor{keywordflow}{then} 1843 \textcolor{comment}{!$OMP do} 1844 \textcolor{keywordflow}{do} j=jsv,jev ; \textcolor{keywordflow}{do} i=isv-2,iev+1 1845 ubt\_old(i,j) = ubt(i,j) 1846 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1847 \textcolor{comment}{!$OMP do} 1848 \textcolor{keywordflow}{do} j=jsv-2,jev+1 ; \textcolor{keywordflow}{do} i=isv,iev 1849 vbt\_old(i,j) = vbt(i,j) 1850 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1851 \textcolor{keywordflow}{ endif} 1852 1853 \textcolor{keywordflow}{if} (apply\_obcs) \textcolor{keywordflow}{then} 1854 \textcolor{keywordflow}{if} (mod(n+g%first\_direction,2)==1) \textcolor{keywordflow}{then} 1855 ioff = 1; joff = 0 1856 \textcolor{keywordflow}{else} 1857 ioff = 0; joff = 1 1858 \textcolor{keywordflow}{ endif} 1859 1860 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_u\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! save the old value of ubt and uhbt} 1861 \textcolor{comment}{!$OMP do} 1862 \textcolor{keywordflow}{do} j=jsv-joff,jev+joff ; \textcolor{keywordflow}{do} i=isv-1,iev 1863 ubt\_prev(i,j) = ubt(i,j) ; uhbt\_prev(i,j) = uhbt(i,j) 1864 ubt\_sum\_prev(i,j) = ubt\_sum(i,j) ; uhbt\_sum\_prev(i,j) = uhbt\_sum(i,j) ; ubt\_wtd\_prev(i,j) = ubt\_wtd(i,j) 1865 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1866 \textcolor{keywordflow}{ endif} 1867 1868 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_v\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! save the old value of vbt and vhbt} 1869 \textcolor{comment}{!$OMP do} 1870 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv-ioff,iev+ioff 1871 vbt\_prev(i,j) = vbt(i,j) ; vhbt\_prev(i,j) = vhbt(i,j) 1872 vbt\_sum\_prev(i,j) = vbt\_sum(i,j) ; vhbt\_sum\_prev(i,j) = vhbt\_sum(i,j) ; vbt\_wtd\_prev(i,j) = vbt\_wtd(i,j) 1873 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1874 \textcolor{keywordflow}{ endif} 1875 \textcolor{keywordflow}{ endif} 1876 1877 \textcolor{keywordflow}{if} (mod(n+g%first\_direction,2)==1) \textcolor{keywordflow}{then} 1878 \textcolor{comment}{! On odd-steps, update v first.} 1879 \textcolor{comment}{!$OMP do schedule(static)} 1880 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1881 cor\_v(i,j) = -1.0*((amer(i-1,j) * ubt(i-1,j) + cmer(i,j+1) * ubt(i,j+1)) + & 1882 (bmer(i,j) * ubt(i,j) + dmer(i-1,j+1) * ubt(i-1,j+1))) - cor\_ref\_v(i,j) 1883 pfv(i,j) = ((eta\_pf\_bt(i,j)-eta\_pf(i,j))*gtot\_n(i,j) - & 1884 (eta\_pf\_bt(i,j+1)-eta\_pf(i,j+1))*gtot\_s(i,j+1)) * & 1885 dgeo\_de * cs%IdyCv(i,j) 1886 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1887 \textcolor{comment}{!$OMP end do nowait} 1888 \textcolor{keywordflow}{if} (cs%dynamic\_psurf) \textcolor{keywordflow}{then} 1889 \textcolor{comment}{!$OMP do schedule(static)} 1890 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1891 pfv(i,j) = pfv(i,j) + (p\_surf\_dyn(i,j) - p\_surf\_dyn(i,j+1)) * cs%IdyCv(i,j) 1892 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1893 \textcolor{comment}{!$OMP end do nowait} 1894 \textcolor{keywordflow}{ endif} 1895 1896 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_v\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! zero out PF across boundary} 1897 \textcolor{comment}{!$OMP do schedule(static)} 1898 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv-1,iev+1 ; \textcolor{keywordflow}{if} (obc%segnum\_v(i,j) /= obc\_none) \textcolor{keywordflow}{then} 1899 pfv(i,j) = 0.0 1900 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1901 \textcolor{comment}{!$OMP end do nowait} 1902 \textcolor{keywordflow}{ endif} 1903 \textcolor{comment}{!$OMP do schedule(static)} 1904 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1905 vel\_prev = vbt(i,j) 1906 vbt(i,j) = bt\_rem\_v(i,j) * (vbt(i,j) + & 1907 dtbt * ((bt\_force\_v(i,j) + cor\_v(i,j)) + pfv(i,j))) 1908 vbt\_trans(i,j) = trans\_wt1*vbt(i,j) + trans\_wt2*vel\_prev 1909 1910 \textcolor{keywordflow}{if} (cs%linear\_wave\_drag) \textcolor{keywordflow}{then} 1911 v\_accel\_bt(i,j) = v\_accel\_bt(i,j) + wt\_accel(n) * & 1912 ((cor\_v(i,j) + pfv(i,j)) - vbt(i,j)*rayleigh\_v(i,j)) 1913 \textcolor{keywordflow}{else} 1914 v\_accel\_bt(i,j) = v\_accel\_bt(i,j) + wt\_accel(n) * (cor\_v(i,j) + pfv(i,j)) 1915 \textcolor{keywordflow}{ endif} 1916 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1917 1918 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 1919 \textcolor{comment}{!$OMP do schedule(static)} 1920 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1921 vbt\_int(i,j) = vbt\_int(i,j) + dtbt * vbt\_trans(i,j) 1922 vhbt\_int(i,j) = find\_vhbt(vbt\_int(i,j), btcl\_v(i,j)) + n*dtbt*vhbt0(i,j) 1923 \textcolor{comment}{! Estimate the mass flux within a single timestep to take the filtered average.} 1924 vhbt(i,j) = (vhbt\_int(i,j) - vhbt\_int\_prev(i,j)) * idtbt 1925 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1926 \textcolor{keywordflow}{elseif} (use\_bt\_cont) \textcolor{keywordflow}{then} 1927 \textcolor{comment}{!$OMP do schedule(static)} 1928 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1929 vhbt(i,j) = find\_vhbt(vbt\_trans(i,j), btcl\_v(i,j)) + vhbt0(i,j) 1930 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1931 \textcolor{comment}{!$OMP end do nowait} 1932 \textcolor{keywordflow}{else} 1933 \textcolor{comment}{!$OMP do schedule(static)} 1934 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv-1,iev+1 1935 vhbt(i,j) = datv(i,j)*vbt\_trans(i,j) + vhbt0(i,j) 1936 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1937 \textcolor{comment}{!$OMP end do nowait} 1938 \textcolor{keywordflow}{ endif} 1939 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_v\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! copy back the value for v-points on the boundary.} 1940 \textcolor{comment}{!$OMP do schedule(static)} 1941 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv-1,iev+1 ; \textcolor{keywordflow}{if} (obc%segnum\_v(i,j) /= obc\_none) \textcolor{keywordflow}{then} 1942 vbt(i,j) = vbt\_prev(i,j) ; vhbt(i,j) = vhbt\_prev(i,j) 1943 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1944 \textcolor{keywordflow}{ endif} 1945 \textcolor{comment}{! Now update the zonal velocity.} 1946 \textcolor{comment}{!$OMP do schedule(static)} 1947 \textcolor{keywordflow}{do} j=jsv,jev ; \textcolor{keywordflow}{do} i=isv-1,iev 1948 cor\_u(i,j) = ((azon(i,j) * vbt(i+1,j) + czon(i,j) * vbt(i,j-1)) + & 1949 (bzon(i,j) * vbt(i,j) + dzon(i,j) * vbt(i+1,j-1))) - & 1950 cor\_ref\_u(i,j) 1951 pfu(i,j) = ((eta\_pf\_bt(i,j)-eta\_pf(i,j))*gtot\_e(i,j) - & 1952 (eta\_pf\_bt(i+1,j)-eta\_pf(i+1,j))*gtot\_w(i+1,j)) * & 1953 dgeo\_de * cs%IdxCu(i,j) 1954 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1955 \textcolor{comment}{!$OMP end do nowait} 1956 1957 \textcolor{keywordflow}{if} (cs%dynamic\_psurf) \textcolor{keywordflow}{then} 1958 \textcolor{comment}{!$OMP do schedule(static)} 1959 \textcolor{keywordflow}{do} j=jsv,jev ; \textcolor{keywordflow}{do} i=isv-1,iev 1960 pfu(i,j) = pfu(i,j) + (p\_surf\_dyn(i,j) - p\_surf\_dyn(i+1,j)) * cs%IdxCu(i,j) 1961 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1962 \textcolor{comment}{!$OMP end do nowait} 1963 \textcolor{keywordflow}{ endif} 1964 1965 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_u\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! zero out pressure force across boundary} 1966 \textcolor{comment}{!$OMP do schedule(static)} 1967 \textcolor{keywordflow}{do} j=jsv,jev ; \textcolor{keywordflow}{do} i=isv-1,iev ; \textcolor{keywordflow}{if} (obc%segnum\_u(i,j) /= obc\_none) \textcolor{keywordflow}{then} 1968 pfu(i,j) = 0.0 1969 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1970 \textcolor{comment}{!$OMP end do nowait} 1971 \textcolor{keywordflow}{ endif} 1972 \textcolor{comment}{!$OMP do schedule(static)} 1973 \textcolor{keywordflow}{do} j=jsv,jev ; \textcolor{keywordflow}{do} i=isv-1,iev 1974 vel\_prev = ubt(i,j) 1975 ubt(i,j) = bt\_rem\_u(i,j) * (ubt(i,j) + & 1976 dtbt * ((bt\_force\_u(i,j) + cor\_u(i,j)) + pfu(i,j))) 1977 \textcolor{keywordflow}{if} (abs(ubt(i,j)) < cs%vel\_underflow) ubt(i,j) = 0.0 1978 ubt\_trans(i,j) = trans\_wt1*ubt(i,j) + trans\_wt2*vel\_prev 1979 1980 \textcolor{keywordflow}{if} (cs%linear\_wave\_drag) \textcolor{keywordflow}{then} 1981 u\_accel\_bt(i,j) = u\_accel\_bt(i,j) + wt\_accel(n) * & 1982 ((cor\_u(i,j) + pfu(i,j)) - ubt(i,j)*rayleigh\_u(i,j)) 1983 \textcolor{keywordflow}{else} 1984 u\_accel\_bt(i,j) = u\_accel\_bt(i,j) + wt\_accel(n) * (cor\_u(i,j) + pfu(i,j)) 1985 \textcolor{keywordflow}{ endif} 1986 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1987 \textcolor{comment}{!$OMP end do nowait} 1988 1989 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 1990 \textcolor{comment}{!$OMP do schedule(static)} 1991 \textcolor{keywordflow}{do} j=jsv,jev ; \textcolor{keywordflow}{do} i=isv-1,iev 1992 ubt\_int(i,j) = ubt\_int(i,j) + dtbt * ubt\_trans(i,j) 1993 uhbt\_int(i,j) = find\_uhbt(ubt\_int(i,j), btcl\_u(i,j)) + n*dtbt*uhbt0(i,j) 1994 \textcolor{comment}{! Estimate the mass flux within a single timestep to take the filtered average.} 1995 uhbt(i,j) = (uhbt\_int(i,j) - uhbt\_int\_prev(i,j)) * idtbt 1996 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 1997 \textcolor{keywordflow}{elseif} (use\_bt\_cont) \textcolor{keywordflow}{then} 1998 \textcolor{comment}{!$OMP do schedule(static)} 1999 \textcolor{keywordflow}{do} j=jsv,jev ; \textcolor{keywordflow}{do} i=isv-1,iev 2000 uhbt(i,j) = find\_uhbt(ubt\_trans(i,j), btcl\_u(i,j)) + uhbt0(i,j) 2001 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2002 \textcolor{keywordflow}{else} 2003 \textcolor{comment}{!$OMP do schedule(static)} 2004 \textcolor{keywordflow}{do} j=jsv,jev ; \textcolor{keywordflow}{do} i=isv-1,iev 2005 uhbt(i,j) = datu(i,j)*ubt\_trans(i,j) + uhbt0(i,j) 2006 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2007 \textcolor{keywordflow}{ endif} 2008 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_u\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! copy back the value for u-points on the boundary.} 2009 \textcolor{comment}{!$OMP do schedule(static)} 2010 \textcolor{keywordflow}{do} j=jsv,jev ; \textcolor{keywordflow}{do} i=isv-1,iev ; \textcolor{keywordflow}{if} (obc%segnum\_u(i,j) /= obc\_none) \textcolor{keywordflow}{then} 2011 ubt(i,j) = ubt\_prev(i,j) ; uhbt(i,j) = uhbt\_prev(i,j) 2012 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2013 \textcolor{keywordflow}{ endif} 2014 \textcolor{keywordflow}{else} 2015 \textcolor{comment}{! On even steps, update u first.} 2016 \textcolor{comment}{!$OMP do schedule(static)} 2017 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev 2018 cor\_u(i,j) = ((azon(i,j) * vbt(i+1,j) + czon(i,j) * vbt(i,j-1)) + & 2019 (bzon(i,j) * vbt(i,j) + dzon(i,j) * vbt(i+1,j-1))) - & 2020 cor\_ref\_u(i,j) 2021 pfu(i,j) = ((eta\_pf\_bt(i,j)-eta\_pf(i,j))*gtot\_e(i,j) - & 2022 (eta\_pf\_bt(i+1,j)-eta\_pf(i+1,j))*gtot\_w(i+1,j)) * & 2023 dgeo\_de * cs%IdxCu(i,j) 2024 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2025 \textcolor{comment}{!$OMP end do nowait} 2026 2027 \textcolor{keywordflow}{if} (cs%dynamic\_psurf) \textcolor{keywordflow}{then} 2028 \textcolor{comment}{!$OMP do schedule(static)} 2029 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev 2030 pfu(i,j) = pfu(i,j) + (p\_surf\_dyn(i,j) - p\_surf\_dyn(i+1,j)) * cs%IdxCu(i,j) 2031 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2032 \textcolor{comment}{!$OMP end do nowait} 2033 \textcolor{keywordflow}{ endif} 2034 2035 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_u\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! zero out pressure force across boundary} 2036 \textcolor{comment}{!$OMP do schedule(static)} 2037 \textcolor{keywordflow}{do} j=jsv,jev ; \textcolor{keywordflow}{do} i=isv-1,iev ; \textcolor{keywordflow}{if} (obc%segnum\_u(i,j) /= obc\_none) \textcolor{keywordflow}{then} 2038 pfu(i,j) = 0.0 2039 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2040 \textcolor{keywordflow}{ endif} 2041 2042 \textcolor{comment}{!$OMP do schedule(static)} 2043 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev 2044 vel\_prev = ubt(i,j) 2045 ubt(i,j) = bt\_rem\_u(i,j) * (ubt(i,j) + & 2046 dtbt * ((bt\_force\_u(i,j) + cor\_u(i,j)) + pfu(i,j))) 2047 \textcolor{keywordflow}{if} (abs(ubt(i,j)) < cs%vel\_underflow) ubt(i,j) = 0.0 2048 ubt\_trans(i,j) = trans\_wt1*ubt(i,j) + trans\_wt2*vel\_prev 2049 2050 \textcolor{keywordflow}{if} (cs%linear\_wave\_drag) \textcolor{keywordflow}{then} 2051 u\_accel\_bt(i,j) = u\_accel\_bt(i,j) + wt\_accel(n) * & 2052 ((cor\_u(i,j) + pfu(i,j)) - ubt(i,j)*rayleigh\_u(i,j)) 2053 \textcolor{keywordflow}{else} 2054 u\_accel\_bt(i,j) = u\_accel\_bt(i,j) + wt\_accel(n) * (cor\_u(i,j) + pfu(i,j)) 2055 \textcolor{keywordflow}{ endif} 2056 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2057 2058 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 2059 \textcolor{comment}{!$OMP do schedule(static)} 2060 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev 2061 ubt\_int(i,j) = ubt\_int(i,j) + dtbt * ubt\_trans(i,j) 2062 uhbt\_int(i,j) = find\_uhbt(ubt\_int(i,j), btcl\_u(i,j)) + n*dtbt*uhbt0(i,j) 2063 \textcolor{comment}{! Estimate the mass flux within a single timestep to take the filtered average.} 2064 uhbt(i,j) = (uhbt\_int(i,j) - uhbt\_int\_prev(i,j)) * idtbt 2065 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2066 \textcolor{keywordflow}{elseif} (use\_bt\_cont) \textcolor{keywordflow}{then} 2067 \textcolor{comment}{!$OMP do schedule(static)} 2068 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev 2069 uhbt(i,j) = find\_uhbt(ubt\_trans(i,j), btcl\_u(i,j)) + uhbt0(i,j) 2070 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2071 \textcolor{comment}{!$OMP end do nowait} 2072 \textcolor{keywordflow}{else} 2073 \textcolor{comment}{!$OMP do schedule(static)} 2074 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev 2075 uhbt(i,j) = datu(i,j)*ubt\_trans(i,j) + uhbt0(i,j) 2076 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2077 \textcolor{comment}{!$OMP end do nowait} 2078 \textcolor{keywordflow}{ endif} 2079 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_u\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! copy back the value for u-points on the boundary.} 2080 \textcolor{comment}{!$OMP do schedule(static)} 2081 \textcolor{keywordflow}{do} j=jsv-1,jev+1 ; \textcolor{keywordflow}{do} i=isv-1,iev ; \textcolor{keywordflow}{if} (obc%segnum\_u(i,j) /= obc\_none) \textcolor{keywordflow}{then} 2082 ubt(i,j) = ubt\_prev(i,j) ; uhbt(i,j) = uhbt\_prev(i,j) 2083 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2084 \textcolor{keywordflow}{ endif} 2085 2086 \textcolor{comment}{! Now update the meridional velocity.} 2087 \textcolor{keywordflow}{if} (cs%use\_old\_coriolis\_bracket\_bug) \textcolor{keywordflow}{then} 2088 \textcolor{comment}{!$OMP do schedule(static)} 2089 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv,iev 2090 cor\_v(i,j) = -1.0*((amer(i-1,j) * ubt(i-1,j) + bmer(i,j) * ubt(i,j)) + & 2091 (cmer(i,j+1) * ubt(i,j+1) + dmer(i-1,j+1) * ubt(i-1,j+1))) - cor\_ref\_v(i,j) 2092 pfv(i,j) = ((eta\_pf\_bt(i,j)-eta\_pf(i,j))*gtot\_n(i,j) - & 2093 (eta\_pf\_bt(i,j+1)-eta\_pf(i,j+1))*gtot\_s(i,j+1)) * & 2094 dgeo\_de * cs%IdyCv(i,j) 2095 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2096 \textcolor{comment}{!$OMP end do nowait} 2097 \textcolor{keywordflow}{else} 2098 \textcolor{comment}{!$OMP do schedule(static)} 2099 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv,iev 2100 cor\_v(i,j) = -1.0*((amer(i-1,j) * ubt(i-1,j) + cmer(i,j+1) * ubt(i,j+1)) + & 2101 (bmer(i,j) * ubt(i,j) + dmer(i-1,j+1) * ubt(i-1,j+1))) - cor\_ref\_v(i,j) 2102 pfv(i,j) = ((eta\_pf\_bt(i,j)-eta\_pf(i,j))*gtot\_n(i,j) - & 2103 (eta\_pf\_bt(i,j+1)-eta\_pf(i,j+1))*gtot\_s(i,j+1)) * & 2104 dgeo\_de * cs%IdyCv(i,j) 2105 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2106 \textcolor{comment}{!$OMP end do nowait} 2107 \textcolor{keywordflow}{ endif} 2108 2109 \textcolor{keywordflow}{if} (cs%dynamic\_psurf) \textcolor{keywordflow}{then} 2110 \textcolor{comment}{!$OMP do schedule(static)} 2111 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv,iev 2112 pfv(i,j) = pfv(i,j) + (p\_surf\_dyn(i,j) - p\_surf\_dyn(i,j+1)) * cs%IdyCv(i,j) 2113 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2114 \textcolor{comment}{!$OMP end do nowait} 2115 \textcolor{keywordflow}{ endif} 2116 2117 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_v\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! zero out PF across boundary} 2118 \textcolor{comment}{!$OMP do schedule(static)} 2119 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv-1,iev+1 ; \textcolor{keywordflow}{if} (obc%segnum\_v(i,j) /= obc\_none) \textcolor{keywordflow}{then} 2120 pfv(i,j) = 0.0 2121 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2122 \textcolor{keywordflow}{ endif} 2123 2124 \textcolor{comment}{!$OMP do schedule(static)} 2125 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv,iev 2126 vel\_prev = vbt(i,j) 2127 vbt(i,j) = bt\_rem\_v(i,j) * (vbt(i,j) + & 2128 dtbt * ((bt\_force\_v(i,j) + cor\_v(i,j)) + pfv(i,j))) 2129 \textcolor{keywordflow}{if} (abs(vbt(i,j)) < cs%vel\_underflow) vbt(i,j) = 0.0 2130 vbt\_trans(i,j) = trans\_wt1*vbt(i,j) + trans\_wt2*vel\_prev 2131 2132 \textcolor{keywordflow}{if} (cs%linear\_wave\_drag) \textcolor{keywordflow}{then} 2133 v\_accel\_bt(i,j) = v\_accel\_bt(i,j) + wt\_accel(n) * & 2134 ((cor\_v(i,j) + pfv(i,j)) - vbt(i,j)*rayleigh\_v(i,j)) 2135 \textcolor{keywordflow}{else} 2136 v\_accel\_bt(i,j) = v\_accel\_bt(i,j) + wt\_accel(n) * (cor\_v(i,j) + pfv(i,j)) 2137 \textcolor{keywordflow}{ endif} 2138 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2139 \textcolor{comment}{!$OMP end do nowait} 2140 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 2141 \textcolor{comment}{!$OMP do schedule(static)} 2142 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv,iev 2143 vbt\_int(i,j) = vbt\_int(i,j) + dtbt * vbt\_trans(i,j) 2144 vhbt\_int(i,j) = find\_vhbt(vbt\_int(i,j), btcl\_v(i,j)) + n*dtbt*vhbt0(i,j) 2145 \textcolor{comment}{! Estimate the mass flux within a single timestep to take the filtered average.} 2146 vhbt(i,j) = (vhbt\_int(i,j) - vhbt\_int\_prev(i,j)) * idtbt 2147 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2148 \textcolor{keywordflow}{elseif} (use\_bt\_cont) \textcolor{keywordflow}{then} 2149 \textcolor{comment}{!$OMP do schedule(static)} 2150 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv,iev 2151 vhbt(i,j) = find\_vhbt(vbt\_trans(i,j), btcl\_v(i,j)) + vhbt0(i,j) 2152 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2153 \textcolor{keywordflow}{else} 2154 \textcolor{comment}{!$OMP do schedule(static)} 2155 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv,iev 2156 vhbt(i,j) = datv(i,j)*vbt\_trans(i,j) + vhbt0(i,j) 2157 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2158 \textcolor{keywordflow}{ endif} 2159 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_v\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! copy back the value for v-points on the boundary.} 2160 \textcolor{comment}{!$OMP do schedule(static)} 2161 \textcolor{keywordflow}{do} j=jsv-1,jev ; \textcolor{keywordflow}{do} i=isv,iev ; \textcolor{keywordflow}{if} (obc%segnum\_v(i,j) /= obc\_none) \textcolor{keywordflow}{then} 2162 vbt(i,j) = vbt\_prev(i,j); vhbt(i,j) = vhbt\_prev(i,j) 2163 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2164 \textcolor{keywordflow}{ endif} 2165 \textcolor{keywordflow}{ endif} 2166 2167 \textcolor{comment}{! This might need to be moved outside of the OMP do loop directives.} 2168 \textcolor{keywordflow}{if} (cs%debug\_bt) \textcolor{keywordflow}{then} 2169 \textcolor{keyword}{write}(mesg,\textcolor{stringliteral}{'("BT vel update ",I4)'}) n 2170 \textcolor{keyword}{call }uvchksum(trim(mesg)//\textcolor{stringliteral}{" PF[uv]"}, pfu, pfv, cs%debug\_BT\_HI, haloshift=iev-ie, & 2171 scale=us%L\_T\_to\_m\_s*us%s\_to\_T) 2172 \textcolor{keyword}{call }uvchksum(trim(mesg)//\textcolor{stringliteral}{" Cor\_[uv]"}, cor\_u, cor\_v, cs%debug\_BT\_HI, haloshift=iev-ie, & 2173 scale=us%L\_T\_to\_m\_s*us%s\_to\_T) 2174 \textcolor{keyword}{call }uvchksum(trim(mesg)//\textcolor{stringliteral}{" BT\_force\_[uv]"}, bt\_force\_u, bt\_force\_v, cs%debug\_BT\_HI, haloshift=iev-ie, & 2175 scale=us%L\_T\_to\_m\_s*us%s\_to\_T) 2176 \textcolor{keyword}{call }uvchksum(trim(mesg)//\textcolor{stringliteral}{" BT\_rem\_[uv]"}, bt\_rem\_u, bt\_rem\_v, cs%debug\_BT\_HI, haloshift=iev-ie) 2177 \textcolor{keyword}{call }uvchksum(trim(mesg)//\textcolor{stringliteral}{" [uv]bt"}, ubt, vbt, cs%debug\_BT\_HI, haloshift=iev-ie, & 2178 scale=us%L\_T\_to\_m\_s) 2179 \textcolor{keyword}{call }uvchksum(trim(mesg)//\textcolor{stringliteral}{" [uv]bt\_trans"}, ubt\_trans, vbt\_trans, cs%debug\_BT\_HI, haloshift=iev-ie, & 2180 scale=us%L\_T\_to\_m\_s) 2181 \textcolor{keyword}{call }uvchksum(trim(mesg)//\textcolor{stringliteral}{" [uv]hbt"}, uhbt, vhbt, cs%debug\_BT\_HI, haloshift=iev-ie, & 2182 scale=us%s\_to\_T*us%L\_to\_m**2*gv%H\_to\_m) 2183 \textcolor{keywordflow}{if} (integral\_bt\_cont) & 2184 \textcolor{keyword}{call }uvchksum(trim(mesg)//\textcolor{stringliteral}{" [uv]hbt\_int"}, uhbt\_int, vhbt\_int, cs%debug\_BT\_HI, haloshift=iev-ie, & 2185 scale=us%L\_to\_m**2*gv%H\_to\_m) 2186 \textcolor{keywordflow}{ endif} 2187 2188 \textcolor{keywordflow}{if} (find\_pf) \textcolor{keywordflow}{then} 2189 \textcolor{comment}{!$OMP do} 2190 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2191 pfu\_bt\_sum(i,j) = pfu\_bt\_sum(i,j) + wt\_accel2(n) * pfu(i,j) 2192 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2193 \textcolor{comment}{!$OMP end do nowait} 2194 \textcolor{comment}{!$OMP do} 2195 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2196 pfv\_bt\_sum(i,j) = pfv\_bt\_sum(i,j) + wt\_accel2(n) * pfv(i,j) 2197 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2198 \textcolor{comment}{!$OMP end do nowait} 2199 \textcolor{keywordflow}{ endif} 2200 \textcolor{keywordflow}{if} (find\_cor) \textcolor{keywordflow}{then} 2201 \textcolor{comment}{!$OMP do} 2202 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2203 coru\_bt\_sum(i,j) = coru\_bt\_sum(i,j) + wt\_accel2(n) * cor\_u(i,j) 2204 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2205 \textcolor{comment}{!$OMP end do nowait} 2206 \textcolor{comment}{!$OMP do} 2207 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2208 corv\_bt\_sum(i,j) = corv\_bt\_sum(i,j) + wt\_accel2(n) * cor\_v(i,j) 2209 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2210 \textcolor{comment}{!$OMP end do nowait} 2211 \textcolor{keywordflow}{ endif} 2212 2213 \textcolor{comment}{!$OMP do} 2214 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2215 ubt\_sum(i,j) = ubt\_sum(i,j) + wt\_trans(n) * ubt\_trans(i,j) 2216 uhbt\_sum(i,j) = uhbt\_sum(i,j) + wt\_trans(n) * uhbt(i,j) 2217 ubt\_wtd(i,j) = ubt\_wtd(i,j) + wt\_vel(n) * ubt(i,j) 2218 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2219 \textcolor{comment}{!$OMP end do nowait} 2220 \textcolor{comment}{!$OMP do} 2221 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2222 vbt\_sum(i,j) = vbt\_sum(i,j) + wt\_trans(n) * vbt\_trans(i,j) 2223 vhbt\_sum(i,j) = vhbt\_sum(i,j) + wt\_trans(n) * vhbt(i,j) 2224 vbt\_wtd(i,j) = vbt\_wtd(i,j) + wt\_vel(n) * vbt(i,j) 2225 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2226 \textcolor{comment}{!$OMP end do nowait} 2227 2228 \textcolor{keywordflow}{if} (apply\_obcs) \textcolor{keywordflow}{then} 2229 2230 \textcolor{comment}{!$OMP single} 2231 \textcolor{keyword}{call }apply\_velocity\_obcs(obc, ubt, vbt, uhbt, vhbt, & 2232 ubt\_trans, vbt\_trans, eta, ubt\_old, vbt\_old, cs%BT\_OBC, & 2233 g, ms, us, iev-ie, dtbt, bebt, use\_bt\_cont, integral\_bt\_cont, & 2234 n*dtbt, datu, datv, btcl\_u, btcl\_v, uhbt0, vhbt0, & 2235 ubt\_int\_prev, vbt\_int\_prev, uhbt\_int\_prev, vhbt\_int\_prev) 2236 \textcolor{comment}{!$OMP end single} 2237 2238 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_u\_OBCs) \textcolor{keywordflow}{then} 2239 \textcolor{comment}{!$OMP do} 2240 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2241 \textcolor{keywordflow}{if} (obc%segnum\_u(i,j) /= obc\_none) \textcolor{keywordflow}{then} 2242 \textcolor{comment}{! Update the summed and integrated quantities from the saved previous values.} 2243 ubt\_sum(i,j) = ubt\_sum\_prev(i,j) + wt\_trans(n) * ubt\_trans(i,j) 2244 uhbt\_sum(i,j) = uhbt\_sum\_prev(i,j) + wt\_trans(n) * uhbt(i,j) 2245 ubt\_wtd(i,j) = ubt\_wtd\_prev(i,j) + wt\_vel(n) * ubt(i,j) 2246 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 2247 uhbt\_int(i,j) = uhbt\_int\_prev(i,j) + dtbt * uhbt(i,j) 2248 ubt\_int(i,j) = ubt\_int\_prev(i,j) + dtbt * ubt\_trans(i,j) 2249 \textcolor{keywordflow}{ endif} 2250 \textcolor{keywordflow}{ endif} 2251 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2252 \textcolor{keywordflow}{ endif} 2253 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_v\_OBCs) \textcolor{keywordflow}{then} 2254 \textcolor{comment}{!$OMP do} 2255 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2256 \textcolor{keywordflow}{if} (obc%segnum\_v(i,j) /= obc\_none) \textcolor{keywordflow}{then} 2257 \textcolor{comment}{! Update the summed and integrated quantities from the saved previous values.} 2258 vbt\_sum(i,j) = vbt\_sum\_prev(i,j) + wt\_trans(n) * vbt\_trans(i,j) 2259 vhbt\_sum(i,j) = vhbt\_sum\_prev(i,j) + wt\_trans(n) * vhbt(i,j) 2260 vbt\_wtd(i,j) = vbt\_wtd\_prev(i,j) + wt\_vel(n) * vbt(i,j) 2261 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 2262 vbt\_int(i,j) = vbt\_int\_prev(i,j) + dtbt * vbt\_trans(i,j) 2263 vhbt\_int(i,j) = vhbt\_int\_prev(i,j) + dtbt * vhbt(i,j) 2264 \textcolor{keywordflow}{ endif} 2265 \textcolor{keywordflow}{ endif} 2266 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2267 \textcolor{keywordflow}{ endif} 2268 \textcolor{keywordflow}{ endif} 2269 2270 \textcolor{keywordflow}{if} (cs%debug\_bt) \textcolor{keywordflow}{then} 2271 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"BT [uv]hbt just after OBC"}, uhbt, vhbt, cs%debug\_BT\_HI, haloshift=iev-ie, & 2272 scale=us%s\_to\_T*us%L\_to\_m**2*gv%H\_to\_m) 2273 \textcolor{keywordflow}{if} (integral\_bt\_cont) & 2274 \textcolor{keyword}{call }uvchksum(\textcolor{stringliteral}{"BT [uv]hbt\_int just after OBC"}, uhbt\_int, vhbt\_int, cs%debug\_BT\_HI, & 2275 haloshift=iev-ie, scale=us%L\_to\_m**2*gv%H\_to\_m) 2276 \textcolor{keywordflow}{ endif} 2277 2278 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 2279 \textcolor{comment}{!$OMP do} 2280 \textcolor{keywordflow}{do} j=jsv,jev ; \textcolor{keywordflow}{do} i=isv,iev 2281 eta(i,j) = (eta\_ic(i,j) + n*eta\_src(i,j)) + cs%IareaT(i,j) * & 2282 ((uhbt\_int(i-1,j) - uhbt\_int(i,j)) + (vhbt\_int(i,j-1) - vhbt\_int(i,j))) 2283 eta\_wtd(i,j) = eta\_wtd(i,j) + eta(i,j) * wt\_eta(n) 2284 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2285 \textcolor{keywordflow}{else} 2286 \textcolor{comment}{!$OMP do} 2287 \textcolor{keywordflow}{do} j=jsv,jev ; \textcolor{keywordflow}{do} i=isv,iev 2288 eta(i,j) = (eta(i,j) + eta\_src(i,j)) + (dtbt * cs%IareaT(i,j)) * & 2289 ((uhbt(i-1,j) - uhbt(i,j)) + (vhbt(i,j-1) - vhbt(i,j))) 2290 eta\_wtd(i,j) = eta\_wtd(i,j) + eta(i,j) * wt\_eta(n) 2291 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2292 \textcolor{keywordflow}{ endif} 2293 \textcolor{comment}{!$OMP end parallel} 2294 2295 \textcolor{keywordflow}{if} (do\_hifreq\_output) \textcolor{keywordflow}{then} 2296 time\_step\_end = time\_bt\_start + real\_to\_time(n*us%T\_to\_s*dtbt) 2297 \textcolor{keyword}{call }enable\_averaging(us%T\_to\_s*dtbt, time\_step\_end, cs%diag) 2298 \textcolor{keywordflow}{if} (cs%id\_ubt\_hifreq > 0) \textcolor{keyword}{call }post\_data(cs%id\_ubt\_hifreq, ubt(isdb:iedb,jsd:jed), cs%diag) 2299 \textcolor{keywordflow}{if} (cs%id\_vbt\_hifreq > 0) \textcolor{keyword}{call }post\_data(cs%id\_vbt\_hifreq, vbt(isd:ied,jsdb:jedb), cs%diag) 2300 \textcolor{keywordflow}{if} (cs%id\_eta\_hifreq > 0) \textcolor{keyword}{call }post\_data(cs%id\_eta\_hifreq, eta(isd:ied,jsd:jed), cs%diag) 2301 \textcolor{keywordflow}{if} (cs%id\_uhbt\_hifreq > 0) \textcolor{keyword}{call }post\_data(cs%id\_uhbt\_hifreq, uhbt(isdb:iedb,jsd:jed), cs%diag) 2302 \textcolor{keywordflow}{if} (cs%id\_vhbt\_hifreq > 0) \textcolor{keyword}{call }post\_data(cs%id\_vhbt\_hifreq, vhbt(isd:ied,jsdb:jedb), cs%diag) 2303 \textcolor{keywordflow}{if} (cs%id\_eta\_pred\_hifreq > 0) \textcolor{keyword}{call }post\_data(cs%id\_eta\_pred\_hifreq, eta\_pf\_bt(isd:ied,jsd:jed), cs %diag) 2304 \textcolor{keywordflow}{ endif} 2305 2306 \textcolor{keywordflow}{if} (cs%debug\_bt) \textcolor{keywordflow}{then} 2307 \textcolor{keyword}{write}(mesg,\textcolor{stringliteral}{'("BT step ",I4)'}) n 2308 \textcolor{keyword}{call }uvchksum(trim(mesg)//\textcolor{stringliteral}{" [uv]bt"}, ubt, vbt, cs%debug\_BT\_HI, haloshift=iev-ie, & 2309 scale=us%L\_T\_to\_m\_s) 2310 \textcolor{keyword}{call }hchksum(eta, trim(mesg)//\textcolor{stringliteral}{" eta"}, cs%debug\_BT\_HI, haloshift=iev-ie, scale=gv%H\_to\_m) 2311 \textcolor{keywordflow}{ endif} 2312 2313 \textcolor{keywordflow}{if} (gv%Boussinesq) \textcolor{keywordflow}{then} 2314 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 2315 \textcolor{keywordflow}{if} (eta(i,j) < -gv%Z\_to\_H*g%bathyT(i,j)) & 2316 \textcolor{keyword}{call }mom\_error(warning, \textcolor{stringliteral}{"btstep: eta has dropped below bathyT."}) 2317 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2318 \textcolor{keywordflow}{else} 2319 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 2320 \textcolor{keywordflow}{if} (eta(i,j) < 0.0) & 2321 \textcolor{keyword}{call }mom\_error(warning, \textcolor{stringliteral}{"btstep: negative eta in a non-Boussinesq barotropic solver."}) 2322 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2323 \textcolor{keywordflow}{ endif} 2324 2325 \textcolor{keywordflow}{ enddo} \textcolor{comment}{! end of do n=1,ntimestep} 2326 \textcolor{keywordflow}{if} (id\_clock\_calc > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc) 2327 \textcolor{keywordflow}{if} (id\_clock\_calc\_post > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc\_post) 2328 2329 \textcolor{comment}{! Reset the time information in the diag type.} 2330 \textcolor{keywordflow}{if} (do\_hifreq\_output) \textcolor{keyword}{call }enable\_averaging(time\_int\_in, time\_end\_in, cs%diag) 2331 2332 \textcolor{keywordflow}{if} (cs%answers\_2018) \textcolor{keywordflow}{then} 2333 i\_sum\_wt\_vel = 1.0 / sum\_wt\_vel ; i\_sum\_wt\_eta = 1.0 / sum\_wt\_eta 2334 i\_sum\_wt\_accel = 1.0 / sum\_wt\_accel ; i\_sum\_wt\_trans = 1.0 / sum\_wt\_trans 2335 \textcolor{keywordflow}{else} 2336 i\_sum\_wt\_vel = 1.0 ; i\_sum\_wt\_eta = 1.0 ; i\_sum\_wt\_accel = 1.0 ; i\_sum\_wt\_trans = 1.0 2337 \textcolor{keywordflow}{ endif} 2338 2339 \textcolor{keywordflow}{if} (find\_etaav) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 2340 etaav(i,j) = eta\_sum(i,j) * i\_sum\_wt\_accel 2341 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ endif} 2342 \textcolor{keywordflow}{do} j=js-1,je+1 ; \textcolor{keywordflow}{do} i=is-1,ie+1 ; e\_anom(i,j) = 0.0 ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2343 \textcolor{keywordflow}{if} (interp\_eta\_pf) \textcolor{keywordflow}{then} 2344 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 2345 e\_anom(i,j) = dgeo\_de * (0.5 * (eta(i,j) + eta\_in(i,j)) - & 2346 (eta\_pf\_1(i,j) + 0.5*d\_eta\_pf(i,j))) 2347 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2348 \textcolor{keywordflow}{else} 2349 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 2350 e\_anom(i,j) = dgeo\_de * (0.5 * (eta(i,j) + eta\_in(i,j)) - eta\_pf(i,j)) 2351 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2352 \textcolor{keywordflow}{ endif} 2353 \textcolor{keywordflow}{if} (apply\_obcs) \textcolor{keywordflow}{then} 2354 \textcolor{comment}{!!! Not safe for wide halos...} 2355 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_u\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! copy back the value for u-points on the boundary.} 2356 \textcolor{comment}{!GOMP parallel do default(shared)} 2357 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2358 l\_seg = obc%segnum\_u(i,j) 2359 \textcolor{keywordflow}{if} (l\_seg == obc\_none) cycle 2360 2361 \textcolor{keywordflow}{if} (obc%segment(l\_seg)%direction == obc\_direction\_e) \textcolor{keywordflow}{then} 2362 e\_anom(i+1,j) = e\_anom(i,j) 2363 \textcolor{keywordflow}{elseif} (obc%segment(l\_seg)%direction == obc\_direction\_w) \textcolor{keywordflow}{then} 2364 e\_anom(i,j) = e\_anom(i+1,j) 2365 \textcolor{keywordflow}{ endif} 2366 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2367 \textcolor{keywordflow}{ endif} 2368 2369 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_v\_OBCs) \textcolor{keywordflow}{then} \textcolor{comment}{! copy back the value for v-points on the boundary.} 2370 \textcolor{comment}{!GOMP parallel do default(shared)} 2371 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2372 l\_seg = obc%segnum\_v(i,j) 2373 \textcolor{keywordflow}{if} (l\_seg == obc\_none) cycle 2374 2375 \textcolor{keywordflow}{if} (obc%segment(l\_seg)%direction == obc\_direction\_n) \textcolor{keywordflow}{then} 2376 e\_anom(i,j+1) = e\_anom(i,j) 2377 \textcolor{keywordflow}{elseif} (obc%segment(l\_seg)%direction == obc\_direction\_s) \textcolor{keywordflow}{then} 2378 e\_anom(i,j) = e\_anom(i,j+1) 2379 \textcolor{keywordflow}{ endif} 2380 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2381 \textcolor{keywordflow}{ endif} 2382 \textcolor{keywordflow}{ endif} 2383 2384 \textcolor{comment}{! It is possible that eta\_out and eta\_in are the same.} 2385 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 2386 eta\_out(i,j) = eta\_wtd(i,j) * i\_sum\_wt\_eta 2387 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2388 2389 \textcolor{keywordflow}{if} (id\_clock\_calc\_post > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc\_post) 2390 \textcolor{keywordflow}{if} (id\_clock\_pass\_post > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_pass\_post) 2391 \textcolor{keywordflow}{if} (g%nonblocking\_updates) \textcolor{keywordflow}{then} 2392 \textcolor{keyword}{call }start\_group\_pass(cs%pass\_e\_anom, g%Domain) 2393 \textcolor{keywordflow}{else} 2394 \textcolor{keywordflow}{if} (find\_etaav) \textcolor{keyword}{call }do\_group\_pass(cs%pass\_etaav, g%Domain) 2395 \textcolor{keyword}{call }do\_group\_pass(cs%pass\_e\_anom, g%Domain) 2396 \textcolor{keywordflow}{ endif} 2397 \textcolor{keywordflow}{if} (id\_clock\_pass\_post > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_pass\_post) 2398 \textcolor{keywordflow}{if} (id\_clock\_calc\_post > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc\_post) 2399 2400 \textcolor{keywordflow}{if} (cs%answers\_2018) \textcolor{keywordflow}{then} 2401 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2402 cs%ubtav(i,j) = ubt\_sum(i,j) * i\_sum\_wt\_trans 2403 uhbtav(i,j) = uhbt\_sum(i,j) * i\_sum\_wt\_trans 2404 ubt\_wtd(i,j) = ubt\_wtd(i,j) * i\_sum\_wt\_vel 2405 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2406 2407 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2408 cs%vbtav(i,j) = vbt\_sum(i,j) * i\_sum\_wt\_trans 2409 vhbtav(i,j) = vhbt\_sum(i,j) * i\_sum\_wt\_trans 2410 vbt\_wtd(i,j) = vbt\_wtd(i,j) * i\_sum\_wt\_vel 2411 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2412 \textcolor{keywordflow}{else} 2413 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2414 cs%ubtav(i,j) = ubt\_sum(i,j) 2415 uhbtav(i,j) = uhbt\_sum(i,j) 2416 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2417 2418 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2419 cs%vbtav(i,j) = vbt\_sum(i,j) 2420 vhbtav(i,j) = vhbt\_sum(i,j) 2421 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2422 \textcolor{keywordflow}{ endif} 2423 2424 2425 \textcolor{keywordflow}{if} (id\_clock\_calc\_post > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc\_post) 2426 \textcolor{keywordflow}{if} (id\_clock\_pass\_post > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_pass\_post) 2427 \textcolor{keywordflow}{if} (g%nonblocking\_updates) \textcolor{keywordflow}{then} 2428 \textcolor{keyword}{call }complete\_group\_pass(cs%pass\_e\_anom, g%Domain) 2429 \textcolor{keywordflow}{if} (find\_etaav) \textcolor{keyword}{call }start\_group\_pass(cs%pass\_etaav, g%Domain) 2430 \textcolor{keyword}{call }start\_group\_pass(cs%pass\_ubta\_uhbta, g%DoMain) 2431 \textcolor{keywordflow}{else} 2432 \textcolor{keyword}{call }do\_group\_pass(cs%pass\_ubta\_uhbta, g%Domain) 2433 \textcolor{keywordflow}{ endif} 2434 \textcolor{keywordflow}{if} (id\_clock\_pass\_post > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_pass\_post) 2435 \textcolor{keywordflow}{if} (id\_clock\_calc\_post > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc\_post) 2436 2437 \textcolor{comment}{! Now calculate each layer's accelerations.} 2438 \textcolor{comment}{!$OMP parallel do default(shared)} 2439 \textcolor{keywordflow}{do} k=1,nz 2440 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2441 accel\_layer\_u(i,j,k) = (u\_accel\_bt(i,j) - & 2442 ((pbce(i+1,j,k) - gtot\_w(i+1,j)) * e\_anom(i+1,j) - & 2443 (pbce(i,j,k) - gtot\_e(i,j)) * e\_anom(i,j)) * cs%IdxCu(i,j) ) 2444 \textcolor{keywordflow}{if} (abs(accel\_layer\_u(i,j,k)) < accel\_underflow) accel\_layer\_u(i,j,k) = 0.0 2445 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2446 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2447 accel\_layer\_v(i,j,k) = (v\_accel\_bt(i,j) - & 2448 ((pbce(i,j+1,k) - gtot\_s(i,j+1)) * e\_anom(i,j+1) - & 2449 (pbce(i,j,k) - gtot\_n(i,j)) * e\_anom(i,j)) * cs%IdyCv(i,j) ) 2450 \textcolor{keywordflow}{if} (abs(accel\_layer\_v(i,j,k)) < accel\_underflow) accel\_layer\_v(i,j,k) = 0.0 2451 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2452 \textcolor{keywordflow}{ enddo} 2453 2454 \textcolor{keywordflow}{if} (apply\_obcs) \textcolor{keywordflow}{then} 2455 \textcolor{comment}{! Correct the accelerations at OBC velocity points, but only in the} 2456 \textcolor{comment}{! symmetric-memory computational domain, not in the wide halo regions.} 2457 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_u\_OBCs) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2458 \textcolor{keywordflow}{if} (obc%segnum\_u(i,j) /= obc\_none) \textcolor{keywordflow}{then} 2459 u\_accel\_bt(i,j) = (ubt\_wtd(i,j) - ubt\_first(i,j)) / dt 2460 \textcolor{keywordflow}{do} k=1,nz ; accel\_layer\_u(i,j,k) = u\_accel\_bt(i,j) ;\textcolor{keywordflow}{ enddo} 2461 \textcolor{keywordflow}{ endif} 2462 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ endif} 2463 \textcolor{keywordflow}{if} (cs%BT\_OBC%apply\_v\_OBCs) \textcolor{keywordflow}{then} ; \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2464 \textcolor{keywordflow}{if} (obc%segnum\_v(i,j) /= obc\_none) \textcolor{keywordflow}{then} 2465 v\_accel\_bt(i,j) = (vbt\_wtd(i,j) - vbt\_first(i,j)) / dt 2466 \textcolor{keywordflow}{do} k=1,nz ; accel\_layer\_v(i,j,k) = v\_accel\_bt(i,j) ;\textcolor{keywordflow}{ enddo} 2467 \textcolor{keywordflow}{ endif} 2468 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ endif} 2469 \textcolor{keywordflow}{ endif} 2470 2471 \textcolor{keywordflow}{if} (id\_clock\_calc\_post > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc\_post) 2472 2473 \textcolor{comment}{! Calculate diagnostic quantities.} 2474 \textcolor{keywordflow}{if} (query\_averaging\_enabled(cs%diag)) \textcolor{keywordflow}{then} 2475 2476 \textcolor{keywordflow}{if} (cs%gradual\_BT\_ICs) \textcolor{keywordflow}{then} 2477 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; cs%ubt\_IC(i,j) = ubt\_wtd(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2478 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; cs%vbt\_IC(i,j) = vbt\_wtd(i,j) ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2479 \textcolor{keywordflow}{ endif} 2480 2481 \textcolor{comment}{! Offer various barotropic terms for averaging.} 2482 \textcolor{keywordflow}{if} (cs%id\_PFu\_bt > 0) \textcolor{keywordflow}{then} 2483 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2484 pfu\_bt\_sum(i,j) = pfu\_bt\_sum(i,j) * i\_sum\_wt\_accel 2485 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2486 \textcolor{keyword}{call }post\_data(cs%id\_PFu\_bt, pfu\_bt\_sum(isdb:iedb,jsd:jed), cs%diag) 2487 \textcolor{keywordflow}{ endif} 2488 \textcolor{keywordflow}{if} (cs%id\_PFv\_bt > 0) \textcolor{keywordflow}{then} 2489 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2490 pfv\_bt\_sum(i,j) = pfv\_bt\_sum(i,j) * i\_sum\_wt\_accel 2491 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2492 \textcolor{keyword}{call }post\_data(cs%id\_PFv\_bt, pfv\_bt\_sum(isd:ied,jsdb:jedb), cs%diag) 2493 \textcolor{keywordflow}{ endif} 2494 \textcolor{keywordflow}{if} (cs%id\_Coru\_bt > 0) \textcolor{keywordflow}{then} 2495 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2496 coru\_bt\_sum(i,j) = coru\_bt\_sum(i,j) * i\_sum\_wt\_accel 2497 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2498 \textcolor{keyword}{call }post\_data(cs%id\_Coru\_bt, coru\_bt\_sum(isdb:iedb,jsd:jed), cs%diag) 2499 \textcolor{keywordflow}{ endif} 2500 \textcolor{keywordflow}{if} (cs%id\_Corv\_bt > 0) \textcolor{keywordflow}{then} 2501 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2502 corv\_bt\_sum(i,j) = corv\_bt\_sum(i,j) * i\_sum\_wt\_accel 2503 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2504 \textcolor{keyword}{call }post\_data(cs%id\_Corv\_bt, corv\_bt\_sum(isd:ied,jsdb:jedb), cs%diag) 2505 \textcolor{keywordflow}{ endif} 2506 \textcolor{keywordflow}{if} (cs%id\_ubtdt > 0) \textcolor{keywordflow}{then} 2507 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2508 ubt\_dt(i,j) = (ubt\_wtd(i,j) - ubt\_st(i,j))*idt 2509 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2510 \textcolor{keyword}{call }post\_data(cs%id\_ubtdt, ubt\_dt(isdb:iedb,jsd:jed), cs%diag) 2511 \textcolor{keywordflow}{ endif} 2512 \textcolor{keywordflow}{if} (cs%id\_vbtdt > 0) \textcolor{keywordflow}{then} 2513 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2514 vbt\_dt(i,j) = (vbt\_wtd(i,j) - vbt\_st(i,j))*idt 2515 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2516 \textcolor{keyword}{call }post\_data(cs%id\_vbtdt, vbt\_dt(isd:ied,jsdb:jedb), cs%diag) 2517 \textcolor{keywordflow}{ endif} 2518 2519 \textcolor{keywordflow}{if} (cs%id\_ubtforce > 0) \textcolor{keyword}{call }post\_data(cs%id\_ubtforce, bt\_force\_u(isdb:iedb,jsd:jed), cs%diag) 2520 \textcolor{keywordflow}{if} (cs%id\_vbtforce > 0) \textcolor{keyword}{call }post\_data(cs%id\_vbtforce, bt\_force\_v(isd:ied,jsdb:jedb), cs%diag) 2521 \textcolor{keywordflow}{if} (cs%id\_uaccel > 0) \textcolor{keyword}{call }post\_data(cs%id\_uaccel, u\_accel\_bt(isdb:iedb,jsd:jed), cs%diag) 2522 \textcolor{keywordflow}{if} (cs%id\_vaccel > 0) \textcolor{keyword}{call }post\_data(cs%id\_vaccel, v\_accel\_bt(isd:ied,jsdb:jedb), cs%diag) 2523 2524 \textcolor{keywordflow}{if} (cs%id\_eta\_cor > 0) \textcolor{keyword}{call }post\_data(cs%id\_eta\_cor, cs%eta\_cor, cs%diag) 2525 \textcolor{keywordflow}{if} (cs%id\_eta\_bt > 0) \textcolor{keyword}{call }post\_data(cs%id\_eta\_bt, eta\_out, cs%diag) 2526 \textcolor{keywordflow}{if} (cs%id\_gtotn > 0) \textcolor{keyword}{call }post\_data(cs%id\_gtotn, gtot\_n(isd:ied,jsd:jed), cs%diag) 2527 \textcolor{keywordflow}{if} (cs%id\_gtots > 0) \textcolor{keyword}{call }post\_data(cs%id\_gtots, gtot\_s(isd:ied,jsd:jed), cs%diag) 2528 \textcolor{keywordflow}{if} (cs%id\_gtote > 0) \textcolor{keyword}{call }post\_data(cs%id\_gtote, gtot\_e(isd:ied,jsd:jed), cs%diag) 2529 \textcolor{keywordflow}{if} (cs%id\_gtotw > 0) \textcolor{keyword}{call }post\_data(cs%id\_gtotw, gtot\_w(isd:ied,jsd:jed), cs%diag) 2530 \textcolor{keywordflow}{if} (cs%id\_ubt > 0) \textcolor{keyword}{call }post\_data(cs%id\_ubt, ubt\_wtd(isdb:iedb,jsd:jed), cs%diag) 2531 \textcolor{keywordflow}{if} (cs%id\_vbt > 0) \textcolor{keyword}{call }post\_data(cs%id\_vbt, vbt\_wtd(isd:ied,jsdb:jedb), cs%diag) 2532 \textcolor{keywordflow}{if} (cs%id\_ubtav > 0) \textcolor{keyword}{call }post\_data(cs%id\_ubtav, cs%ubtav, cs%diag) 2533 \textcolor{keywordflow}{if} (cs%id\_vbtav > 0) \textcolor{keyword}{call }post\_data(cs%id\_vbtav, cs%vbtav, cs%diag) 2534 \textcolor{keywordflow}{if} (cs%id\_visc\_rem\_u > 0) \textcolor{keyword}{call }post\_data(cs%id\_visc\_rem\_u, visc\_rem\_u, cs%diag) 2535 \textcolor{keywordflow}{if} (cs%id\_visc\_rem\_v > 0) \textcolor{keyword}{call }post\_data(cs%id\_visc\_rem\_v, visc\_rem\_v, cs%diag) 2536 2537 \textcolor{keywordflow}{if} (cs%id\_frhatu > 0) \textcolor{keyword}{call }post\_data(cs%id\_frhatu, cs%frhatu, cs%diag) 2538 \textcolor{keywordflow}{if} (cs%id\_uhbt > 0) \textcolor{keyword}{call }post\_data(cs%id\_uhbt, uhbtav, cs%diag) 2539 \textcolor{keywordflow}{if} (cs%id\_frhatv > 0) \textcolor{keyword}{call }post\_data(cs%id\_frhatv, cs%frhatv, cs%diag) 2540 \textcolor{keywordflow}{if} (cs%id\_vhbt > 0) \textcolor{keyword}{call }post\_data(cs%id\_vhbt, vhbtav, cs%diag) 2541 \textcolor{keywordflow}{if} (cs%id\_uhbt0 > 0) \textcolor{keyword}{call }post\_data(cs%id\_uhbt0, uhbt0(isdb:iedb,jsd:jed), cs%diag) 2542 \textcolor{keywordflow}{if} (cs%id\_vhbt0 > 0) \textcolor{keyword}{call }post\_data(cs%id\_vhbt0, vhbt0(isd:ied,jsdb:jedb), cs%diag) 2543 2544 \textcolor{keywordflow}{if} (cs%id\_frhatu1 > 0) \textcolor{keyword}{call }post\_data(cs%id\_frhatu1, cs%frhatu1, cs%diag) 2545 \textcolor{keywordflow}{if} (cs%id\_frhatv1 > 0) \textcolor{keyword}{call }post\_data(cs%id\_frhatv1, cs%frhatv1, cs%diag) 2546 2547 \textcolor{keywordflow}{if} (use\_bt\_cont) \textcolor{keywordflow}{then} 2548 \textcolor{keywordflow}{if} (cs%id\_BTC\_FA\_u\_EE > 0) \textcolor{keyword}{call }post\_data(cs%id\_BTC\_FA\_u\_EE, bt\_cont%FA\_u\_EE, cs%diag) 2549 \textcolor{keywordflow}{if} (cs%id\_BTC\_FA\_u\_E0 > 0) \textcolor{keyword}{call }post\_data(cs%id\_BTC\_FA\_u\_E0, bt\_cont%FA\_u\_E0, cs%diag) 2550 \textcolor{keywordflow}{if} (cs%id\_BTC\_FA\_u\_W0 > 0) \textcolor{keyword}{call }post\_data(cs%id\_BTC\_FA\_u\_W0, bt\_cont%FA\_u\_W0, cs%diag) 2551 \textcolor{keywordflow}{if} (cs%id\_BTC\_FA\_u\_WW > 0) \textcolor{keyword}{call }post\_data(cs%id\_BTC\_FA\_u\_WW, bt\_cont%FA\_u\_WW, cs%diag) 2552 \textcolor{keywordflow}{if} (cs%id\_BTC\_uBT\_EE > 0) \textcolor{keyword}{call }post\_data(cs%id\_BTC\_uBT\_EE, bt\_cont%uBT\_EE, cs%diag) 2553 \textcolor{keywordflow}{if} (cs%id\_BTC\_uBT\_WW > 0) \textcolor{keyword}{call }post\_data(cs%id\_BTC\_uBT\_WW, bt\_cont%uBT\_WW, cs%diag) 2554 \textcolor{keywordflow}{if} (cs%id\_BTC\_FA\_u\_rat0 > 0) \textcolor{keywordflow}{then} 2555 tmp\_u(:,:) = 0.0 2556 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2557 \textcolor{keywordflow}{if} ((g%mask2dCu(i,j) > 0.0) .and. (bt\_cont%FA\_u\_W0(i,j) > 0.0)) \textcolor{keywordflow}{then} 2558 tmp\_u(i,j) = (bt\_cont%FA\_u\_E0(i,j)/ bt\_cont%FA\_u\_W0(i,j)) 2559 \textcolor{keywordflow}{else} 2560 tmp\_u(i,j) = 1.0 2561 \textcolor{keywordflow}{ endif} 2562 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2563 \textcolor{keyword}{call }post\_data(cs%id\_BTC\_FA\_u\_rat0, tmp\_u, cs%diag) 2564 \textcolor{keywordflow}{ endif} 2565 \textcolor{keywordflow}{if} (cs%id\_BTC\_FA\_v\_NN > 0) \textcolor{keyword}{call }post\_data(cs%id\_BTC\_FA\_v\_NN, bt\_cont%FA\_v\_NN, cs%diag) 2566 \textcolor{keywordflow}{if} (cs%id\_BTC\_FA\_v\_N0 > 0) \textcolor{keyword}{call }post\_data(cs%id\_BTC\_FA\_v\_N0, bt\_cont%FA\_v\_N0, cs%diag) 2567 \textcolor{keywordflow}{if} (cs%id\_BTC\_FA\_v\_S0 > 0) \textcolor{keyword}{call }post\_data(cs%id\_BTC\_FA\_v\_S0, bt\_cont%FA\_v\_S0, cs%diag) 2568 \textcolor{keywordflow}{if} (cs%id\_BTC\_FA\_v\_SS > 0) \textcolor{keyword}{call }post\_data(cs%id\_BTC\_FA\_v\_SS, bt\_cont%FA\_v\_SS, cs%diag) 2569 \textcolor{keywordflow}{if} (cs%id\_BTC\_vBT\_NN > 0) \textcolor{keyword}{call }post\_data(cs%id\_BTC\_vBT\_NN, bt\_cont%vBT\_NN, cs%diag) 2570 \textcolor{keywordflow}{if} (cs%id\_BTC\_vBT\_SS > 0) \textcolor{keyword}{call }post\_data(cs%id\_BTC\_vBT\_SS, bt\_cont%vBT\_SS, cs%diag) 2571 \textcolor{keywordflow}{if} (cs%id\_BTC\_FA\_v\_rat0 > 0) \textcolor{keywordflow}{then} 2572 tmp\_v(:,:) = 0.0 2573 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2574 \textcolor{keywordflow}{if} ((g%mask2dCv(i,j) > 0.0) .and. (bt\_cont%FA\_v\_S0(i,j) > 0.0)) \textcolor{keywordflow}{then} 2575 tmp\_v(i,j) = (bt\_cont%FA\_v\_N0(i,j)/ bt\_cont%FA\_v\_S0(i,j)) 2576 \textcolor{keywordflow}{else} 2577 tmp\_v(i,j) = 1.0 2578 \textcolor{keywordflow}{ endif} 2579 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2580 \textcolor{keyword}{call }post\_data(cs%id\_BTC\_FA\_v\_rat0, tmp\_v, cs%diag) 2581 \textcolor{keywordflow}{ endif} 2582 \textcolor{keywordflow}{if} (cs%id\_BTC\_FA\_h\_rat0 > 0) \textcolor{keywordflow}{then} 2583 tmp\_h(:,:) = 0.0 2584 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 2585 tmp\_h(i,j) = 1.0 2586 \textcolor{keywordflow}{if} ((g%mask2dCu(i,j) > 0.0) .and. (bt\_cont%FA\_u\_W0(i,j) > 0.0) .and. (bt\_cont%FA\_u\_E0(i,j) > 0.0) ) \textcolor{keywordflow}{then} 2587 \textcolor{keywordflow}{if} (bt\_cont%FA\_u\_W0(i,j) > bt\_cont%FA\_u\_E0(i,j)) \textcolor{keywordflow}{then} 2588 tmp\_h(i,j) = max(tmp\_h(i,j), (bt\_cont%FA\_u\_W0(i,j)/ bt\_cont%FA\_u\_E0(i,j))) 2589 \textcolor{keywordflow}{else} 2590 tmp\_h(i,j) = max(tmp\_h(i,j), (bt\_cont%FA\_u\_E0(i,j)/ bt\_cont%FA\_u\_W0(i,j))) 2591 \textcolor{keywordflow}{ endif} 2592 \textcolor{keywordflow}{ endif} 2593 \textcolor{keywordflow}{if} ((g%mask2dCu(i-1,j) > 0.0) .and. (bt\_cont%FA\_u\_W0(i-1,j) > 0.0) .and. (bt\_cont%FA\_u\_E0(i-1,j) > 0.0)) \textcolor{keywordflow}{then} 2594 \textcolor{keywordflow}{if} (bt\_cont%FA\_u\_W0(i-1,j) > bt\_cont%FA\_u\_E0(i-1,j)) \textcolor{keywordflow}{then} 2595 tmp\_h(i,j) = max(tmp\_h(i,j), (bt\_cont%FA\_u\_W0(i-1,j)/ bt\_cont%FA\_u\_E0(i-1,j))) 2596 \textcolor{keywordflow}{else} 2597 tmp\_h(i,j) = max(tmp\_h(i,j), (bt\_cont%FA\_u\_E0(i-1,j)/ bt\_cont%FA\_u\_W0(i-1,j))) 2598 \textcolor{keywordflow}{ endif} 2599 \textcolor{keywordflow}{ endif} 2600 \textcolor{keywordflow}{if} ((g%mask2dCv(i,j) > 0.0) .and. (bt\_cont%FA\_v\_S0(i,j) > 0.0) .and. (bt\_cont%FA\_v\_N0(i,j) > 0.0) ) \textcolor{keywordflow}{then} 2601 \textcolor{keywordflow}{if} (bt\_cont%FA\_v\_S0(i,j) > bt\_cont%FA\_v\_N0(i,j)) \textcolor{keywordflow}{then} 2602 tmp\_h(i,j) = max(tmp\_h(i,j), (bt\_cont%FA\_v\_S0(i,j)/ bt\_cont%FA\_v\_N0(i,j))) 2603 \textcolor{keywordflow}{else} 2604 tmp\_h(i,j) = max(tmp\_h(i,j), (bt\_cont%FA\_v\_N0(i,j)/ bt\_cont%FA\_v\_S0(i,j))) 2605 \textcolor{keywordflow}{ endif} 2606 \textcolor{keywordflow}{ endif} 2607 \textcolor{keywordflow}{if} ((g%mask2dCv(i,j-1) > 0.0) .and. (bt\_cont%FA\_v\_S0(i,j-1) > 0.0) .and. (bt\_cont%FA\_v\_N0(i,j-1) > 0.0)) \textcolor{keywordflow}{then} 2608 \textcolor{keywordflow}{if} (bt\_cont%FA\_v\_S0(i,j-1) > bt\_cont%FA\_v\_N0(i,j-1)) \textcolor{keywordflow}{then} 2609 tmp\_h(i,j) = max(tmp\_h(i,j), (bt\_cont%FA\_v\_S0(i,j-1)/ bt\_cont%FA\_v\_N0(i,j-1))) 2610 \textcolor{keywordflow}{else} 2611 tmp\_h(i,j) = max(tmp\_h(i,j), (bt\_cont%FA\_v\_N0(i,j-1)/ bt\_cont%FA\_v\_S0(i,j-1))) 2612 \textcolor{keywordflow}{ endif} 2613 \textcolor{keywordflow}{ endif} 2614 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2615 \textcolor{keyword}{call }post\_data(cs%id\_BTC\_FA\_h\_rat0, tmp\_h, cs%diag) 2616 \textcolor{keywordflow}{ endif} 2617 \textcolor{keywordflow}{ endif} 2618 \textcolor{keywordflow}{else} 2619 \textcolor{keywordflow}{if} (cs%id\_frhatu1 > 0) cs%frhatu1(:,:,:) = cs%frhatu(:,:,:) 2620 \textcolor{keywordflow}{if} (cs%id\_frhatv1 > 0) cs%frhatv1(:,:,:) = cs%frhatv(:,:,:) 2621 \textcolor{keywordflow}{ endif} 2622 2623 \textcolor{keywordflow}{if} ((\textcolor{keyword}{present}(adp)) .and. (\textcolor{keyword}{associated}(adp%diag\_hfrac\_u))) \textcolor{keywordflow}{then} 2624 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie 2625 adp%diag\_hfrac\_u(i,j,k) = cs%frhatu(i,j,k) 2626 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2627 \textcolor{keywordflow}{ endif} 2628 \textcolor{keywordflow}{if} ((\textcolor{keyword}{present}(adp)) .and. (\textcolor{keyword}{associated}(adp%diag\_hfrac\_v))) \textcolor{keywordflow}{then} 2629 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie 2630 adp%diag\_hfrac\_v(i,j,k) = cs%frhatv(i,j,k) 2631 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2632 \textcolor{keywordflow}{ endif} 2633 2634 \textcolor{keywordflow}{if} (g%nonblocking\_updates) \textcolor{keywordflow}{then} 2635 \textcolor{keywordflow}{if} (find\_etaav) \textcolor{keyword}{call }complete\_group\_pass(cs%pass\_etaav, g%Domain) 2636 \textcolor{keyword}{call }complete\_group\_pass(cs%pass\_ubta\_uhbta, g%Domain) 2637 \textcolor{keywordflow}{ endif} 2638 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_ac8250401fa646cce0f3108587caf19be}\label{namespacemom__barotropic_ac8250401fa646cce0f3108587caf19be}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!destroy\+\_\+bt\+\_\+obc@{destroy\+\_\+bt\+\_\+obc}} \index{destroy\+\_\+bt\+\_\+obc@{destroy\+\_\+bt\+\_\+obc}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{destroy\+\_\+bt\+\_\+obc()}{destroy\_bt\_obc()}} {\footnotesize\ttfamily subroutine mom\+\_\+barotropic\+::destroy\+\_\+bt\+\_\+obc (\begin{DoxyParamCaption}\item[{type(\hyperlink{structmom__barotropic_1_1bt__obc__type}{bt\+\_\+obc\+\_\+type}), intent(inout)}]{B\+T\+\_\+\+O\+BC }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} Clean up the B\+T\+\_\+\+O\+BC memory. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in,out} & {\em bt\+\_\+obc} & A structure with the private barotropic arrays related to the open boundary conditions, set by set\+\_\+up\+\_\+\+B\+T\+\_\+\+O\+BC. \\ \hline \end{DoxyParams} Definition at line 3158 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 3158 \textcolor{keywordtype}{type}(bt\_obc\_type), \textcolor{keywordtype}{intent(inout)} :: bt\_obc\textcolor{comment}{ !< A structure with the private barotropic arrays} 3159 \textcolor{comment}{ !! related to the open boundary conditions,} 3160 \textcolor{comment}{ !! set by set\_up\_BT\_OBC.} 3161 3162 \textcolor{keywordflow}{if} (bt\_obc%is\_alloced) \textcolor{keywordflow}{then} 3163 \textcolor{keyword}{deallocate}(bt\_obc%Cg\_u) 3164 \textcolor{keyword}{deallocate}(bt\_obc%H\_u) 3165 \textcolor{keyword}{deallocate}(bt\_obc%uhbt) 3166 \textcolor{keyword}{deallocate}(bt\_obc%ubt\_outer) 3167 \textcolor{keyword}{deallocate}(bt\_obc%eta\_outer\_u) 3168 3169 \textcolor{keyword}{deallocate}(bt\_obc%Cg\_v) 3170 \textcolor{keyword}{deallocate}(bt\_obc%H\_v) 3171 \textcolor{keyword}{deallocate}(bt\_obc%vhbt) 3172 \textcolor{keyword}{deallocate}(bt\_obc%vbt\_outer) 3173 \textcolor{keyword}{deallocate}(bt\_obc%eta\_outer\_v) 3174 bt\_obc%is\_alloced = .false. 3175 \textcolor{keywordflow}{ endif} \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_abcc5b7bef6e5c17630b05962d61995e3}\label{namespacemom__barotropic_abcc5b7bef6e5c17630b05962d61995e3}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!find\+\_\+duhbt\+\_\+du@{find\+\_\+duhbt\+\_\+du}} \index{find\+\_\+duhbt\+\_\+du@{find\+\_\+duhbt\+\_\+du}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{find\+\_\+duhbt\+\_\+du()}{find\_duhbt\_du()}} {\footnotesize\ttfamily real function mom\+\_\+barotropic\+::find\+\_\+duhbt\+\_\+du (\begin{DoxyParamCaption}\item[{real, intent(in)}]{u, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__u__type}{local\+\_\+bt\+\_\+cont\+\_\+u\+\_\+type}), intent(in)}]{B\+TC }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} The function find\+\_\+duhbt\+\_\+du determines the marginal zonal face area for a given velocity, or with I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT=True for a given time-\/integrated velocity. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in} & {\em u} & The local zonal velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]} or time integrated velocity \mbox{[}L $\sim$$>$ m\mbox{]}\\ \hline \mbox{\tt in} & {\em btc} & A structure containing various fields that allow the barotropic transports to be calculated consistently with the layers\textquotesingle{} continuity equations. The dimensions of some of the elements in this type vary depending on I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT.\\ \hline \end{DoxyParams} \begin{DoxyReturn}{Returns} The zonal barotropic face area \mbox{[}L H $\sim$$>$ m2\mbox{]} \end{DoxyReturn} Definition at line 3484 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 3484 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(in)} :: u\textcolor{comment}{ !< The local zonal velocity [L T-1 ~> m s-1] or time integrated velocity [L ~> m]} 3485 \textcolor{keywordtype}{type}(local\_bt\_cont\_u\_type), \textcolor{keywordtype}{intent(in)} :: btc\textcolor{comment}{ !< A structure containing various fields that} 3486 \textcolor{comment}{ !! allow the barotropic transports to be calculated consistently} 3487 \textcolor{comment}{ !! with the layers' continuity equations. The dimensions of some} 3488 \textcolor{comment}{ !! of the elements in this type vary depending on INTEGRAL\_BT\_CONT.} 3489 \textcolor{keywordtype}{real} :: duhbt\_du\textcolor{comment}{ !< The zonal barotropic face area [L H ~> m2]} 3490 3491 \textcolor{keywordflow}{if} (u == 0.0) \textcolor{keywordflow}{then} 3492 duhbt\_du = 0.5*(btc%FA\_u\_E0 + btc%FA\_u\_W0) \textcolor{comment}{! Note the potential discontinuity here.} 3493 \textcolor{keywordflow}{elseif} (u < btc%uBT\_EE) \textcolor{keywordflow}{then} 3494 duhbt\_du = btc%FA\_u\_EE 3495 \textcolor{keywordflow}{elseif} (u < 0.0) \textcolor{keywordflow}{then} 3496 duhbt\_du = (btc%FA\_u\_E0 + 3.0*btc%uh\_crvE * u**2) 3497 \textcolor{keywordflow}{elseif} (u <= btc%uBT\_WW) \textcolor{keywordflow}{then} 3498 duhbt\_du = (btc%FA\_u\_W0 + 3.0*btc%uh\_crvW * u**2) 3499 \textcolor{keywordflow}{else} \textcolor{comment}{! (u > BTC%uBT\_WW)} 3500 duhbt\_du = btc%FA\_u\_WW 3501 \textcolor{keywordflow}{ endif} 3502 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_a951d827a745c277e8950a091c060ee86}\label{namespacemom__barotropic_a951d827a745c277e8950a091c060ee86}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!find\+\_\+dvhbt\+\_\+dv@{find\+\_\+dvhbt\+\_\+dv}} \index{find\+\_\+dvhbt\+\_\+dv@{find\+\_\+dvhbt\+\_\+dv}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{find\+\_\+dvhbt\+\_\+dv()}{find\_dvhbt\_dv()}} {\footnotesize\ttfamily real function mom\+\_\+barotropic\+::find\+\_\+dvhbt\+\_\+dv (\begin{DoxyParamCaption}\item[{real, intent(in)}]{v, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__v__type}{local\+\_\+bt\+\_\+cont\+\_\+v\+\_\+type}), intent(in)}]{B\+TC }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} The function find\+\_\+dvhbt\+\_\+dv determines the marginal meridional face area for a given velocity, or with I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT=True for a given time-\/integrated velocity. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in} & {\em v} & The local meridional velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]} or time integrated velocity \mbox{[}L $\sim$$>$ m\mbox{]}\\ \hline \mbox{\tt in} & {\em btc} & A structure containing various fields that allow the barotropic transports to be calculated consistently with the layers\textquotesingle{} continuity equations. The dimensions of some of the elements in this type vary depending on I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT.\\ \hline \end{DoxyParams} \begin{DoxyReturn}{Returns} The meridional barotropic face area \mbox{[}L H $\sim$$>$ m2\mbox{]} \end{DoxyReturn} Definition at line 3633 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 3633 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(in)} :: v\textcolor{comment}{ !< The local meridional velocity [L T-1 ~> m s-1] or time integrated velocity [L ~> m]} 3634 \textcolor{keywordtype}{type}(local\_bt\_cont\_v\_type), \textcolor{keywordtype}{intent(in)} :: btc\textcolor{comment}{ !< A structure containing various fields that} 3635 \textcolor{comment}{ !! allow the barotropic transports to be calculated consistently} 3636 \textcolor{comment}{ !! with the layers' continuity equations. The dimensions of some} 3637 \textcolor{comment}{ !! of the elements in this type vary depending on INTEGRAL\_BT\_CONT.} 3638 \textcolor{keywordtype}{real} :: dvhbt\_dv\textcolor{comment}{ !< The meridional barotropic face area [L H ~> m2]} 3639 3640 \textcolor{keywordflow}{if} (v == 0.0) \textcolor{keywordflow}{then} 3641 dvhbt\_dv = 0.5*(btc%FA\_v\_N0 + btc%FA\_v\_S0) \textcolor{comment}{! Note the potential discontinuity here.} 3642 \textcolor{keywordflow}{elseif} (v < btc%vBT\_NN) \textcolor{keywordflow}{then} 3643 dvhbt\_dv = btc%FA\_v\_NN 3644 \textcolor{keywordflow}{elseif} (v < 0.0) \textcolor{keywordflow}{then} 3645 dvhbt\_dv = btc%FA\_v\_N0 + 3.0*btc%vh\_crvN * v**2 3646 \textcolor{keywordflow}{elseif} (v <= btc%vBT\_SS) \textcolor{keywordflow}{then} 3647 dvhbt\_dv = btc%FA\_v\_S0 + 3.0*btc%vh\_crvS * v**2 3648 \textcolor{keywordflow}{else} \textcolor{comment}{! (v > BTC%vBT\_SS)} 3649 dvhbt\_dv = btc%FA\_v\_SS 3650 \textcolor{keywordflow}{ endif} 3651 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_aba29d11dc2530622be997c069fb932ae}\label{namespacemom__barotropic_aba29d11dc2530622be997c069fb932ae}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!find\+\_\+face\+\_\+areas@{find\+\_\+face\+\_\+areas}} \index{find\+\_\+face\+\_\+areas@{find\+\_\+face\+\_\+areas}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{find\+\_\+face\+\_\+areas()}{find\_face\_areas()}} {\footnotesize\ttfamily subroutine mom\+\_\+barotropic\+::find\+\_\+face\+\_\+areas (\begin{DoxyParamCaption}\item[{real, dimension(ms\%isdw-\/1\+:ms\%iedw,ms\%jsdw\+:ms\%jedw), intent(out)}]{Datu, }\item[{real, dimension(ms\%isdw\+:ms\%iedw,ms\%jsdw-\/1\+:ms\%jedw), intent(out)}]{Datv, }\item[{type(ocean\+\_\+grid\+\_\+type), intent(in)}]{G, }\item[{type(verticalgrid\+\_\+type), intent(in)}]{GV, }\item[{type(unit\+\_\+scale\+\_\+type), intent(in)}]{US, }\item[{type(\hyperlink{structmom__barotropic_1_1barotropic__cs}{barotropic\+\_\+cs}), pointer}]{CS, }\item[{type(\hyperlink{structmom__barotropic_1_1memory__size__type}{memory\+\_\+size\+\_\+type}), intent(in)}]{MS, }\item[{real, dimension(ms\%isdw\+:ms\%iedw,ms\%jsdw\+:ms\%jedw), intent(in), optional}]{eta, }\item[{integer, intent(in), optional}]{halo, }\item[{real, intent(in), optional}]{add\+\_\+max }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} This subroutine determines the open face areas of cells for calculating the barotropic transport. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in} & {\em ms} & A type that describes the memory sizes of the argument arrays.\\ \hline \mbox{\tt out} & {\em datu} & The open zonal face area \mbox{[}H L $\sim$$>$ m2 or kg m-\/1\mbox{]}.\\ \hline \mbox{\tt out} & {\em datv} & The open meridional face area \mbox{[}H L $\sim$$>$ m2 or kg m-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em g} & The ocean\textquotesingle{}s grid structure.\\ \hline \mbox{\tt in} & {\em gv} & The ocean\textquotesingle{}s vertical grid structure.\\ \hline \mbox{\tt in} & {\em us} & A dimensional unit scaling type\\ \hline & {\em cs} & The control structure returned by a previous call to barotropic\+\_\+init.\\ \hline \mbox{\tt in} & {\em eta} & The barotropic free surface height anomaly\\ \hline \mbox{\tt in} & {\em halo} & The halo size to use, default = 1.\\ \hline \mbox{\tt in} & {\em add\+\_\+max} & A value to add to the maximum depth (used to overestimate the external wave speed) \mbox{[}Z $\sim$$>$ m\mbox{]}. \\ \hline \end{DoxyParams} Definition at line 4049 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 4049 \textcolor{keywordtype}{type}(memory\_size\_type), \textcolor{keywordtype}{intent(in)} :: ms\textcolor{comment}{ !< A type that describes the memory sizes of the argument arrays.} 4050 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw)}, & 4051 \textcolor{keywordtype}{intent(out)} :: datu\textcolor{comment}{ !< The open zonal face area [H L ~> m2 or kg m-1].} 4052 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw)}, & 4053 \textcolor{keywordtype}{intent(out)} :: datv\textcolor{comment}{ !< The open meridional face area [H L ~> m2 or kg m-1].} 4054 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(in)} :: g\textcolor{comment}{ !< The ocean's grid structure.} 4055 \textcolor{keywordtype}{type}(verticalgrid\_type), \textcolor{keywordtype}{intent(in)} :: gv\textcolor{comment}{ !< The ocean's vertical grid structure.} 4056 \textcolor{keywordtype}{type}(unit\_scale\_type), \textcolor{keywordtype}{intent(in)} :: us\textcolor{comment}{ !< A dimensional unit scaling type} 4057 \textcolor{keywordtype}{type}(barotropic\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< The control structure returned by a previous} 4058 \textcolor{comment}{ !! call to barotropic\_init.} 4059 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw)}, & 4060 \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: eta\textcolor{comment}{ !< The barotropic free surface height anomaly} 4061 \textcolor{comment}{ !! or column mass anomaly [H ~> m or kg m-2].} 4062 \textcolor{keywordtype}{integer}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: halo\textcolor{comment}{ !< The halo size to use, default = 1.} 4063 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: add\_max\textcolor{comment}{ !< A value to add to the maximum depth (used} 4064 \textcolor{comment}{ !! to overestimate the external wave speed) [Z ~> m].} 4065 4066 \textcolor{comment}{! Local variables} 4067 \textcolor{keywordtype}{real} :: h1, h2 \textcolor{comment}{! Temporary total thicknesses [H ~> m or kg m-2].} 4068 \textcolor{keywordtype}{integer} :: i, j, is, ie, js, je, hs 4069 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec 4070 hs = 1 ; \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(halo)) hs = max(halo,0) 4071 4072 \textcolor{comment}{!$OMP parallel default(none) shared(is,ie,js,je,hs,eta,GV,CS,Datu,Datv,add\_max) &} 4073 \textcolor{comment}{!$OMP private(H1,H2)} 4074 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(eta)) \textcolor{keywordflow}{then} 4075 \textcolor{comment}{! The use of harmonic mean thicknesses ensure positive definiteness.} 4076 \textcolor{keywordflow}{if} (gv%Boussinesq) \textcolor{keywordflow}{then} 4077 \textcolor{comment}{!$OMP do} 4078 \textcolor{keywordflow}{do} j=js-hs,je+hs ; \textcolor{keywordflow}{do} i=is-1-hs,ie+hs 4079 h1 = cs%bathyT(i,j)*gv%Z\_to\_H + eta(i,j) ; h2 = cs%bathyT(i+1,j)*gv%Z\_to\_H + eta(i+1,j) 4080 datu(i,j) = 0.0 ; \textcolor{keywordflow}{if} ((h1 > 0.0) .and. (h2 > 0.0)) & 4081 datu(i,j) = cs%dy\_Cu(i,j) * (2.0 * h1 * h2) / (h1 + h2) 4082 \textcolor{comment}{! Datu(I,j) = CS%dy\_Cu(I,j) * 0.5 * (H1 + H2)} 4083 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4084 \textcolor{comment}{!$OMP do} 4085 \textcolor{keywordflow}{do} j=js-1-hs,je+hs ; \textcolor{keywordflow}{do} i=is-hs,ie+hs 4086 h1 = cs%bathyT(i,j)*gv%Z\_to\_H + eta(i,j) ; h2 = cs%bathyT(i,j+1)*gv%Z\_to\_H + eta(i,j+1) 4087 datv(i,j) = 0.0 ; \textcolor{keywordflow}{if} ((h1 > 0.0) .and. (h2 > 0.0)) & 4088 datv(i,j) = cs%dx\_Cv(i,j) * (2.0 * h1 * h2) / (h1 + h2) 4089 \textcolor{comment}{! Datv(i,J) = CS%dy\_v(i,J) * 0.5 * (H1 + H2)} 4090 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4091 \textcolor{keywordflow}{else} 4092 \textcolor{comment}{!$OMP do} 4093 \textcolor{keywordflow}{do} j=js-hs,je+hs ; \textcolor{keywordflow}{do} i=is-1-hs,ie+hs 4094 datu(i,j) = 0.0 ; \textcolor{keywordflow}{if} ((eta(i,j) > 0.0) .and. (eta(i+1,j) > 0.0)) & 4095 datu(i,j) = cs%dy\_Cu(i,j) * (2.0 * eta(i,j) * eta(i+1,j)) / & 4096 (eta(i,j) + eta(i+1,j)) 4097 \textcolor{comment}{! Datu(I,j) = CS%dy\_Cu(I,j) * 0.5 * (eta(i,j) + eta(i+1,j))} 4098 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4099 \textcolor{comment}{!$OMP do} 4100 \textcolor{keywordflow}{do} j=js-1-hs,je+hs ; \textcolor{keywordflow}{do} i=is-hs,ie+hs 4101 datv(i,j) = 0.0 ; \textcolor{keywordflow}{if} ((eta(i,j) > 0.0) .and. (eta(i,j+1) > 0.0)) & 4102 datv(i,j) = cs%dx\_Cv(i,j) * (2.0 * eta(i,j) * eta(i,j+1)) / & 4103 (eta(i,j) + eta(i,j+1)) 4104 \textcolor{comment}{! Datv(i,J) = CS%dy\_v(i,J) * 0.5 * (eta(i,j) + eta(i,j+1))} 4105 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4106 \textcolor{keywordflow}{ endif} 4107 \textcolor{keywordflow}{elseif} (\textcolor{keyword}{present}(add\_max)) \textcolor{keywordflow}{then} 4108 \textcolor{comment}{!$OMP do} 4109 \textcolor{keywordflow}{do} j=js-hs,je+hs ; \textcolor{keywordflow}{do} i=is-1-hs,ie+hs 4110 datu(i,j) = cs%dy\_Cu(i,j) * gv%Z\_to\_H * & 4111 (max(cs%bathyT(i+1,j), cs%bathyT(i,j)) + add\_max) 4112 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4113 \textcolor{comment}{!$OMP do} 4114 \textcolor{keywordflow}{do} j=js-1-hs,je+hs ; \textcolor{keywordflow}{do} i=is-hs,ie+hs 4115 datv(i,j) = cs%dx\_Cv(i,j) * gv%Z\_to\_H * & 4116 (max(cs%bathyT(i,j+1), cs%bathyT(i,j)) + add\_max) 4117 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4118 \textcolor{keywordflow}{else} 4119 \textcolor{comment}{!$OMP do} 4120 \textcolor{keywordflow}{do} j=js-hs,je+hs ; \textcolor{keywordflow}{do} i=is-1-hs,ie+hs 4121 datu(i, j) = 0.0 4122 \textcolor{comment}{!Would be "if (G%mask2dCu(I,j)>0.) &" is G was valid on BT domain} 4123 \textcolor{keywordflow}{if} (cs%bathyT(i+1,j)+cs%bathyT(i,j)>0.) & 4124 datu(i,j) = 2.0*cs%dy\_Cu(i,j) * gv%Z\_to\_H * & 4125 (cs%bathyT(i+1,j) * cs%bathyT(i,j)) / & 4126 (cs%bathyT(i+1,j) + cs%bathyT(i,j)) 4127 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4128 \textcolor{comment}{!$OMP do} 4129 \textcolor{keywordflow}{do} j=js-1-hs,je+hs ; \textcolor{keywordflow}{do} i=is-hs,ie+hs 4130 datv(i, j) = 0.0 4131 \textcolor{comment}{!Would be "if (G%mask2dCv(i,J)>0.) &" is G was valid on BT domain} 4132 \textcolor{keywordflow}{if} (cs%bathyT(i,j+1)+cs%bathyT(i,j)>0.) & 4133 datv(i,j) = 2.0*cs%dx\_Cv(i,j) * gv%Z\_to\_H * & 4134 (cs%bathyT(i,j+1) * cs%bathyT(i,j)) / & 4135 (cs%bathyT(i,j+1) + cs%bathyT(i,j)) 4136 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 4137 \textcolor{keywordflow}{ endif} 4138 \textcolor{comment}{!$OMP end parallel} 4139 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_a8ad2b12e885746401a97fd65ad189722}\label{namespacemom__barotropic_a8ad2b12e885746401a97fd65ad189722}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!find\+\_\+uhbt@{find\+\_\+uhbt}} \index{find\+\_\+uhbt@{find\+\_\+uhbt}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{find\+\_\+uhbt()}{find\_uhbt()}} {\footnotesize\ttfamily real function mom\+\_\+barotropic\+::find\+\_\+uhbt (\begin{DoxyParamCaption}\item[{real, intent(in)}]{u, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__u__type}{local\+\_\+bt\+\_\+cont\+\_\+u\+\_\+type}), intent(in)}]{B\+TC }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} The function find\+\_\+uhbt determines the zonal transport for a given velocity, or with I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT=True it determines the time-\/integrated zonal transport for a given time-\/integrated velocity. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in} & {\em u} & The local zonal velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]} or time integrated velocity \mbox{[}L $\sim$$>$ m\mbox{]}\\ \hline \mbox{\tt in} & {\em btc} & A structure containing various fields that allow the barotropic transports to be calculated consistently with the layers\textquotesingle{} continuity equations. The dimensions of some of the elements in this type vary depending on I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT.\\ \hline \end{DoxyParams} \begin{DoxyReturn}{Returns} The zonal barotropic transport \mbox{[}L2 H T-\/1 $\sim$$>$ m3 s-\/1\mbox{]} or time integrated transport \mbox{[}L2 H $\sim$$>$ m3\mbox{]} \end{DoxyReturn} Definition at line 3459 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 3459 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(in)} :: u\textcolor{comment}{ !< The local zonal velocity [L T-1 ~> m s-1] or time integrated velocity [L ~> m]} 3460 \textcolor{keywordtype}{type}(local\_bt\_cont\_u\_type), \textcolor{keywordtype}{intent(in)} :: btc\textcolor{comment}{ !< A structure containing various fields that} 3461 \textcolor{comment}{ !! allow the barotropic transports to be calculated consistently} 3462 \textcolor{comment}{ !! with the layers' continuity equations. The dimensions of some} 3463 \textcolor{comment}{ !! of the elements in this type vary depending on INTEGRAL\_BT\_CONT.} 3464 3465 \textcolor{keywordtype}{real} :: uhbt\textcolor{comment}{ !< The zonal barotropic transport [L2 H T-1 ~> m3 s-1] or time integrated transport [L2 H ~> m3]} 3466 3467 \textcolor{keywordflow}{if} (u == 0.0) \textcolor{keywordflow}{then} 3468 uhbt = 0.0 3469 \textcolor{keywordflow}{elseif} (u < btc%uBT\_EE) \textcolor{keywordflow}{then} 3470 uhbt = (u - btc%uBT\_EE) * btc%FA\_u\_EE + btc%uh\_EE 3471 \textcolor{keywordflow}{elseif} (u < 0.0) \textcolor{keywordflow}{then} 3472 uhbt = u * (btc%FA\_u\_E0 + btc%uh\_crvE * u**2) 3473 \textcolor{keywordflow}{elseif} (u <= btc%uBT\_WW) \textcolor{keywordflow}{then} 3474 uhbt = u * (btc%FA\_u\_W0 + btc%uh\_crvW * u**2) 3475 \textcolor{keywordflow}{else} \textcolor{comment}{! (u > BTC%uBT\_WW)} 3476 uhbt = (u - btc%uBT\_WW) * btc%FA\_u\_WW + btc%uh\_WW 3477 \textcolor{keywordflow}{ endif} 3478 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_ae96b701027f6f77feed0f68515b31e55}\label{namespacemom__barotropic_ae96b701027f6f77feed0f68515b31e55}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!find\+\_\+vhbt@{find\+\_\+vhbt}} \index{find\+\_\+vhbt@{find\+\_\+vhbt}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{find\+\_\+vhbt()}{find\_vhbt()}} {\footnotesize\ttfamily real function mom\+\_\+barotropic\+::find\+\_\+vhbt (\begin{DoxyParamCaption}\item[{real, intent(in)}]{v, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__v__type}{local\+\_\+bt\+\_\+cont\+\_\+v\+\_\+type}), intent(in)}]{B\+TC }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} The function find\+\_\+vhbt determines the meridional transport for a given velocity, or with I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT=True it determines the time-\/integrated meridional transport for a given time-\/integrated velocity. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in} & {\em v} & The local meridional velocity \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]} or time integrated velocity \mbox{[}L $\sim$$>$ m\mbox{]}\\ \hline \mbox{\tt in} & {\em btc} & A structure containing various fields that allow the barotropic transports to be calculated consistently with the layers\textquotesingle{} continuity equations. The dimensions of some of the elements in this type vary depending on I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT.\\ \hline \end{DoxyParams} \begin{DoxyReturn}{Returns} The meridional barotropic transport \mbox{[}L2 H T-\/1 $\sim$$>$ m3 s-\/1\mbox{]} or time integrated transport \mbox{[}L2 H $\sim$$>$ m3\mbox{]} \end{DoxyReturn} Definition at line 3609 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 3609 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(in)} :: v\textcolor{comment}{ !< The local meridional velocity [L T-1 ~> m s-1] or time integrated velocity [L ~> m]} 3610 \textcolor{keywordtype}{type}(local\_bt\_cont\_v\_type), \textcolor{keywordtype}{intent(in)} :: btc\textcolor{comment}{ !< A structure containing various fields that} 3611 \textcolor{comment}{ !! allow the barotropic transports to be calculated consistently} 3612 \textcolor{comment}{ !! with the layers' continuity equations. The dimensions of some} 3613 \textcolor{comment}{ !! of the elements in this type vary depending on INTEGRAL\_BT\_CONT.} 3614 \textcolor{keywordtype}{real} :: vhbt\textcolor{comment}{ !< The meridional barotropic transport [L2 H T-1 ~> m3 s-1] or time integrated transport [L2 H ~> m3]} 3615 3616 \textcolor{keywordflow}{if} (v == 0.0) \textcolor{keywordflow}{then} 3617 vhbt = 0.0 3618 \textcolor{keywordflow}{elseif} (v < btc%vBT\_NN) \textcolor{keywordflow}{then} 3619 vhbt = (v - btc%vBT\_NN) * btc%FA\_v\_NN + btc%vh\_NN 3620 \textcolor{keywordflow}{elseif} (v < 0.0) \textcolor{keywordflow}{then} 3621 vhbt = v * (btc%FA\_v\_N0 + btc%vh\_crvN * v**2) 3622 \textcolor{keywordflow}{elseif} (v <= btc%vBT\_SS) \textcolor{keywordflow}{then} 3623 vhbt = v * (btc%FA\_v\_S0 + btc%vh\_crvS * v**2) 3624 \textcolor{keywordflow}{else} \textcolor{comment}{! (v > BTC%vBT\_SS)} 3625 vhbt = (v - btc%vBT\_SS) * btc%FA\_v\_SS + btc%vh\_SS 3626 \textcolor{keywordflow}{ endif} 3627 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_a28fa2e7600a471735c3b827ac08ed94b}\label{namespacemom__barotropic_a28fa2e7600a471735c3b827ac08ed94b}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!register\+\_\+barotropic\+\_\+restarts@{register\+\_\+barotropic\+\_\+restarts}} \index{register\+\_\+barotropic\+\_\+restarts@{register\+\_\+barotropic\+\_\+restarts}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{register\+\_\+barotropic\+\_\+restarts()}{register\_barotropic\_restarts()}} {\footnotesize\ttfamily subroutine, public mom\+\_\+barotropic\+::register\+\_\+barotropic\+\_\+restarts (\begin{DoxyParamCaption}\item[{type(hor\+\_\+index\+\_\+type), intent(in)}]{HI, }\item[{type(verticalgrid\+\_\+type), intent(in)}]{GV, }\item[{type(param\+\_\+file\+\_\+type), intent(in)}]{param\+\_\+file, }\item[{type(\hyperlink{structmom__barotropic_1_1barotropic__cs}{barotropic\+\_\+cs}), pointer}]{CS, }\item[{type(mom\+\_\+restart\+\_\+cs), pointer}]{restart\+\_\+\+CS }\end{DoxyParamCaption})} This subroutine is used to register any fields from \hyperlink{MOM__barotropic_8F90_source}{M\+O\+M\+\_\+barotropic.\+F90} that should be written to or read from the restart file. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in} & {\em hi} & A horizontal index type structure.\\ \hline \mbox{\tt in} & {\em param\+\_\+file} & A structure to parse for run-\/time parameters.\\ \hline & {\em cs} & A pointer that is set to point to the control structure for this module.\\ \hline \mbox{\tt in} & {\em gv} & The ocean\textquotesingle{}s vertical grid structure.\\ \hline & {\em restart\+\_\+cs} & A pointer to the restart control structure. \\ \hline \end{DoxyParams} Definition at line 4965 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 4965 \textcolor{keywordtype}{type}(hor\_index\_type), \textcolor{keywordtype}{intent(in)} :: hi\textcolor{comment}{ !< A horizontal index type structure.} 4966 \textcolor{keywordtype}{type}(param\_file\_type), \textcolor{keywordtype}{intent(in)} :: param\_file\textcolor{comment}{ !< A structure to parse for run-time parameters.} 4967 \textcolor{keywordtype}{type}(barotropic\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< A pointer that is set to point to the control} 4968 \textcolor{comment}{ !! structure for this module.} 4969 \textcolor{keywordtype}{type}(verticalgrid\_type), \textcolor{keywordtype}{intent(in)} :: gv\textcolor{comment}{ !< The ocean's vertical grid structure.} 4970 \textcolor{keywordtype}{type}(mom\_restart\_cs), \textcolor{keywordtype}{pointer} :: restart\_cs\textcolor{comment}{ !< A pointer to the restart control structure.} 4971 4972 \textcolor{comment}{! Local variables} 4973 \textcolor{keywordtype}{type}(vardesc) :: vd(3) 4974 \textcolor{keywordtype}{character(len=40)} :: mdl = \textcolor{stringliteral}{"MOM\_barotropic"} \textcolor{comment}{! This module's name.} 4975 \textcolor{keywordtype}{integer} :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb 4976 4977 isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed 4978 isdb = hi%IsdB ; iedb = hi%IedB ; jsdb = hi%JsdB ; jedb = hi%JedB 4979 4980 \textcolor{keywordflow}{if} (\textcolor{keyword}{associated}(cs)) \textcolor{keywordflow}{then} 4981 \textcolor{keyword}{call }mom\_error(warning, \textcolor{stringliteral}{"register\_barotropic\_restarts called with an associated "}// & 4982 \textcolor{stringliteral}{"control structure."}) 4983 \textcolor{keywordflow}{return} 4984 \textcolor{keywordflow}{ endif} 4985 \textcolor{keyword}{allocate}(cs) 4986 4987 \textcolor{keyword}{call }get\_param(param\_file, mdl, \textcolor{stringliteral}{"GRADUAL\_BT\_ICS"}, cs%gradual\_BT\_ICs, & 4988 \textcolor{stringliteral}{"If true, adjust the initial conditions for the "}//& 4989 \textcolor{stringliteral}{"barotropic solver to the values from the layered "}//& 4990 \textcolor{stringliteral}{"solution over a whole timestep instead of instantly. "}//& 4991 \textcolor{stringliteral}{"This is a decent approximation to the inclusion of "}//& 4992 \textcolor{stringliteral}{"sum(u dh\_dt) while also correcting for truncation errors."}, & 4993 default=.false., do\_not\_log=.true.) 4994 4995 alloc\_(cs%ubtav(isdb:iedb,jsd:jed)) ; cs%ubtav(:,:) = 0.0 4996 alloc\_(cs%vbtav(isd:ied,jsdb:jedb)) ; cs%vbtav(:,:) = 0.0 4997 \textcolor{keywordflow}{if} (cs%gradual\_BT\_ICs) \textcolor{keywordflow}{then} 4998 alloc\_(cs%ubt\_IC(isdb:iedb,jsd:jed)) ; cs%ubt\_IC(:,:) = 0.0 4999 alloc\_(cs%vbt\_IC(isd:ied,jsdb:jedb)) ; cs%vbt\_IC(:,:) = 0.0 5000 \textcolor{keywordflow}{ endif} 5001 5002 vd(2) = var\_desc(\textcolor{stringliteral}{"ubtav"},\textcolor{stringliteral}{"m s-1"},\textcolor{stringliteral}{"Time mean barotropic zonal velocity"}, & 5003 hor\_grid=\textcolor{stringliteral}{'u'}, z\_grid=\textcolor{stringliteral}{'1'}) 5004 vd(3) = var\_desc(\textcolor{stringliteral}{"vbtav"},\textcolor{stringliteral}{"m s-1"},\textcolor{stringliteral}{"Time mean barotropic meridional velocity"},& 5005 hor\_grid=\textcolor{stringliteral}{'v'}, z\_grid=\textcolor{stringliteral}{'1'}) 5006 \textcolor{keyword}{call }register\_restart\_pair(cs%ubtav, cs%vbtav, vd(2), vd(3), .false., restart\_cs) 5007 5008 \textcolor{keywordflow}{if} (cs%gradual\_BT\_ICs) \textcolor{keywordflow}{then} 5009 vd(2) = var\_desc(\textcolor{stringliteral}{"ubt\_IC"}, \textcolor{stringliteral}{"m s-1"}, & 5010 longname=\textcolor{stringliteral}{"Next initial condition for the barotropic zonal velocity"}, & 5011 hor\_grid=\textcolor{stringliteral}{'u'}, z\_grid=\textcolor{stringliteral}{'1'}) 5012 vd(3) = var\_desc(\textcolor{stringliteral}{"vbt\_IC"}, \textcolor{stringliteral}{"m s-1"}, & 5013 longname=\textcolor{stringliteral}{"Next initial condition for the barotropic meridional velocity"},& 5014 hor\_grid=\textcolor{stringliteral}{'v'}, z\_grid=\textcolor{stringliteral}{'1'}) 5015 \textcolor{keyword}{call }register\_restart\_pair(cs%ubt\_IC, cs%vbt\_IC, vd(2), vd(3), .false., restart\_cs) 5016 \textcolor{keywordflow}{ endif} 5017 5018 5019 \textcolor{keyword}{call }register\_restart\_field(cs%dtbt, \textcolor{stringliteral}{"DTBT"}, .false., restart\_cs, & 5020 longname=\textcolor{stringliteral}{"Barotropic timestep"}, units=\textcolor{stringliteral}{"seconds"}) 5021 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_a486257b675aa4e81c2d1634b5288a67f}\label{namespacemom__barotropic_a486257b675aa4e81c2d1634b5288a67f}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!set\+\_\+dtbt@{set\+\_\+dtbt}} \index{set\+\_\+dtbt@{set\+\_\+dtbt}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{set\+\_\+dtbt()}{set\_dtbt()}} {\footnotesize\ttfamily subroutine, public mom\+\_\+barotropic\+::set\+\_\+dtbt (\begin{DoxyParamCaption}\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__barotropic_1_1barotropic__cs}{barotropic\+\_\+cs}), pointer}]{CS, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsd\+: g \%jed), intent(in), optional}]{eta, }\item[{real, dimension( g \%isd\+: g \%ied, g \%jsd\+: g \%jed, g \%ke), intent(in), optional}]{pbce, }\item[{type(bt\+\_\+cont\+\_\+type), optional, pointer}]{B\+T\+\_\+cont, }\item[{real, intent(in), optional}]{gtot\+\_\+est, }\item[{real, intent(in), optional}]{S\+S\+H\+\_\+add }\end{DoxyParamCaption})} This subroutine automatically determines an optimal value for dtbt based on some state of the ocean. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in,out} & {\em g} & The ocean\textquotesingle{}s grid structure.\\ \hline \mbox{\tt in} & {\em gv} & The ocean\textquotesingle{}s vertical grid structure.\\ \hline \mbox{\tt in} & {\em us} & A dimensional unit scaling type\\ \hline & {\em cs} & Barotropic control structure.\\ \hline \mbox{\tt in} & {\em eta} & The barotropic free surface height anomaly or column mass anomaly \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline \mbox{\tt in} & {\em pbce} & The baroclinic pressure anomaly in each layer due to free surface height anomalies \mbox{[}L2 H-\/1 T-\/2 $\sim$$>$ m s-\/2 or m4 kg-\/1 s-\/2\mbox{]}.\\ \hline & {\em bt\+\_\+cont} & A structure with elements that describe the effective open face areas as a function of barotropic flow.\\ \hline \mbox{\tt in} & {\em gtot\+\_\+est} & An estimate of the total gravitational acceleration \mbox{[}L2 Z-\/1 T-\/2 $\sim$$>$ m s-\/2\mbox{]}.\\ \hline \mbox{\tt in} & {\em ssh\+\_\+add} & An additional contribution to S\+SH to provide a margin of error when calculating the external wave speed \mbox{[}Z $\sim$$>$ m\mbox{]}. \\ \hline \end{DoxyParams} Definition at line 2644 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 2644 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(inout)} :: g\textcolor{comment}{ !< The ocean's grid structure.} 2645 \textcolor{keywordtype}{type}(verticalgrid\_type), \textcolor{keywordtype}{intent(in)} :: gv\textcolor{comment}{ !< The ocean's vertical grid structure.} 2646 \textcolor{keywordtype}{type}(unit\_scale\_type), \textcolor{keywordtype}{intent(in)} :: us\textcolor{comment}{ !< A dimensional unit scaling type} 2647 \textcolor{keywordtype}{type}(barotropic\_cs), \textcolor{keywordtype}{pointer} :: cs\textcolor{comment}{ !< Barotropic control structure.} 2648 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G))}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: eta\textcolor{comment}{ !< The barotropic free surface} 2649 \textcolor{comment}{ !! height anomaly or column mass anomaly [H ~> m or kg m-2].} 2650 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G),SZK\_(G))}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: pbce\textcolor{comment}{ !< The baroclinic pressure} 2651 \textcolor{comment}{ !! anomaly in each layer due to free surface} 2652 \textcolor{comment}{ !! height anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].} 2653 \textcolor{keywordtype}{type}(bt\_cont\_type), \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{pointer} :: bt\_cont\textcolor{comment}{ !< A structure with elements that describe} 2654 \textcolor{comment}{ !! the effective open face areas as a} 2655 \textcolor{comment}{ !! function of barotropic flow.} 2656 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: gtot\_est\textcolor{comment}{ !< An estimate of the total gravitational} 2657 \textcolor{comment}{ !! acceleration [L2 Z-1 T-2 ~> m s-2].} 2658 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: ssh\_add\textcolor{comment}{ !< An additional contribution to SSH to} 2659 \textcolor{comment}{ !! provide a margin of error when} 2660 \textcolor{comment}{ !! calculating the external wave speed [Z ~> m].} 2661 2662 \textcolor{comment}{! Local variables} 2663 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJ\_(G))} :: & 2664 gtot\_e, & \textcolor{comment}{! gtot\_X is the effective total reduced gravity used to relate} 2665 gtot\_w, & \textcolor{comment}{! free surface height deviations to pressure forces (including} 2666 gtot\_n, & \textcolor{comment}{! GFS and baroclinic contributions) in the barotropic momentum} 2667 gtot\_s \textcolor{comment}{! equations half a grid-point in the X-direction (X is N, S, E, or W)} 2668 \textcolor{comment}{! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].} 2669 \textcolor{comment}{! (See Hallberg, J Comp Phys 1997 for a discussion.)} 2670 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBS\_(G),SZJ\_(G))} :: & 2671 datu \textcolor{comment}{! Basin depth at u-velocity grid points times the y-grid} 2672 \textcolor{comment}{! spacing [H L ~> m2 or kg m-1].} 2673 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZI\_(G),SZJBS\_(G))} :: & 2674 datv \textcolor{comment}{! Basin depth at v-velocity grid points times the x-grid} 2675 \textcolor{comment}{! spacing [H L ~> m2 or kg m-1].} 2676 \textcolor{keywordtype}{real} :: det\_de \textcolor{comment}{! The partial derivative due to self-attraction and loading} 2677 \textcolor{comment}{! of the reference geopotential with the sea surface height [nondim].} 2678 \textcolor{comment}{! This is typically ~0.09 or less.} 2679 \textcolor{keywordtype}{real} :: dgeo\_de \textcolor{comment}{! The constant of proportionality between geopotential and} 2680 \textcolor{comment}{! sea surface height [nondim]. It is a nondimensional number of} 2681 \textcolor{comment}{! order 1. For stability, this may be made larger} 2682 \textcolor{comment}{! than physical problem would suggest.} 2683 \textcolor{keywordtype}{real} :: add\_ssh \textcolor{comment}{! An additional contribution to SSH to provide a margin of error} 2684 \textcolor{comment}{! when calculating the external wave speed [Z ~> m].} 2685 \textcolor{keywordtype}{real} :: min\_max\_dt2 \textcolor{comment}{! The square of the minimum value of the largest stable barotropic} 2686 \textcolor{comment}{! timesteps [T2 ~> s2]} 2687 \textcolor{keywordtype}{real} :: dtbt\_max \textcolor{comment}{! The maximum barotropic timestep [T ~> s]} 2688 \textcolor{keywordtype}{real} :: idt\_max2 \textcolor{comment}{! The squared inverse of the local maximum stable} 2689 \textcolor{comment}{! barotropic time step [T-2 ~> s-2].} 2690 \textcolor{keywordtype}{logical} :: use\_bt\_cont 2691 \textcolor{keywordtype}{type}(memory\_size\_type) :: ms 2692 2693 \textcolor{keywordtype}{character(len=200)} :: mesg 2694 \textcolor{keywordtype}{integer} :: i, j, k, is, ie, js, je, nz 2695 2696 \textcolor{keywordflow}{if} (.not.\textcolor{keyword}{associated}(cs)) \textcolor{keyword}{call }mom\_error(fatal, & 2697 \textcolor{stringliteral}{"set\_dtbt: Module MOM\_barotropic must be initialized before it is used."}) 2698 \textcolor{keywordflow}{if} (.not.cs%split) \textcolor{keywordflow}{return} 2699 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke 2700 ms%isdw = g%isd ; ms%iedw = g%ied ; ms%jsdw = g%jsd ; ms%jedw = g%jed 2701 2702 \textcolor{keywordflow}{if} (.not.(\textcolor{keyword}{present}(pbce) .or. \textcolor{keyword}{present}(gtot\_est))) \textcolor{keyword}{call }mom\_error(fatal, & 2703 \textcolor{stringliteral}{"set\_dtbt: Either pbce or gtot\_est must be present."}) 2704 2705 add\_ssh = 0.0 ; \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(ssh\_add)) add\_ssh = ssh\_add 2706 2707 use\_bt\_cont = .false. 2708 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(bt\_cont)) use\_bt\_cont = (\textcolor{keyword}{associated}(bt\_cont)) 2709 2710 \textcolor{keywordflow}{if} (use\_bt\_cont) \textcolor{keywordflow}{then} 2711 \textcolor{keyword}{call }bt\_cont\_to\_face\_areas(bt\_cont, datu, datv, g, us, ms, 0, .true.) 2712 \textcolor{keywordflow}{elseif} (cs%Nonlinear\_continuity .and. \textcolor{keyword}{present}(eta)) \textcolor{keywordflow}{then} 2713 \textcolor{keyword}{call }find\_face\_areas(datu, datv, g, gv, us, cs, ms, eta=eta, halo=0) 2714 \textcolor{keywordflow}{else} 2715 \textcolor{keyword}{call }find\_face\_areas(datu, datv, g, gv, us, cs, ms, halo=0, add\_max=add\_ssh) 2716 \textcolor{keywordflow}{ endif} 2717 2718 det\_de = 0.0 2719 \textcolor{keywordflow}{if} (cs%tides) \textcolor{keyword}{call }tidal\_forcing\_sensitivity(g, cs%tides\_CSp, det\_de) 2720 dgeo\_de = 1.0 + max(0.0, det\_de + cs%G\_extra) 2721 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(pbce)) \textcolor{keywordflow}{then} 2722 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 2723 gtot\_e(i,j) = 0.0 ; gtot\_w(i,j) = 0.0 2724 gtot\_n(i,j) = 0.0 ; gtot\_s(i,j) = 0.0 2725 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2726 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 2727 gtot\_e(i,j) = gtot\_e(i,j) + pbce(i,j,k) * cs%frhatu(i,j,k) 2728 gtot\_w(i,j) = gtot\_w(i,j) + pbce(i,j,k) * cs%frhatu(i-1,j,k) 2729 gtot\_n(i,j) = gtot\_n(i,j) + pbce(i,j,k) * cs%frhatv(i,j,k) 2730 gtot\_s(i,j) = gtot\_s(i,j) + pbce(i,j,k) * cs%frhatv(i,j-1,k) 2731 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2732 \textcolor{keywordflow}{else} 2733 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 2734 gtot\_e(i,j) = gtot\_est * gv%H\_to\_Z ; gtot\_w(i,j) = gtot\_est * gv%H\_to\_Z 2735 gtot\_n(i,j) = gtot\_est * gv%H\_to\_Z ; gtot\_s(i,j) = gtot\_est * gv%H\_to\_Z 2736 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2737 \textcolor{keywordflow}{ endif} 2738 2739 min\_max\_dt2 = 1.0e38*us%s\_to\_T**2 \textcolor{comment}{! A huge value for the permissible timestep squared.} 2740 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is,ie 2741 \textcolor{comment}{! This is pretty accurate for gravity waves, but it is a conservative} 2742 \textcolor{comment}{! estimate since it ignores the stabilizing effect of the bottom drag.} 2743 idt\_max2 = 0.5 * (1.0 + 2.0*cs%bebt) * (g%IareaT(i,j) * & 2744 ((gtot\_e(i,j)*datu(i,j)*g%IdxCu(i,j) + gtot\_w(i,j)*datu(i-1,j)*g%IdxCu(i-1,j)) + & 2745 (gtot\_n(i,j)*datv(i,j)*g%IdyCv(i,j) + gtot\_s(i,j)*datv(i,j-1)*g%IdyCv(i,j-1))) + & 2746 ((g%CoriolisBu(i,j)**2 + g%CoriolisBu(i-1,j-1)**2) + & 2747 (g%CoriolisBu(i-1,j)**2 + g%CoriolisBu(i,j-1)**2)) * cs%BT\_Coriolis\_scale**2 ) 2748 \textcolor{keywordflow}{if} (idt\_max2 * min\_max\_dt2 > 1.0) min\_max\_dt2 = 1.0 / idt\_max2 2749 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 2750 dtbt\_max = sqrt(min\_max\_dt2 / dgeo\_de) 2751 \textcolor{keywordflow}{if} (id\_clock\_sync > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_sync) 2752 \textcolor{keyword}{call }min\_across\_pes(dtbt\_max) 2753 \textcolor{keywordflow}{if} (id\_clock\_sync > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_sync) 2754 2755 cs%dtbt = cs%dtbt\_fraction * dtbt\_max 2756 cs%dtbt\_max = dtbt\_max \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_a2be327af11ae54368acd32a3ba360ac4}\label{namespacemom__barotropic_a2be327af11ae54368acd32a3ba360ac4}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!set\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types@{set\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types}} \index{set\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types@{set\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{set\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types()}{set\_local\_bt\_cont\_types()}} {\footnotesize\ttfamily subroutine mom\+\_\+barotropic\+::set\+\_\+local\+\_\+bt\+\_\+cont\+\_\+types (\begin{DoxyParamCaption}\item[{type(bt\+\_\+cont\+\_\+type), intent(inout)}]{B\+T\+\_\+cont, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__u__type}{local\+\_\+bt\+\_\+cont\+\_\+u\+\_\+type}), dimension( ms \%isdw-\/1\+: ms \%iedw, ms \%jsdw\+: ms \%jedw), intent(out)}]{B\+T\+C\+L\+\_\+u, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__v__type}{local\+\_\+bt\+\_\+cont\+\_\+v\+\_\+type}), dimension( ms \%isdw\+: ms \%iedw, ms \%jsdw-\/1\+: ms \%jedw), intent(out)}]{B\+T\+C\+L\+\_\+v, }\item[{type(ocean\+\_\+grid\+\_\+type), intent(in)}]{G, }\item[{type(unit\+\_\+scale\+\_\+type), intent(in)}]{US, }\item[{type(\hyperlink{structmom__barotropic_1_1memory__size__type}{memory\+\_\+size\+\_\+type}), intent(in)}]{MS, }\item[{type(mom\+\_\+domain\+\_\+type), intent(inout)}]{B\+T\+\_\+\+Domain, }\item[{integer, intent(in), optional}]{halo, }\item[{real, intent(in), optional}]{dt\+\_\+baroclinic }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} This subroutine sets up reordered versions of the B\+T\+\_\+cont type in the local\+\_\+\+B\+T\+\_\+cont types, which have wide halos properly filled in. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in,out} & {\em bt\+\_\+cont} & The B\+T\+\_\+cont\+\_\+type input to the barotropic solver.\\ \hline \mbox{\tt in} & {\em ms} & A type that describes the memory sizes of the argument arrays.\\ \hline \mbox{\tt out} & {\em btcl\+\_\+u} & A structure with the u information from B\+T\+\_\+cont.\\ \hline \mbox{\tt out} & {\em btcl\+\_\+v} & A structure with the v information from B\+T\+\_\+cont.\\ \hline \mbox{\tt in} & {\em g} & The ocean\textquotesingle{}s grid structure.\\ \hline \mbox{\tt in} & {\em us} & A dimensional unit scaling type\\ \hline \mbox{\tt in,out} & {\em bt\+\_\+domain} & The domain to use for updating the halos of wide arrays.\\ \hline \mbox{\tt in} & {\em halo} & The extra halo size to use here.\\ \hline \mbox{\tt in} & {\em dt\+\_\+baroclinic} & The baroclinic time step \mbox{[}T $\sim$$>$ s\mbox{]}, which is provided if I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+N\+T\+I\+N\+U\+I\+TY is true. \\ \hline \end{DoxyParams} Definition at line 3757 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 3757 \textcolor{keywordtype}{type}(bt\_cont\_type), \textcolor{keywordtype}{intent(inout)} :: bt\_cont\textcolor{comment}{ !< The BT\_cont\_type input to the} 3758 \textcolor{comment}{ !! barotropic solver.} 3759 \textcolor{keywordtype}{type}(memory\_size\_type), \textcolor{keywordtype}{intent(in)} :: ms\textcolor{comment}{ !< A type that describes the} 3760 \textcolor{comment}{ !! memory sizes of the argument} 3761 \textcolor{comment}{ !! arrays.} 3762 \textcolor{keywordtype}{type}(local\_bt\_cont\_u\_type), \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(out)} :: btcl\_u\textcolor{comment}{ !< A structure with the u} 3763 \textcolor{comment}{ !! information from BT\_cont.} 3764 \textcolor{keywordtype}{type}(local\_bt\_cont\_v\_type), \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, \textcolor{keywordtype}{intent(out)} :: btcl\_v\textcolor{comment}{ !< A structure with the v} 3765 \textcolor{comment}{ !! information from BT\_cont.} 3766 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(in)} :: g\textcolor{comment}{ !< The ocean's grid structure.} 3767 \textcolor{keywordtype}{type}(unit\_scale\_type), \textcolor{keywordtype}{intent(in)} :: us\textcolor{comment}{ !< A dimensional unit scaling type} 3768 \textcolor{keywordtype}{type}(mom\_domain\_type), \textcolor{keywordtype}{intent(inout)} :: bt\_domain\textcolor{comment}{ !< The domain to use for updating} 3769 \textcolor{comment}{ !! the halos of wide arrays.} 3770 \textcolor{keywordtype}{integer}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: halo\textcolor{comment}{ !< The extra halo size to use here.} 3771 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: dt\_baroclinic\textcolor{comment}{ !< The baroclinic time step} 3772 \textcolor{comment}{ !! [T ~> s], which is provided if} 3773 \textcolor{comment}{ !! INTEGRAL\_BT\_CONTINUITY is true.} 3774 3775 \textcolor{comment}{! Local variables} 3776 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))} :: & 3777 u\_polarity, & \textcolor{comment}{! An array used to test for halo update polarity [nondim]} 3778 ubt\_ee, ubt\_ww, & \textcolor{comment}{! Zonal velocities at which the form of the fit changes [L T-1 ~> m s-1]} 3779 fa\_u\_ee, fa\_u\_e0, fa\_u\_w0, fa\_u\_ww \textcolor{comment}{! Zonal face areas [H L ~> m2 or kg m-1]} 3780 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))} :: & 3781 v\_polarity, & \textcolor{comment}{! An array used to test for halo update polarity [nondim]} 3782 vbt\_nn, vbt\_ss, & \textcolor{comment}{! Meridional velocities at which the form of the fit changes [L T-1 ~> m s-1]} 3783 fa\_v\_nn, fa\_v\_n0, fa\_v\_s0, fa\_v\_ss \textcolor{comment}{! Meridional face areas [H L ~> m2 or kg m-1]} 3784 \textcolor{keywordtype}{real} :: dt \textcolor{comment}{! The baroclinic timestep [T ~> s] or 1.0 [nondim]} 3785 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{parameter} :: c1\_3 = 1.0/3.0 3786 \textcolor{keywordtype}{integer} :: i, j, is, ie, js, je, hs 3787 3788 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec 3789 hs = 1 ; \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(halo)) hs = max(halo,0) 3790 dt = 1.0 ; \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(dt\_baroclinic)) dt = dt\_baroclinic 3791 3792 \textcolor{comment}{! Copy the BT\_cont arrays into symmetric, potentially wide haloed arrays.} 3793 \textcolor{comment}{!$OMP parallel default(none) shared(is,ie,js,je,hs,u\_polarity,uBT\_EE,uBT\_WW,FA\_u\_EE, &} 3794 \textcolor{comment}{!$OMP FA\_u\_E0,FA\_u\_W0,FA\_u\_WW,v\_polarity,vBT\_NN,vBT\_SS,&} 3795 \textcolor{comment}{!$OMP FA\_v\_NN,FA\_v\_N0,FA\_v\_S0,FA\_v\_SS,BT\_cont )} 3796 \textcolor{comment}{!$OMP do} 3797 \textcolor{keywordflow}{do} j=js-hs,je+hs ; \textcolor{keywordflow}{do} i=is-hs-1,ie+hs 3798 u\_polarity(i,j) = 1.0 3799 ubt\_ee(i,j) = 0.0 ; ubt\_ww(i,j) = 0.0 3800 fa\_u\_ee(i,j) = 0.0 ; fa\_u\_e0(i,j) = 0.0 ; fa\_u\_w0(i,j) = 0.0 ; fa\_u\_ww(i,j) = 0.0 3801 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3802 \textcolor{comment}{!$OMP do} 3803 \textcolor{keywordflow}{do} j=js-hs-1,je+hs ; \textcolor{keywordflow}{do} i=is-hs,ie+hs 3804 v\_polarity(i,j) = 1.0 3805 vbt\_nn(i,j) = 0.0 ; vbt\_ss(i,j) = 0.0 3806 fa\_v\_nn(i,j) = 0.0 ; fa\_v\_n0(i,j) = 0.0 ; fa\_v\_s0(i,j) = 0.0 ; fa\_v\_ss(i,j) = 0.0 3807 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3808 \textcolor{comment}{!$OMP do} 3809 \textcolor{keywordflow}{do} j=js,je; \textcolor{keywordflow}{do} i=is-1,ie 3810 ubt\_ee(i,j) = bt\_cont%uBT\_EE(i,j) ; ubt\_ww(i,j) = bt\_cont%uBT\_WW(i,j) 3811 fa\_u\_ee(i,j) = bt\_cont%FA\_u\_EE(i,j) ; fa\_u\_e0(i,j) = bt\_cont%FA\_u\_E0(i,j) 3812 fa\_u\_w0(i,j) = bt\_cont%FA\_u\_W0(i,j) ; fa\_u\_ww(i,j) = bt\_cont%FA\_u\_WW(i,j) 3813 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3814 \textcolor{comment}{!$OMP do} 3815 \textcolor{keywordflow}{do} j=js-1,je; \textcolor{keywordflow}{do} i=is,ie 3816 vbt\_nn(i,j) = bt\_cont%vBT\_NN(i,j) ; vbt\_ss(i,j) = bt\_cont%vBT\_SS(i,j) 3817 fa\_v\_nn(i,j) = bt\_cont%FA\_v\_NN(i,j) ; fa\_v\_n0(i,j) = bt\_cont%FA\_v\_N0(i,j) 3818 fa\_v\_s0(i,j) = bt\_cont%FA\_v\_S0(i,j) ; fa\_v\_ss(i,j) = bt\_cont%FA\_v\_SS(i,j) 3819 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3820 \textcolor{comment}{!$OMP end parallel} 3821 3822 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_calc\_pre) 3823 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_pass\_pre) 3824 \textcolor{comment}{!--- begin setup for group halo update} 3825 \textcolor{keyword}{call }create\_group\_pass(bt\_cont%pass\_polarity\_BT, u\_polarity, v\_polarity, bt\_domain) 3826 \textcolor{keyword}{call }create\_group\_pass(bt\_cont%pass\_polarity\_BT, ubt\_ee, vbt\_nn, bt\_domain) 3827 \textcolor{keyword}{call }create\_group\_pass(bt\_cont%pass\_polarity\_BT, ubt\_ww, vbt\_ss, bt\_domain) 3828 3829 \textcolor{keyword}{call }create\_group\_pass(bt\_cont%pass\_FA\_uv, fa\_u\_ee, fa\_v\_nn, bt\_domain, to\_all+scalar\_pair) 3830 \textcolor{keyword}{call }create\_group\_pass(bt\_cont%pass\_FA\_uv, fa\_u\_e0, fa\_v\_n0, bt\_domain, to\_all+scalar\_pair) 3831 \textcolor{keyword}{call }create\_group\_pass(bt\_cont%pass\_FA\_uv, fa\_u\_w0, fa\_v\_s0, bt\_domain, to\_all+scalar\_pair) 3832 \textcolor{keyword}{call }create\_group\_pass(bt\_cont%pass\_FA\_uv, fa\_u\_ww, fa\_v\_ss, bt\_domain, to\_all+scalar\_pair) 3833 \textcolor{comment}{!--- end setup for group halo update} 3834 \textcolor{comment}{! Do halo updates on BT\_cont.} 3835 \textcolor{keyword}{call }do\_group\_pass(bt\_cont%pass\_polarity\_BT, bt\_domain) 3836 \textcolor{keyword}{call }do\_group\_pass(bt\_cont%pass\_FA\_uv, bt\_domain) 3837 \textcolor{keywordflow}{if} (id\_clock\_pass\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_end(id\_clock\_pass\_pre) 3838 \textcolor{keywordflow}{if} (id\_clock\_calc\_pre > 0) \textcolor{keyword}{call }cpu\_clock\_begin(id\_clock\_calc\_pre) 3839 3840 \textcolor{comment}{!$OMP parallel default(shared)} 3841 \textcolor{comment}{!$OMP do} 3842 \textcolor{keywordflow}{do} j=js-hs,je+hs ; \textcolor{keywordflow}{do} i=is-hs-1,ie+hs 3843 btcl\_u(i,j)%FA\_u\_EE = fa\_u\_ee(i,j) ; btcl\_u(i,j)%FA\_u\_E0 = fa\_u\_e0(i,j) 3844 btcl\_u(i,j)%FA\_u\_W0 = fa\_u\_w0(i,j) ; btcl\_u(i,j)%FA\_u\_WW = fa\_u\_ww(i,j) 3845 btcl\_u(i,j)%uBT\_EE = dt*ubt\_ee(i,j) ; btcl\_u(i,j)%uBT\_WW = dt*ubt\_ww(i,j) 3846 \textcolor{comment}{! Check for reversed polarity in the tripolar halo regions.} 3847 \textcolor{keywordflow}{if} (u\_polarity(i,j) < 0.0) \textcolor{keywordflow}{then} 3848 \textcolor{keyword}{call }swap(btcl\_u(i,j)%FA\_u\_EE, btcl\_u(i,j)%FA\_u\_WW) 3849 \textcolor{keyword}{call }swap(btcl\_u(i,j)%FA\_u\_E0, btcl\_u(i,j)%FA\_u\_W0) 3850 \textcolor{keyword}{call }swap(btcl\_u(i,j)%uBT\_EE, btcl\_u(i,j)%uBT\_WW) 3851 \textcolor{keywordflow}{ endif} 3852 3853 btcl\_u(i,j)%uh\_EE = btcl\_u(i,j)%uBT\_EE * & 3854 (c1\_3 * (2.0*btcl\_u(i,j)%FA\_u\_E0 + btcl\_u(i,j)%FA\_u\_EE)) 3855 btcl\_u(i,j)%uh\_WW = btcl\_u(i,j)%uBT\_WW * & 3856 (c1\_3 * (2.0*btcl\_u(i,j)%FA\_u\_W0 + btcl\_u(i,j)%FA\_u\_WW)) 3857 3858 btcl\_u(i,j)%uh\_crvE = 0.0 ; btcl\_u(i,j)%uh\_crvW = 0.0 3859 \textcolor{keywordflow}{if} (abs(btcl\_u(i,j)%uBT\_WW) > 0.0) btcl\_u(i,j)%uh\_crvW = & 3860 (c1\_3 * (btcl\_u(i,j)%FA\_u\_WW - btcl\_u(i,j)%FA\_u\_W0)) / btcl\_u(i,j)%uBT\_WW**2 3861 \textcolor{keywordflow}{if} (abs(btcl\_u(i,j)%uBT\_EE) > 0.0) btcl\_u(i,j)%uh\_crvE = & 3862 (c1\_3 * (btcl\_u(i,j)%FA\_u\_EE - btcl\_u(i,j)%FA\_u\_E0)) / btcl\_u(i,j)%uBT\_EE**2 3863 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3864 \textcolor{comment}{!$OMP do} 3865 \textcolor{keywordflow}{do} j=js-hs-1,je+hs ; \textcolor{keywordflow}{do} i=is-hs,ie+hs 3866 btcl\_v(i,j)%FA\_v\_NN = fa\_v\_nn(i,j) ; btcl\_v(i,j)%FA\_v\_N0 = fa\_v\_n0(i,j) 3867 btcl\_v(i,j)%FA\_v\_S0 = fa\_v\_s0(i,j) ; btcl\_v(i,j)%FA\_v\_SS = fa\_v\_ss(i,j) 3868 btcl\_v(i,j)%vBT\_NN = dt*vbt\_nn(i,j) ; btcl\_v(i,j)%vBT\_SS = dt*vbt\_ss(i,j) 3869 \textcolor{comment}{! Check for reversed polarity in the tripolar halo regions.} 3870 \textcolor{keywordflow}{if} (v\_polarity(i,j) < 0.0) \textcolor{keywordflow}{then} 3871 \textcolor{keyword}{call }swap(btcl\_v(i,j)%FA\_v\_NN, btcl\_v(i,j)%FA\_v\_SS) 3872 \textcolor{keyword}{call }swap(btcl\_v(i,j)%FA\_v\_N0, btcl\_v(i,j)%FA\_v\_S0) 3873 \textcolor{keyword}{call }swap(btcl\_v(i,j)%vBT\_NN, btcl\_v(i,j)%vBT\_SS) 3874 \textcolor{keywordflow}{ endif} 3875 3876 btcl\_v(i,j)%vh\_NN = btcl\_v(i,j)%vBT\_NN * & 3877 (c1\_3 * (2.0*btcl\_v(i,j)%FA\_v\_N0 + btcl\_v(i,j)%FA\_v\_NN)) 3878 btcl\_v(i,j)%vh\_SS = btcl\_v(i,j)%vBT\_SS * & 3879 (c1\_3 * (2.0*btcl\_v(i,j)%FA\_v\_S0 + btcl\_v(i,j)%FA\_v\_SS)) 3880 3881 btcl\_v(i,j)%vh\_crvN = 0.0 ; btcl\_v(i,j)%vh\_crvS = 0.0 3882 \textcolor{keywordflow}{if} (abs(btcl\_v(i,j)%vBT\_SS) > 0.0) btcl\_v(i,j)%vh\_crvS = & 3883 (c1\_3 * (btcl\_v(i,j)%FA\_v\_SS - btcl\_v(i,j)%FA\_v\_S0)) / btcl\_v(i,j)%vBT\_SS**2 3884 \textcolor{keywordflow}{if} (abs(btcl\_v(i,j)%vBT\_NN) > 0.0) btcl\_v(i,j)%vh\_crvN = & 3885 (c1\_3 * (btcl\_v(i,j)%FA\_v\_NN - btcl\_v(i,j)%FA\_v\_N0)) / btcl\_v(i,j)%vBT\_NN**2 3886 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3887 \textcolor{comment}{!$OMP end parallel} \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_af8296e1b2f7a24a091c7ad563393edb0}\label{namespacemom__barotropic_af8296e1b2f7a24a091c7ad563393edb0}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!set\+\_\+up\+\_\+bt\+\_\+obc@{set\+\_\+up\+\_\+bt\+\_\+obc}} \index{set\+\_\+up\+\_\+bt\+\_\+obc@{set\+\_\+up\+\_\+bt\+\_\+obc}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{set\+\_\+up\+\_\+bt\+\_\+obc()}{set\_up\_bt\_obc()}} {\footnotesize\ttfamily subroutine mom\+\_\+barotropic\+::set\+\_\+up\+\_\+bt\+\_\+obc (\begin{DoxyParamCaption}\item[{type(ocean\+\_\+obc\+\_\+type), pointer}]{O\+BC, }\item[{real, dimension(sziw\+\_\+(ms),szjw\+\_\+(ms)), intent(in)}]{eta, }\item[{type(\hyperlink{structmom__barotropic_1_1bt__obc__type}{bt\+\_\+obc\+\_\+type}), intent(inout)}]{B\+T\+\_\+\+O\+BC, }\item[{type(mom\+\_\+domain\+\_\+type), intent(inout)}]{B\+T\+\_\+\+Domain, }\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__barotropic_1_1memory__size__type}{memory\+\_\+size\+\_\+type}), intent(in)}]{MS, }\item[{integer, intent(in)}]{halo, }\item[{logical, intent(in)}]{use\+\_\+\+B\+T\+\_\+cont, }\item[{logical, intent(in)}]{integral\+\_\+\+B\+T\+\_\+cont, }\item[{real, intent(in)}]{dt\+\_\+baroclinic, }\item[{real, dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(in)}]{Datu, }\item[{real, dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(in)}]{Datv, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__u__type}{local\+\_\+bt\+\_\+cont\+\_\+u\+\_\+type}), dimension(szibw\+\_\+(ms),szjw\+\_\+(ms)), intent(in)}]{B\+T\+C\+L\+\_\+u, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__v__type}{local\+\_\+bt\+\_\+cont\+\_\+v\+\_\+type}), dimension(sziw\+\_\+(ms),szjbw\+\_\+(ms)), intent(in)}]{B\+T\+C\+L\+\_\+v }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} This subroutine sets up the private structure used to apply the open boundary conditions, as developed by Mehmet Ilicak. \begin{DoxyParams}[1]{Parameters} & {\em obc} & An associated pointer to an O\+BC type.\\ \hline \mbox{\tt in} & {\em ms} & A type that describes the memory sizes of the argument arrays.\\ \hline \mbox{\tt in} & {\em eta} & The barotropic free surface height anomaly or column mass anomaly \mbox{[}H $\sim$$>$ m or kg m-\/2\mbox{]}.\\ \hline \mbox{\tt in,out} & {\em bt\+\_\+obc} & A structure with the private barotropic arrays related to the open boundary conditions, set by set\+\_\+up\+\_\+\+B\+T\+\_\+\+O\+BC.\\ \hline \mbox{\tt in,out} & {\em bt\+\_\+domain} & M\+O\+M\+\_\+domain\+\_\+type associated with wide arrays\\ \hline \mbox{\tt in,out} & {\em g} & The ocean\textquotesingle{}s grid structure.\\ \hline \mbox{\tt in} & {\em gv} & The ocean\textquotesingle{}s vertical grid structure.\\ \hline \mbox{\tt in} & {\em us} & A dimensional unit scaling type\\ \hline \mbox{\tt in} & {\em halo} & The extra halo size to use here.\\ \hline \mbox{\tt in} & {\em use\+\_\+bt\+\_\+cont} & If true, use the B\+T\+\_\+cont\+\_\+types to calculate transports.\\ \hline \mbox{\tt in} & {\em integral\+\_\+bt\+\_\+cont} & If true, update the barotropic continuity equation directly from the initial condition using the time-\/integrated barotropic velocity.\\ \hline \mbox{\tt in} & {\em dt\+\_\+baroclinic} & The baroclinic timestep for this cycle of updates to the barotropic solver \mbox{[}T $\sim$$>$ s\mbox{]}\\ \hline \mbox{\tt in} & {\em datu} & A fixed estimate of the face areas at u points \mbox{[}H L $\sim$$>$ m2 or kg m-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em datv} & A fixed estimate of the face areas at v points \mbox{[}H L $\sim$$>$ m2 or kg m-\/1\mbox{]}.\\ \hline \mbox{\tt in} & {\em btcl\+\_\+u} & Structure of information used for a dynamic estimate of the face areas at u-\/points.\\ \hline \mbox{\tt in} & {\em btcl\+\_\+v} & Structure of information used for a dynamic estimate of the face areas at v-\/points. \\ \hline \end{DoxyParams} Definition at line 2969 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 2969 \textcolor{keywordtype}{type}(ocean\_obc\_type), \textcolor{keywordtype}{pointer} :: obc\textcolor{comment}{ !< An associated pointer to an OBC type.} 2970 \textcolor{keywordtype}{type}(memory\_size\_type), \textcolor{keywordtype}{intent(in)} :: ms\textcolor{comment}{ !< A type that describes the memory sizes of the} 2971 \textcolor{comment}{ !! argument arrays.} 2972 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: eta\textcolor{comment}{ !< The barotropic free surface height anomaly or} 2973 \textcolor{comment}{ !! column mass anomaly [H ~> m or kg m-2].} 2974 \textcolor{keywordtype}{type}(bt\_obc\_type), \textcolor{keywordtype}{intent(inout)} :: bt\_obc\textcolor{comment}{ !< A structure with the private barotropic arrays} 2975 \textcolor{comment}{ !! related to the open boundary conditions,} 2976 \textcolor{comment}{ !! set by set\_up\_BT\_OBC.} 2977 \textcolor{keywordtype}{type}(mom\_domain\_type), \textcolor{keywordtype}{intent(inout)} :: bt\_domain\textcolor{comment}{ !< MOM\_domain\_type associated with wide arrays} 2978 \textcolor{keywordtype}{type}(ocean\_grid\_type), \textcolor{keywordtype}{intent(inout)} :: g\textcolor{comment}{ !< The ocean's grid structure.} 2979 \textcolor{keywordtype}{type}(verticalgrid\_type), \textcolor{keywordtype}{intent(in)} :: gv\textcolor{comment}{ !< The ocean's vertical grid structure.} 2980 \textcolor{keywordtype}{type}(unit\_scale\_type), \textcolor{keywordtype}{intent(in)} :: us\textcolor{comment}{ !< A dimensional unit scaling type} 2981 \textcolor{keywordtype}{integer}, \textcolor{keywordtype}{intent(in)} :: halo\textcolor{comment}{ !< The extra halo size to use here.} 2982 \textcolor{keywordtype}{logical}, \textcolor{keywordtype}{intent(in)} :: use\_bt\_cont\textcolor{comment}{ !< If true, use the BT\_cont\_types to calculate} 2983 \textcolor{comment}{ !! transports.} 2984 \textcolor{keywordtype}{logical}, \textcolor{keywordtype}{intent(in)} :: integral\_bt\_cont\textcolor{comment}{ !< If true, update the barotropic continuity} 2985 \textcolor{comment}{ !! equation directly from the initial condition} 2986 \textcolor{comment}{ !! using the time-integrated barotropic velocity.} 2987 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(in)} :: dt\_baroclinic\textcolor{comment}{ !< The baroclinic timestep for this cycle of} 2988 \textcolor{comment}{ !! updates to the barotropic solver [T ~> s]} 2989 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: datu\textcolor{comment}{ !< A fixed estimate of the face areas at u points} 2990 \textcolor{comment}{ !! [H L ~> m2 or kg m-1].} 2991 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: datv\textcolor{comment}{ !< A fixed estimate of the face areas at v points} 2992 \textcolor{comment}{ !! [H L ~> m2 or kg m-1].} 2993 \textcolor{keywordtype}{type}(local\_bt\_cont\_u\_type), \textcolor{keywordtype}{dimension(SZIBW\_(MS),SZJW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: btcl\_u\textcolor{comment}{ !< Structure of information used} 2994 \textcolor{comment}{ !! for a dynamic estimate of the face areas at} 2995 \textcolor{comment}{ !! u-points.} 2996 \textcolor{keywordtype}{type}(local\_bt\_cont\_v\_type), \textcolor{keywordtype}{dimension(SZIW\_(MS),SZJBW\_(MS))}, \textcolor{keywordtype}{intent(in)} :: btcl\_v\textcolor{comment}{ !< Structure of information used} 2997 \textcolor{comment}{ !! for a dynamic estimate of the face areas at} 2998 \textcolor{comment}{ !! v-points.} 2999 3000 \textcolor{comment}{! Local variables} 3001 \textcolor{keywordtype}{real} :: i\_dt \textcolor{comment}{! The inverse of the time interval of this call [T-1 ~> s-1].} 3002 \textcolor{keywordtype}{integer} :: i, j, k, is, ie, js, je, n, nz, isq, ieq, jsq, jeq 3003 \textcolor{keywordtype}{integer} :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb 3004 \textcolor{keywordtype}{integer} :: isdw, iedw, jsdw, jedw 3005 \textcolor{keywordtype}{logical} :: obc\_used 3006 \textcolor{keywordtype}{type}(obc\_segment\_type), \textcolor{keywordtype}{pointer} :: segment\textcolor{comment}{ !< Open boundary segment} 3007 3008 is = g%isc-halo ; ie = g%iec+halo ; js = g%jsc-halo ; je = g%jec+halo 3009 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed ; nz = g%ke 3010 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB 3011 isdw = ms%isdw ; iedw = ms%iedw ; jsdw = ms%jsdw ; jedw = ms%jedw 3012 3013 i\_dt = 1.0 / dt\_baroclinic 3014 3015 \textcolor{keywordflow}{if} ((isdw < isd) .or. (jsdw < jsd)) \textcolor{keywordflow}{then} 3016 \textcolor{keyword}{call }mom\_error(fatal, \textcolor{stringliteral}{"set\_up\_BT\_OBC: Open boundary conditions are not "}//& 3017 \textcolor{stringliteral}{"yet fully implemented with wide barotropic halos."}) 3018 \textcolor{keywordflow}{ endif} 3019 3020 \textcolor{keywordflow}{if} (.not. bt\_obc%is\_alloced) \textcolor{keywordflow}{then} 3021 \textcolor{keyword}{allocate}(bt\_obc%Cg\_u(isdw-1:iedw,jsdw:jedw)) ; bt\_obc%Cg\_u(:,:) = 0.0 3022 \textcolor{keyword}{allocate}(bt\_obc%H\_u(isdw-1:iedw,jsdw:jedw)) ; bt\_obc%H\_u(:,:) = 0.0 3023 \textcolor{keyword}{allocate}(bt\_obc%uhbt(isdw-1:iedw,jsdw:jedw)) ; bt\_obc%uhbt(:,:) = 0.0 3024 \textcolor{keyword}{allocate}(bt\_obc%ubt\_outer(isdw-1:iedw,jsdw:jedw)) ; bt\_obc%ubt\_outer(:,:) = 0.0 3025 \textcolor{keyword}{allocate}(bt\_obc%eta\_outer\_u(isdw-1:iedw,jsdw:jedw)) ; bt\_obc%eta\_outer\_u(:,:) = 0.0 3026 3027 \textcolor{keyword}{allocate}(bt\_obc%Cg\_v(isdw:iedw,jsdw-1:jedw)) ; bt\_obc%Cg\_v(:,:) = 0.0 3028 \textcolor{keyword}{allocate}(bt\_obc%H\_v(isdw:iedw,jsdw-1:jedw)) ; bt\_obc%H\_v(:,:) = 0.0 3029 \textcolor{keyword}{allocate}(bt\_obc%vhbt(isdw:iedw,jsdw-1:jedw)) ; bt\_obc%vhbt(:,:) = 0.0 3030 \textcolor{keyword}{allocate}(bt\_obc%vbt\_outer(isdw:iedw,jsdw-1:jedw)) ; bt\_obc%vbt\_outer(:,:) = 0.0 3031 \textcolor{keyword}{allocate}(bt\_obc%eta\_outer\_v(isdw:iedw,jsdw-1:jedw)) ; bt\_obc%eta\_outer\_v(:,:)=0.0 3032 bt\_obc%is\_alloced = .true. 3033 \textcolor{keyword}{call }create\_group\_pass(bt\_obc%pass\_uv, bt\_obc%ubt\_outer, bt\_obc%vbt\_outer, bt\_domain) 3034 \textcolor{keyword}{call }create\_group\_pass(bt\_obc%pass\_uhvh, bt\_obc%uhbt, bt\_obc%vhbt, bt\_domain) 3035 \textcolor{keyword}{call }create\_group\_pass(bt\_obc%pass\_eta\_outer, bt\_obc%eta\_outer\_u, bt\_obc%eta\_outer\_v, bt\_domain,to\_all+ scalar\_pair) 3036 \textcolor{keyword}{call }create\_group\_pass(bt\_obc%pass\_h, bt\_obc%H\_u, bt\_obc%H\_v, bt\_domain,to\_all+scalar\_pair) 3037 \textcolor{keyword}{call }create\_group\_pass(bt\_obc%pass\_cg, bt\_obc%Cg\_u, bt\_obc%Cg\_v, bt\_domain,to\_all+scalar\_pair) 3038 \textcolor{keywordflow}{ endif} 3039 3040 \textcolor{keywordflow}{if} (bt\_obc%apply\_u\_OBCs) \textcolor{keywordflow}{then} 3041 \textcolor{keywordflow}{if} (obc%specified\_u\_BCs\_exist\_globally) \textcolor{keywordflow}{then} 3042 \textcolor{keywordflow}{do} n = 1, obc%number\_of\_segments 3043 segment => obc%segment(n) 3044 \textcolor{keywordflow}{if} (segment%is\_E\_or\_W .and. segment%specified) \textcolor{keywordflow}{then} 3045 \textcolor{keywordflow}{do} j=segment%HI%jsd,segment%HI%jed ; \textcolor{keywordflow}{do} i=segment%HI%IsdB,segment%HI%IedB 3046 bt\_obc%uhbt(i,j) = 0. 3047 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3048 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} j=segment%HI%jsd,segment%HI%jed ; \textcolor{keywordflow}{do} i=segment%HI%IsdB,segment%HI%IedB 3049 bt\_obc%uhbt(i,j) = bt\_obc%uhbt(i,j) + segment%normal\_trans(i,j,k) 3050 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3051 \textcolor{keywordflow}{ endif} 3052 \textcolor{keywordflow}{ enddo} 3053 \textcolor{keywordflow}{ endif} 3054 \textcolor{keywordflow}{do} j=js,je ; \textcolor{keywordflow}{do} i=is-1,ie ; \textcolor{keywordflow}{if} (obc%segnum\_u(i,j) /= obc\_none) \textcolor{keywordflow}{then} 3055 \textcolor{comment}{! Can this go in segment loop above? Is loop above wrong for wide halos??} 3056 \textcolor{keywordflow}{if} (obc%segment(obc%segnum\_u(i,j))%specified) \textcolor{keywordflow}{then} 3057 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 3058 bt\_obc%ubt\_outer(i,j) = uhbt\_to\_ubt(bt\_obc%uhbt(i,j)*dt\_baroclinic, btcl\_u(i,j)) * i\_dt 3059 \textcolor{keywordflow}{elseif} (use\_bt\_cont) \textcolor{keywordflow}{then} 3060 bt\_obc%ubt\_outer(i,j) = uhbt\_to\_ubt(bt\_obc%uhbt(i,j), btcl\_u(i,j)) 3061 \textcolor{keywordflow}{else} 3062 \textcolor{keywordflow}{if} (datu(i,j) > 0.0) bt\_obc%ubt\_outer(i,j) = bt\_obc%uhbt(i,j) / datu(i,j) 3063 \textcolor{keywordflow}{ endif} 3064 \textcolor{keywordflow}{else} \textcolor{comment}{! This is assuming Flather as only other option} 3065 \textcolor{keywordflow}{if} (gv%Boussinesq) \textcolor{keywordflow}{then} 3066 \textcolor{keywordflow}{if} (obc%segment(obc%segnum\_u(i,j))%direction == obc\_direction\_e) \textcolor{keywordflow}{then} 3067 bt\_obc%H\_u(i,j) = g%bathyT(i,j)*gv%Z\_to\_H + eta(i,j) 3068 \textcolor{keywordflow}{elseif} (obc%segment(obc%segnum\_u(i,j))%direction == obc\_direction\_w) \textcolor{keywordflow}{then} 3069 bt\_obc%H\_u(i,j) = g%bathyT(i+1,j)*gv%Z\_to\_H + eta(i+1,j) 3070 \textcolor{keywordflow}{ endif} 3071 \textcolor{keywordflow}{else} 3072 \textcolor{keywordflow}{if} (obc%segment(obc%segnum\_u(i,j))%direction == obc\_direction\_e) \textcolor{keywordflow}{then} 3073 bt\_obc%H\_u(i,j) = eta(i,j) 3074 \textcolor{keywordflow}{elseif} (obc%segment(obc%segnum\_u(i,j))%direction == obc\_direction\_w) \textcolor{keywordflow}{then} 3075 bt\_obc%H\_u(i,j) = eta(i+1,j) 3076 \textcolor{keywordflow}{ endif} 3077 \textcolor{keywordflow}{ endif} 3078 bt\_obc%Cg\_u(i,j) = sqrt(gv%g\_prime(1) * gv%H\_to\_Z*bt\_obc%H\_u(i,j)) 3079 \textcolor{keywordflow}{ endif} 3080 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3081 \textcolor{keywordflow}{if} (obc%Flather\_u\_BCs\_exist\_globally) \textcolor{keywordflow}{then} 3082 \textcolor{keywordflow}{do} n = 1, obc%number\_of\_segments 3083 segment => obc%segment(n) 3084 \textcolor{keywordflow}{if} (segment%is\_E\_or\_W .and. segment%Flather) \textcolor{keywordflow}{then} 3085 \textcolor{keywordflow}{do} j=segment%HI%jsd,segment%HI%jed ; \textcolor{keywordflow}{do} i=segment%HI%IsdB,segment%HI%IedB 3086 bt\_obc%ubt\_outer(i,j) = segment%normal\_vel\_bt(i,j) 3087 bt\_obc%eta\_outer\_u(i,j) = segment%eta(i,j) 3088 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3089 \textcolor{keywordflow}{ endif} 3090 \textcolor{keywordflow}{ enddo} 3091 \textcolor{keywordflow}{ endif} 3092 \textcolor{keywordflow}{ endif} 3093 3094 \textcolor{keywordflow}{if} (bt\_obc%apply\_v\_OBCs) \textcolor{keywordflow}{then} 3095 \textcolor{keywordflow}{if} (obc%specified\_v\_BCs\_exist\_globally) \textcolor{keywordflow}{then} 3096 \textcolor{keywordflow}{do} n = 1, obc%number\_of\_segments 3097 segment => obc%segment(n) 3098 \textcolor{keywordflow}{if} (segment%is\_N\_or\_S .and. segment%specified) \textcolor{keywordflow}{then} 3099 \textcolor{keywordflow}{do} j=segment%HI%JsdB,segment%HI%JedB ; \textcolor{keywordflow}{do} i=segment%HI%isd,segment%HI%ied 3100 bt\_obc%vhbt(i,j) = 0. 3101 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3102 \textcolor{keywordflow}{do} k=1,nz ; \textcolor{keywordflow}{do} j=segment%HI%JsdB,segment%HI%JedB ; \textcolor{keywordflow}{do} i=segment%HI%isd,segment%HI%ied 3103 bt\_obc%vhbt(i,j) = bt\_obc%vhbt(i,j) + segment%normal\_trans(i,j,k) 3104 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3105 \textcolor{keywordflow}{ endif} 3106 \textcolor{keywordflow}{ enddo} 3107 \textcolor{keywordflow}{ endif} 3108 \textcolor{keywordflow}{do} j=js-1,je ; \textcolor{keywordflow}{do} i=is,ie ; \textcolor{keywordflow}{if} (obc%segnum\_v(i,j) /= obc\_none) \textcolor{keywordflow}{then} 3109 \textcolor{comment}{! Can this go in segment loop above? Is loop above wrong for wide halos??} 3110 \textcolor{keywordflow}{if} (obc%segment(obc%segnum\_v(i,j))%specified) \textcolor{keywordflow}{then} 3111 \textcolor{keywordflow}{if} (integral\_bt\_cont) \textcolor{keywordflow}{then} 3112 bt\_obc%vbt\_outer(i,j) = vhbt\_to\_vbt(bt\_obc%vhbt(i,j)*dt\_baroclinic, btcl\_v(i,j)) * i\_dt 3113 \textcolor{keywordflow}{elseif} (use\_bt\_cont) \textcolor{keywordflow}{then} 3114 bt\_obc%vbt\_outer(i,j) = vhbt\_to\_vbt(bt\_obc%vhbt(i,j), btcl\_v(i,j)) 3115 \textcolor{keywordflow}{else} 3116 \textcolor{keywordflow}{if} (datv(i,j) > 0.0) bt\_obc%vbt\_outer(i,j) = bt\_obc%vhbt(i,j) / datv(i,j) 3117 \textcolor{keywordflow}{ endif} 3118 \textcolor{keywordflow}{else} \textcolor{comment}{! This is assuming Flather as only other option} 3119 \textcolor{keywordflow}{if} (gv%Boussinesq) \textcolor{keywordflow}{then} 3120 \textcolor{keywordflow}{if} (obc%segment(obc%segnum\_v(i,j))%direction == obc\_direction\_n) \textcolor{keywordflow}{then} 3121 bt\_obc%H\_v(i,j) = g%bathyT(i,j)*gv%Z\_to\_H + eta(i,j) 3122 \textcolor{keywordflow}{elseif} (obc%segment(obc%segnum\_v(i,j))%direction == obc\_direction\_s) \textcolor{keywordflow}{then} 3123 bt\_obc%H\_v(i,j) = g%bathyT(i,j+1)*gv%Z\_to\_H + eta(i,j+1) 3124 \textcolor{keywordflow}{ endif} 3125 \textcolor{keywordflow}{else} 3126 \textcolor{keywordflow}{if} (obc%segment(obc%segnum\_v(i,j))%direction == obc\_direction\_n) \textcolor{keywordflow}{then} 3127 bt\_obc%H\_v(i,j) = eta(i,j) 3128 \textcolor{keywordflow}{elseif} (obc%segment(obc%segnum\_v(i,j))%direction == obc\_direction\_s) \textcolor{keywordflow}{then} 3129 bt\_obc%H\_v(i,j) = eta(i,j+1) 3130 \textcolor{keywordflow}{ endif} 3131 \textcolor{keywordflow}{ endif} 3132 bt\_obc%Cg\_v(i,j) = sqrt(gv%g\_prime(1) * gv%H\_to\_Z*bt\_obc%H\_v(i,j)) 3133 \textcolor{keywordflow}{ endif} 3134 \textcolor{keywordflow}{ endif} ;\textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3135 \textcolor{keywordflow}{if} (obc%Flather\_v\_BCs\_exist\_globally) \textcolor{keywordflow}{then} 3136 \textcolor{keywordflow}{do} n = 1, obc%number\_of\_segments 3137 segment => obc%segment(n) 3138 \textcolor{keywordflow}{if} (segment%is\_N\_or\_S .and. segment%Flather) \textcolor{keywordflow}{then} 3139 \textcolor{keywordflow}{do} j=segment%HI%JsdB,segment%HI%JedB ; \textcolor{keywordflow}{do} i=segment%HI%isd,segment%HI%ied 3140 bt\_obc%vbt\_outer(i,j) = segment%normal\_vel\_bt(i,j) 3141 bt\_obc%eta\_outer\_v(i,j) = segment%eta(i,j) 3142 \textcolor{keywordflow}{ enddo} ;\textcolor{keywordflow}{ enddo} 3143 \textcolor{keywordflow}{ endif} 3144 \textcolor{keywordflow}{ enddo} 3145 \textcolor{keywordflow}{ endif} 3146 \textcolor{keywordflow}{ endif} 3147 3148 \textcolor{keyword}{call }do\_group\_pass(bt\_obc%pass\_uv, bt\_domain) 3149 \textcolor{keyword}{call }do\_group\_pass(bt\_obc%pass\_uhvh, bt\_domain) 3150 \textcolor{keyword}{call }do\_group\_pass(bt\_obc%pass\_eta\_outer, bt\_domain) 3151 \textcolor{keyword}{call }do\_group\_pass(bt\_obc%pass\_h, bt\_domain) 3152 \textcolor{keyword}{call }do\_group\_pass(bt\_obc%pass\_cg, bt\_domain) 3153 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_af1813744cf2034c2413ef904bf628263}\label{namespacemom__barotropic_af1813744cf2034c2413ef904bf628263}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!swap@{swap}} \index{swap@{swap}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{swap()}{swap()}} {\footnotesize\ttfamily subroutine mom\+\_\+barotropic\+::swap (\begin{DoxyParamCaption}\item[{real, intent(inout)}]{a, }\item[{real, intent(inout)}]{b }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} Swap the values of two real variables. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in,out} & {\em a} & The first variable to be swapped.\\ \hline \mbox{\tt in,out} & {\em b} & The second variable to be swapped. \\ \hline \end{DoxyParams} Definition at line 4040 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 4040 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(inout)} :: a\textcolor{comment}{ !< The first variable to be swapped.} 4041 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(inout)} :: b\textcolor{comment}{ !< The second variable to be swapped.} 4042 \textcolor{keywordtype}{real} :: tmp 4043 tmp = a ; a = b ; b = tmp \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_a0311f0f3d4e27f4017582d6a8c01298c}\label{namespacemom__barotropic_a0311f0f3d4e27f4017582d6a8c01298c}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!uhbt\+\_\+to\+\_\+ubt@{uhbt\+\_\+to\+\_\+ubt}} \index{uhbt\+\_\+to\+\_\+ubt@{uhbt\+\_\+to\+\_\+ubt}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{uhbt\+\_\+to\+\_\+ubt()}{uhbt\_to\_ubt()}} {\footnotesize\ttfamily real function mom\+\_\+barotropic\+::uhbt\+\_\+to\+\_\+ubt (\begin{DoxyParamCaption}\item[{real, intent(in)}]{uhbt, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__u__type}{local\+\_\+bt\+\_\+cont\+\_\+u\+\_\+type}), intent(in)}]{B\+TC, }\item[{real, intent(in), optional}]{guess }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} This function inverts the transport function to determine the barotopic velocity that is consistent with a given transport, or if I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT=True this finds the time-\/integrated velocity that is consistent with a time-\/integrated transport. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in} & {\em uhbt} & The barotropic zonal transport that should be inverted for, \mbox{[}H L2 T-\/1 $\sim$$>$ m3 s-\/1 or kg s-\/1\mbox{]} or the time-\/integrated transport \mbox{[}H L2 $\sim$$>$ m3 or kg\mbox{]}.\\ \hline \mbox{\tt in} & {\em btc} & A structure containing various fields that allow the barotropic transports to be calculated consistently with the layers\textquotesingle{} continuity equations. The dimensions of some of the elements in this type vary depending on I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT.\\ \hline \mbox{\tt in} & {\em guess} & A guess at what ubt will be \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]} or \mbox{[}L $\sim$$>$ m\mbox{]}. The result is not allowed to be dramatically larger than guess.\\ \hline \end{DoxyParams} \begin{DoxyReturn}{Returns} The result -\/ The velocity that gives uhbt transport \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]} or the time-\/integrated velocity \mbox{[}L $\sim$$>$ m\mbox{]}. \end{DoxyReturn} Definition at line 3509 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 3509 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(in)} :: uhbt\textcolor{comment}{ !< The barotropic zonal transport that should be inverted for,} 3510 \textcolor{comment}{ !! [H L2 T-1 ~> m3 s-1 or kg s-1] or the time-integrated} 3511 \textcolor{comment}{ !! transport [H L2 ~> m3 or kg].} 3512 \textcolor{keywordtype}{type}(local\_bt\_cont\_u\_type), \textcolor{keywordtype}{intent(in)} :: btc\textcolor{comment}{ !< A structure containing various fields that allow the} 3513 \textcolor{comment}{ !! barotropic transports to be calculated consistently with the} 3514 \textcolor{comment}{ !! layers' continuity equations. The dimensions of some} 3515 \textcolor{comment}{ !! of the elements in this type vary depending on INTEGRAL\_BT\_CONT.} 3516 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: guess\textcolor{comment}{ !< A guess at what ubt will be [L T-1 ~> m s-1] or [L ~> m].} 3517 \textcolor{comment}{ !! The result is not allowed to be dramatically larger than guess.} 3518 \textcolor{keywordtype}{real} :: ubt\textcolor{comment}{ !< The result - The velocity that gives uhbt transport [L T-1 ~> m s-1]} 3519 \textcolor{comment}{ !! or the time-integrated velocity [L ~> m].} 3520 3521 \textcolor{comment}{! Local variables} 3522 \textcolor{keywordtype}{real} :: ubt\_min, ubt\_max \textcolor{comment}{! Bounding values of vbt [L T-1 ~> m s-1] or [L ~> m]} 3523 \textcolor{keywordtype}{real} :: uhbt\_err \textcolor{comment}{! The transport error [H L2 T-1 ~> m3 s-1 or kg s-1] or [H L2 ~> m3 or kg].} 3524 \textcolor{keywordtype}{real} :: derr\_du \textcolor{comment}{! The change in transport error with vbt, i.e. the face area [H L ~> m2 or kg m-1].} 3525 \textcolor{keywordtype}{real} :: uherr\_min, uherr\_max \textcolor{comment}{! The bounding values of the transport error [H L2 T-1 ~> m3 s-1 or kg s-1]} 3526 \textcolor{comment}{! or [H L2 ~> m3 or kg].} 3527 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{parameter} :: tol = 1.0e-10 \textcolor{comment}{! A fractional match tolerance [nondim]} 3528 \textcolor{keywordtype}{real} :: dvel \textcolor{comment}{! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1] or [L ~> m].} 3529 \textcolor{keywordtype}{real} :: vsr \textcolor{comment}{! Temporary variable used in the limiting the velocity [nondim].} 3530 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{parameter} :: vs1 = 1.25 \textcolor{comment}{! Nondimensional parameters used in limiting} 3531 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{parameter} :: vs2 = 2.0 \textcolor{comment}{! the velocity, starting at vs1, with the} 3532 \textcolor{comment}{! maximum increase of vs2, both nondim.} 3533 \textcolor{keywordtype}{integer} :: itt, max\_itt = 20 3534 3535 \textcolor{comment}{! Find the value of ubt that gives uhbt.} 3536 \textcolor{keywordflow}{if} (uhbt == 0.0) \textcolor{keywordflow}{then} 3537 ubt = 0.0 3538 \textcolor{keywordflow}{elseif} (uhbt < btc%uh\_EE) \textcolor{keywordflow}{then} 3539 ubt = btc%uBT\_EE + (uhbt - btc%uh\_EE) / btc%FA\_u\_EE 3540 \textcolor{keywordflow}{elseif} (uhbt < 0.0) \textcolor{keywordflow}{then} 3541 \textcolor{comment}{! Iterate to convergence with Newton's method (when bounded) and the} 3542 \textcolor{comment}{! false position method otherwise. ubt will be negative.} 3543 ubt\_min = btc%uBT\_EE ; uherr\_min = btc%uh\_EE - uhbt 3544 ubt\_max = 0.0 ; uherr\_max = -uhbt 3545 \textcolor{comment}{! Use a false-position method first guess.} 3546 ubt = btc%uBT\_EE * (uhbt / btc%uh\_EE) 3547 \textcolor{keywordflow}{do} itt = 1, max\_itt 3548 uhbt\_err = ubt * (btc%FA\_u\_E0 + btc%uh\_crvE * ubt**2) - uhbt 3549 3550 \textcolor{keywordflow}{if} (abs(uhbt\_err) < tol*abs(uhbt)) \textcolor{keywordflow}{exit} 3551 \textcolor{keywordflow}{if} (uhbt\_err > 0.0) \textcolor{keywordflow}{then} ; ubt\_max = ubt ; uherr\_max = uhbt\_err ;\textcolor{keywordflow}{ endif} 3552 \textcolor{keywordflow}{if} (uhbt\_err < 0.0) \textcolor{keywordflow}{then} ; ubt\_min = ubt ; uherr\_min = uhbt\_err ;\textcolor{keywordflow}{ endif} 3553 3554 derr\_du = btc%FA\_u\_E0 + 3.0 * btc%uh\_crvE * ubt**2 3555 \textcolor{keywordflow}{if} ((uhbt\_err >= derr\_du*(ubt - ubt\_min)) .or. & 3556 (-uhbt\_err >= derr\_du*(ubt\_max - ubt)) .or. (derr\_du <= 0.0)) \textcolor{keywordflow}{then} 3557 \textcolor{comment}{! Use a false-position method guess.} 3558 ubt = ubt\_max + (ubt\_min-ubt\_max) * (uherr\_max / (uherr\_max-uherr\_min)) 3559 \textcolor{keywordflow}{else} \textcolor{comment}{! Use Newton's method.} 3560 ubt = ubt - uhbt\_err / derr\_du 3561 \textcolor{keywordflow}{if} (abs(uhbt\_err) < (0.01*tol)*abs(ubt\_min*derr\_du)) \textcolor{keywordflow}{exit} 3562 \textcolor{keywordflow}{ endif} 3563 \textcolor{keywordflow}{ enddo} 3564 \textcolor{keywordflow}{elseif} (uhbt <= btc%uh\_WW) \textcolor{keywordflow}{then} 3565 \textcolor{comment}{! Iterate to convergence with Newton's method. ubt will be positive.} 3566 ubt\_min = 0.0 ; uherr\_min = -uhbt 3567 ubt\_max = btc%uBT\_WW ; uherr\_max = btc%uh\_WW - uhbt 3568 \textcolor{comment}{! Use a false-position method first guess.} 3569 ubt = btc%uBT\_WW * (uhbt / btc%uh\_WW) 3570 \textcolor{keywordflow}{do} itt = 1, max\_itt 3571 uhbt\_err = ubt * (btc%FA\_u\_W0 + btc%uh\_crvW * ubt**2) - uhbt 3572 3573 \textcolor{keywordflow}{if} (abs(uhbt\_err) < tol*abs(uhbt)) \textcolor{keywordflow}{exit} 3574 \textcolor{keywordflow}{if} (uhbt\_err > 0.0) \textcolor{keywordflow}{then} ; ubt\_max = ubt ; uherr\_max = uhbt\_err ;\textcolor{keywordflow}{ endif} 3575 \textcolor{keywordflow}{if} (uhbt\_err < 0.0) \textcolor{keywordflow}{then} ; ubt\_min = ubt ; uherr\_min = uhbt\_err ;\textcolor{keywordflow}{ endif} 3576 3577 derr\_du = btc%FA\_u\_W0 + 3.0 * btc%uh\_crvW * ubt**2 3578 \textcolor{keywordflow}{if} ((uhbt\_err >= derr\_du*(ubt - ubt\_min)) .or. & 3579 (-uhbt\_err >= derr\_du*(ubt\_max - ubt)) .or. (derr\_du <= 0.0)) \textcolor{keywordflow}{then} 3580 \textcolor{comment}{! Use a false-position method guess.} 3581 ubt = ubt\_min + (ubt\_max-ubt\_min) * (-uherr\_min / (uherr\_max-uherr\_min)) 3582 \textcolor{keywordflow}{else} \textcolor{comment}{! Use Newton's method.} 3583 ubt = ubt - uhbt\_err / derr\_du 3584 \textcolor{keywordflow}{if} (abs(uhbt\_err) < (0.01*tol)*(ubt\_max*derr\_du)) \textcolor{keywordflow}{exit} 3585 \textcolor{keywordflow}{ endif} 3586 \textcolor{keywordflow}{ enddo} 3587 \textcolor{keywordflow}{else} \textcolor{comment}{! (uhbt > BTC%uh\_WW)} 3588 ubt = btc%uBT\_WW + (uhbt - btc%uh\_WW) / btc%FA\_u\_WW 3589 \textcolor{keywordflow}{ endif} 3590 3591 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(guess)) \textcolor{keywordflow}{then} 3592 dvel = abs(ubt) - vs1*abs(guess) 3593 \textcolor{keywordflow}{if} (dvel > 0.0) \textcolor{keywordflow}{then} \textcolor{comment}{! Limit the velocity} 3594 \textcolor{keywordflow}{if} (dvel < 40.0 * (abs(guess)*(vs2-vs1)) ) \textcolor{keywordflow}{then} 3595 vsr = vs2 - (vs2-vs1) * exp(-dvel / (abs(guess)*(vs2-vs1))) 3596 \textcolor{keywordflow}{else} \textcolor{comment}{! The exp is less than 4e-18 anyway in this case, so neglect it.} 3597 vsr = vs2 3598 \textcolor{keywordflow}{ endif} 3599 ubt = sign(vsr * guess, ubt) 3600 \textcolor{keywordflow}{ endif} 3601 \textcolor{keywordflow}{ endif} 3602 \end{DoxyCode} \mbox{\Hypertarget{namespacemom__barotropic_aeed3e618781611b448105a122e1a358c}\label{namespacemom__barotropic_aeed3e618781611b448105a122e1a358c}} \index{mom\+\_\+barotropic@{mom\+\_\+barotropic}!vhbt\+\_\+to\+\_\+vbt@{vhbt\+\_\+to\+\_\+vbt}} \index{vhbt\+\_\+to\+\_\+vbt@{vhbt\+\_\+to\+\_\+vbt}!mom\+\_\+barotropic@{mom\+\_\+barotropic}} \subsubsection{\texorpdfstring{vhbt\+\_\+to\+\_\+vbt()}{vhbt\_to\_vbt()}} {\footnotesize\ttfamily real function mom\+\_\+barotropic\+::vhbt\+\_\+to\+\_\+vbt (\begin{DoxyParamCaption}\item[{real, intent(in)}]{vhbt, }\item[{type(\hyperlink{structmom__barotropic_1_1local__bt__cont__v__type}{local\+\_\+bt\+\_\+cont\+\_\+v\+\_\+type}), intent(in)}]{B\+TC, }\item[{real, intent(in), optional}]{guess }\end{DoxyParamCaption})\hspace{0.3cm}{\ttfamily [private]}} This function inverts the transport function to determine the barotopic velocity that is consistent with a given transport, or if I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT=True this finds the time-\/integrated velocity that is consistent with a time-\/integrated transport. \begin{DoxyParams}[1]{Parameters} \mbox{\tt in} & {\em vhbt} & The barotropic meridional transport that should be inverted for \mbox{[}H L2 T-\/1 $\sim$$>$ m3 s-\/1 or kg s-\/1\mbox{]} or the time-\/integrated transport \mbox{[}H L2 $\sim$$>$ m3 or kg\mbox{]}.\\ \hline \mbox{\tt in} & {\em btc} & A structure containing various fields that allow the barotropic transports to be calculated consistently with the layers\textquotesingle{} continuity equations. The dimensions of some of the elements in this type vary depending on I\+N\+T\+E\+G\+R\+A\+L\+\_\+\+B\+T\+\_\+\+C\+O\+NT.\\ \hline \mbox{\tt in} & {\em guess} & A guess at what vbt will be \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]} or \mbox{[}L $\sim$$>$ m\mbox{]}. The result is not allowed to be dramatically larger than guess.\\ \hline \end{DoxyParams} \begin{DoxyReturn}{Returns} The result -\/ The velocity that gives vhbt transport \mbox{[}L T-\/1 $\sim$$>$ m s-\/1\mbox{]} or the time-\/integrated velocity \mbox{[}L $\sim$$>$ m\mbox{]}. \end{DoxyReturn} Definition at line 3658 of file M\+O\+M\+\_\+barotropic.\+F90. \begin{DoxyCode} 3658 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{intent(in)} :: vhbt\textcolor{comment}{ !< The barotropic meridional transport that should be} 3659 \textcolor{comment}{ !! inverted for [H L2 T-1 ~> m3 s-1 or kg s-1] or the} 3660 \textcolor{comment}{ !! time-integrated transport [H L2 ~> m3 or kg].} 3661 \textcolor{keywordtype}{type}(local\_bt\_cont\_v\_type), \textcolor{keywordtype}{intent(in)} :: btc\textcolor{comment}{ !< A structure containing various fields that allow the} 3662 \textcolor{comment}{ !! barotropic transports to be calculated consistently} 3663 \textcolor{comment}{ !! with the layers' continuity equations. The dimensions of some} 3664 \textcolor{comment}{ !! of the elements in this type vary depending on INTEGRAL\_BT\_CONT.} 3665 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{optional}, \textcolor{keywordtype}{intent(in)} :: guess\textcolor{comment}{ !< A guess at what vbt will be [L T-1 ~> m s-1] or [L ~> m].} 3666 \textcolor{comment}{ !! The result is not allowed to be dramatically larger than guess.} 3667 \textcolor{keywordtype}{real} :: vbt\textcolor{comment}{ !< The result - The velocity that gives vhbt transport [L T-1 ~> m s-1]} 3668 \textcolor{comment}{ !! or the time-integrated velocity [L ~> m].} 3669 3670 \textcolor{comment}{! Local variables} 3671 \textcolor{keywordtype}{real} :: vbt\_min, vbt\_max \textcolor{comment}{! Bounding values of vbt [L T-1 ~> m s-1] or [L ~> m]} 3672 \textcolor{keywordtype}{real} :: vhbt\_err \textcolor{comment}{! The transport error [H L2 T-1 ~> m3 s-1 or kg s-1] or [H L2 ~> m3 or kg].} 3673 \textcolor{keywordtype}{real} :: derr\_dv \textcolor{comment}{! The change in transport error with vbt, i.e. the face area [H L ~> m2 or kg m-1].} 3674 \textcolor{keywordtype}{real} :: vherr\_min, vherr\_max \textcolor{comment}{! The bounding values of the transport error [H L2 T-1 ~> m3 s-1 or kg s-1]} 3675 \textcolor{comment}{! or [H L2 ~> m3 or kg].} 3676 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{parameter} :: tol = 1.0e-10 \textcolor{comment}{! A fractional match tolerance [nondim]} 3677 \textcolor{keywordtype}{real} :: dvel \textcolor{comment}{! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1] or [L ~> m].} 3678 \textcolor{keywordtype}{real} :: vsr \textcolor{comment}{! Temporary variable used in the limiting the velocity [nondim].} 3679 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{parameter} :: vs1 = 1.25 \textcolor{comment}{! Nondimensional parameters used in limiting} 3680 \textcolor{keywordtype}{real}, \textcolor{keywordtype}{parameter} :: vs2 = 2.0 \textcolor{comment}{! the velocity, starting at vs1, with the} 3681 \textcolor{comment}{! maximum increase of vs2, both nondim.} 3682 \textcolor{keywordtype}{integer} :: itt, max\_itt = 20 3683 3684 \textcolor{comment}{! Find the value of vbt that gives vhbt.} 3685 \textcolor{keywordflow}{if} (vhbt == 0.0) \textcolor{keywordflow}{then} 3686 vbt = 0.0 3687 \textcolor{keywordflow}{elseif} (vhbt < btc%vh\_NN) \textcolor{keywordflow}{then} 3688 vbt = btc%vBT\_NN + (vhbt - btc%vh\_NN) / btc%FA\_v\_NN 3689 \textcolor{keywordflow}{elseif} (vhbt < 0.0) \textcolor{keywordflow}{then} 3690 \textcolor{comment}{! Iterate to convergence with Newton's method (when bounded) and the} 3691 \textcolor{comment}{! false position method otherwise. vbt will be negative.} 3692 vbt\_min = btc%vBT\_NN ; vherr\_min = btc%vh\_NN - vhbt 3693 vbt\_max = 0.0 ; vherr\_max = -vhbt 3694 \textcolor{comment}{! Use a false-position method first guess.} 3695 vbt = btc%vBT\_NN * (vhbt / btc%vh\_NN) 3696 \textcolor{keywordflow}{do} itt = 1, max\_itt 3697 vhbt\_err = vbt * (btc%FA\_v\_N0 + btc%vh\_crvN * vbt**2) - vhbt 3698 3699 \textcolor{keywordflow}{if} (abs(vhbt\_err) < tol*abs(vhbt)) \textcolor{keywordflow}{exit} 3700 \textcolor{keywordflow}{if} (vhbt\_err > 0.0) \textcolor{keywordflow}{then} ; vbt\_max = vbt ; vherr\_max = vhbt\_err ;\textcolor{keywordflow}{ endif} 3701 \textcolor{keywordflow}{if} (vhbt\_err < 0.0) \textcolor{keywordflow}{then} ; vbt\_min = vbt ; vherr\_min = vhbt\_err ;\textcolor{keywordflow}{ endif} 3702 3703 derr\_dv = btc%FA\_v\_N0 + 3.0 * btc%vh\_crvN * vbt**2 3704 \textcolor{keywordflow}{if} ((vhbt\_err >= derr\_dv*(vbt - vbt\_min)) .or. & 3705 (-vhbt\_err >= derr\_dv*(vbt\_max - vbt)) .or. (derr\_dv <= 0.0)) \textcolor{keywordflow}{then} 3706 \textcolor{comment}{! Use a false-position method guess.} 3707 vbt = vbt\_max + (vbt\_min-vbt\_max) * (vherr\_max / (vherr\_max-vherr\_min)) 3708 \textcolor{keywordflow}{else} \textcolor{comment}{! Use Newton's method.} 3709 vbt = vbt - vhbt\_err / derr\_dv 3710 \textcolor{keywordflow}{if} (abs(vhbt\_err) < (0.01*tol)*abs(derr\_dv*vbt\_min)) \textcolor{keywordflow}{exit} 3711 \textcolor{keywordflow}{ endif} 3712 \textcolor{keywordflow}{ enddo} 3713 \textcolor{keywordflow}{elseif} (vhbt <= btc%vh\_SS) \textcolor{keywordflow}{then} 3714 \textcolor{comment}{! Iterate to convergence with Newton's method. vbt will be positive.} 3715 vbt\_min = 0.0 ; vherr\_min = -vhbt 3716 vbt\_max = btc%vBT\_SS ; vherr\_max = btc%vh\_SS - vhbt 3717 \textcolor{comment}{! Use a false-position method first guess.} 3718 vbt = btc%vBT\_SS * (vhbt / btc%vh\_SS) 3719 \textcolor{keywordflow}{do} itt = 1, max\_itt 3720 vhbt\_err = vbt * (btc%FA\_v\_S0 + btc%vh\_crvS * vbt**2) - vhbt 3721 3722 \textcolor{keywordflow}{if} (abs(vhbt\_err) < tol*abs(vhbt)) \textcolor{keywordflow}{exit} 3723 \textcolor{keywordflow}{if} (vhbt\_err > 0.0) \textcolor{keywordflow}{then} ; vbt\_max = vbt ; vherr\_max = vhbt\_err ;\textcolor{keywordflow}{ endif} 3724 \textcolor{keywordflow}{if} (vhbt\_err < 0.0) \textcolor{keywordflow}{then} ; vbt\_min = vbt ; vherr\_min = vhbt\_err ;\textcolor{keywordflow}{ endif} 3725 3726 derr\_dv = btc%FA\_v\_S0 + 3.0 * btc%vh\_crvS * vbt**2 3727 \textcolor{keywordflow}{if} ((vhbt\_err >= derr\_dv*(vbt - vbt\_min)) .or. & 3728 (-vhbt\_err >= derr\_dv*(vbt\_max - vbt)) .or. (derr\_dv <= 0.0)) \textcolor{keywordflow}{then} 3729 \textcolor{comment}{! Use a false-position method guess.} 3730 vbt = vbt\_min + (vbt\_max-vbt\_min) * (-vherr\_min / (vherr\_max-vherr\_min)) 3731 \textcolor{keywordflow}{else} \textcolor{comment}{! Use Newton's method.} 3732 vbt = vbt - vhbt\_err / derr\_dv 3733 \textcolor{keywordflow}{if} (abs(vhbt\_err) < (0.01*tol)*(vbt\_max*derr\_dv)) \textcolor{keywordflow}{exit} 3734 \textcolor{keywordflow}{ endif} 3735 \textcolor{keywordflow}{ enddo} 3736 \textcolor{keywordflow}{else} \textcolor{comment}{! (vhbt > BTC%vh\_SS)} 3737 vbt = btc%vBT\_SS + (vhbt - btc%vh\_SS) / btc%FA\_v\_SS 3738 \textcolor{keywordflow}{ endif} 3739 3740 \textcolor{keywordflow}{if} (\textcolor{keyword}{present}(guess)) \textcolor{keywordflow}{then} 3741 dvel = abs(vbt) - vs1*abs(guess) 3742 \textcolor{keywordflow}{if} (dvel > 0.0) \textcolor{keywordflow}{then} \textcolor{comment}{! Limit the velocity} 3743 \textcolor{keywordflow}{if} (dvel < 40.0 * (abs(guess)*(vs2-vs1)) ) \textcolor{keywordflow}{then} 3744 vsr = vs2 - (vs2-vs1) * exp(-dvel / (abs(guess)*(vs2-vs1))) 3745 \textcolor{keywordflow}{else} \textcolor{comment}{! The exp is less than 4e-18 anyway in this case, so neglect it.} 3746 vsr = vs2 3747 \textcolor{keywordflow}{ endif} 3748 vbt = sign(guess * vsr, vbt) 3749 \textcolor{keywordflow}{ endif} 3750 \textcolor{keywordflow}{ endif} 3751 \end{DoxyCode}