MOM6
MOM_PressureForce_blocked_AFV.F90
1 !> Analytically integrated finite volume pressure gradient
3 
4 ! This file is part of MOM6. See LICENSE.md for the license.
5 
6 use mom_diag_mediator, only : post_data, register_diag_field
7 use mom_diag_mediator, only : safe_alloc_ptr, diag_ctrl, time_type
8 use mom_error_handler, only : mom_error, fatal, warning, is_root_pe
10 use mom_grid, only : ocean_grid_type
11 use mom_pressureforce_mont, only : set_pbce_bouss, set_pbce_nonbouss
12 use mom_tidal_forcing, only : calc_tidal_forcing, tidal_forcing_cs
17 use mom_eos, only : int_density_dz, int_specific_vol_dp
18 use mom_eos, only : int_density_dz_generic_plm, int_density_dz_generic_ppm
19 use mom_eos, only : int_spec_vol_dp_generic_plm
20 use mom_eos, only : int_density_dz_generic, int_spec_vol_dp_generic
21 use mom_ale, only : pressure_gradient_plm, pressure_gradient_ppm, ale_cs
22 
23 implicit none ; private
24 
25 #include <MOM_memory.h>
26 
27 public pressureforce_blk_afv, pressureforce_blk_afv_init, pressureforce_blk_afv_end
28 public pressureforce_blk_afv_bouss, pressureforce_blk_afv_nonbouss
29 
30 ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
31 ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
32 ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units
33 ! vary with the Boussinesq approximation, the Boussinesq variant is given first.
34 
35 !> Finite volume pressure gradient control structure
36 type, public :: pressureforce_blk_afv_cs ; private
37  logical :: tides !< If true, apply tidal momentum forcing.
38  real :: rho0 !< The density used in the Boussinesq
39  !! approximation [kg m-3].
40  real :: gfs_scale !< A scaling of the surface pressure gradients to
41  !! allow the use of a reduced gravity model [nondim].
42  type(time_type), pointer :: time !< A pointer to the ocean model's clock.
43  type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the
44  !! timing of diagnostic output.
45  logical :: usemasswghtinterp !< Use mass weighting in T/S interpolation
46  logical :: boundary_extrap !< Indicate whether high-order boundary
47  !! extrapolation should be used within boundary cells
48 
49  logical :: reconstruct !< If true, polynomial profiles of T & S will be
50  !! reconstructed and used in the integrals for the
51  !! finite volume pressure gradient calculation.
52  !! The default depends on whether regridding is being used.
53 
54  integer :: recon_scheme !< Order of the polynomial of the reconstruction of T & S
55  !! for the finite volume pressure gradient calculation.
56  !! By the default (1) is for a piecewise linear method
57 
58  integer :: id_e_tidal = -1 !< Diagnostic identifier
59  type(tidal_forcing_cs), pointer :: tides_csp => null() !< Tides control structure
61 
62 contains
63 
64 !> Thin interface between the model and the Boussinesq and non-Boussinesq
65 !! pressure force routines.
66 subroutine pressureforce_blk_afv(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta)
67  type(ocean_grid_type), intent(in) :: g !< Ocean grid structure
68  type(verticalgrid_type), intent(in) :: gv !< Vertical grid structure
69  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
70  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]
71  type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables
72  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: pfu !< Zonal acceleration [m s-2]
73  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: pfv !< Meridional acceleration [m s-2]
74  type(pressureforce_blk_afv_cs), pointer :: cs !< Finite volume PGF control structure
75  type(ale_cs), pointer :: ale_csp !< ALE control structure
76  real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean
77  !! or atmosphere-ocean interface [Pa].
78  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure
79  !! anomaly in each layer due to eta anomalies
80  !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1].
81  real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to
82  !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal
83  !! contributions or compressibility compensation.
84 
85  if (gv%Boussinesq) then
86  call pressureforce_blk_afv_bouss(h, tv, pfu, pfv, g, gv, us, cs, ale_csp, p_atm, pbce, eta)
87  else
88  call pressureforce_blk_afv_nonbouss(h, tv, pfu, pfv, g, gv, us, cs, p_atm, pbce, eta)
89  endif
90 
91 end subroutine pressureforce_blk_afv
92 
93 !> \brief Non-Boussinesq analytically-integrated finite volume form of pressure gradient
94 !!
95 !! Determines the acceleration due to hydrostatic pressure forces, using the
96 !! analytic finite volume form of the Pressure gradient, and does not make the
97 !! Boussinesq approximation. This version uses code-blocking for threads.
98 !!
99 !! To work, the following fields must be set outside of the usual (is:ie,js:je)
100 !! range before this subroutine is called:
101 !! h(isB:ie+1,jsB:je+1), T(isB:ie+1,jsB:je+1), and S(isB:ie+1,jsB:je+1).
102 subroutine pressureforce_blk_afv_nonbouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, eta)
103  type(ocean_grid_type), intent(in) :: g !< Ocean grid structure
104  type(verticalgrid_type), intent(in) :: gv !< Vertical grid structure
105  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
106  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> kg m-2]
107  type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables
108  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: pfu !< Zonal acceleration [m s-2]
109  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: pfv !< Meridional acceleration [m s-2]
110  type(pressureforce_blk_afv_cs), pointer :: cs !< Finite volume PGF control structure
111  real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean
112  !! or atmosphere-ocean interface [Pa].
113  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure
114  !! anomaly in each layer due to eta anomalies
115  !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1].
116  real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to
117  !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal
118  !! contributions or compressibility compensation.
119  ! Local variables
120  real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [Pa].
121  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: &
122  t_tmp, & ! Temporary array of temperatures where layers that are lighter
123  ! than the mixed layer have the mixed layer's properties [degC].
124  s_tmp ! Temporary array of salinities where layers that are lighter
125  ! than the mixed layer have the mixed layer's properties [ppt].
126  real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: &
127  dza, & ! The change in geopotential anomaly between the top and bottom
128  ! of a layer [m2 s-2].
129  intp_dza ! The vertical integral in depth of the pressure anomaly less
130  ! the pressure anomaly at the top of the layer [Pa m2 s-2].
131  real, dimension(SZI_(G),SZJ_(G)) :: &
132  dp, & ! The (positive) change in pressure across a layer [Pa].
133  ssh, & ! The sea surface height anomaly, in depth units [Z ~> m].
134  e_tidal, & ! The bottom geopotential anomaly due to tidal forces from
135  ! astronomical sources and self-attraction and loading [Z ~> m].
136  dm, & ! The barotropic adjustment to the Montgomery potential to
137  ! account for a reduced gravity model [m2 s-2].
138  za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the
139  ! interface atop a layer [m2 s-2].
140  real, dimension(SZDI_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices
141  dp_bk, & ! The (positive) change in pressure across a layer [Pa].
142  za_bk ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the
143  ! interface atop a layer [m2 s-2].
144 
145  real, dimension(SZI_(G)) :: rho_cv_bl ! The coordinate potential density in the deepest variable
146  ! density near-surface layer [kg m-3].
147  real, dimension(SZDIB_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices
148  intx_za_bk ! The zonal integral of the geopotential anomaly along the
149  ! interface below a layer, divided by the grid spacing [m2 s-2].
150  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: &
151  intx_dza ! The change in intx_za through a layer [m2 s-2].
152  real, dimension(SZDI_(G%Block(1)),SZDJB_(G%Block(1))) :: & ! on block indices
153  inty_za_bk ! The meridional integral of the geopotential anomaly along the
154  ! interface below a layer, divided by the grid spacing [m2 s-2].
155  real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: &
156  inty_dza ! The change in inty_za through a layer [m2 s-2].
157  real :: p_ref(szi_(g)) ! The pressure used to calculate the coordinate
158  ! density [Pa] (usually 2e7 Pa = 2000 dbar).
159 
160  real :: dp_neglect ! A thickness that is so small it is usually lost
161  ! in roundoff and can be neglected [Pa].
162  real :: g_earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2].
163  real :: i_gearth ! The inverse of g_Earth_z [s2 Z m-2 ~> s2 m-1]
164  real :: alpha_anom ! The in-situ specific volume, averaged over a
165  ! layer, less alpha_ref [m3 kg-1].
166  logical :: use_p_atm ! If true, use the atmospheric pressure.
167  logical :: use_eos ! If true, density is calculated from T & S using an
168  ! equation of state.
169  type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S.
170 
171  real :: alpha_ref ! A reference specific volume [m3 kg-1], that is used
172  ! to reduce the impact of truncation errors.
173  real :: rho_in_situ(szi_(g)) ! The in situ density [kg m-3].
174  real :: pa_to_h ! A factor to convert from Pa to the thicknesss units (H).
175 ! real :: oneatm = 101325.0 ! 1 atm in [Pa] = [kg m-1 s-2]
176  real, parameter :: c1_6 = 1.0/6.0
177  integer :: is, ie, js, je, isq, ieq, jsq, jeq, nz, nkmb
178  integer :: is_bk, ie_bk, js_bk, je_bk, isq_bk, ieq_bk, jsq_bk, jeq_bk
179  integer :: i, j, k, n, ib, jb, ioff_bk, joff_bk
180 
181  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
182  nkmb=gv%nk_rho_varies
183  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
184 
185  if (.not.associated(cs)) call mom_error(fatal, &
186  "MOM_PressureForce_AFV_nonBouss: Module must be initialized before it is used.")
187 
188  use_p_atm = .false.
189  if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif
190  use_eos = associated(tv%eqn_of_state)
191 
192  dp_neglect = gv%H_to_Pa * gv%H_subroundoff
193  alpha_ref = 1.0/cs%Rho0
194  g_earth_z = us%L_T_to_m_s**2 * gv%g_Earth
195  i_gearth = 1.0 / g_earth_z
196 
197  if (use_p_atm) then
198  !$OMP parallel do default(shared)
199  do j=jsq,jeq+1 ; do i=isq,ieq+1
200  p(i,j,1) = p_atm(i,j)
201  enddo ; enddo
202  else
203  !$OMP parallel do default(shared)
204  do j=jsq,jeq+1 ; do i=isq,ieq+1
205  p(i,j,1) = 0.0 ! or oneatm
206  enddo ; enddo
207  endif
208  !$OMP parallel do default(shared)
209  do j=jsq,jeq+1 ; do k=2,nz+1 ; do i=isq,ieq+1
210  p(i,j,k) = p(i,j,k-1) + gv%H_to_Pa * h(i,j,k-1)
211  enddo ; enddo ; enddo
212 
213  if (use_eos) then
214  ! With a bulk mixed layer, replace the T & S of any layers that are
215  ! lighter than the the buffer layer with the properties of the buffer
216  ! layer. These layers will be massless anyway, and it avoids any
217  ! formal calculations with hydrostatically unstable profiles.
218  if (nkmb>0) then
219  tv_tmp%T => t_tmp ; tv_tmp%S => s_tmp
220  tv_tmp%eqn_of_state => tv%eqn_of_state
221  do i=isq,ieq+1 ; p_ref(i) = tv%P_Ref ; enddo
222  !$OMP parallel do default(shared) private(Rho_cv_BL)
223  do j=jsq,jeq+1
224  do k=1,nkmb ; do i=isq,ieq+1
225  tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k)
226  enddo ; enddo
227  call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, &
228  rho_cv_bl(:), isq, ieq-isq+2, tv%eqn_of_state)
229  do k=nkmb+1,nz ; do i=isq,ieq+1
230  if (gv%Rlay(k) < rho_cv_bl(i)) then
231  tv_tmp%T(i,j,k) = tv%T(i,j,nkmb) ; tv_tmp%S(i,j,k) = tv%S(i,j,nkmb)
232  else
233  tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k)
234  endif
235  enddo ; enddo
236  enddo
237  else
238  tv_tmp%T => tv%T ; tv_tmp%S => tv%S
239  tv_tmp%eqn_of_state => tv%eqn_of_state
240  endif
241  endif
242 
243  !$OMP parallel do default(shared) private(alpha_anom,dp)
244  do k=1,nz
245  ! Calculate 4 integrals through the layer that are required in the
246  ! subsequent calculation.
247  if (use_eos) then
248  call int_specific_vol_dp(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), p(:,:,k), &
249  p(:,:,k+1), alpha_ref, g%HI, tv%eqn_of_state, &
250  dza(:,:,k), intp_dza(:,:,k), intx_dza(:,:,k), &
251  inty_dza(:,:,k), bathyp=p(:,:,nz+1), dp_tiny=dp_neglect, &
252  usemasswghtinterp = cs%useMassWghtInterp)
253  else
254  alpha_anom = 1.0/gv%Rlay(k) - alpha_ref
255  do j=jsq,jeq+1 ; do i=isq,ieq+1
256  dp(i,j) = gv%H_to_Pa * h(i,j,k)
257  dza(i,j,k) = alpha_anom * dp(i,j)
258  intp_dza(i,j,k) = 0.5 * alpha_anom * dp(i,j)**2
259  enddo ; enddo
260  do j=js,je ; do i=isq,ieq
261  intx_dza(i,j,k) = 0.5 * alpha_anom * (dp(i,j)+dp(i+1,j))
262  enddo ; enddo
263  do j=jsq,jeq ; do i=is,ie
264  inty_dza(i,j,k) = 0.5 * alpha_anom * (dp(i,j)+dp(i,j+1))
265  enddo ; enddo
266  endif
267  enddo
268 
269  ! The bottom geopotential anomaly is calculated first so that the increments
270  ! to the geopotential anomalies can be reused. Alternately, the surface
271  ! geopotential could be calculated directly with separate calls to
272  ! int_specific_vol_dp with alpha_ref=0, and the anomalies used going
273  ! downward, which would relieve the need for dza, intp_dza, intx_dza, and
274  ! inty_dza to be 3-D arrays.
275 
276  ! Sum vertically to determine the surface geopotential anomaly.
277  !$OMP parallel do default(shared)
278  do j=jsq,jeq+1
279  do i=isq,ieq+1
280  za(i,j) = alpha_ref*p(i,j,nz+1) - g_earth_z*g%bathyT(i,j)
281  enddo
282  do k=nz,1,-1 ; do i=isq,ieq+1
283  za(i,j) = za(i,j) + dza(i,j,k)
284  enddo ; enddo
285  enddo
286 
287  if (cs%tides) then
288  ! Find and add the tidal geopotential anomaly.
289  !$OMP parallel do default(shared)
290  do j=jsq,jeq+1 ; do i=isq,ieq+1
291  ssh(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * i_gearth
292  enddo ; enddo
293  call calc_tidal_forcing(cs%Time, ssh, e_tidal, g, cs%tides_CSp, m_to_z=us%m_to_Z)
294  !$OMP parallel do default(shared)
295  do j=jsq,jeq+1 ; do i=isq,ieq+1
296  za(i,j) = za(i,j) - g_earth_z * e_tidal(i,j)
297  enddo ; enddo
298  endif
299 
300  if (cs%GFS_scale < 1.0) then
301  ! Adjust the Montgomery potential to make this a reduced gravity model.
302  if (use_eos) then
303  !$OMP parallel do default(shared) private(rho_in_situ)
304  do j=jsq,jeq+1
305  call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p(:,j,1), &
306  rho_in_situ, isq, ieq-isq+2, tv%eqn_of_state)
307 
308  do i=isq,ieq+1
309  dm(i,j) = (cs%GFS_scale - 1.0) * &
310  (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j))
311  enddo
312  enddo
313  else
314  !$OMP parallel do default(shared)
315  do j=jsq,jeq+1 ; do i=isq,ieq+1
316  dm(i,j) = (cs%GFS_scale - 1.0) * &
317  (p(i,j,1)*(1.0/gv%Rlay(1) - alpha_ref) + za(i,j))
318  enddo ; enddo
319  endif
320 ! else
321 ! do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; dM(i,j) = 0.0 ; enddo ; enddo
322  endif
323 
324  ! This order of integrating upward and then downward again is necessary with
325  ! a nonlinear equation of state, so that the surface geopotentials will go
326  ! linearly between the values at thickness points, but the bottom
327  ! geopotentials will not now be linear at the sub-grid-scale. Doing this
328  ! ensures no motion with flat isopycnals, even with a nonlinear equation of state.
329 !$OMP parallel do default(none) shared(nz,za,G,GV,dza,intx_dza,h,PFu, &
330 !$OMP intp_dza,p,dp_neglect,inty_dza,PFv,CS,dM) &
331 !$OMP private(is_bk,ie_bk,js_bk,je_bk,Isq_bk,Ieq_bk,Jsq_bk, &
332 !$OMP Jeq_bk,ioff_bk,joff_bk,i,j,za_bk,intx_za_bk, &
333 !$OMP inty_za_bk,dp_bk)
334  do n = 1, g%nblocks
335  is_bk=g%block(n)%isc ; ie_bk=g%block(n)%iec
336  js_bk=g%block(n)%jsc ; je_bk=g%block(n)%jec
337  isq_bk=g%block(n)%IscB ; ieq_bk=g%block(n)%IecB
338  jsq_bk=g%block(n)%JscB ; jeq_bk=g%block(n)%JecB
339  ioff_bk = g%Block(n)%idg_offset - g%HI%idg_offset
340  joff_bk = g%Block(n)%jdg_offset - g%HI%jdg_offset
341  do jb=jsq_bk,jeq_bk+1 ; do ib=isq_bk,ieq_bk+1
342  i = ib+ioff_bk ; j = jb+joff_bk
343  za_bk(ib,jb) = za(i,j)
344  enddo ; enddo
345  do jb=js_bk,je_bk ; do ib=isq_bk,ieq_bk
346  i = ib+ioff_bk ; j = jb+joff_bk
347  intx_za_bk(ib,jb) = 0.5*(za_bk(ib,jb) + za_bk(ib+1,jb))
348  enddo ; enddo
349  do jb=jsq_bk,jeq_bk ; do ib=is_bk,ie_bk
350  i = ib+ioff_bk ; j = jb+joff_bk
351  inty_za_bk(ib,jb) = 0.5*(za_bk(ib,jb) + za_bk(ib,jb+1))
352  enddo ; enddo
353  do k=1,nz
354  ! These expressions for the acceleration have been carefully checked in
355  ! a set of idealized cases, and should be bug-free.
356  do jb=jsq_bk,jeq_bk+1 ; do ib=isq_bk,ieq_bk+1
357  i = ib+ioff_bk ; j = jb+joff_bk
358  dp_bk(ib,jb) = gv%H_to_Pa*h(i,j,k)
359  za_bk(ib,jb) = za_bk(ib,jb) - dza(i,j,k)
360  enddo ; enddo
361  do jb=js_bk,je_bk ; do ib=isq_bk,ieq_bk
362  i = ib+ioff_bk ; j = jb+joff_bk
363  intx_za_bk(ib,jb) = intx_za_bk(ib,jb) - intx_dza(i,j,k)
364  pfu(i,j,k) = (((za_bk(ib,jb)*dp_bk(ib,jb) + intp_dza(i,j,k)) - &
365  (za_bk(ib+1,jb)*dp_bk(ib+1,jb) + intp_dza(i+1,j,k))) + &
366  ((dp_bk(ib+1,jb) - dp_bk(ib,jb)) * intx_za_bk(ib,jb) - &
367  (p(i+1,j,k) - p(i,j,k)) * intx_dza(i,j,k))) * &
368  (2.0*g%IdxCu(i,j) / ((dp_bk(ib,jb) + dp_bk(ib+1,jb)) + &
369  dp_neglect))
370  enddo ; enddo
371  do jb=jsq_bk,jeq_bk ; do ib=is_bk,ie_bk
372  i = ib+ioff_bk ; j = jb+joff_bk
373  inty_za_bk(ib,jb) = inty_za_bk(ib,jb) - inty_dza(i,j,k)
374  pfv(i,j,k) = (((za_bk(ib,jb)*dp_bk(ib,jb) + intp_dza(i,j,k)) - &
375  (za_bk(ib,jb+1)*dp_bk(ib,jb+1) + intp_dza(i,j+1,k))) + &
376  ((dp_bk(ib,jb+1) - dp_bk(ib,jb)) * inty_za_bk(ib,jb) - &
377  (p(i,j+1,k) - p(i,j,k)) * inty_dza(i,j,k))) * &
378  (2.0*g%IdyCv(i,j) / ((dp_bk(ib,jb) + dp_bk(ib,jb+1)) + &
379  dp_neglect))
380  enddo ; enddo
381 
382  if (cs%GFS_scale < 1.0) then
383  ! Adjust the Montgomery potential to make this a reduced gravity model.
384  do j=js_bk+joff_bk,je_bk+joff_bk ; do i=isq_bk+ioff_bk,ieq_bk+ioff_bk
385  pfu(i,j,k) = pfu(i,j,k) - (dm(i+1,j) - dm(i,j)) * g%IdxCu(i,j)
386  enddo ; enddo
387  do j=jsq_bk+joff_bk,jeq_bk+joff_bk ; do i=is_bk+ioff_bk,ie_bk+ioff_bk
388  pfv(i,j,k) = pfv(i,j,k) - (dm(i,j+1) - dm(i,j)) * g%IdyCv(i,j)
389  enddo ; enddo
390  endif
391  enddo
392  enddo
393 
394  if (present(pbce)) then
395  call set_pbce_nonbouss(p, tv_tmp, g, gv, us, cs%GFS_scale, pbce)
396  endif
397 
398  if (present(eta)) then
399  pa_to_h = 1.0 / gv%H_to_Pa
400  if (use_p_atm) then
401  !$OMP parallel do default(shared)
402  do j=jsq,jeq+1 ; do i=isq,ieq+1
403  eta(i,j) = (p(i,j,nz+1) - p_atm(i,j))*pa_to_h ! eta has the same units as h.
404  enddo ; enddo
405  else
406  !$OMP parallel do default(shared)
407  do j=jsq,jeq+1 ; do i=isq,ieq+1
408  eta(i,j) = p(i,j,nz+1)*pa_to_h ! eta has the same units as h.
409  enddo ; enddo
410  endif
411  endif
412 
413  if (cs%id_e_tidal>0) call post_data(cs%id_e_tidal, e_tidal, cs%diag)
414 
415 end subroutine pressureforce_blk_afv_nonbouss
416 
417 !> \brief Boussinesq analytically-integrated finite volume form of pressure gradient
418 !!
419 !! Determines the acceleration due to hydrostatic pressure forces, using
420 !! the finite volume form of the terms and analytic integrals in depth, making
421 !! the Boussinesq approximation. This version uses code-blocking for threads.
422 !!
423 !! To work, the following fields must be set outside of the usual (is:ie,js:je)
424 !! range before this subroutine is called:
425 !! h(isB:ie+1,jsB:je+1), T(isB:ie+1,jsB:je+1), and S(isB:ie+1,jsB:je+1).
426 subroutine pressureforce_blk_afv_bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta)
427  type(ocean_grid_type), intent(in) :: g !< Ocean grid structure
428  type(verticalgrid_type), intent(in) :: gv !< Vertical grid structure
429  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
430  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]
431  type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables
432  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: pfu !< Zonal acceleration [m s-2]
433  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: pfv !< Meridional acceleration [m s-2]
434  type(pressureforce_blk_afv_cs), pointer :: cs !< Finite volume PGF control structure
435  type(ale_cs), pointer :: ale_csp !< ALE control structure
436  real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean
437  !! or atmosphere-ocean interface [Pa].
438  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure
439  !! anomaly in each layer due to eta anomalies
440  !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1].
441  real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to
442  !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal
443  !! contributions or compressibility compensation.
444  ! Local variables
445  real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units [Z ~> m].
446  real, dimension(SZI_(G),SZJ_(G)) :: &
447  e_tidal, & ! The bottom geopotential anomaly due to tidal forces from
448  ! astronomical sources and self-attraction and loading, in depth units [Z ~> m].
449  dm ! The barotropic adjustment to the Montgomery potential to
450  ! account for a reduced gravity model [m2 s-2].
451  real, dimension(SZI_(G)) :: &
452  rho_cv_bl ! The coordinate potential density in the deepest variable
453  ! density near-surface layer [kg m-3].
454  real, dimension(SZDI_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices
455  dz_bk, & ! The change in geopotential thickness through a layer [m2 s-2].
456  pa_bk, & ! The pressure anomaly (i.e. pressure + g*RHO_0*e) at the
457  ! the interface atop a layer [Pa].
458  dpa_bk, & ! The change in pressure anomaly between the top and bottom
459  ! of a layer [Pa].
460  intz_dpa_bk ! The vertical integral in depth of the pressure anomaly less the
461  ! pressure anomaly at the top of the layer [H Pa ~> m Pa or kg m-2 Pa].
462  real, dimension(SZDIB_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices
463  intx_pa_bk, & ! The zonal integral of the pressure anomaly along the interface
464  ! atop a layer, divided by the grid spacing [Pa].
465  intx_dpa_bk ! The change in intx_pa through a layer [Pa].
466  real, dimension(SZDI_(G%Block(1)),SZDJB_(G%Block(1))) :: & ! on block indices
467  inty_pa_bk, & ! The meridional integral of the pressure anomaly along the
468  ! interface atop a layer, divided by the grid spacing [Pa].
469  inty_dpa_bk ! The change in inty_pa through a layer [Pa].
470 
471  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: &
472  t_tmp, & ! Temporary array of temperatures where layers that are lighter
473  ! than the mixed layer have the mixed layer's properties [degC].
474  s_tmp ! Temporary array of salinities where layers that are lighter
475  ! than the mixed layer have the mixed layer's properties [ppt].
476  real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: &
477  s_t, s_b, & ! Top and bottom edge salinities for linear reconstructions within each layer [ppt].
478  t_t, t_b ! Top and bottom edge temperatures for linear reconstructions within each layer [degC].
479  real :: rho_in_situ(szi_(g)) ! The in situ density [kg m-3].
480  real :: p_ref(szi_(g)) ! The pressure used to calculate the coordinate
481  ! density [Pa] (usually 2e7 Pa = 2000 dbar).
482  real :: p0(szi_(g)) ! An array of zeros to use for pressure [Pa].
483  real :: h_neglect ! A thickness that is so small it is usually lost
484  ! in roundoff and can be neglected [H ~> m or kg m-2].
485  real :: i_rho0 ! 1/Rho0 [m3 kg-1].
486  real :: g_earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2].
487  real :: g_rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1].
488  real :: rho_ref ! The reference density [kg m-3].
489  real :: dz_neglect ! A minimal thickness [Z ~> m], like e.
490  logical :: use_p_atm ! If true, use the atmospheric pressure.
491  logical :: use_ale ! If true, use an ALE pressure reconstruction.
492  logical :: use_eos ! If true, density is calculated from T & S using an
493  ! equation of state.
494  type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S.
495 
496  real, parameter :: c1_6 = 1.0/6.0
497  integer :: is, ie, js, je, isq, ieq, jsq, jeq, nz, nkmb
498  integer :: is_bk, ie_bk, js_bk, je_bk, isq_bk, ieq_bk, jsq_bk, jeq_bk
499  integer :: ioff_bk, joff_bk
500  integer :: i, j, k, n, ib, jb
501 
502  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
503  nkmb=gv%nk_rho_varies
504  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
505 
506  if (.not.associated(cs)) call mom_error(fatal, &
507  "MOM_PressureForce_AFV_Bouss: Module must be initialized before it is used.")
508 
509  use_p_atm = .false.
510  if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif
511  use_eos = associated(tv%eqn_of_state)
512  do i=isq,ieq+1 ; p0(i) = 0.0 ; enddo
513  use_ale = .false.
514  if (associated(ale_csp)) use_ale = cs%reconstruct .and. use_eos
515 
516  h_neglect = gv%H_subroundoff
517  dz_neglect = gv%H_subroundoff * gv%H_to_Z
518  i_rho0 = 1.0/gv%Rho0
519  g_earth_z = us%L_T_to_m_s**2 * gv%g_Earth
520  g_rho0 = g_earth_z / gv%Rho0
521  rho_ref = cs%Rho0
522 
523  if (cs%tides) then
524  ! Determine the surface height anomaly for calculating self attraction
525  ! and loading. This should really be based on bottom pressure anomalies,
526  ! but that is not yet implemented, and the current form is correct for
527  ! barotropic tides.
528  !$OMP parallel do default(shared)
529  do j=jsq,jeq+1
530  do i=isq,ieq+1
531  e(i,j,1) = -g%bathyT(i,j)
532  enddo
533  do k=1,nz ; do i=isq,ieq+1
534  e(i,j,1) = e(i,j,1) + h(i,j,k)*gv%H_to_Z
535  enddo ; enddo
536  enddo
537  call calc_tidal_forcing(cs%Time, e(:,:,1), e_tidal, g, cs%tides_CSp, m_to_z=us%m_to_Z)
538  endif
539 
540 ! Here layer interface heights, e, are calculated.
541  if (cs%tides) then
542  !$OMP parallel do default(shared)
543  do j=jsq,jeq+1 ; do i=isq,ieq+1
544  e(i,j,nz+1) = -(g%bathyT(i,j) + e_tidal(i,j))
545  enddo ; enddo
546  else
547  !$OMP parallel do default(shared)
548  do j=jsq,jeq+1 ; do i=isq,ieq+1
549  e(i,j,nz+1) = -g%bathyT(i,j)
550  enddo ; enddo
551  endif
552  !$OMP parallel do default(shared)
553  do j=jsq,jeq+1; do k=nz,1,-1 ; do i=isq,ieq+1
554  e(i,j,k) = e(i,j,k+1) + h(i,j,k)*gv%H_to_Z
555  enddo ; enddo ; enddo
556 
557  if (use_eos) then
558 ! With a bulk mixed layer, replace the T & S of any layers that are
559 ! lighter than the the buffer layer with the properties of the buffer
560 ! layer. These layers will be massless anyway, and it avoids any
561 ! formal calculations with hydrostatically unstable profiles.
562 
563  if (nkmb>0) then
564  tv_tmp%T => t_tmp ; tv_tmp%S => s_tmp
565  tv_tmp%eqn_of_state => tv%eqn_of_state
566 
567  do i=isq,ieq+1 ; p_ref(i) = tv%P_Ref ; enddo
568  !$OMP parallel do default(shared) private(Rho_cv_BL)
569  do j=jsq,jeq+1
570  do k=1,nkmb ; do i=isq,ieq+1
571  tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k)
572  enddo ; enddo
573  call calculate_density(tv%T(:,j,nkmb), tv%S(:,j,nkmb), p_ref, &
574  rho_cv_bl(:), isq, ieq-isq+2, tv%eqn_of_state)
575 
576  do k=nkmb+1,nz ; do i=isq,ieq+1
577  if (gv%Rlay(k) < rho_cv_bl(i)) then
578  tv_tmp%T(i,j,k) = tv%T(i,j,nkmb) ; tv_tmp%S(i,j,k) = tv%S(i,j,nkmb)
579  else
580  tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k)
581  endif
582  enddo ; enddo
583  enddo
584  else
585  tv_tmp%T => tv%T ; tv_tmp%S => tv%S
586  tv_tmp%eqn_of_state => tv%eqn_of_state
587  endif
588  endif
589 
590  if (cs%GFS_scale < 1.0) then
591  ! Adjust the Montgomery potential to make this a reduced gravity model.
592  if (use_eos) then
593  !$OMP parallel do default(shared)
594  do j=jsq,jeq+1
595  if (use_p_atm) then
596  call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p_atm(:,j), &
597  rho_in_situ, isq, ieq-isq+2, tv%eqn_of_state)
598  else
599  call calculate_density(tv_tmp%T(:,j,1), tv_tmp%S(:,j,1), p0, &
600  rho_in_situ, isq, ieq-isq+2, tv%eqn_of_state)
601  endif
602  do i=isq,ieq+1
603  dm(i,j) = (cs%GFS_scale - 1.0) * (g_rho0 * rho_in_situ(i)) * e(i,j,1)
604  enddo
605  enddo
606  else
607  !$OMP parallel do default(shared)
608  do j=jsq,jeq+1 ; do i=isq,ieq+1
609  dm(i,j) = (cs%GFS_scale - 1.0) * (g_rho0 * gv%Rlay(1)) * e(i,j,1)
610  enddo ; enddo
611  endif
612  endif
613  ! I have checked that rho_0 drops out and that the 1-layer case is right. RWH.
614 
615  ! If regridding is activated, do a linear reconstruction of salinity
616  ! and temperature across each layer. The subscripts 't' and 'b' refer
617  ! to top and bottom values within each layer (these are the only degrees
618  ! of freedeom needed to know the linear profile).
619  if ( use_ale ) then
620  if ( cs%Recon_Scheme == 1 ) then
621  call pressure_gradient_plm(ale_csp, s_t, s_b, t_t, t_b, g, gv, tv, h, cs%boundary_extrap)
622  elseif ( cs%Recon_Scheme == 2 ) then
623  call pressure_gradient_ppm(ale_csp, s_t, s_b, t_t, t_b, g, gv, tv, h, cs%boundary_extrap)
624  endif
625  endif
626 
627 !$OMP parallel do default(none) shared(use_p_atm,rho_ref,G,GV,e,p_atm,nz,use_EOS,&
628 !$OMP use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp,g_Earth_z, &
629 !$OMP h,PFu,I_Rho0,h_neglect,dz_neglect,PFv,dM)&
630 !$OMP private(is_bk,ie_bk,js_bk,je_bk,Isq_bk,Ieq_bk,Jsq_bk, &
631 !$OMP Jeq_bk,ioff_bk,joff_bk,pa_bk, &
632 !$OMP intx_pa_bk,inty_pa_bk,dpa_bk,intz_dpa_bk, &
633 !$OMP intx_dpa_bk,inty_dpa_bk,dz_bk,i,j)
634  do n = 1, g%nblocks
635  is_bk=g%Block(n)%isc ; ie_bk=g%Block(n)%iec
636  js_bk=g%Block(n)%jsc ; je_bk=g%Block(n)%jec
637  isq_bk=g%Block(n)%IscB ; ieq_bk=g%Block(n)%IecB
638  jsq_bk=g%Block(n)%JscB ; jeq_bk=g%Block(n)%JecB
639  ioff_bk = g%Block(n)%idg_offset - g%HI%idg_offset
640  joff_bk = g%Block(n)%jdg_offset - g%HI%jdg_offset
641 
642  ! Set the surface boundary conditions on pressure anomaly and its horizontal
643  ! integrals, assuming that the surface pressure anomaly varies linearly
644  ! in x and y.
645  if (use_p_atm) then
646  do jb=jsq_bk,jeq_bk+1 ; do ib=isq_bk,ieq_bk+1
647  i = ib+ioff_bk ; j = jb+joff_bk
648  pa_bk(ib,jb) = (rho_ref*g_earth_z)*e(i,j,1) + p_atm(i,j)
649  enddo ; enddo
650  else
651  do jb=jsq_bk,jeq_bk+1 ; do ib=isq_bk,ieq_bk+1
652  i = ib+ioff_bk ; j = jb+joff_bk
653  pa_bk(ib,jb) = (rho_ref*g_earth_z)*e(i,j,1)
654  enddo ; enddo
655  endif
656  do jb=js_bk,je_bk ; do ib=isq_bk,ieq_bk
657  intx_pa_bk(ib,jb) = 0.5*(pa_bk(ib,jb) + pa_bk(ib+1,jb))
658  enddo ; enddo
659  do jb=jsq_bk,jeq_bk ; do ib=is_bk,ie_bk
660  inty_pa_bk(ib,jb) = 0.5*(pa_bk(ib,jb) + pa_bk(ib,jb+1))
661  enddo ; enddo
662 
663  do k=1,nz
664  ! Calculate 4 integrals through the layer that are required in the
665  ! subsequent calculation.
666 
667  if (use_eos) then
668  ! The following routine computes the integrals that are needed to
669  ! calculate the pressure gradient force. Linear profiles for T and S are
670  ! assumed when regridding is activated. Otherwise, the previous version
671  ! is used, whereby densities within each layer are constant no matter
672  ! where the layers are located.
673  if ( use_ale ) then
674  if ( cs%Recon_Scheme == 1 ) then
675  call int_density_dz_generic_plm( t_t(:,:,k), t_b(:,:,k), &
676  s_t(:,:,k), s_b(:,:,k), e(:,:,k), e(:,:,k+1), &
677  rho_ref, cs%Rho0, g_earth_z, &
678  dz_neglect, g%bathyT, g%HI, g%Block(n), &
679  tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, &
680  usemasswghtinterp = cs%useMassWghtInterp)
681  elseif ( cs%Recon_Scheme == 2 ) then
682  call int_density_dz_generic_ppm( tv%T(:,:,k), t_t(:,:,k), t_b(:,:,k), &
683  tv%S(:,:,k), s_t(:,:,k), s_b(:,:,k), e(:,:,k), e(:,:,k+1), &
684  rho_ref, cs%Rho0, g_earth_z, &
685  g%HI, g%Block(n), tv%eqn_of_state, dpa_bk, intz_dpa_bk, &
686  intx_dpa_bk, inty_dpa_bk)
687  endif
688  else
689  call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,k), e(:,:,k+1), &
690  rho_ref, cs%Rho0, g_earth_z, g%HI, g%Block(n), tv%eqn_of_state, &
691  dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, &
692  g%bathyT, dz_neglect, cs%useMassWghtInterp)
693  endif
694  do jb=jsq_bk,jeq_bk+1 ; do ib=isq_bk,ieq_bk+1
695  intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*gv%Z_to_H
696  enddo ; enddo
697  else
698  do jb=jsq_bk,jeq_bk+1 ; do ib=isq_bk,ieq_bk+1
699  i = ib+ioff_bk ; j = jb+joff_bk
700  dz_bk(ib,jb) = g_earth_z*gv%H_to_Z*h(i,j,k)
701  dpa_bk(ib,jb) = (gv%Rlay(k) - rho_ref)*dz_bk(ib,jb)
702  intz_dpa_bk(ib,jb) = 0.5*(gv%Rlay(k) - rho_ref)*dz_bk(ib,jb)*h(i,j,k)
703  enddo ; enddo
704  do jb=js_bk,je_bk ; do ib=isq_bk,ieq_bk
705  intx_dpa_bk(ib,jb) = 0.5*(gv%Rlay(k) - rho_ref) * (dz_bk(ib,jb)+dz_bk(ib+1,jb))
706  enddo ; enddo
707  do jb=jsq_bk,jeq_bk ; do ib=is_bk,ie_bk
708  inty_dpa_bk(ib,jb) = 0.5*(gv%Rlay(k) - rho_ref) * (dz_bk(ib,jb)+dz_bk(ib,jb+1))
709  enddo ; enddo
710  endif
711 
712  ! Compute pressure gradient in x direction
713  do jb=js_bk,je_bk ; do ib=isq_bk,ieq_bk
714  i = ib+ioff_bk ; j = jb+joff_bk
715  pfu(i,j,k) = (((pa_bk(ib,jb)*h(i,j,k) + intz_dpa_bk(ib,jb)) - &
716  (pa_bk(ib+1,jb)*h(i+1,j,k) + intz_dpa_bk(ib+1,jb))) + &
717  ((h(i+1,j,k) - h(i,j,k)) * intx_pa_bk(ib,jb) - &
718  (e(i+1,j,k+1) - e(i,j,k+1)) * intx_dpa_bk(ib,jb) * gv%Z_to_H)) * &
719  ((2.0*i_rho0*g%IdxCu(i,j)) / &
720  ((h(i,j,k) + h(i+1,j,k)) + h_neglect))
721  intx_pa_bk(ib,jb) = intx_pa_bk(ib,jb) + intx_dpa_bk(ib,jb)
722  enddo ; enddo
723  ! Compute pressure gradient in y direction
724  do jb=jsq_bk,jeq_bk ; do ib=is_bk,ie_bk
725  i = ib+ioff_bk ; j = jb+joff_bk
726  pfv(i,j,k) = (((pa_bk(ib,jb)*h(i,j,k) + intz_dpa_bk(ib,jb)) - &
727  (pa_bk(ib,jb+1)*h(i,j+1,k) + intz_dpa_bk(ib,jb+1))) + &
728  ((h(i,j+1,k) - h(i,j,k)) * inty_pa_bk(ib,jb) - &
729  (e(i,j+1,k+1) - e(i,j,k+1)) * inty_dpa_bk(ib,jb) * gv%Z_to_H)) * &
730  ((2.0*i_rho0*g%IdyCv(i,j)) / &
731  ((h(i,j,k) + h(i,j+1,k)) + h_neglect))
732  inty_pa_bk(ib,jb) = inty_pa_bk(ib,jb) + inty_dpa_bk(ib,jb)
733  enddo ; enddo
734  do jb=jsq_bk,jeq_bk+1 ; do ib=isq_bk,ieq_bk+1
735  pa_bk(ib,jb) = pa_bk(ib,jb) + dpa_bk(ib,jb)
736  enddo ; enddo
737  enddo
738 
739  if (cs%GFS_scale < 1.0) then
740  do k=1,nz
741  do j=js_bk+joff_bk,je_bk+joff_bk ; do i=isq_bk+ioff_bk,ieq_bk+ioff_bk
742  pfu(i,j,k) = pfu(i,j,k) - (dm(i+1,j) - dm(i,j)) * g%IdxCu(i,j)
743  enddo ; enddo
744  do j=jsq_bk+joff_bk,jeq_bk+joff_bk ; do i=is_bk+ioff_bk,ie_bk+ioff_bk
745  pfv(i,j,k) = pfv(i,j,k) - (dm(i,j+1) - dm(i,j)) * g%IdyCv(i,j)
746  enddo ; enddo
747  enddo
748  endif
749  enddo
750 
751  if (present(pbce)) then
752  call set_pbce_bouss(e, tv_tmp, g, gv, us, cs%Rho0, cs%GFS_scale, pbce)
753  endif
754 
755  if (present(eta)) then
756  if (cs%tides) then
757  ! eta is the sea surface height relative to a time-invariant geoid, for
758  ! comparison with what is used for eta in btstep. See how e was calculated
759  ! about 200 lines above.
760  !$OMP parallel do default(shared)
761  do j=jsq,jeq+1 ; do i=isq,ieq+1
762  eta(i,j) = e(i,j,1)*gv%Z_to_H + e_tidal(i,j)*gv%Z_to_H
763  enddo ; enddo
764  else
765  !$OMP parallel do default(shared)
766  do j=jsq,jeq+1 ; do i=isq,ieq+1
767  eta(i,j) = e(i,j,1)*gv%Z_to_H
768  enddo ; enddo
769  endif
770  endif
771 
772  if (cs%id_e_tidal>0) call post_data(cs%id_e_tidal, e_tidal, cs%diag)
773 
774 end subroutine pressureforce_blk_afv_bouss
775 
776 !> Initializes the finite volume pressure gradient control structure
777 subroutine pressureforce_blk_afv_init(Time, G, GV, US, param_file, diag, CS, tides_CSp)
778  type(time_type), target, intent(in) :: time !< Current model time
779  type(ocean_grid_type), intent(in) :: g !< Ocean grid structure
780  type(verticalgrid_type), intent(in) :: gv !< Vertical grid structure
781  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
782  type(param_file_type), intent(in) :: param_file !< Parameter file handles
783  type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure
784  type(pressureforce_blk_afv_cs), pointer :: cs !< Finite volume PGF control structure
785  type(tidal_forcing_cs), optional, pointer :: tides_csp !< Tides control structure
786 ! This include declares and sets the variable "version".
787 #include "version_variable.h"
788  character(len=40) :: mdl ! This module's name.
789  logical :: use_ale
790 
791  if (associated(cs)) then
792  call mom_error(warning, "PressureForce_init called with an associated "// &
793  "control structure.")
794  return
795  else ; allocate(cs) ; endif
796 
797  cs%diag => diag ; cs%Time => time
798  if (present(tides_csp)) then
799  if (associated(tides_csp)) cs%tides_CSp => tides_csp
800  endif
801 
802  mdl = "MOM_PressureForce_blk_AFV"
803  call log_version(param_file, mdl, version, "")
804  call get_param(param_file, mdl, "RHO_0", cs%Rho0, &
805  "The mean ocean density used with BOUSSINESQ true to "//&
806  "calculate accelerations and the mass for conservation "//&
807  "properties, or with BOUSSINSEQ false to convert some "//&
808  "parameters from vertical units of m to kg m-2.", &
809  units="kg m-3", default=1035.0)
810  call get_param(param_file, mdl, "TIDES", cs%tides, &
811  "If true, apply tidal momentum forcing.", default=.false.)
812  call get_param(param_file, "MOM", "USE_REGRIDDING", use_ale, &
813  "If True, use the ALE algorithm (regridding/remapping). "//&
814  "If False, use the layered isopycnal algorithm.", default=.false. )
815  call get_param(param_file, mdl, "MASS_WEIGHT_IN_PRESSURE_GRADIENT", cs%useMassWghtInterp, &
816  "If true, use mass weighting when interpolating T/S for "//&
817  "integrals near the bathymetry in AFV pressure gradient "//&
818  "calculations.", default=.false.)
819  call get_param(param_file, mdl, "RECONSTRUCT_FOR_PRESSURE", cs%reconstruct, &
820  "If True, use vertical reconstruction of T & S within "//&
821  "the integrals of the FV pressure gradient calculation. "//&
822  "If False, use the constant-by-layer algorithm. "//&
823  "The default is set by USE_REGRIDDING.", &
824  default=use_ale )
825  call get_param(param_file, mdl, "PRESSURE_RECONSTRUCTION_SCHEME", cs%Recon_Scheme, &
826  "Order of vertical reconstruction of T/S to use in the "//&
827  "integrals within the FV pressure gradient calculation.\n"//&
828  " 0: PCM or no reconstruction.\n"//&
829  " 1: PLM reconstruction.\n"//&
830  " 2: PPM reconstruction.", default=1)
831  call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION_PRESSURE", cs%boundary_extrap, &
832  "If true, the reconstruction of T & S for pressure in "//&
833  "boundary cells is extrapolated, rather than using PCM "//&
834  "in these cells. If true, the same order polynomial is "//&
835  "used as is used for the interior cells.", default=.true.)
836 
837  if (cs%tides) then
838  cs%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, &
839  time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=us%Z_to_m)
840  endif
841 
842  cs%GFS_scale = 1.0
843  if (gv%g_prime(1) /= gv%g_Earth) cs%GFS_scale = gv%g_prime(1) / gv%g_Earth
844 
845  call log_param(param_file, mdl, "GFS / G_EARTH", cs%GFS_scale)
846 
847 end subroutine pressureforce_blk_afv_init
848 
849 !> Deallocates the finite volume pressure gradient control structure
850 subroutine pressureforce_blk_afv_end(CS)
851  type(pressureforce_blk_afv_cs), pointer :: cs !< Blocked AFV pressure control structure that
852  !! will be deallocated in this subroutine.
853  if (associated(cs)) deallocate(cs)
854 end subroutine pressureforce_blk_afv_end
855 
856 !> \namespace mom_pressureforce_afv
857 !!
858 !! Provides the Boussinesq and non-Boussinesq forms of horizontal accelerations
859 !! due to pressure gradients using a 2nd-order analytically vertically integrated
860 !! finite volume form, as described by Adcroft et al., 2008.
861 !!
862 !! This form eliminates the thermobaric instabilities that had been a problem with
863 !! previous forms of the pressure gradient force calculation, as described by
864 !! Hallberg, 2005.
865 !!
866 !! Adcroft, A., R. Hallberg, and M. Harrison, 2008: A finite volume discretization
867 !! of the pressure gradient force using analytic integration. Ocean Modelling, 22,
868 !! 106-113. http://doi.org/10.1016/j.ocemod.2008.02.001
869 !!
870 !! Hallberg, 2005: A thermobaric instability of Lagrangian vertical coordinate
871 !! ocean models. Ocean Modelling, 8, 279-300.
872 !! http://dx.doi.org/10.1016/j.ocemod.2004.01.001
873 
874 end module mom_pressureforce_blk_afv
mom_pressureforce_blk_afv
Analytically integrated finite volume pressure gradient.
Definition: MOM_PressureForce_blocked_AFV.F90:2
mom_verticalgrid
Provides a transparent vertical ocean grid type and supporting routines.
Definition: MOM_verticalGrid.F90:2
mom_pressureforce_blk_afv::pressureforce_blk_afv_cs
Finite volume pressure gradient control structure.
Definition: MOM_PressureForce_blocked_AFV.F90:36
mom_file_parser::log_version
An overloaded interface to log version information about modules.
Definition: MOM_file_parser.F90:109
mom_diag_mediator
The subroutines here provide convenient wrappers to the fms diag_manager interfaces with additional d...
Definition: MOM_diag_mediator.F90:3
mom_variables::thermo_var_ptrs
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
Definition: MOM_variables.F90:82
mom_eos
Provides subroutines for quantities specific to the equation of state.
Definition: MOM_EOS.F90:2
mom_file_parser::param_file_type
A structure that can be parsed to read and document run-time parameters.
Definition: MOM_file_parser.F90:54
mom_file_parser::get_param
An overloaded interface to read and log the values of various types of parameters.
Definition: MOM_file_parser.F90:102
mom_unit_scaling::unit_scale_type
Describes various unit conversion factors.
Definition: MOM_unit_scaling.F90:14
mom_diag_mediator::post_data
Make a diagnostic available for averaging or output.
Definition: MOM_diag_mediator.F90:70
mom_tidal_forcing
Tidal contributions to geopotential.
Definition: MOM_tidal_forcing.F90:2
mom_tidal_forcing::tidal_forcing_cs
The control structure for the MOM_tidal_forcing module.
Definition: MOM_tidal_forcing.F90:26
mom_verticalgrid::verticalgrid_type
Describes the vertical ocean grid, including unit conversion factors.
Definition: MOM_verticalGrid.F90:24
mom_ale
This module contains the main regridding routines.
Definition: MOM_ALE.F90:9
mom_variables
Provides transparent structures with groups of MOM6 variables and supporting routines.
Definition: MOM_variables.F90:2
mom_file_parser
The MOM6 facility to parse input files for runtime parameters.
Definition: MOM_file_parser.F90:2
mom_ale::ale_cs
ALE control structure.
Definition: MOM_ALE.F90:63
mom_pressureforce_mont
Provides the Montgomery potential form of pressure gradient.
Definition: MOM_PressureForce_Montgomery.F90:2
mom_eos::calculate_density_derivs
Calculate the derivatives of density with temperature and salinity from T, S, and P.
Definition: MOM_EOS.F90:70
mom_grid
Provides the ocean grid type.
Definition: MOM_grid.F90:2
mom_unit_scaling
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Definition: MOM_unit_scaling.F90:2
mom_file_parser::log_param
An overloaded interface to log the values of various types of parameters.
Definition: MOM_file_parser.F90:96
mom_error_handler
Routines for error handling and I/O management.
Definition: MOM_error_handler.F90:2
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:25
mom_diag_mediator::diag_ctrl
The following data type a list of diagnostic fields an their variants, as well as variables that cont...
Definition: MOM_diag_mediator.F90:239
mom_eos::calculate_density
Calculates density of sea water from T, S and P.
Definition: MOM_EOS.F90:60