MOM6
MOM_EOS.F90
1 !> Provides subroutines for quantities specific to the equation of state
2 module mom_eos
3 
4 ! This file is part of MOM6. See LICENSE.md for the license.
5 
8 use mom_eos_linear, only : calculate_specvol_derivs_linear, int_density_dz_linear
10 use mom_eos_linear, only : calculate_compress_linear, int_spec_vol_dp_linear
13 use mom_eos_wright, only : calculate_specvol_derivs_wright, int_density_dz_wright
14 use mom_eos_wright, only : calculate_compress_wright, int_spec_vol_dp_wright
17 use mom_eos_unesco, only : calculate_density_derivs_unesco, calculate_density_unesco
18 use mom_eos_unesco, only : calculate_compress_unesco
21 use mom_eos_nemo, only : calculate_compress_nemo
24 use mom_eos_teos10, only : calculate_specvol_derivs_teos10
26 use mom_eos_teos10, only : calculate_compress_teos10
27 use mom_eos_teos10, only : gsw_sp_from_sr, gsw_pt_from_ct
30 use mom_error_handler, only : mom_error, fatal, warning, mom_mesg
32 use mom_string_functions, only : uppercase
33 use mom_hor_index, only : hor_index_type
34 
35 implicit none ; private
36 
37 #include <MOM_memory.h>
38 
39 public calculate_compress, calculate_density, query_compressible
40 public calculate_density_derivs, calculate_specific_vol_derivs
42 public eos_init, eos_manual_init, eos_end, eos_allocate
43 public eos_use_linear, calculate_spec_vol
44 public int_density_dz, int_specific_vol_dp
45 public int_density_dz_generic_plm, int_density_dz_generic_ppm
46 public int_spec_vol_dp_generic_plm !, int_spec_vol_dz_generic_ppm
47 public int_density_dz_generic, int_spec_vol_dp_generic
48 public find_depth_of_pressure_in_cell
49 public calculate_tfreeze
50 public convert_temp_salt_for_teos10
51 public gsw_sp_from_sr, gsw_pt_from_ct
52 public extract_member_eos
53 
54 ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
55 ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
56 ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units
57 ! vary with the Boussinesq approximation, the Boussinesq variant is given first.
58 
59 !> Calculates density of sea water from T, S and P
61  module procedure calculate_density_scalar, calculate_density_array
62 end interface calculate_density
63 
64 !> Calculates specific volume of sea water from T, S and P
66  module procedure calculate_spec_vol_scalar, calculate_spec_vol_array
67 end interface calculate_spec_vol
68 
69 !> Calculate the derivatives of density with temperature and salinity from T, S, and P
71  module procedure calculate_density_derivs_scalar, calculate_density_derivs_array
72 end interface calculate_density_derivs
73 
74 !> Calculates the second derivatives of density with various combinations of temperature,
75 !! salinity, and pressure from T, S and P
77  module procedure calculate_density_second_derivs_scalar, calculate_density_second_derivs_array
79 
80 !> Calculates the freezing point of sea water from T, S and P
82  module procedure calculate_tfreeze_scalar, calculate_tfreeze_array
83 end interface calculate_tfreeze
84 
85 !> A control structure for the equation of state
86 type, public :: eos_type ; private
87  integer :: form_of_eos = 0 !< The equation of state to use.
88  integer :: form_of_tfreeze = 0 !< The expression for the potential temperature
89  !! of the freezing point.
90  logical :: eos_quadrature !< If true, always use the generic (quadrature)
91  !! code for the integrals of density.
92  logical :: compressible = .true. !< If true, in situ density is a function of pressure.
93 ! The following parameters are used with the linear equation of state only.
94  real :: rho_t0_s0 !< The density at T=0, S=0 [kg m-3].
95  real :: drho_dt !< The partial derivative of density with temperature [kg m-3 degC-1]
96  real :: drho_ds !< The partial derivative of density with salinity [kg m-3 ppt-1].
97 ! The following parameters are use with the linear expression for the freezing
98 ! point only.
99  real :: tfr_s0_p0 !< The freezing potential temperature at S=0, P=0 [degC].
100  real :: dtfr_ds !< The derivative of freezing point with salinity [degC ppt-1].
101  real :: dtfr_dp !< The derivative of freezing point with pressure [degC Pa-1].
102 
103 ! logical :: test_EOS = .true. ! If true, test the equation of state
104 end type eos_type
105 
106 ! The named integers that might be stored in eqn_of_state_type%form_of_EOS.
107 integer, parameter, public :: eos_linear = 1 !< A named integer specifying an equation of state
108 integer, parameter, public :: eos_unesco = 2 !< A named integer specifying an equation of state
109 integer, parameter, public :: eos_wright = 3 !< A named integer specifying an equation of state
110 integer, parameter, public :: eos_teos10 = 4 !< A named integer specifying an equation of state
111 integer, parameter, public :: eos_nemo = 5 !< A named integer specifying an equation of state
112 
113 character*(10), parameter :: eos_linear_string = "LINEAR" !< A string for specifying the equation of state
114 character*(10), parameter :: eos_unesco_string = "UNESCO" !< A string for specifying the equation of state
115 character*(10), parameter :: eos_wright_string = "WRIGHT" !< A string for specifying the equation of state
116 character*(10), parameter :: eos_teos10_string = "TEOS10" !< A string for specifying the equation of state
117 character*(10), parameter :: eos_nemo_string = "NEMO" !< A string for specifying the equation of state
118 character*(10), parameter :: eos_default = eos_wright_string !< The default equation of state
119 
120 integer, parameter :: tfreeze_linear = 1 !< A named integer specifying a freezing point expression
121 integer, parameter :: tfreeze_millero = 2 !< A named integer specifying a freezing point expression
122 integer, parameter :: tfreeze_teos10 = 3 !< A named integer specifying a freezing point expression
123 character*(10), parameter :: tfreeze_linear_string = "LINEAR" !< A string for specifying the freezing point expression
124 character*(10), parameter :: tfreeze_millero_string = "MILLERO_78" !< A string for specifying
125  !! freezing point expression
126 character*(10), parameter :: tfreeze_teos10_string = "TEOS10" !< A string for specifying the freezing point expression
127 character*(10), parameter :: tfreeze_default = tfreeze_linear_string !< The default freezing point expression
128 
129 contains
130 
131 !> Calls the appropriate subroutine to calculate density of sea water for scalar inputs.
132 !! If rho_ref is present, the anomaly with respect to rho_ref is returned.
133 subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref)
134  real, intent(in) :: T !< Potential temperature referenced to the surface [degC]
135  real, intent(in) :: S !< Salinity [ppt]
136  real, intent(in) :: pressure !< Pressure [Pa]
137  real, intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3]
138  type(eos_type), pointer :: EOS !< Equation of state structure
139  real, optional, intent(in) :: rho_ref !< A reference density [kg m-3].
140 
141  if (.not.associated(eos)) call mom_error(fatal, &
142  "calculate_density_scalar called with an unassociated EOS_type EOS.")
143 
144  select case (eos%form_of_EOS)
145  case (eos_linear)
146  call calculate_density_linear(t, s, pressure, rho, &
147  eos%Rho_T0_S0, eos%dRho_dT, eos%dRho_dS, rho_ref)
148  case (eos_unesco)
149  call calculate_density_unesco(t, s, pressure, rho, rho_ref)
150  case (eos_wright)
151  call calculate_density_wright(t, s, pressure, rho, rho_ref)
152  case (eos_teos10)
153  call calculate_density_teos10(t, s, pressure, rho, rho_ref)
154  case (eos_nemo)
155  call calculate_density_nemo(t, s, pressure, rho, rho_ref)
156  case default
157  call mom_error(fatal, &
158  "calculate_density_scalar: EOS is not valid.")
159  end select
160 
161 end subroutine calculate_density_scalar
162 
163 !> Calls the appropriate subroutine to calculate the density of sea water for 1-D array inputs.
164 !! If rho_ref is present, the anomaly with respect to rho_ref is returned.
165 subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_ref)
166  real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC]
167  real, dimension(:), intent(in) :: S !< Salinity [ppt]
168  real, dimension(:), intent(in) :: pressure !< Pressure [Pa]
169  real, dimension(:), intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3]
170  integer, intent(in) :: start !< Start index for computation
171  integer, intent(in) :: npts !< Number of point to compute
172  type(eos_type), pointer :: EOS !< Equation of state structure
173  real, optional, intent(in) :: rho_ref !< A reference density [kg m-3].
174 
175  if (.not.associated(eos)) call mom_error(fatal, &
176  "calculate_density_array called with an unassociated EOS_type EOS.")
177 
178  select case (eos%form_of_EOS)
179  case (eos_linear)
180  call calculate_density_linear(t, s, pressure, rho, start, npts, &
181  eos%Rho_T0_S0, eos%dRho_dT, eos%dRho_dS, rho_ref)
182  case (eos_unesco)
183  call calculate_density_unesco(t, s, pressure, rho, start, npts, rho_ref)
184  case (eos_wright)
185  call calculate_density_wright(t, s, pressure, rho, start, npts, rho_ref)
186  case (eos_teos10)
187  call calculate_density_teos10(t, s, pressure, rho, start, npts, rho_ref)
188  case (eos_nemo)
189  call calculate_density_nemo (t, s, pressure, rho, start, npts, rho_ref)
190  case default
191  call mom_error(fatal, &
192  "calculate_density_array: EOS%form_of_EOS is not valid.")
193  end select
194 
195 end subroutine calculate_density_array
196 
197 !> Calls the appropriate subroutine to calculate specific volume of sea water
198 !! for scalar inputs.
199 subroutine calculate_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref)
200  real, intent(in) :: T !< Potential temperature referenced to the surface [degC]
201  real, intent(in) :: S !< Salinity [ppt]
202  real, intent(in) :: pressure !< Pressure [Pa]
203  real, intent(out) :: specvol !< specific volume (in-situ if pressure is local) [m3 kg-1]
204  type(eos_type), pointer :: EOS !< Equation of state structure
205  real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1].
206 
207  real :: rho
208 
209  if (.not.associated(eos)) call mom_error(fatal, &
210  "calculate_spec_vol_scalar called with an unassociated EOS_type EOS.")
211 
212  select case (eos%form_of_EOS)
213  case (eos_linear)
214  call calculate_spec_vol_linear(t, s, pressure, specvol, &
215  eos%rho_T0_S0, eos%drho_dT, eos%drho_dS, spv_ref)
216  case (eos_unesco)
217  call calculate_spec_vol_unesco(t, s, pressure, specvol, spv_ref)
218  case (eos_wright)
219  call calculate_spec_vol_wright(t, s, pressure, specvol, spv_ref)
220  case (eos_teos10)
221  call calculate_spec_vol_teos10(t, s, pressure, specvol, spv_ref)
222  case (eos_nemo)
223  call calculate_density_nemo(t, s, pressure, rho)
224  if (present(spv_ref)) then
225  specvol = 1.0 / rho - spv_ref
226  else
227  specvol = 1.0 / rho
228  endif
229  case default
230  call mom_error(fatal, &
231  "calculate_spec_vol_scalar: EOS is not valid.")
232  end select
233 
234 end subroutine calculate_spec_vol_scalar
235 
236 
237 !> Calls the appropriate subroutine to calculate the specific volume of sea water
238 !! for 1-D array inputs.
239 subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, spv_ref)
240  real, dimension(:), intent(in) :: T !< potential temperature relative to the surface
241  !! [degC].
242  real, dimension(:), intent(in) :: S !< salinity [ppt].
243  real, dimension(:), intent(in) :: pressure !< pressure [Pa].
244  real, dimension(:), intent(out) :: specvol !< in situ specific volume [kg m-3].
245  integer, intent(in) :: start !< the starting point in the arrays.
246  integer, intent(in) :: npts !< the number of values to calculate.
247  type(eos_type), pointer :: EOS !< Equation of state structure
248  real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1].
249 
250  real, dimension(size(specvol)) :: rho
251 
252 
253  if (.not.associated(eos)) call mom_error(fatal, &
254  "calculate_spec_vol_array called with an unassociated EOS_type EOS.")
255 
256  select case (eos%form_of_EOS)
257  case (eos_linear)
258  call calculate_spec_vol_linear(t, s, pressure, specvol, start, npts, &
259  eos%rho_T0_S0, eos%drho_dT, eos%drho_dS, spv_ref)
260  case (eos_unesco)
261  call calculate_spec_vol_unesco(t, s, pressure, specvol, start, npts, spv_ref)
262  case (eos_wright)
263  call calculate_spec_vol_wright(t, s, pressure, specvol, start, npts, spv_ref)
264  case (eos_teos10)
265  call calculate_spec_vol_teos10(t, s, pressure, specvol, start, npts, spv_ref)
266  case (eos_nemo)
267  call calculate_density_nemo (t, s, pressure, rho, start, npts)
268  if (present(spv_ref)) then
269  specvol(:) = 1.0 / rho(:) - spv_ref
270  else
271  specvol(:) = 1.0 / rho(:)
272  endif
273  case default
274  call mom_error(fatal, &
275  "calculate_spec_vol_array: EOS%form_of_EOS is not valid.")
276  end select
277 
278 end subroutine calculate_spec_vol_array
279 
280 
281 !> Calls the appropriate subroutine to calculate the freezing point for scalar inputs.
282 subroutine calculate_tfreeze_scalar(S, pressure, T_fr, EOS)
283  real, intent(in) :: S !< Salinity [ppt]
284  real, intent(in) :: pressure !< Pressure [Pa]
285  real, intent(out) :: T_fr !< Freezing point potential temperature referenced
286  !! to the surface [degC]
287  type(eos_type), pointer :: EOS !< Equation of state structure
288 
289  if (.not.associated(eos)) call mom_error(fatal, &
290  "calculate_TFreeze_scalar called with an unassociated EOS_type EOS.")
291 
292  select case (eos%form_of_TFreeze)
293  case (tfreeze_linear)
294  call calculate_tfreeze_linear(s, pressure, t_fr, eos%TFr_S0_P0, &
295  eos%dTFr_dS, eos%dTFr_dp)
296  case (tfreeze_millero)
297  call calculate_tfreeze_millero(s, pressure, t_fr)
298  case (tfreeze_teos10)
299  call calculate_tfreeze_teos10(s, pressure, t_fr)
300  case default
301  call mom_error(fatal, &
302  "calculate_TFreeze_scalar: form_of_TFreeze is not valid.")
303  end select
304 
305 end subroutine calculate_tfreeze_scalar
306 
307 !> Calls the appropriate subroutine to calculate the freezing point for a 1-D array.
308 subroutine calculate_tfreeze_array(S, pressure, T_fr, start, npts, EOS)
309  real, dimension(:), intent(in) :: S !< Salinity [ppt]
310  real, dimension(:), intent(in) :: pressure !< Pressure [Pa]
311  real, dimension(:), intent(out) :: T_fr !< Freezing point potential temperature referenced
312  !! to the surface [degC]
313  integer, intent(in) :: start !< Starting index within the array
314  integer, intent(in) :: npts !< The number of values to calculate
315  type(eos_type), pointer :: EOS !< Equation of state structure
316 
317  if (.not.associated(eos)) call mom_error(fatal, &
318  "calculate_TFreeze_scalar called with an unassociated EOS_type EOS.")
319 
320  select case (eos%form_of_TFreeze)
321  case (tfreeze_linear)
322  call calculate_tfreeze_linear(s, pressure, t_fr, start, npts, &
323  eos%TFr_S0_P0, eos%dTFr_dS, eos%dTFr_dp)
324  case (tfreeze_millero)
325  call calculate_tfreeze_millero(s, pressure, t_fr, start, npts)
326  case (tfreeze_teos10)
327  call calculate_tfreeze_teos10(s, pressure, t_fr, start, npts)
328  case default
329  call mom_error(fatal, &
330  "calculate_TFreeze_scalar: form_of_TFreeze is not valid.")
331  end select
332 
333 end subroutine calculate_tfreeze_array
334 
335 !> Calls the appropriate subroutine to calculate density derivatives for 1-D array inputs.
336 subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS)
337  real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC]
338  real, dimension(:), intent(in) :: S !< Salinity [ppt]
339  real, dimension(:), intent(in) :: pressure !< Pressure [Pa]
340  real, dimension(:), intent(out) :: drho_dT !< The partial derivative of density with potential
341  !! temperature [kg m-3 degC-1].
342  real, dimension(:), intent(out) :: drho_dS !< The partial derivative of density with salinity,
343  !! in [kg m-3 ppt-1].
344  integer, intent(in) :: start !< Starting index within the array
345  integer, intent(in) :: npts !< The number of values to calculate
346  type(eos_type), pointer :: EOS !< Equation of state structure
347 
348  if (.not.associated(eos)) call mom_error(fatal, &
349  "calculate_density_derivs called with an unassociated EOS_type EOS.")
350 
351  select case (eos%form_of_EOS)
352  case (eos_linear)
353  call calculate_density_derivs_linear(t, s, pressure, drho_dt, drho_ds, eos%Rho_T0_S0, &
354  eos%dRho_dT, eos%dRho_dS, start, npts)
355  case (eos_unesco)
356  call calculate_density_derivs_unesco(t, s, pressure, drho_dt, drho_ds, start, npts)
357  case (eos_wright)
358  call calculate_density_derivs_wright(t, s, pressure, drho_dt, drho_ds, start, npts)
359  case (eos_teos10)
360  call calculate_density_derivs_teos10(t, s, pressure, drho_dt, drho_ds, start, npts)
361  case (eos_nemo)
362  call calculate_density_derivs_nemo(t, s, pressure, drho_dt, drho_ds, start, npts)
363  case default
364  call mom_error(fatal, &
365  "calculate_density_derivs_array: EOS%form_of_EOS is not valid.")
366  end select
367 
368 end subroutine calculate_density_derivs_array
369 
370 !> Calls the appropriate subroutines to calculate density derivatives by promoting a scalar
371 !! to a one-element array
372 subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS)
373  real, intent(in) :: T !< Potential temperature referenced to the surface [degC]
374  real, intent(in) :: S !< Salinity [ppt]
375  real, intent(in) :: pressure !< Pressure [Pa]
376  real, intent(out) :: drho_dT !< The partial derivative of density with potential
377  !! temperature [kg m-3 degC-1].
378  real, intent(out) :: drho_dS !< The partial derivative of density with salinity,
379  !! in [kg m-3 ppt-1].
380  type(eos_type), pointer :: EOS !< Equation of state structure
381  if (.not.associated(eos)) call mom_error(fatal, &
382  "calculate_density_derivs called with an unassociated EOS_type EOS.")
383 
384  select case (eos%form_of_EOS)
385  case (eos_linear)
386  call calculate_density_derivs_linear(t, s, pressure, drho_dt, drho_ds, &
387  eos%Rho_T0_S0, eos%dRho_dT, eos%dRho_dS)
388  case (eos_wright)
389  call calculate_density_derivs_wright(t, s, pressure, drho_dt, drho_ds)
390  case (eos_teos10)
391  call calculate_density_derivs_teos10(t, s, pressure, drho_dt, drho_ds)
392  case default
393  call mom_error(fatal, &
394  "calculate_density_derivs_scalar: EOS%form_of_EOS is not valid.")
395  end select
396 
397 end subroutine calculate_density_derivs_scalar
398 
399 !> Calls the appropriate subroutine to calculate density second derivatives for 1-D array inputs.
400 subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, &
401  drho_dS_dP, drho_dT_dP, start, npts, EOS)
402  real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC]
403  real, dimension(:), intent(in) :: S !< Salinity [ppt]
404  real, dimension(:), intent(in) :: pressure !< Pressure [Pa]
405  real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect
406  !! to S [kg m-3 ppt-2]
407  real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with respcct
408  !! to T [kg m-3 ppt-1 degC-1]
409  real, dimension(:), intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect
410  !! to T [kg m-3 degC-2]
411  real, dimension(:), intent(out) :: drho_dS_dP !< Partial derivative of beta with respect
412  !! to pressure [kg m-3 ppt-1 Pa-1]
413  real, dimension(:), intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect
414  !! to pressure [kg m-3 degC-1 Pa-1]
415  integer, intent(in) :: start !< Starting index within the array
416  integer, intent(in) :: npts !< The number of values to calculate
417  type(eos_type), pointer :: EOS !< Equation of state structure
418 
419  if (.not.associated(eos)) call mom_error(fatal, &
420  "calculate_density_derivs called with an unassociated EOS_type EOS.")
421 
422  select case (eos%form_of_EOS)
423  case (eos_linear)
424  call calculate_density_second_derivs_linear(t, s, pressure, drho_ds_ds, drho_ds_dt, &
425  drho_dt_dt, drho_ds_dp, drho_dt_dp, start, npts)
426  case (eos_wright)
427  call calculate_density_second_derivs_wright(t, s, pressure, drho_ds_ds, drho_ds_dt, &
428  drho_dt_dt, drho_ds_dp, drho_dt_dp, start, npts)
429  case (eos_teos10)
430  call calculate_density_second_derivs_teos10(t, s, pressure, drho_ds_ds, drho_ds_dt, &
431  drho_dt_dt, drho_ds_dp, drho_dt_dp, start, npts)
432  case default
433  call mom_error(fatal, &
434  "calculate_density_derivs: EOS%form_of_EOS is not valid.")
435  end select
436 
437 end subroutine calculate_density_second_derivs_array
438 
439 !> Calls the appropriate subroutine to calculate density second derivatives for scalar nputs.
440 subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, &
441  drho_dS_dP, drho_dT_dP, EOS)
442  real, intent(in) :: T !< Potential temperature referenced to the surface [degC]
443  real, intent(in) :: S !< Salinity [ppt]
444  real, intent(in) :: pressure !< Pressure [Pa]
445  real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect
446  !! to S [kg m-3 ppt-2]
447  real, intent(out) :: drho_dS_dT !< Partial derivative of beta with respcct
448  !! to T [kg m-3 ppt-1 degC-1]
449  real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect
450  !! to T [kg m-3 degC-2]
451  real, intent(out) :: drho_dS_dP !< Partial derivative of beta with respect
452  !! to pressure [kg m-3 ppt-1 Pa-1]
453  real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect
454  !! to pressure [kg m-3 degC-1 Pa-1]
455  type(eos_type), pointer :: EOS !< Equation of state structure
456 
457  if (.not.associated(eos)) call mom_error(fatal, &
458  "calculate_density_derivs called with an unassociated EOS_type EOS.")
459 
460  select case (eos%form_of_EOS)
461  case (eos_linear)
462  call calculate_density_second_derivs_linear(t, s, pressure, drho_ds_ds, drho_ds_dt, &
463  drho_dt_dt, drho_ds_dp, drho_dt_dp)
464  case (eos_wright)
465  call calculate_density_second_derivs_wright(t, s, pressure, drho_ds_ds, drho_ds_dt, &
466  drho_dt_dt, drho_ds_dp, drho_dt_dp)
467  case (eos_teos10)
468  call calculate_density_second_derivs_teos10(t, s, pressure, drho_ds_ds, drho_ds_dt, &
469  drho_dt_dt, drho_ds_dp, drho_dt_dp)
470  case default
471  call mom_error(fatal, &
472  "calculate_density_derivs: EOS%form_of_EOS is not valid.")
473  end select
474 
475 end subroutine calculate_density_second_derivs_scalar
476 
477 !> Calls the appropriate subroutine to calculate specific volume derivatives for an array.
478 subroutine calculate_specific_vol_derivs(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS)
479  real, dimension(:), intent(in) :: t !< Potential temperature referenced to the surface [degC]
480  real, dimension(:), intent(in) :: s !< Salinity [ppt]
481  real, dimension(:), intent(in) :: pressure !< Pressure [Pa]
482  real, dimension(:), intent(out) :: dsv_dt !< The partial derivative of specific volume with potential
483  !! temperature [m3 kg-1 degC-1].
484  real, dimension(:), intent(out) :: dsv_ds !< The partial derivative of specific volume with salinity
485  !! [m3 kg-1 ppt-1].
486  integer, intent(in) :: start !< Starting index within the array
487  integer, intent(in) :: npts !< The number of values to calculate
488  type(eos_type), pointer :: eos !< Equation of state structure
489  ! Local variables
490  real, dimension(size(T)) :: drho_dt, drho_ds, rho
491  integer :: j
492 
493  if (.not.associated(eos)) call mom_error(fatal, &
494  "calculate_density_derivs called with an unassociated EOS_type EOS.")
495 
496  select case (eos%form_of_EOS)
497  case (eos_linear)
498  call calculate_specvol_derivs_linear(t, s, pressure, dsv_dt, dsv_ds, start, &
499  npts, eos%Rho_T0_S0, eos%dRho_dT, eos%dRho_dS)
500  case (eos_unesco)
501  call calculate_density_unesco(t, s, pressure, rho, start, npts)
502  call calculate_density_derivs_unesco(t, s, pressure, drho_dt, drho_ds, start, npts)
503  do j=start,start+npts-1
504  dsv_dt(j) = -drho_dt(j)/(rho(j)**2)
505  dsv_ds(j) = -drho_ds(j)/(rho(j)**2)
506  enddo
507  case (eos_wright)
508  call calculate_specvol_derivs_wright(t, s, pressure, dsv_dt, dsv_ds, start, npts)
509  case (eos_teos10)
510  call calculate_specvol_derivs_teos10(t, s, pressure, dsv_dt, dsv_ds, start, npts)
511  case (eos_nemo)
512  call calculate_density_nemo(t, s, pressure, rho, start, npts)
513  call calculate_density_derivs_nemo(t, s, pressure, drho_dt, drho_ds, start, npts)
514  do j=start,start+npts-1
515  dsv_dt(j) = -drho_dt(j)/(rho(j)**2)
516  dsv_ds(j) = -drho_ds(j)/(rho(j)**2)
517  enddo
518  case default
519  call mom_error(fatal, &
520  "calculate_density_derivs: EOS%form_of_EOS is not valid.")
521  end select
522 
523 end subroutine calculate_specific_vol_derivs
524 
525 !> Calls the appropriate subroutine to calculate the density and compressibility for 1-D array inputs.
526 subroutine calculate_compress(T, S, pressure, rho, drho_dp, start, npts, EOS)
527  real, dimension(:), intent(in) :: t !< Potential temperature referenced to the surface [degC]
528  real, dimension(:), intent(in) :: s !< Salinity [ppt]
529  real, dimension(:), intent(in) :: pressure !< Pressure [Pa]
530  real, dimension(:), intent(out) :: rho !< In situ density [kg m-3].
531  real, dimension(:), intent(out) :: drho_dp !< The partial derivative of density with pressure
532  !! (also the inverse of the square of sound speed) in s2 m-2.
533  integer, intent(in) :: start !< Starting index within the array
534  integer, intent(in) :: npts !< The number of values to calculate
535  type(eos_type), pointer :: eos !< Equation of state structure
536 
537  if (.not.associated(eos)) call mom_error(fatal, &
538  "calculate_compress called with an unassociated EOS_type EOS.")
539 
540  select case (eos%form_of_EOS)
541  case (eos_linear)
542  call calculate_compress_linear(t, s, pressure, rho, drho_dp, start, npts, &
543  eos%Rho_T0_S0, eos%dRho_dT, eos%dRho_dS)
544  case (eos_unesco)
545  call calculate_compress_unesco(t, s, pressure, rho, drho_dp, start, npts)
546  case (eos_wright)
547  call calculate_compress_wright(t, s, pressure, rho, drho_dp, start, npts)
548  case (eos_teos10)
549  call calculate_compress_teos10(t, s, pressure, rho, drho_dp, start, npts)
550  case (eos_nemo)
551  call calculate_compress_nemo(t, s, pressure, rho, drho_dp, start, npts)
552  case default
553  call mom_error(fatal, &
554  "calculate_compress: EOS%form_of_EOS is not valid.")
555  end select
556 
557 end subroutine calculate_compress
558 
559 !> Calls the appropriate subroutine to alculate analytical and nearly-analytical
560 !! integrals in pressure across layers of geopotential anomalies, which are
561 !! required for calculating the finite-volume form pressure accelerations in a
562 !! non-Boussinesq model. There are essentially no free assumptions, apart from the
563 !! use of Bode's rule to do the horizontal integrals, and from a truncation in the
564 !! series for log(1-eps/1+eps) that assumes that |eps| < .
565 subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, &
566  dza, intp_dza, intx_dza, inty_dza, halo_size, &
567  bathyP, dP_tiny, useMassWghtInterp)
568  type(hor_index_type), intent(in) :: hi !< The horizontal index structure
569  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
570  intent(in) :: t !< Potential temperature referenced to the surface [degC]
571  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
572  intent(in) :: s !< Salinity [ppt]
573  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
574  intent(in) :: p_t !< Pressure at the top of the layer [Pa].
575  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
576  intent(in) :: p_b !< Pressure at the bottom of the layer [Pa].
577  real, intent(in) :: alpha_ref !< A mean specific volume that is subtracted out
578  !! to reduce the magnitude of each of the integrals, m3 kg-1. The
579  !! calculation is mathematically identical with different values of
580  !! alpha_ref, but this reduces the effects of roundoff.
581  type(eos_type), pointer :: eos !< Equation of state structure
582  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
583  intent(out) :: dza !< The change in the geopotential anomaly across
584  !! the layer [m2 s-2].
585  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
586  optional, intent(out) :: intp_dza !< The integral in pressure through the layer of the
587  !! geopotential anomaly relative to the anomaly at the bottom of the
588  !! layer [Pa m2 s-2].
589  real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), &
590  optional, intent(out) :: intx_dza !< The integral in x of the difference between the
591  !! geopotential anomaly at the top and bottom of the layer divided by
592  !! the x grid spacing [m2 s-2].
593  real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), &
594  optional, intent(out) :: inty_dza !< The integral in y of the difference between the
595  !! geopotential anomaly at the top and bottom of the layer divided by
596  !! the y grid spacing [m2 s-2].
597  integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza.
598  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
599  optional, intent(in) :: bathyp !< The pressure at the bathymetry [Pa]
600  real, optional, intent(in) :: dp_tiny !< A miniscule pressure change with
601  !! the same units as p_t (Pa?)
602  logical, optional, intent(in) :: usemasswghtinterp !< If true, uses mass weighting
603  !! to interpolate T/S for top and bottom integrals.
604 
605  if (.not.associated(eos)) call mom_error(fatal, &
606  "int_specific_vol_dp called with an unassociated EOS_type EOS.")
607 
608  if (eos%EOS_quadrature) then
609  call int_spec_vol_dp_generic(t, s, p_t, p_b, alpha_ref, hi, eos, &
610  dza, intp_dza, intx_dza, inty_dza, halo_size, &
611  bathyp, dp_tiny, usemasswghtinterp)
612  else ; select case (eos%form_of_EOS)
613  case (eos_linear)
614  call int_spec_vol_dp_linear(t, s, p_t, p_b, alpha_ref, hi, eos%Rho_T0_S0, &
615  eos%dRho_dT, eos%dRho_dS, dza, intp_dza, &
616  intx_dza, inty_dza, halo_size, &
617  bathyp, dp_tiny, usemasswghtinterp)
618  case (eos_wright)
619  call int_spec_vol_dp_wright(t, s, p_t, p_b, alpha_ref, hi, dza, &
620  intp_dza, intx_dza, inty_dza, halo_size, &
621  bathyp, dp_tiny, usemasswghtinterp)
622  case default
623  call int_spec_vol_dp_generic(t, s, p_t, p_b, alpha_ref, hi, eos, &
624  dza, intp_dza, intx_dza, inty_dza, halo_size, &
625  bathyp, dp_tiny, usemasswghtinterp)
626  end select ; endif
627 
628 end subroutine int_specific_vol_dp
629 
630 !> This subroutine calculates analytical and nearly-analytical integrals of
631 !! pressure anomalies across layers, which are required for calculating the
632 !! finite-volume form pressure accelerations in a Boussinesq model.
633 subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, &
634  dpa, intz_dpa, intx_dpa, inty_dpa, &
635  bathyT, dz_neglect, useMassWghtInterp)
636  type(hor_index_type), intent(in) :: hii !< Ocean horizontal index structures for the input arrays
637  type(hor_index_type), intent(in) :: hio !< Ocean horizontal index structures for the output arrays
638  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
639  intent(in) :: t !< Potential temperature referenced to the surface [degC]
640  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
641  intent(in) :: s !< Salinity [ppt]
642  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
643  intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m].
644  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
645  intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m].
646  real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted out to
647  !! reduce the magnitude of each of the integrals.
648  real, intent(in) :: rho_0 !< A density [kg m-3], that is used to calculate the
649  !! pressure (as p~=-z*rho_0*G_e) used in the equation of state.
650  real, intent(in) :: g_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2].
651  type(eos_type), pointer :: eos !< Equation of state structure
652  real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
653  intent(out) :: dpa !< The change in the pressure anomaly across the layer [Pa].
654  real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
655  optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of
656  !! the pressure anomaly relative to the anomaly at the
657  !! top of the layer [Pa Z ~> Pa m].
658  real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), &
659  optional, intent(out) :: intx_dpa !< The integral in x of the difference between the
660  !! pressure anomaly at the top and bottom of the layer
661  !! divided by the x grid spacing [Pa].
662  real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), &
663  optional, intent(out) :: inty_dpa !< The integral in y of the difference between the
664  !! pressure anomaly at the top and bottom of the layer
665  !! divided by the y grid spacing [Pa].
666  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
667  optional, intent(in) :: bathyt !< The depth of the bathymetry [Z ~> m].
668  real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m].
669  logical, optional, intent(in) :: usemasswghtinterp !< If true, uses mass weighting to
670  !! interpolate T/S for top and bottom integrals.
671 
672  if (.not.associated(eos)) call mom_error(fatal, &
673  "int_density_dz called with an unassociated EOS_type EOS.")
674 
675  if (eos%EOS_quadrature) then
676  call int_density_dz_generic(t, s, z_t, z_b, rho_ref, rho_0, g_e, hii, hio, &
677  eos, dpa, intz_dpa, intx_dpa, inty_dpa, &
678  bathyt, dz_neglect, usemasswghtinterp)
679  else ; select case (eos%form_of_EOS)
680  case (eos_linear)
681  call int_density_dz_linear(t, s, z_t, z_b, rho_ref, rho_0, g_e, hii, hio, &
682  eos%Rho_T0_S0, eos%dRho_dT, eos%dRho_dS, &
683  dpa, intz_dpa, intx_dpa, inty_dpa, &
684  bathyt, dz_neglect, usemasswghtinterp)
685  case (eos_wright)
686  call int_density_dz_wright(t, s, z_t, z_b, rho_ref, rho_0, g_e, hii, hio, &
687  dpa, intz_dpa, intx_dpa, inty_dpa, &
688  bathyt, dz_neglect, usemasswghtinterp)
689  case default
690  call int_density_dz_generic(t, s, z_t, z_b, rho_ref, rho_0, g_e, hii, hio, &
691  eos, dpa, intz_dpa, intx_dpa, inty_dpa, &
692  bathyt, dz_neglect, usemasswghtinterp)
693  end select ; endif
694 
695 end subroutine int_density_dz
696 
697 !> Returns true if the equation of state is compressible (i.e. has pressure dependence)
698 logical function query_compressible(EOS)
699  type(eos_type), pointer :: eos !< Equation of state structure
700 
701  if (.not.associated(eos)) call mom_error(fatal, &
702  "query_compressible called with an unassociated EOS_type EOS.")
703 
704  query_compressible = eos%compressible
705 end function query_compressible
706 
707 !> Initializes EOS_type by allocating and reading parameters
708 subroutine eos_init(param_file, EOS)
709  type(param_file_type), intent(in) :: param_file !< Parameter file structure
710  type(eos_type), pointer :: eos !< Equation of state structure
711  ! Local variables
712 #include "version_variable.h"
713  character(len=40) :: mdl = "MOM_EOS" ! This module's name.
714  character(len=40) :: tmpstr
715 
716  if (.not.associated(eos)) call eos_allocate(eos)
717 
718  ! Read all relevant parameters and write them to the model log.
719  call log_version(param_file, mdl, version, "")
720 
721  call get_param(param_file, mdl, "EQN_OF_STATE", tmpstr, &
722  "EQN_OF_STATE determines which ocean equation of state "//&
723  "should be used. Currently, the valid choices are "//&
724  '"LINEAR", "UNESCO", "WRIGHT", "NEMO" and "TEOS10". '//&
725  "This is only used if USE_EOS is true.", default=eos_default)
726  select case (uppercase(tmpstr))
727  case (eos_linear_string)
728  eos%form_of_EOS = eos_linear
729  case (eos_unesco_string)
730  eos%form_of_EOS = eos_unesco
731  case (eos_wright_string)
732  eos%form_of_EOS = eos_wright
733  case (eos_teos10_string)
734  eos%form_of_EOS = eos_teos10
735  case (eos_nemo_string)
736  eos%form_of_EOS = eos_nemo
737  case default
738  call mom_error(fatal, "interpret_eos_selection: EQN_OF_STATE "//&
739  trim(tmpstr) // "in input file is invalid.")
740  end select
741  call mom_mesg('interpret_eos_selection: equation of state set to "' // &
742  trim(tmpstr)//'"', 5)
743 
744  if (eos%form_of_EOS == eos_linear) then
745  eos%Compressible = .false.
746  call get_param(param_file, mdl, "RHO_T0_S0", eos%Rho_T0_S0, &
747  "When EQN_OF_STATE="//trim(eos_linear_string)//", "//&
748  "this is the density at T=0, S=0.", units="kg m-3", &
749  default=1000.0)
750  call get_param(param_file, mdl, "DRHO_DT", eos%dRho_dT, &
751  "When EQN_OF_STATE="//trim(eos_linear_string)//", "//&
752  "this is the partial derivative of density with "//&
753  "temperature.", units="kg m-3 K-1", default=-0.2)
754  call get_param(param_file, mdl, "DRHO_DS", eos%dRho_dS, &
755  "When EQN_OF_STATE="//trim(eos_linear_string)//", "//&
756  "this is the partial derivative of density with "//&
757  "salinity.", units="kg m-3 PSU-1", default=0.8)
758  endif
759 
760  call get_param(param_file, mdl, "EOS_QUADRATURE", eos%EOS_quadrature, &
761  "If true, always use the generic (quadrature) code "//&
762  "code for the integrals of density.", default=.false.)
763 
764  call get_param(param_file, mdl, "TFREEZE_FORM", tmpstr, &
765  "TFREEZE_FORM determines which expression should be "//&
766  "used for the freezing point. Currently, the valid "//&
767  'choices are "LINEAR", "MILLERO_78", "TEOS10"', &
768  default=tfreeze_default)
769  select case (uppercase(tmpstr))
770  case (tfreeze_linear_string)
771  eos%form_of_TFreeze = tfreeze_linear
772  case (tfreeze_millero_string)
773  eos%form_of_TFreeze = tfreeze_millero
774  case (tfreeze_teos10_string)
775  eos%form_of_TFreeze = tfreeze_teos10
776  case default
777  call mom_error(fatal, "interpret_eos_selection: TFREEZE_FORM "//&
778  trim(tmpstr) // "in input file is invalid.")
779  end select
780 
781  if (eos%form_of_TFreeze == tfreeze_linear) then
782  call get_param(param_file, mdl, "TFREEZE_S0_P0",eos%TFr_S0_P0, &
783  "When TFREEZE_FORM="//trim(tfreeze_linear_string)//", "//&
784  "this is the freezing potential temperature at "//&
785  "S=0, P=0.", units="deg C", default=0.0)
786  call get_param(param_file, mdl, "DTFREEZE_DS",eos%dTFr_dS, &
787  "When TFREEZE_FORM="//trim(tfreeze_linear_string)//", "//&
788  "this is the derivative of the freezing potential "//&
789  "temperature with salinity.", &
790  units="deg C PSU-1", default=-0.054)
791  call get_param(param_file, mdl, "DTFREEZE_DP",eos%dTFr_dP, &
792  "When TFREEZE_FORM="//trim(tfreeze_linear_string)//", "//&
793  "this is the derivative of the freezing potential "//&
794  "temperature with pressure.", &
795  units="deg C Pa-1", default=0.0)
796  endif
797 
798  if ((eos%form_of_EOS == eos_teos10 .OR. eos%form_of_EOS == eos_nemo) .AND. &
799  eos%form_of_TFreeze /= tfreeze_teos10) then
800  call mom_error(fatal, "interpret_eos_selection: EOS_TEOS10 or EOS_NEMO \n" //&
801  "should only be used along with TFREEZE_FORM = TFREEZE_TEOS10 .")
802  endif
803 
804 
805 end subroutine eos_init
806 
807 !> Manually initialized an EOS type (intended for unit testing of routines which need a specific EOS)
808 subroutine eos_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, &
809  Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp)
810  type(eos_type), pointer :: eos !< Equation of state structure
811  integer, optional, intent(in) :: form_of_eos !< A coded integer indicating the equation of state to use.
812  integer, optional, intent(in) :: form_of_tfreeze !< A coded integer indicating the expression for
813  !! the potential temperature of the freezing point.
814  logical, optional, intent(in) :: eos_quadrature !< If true, always use the generic (quadrature)
815  !! code for the integrals of density.
816  logical, optional, intent(in) :: compressible !< If true, in situ density is a function of pressure.
817  real , optional, intent(in) :: rho_t0_s0 !< Density at T=0 degC and S=0 ppt [kg m-3]
818  real , optional, intent(in) :: drho_dt !< Partial derivative of density with temperature
819  !! in [kg m-3 degC-1]
820  real , optional, intent(in) :: drho_ds !< Partial derivative of density with salinity
821  !! in [kg m-3 ppt-1]
822  real , optional, intent(in) :: tfr_s0_p0 !< The freezing potential temperature at S=0, P=0 [degC].
823  real , optional, intent(in) :: dtfr_ds !< The derivative of freezing point with salinity
824  !! in [degC ppt-1].
825  real , optional, intent(in) :: dtfr_dp !< The derivative of freezing point with pressure
826  !! in [degC Pa-1].
827 
828  if (present(form_of_eos )) eos%form_of_EOS = form_of_eos
829  if (present(form_of_tfreeze)) eos%form_of_TFreeze = form_of_tfreeze
830  if (present(eos_quadrature )) eos%EOS_quadrature = eos_quadrature
831  if (present(compressible )) eos%Compressible = compressible
832  if (present(rho_t0_s0 )) eos%Rho_T0_S0 = rho_t0_s0
833  if (present(drho_dt )) eos%drho_dT = drho_dt
834  if (present(drho_ds )) eos%dRho_dS = drho_ds
835  if (present(tfr_s0_p0 )) eos%TFr_S0_P0 = tfr_s0_p0
836  if (present(dtfr_ds )) eos%dTFr_dS = dtfr_ds
837  if (present(dtfr_dp )) eos%dTFr_dp = dtfr_dp
838 
839 end subroutine eos_manual_init
840 
841 !> Allocates EOS_type
842 subroutine eos_allocate(EOS)
843  type(eos_type), pointer :: eos !< Equation of state structure
844 
845  if (.not.associated(eos)) allocate(eos)
846 end subroutine eos_allocate
847 
848 !> Deallocates EOS_type
849 subroutine eos_end(EOS)
850  type(eos_type), pointer :: eos !< Equation of state structure
851 
852  if (associated(eos)) deallocate(eos)
853 end subroutine eos_end
854 
855 !> Set equation of state structure (EOS) to linear with given coefficients
856 !!
857 !! \note This routine is primarily for testing and allows a local copy of the
858 !! EOS_type (EOS argument) to be set to use the linear equation of state
859 !! independent from the rest of the model.
860 subroutine eos_use_linear(Rho_T0_S0, dRho_dT, dRho_dS, EOS, use_quadrature)
861  real, intent(in) :: rho_t0_s0 !< Density at T=0 degC and S=0 ppt [kg m-3]
862  real, intent(in) :: drho_dt !< Partial derivative of density with temperature [kg m-3 degC-1]
863  real, intent(in) :: drho_ds !< Partial derivative of density with salinity [kg m-3 ppt-1]
864  logical, optional, intent(in) :: use_quadrature !< If true, always use the generic (quadrature)
865  !! code for the integrals of density.
866  type(eos_type), pointer :: eos !< Equation of state structure
867 
868  if (.not.associated(eos)) call mom_error(fatal, &
869  "MOM_EOS.F90: EOS_use_linear() called with an unassociated EOS_type EOS.")
870 
871  eos%form_of_EOS = eos_linear
872  eos%Compressible = .false.
873  eos%Rho_T0_S0 = rho_t0_s0
874  eos%dRho_dT = drho_dt
875  eos%dRho_dS = drho_ds
876  eos%EOS_quadrature = .false.
877  if (present(use_quadrature)) eos%EOS_quadrature = use_quadrature
878 
879 end subroutine eos_use_linear
880 
881 !> This subroutine calculates (by numerical quadrature) integrals of
882 !! pressure anomalies across layers, which are required for calculating the
883 !! finite-volume form pressure accelerations in a Boussinesq model.
884 subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, &
885  EOS, dpa, intz_dpa, intx_dpa, inty_dpa, &
886  bathyT, dz_neglect, useMassWghtInterp)
887  type(hor_index_type), intent(in) :: hii !< Horizontal index type for input variables.
888  type(hor_index_type), intent(in) :: hio !< Horizontal index type for output variables.
889  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
890  intent(in) :: t !< Potential temperature of the layer [degC].
891  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
892  intent(in) :: s !< Salinity of the layer [ppt].
893  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
894  intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m].
895  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
896  intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m].
897  real, intent(in) :: rho_ref !< A mean density [kg m-3], that is
898  !! subtracted out to reduce the magnitude
899  !! of each of the integrals.
900  real, intent(in) :: rho_0 !< A density [kg m-3], that is used
901  !! to calculate the pressure (as p~=-z*rho_0*G_e)
902  !! used in the equation of state.
903  real, intent(in) :: g_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2].
904  type(eos_type), pointer :: eos !< Equation of state structure
905  real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
906  intent(out) :: dpa !< The change in the pressure anomaly
907  !! across the layer [Pa].
908  real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
909  optional, intent(out) :: intz_dpa !< The integral through the thickness of the
910  !! layer of the pressure anomaly relative to the
911  !! anomaly at the top of the layer [Pa Z ~> Pa m].
912  real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), &
913  optional, intent(out) :: intx_dpa !< The integral in x of the difference between
914  !! the pressure anomaly at the top and bottom of the
915  !! layer divided by the x grid spacing [Pa].
916  real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), &
917  optional, intent(out) :: inty_dpa !< The integral in y of the difference between
918  !! the pressure anomaly at the top and bottom of the
919  !! layer divided by the y grid spacing [Pa].
920  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
921  optional, intent(in) :: bathyt !< The depth of the bathymetry [Z ~> m].
922  real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m].
923  logical, optional, intent(in) :: usemasswghtinterp !< If true, uses mass weighting to
924  !! interpolate T/S for top and bottom integrals.
925  real :: t5(5), s5(5), p5(5), r5(5)
926  real :: rho_anom ! The depth averaged density anomaly [kg m-3].
927  real :: w_left, w_right
928  real, parameter :: c1_90 = 1.0/90.0 ! Rational constants.
929  real :: gxrho, i_rho
930  real :: dz ! The layer thickness [Z ~> m].
931  real :: hwght ! A pressure-thickness below topography [Z ~> m].
932  real :: hl, hr ! Pressure-thicknesses of the columns to the left and right [Z ~> m].
933  real :: idenom ! The inverse of the denominator in the weights [Z-2 ~> m-2].
934  real :: hwt_ll, hwt_lr ! hWt_LA is the weighted influence of A on the left column [nondim].
935  real :: hwt_rl, hwt_rr ! hWt_RA is the weighted influence of A on the right column [nondim].
936  real :: wt_l, wt_r ! The linear weights of the left and right columns [nondim].
937  real :: wtt_l, wtt_r ! The weights for tracers from the left and right columns [nondim].
938  real :: intz(5) ! The gravitational acceleration times the integrals of density
939  ! with height at the 5 sub-column locations [Pa].
940  logical :: do_massweight ! Indicates whether to do mass weighting.
941  integer :: is, ie, js, je, isq, ieq, jsq, jeq, i, j, m, n, ioff, joff
942 
943  ioff = hio%idg_offset - hii%idg_offset
944  joff = hio%jdg_offset - hii%jdg_offset
945 
946  ! These array bounds work for the indexing convention of the input arrays, but
947  ! on the computational domain defined for the output arrays.
948  isq = hio%IscB + ioff ; ieq = hio%IecB + ioff
949  jsq = hio%JscB + joff ; jeq = hio%JecB + joff
950  is = hio%isc + ioff ; ie = hio%iec + ioff
951  js = hio%jsc + joff ; je = hio%jec + joff
952 
953  gxrho = g_e * rho_0
954  i_rho = 1.0 / rho_0
955 
956  do_massweight = .false.
957  if (present(usemasswghtinterp)) then ; if (usemasswghtinterp) then
958  do_massweight = .true.
959  if (.not.present(bathyt)) call mom_error(fatal, "int_density_dz_generic: "//&
960  "bathyT must be present if useMassWghtInterp is present and true.")
961  if (.not.present(dz_neglect)) call mom_error(fatal, "int_density_dz_generic: "//&
962  "dz_neglect must be present if useMassWghtInterp is present and true.")
963  endif ; endif
964 
965  do j=jsq,jeq+1 ; do i=isq,ieq+1
966  dz = z_t(i,j) - z_b(i,j)
967  do n=1,5
968  t5(n) = t(i,j) ; s5(n) = s(i,j)
969  p5(n) = -gxrho*(z_t(i,j) - 0.25*real(n-1)*dz)
970  enddo
971  call calculate_density(t5, s5, p5, r5, 1, 5, eos, rho_ref)
972 
973  ! Use Bode's rule to estimate the pressure anomaly change.
974  rho_anom = c1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3))
975  dpa(i-ioff,j-joff) = g_e*dz*rho_anom
976  ! Use a Bode's-rule-like fifth-order accurate estimate of the double integral of
977  ! the pressure anomaly.
978  if (present(intz_dpa)) intz_dpa(i-ioff,j-joff) = 0.5*g_e*dz**2 * &
979  (rho_anom - c1_90*(16.0*(r5(4)-r5(2)) + 7.0*(r5(5)-r5(1))) )
980  enddo ; enddo
981 
982  if (present(intx_dpa)) then ; do j=js,je ; do i=isq,ieq
983  ! hWght is the distance measure by which the cell is violation of
984  ! hydrostatic consistency. For large hWght we bias the interpolation of
985  ! T & S along the top and bottom integrals, akin to thickness weighting.
986  hwght = 0.0
987  if (do_massweight) &
988  hwght = max(0., -bathyt(i,j)-z_t(i+1,j), -bathyt(i+1,j)-z_t(i,j))
989  if (hwght > 0.) then
990  hl = (z_t(i,j) - z_b(i,j)) + dz_neglect
991  hr = (z_t(i+1,j) - z_b(i+1,j)) + dz_neglect
992  hwght = hwght * ( (hl-hr)/(hl+hr) )**2
993  idenom = 1.0 / ( hwght*(hr + hl) + hl*hr )
994  hwt_ll = (hwght*hl + hr*hl) * idenom ; hwt_lr = (hwght*hr) * idenom
995  hwt_rr = (hwght*hr + hr*hl) * idenom ; hwt_rl = (hwght*hl) * idenom
996  else
997  hwt_ll = 1.0 ; hwt_lr = 0.0 ; hwt_rr = 1.0 ; hwt_rl = 0.0
998  endif
999 
1000  intz(1) = dpa(i-ioff,j-joff) ; intz(5) = dpa(i+1-ioff,j-joff)
1001  do m=2,4
1002  ! T, S, and z are interpolated in the horizontal. The z interpolation
1003  ! is linear, but for T and S it may be thickness weighted.
1004  wt_l = 0.25*real(5-m) ; wt_r = 1.0-wt_l
1005  wtt_l = wt_l*hwt_ll + wt_r*hwt_rl ; wtt_r = wt_l*hwt_lr + wt_r*hwt_rr
1006  dz = wt_l*(z_t(i,j) - z_b(i,j)) + wt_r*(z_t(i+1,j) - z_b(i+1,j))
1007  t5(1) = wtt_l*t(i,j) + wtt_r*t(i+1,j)
1008  s5(1) = wtt_l*s(i,j) + wtt_r*s(i+1,j)
1009  p5(1) = -gxrho*(wt_l*z_t(i,j) + wt_r*z_t(i+1,j))
1010  do n=2,5
1011  t5(n) = t5(1) ; s5(n) = s5(1) ; p5(n) = p5(n-1) + gxrho*0.25*dz
1012  enddo
1013  call calculate_density(t5, s5, p5, r5, 1, 5, eos, rho_ref)
1014 
1015  ! Use Bode's rule to estimate the pressure anomaly change.
1016  intz(m) = g_e*dz*( c1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)))
1017  enddo
1018  ! Use Bode's rule to integrate the bottom pressure anomaly values in x.
1019  intx_dpa(i-ioff,j-joff) = c1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + &
1020  12.0*intz(3))
1021  enddo ; enddo ; endif
1022 
1023  if (present(inty_dpa)) then ; do j=jsq,jeq ; do i=is,ie
1024  ! hWght is the distance measure by which the cell is violation of
1025  ! hydrostatic consistency. For large hWght we bias the interpolation of
1026  ! T & S along the top and bottom integrals, akin to thickness weighting.
1027  hwght = 0.0
1028  if (do_massweight) &
1029  hwght = max(0., -bathyt(i,j)-z_t(i,j+1), -bathyt(i,j+1)-z_t(i,j))
1030  if (hwght > 0.) then
1031  hl = (z_t(i,j) - z_b(i,j)) + dz_neglect
1032  hr = (z_t(i,j+1) - z_b(i,j+1)) + dz_neglect
1033  hwght = hwght * ( (hl-hr)/(hl+hr) )**2
1034  idenom = 1.0 / ( hwght*(hr + hl) + hl*hr )
1035  hwt_ll = (hwght*hl + hr*hl) * idenom ; hwt_lr = (hwght*hr) * idenom
1036  hwt_rr = (hwght*hr + hr*hl) * idenom ; hwt_rl = (hwght*hl) * idenom
1037  else
1038  hwt_ll = 1.0 ; hwt_lr = 0.0 ; hwt_rr = 1.0 ; hwt_rl = 0.0
1039  endif
1040 
1041  intz(1) = dpa(i-ioff,j-joff) ; intz(5) = dpa(i-ioff,j-joff+1)
1042  do m=2,4
1043  ! T, S, and z are interpolated in the horizontal. The z interpolation
1044  ! is linear, but for T and S it may be thickness weighted.
1045  wt_l = 0.25*real(5-m) ; wt_r = 1.0-wt_l
1046  wtt_l = wt_l*hwt_ll + wt_r*hwt_rl ; wtt_r = wt_l*hwt_lr + wt_r*hwt_rr
1047  dz = wt_l*(z_t(i,j) - z_b(i,j)) + wt_r*(z_t(i,j+1) - z_b(i,j+1))
1048  t5(1) = wtt_l*t(i,j) + wtt_r*t(i,j+1)
1049  s5(1) = wtt_l*s(i,j) + wtt_r*s(i,j+1)
1050  p5(1) = -gxrho*(wt_l*z_t(i,j) + wt_r*z_t(i,j+1))
1051  do n=2,5
1052  t5(n) = t5(1) ; s5(n) = s5(1)
1053  p5(n) = p5(n-1) + gxrho*0.25*dz
1054  enddo
1055  call calculate_density(t5, s5, p5, r5, 1, 5, eos, rho_ref)
1056 
1057  ! Use Bode's rule to estimate the pressure anomaly change.
1058  intz(m) = g_e*dz*( c1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)))
1059  enddo
1060  ! Use Bode's rule to integrate the values.
1061  inty_dpa(i-ioff,j-joff) = c1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + &
1062  12.0*intz(3))
1063  enddo ; enddo ; endif
1064 end subroutine int_density_dz_generic
1065 
1066 
1067 ! ==========================================================================
1068 !> Compute pressure gradient force integrals by quadrature for the case where
1069 !! T and S are linear profiles.
1070 subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, &
1071  rho_0, G_e, dz_subroundoff, bathyT, HII, HIO, EOS, dpa, &
1072  intz_dpa, intx_dpa, inty_dpa, &
1073  useMassWghtInterp)
1074  type(hor_index_type), intent(in) :: hii !< Ocean horizontal index structures for the input arrays
1075  type(hor_index_type), intent(in) :: hio !< Ocean horizontal index structures for the output arrays
1076  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1077  intent(in) :: t_t !< Potential temperatue at the cell top [degC]
1078  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1079  intent(in) :: t_b !< Potential temperatue at the cell bottom [degC]
1080  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1081  intent(in) :: s_t !< Salinity at the cell top [ppt]
1082  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1083  intent(in) :: s_b !< Salinity at the cell bottom [ppt]
1084  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1085  intent(in) :: z_t !< The geometric height at the top of the layer,
1086  !! in depth units [Z ~> m].
1087  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1088  intent(in) :: z_b !< The geometric height at the bottom of the layer [Z ~> m].
1089  real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted out to
1090  !! reduce the magnitude of each of the integrals.
1091  real, intent(in) :: rho_0 !< A density [kg m-3], that is used to calculate the
1092  !! pressure (as p~=-z*rho_0*G_e) used in the equation of state.
1093  real, intent(in) :: g_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2].
1094  real, intent(in) :: dz_subroundoff !< A miniscule thickness change [Z ~> m].
1095  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1096  intent(in) :: bathyt !< The depth of the bathymetry [Z ~> m].
1097  type(eos_type), pointer :: eos !< Equation of state structure
1098  real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
1099  intent(out) :: dpa !< The change in the pressure anomaly across the layer [Pa].
1100  real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
1101  optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of
1102  !! the pressure anomaly relative to the anomaly at the
1103  !! top of the layer [Pa Z].
1104  real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), &
1105  optional, intent(out) :: intx_dpa !< The integral in x of the difference between the
1106  !! pressure anomaly at the top and bottom of the layer
1107  !! divided by the x grid spacing [Pa].
1108  real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), &
1109  optional, intent(out) :: inty_dpa !< The integral in y of the difference between the
1110  !! pressure anomaly at the top and bottom of the layer
1111  !! divided by the y grid spacing [Pa].
1112  logical, optional, intent(in) :: usemasswghtinterp !< If true, uses mass weighting to
1113  !! interpolate T/S for top and bottom integrals.
1114 ! This subroutine calculates (by numerical quadrature) integrals of
1115 ! pressure anomalies across layers, which are required for calculating the
1116 ! finite-volume form pressure accelerations in a Boussinesq model. The one
1117 ! potentially dodgy assumtion here is that rho_0 is used both in the denominator
1118 ! of the accelerations, and in the pressure used to calculated density (the
1119 ! latter being -z*rho_0*G_e). These two uses could be separated if need be.
1120 !
1121 ! It is assumed that the salinity and temperature profiles are linear in the
1122 ! vertical. The top and bottom values within each layer are provided and
1123 ! a linear interpolation is used to compute intermediate values.
1124 
1125  ! Local variables
1126  real :: t5((5*hio%iscb+1):(5*(hio%iecb+2))) ! Temperatures along a line of subgrid locations [degC].
1127  real :: s5((5*hio%iscb+1):(5*(hio%iecb+2))) ! Salinities along a line of subgrid locations [ppt].
1128  real :: p5((5*hio%iscb+1):(5*(hio%iecb+2))) ! Pressures along a line of subgrid locations [Pa].
1129  real :: r5((5*hio%iscb+1):(5*(hio%iecb+2))) ! Densities along a line of subgrid locations [kg m-3].
1130  real :: t15((15*hio%iscb+1):(15*(hio%iecb+1))) ! Temperatures at an array of subgrid locations [degC].
1131  real :: s15((15*hio%iscb+1):(15*(hio%iecb+1))) ! Salinities at an array of subgrid locations [ppt].
1132  real :: p15((15*hio%iscb+1):(15*(hio%iecb+1))) ! Pressures at an array of subgrid locations [Pa].
1133  real :: r15((15*hio%iscb+1):(15*(hio%iecb+1))) ! Densities at an array of subgrid locations [kg m-3].
1134  real :: wt_t(5), wt_b(5) ! Top and bottom weights [nondim].
1135  real :: rho_anom ! A density anomaly [kg m-3].
1136  real :: w_left, w_right ! Left and right weights [nondim].
1137  real :: intz(5) ! The gravitational acceleration times the integrals of density
1138  ! with height at the 5 sub-column locations [Pa].
1139  real, parameter :: c1_90 = 1.0/90.0 ! A rational constant [nondim].
1140  real :: gxrho ! Gravitational acceleration times density [kg m-1 Z-1 s-2 ~> kg m-2 s-2].
1141  real :: i_rho ! The inverse of the reference density [m3 kg-1].
1142  real :: dz(hio%iscb:hio%iecb+1) ! Layer thicknesses at tracer points [Z ~> m].
1143  real :: dz_x(5,hio%iscb:hio%iecb) ! Layer thicknesses along an x-line of subrid locations [Z ~> m].
1144  real :: dz_y(5,hio%isc:hio%iec) ! Layer thicknesses along a y-line of subrid locations [Z ~> m].
1145  real :: weight_t, weight_b ! Nondimensional weights of the top and bottom.
1146  real :: massweighttoggle ! A nondimensional toggle factor (0 or 1).
1147  real :: ttl, tbl, ttr, tbr ! Temperatures at the velocity cell corners [degC].
1148  real :: stl, sbl, str, sbr ! Salinities at the velocity cell corners [ppt].
1149  real :: hwght ! A topographically limited thicknes weight [Z ~> m].
1150  real :: hl, hr ! Thicknesses to the left and right [Z ~> m].
1151  real :: idenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2].
1152  integer :: isq, ieq, jsq, jeq, i, j, m, n
1153  integer :: iin, jin, ioff, joff
1154  integer :: pos
1155 
1156  ioff = hio%idg_offset - hii%idg_offset
1157  joff = hio%jdg_offset - hii%jdg_offset
1158 
1159  isq = hio%IscB ; ieq = hio%IecB ; jsq = hio%JscB ; jeq = hio%JecB
1160 
1161  gxrho = g_e * rho_0
1162  i_rho = 1.0 / rho_0
1163  massweighttoggle = 0.
1164  if (present(usemasswghtinterp)) then
1165  if (usemasswghtinterp) massweighttoggle = 1.
1166  endif
1167 
1168  do n = 1, 5
1169  wt_t(n) = 0.25 * real(5-n)
1170  wt_b(n) = 1.0 - wt_t(n)
1171  enddo
1172 
1173  ! =============================
1174  ! 1. Compute vertical integrals
1175  ! =============================
1176  do j=jsq,jeq+1
1177  jin = j+joff
1178  do i = isq,ieq+1 ; iin = i+ioff
1179  dz(i) = z_t(iin,jin) - z_b(iin,jin)
1180  do n=1,5
1181  p5(i*5+n) = -gxrho*(z_t(iin,jin) - 0.25*real(n-1)*dz(i))
1182  ! Salinity and temperature points are linearly interpolated
1183  s5(i*5+n) = wt_t(n) * s_t(iin,jin) + wt_b(n) * s_b(iin,jin)
1184  t5(i*5+n) = wt_t(n) * t_t(iin,jin) + wt_b(n) * t_b(iin,jin)
1185  enddo
1186  enddo
1187  call calculate_density_array(t5, s5, p5, r5, 1, (ieq-isq+2)*5, eos, rho_ref )
1188 
1189  do i=isq,ieq+1 ; iin = i+ioff
1190  ! Use Bode's rule to estimate the pressure anomaly change.
1191  rho_anom = c1_90*(7.0*(r5(i*5+1)+r5(i*5+5)) + 32.0*(r5(i*5+2)+r5(i*5+4)) + 12.0*r5(i*5+3))
1192  dpa(i,j) = g_e*dz(i)*rho_anom
1193  if (present(intz_dpa)) then
1194  ! Use a Bode's-rule-like fifth-order accurate estimate of
1195  ! the double integral of the pressure anomaly.
1196  intz_dpa(i,j) = 0.5*g_e*dz(i)**2 * &
1197  (rho_anom - c1_90*(16.0*(r5(i*5+4)-r5(i*5+2)) + 7.0*(r5(i*5+5)-r5(i*5+1))) )
1198  endif
1199  enddo
1200  enddo ! end loops on j
1201 
1202 
1203  ! ==================================================
1204  ! 2. Compute horizontal integrals in the x direction
1205  ! ==================================================
1206  if (present(intx_dpa)) then ; do j=hio%jsc,hio%jec ; jin = j+joff
1207  do i=isq,ieq ; iin = i+ioff
1208  ! Corner values of T and S
1209  ! hWght is the distance measure by which the cell is violation of
1210  ! hydrostatic consistency. For large hWght we bias the interpolation
1211  ! of T,S along the top and bottom integrals, almost like thickness
1212  ! weighting.
1213  ! Note: To work in terrain following coordinates we could offset
1214  ! this distance by the layer thickness to replicate other models.
1215  hwght = massweighttoggle * &
1216  max(0., -bathyt(iin,jin)-z_t(iin+1,jin), -bathyt(iin+1,jin)-z_t(iin,jin))
1217  if (hwght > 0.) then
1218  hl = (z_t(iin,jin) - z_b(iin,jin)) + dz_subroundoff
1219  hr = (z_t(iin+1,jin) - z_b(iin+1,jin)) + dz_subroundoff
1220  hwght = hwght * ( (hl-hr)/(hl+hr) )**2
1221  idenom = 1./( hwght*(hr + hl) + hl*hr )
1222  ttl = ( (hwght*hr)*t_t(iin+1,jin) + (hwght*hl + hr*hl)*t_t(iin,jin) ) * idenom
1223  ttr = ( (hwght*hl)*t_t(iin,jin) + (hwght*hr + hr*hl)*t_t(iin+1,jin) ) * idenom
1224  tbl = ( (hwght*hr)*t_b(iin+1,jin) + (hwght*hl + hr*hl)*t_b(iin,jin) ) * idenom
1225  tbr = ( (hwght*hl)*t_b(iin,jin) + (hwght*hr + hr*hl)*t_b(iin+1,jin) ) * idenom
1226  stl = ( (hwght*hr)*s_t(iin+1,jin) + (hwght*hl + hr*hl)*s_t(iin,jin) ) * idenom
1227  str = ( (hwght*hl)*s_t(iin,jin) + (hwght*hr + hr*hl)*s_t(iin+1,jin) ) * idenom
1228  sbl = ( (hwght*hr)*s_b(iin+1,jin) + (hwght*hl + hr*hl)*s_b(iin,jin) ) * idenom
1229  sbr = ( (hwght*hl)*s_b(iin,jin) + (hwght*hr + hr*hl)*s_b(iin+1,jin) ) * idenom
1230  else
1231  ttl = t_t(iin,jin); tbl = t_b(iin,jin); ttr = t_t(iin+1,jin); tbr = t_b(iin+1,jin)
1232  stl = s_t(iin,jin); sbl = s_b(iin,jin); str = s_t(iin+1,jin); sbr = s_b(iin+1,jin)
1233  endif
1234 
1235  do m=2,4
1236  w_left = 0.25*real(5-m) ; w_right = 1.0-w_left
1237  dz_x(m,i) = w_left*(z_t(iin,jin) - z_b(iin,jin)) + w_right*(z_t(iin+1,jin) - z_b(iin+1,jin))
1238 
1239  ! Salinity and temperature points are linearly interpolated in
1240  ! the horizontal. The subscript (1) refers to the top value in
1241  ! the vertical profile while subscript (5) refers to the bottom
1242  ! value in the vertical profile.
1243  pos = i*15+(m-2)*5
1244  t15(pos+1) = w_left*ttl + w_right*ttr
1245  t15(pos+5) = w_left*tbl + w_right*tbr
1246 
1247  s15(pos+1) = w_left*stl + w_right*str
1248  s15(pos+5) = w_left*sbl + w_right*sbr
1249 
1250  p15(pos+1) = -gxrho*(w_left*z_t(iin,jin) + w_right*z_t(iin+1,jin))
1251 
1252  ! Pressure
1253  do n=2,5
1254  p15(pos+n) = p15(pos+n-1) + gxrho*0.25*dz_x(m,i)
1255  enddo
1256 
1257  ! Salinity and temperature (linear interpolation in the vertical)
1258  do n=2,4
1259  weight_t = 0.25 * real(5-n)
1260  weight_b = 1.0 - weight_t
1261  s15(pos+n) = weight_t * s15(pos+1) + weight_b * s15(pos+5)
1262  t15(pos+n) = weight_t * t15(pos+1) + weight_b * t15(pos+5)
1263  enddo
1264  enddo
1265  enddo
1266 
1267  call calculate_density(t15, s15, p15, r15, 1, 15*(ieq-isq+1), eos, rho_ref)
1268 
1269  do i=isq,ieq ; iin = i+ioff
1270  intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j)
1271 
1272  ! Use Bode's rule to estimate the pressure anomaly change.
1273  do m = 2,4
1274  pos = i*15+(m-2)*5
1275  intz(m) = g_e*dz_x(m,i)*( c1_90*(7.0*(r15(pos+1)+r15(pos+5)) + 32.0*(r15(pos+2)+r15(pos+4)) + &
1276  12.0*r15(pos+3)))
1277  enddo
1278  ! Use Bode's rule to integrate the bottom pressure anomaly values in x.
1279  intx_dpa(i,j) = c1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + &
1280  12.0*intz(3))
1281  enddo
1282  enddo ; endif
1283 
1284  ! ==================================================
1285  ! 3. Compute horizontal integrals in the y direction
1286  ! ==================================================
1287  if (present(inty_dpa)) then ; do j=jsq,jeq ; jin = j+joff
1288  do i=hio%isc,hio%iec ; iin = i+ioff
1289  ! Corner values of T and S
1290  ! hWght is the distance measure by which the cell is violation of
1291  ! hydrostatic consistency. For large hWght we bias the interpolation
1292  ! of T,S along the top and bottom integrals, almost like thickness
1293  ! weighting.
1294  ! Note: To work in terrain following coordinates we could offset
1295  ! this distance by the layer thickness to replicate other models.
1296  hwght = massweighttoggle * &
1297  max(0., -bathyt(i,j)-z_t(iin,jin+1), -bathyt(i,j+1)-z_t(iin,jin))
1298  if (hwght > 0.) then
1299  hl = (z_t(iin,jin) - z_b(iin,jin)) + dz_subroundoff
1300  hr = (z_t(iin,jin+1) - z_b(iin,jin+1)) + dz_subroundoff
1301  hwght = hwght * ( (hl-hr)/(hl+hr) )**2
1302  idenom = 1./( hwght*(hr + hl) + hl*hr )
1303  ttl = ( (hwght*hr)*t_t(iin,jin+1) + (hwght*hl + hr*hl)*t_t(iin,jin) ) * idenom
1304  ttr = ( (hwght*hl)*t_t(iin,jin) + (hwght*hr + hr*hl)*t_t(iin,jin+1) ) * idenom
1305  tbl = ( (hwght*hr)*t_b(iin,jin+1) + (hwght*hl + hr*hl)*t_b(iin,jin) ) * idenom
1306  tbr = ( (hwght*hl)*t_b(iin,jin) + (hwght*hr + hr*hl)*t_b(iin,jin+1) ) * idenom
1307  stl = ( (hwght*hr)*s_t(iin,jin+1) + (hwght*hl + hr*hl)*s_t(iin,jin) ) * idenom
1308  str = ( (hwght*hl)*s_t(iin,jin) + (hwght*hr + hr*hl)*s_t(iin,jin+1) ) * idenom
1309  sbl = ( (hwght*hr)*s_b(iin,jin+1) + (hwght*hl + hr*hl)*s_b(iin,jin) ) * idenom
1310  sbr = ( (hwght*hl)*s_b(iin,jin) + (hwght*hr + hr*hl)*s_b(iin,jin+1) ) * idenom
1311  else
1312  ttl = t_t(iin,jin); tbl = t_b(iin,jin); ttr = t_t(iin,jin+1); tbr = t_b(iin,jin+1)
1313  stl = s_t(iin,jin); sbl = s_b(iin,jin); str = s_t(iin,jin+1); sbr = s_b(iin,jin+1)
1314  endif
1315 
1316  do m=2,4
1317  w_left = 0.25*real(5-m) ; w_right = 1.0-w_left
1318  dz_y(m,i) = w_left*(z_t(iin,jin) - z_b(iin,jin)) + w_right*(z_t(iin,jin+1) - z_b(iin,jin+1))
1319 
1320  ! Salinity and temperature points are linearly interpolated in
1321  ! the horizontal. The subscript (1) refers to the top value in
1322  ! the vertical profile while subscript (5) refers to the bottom
1323  ! value in the vertical profile.
1324  pos = i*15+(m-2)*5
1325  t15(pos+1) = w_left*ttl + w_right*ttr
1326  t15(pos+5) = w_left*tbl + w_right*tbr
1327 
1328  s15(pos+1) = w_left*stl + w_right*str
1329  s15(pos+5) = w_left*sbl + w_right*sbr
1330 
1331  p15(pos+1) = -gxrho*(w_left*z_t(iin,jin) + w_right*z_t(iin,jin+1))
1332 
1333  ! Pressure
1334  do n=2,5 ; p15(pos+n) = p15(pos+n-1) + gxrho*0.25*dz_y(m,i) ; enddo
1335 
1336  ! Salinity and temperature (linear interpolation in the vertical)
1337  do n=2,4
1338  weight_t = 0.25 * real(5-n)
1339  weight_b = 1.0 - weight_t
1340  s15(pos+n) = weight_t * s15(pos+1) + weight_b * s15(pos+5)
1341  t15(pos+n) = weight_t * t15(pos+1) + weight_b * t15(pos+5)
1342  enddo
1343  enddo
1344  enddo
1345 
1346  call calculate_density_array(t15(15*hio%isc+1:), s15(15*hio%isc+1:), p15(15*hio%isc+1:), &
1347  r15(15*hio%isc+1:), 1, 15*(hio%iec-hio%isc+1), eos, rho_ref)
1348  do i=hio%isc,hio%iec ; iin = i+ioff
1349  intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1)
1350 
1351  ! Use Bode's rule to estimate the pressure anomaly change.
1352  do m = 2,4
1353  pos = i*15+(m-2)*5
1354  intz(m) = g_e*dz_y(m,i)*( c1_90*(7.0*(r15(pos+1)+r15(pos+5)) + &
1355  32.0*(r15(pos+2)+r15(pos+4)) + &
1356  12.0*r15(pos+3)))
1357  enddo
1358  ! Use Bode's rule to integrate the values.
1359  inty_dpa(i,j) = c1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + &
1360  12.0*intz(3))
1361  enddo
1362  enddo ; endif
1363 
1364 end subroutine int_density_dz_generic_plm
1365 ! ==========================================================================
1366 ! Above is the routine where only the S and T profiles are modified
1367 ! The real topography is still used
1368 ! ==========================================================================
1369 
1370 !> Find the depth at which the reconstructed pressure matches P_tgt
1371 subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_tgt, &
1372  rho_ref, G_e, EOS, P_b, z_out, z_tol)
1373  real, intent(in) :: t_t !< Potential temperatue at the cell top [degC]
1374  real, intent(in) :: t_b !< Potential temperatue at the cell bottom [degC]
1375  real, intent(in) :: s_t !< Salinity at the cell top [ppt]
1376  real, intent(in) :: s_b !< Salinity at the cell bottom [ppt]
1377  real, intent(in) :: z_t !< Absolute height of top of cell [Z ~> m]. (Boussinesq ????)
1378  real, intent(in) :: z_b !< Absolute height of bottom of cell [Z ~> m].
1379  real, intent(in) :: p_t !< Anomalous pressure of top of cell, relative to g*rho_ref*z_t [Pa]
1380  real, intent(in) :: p_tgt !< Target pressure at height z_out, relative to g*rho_ref*z_out [Pa]
1381  real, intent(in) :: rho_ref !< Reference density with which calculation are anomalous to
1382  real, intent(in) :: g_e !< Gravitational acceleration [m2 Z-1 s-2 ~> m s-2]
1383  type(eos_type), pointer :: eos !< Equation of state structure
1384  real, intent(out) :: p_b !< Pressure at the bottom of the cell [Pa]
1385  real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt [Z ~> m].
1386  real, optional, intent(in) :: z_tol !< The tolerance in finding z_out [Z ~> m].
1387  ! Local variables
1388  real :: top_weight, bottom_weight, rho_anom, w_left, w_right, gxrho, dz, dp, f_guess, f_l, f_r
1389  real :: pa, pa_left, pa_right, pa_tol ! Pressure anomalies, P = integral of g*(rho-rho_ref) dz
1390 
1391  gxrho = g_e * rho_ref
1392 
1393  ! Anomalous pressure difference across whole cell
1394  dp = frac_dp_at_pos(t_t, t_b, s_t, s_b, z_t, z_b, rho_ref, g_e, 1.0, eos)
1395 
1396  p_b = p_t + dp ! Anomalous pressure at bottom of cell
1397 
1398  if (p_tgt <= p_t ) then
1399  z_out = z_t
1400  return
1401  endif
1402 
1403  if (p_tgt >= p_b) then
1404  z_out = z_b
1405  return
1406  endif
1407 
1408  f_l = 0.
1409  pa_left = p_t - p_tgt ! Pa_left < 0
1410  f_r = 1.
1411  pa_right = p_b - p_tgt ! Pa_right > 0
1412  pa_tol = gxrho * 1.e-5 ! 1e-5 has dimensions of m, but should be converted to the units of z.
1413  if (present(z_tol)) pa_tol = gxrho * z_tol
1414  f_guess = f_l - pa_left / ( pa_right -pa_left ) * ( f_r - f_l )
1415  pa = pa_right - pa_left ! To get into iterative loop
1416  do while ( abs(pa) > pa_tol )
1417 
1418  z_out = z_t + ( z_b - z_t ) * f_guess
1419  pa = frac_dp_at_pos(t_t, t_b, s_t, s_b, z_t, z_b, rho_ref, g_e, f_guess, eos) - ( p_tgt - p_t )
1420 
1421  if (pa<pa_left) then
1422  write(0,*) pa_left,pa,pa_right,p_t-p_tgt,p_b-p_tgt
1423  stop 'Blurgh! Too negative'
1424  elseif (pa<0.) then
1425  pa_left = pa
1426  f_l = f_guess
1427  elseif (pa>pa_right) then
1428  write(0,*) pa_left,pa,pa_right,p_t-p_tgt,p_b-p_tgt
1429  stop 'Blurgh! Too positive'
1430  elseif (pa>0.) then
1431  pa_right = pa
1432  f_r = f_guess
1433  else ! Pa == 0
1434  return
1435  endif
1436  f_guess = f_l - pa_left / ( pa_right -pa_left ) * ( f_r - f_l )
1437 
1438  enddo
1439 
1440 end subroutine find_depth_of_pressure_in_cell
1441 
1442 !> Returns change in anomalous pressure change from top to non-dimensional
1443 !! position pos between z_t and z_b
1444 real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EOS)
1445  real, intent(in) :: t_t !< Potential temperatue at the cell top [degC]
1446  real, intent(in) :: t_b !< Potential temperatue at the cell bottom [degC]
1447  real, intent(in) :: s_t !< Salinity at the cell top [ppt]
1448  real, intent(in) :: s_b !< Salinity at the cell bottom [ppt]
1449  real, intent(in) :: z_t !< The geometric height at the top of the layer [Z ~> m]
1450  real, intent(in) :: z_b !< The geometric height at the bottom of the layer [Z ~> m]
1451  real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted out to
1452  !! reduce the magnitude of each of the integrals.
1453  real, intent(in) :: g_e !< The Earth's gravitational acceleration [m s-2]
1454  real, intent(in) :: pos !< The fractional vertical position, 0 to 1 [nondim].
1455  type(eos_type), pointer :: eos !< Equation of state structure
1456  ! Local variables
1457  real, parameter :: c1_90 = 1.0/90.0 ! Rational constants.
1458  real :: dz, top_weight, bottom_weight, rho_ave
1459  real, dimension(5) :: t5, s5, p5, rho5
1460  integer :: n
1461 
1462  do n=1,5
1463  ! Evalute density at five quadrature points
1464  bottom_weight = 0.25*real(n-1) * pos
1465  top_weight = 1.0 - bottom_weight
1466  ! Salinity and temperature points are linearly interpolated
1467  s5(n) = top_weight * s_t + bottom_weight * s_b
1468  t5(n) = top_weight * t_t + bottom_weight * t_b
1469  p5(n) = ( top_weight * z_t + bottom_weight * z_b ) * ( g_e * rho_ref )
1470  enddo
1471  call calculate_density_array(t5, s5, p5, rho5, 1, 5, eos)
1472  rho5(:) = rho5(:) !- rho_ref ! Work with anomalies relative to rho_ref
1473 
1474  ! Use Boole's rule to estimate the average density
1475  rho_ave = c1_90*(7.0*(rho5(1)+rho5(5)) + 32.0*(rho5(2)+rho5(4)) + 12.0*rho5(3))
1476 
1477  dz = ( z_t - z_b ) * pos
1478  frac_dp_at_pos = g_e * dz * rho_ave
1479 end function frac_dp_at_pos
1480 
1481 
1482 ! ==========================================================================
1483 !> Compute pressure gradient force integrals for the case where T and S
1484 !! are parabolic profiles
1485 subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, &
1486  z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, &
1487  EOS, dpa, intz_dpa, intx_dpa, inty_dpa)
1489  type(hor_index_type), intent(in) :: hii !< Ocean horizontal index structures for the input arrays
1490  type(hor_index_type), intent(in) :: hio !< Ocean horizontal index structures for the output arrays
1491  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1492  intent(in) :: t !< Potential temperature referenced to the surface [degC]
1493  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1494  intent(in) :: t_t !< Potential temperatue at the cell top [degC]
1495  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1496  intent(in) :: t_b !< Potential temperatue at the cell bottom [degC]
1497  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1498  intent(in) :: s !< Salinity [ppt]
1499  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1500  intent(in) :: s_t !< Salinity at the cell top [ppt]
1501  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1502  intent(in) :: s_b !< Salinity at the cell bottom [ppt]
1503  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1504  intent(in) :: z_t !< Height at the top of the layer [Z ~> m].
1505  real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), &
1506  intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m].
1507  real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted out to
1508  !! reduce the magnitude of each of the integrals.
1509  real, intent(in) :: rho_0 !< A density [kg m-3], that is used to calculate the
1510  !! pressure (as p~=-z*rho_0*G_e) used in the equation of state.
1511  real, intent(in) :: g_e !< The Earth's gravitational acceleration [m s-2]
1512  type(eos_type), pointer :: eos !< Equation of state structure
1513  real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
1514  intent(out) :: dpa !< The change in the pressure anomaly across the layer [Pa].
1515  real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), &
1516  optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of
1517  !! the pressure anomaly relative to the anomaly at the
1518  !! top of the layer [Pa Z ~> Pa m].
1519  real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), &
1520  optional, intent(out) :: intx_dpa !< The integral in x of the difference between the
1521  !! pressure anomaly at the top and bottom of the layer
1522  !! divided by the x grid spacing [Pa].
1523  real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), &
1524  optional, intent(out) :: inty_dpa !< The integral in y of the difference between the
1525  !! pressure anomaly at the top and bottom of the layer
1526  !! divided by the y grid spacing [Pa].
1527 
1528 ! This subroutine calculates (by numerical quadrature) integrals of
1529 ! pressure anomalies across layers, which are required for calculating the
1530 ! finite-volume form pressure accelerations in a Boussinesq model. The one
1531 ! potentially dodgy assumtion here is that rho_0 is used both in the denominator
1532 ! of the accelerations, and in the pressure used to calculated density (the
1533 ! latter being -z*rho_0*G_e). These two uses could be separated if need be.
1534 !
1535 ! It is assumed that the salinity and temperature profiles are linear in the
1536 ! vertical. The top and bottom values within each layer are provided and
1537 ! a linear interpolation is used to compute intermediate values.
1538 
1539  ! Local variables
1540  real :: t5(5), s5(5), p5(5), r5(5)
1541  real :: rho_anom
1542  real :: w_left, w_right, intz(5)
1543  real, parameter :: c1_90 = 1.0/90.0 ! Rational constants.
1544  real :: gxrho, i_rho
1545  real :: dz
1546  real :: weight_t, weight_b
1547  real :: s0, s1, s2 ! parabola coefficients for S [ppt]
1548  real :: t0, t1, t2 ! parabola coefficients for T [degC]
1549  real :: xi ! normalized coordinate
1550  real :: t_top, t_mid, t_bot
1551  real :: s_top, s_mid, s_bot
1552  integer :: is, ie, js, je, isq, ieq, jsq, jeq, i, j, m, n, ioff, joff
1553  real, dimension(4) :: x, y
1554  real, dimension(9) :: s_node, t_node, p_node, r_node
1555 
1556 
1557  call mom_error(fatal, &
1558  "int_density_dz_generic_ppm: the implementation is not done yet, contact developer")
1559 
1560  ioff = hio%idg_offset - hii%idg_offset
1561  joff = hio%jdg_offset - hii%jdg_offset
1562 
1563  ! These array bounds work for the indexing convention of the input arrays, but
1564  ! on the computational domain defined for the output arrays.
1565  isq = hio%IscB + ioff ; ieq = hio%IecB + ioff
1566  jsq = hio%JscB + joff ; jeq = hio%JecB + joff
1567  is = hio%isc + ioff ; ie = hio%iec + ioff
1568  js = hio%jsc + joff ; je = hio%jec + joff
1569 
1570  gxrho = g_e * rho_0
1571  i_rho = 1.0 / rho_0
1572 
1573  ! =============================
1574  ! 1. Compute vertical integrals
1575  ! =============================
1576  do j=jsq,jeq+1 ; do i=isq,ieq+1
1577  dz = z_t(i,j) - z_b(i,j)
1578 
1579  ! Coefficients of the parabola for S
1580  s0 = s_t(i,j)
1581  s1 = 6.0 * s(i,j) - 4.0 * s_t(i,j) - 2.0 * s_b(i,j)
1582  s2 = 3.0 * ( s_t(i,j) + s_b(i,j) - 2.0*s(i,j) )
1583 
1584  ! Coefficients of the parabola for T
1585  t0 = t_t(i,j)
1586  t1 = 6.0 * t(i,j) - 4.0 * t_t(i,j) - 2.0 * t_b(i,j)
1587  t2 = 3.0 * ( t_t(i,j) + t_b(i,j) - 2.0*t(i,j) )
1588 
1589  do n=1,5
1590  p5(n) = -gxrho*(z_t(i,j) - 0.25*real(n-1)*dz)
1591 
1592  ! Parabolic reconstruction for T and S
1593  xi = 0.25 * ( n - 1 )
1594  s5(n) = s0 + s1 * xi + s2 * xi**2
1595  t5(n) = t0 + t1 * xi + t2 * xi**2
1596  enddo
1597 
1598  call calculate_density(t5, s5, p5, r5, 1, 5, eos)
1599 
1600  ! Use Bode's rule to estimate the pressure anomaly change.
1601  !rho_anom = C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) - &
1602  ! rho_ref
1603 
1604  rho_anom = 1000.0 + s(i,j) - rho_ref
1605  dpa(i-ioff,j-joff) = g_e*dz*rho_anom
1606 
1607  ! Use a Bode's-rule-like fifth-order accurate estimate of
1608  ! the double integral of the pressure anomaly.
1609  !r5 = r5 - rho_ref
1610  !if (present(intz_dpa)) intz_dpa(i,j) = 0.5*G_e*dz**2 * &
1611  ! (rho_anom - C1_90*(16.0*(r5(4)-r5(2)) + 7.0*(r5(5)-r5(1))) )
1612 
1613  intz_dpa(i-ioff,j-joff) = 0.5 * g_e * dz**2 * ( 1000.0 - rho_ref + s0 + s1/3.0 + &
1614  s2/6.0 )
1615  enddo ; enddo ! end loops on j and i
1616 
1617  ! ==================================================
1618  ! 2. Compute horizontal integrals in the x direction
1619  ! ==================================================
1620  if (present(intx_dpa)) then ; do j=js,je ; do i=isq,ieq
1621  intz(1) = dpa(i-ioff,j-joff) ; intz(5) = dpa(i+1-ioff,j-joff)
1622  do m=2,4
1623  w_left = 0.25*real(5-m) ; w_right = 1.0-w_left
1624  dz = w_left*(z_t(i,j) - z_b(i,j)) + w_right*(z_t(i+1,j) - z_b(i+1,j))
1625 
1626  ! Salinity and temperature points are linearly interpolated in
1627  ! the horizontal. The subscript (1) refers to the top value in
1628  ! the vertical profile while subscript (5) refers to the bottom
1629  ! value in the vertical profile.
1630  t_top = w_left*t_t(i,j) + w_right*t_t(i+1,j)
1631  t_mid = w_left*t(i,j) + w_right*t(i+1,j)
1632  t_bot = w_left*t_b(i,j) + w_right*t_b(i+1,j)
1633 
1634  s_top = w_left*s_t(i,j) + w_right*s_t(i+1,j)
1635  s_mid = w_left*s(i,j) + w_right*s(i+1,j)
1636  s_bot = w_left*s_b(i,j) + w_right*s_b(i+1,j)
1637 
1638  p5(1) = -gxrho*(w_left*z_t(i,j) + w_right*z_t(i+1,j))
1639 
1640  ! Pressure
1641  do n=2,5
1642  p5(n) = p5(n-1) + gxrho*0.25*dz
1643  enddo
1644 
1645  ! Coefficients of the parabola for S
1646  s0 = s_top
1647  s1 = 6.0 * s_mid - 4.0 * s_top - 2.0 * s_bot
1648  s2 = 3.0 * ( s_top + s_bot - 2.0*s_mid )
1649 
1650  ! Coefficients of the parabola for T
1651  t0 = t_top
1652  t1 = 6.0 * t_mid - 4.0 * t_top - 2.0 * t_bot
1653  t2 = 3.0 * ( t_top + t_bot - 2.0*t_mid )
1654 
1655  do n=1,5
1656  ! Parabolic reconstruction for T and S
1657  xi = 0.25 * ( n - 1 )
1658  s5(n) = s0 + s1 * xi + s2 * xi**2
1659  t5(n) = t0 + t1 * xi + t2 * xi**2
1660  enddo
1661 
1662  call calculate_density(t5, s5, p5, r5, 1, 5, eos)
1663 
1664  ! Use Bode's rule to estimate the pressure anomaly change.
1665  intz(m) = g_e*dz*( c1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + &
1666  12.0*r5(3)) - rho_ref)
1667  enddo
1668  intx_dpa(i-ioff,j-joff) = c1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + &
1669  12.0*intz(3))
1670 
1671  ! Use Gauss quadrature rule to compute integral
1672 
1673  ! The following coordinates define the quadrilateral on which the integral
1674  ! is computed
1675  x(1) = 1.0
1676  x(2) = 0.0
1677  x(3) = 0.0
1678  x(4) = 1.0
1679  y(1) = z_t(i+1,j)
1680  y(2) = z_t(i,j)
1681  y(3) = z_b(i,j)
1682  y(4) = z_b(i+1,j)
1683 
1684  t_node = 0.0
1685  p_node = 0.0
1686 
1687  ! Nodal values for S
1688 
1689  ! Parabolic reconstruction on the left
1690  s0 = s_t(i,j)
1691  s1 = 6.0 * s(i,j) - 4.0 * s_t(i,j) - 2.0 * s_b(i,j)
1692  s2 = 3.0 * ( s_t(i,j) + s_b(i,j) - 2.0 * s(i,j) )
1693  s_node(2) = s0
1694  s_node(6) = s0 + 0.5 * s1 + 0.25 * s2
1695  s_node(3) = s0 + s1 + s2
1696 
1697  ! Parabolic reconstruction on the left
1698  s0 = s_t(i+1,j)
1699  s1 = 6.0 * s(i+1,j) - 4.0 * s_t(i+1,j) - 2.0 * s_b(i+1,j)
1700  s2 = 3.0 * ( s_t(i+1,j) + s_b(i+1,j) - 2.0 * s(i+1,j) )
1701  s_node(1) = s0
1702  s_node(8) = s0 + 0.5 * s1 + 0.25 * s2
1703  s_node(4) = s0 + s1 + s2
1704 
1705  s_node(5) = 0.5 * ( s_node(2) + s_node(1) )
1706  s_node(9) = 0.5 * ( s_node(6) + s_node(8) )
1707  s_node(7) = 0.5 * ( s_node(3) + s_node(4) )
1708 
1709  call calculate_density( t_node, s_node, p_node, r_node, 1, 9, eos )
1710  r_node = r_node - rho_ref
1711 
1712  call compute_integral_quadratic( x, y, r_node, intx_dpa(i-ioff,j-joff) )
1713 
1714  intx_dpa(i-ioff,j-joff) = intx_dpa(i-ioff,j-joff) * g_e
1715 
1716  enddo ; enddo ; endif
1717 
1718  ! ==================================================
1719  ! 3. Compute horizontal integrals in the y direction
1720  ! ==================================================
1721  if (present(inty_dpa)) then
1722  call mom_error(warning, "int_density_dz_generic_ppm still needs to be written for inty_dpa!")
1723  do j=jsq,jeq ; do i=is,ie
1724 
1725  inty_dpa(i-ioff,j-joff) = 0.0
1726 
1727  enddo ; enddo
1728  endif
1729 
1730 end subroutine int_density_dz_generic_ppm
1731 
1732 
1733 
1734 ! =============================================================================
1735 !> Compute the integral of the quadratic function
1736 subroutine compute_integral_quadratic( x, y, f, integral )
1737  real, dimension(4), intent(in) :: x !< The x-position of the corners
1738  real, dimension(4), intent(in) :: y !< The y-position of the corners
1739  real, dimension(9), intent(in) :: f !< The function at the quadrature points
1740  real, intent(out) :: integral !< The returned integral
1741 
1742  ! Local variables
1743  integer :: i, k
1744  real, dimension(9) :: weight, xi, eta ! integration points
1745  real :: f_k
1746  real :: dxdxi, dxdeta
1747  real :: dydxi, dydeta
1748  real, dimension(4) :: phiiso, dphiisodxi, dphiisodeta
1749  real, dimension(9) :: phi, dphidxi, dphideta
1750  real :: jacobian_k
1751  real :: t
1752 
1753  ! Quadrature rule (4 points)
1754  !weight(:) = 1.0
1755  !xi(1) = - sqrt(3.0) / 3.0
1756  !xi(2) = sqrt(3.0) / 3.0
1757  !xi(3) = sqrt(3.0) / 3.0
1758  !xi(4) = - sqrt(3.0) / 3.0
1759  !eta(1) = - sqrt(3.0) / 3.0
1760  !eta(2) = - sqrt(3.0) / 3.0
1761  !eta(3) = sqrt(3.0) / 3.0
1762  !eta(4) = sqrt(3.0) / 3.0
1763 
1764  ! Quadrature rule (9 points)
1765  t = sqrt(3.0/5.0)
1766  weight(1) = 25.0/81.0 ; xi(1) = -t ; eta(1) = t
1767  weight(2) = 40.0/81.0 ; xi(2) = .0 ; eta(2) = t
1768  weight(3) = 25.0/81.0 ; xi(3) = t ; eta(3) = t
1769  weight(4) = 40.0/81.0 ; xi(4) = -t ; eta(4) = .0
1770  weight(5) = 64.0/81.0 ; xi(5) = .0 ; eta(5) = .0
1771  weight(6) = 40.0/81.0 ; xi(6) = t ; eta(6) = .0
1772  weight(7) = 25.0/81.0 ; xi(7) = -t ; eta(7) = -t
1773  weight(8) = 40.0/81.0 ; xi(8) = .0 ; eta(8) = -t
1774  weight(9) = 25.0/81.0 ; xi(9) = t ; eta(9) = -t
1775 
1776  integral = 0.0
1777 
1778  ! Integration loop
1779  do k = 1,9
1780 
1781  ! Evaluate shape functions and gradients for isomorphism
1782  call evaluate_shape_bilinear( xi(k), eta(k), phiiso, &
1783  dphiisodxi, dphiisodeta )
1784 
1785  ! Determine gradient of global coordinate at integration point
1786  dxdxi = 0.0
1787  dxdeta = 0.0
1788  dydxi = 0.0
1789  dydeta = 0.0
1790 
1791  do i = 1,4
1792  dxdxi = dxdxi + x(i) * dphiisodxi(i)
1793  dxdeta = dxdeta + x(i) * dphiisodeta(i)
1794  dydxi = dydxi + y(i) * dphiisodxi(i)
1795  dydeta = dydeta + y(i) * dphiisodeta(i)
1796  enddo
1797 
1798  ! Evaluate Jacobian at integration point
1799  jacobian_k = dxdxi*dydeta - dydxi*dxdeta
1800 
1801  ! Evaluate shape functions for interpolation
1802  call evaluate_shape_quadratic( xi(k), eta(k), phi, dphidxi, dphideta )
1803 
1804  ! Evaluate function at integration point
1805  f_k = 0.0
1806  do i = 1,9
1807  f_k = f_k + f(i) * phi(i)
1808  enddo
1809 
1810  integral = integral + weight(k) * f_k * jacobian_k
1811 
1812  enddo ! end integration loop
1813 
1814 end subroutine compute_integral_quadratic
1815 
1816 
1817 ! =============================================================================
1818 !> Evaluation of the four bilinear shape fn and their gradients at (xi,eta)
1819 subroutine evaluate_shape_bilinear( xi, eta, phi, dphidxi, dphideta )
1820  real, intent(in) :: xi !< The x position to evaluate
1821  real, intent(in) :: eta !< The z position to evaluate
1822  real, dimension(4), intent(out) :: phi !< The weights of the four corners at this point
1823  real, dimension(4), intent(out) :: dphidxi !< The x-gradient of the weights of the four
1824  !! corners at this point
1825  real, dimension(4), intent(out) :: dphideta !< The z-gradient of the weights of the four
1826  !! corners at this point
1827 
1828  ! The shape functions within the parent element are defined as shown here:
1829  !
1830  ! (-1,1) 2 o------------o 1 (1,1)
1831  ! | |
1832  ! | |
1833  ! | |
1834  ! | |
1835  ! (-1,-1) 3 o------------o 4 (1,-1)
1836  !
1837 
1838  phi(1) = 0.25 * ( 1 + xi ) * ( 1 + eta )
1839  phi(2) = 0.25 * ( 1 - xi ) * ( 1 + eta )
1840  phi(3) = 0.25 * ( 1 - xi ) * ( 1 - eta )
1841  phi(4) = 0.25 * ( 1 + xi ) * ( 1 - eta )
1842 
1843  dphidxi(1) = 0.25 * ( 1 + eta )
1844  dphidxi(2) = - 0.25 * ( 1 + eta )
1845  dphidxi(3) = - 0.25 * ( 1 - eta )
1846  dphidxi(4) = 0.25 * ( 1 - eta )
1847 
1848  dphideta(1) = 0.25 * ( 1 + xi )
1849  dphideta(2) = 0.25 * ( 1 - xi )
1850  dphideta(3) = - 0.25 * ( 1 - xi )
1851  dphideta(4) = - 0.25 * ( 1 + xi )
1852 
1853 end subroutine evaluate_shape_bilinear
1854 
1855 
1856 ! =============================================================================
1857 !> Evaluation of the nine quadratic shape fn weights and their gradients at (xi,eta)
1858 subroutine evaluate_shape_quadratic ( xi, eta, phi, dphidxi, dphideta )
1860  ! Arguments
1861  real, intent(in) :: xi !< The x position to evaluate
1862  real, intent(in) :: eta !< The z position to evaluate
1863  real, dimension(9), intent(out) :: phi !< The weights of the 9 bilinear quadrature points
1864  !! at this point
1865  real, dimension(9), intent(out) :: dphidxi !< The x-gradient of the weights of the 9 bilinear
1866  !! quadrature points corners at this point
1867  real, dimension(9), intent(out) :: dphideta !< The z-gradient of the weights of the 9 bilinear
1868  !! quadrature points corners at this point
1869 
1870  ! The quadratic shape functions within the parent element are defined as shown here:
1871  !
1872  ! 5 (0,1)
1873  ! (-1,1) 2 o------o------o 1 (1,1)
1874  ! | |
1875  ! | 9 (0,0) |
1876  ! (-1,0) 6 o o o 8 (1,0)
1877  ! | |
1878  ! | |
1879  ! (-1,-1) 3 o------o------o 4 (1,-1)
1880  ! 7 (0,-1)
1881  !
1882 
1883  phi(:) = 0.0
1884  dphidxi(:) = 0.0
1885  dphideta(:) = 0.0
1886 
1887  phi(1) = 0.25 * xi * ( 1 + xi ) * eta * ( 1 + eta )
1888  phi(2) = - 0.25 * xi * ( 1 - xi ) * eta * ( 1 + eta )
1889  phi(3) = 0.25 * xi * ( 1 - xi ) * eta * ( 1 - eta )
1890  phi(4) = - 0.25 * xi * ( 1 + xi ) * eta * ( 1 - eta )
1891  phi(5) = 0.5 * ( 1 + xi ) * ( 1 - xi ) * eta * ( 1 + eta )
1892  phi(6) = - 0.5 * xi * ( 1 - xi ) * ( 1 - eta ) * ( 1 + eta )
1893  phi(7) = - 0.5 * ( 1 - xi ) * ( 1 + xi ) * eta * ( 1 - eta )
1894  phi(8) = 0.5 * xi * ( 1 + xi ) * ( 1 - eta ) * ( 1 + eta )
1895  phi(9) = ( 1 - xi ) * ( 1 + xi ) * ( 1 - eta ) * ( 1 + eta )
1896 
1897  !dphidxi(1) = 0.25 * ( 1 + 2*xi ) * eta * ( 1 + eta )
1898  !dphidxi(2) = - 0.25 * ( 1 - 2*xi ) * eta * ( 1 + eta )
1899  !dphidxi(3) = 0.25 * ( 1 - 2*xi ) * eta * ( 1 - eta )
1900  !dphidxi(4) = - 0.25 * ( 1 + 2*xi ) * eta * ( 1 - eta )
1901  !dphidxi(5) = - xi * eta * ( 1 + eta )
1902  !dphidxi(6) = - 0.5 * ( 1 - 2*xi ) * ( 1 - eta ) * ( 1 + eta )
1903  !dphidxi(7) = xi * eta * ( 1 - eta )
1904  !dphidxi(8) = 0.5 * ( 1 + 2*xi ) * ( 1 - eta ) * ( 1 + eta )
1905  !dphidxi(9) = - 2 * xi * ( 1 - eta ) * ( 1 + eta )
1906 
1907  !dphideta(1) = 0.25 * xi * ( 1 + xi ) * ( 1 + 2*eta )
1908  !dphideta(2) = - 0.25 * xi * ( 1 - xi ) * ( 1 + 2*eta )
1909  !dphideta(3) = 0.25 * xi * ( 1 - xi ) * ( 1 - 2*eta )
1910  !dphideta(4) = - 0.25 * xi * ( 1 + xi ) * ( 1 - 2*eta )
1911  !dphideta(5) = 0.5 * ( 1 + xi ) * ( 1 - xi ) * ( 1 + 2*eta )
1912  !dphideta(6) = xi * ( 1 - xi ) * eta
1913  !dphideta(7) = - 0.5 * ( 1 - xi ) * ( 1 + xi ) * ( 1 - 2*eta )
1914  !dphideta(8) = - xi * ( 1 + xi ) * eta
1915  !dphideta(9) = - 2 * ( 1 - xi ) * ( 1 + xi ) * eta
1916 
1917 end subroutine evaluate_shape_quadratic
1918 ! ==============================================================================
1919 
1920 !> This subroutine calculates integrals of specific volume anomalies in
1921 !! pressure across layers, which are required for calculating the finite-volume
1922 !! form pressure accelerations in a non-Boussinesq model. There are essentially
1923 !! no free assumptions, apart from the use of Bode's rule quadrature to do the integrals.
1924 subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, &
1925  dza, intp_dza, intx_dza, inty_dza, halo_size, &
1926  bathyP, dP_neglect, useMassWghtInterp)
1927  type(hor_index_type), intent(in) :: hi !< A horizontal index type structure.
1928  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
1929  intent(in) :: t !< Potential temperature of the layer [degC].
1930  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
1931  intent(in) :: s !< Salinity of the layer [ppt].
1932  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
1933  intent(in) :: p_t !< Pressure atop the layer [Pa].
1934  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
1935  intent(in) :: p_b !< Pressure below the layer [Pa].
1936  real, intent(in) :: alpha_ref !< A mean specific volume that is
1937  !! subtracted out to reduce the magnitude of each of the
1938  !! integrals [m3 kg-1]. The calculation is mathematically
1939  !! identical with different values of alpha_ref, but alpha_ref
1940  !! alters the effects of roundoff, and answers do change.
1941  type(eos_type), pointer :: eos !< Equation of state structure
1942  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
1943  intent(out) :: dza !< The change in the geopotential anomaly
1944  !! across the layer [m2 s-2].
1945  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
1946  optional, intent(out) :: intp_dza !< The integral in pressure through the
1947  !! layer of the geopotential anomaly relative to the anomaly
1948  !! at the bottom of the layer [Pa m2 s-2].
1949  real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), &
1950  optional, intent(out) :: intx_dza !< The integral in x of the difference
1951  !! between the geopotential anomaly at the top and bottom of
1952  !! the layer divided by the x grid spacing [m2 s-2].
1953  real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), &
1954  optional, intent(out) :: inty_dza !< The integral in y of the difference
1955  !! between the geopotential anomaly at the top and bottom of
1956  !! the layer divided by the y grid spacing [m2 s-2].
1957  integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza.
1958  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
1959  optional, intent(in) :: bathyp !< The pressure at the bathymetry [Pa]
1960  real, optional, intent(in) :: dp_neglect !< A miniscule pressure change with
1961  !! the same units as p_t (Pa?)
1962  logical, optional, intent(in) :: usemasswghtinterp !< If true, uses mass weighting
1963  !! to interpolate T/S for top and bottom integrals.
1964 
1965 ! This subroutine calculates analytical and nearly-analytical integrals in
1966 ! pressure across layers of geopotential anomalies, which are required for
1967 ! calculating the finite-volume form pressure accelerations in a non-Boussinesq
1968 ! model. There are essentially no free assumptions, apart from the use of
1969 ! Bode's rule to do the horizontal integrals, and from a truncation in the
1970 ! series for log(1-eps/1+eps) that assumes that |eps| < 0.34.
1971 
1972  real :: t5(5), s5(5), p5(5), a5(5)
1973  real :: alpha_anom ! The depth averaged specific density anomaly [m3 kg-1].
1974  real :: dp ! The pressure change through a layer [Pa].
1975 ! real :: dp_90(2:4) ! The pressure change through a layer divided by 90 [Pa].
1976  real :: hwght ! A pressure-thickness below topography [Pa].
1977  real :: hl, hr ! Pressure-thicknesses of the columns to the left and right [Pa].
1978  real :: idenom ! The inverse of the denominator in the weights [Pa-2].
1979  real :: hwt_ll, hwt_lr ! hWt_LA is the weighted influence of A on the left column [nondim].
1980  real :: hwt_rl, hwt_rr ! hWt_RA is the weighted influence of A on the right column [nondim].
1981  real :: wt_l, wt_r ! The linear weights of the left and right columns [nondim].
1982  real :: wtt_l, wtt_r ! The weights for tracers from the left and right columns [nondim].
1983  real :: intp(5) ! The integrals of specific volume with pressure at the
1984  ! 5 sub-column locations [m2 s-2].
1985  logical :: do_massweight ! Indicates whether to do mass weighting.
1986  real, parameter :: c1_90 = 1.0/90.0 ! A rational constant.
1987  integer :: isq, ieq, jsq, jeq, ish, ieh, jsh, jeh, i, j, m, n, halo
1988 
1989  isq = hi%IscB ; ieq = hi%IecB ; jsq = hi%JscB ; jeq = hi%JecB
1990  halo = 0 ; if (present(halo_size)) halo = max(halo_size,0)
1991  ish = hi%isc-halo ; ieh = hi%iec+halo ; jsh = hi%jsc-halo ; jeh = hi%jec+halo
1992  if (present(intx_dza)) then ; ish = min(isq,ish) ; ieh = max(ieq+1,ieh); endif
1993  if (present(inty_dza)) then ; jsh = min(jsq,jsh) ; jeh = max(jeq+1,jeh); endif
1994 
1995  do_massweight = .false.
1996  if (present(usemasswghtinterp)) then ; if (usemasswghtinterp) then
1997  do_massweight = .true.
1998  if (.not.present(bathyp)) call mom_error(fatal, "int_spec_vol_dp_generic: "//&
1999  "bathyP must be present if useMassWghtInterp is present and true.")
2000  if (.not.present(dp_neglect)) call mom_error(fatal, "int_spec_vol_dp_generic: "//&
2001  "dP_neglect must be present if useMassWghtInterp is present and true.")
2002  endif ; endif
2003 
2004  do j=jsh,jeh ; do i=ish,ieh
2005  dp = p_b(i,j) - p_t(i,j)
2006  do n=1,5
2007  t5(n) = t(i,j) ; s5(n) = s(i,j)
2008  p5(n) = p_b(i,j) - 0.25*real(n-1)*dp
2009  enddo
2010  call calculate_spec_vol(t5, s5, p5, a5, 1, 5, eos, alpha_ref)
2011 
2012  ! Use Bode's rule to estimate the interface height anomaly change.
2013  alpha_anom = c1_90*(7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4)) + 12.0*a5(3))
2014  dza(i,j) = dp*alpha_anom
2015  ! Use a Bode's-rule-like fifth-order accurate estimate of the double integral of
2016  ! the interface height anomaly.
2017  if (present(intp_dza)) intp_dza(i,j) = 0.5*dp**2 * &
2018  (alpha_anom - c1_90*(16.0*(a5(4)-a5(2)) + 7.0*(a5(5)-a5(1))) )
2019  enddo ; enddo
2020 
2021  if (present(intx_dza)) then ; do j=hi%jsc,hi%jec ; do i=isq,ieq
2022  ! hWght is the distance measure by which the cell is violation of
2023  ! hydrostatic consistency. For large hWght we bias the interpolation of
2024  ! T & S along the top and bottom integrals, akin to thickness weighting.
2025  hwght = 0.0
2026  if (do_massweight) &
2027  hwght = max(0., bathyp(i,j)-p_t(i+1,j), bathyp(i+1,j)-p_t(i,j))
2028  if (hwght > 0.) then
2029  hl = (p_b(i,j) - p_t(i,j)) + dp_neglect
2030  hr = (p_b(i+1,j) - p_t(i+1,j)) + dp_neglect
2031  hwght = hwght * ( (hl-hr)/(hl+hr) )**2
2032  idenom = 1.0 / ( hwght*(hr + hl) + hl*hr )
2033  hwt_ll = (hwght*hl + hr*hl) * idenom ; hwt_lr = (hwght*hr) * idenom
2034  hwt_rr = (hwght*hr + hr*hl) * idenom ; hwt_rl = (hwght*hl) * idenom
2035  else
2036  hwt_ll = 1.0 ; hwt_lr = 0.0 ; hwt_rr = 1.0 ; hwt_rl = 0.0
2037  endif
2038 
2039  intp(1) = dza(i,j) ; intp(5) = dza(i+1,j)
2040  do m=2,4
2041  wt_l = 0.25*real(5-m) ; wt_r = 1.0-wt_l
2042  wtt_l = wt_l*hwt_ll + wt_r*hwt_rl ; wtt_r = wt_l*hwt_lr + wt_r*hwt_rr
2043 
2044  ! T, S, and p are interpolated in the horizontal. The p interpolation
2045  ! is linear, but for T and S it may be thickness wekghted.
2046  p5(1) = wt_l*p_b(i,j) + wt_r*p_b(i+1,j)
2047  dp = wt_l*(p_b(i,j) - p_t(i,j)) + wt_r*(p_b(i+1,j) - p_t(i+1,j))
2048  t5(1) = wtt_l*t(i,j) + wtt_r*t(i+1,j)
2049  s5(1) = wtt_l*s(i,j) + wtt_r*s(i+1,j)
2050 
2051  do n=2,5
2052  t5(n) = t5(1) ; s5(n) = s5(1) ; p5(n) = p5(n-1) - 0.25*dp
2053  enddo
2054  call calculate_spec_vol(t5, s5, p5, a5, 1, 5, eos, alpha_ref)
2055 
2056  ! Use Bode's rule to estimate the interface height anomaly change.
2057  intp(m) = dp*( c1_90*(7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4)) + &
2058  12.0*a5(3)))
2059  enddo
2060  ! Use Bode's rule to integrate the interface height anomaly values in x.
2061  intx_dza(i,j) = c1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + &
2062  12.0*intp(3))
2063  enddo ; enddo ; endif
2064 
2065  if (present(inty_dza)) then ; do j=jsq,jeq ; do i=hi%isc,hi%iec
2066  ! hWght is the distance measure by which the cell is violation of
2067  ! hydrostatic consistency. For large hWght we bias the interpolation of
2068  ! T & S along the top and bottom integrals, akin to thickness weighting.
2069  hwght = 0.0
2070  if (do_massweight) &
2071  hwght = max(0., bathyp(i,j)-p_t(i,j+1), bathyp(i,j+1)-p_t(i,j))
2072  if (hwght > 0.) then
2073  hl = (p_b(i,j) - p_t(i,j)) + dp_neglect
2074  hr = (p_b(i,j+1) - p_t(i,j+1)) + dp_neglect
2075  hwght = hwght * ( (hl-hr)/(hl+hr) )**2
2076  idenom = 1.0 / ( hwght*(hr + hl) + hl*hr )
2077  hwt_ll = (hwght*hl + hr*hl) * idenom ; hwt_lr = (hwght*hr) * idenom
2078  hwt_rr = (hwght*hr + hr*hl) * idenom ; hwt_rl = (hwght*hl) * idenom
2079  else
2080  hwt_ll = 1.0 ; hwt_lr = 0.0 ; hwt_rr = 1.0 ; hwt_rl = 0.0
2081  endif
2082 
2083  intp(1) = dza(i,j) ; intp(5) = dza(i,j+1)
2084  do m=2,4
2085  wt_l = 0.25*real(5-m) ; wt_r = 1.0-wt_l
2086  wtt_l = wt_l*hwt_ll + wt_r*hwt_rl ; wtt_r = wt_l*hwt_lr + wt_r*hwt_rr
2087 
2088  ! T, S, and p are interpolated in the horizontal. The p interpolation
2089  ! is linear, but for T and S it may be thickness wekghted.
2090  p5(1) = wt_l*p_b(i,j) + wt_r*p_b(i,j+1)
2091  dp = wt_l*(p_b(i,j) - p_t(i,j)) + wt_r*(p_b(i,j+1) - p_t(i,j+1))
2092  t5(1) = wtt_l*t(i,j) + wtt_r*t(i,j+1)
2093  s5(1) = wtt_l*s(i,j) + wtt_r*s(i,j+1)
2094  do n=2,5
2095  t5(n) = t5(1) ; s5(n) = s5(1) ; p5(n) = p5(n-1) - 0.25*dp
2096  enddo
2097  call calculate_spec_vol(t5, s5, p5, a5, 1, 5, eos, alpha_ref)
2098 
2099  ! Use Bode's rule to estimate the interface height anomaly change.
2100  intp(m) = dp*( c1_90*(7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4)) + &
2101  12.0*a5(3)))
2102  enddo
2103  ! Use Bode's rule to integrate the interface height anomaly values in y.
2104  inty_dza(i,j) = c1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + &
2105  12.0*intp(3))
2106  enddo ; enddo ; endif
2107 
2108 end subroutine int_spec_vol_dp_generic
2109 
2110 !> This subroutine calculates integrals of specific volume anomalies in
2111 !! pressure across layers, which are required for calculating the finite-volume
2112 !! form pressure accelerations in a non-Boussinesq model. There are essentially
2113 !! no free assumptions, apart from the use of Bode's rule quadrature to do the integrals.
2114 subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, &
2115  dP_neglect, bathyP, HI, EOS, dza, &
2116  intp_dza, intx_dza, inty_dza, useMassWghtInterp)
2117  type(hor_index_type), intent(in) :: hi !< A horizontal index type structure.
2118  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
2119  intent(in) :: t_t !< Potential temperature at the top of the layer [degC].
2120  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
2121  intent(in) :: t_b !< Potential temperature at the bottom of the layer [degC].
2122  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
2123  intent(in) :: s_t !< Salinity at the top the layer [ppt].
2124  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
2125  intent(in) :: s_b !< Salinity at the bottom the layer [ppt].
2126  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
2127  intent(in) :: p_t !< Pressure atop the layer [Pa].
2128  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
2129  intent(in) :: p_b !< Pressure below the layer [Pa].
2130  real, intent(in) :: alpha_ref !< A mean specific volume that is
2131  !! subtracted out to reduce the magnitude of each of the
2132  !! integrals [m3 kg-1]. The calculation is mathematically
2133  !! identical with different values of alpha_ref, but alpha_ref
2134  !! alters the effects of roundoff, and answers do change.
2135  real, intent(in) :: dp_neglect !< A miniscule pressure change with
2136  !! the same units as p_t (Pa?)
2137  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
2138  intent(in) :: bathyp !< The pressure at the bathymetry [Pa]
2139  type(eos_type), pointer :: eos !< Equation of state structure
2140  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
2141  intent(out) :: dza !< The change in the geopotential anomaly
2142  !! across the layer [m2 s-2].
2143  real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), &
2144  optional, intent(out) :: intp_dza !< The integral in pressure through the
2145  !! layer of the geopotential anomaly relative to the anomaly
2146  !! at the bottom of the layer [Pa m2 s-2].
2147  real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), &
2148  optional, intent(out) :: intx_dza !< The integral in x of the difference
2149  !! between the geopotential anomaly at the top and bottom of
2150  !! the layer divided by the x grid spacing [m2 s-2].
2151  real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), &
2152  optional, intent(out) :: inty_dza !< The integral in y of the difference
2153  !! between the geopotential anomaly at the top and bottom of
2154  !! the layer divided by the y grid spacing [m2 s-2].
2155  logical, optional, intent(in) :: usemasswghtinterp !< If true, uses mass weighting
2156  !! to interpolate T/S for top and bottom integrals.
2157 
2158 ! This subroutine calculates analytical and nearly-analytical integrals in
2159 ! pressure across layers of geopotential anomalies, which are required for
2160 ! calculating the finite-volume form pressure accelerations in a non-Boussinesq
2161 ! model. There are essentially no free assumptions, apart from the use of
2162 ! Bode's rule to do the horizontal integrals, and from a truncation in the
2163 ! series for log(1-eps/1+eps) that assumes that |eps| < 0.34.
2164 
2165  real, dimension(5) :: t5, s5, p5, a5
2166  real, dimension(15) :: t15, s15, p15, a15
2167  real :: wt_t(5), wt_b(5)
2168  real :: t_top, t_bot, s_top, s_bot, p_top, p_bot
2169 
2170  real :: alpha_anom ! The depth averaged specific density anomaly [m3 kg-1].
2171  real :: dp ! The pressure change through a layer [Pa].
2172  real :: dp_90(2:4) ! The pressure change through a layer divided by 90 [Pa].
2173  real :: hwght ! A pressure-thickness below topography [Pa].
2174  real :: hl, hr ! Pressure-thicknesses of the columns to the left and right [Pa].
2175  real :: idenom ! The inverse of the denominator in the weights [Pa-2].
2176  real :: hwt_ll, hwt_lr ! hWt_LA is the weighted influence of A on the left column [nondim].
2177  real :: hwt_rl, hwt_rr ! hWt_RA is the weighted influence of A on the right column [nondim].
2178  real :: wt_l, wt_r ! The linear weights of the left and right columns [nondim].
2179  real :: wtt_l, wtt_r ! The weights for tracers from the left and right columns [nondim].
2180  real :: intp(5) ! The integrals of specific volume with pressure at the
2181  ! 5 sub-column locations [m2 s-2].
2182  real, parameter :: c1_90 = 1.0/90.0 ! A rational constant.
2183  logical :: do_massweight ! Indicates whether to do mass weighting.
2184  integer :: isq, ieq, jsq, jeq, i, j, m, n, pos
2185 
2186  isq = hi%IscB ; ieq = hi%IecB ; jsq = hi%JscB ; jeq = hi%JecB
2187 
2188  do_massweight = .false.
2189  if (present(usemasswghtinterp)) do_massweight = usemasswghtinterp
2190 
2191  do n = 1, 5 ! Note that these are reversed from int_density_dz.
2192  wt_t(n) = 0.25 * real(n-1)
2193  wt_b(n) = 1.0 - wt_t(n)
2194  enddo
2195 
2196  ! =============================
2197  ! 1. Compute vertical integrals
2198  ! =============================
2199  do j=jsq,jeq+1; do i=isq,ieq+1
2200  dp = p_b(i,j) - p_t(i,j)
2201  do n=1,5 ! T, S and p are linearly interpolated in the vertical.
2202  p5(n) = wt_t(n) * p_t(i,j) + wt_b(n) * p_b(i,j)
2203  s5(n) = wt_t(n) * s_t(i,j) + wt_b(n) * s_b(i,j)
2204  t5(n) = wt_t(n) * t_t(i,j) + wt_b(n) * t_b(i,j)
2205  enddo
2206  call calculate_spec_vol(t5, s5, p5, a5, 1, 5, eos, alpha_ref)
2207 
2208  ! Use Bode's rule to estimate the interface height anomaly change.
2209  alpha_anom = c1_90*((7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4))) + 12.0*a5(3))
2210  dza(i,j) = dp*alpha_anom
2211  ! Use a Bode's-rule-like fifth-order accurate estimate of the double integral of
2212  ! the interface height anomaly.
2213  if (present(intp_dza)) intp_dza(i,j) = 0.5*dp**2 * &
2214  (alpha_anom - c1_90*(16.0*(a5(4)-a5(2)) + 7.0*(a5(5)-a5(1))) )
2215  enddo ; enddo
2216 
2217  ! ==================================================
2218  ! 2. Compute horizontal integrals in the x direction
2219  ! ==================================================
2220  if (present(intx_dza)) then ; do j=hi%jsc,hi%jec ; do i=isq,ieq
2221  ! hWght is the distance measure by which the cell is violation of
2222  ! hydrostatic consistency. For large hWght we bias the interpolation
2223  ! of T,S along the top and bottom integrals, almost like thickness
2224  ! weighting. Note: To work in terrain following coordinates we could
2225  ! offset this distance by the layer thickness to replicate other models.
2226  hwght = 0.0
2227  if (do_massweight) &
2228  hwght = max(0., bathyp(i,j)-p_t(i+1,j), bathyp(i+1,j)-p_t(i,j))
2229  if (hwght > 0.) then
2230  hl = (p_b(i,j) - p_t(i,j)) + dp_neglect
2231  hr = (p_b(i+1,j) - p_t(i+1,j)) + dp_neglect
2232  hwght = hwght * ( (hl-hr)/(hl+hr) )**2
2233  idenom = 1.0 / ( hwght*(hr + hl) + hl*hr )
2234  hwt_ll = (hwght*hl + hr*hl) * idenom ; hwt_lr = (hwght*hr) * idenom
2235  hwt_rr = (hwght*hr + hr*hl) * idenom ; hwt_rl = (hwght*hl) * idenom
2236  else
2237  hwt_ll = 1.0 ; hwt_lr = 0.0 ; hwt_rr = 1.0 ; hwt_rl = 0.0
2238  endif
2239 
2240  do m=2,4
2241  wt_l = 0.25*real(5-m) ; wt_r = 1.0-wt_l
2242  wtt_l = wt_l*hwt_ll + wt_r*hwt_rl ; wtt_r = wt_l*hwt_lr + wt_r*hwt_rr
2243 
2244  ! T, S, and p are interpolated in the horizontal. The p interpolation
2245  ! is linear, but for T and S it may be thickness wekghted.
2246  p_top = wt_l*p_t(i,j) + wt_r*p_t(i+1,j)
2247  p_bot = wt_l*p_b(i,j) + wt_r*p_b(i+1,j)
2248  t_top = wtt_l*t_t(i,j) + wtt_r*t_t(i+1,j)
2249  t_bot = wtt_l*t_b(i,j) + wtt_r*t_b(i+1,j)
2250  s_top = wtt_l*s_t(i,j) + wtt_r*s_t(i+1,j)
2251  s_bot = wtt_l*s_b(i,j) + wtt_r*s_b(i+1,j)
2252  dp_90(m) = c1_90*(p_bot - p_top)
2253 
2254  ! Salinity, temperature and pressure with linear interpolation in the vertical.
2255  pos = (m-2)*5
2256  do n=1,5
2257  p15(pos+n) = wt_t(n) * p_top + wt_b(n) * p_bot
2258  s15(pos+n) = wt_t(n) * s_top + wt_b(n) * s_bot
2259  t15(pos+n) = wt_t(n) * t_top + wt_b(n) * t_bot
2260  enddo
2261  enddo
2262 
2263  call calculate_spec_vol(t15, s15, p15, a15, 1, 15, eos, alpha_ref)
2264 
2265  intp(1) = dza(i,j) ; intp(5) = dza(i+1,j)
2266  do m=2,4
2267  ! Use Bode's rule to estimate the interface height anomaly change.
2268  ! The integrals at the ends of the segment are already known.
2269  pos = (m-2)*5
2270  intp(m) = dp_90(m)*((7.0*(a15(pos+1)+a15(pos+5)) + &
2271  32.0*(a15(pos+2)+a15(pos+4))) + 12.0*a15(pos+3))
2272  enddo
2273  ! Use Bode's rule to integrate the interface height anomaly values in x.
2274  intx_dza(i,j) = c1_90*((7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4))) + &
2275  12.0*intp(3))
2276  enddo ; enddo ; endif
2277 
2278  ! ==================================================
2279  ! 3. Compute horizontal integrals in the y direction
2280  ! ==================================================
2281  if (present(inty_dza)) then ; do j=jsq,jeq ; do i=hi%isc,hi%iec
2282  ! hWght is the distance measure by which the cell is violation of
2283  ! hydrostatic consistency. For large hWght we bias the interpolation
2284  ! of T,S along the top and bottom integrals, like thickness weighting.
2285  hwght = 0.0
2286  if (do_massweight) &
2287  hwght = max(0., bathyp(i,j)-p_t(i,j+1), bathyp(i,j+1)-p_t(i,j))
2288  if (hwght > 0.) then
2289  hl = (p_b(i,j) - p_t(i,j)) + dp_neglect
2290  hr = (p_b(i,j+1) - p_t(i,j+1)) + dp_neglect
2291  hwght = hwght * ( (hl-hr)/(hl+hr) )**2
2292  idenom = 1.0 / ( hwght*(hr + hl) + hl*hr )
2293  hwt_ll = (hwght*hl + hr*hl) * idenom ; hwt_lr = (hwght*hr) * idenom
2294  hwt_rr = (hwght*hr + hr*hl) * idenom ; hwt_rl = (hwght*hl) * idenom
2295  else
2296  hwt_ll = 1.0 ; hwt_lr = 0.0 ; hwt_rr = 1.0 ; hwt_rl = 0.0
2297  endif
2298 
2299  do m=2,4
2300  wt_l = 0.25*real(5-m) ; wt_r = 1.0-wt_l
2301  wtt_l = wt_l*hwt_ll + wt_r*hwt_rl ; wtt_r = wt_l*hwt_lr + wt_r*hwt_rr
2302 
2303  ! T, S, and p are interpolated in the horizontal. The p interpolation
2304  ! is linear, but for T and S it may be thickness wekghted.
2305  p_top = wt_l*p_t(i,j) + wt_r*p_t(i,j+1)
2306  p_bot = wt_l*p_b(i,j) + wt_r*p_b(i,j+1)
2307  t_top = wtt_l*t_t(i,j) + wtt_r*t_t(i,j+1)
2308  t_bot = wtt_l*t_b(i,j) + wtt_r*t_b(i,j+1)
2309  s_top = wtt_l*s_t(i,j) + wtt_r*s_t(i,j+1)
2310  s_bot = wtt_l*s_b(i,j) + wtt_r*s_b(i,j+1)
2311  dp_90(m) = c1_90*(p_bot - p_top)
2312 
2313  ! Salinity, temperature and pressure with linear interpolation in the vertical.
2314  pos = (m-2)*5
2315  do n=1,5
2316  p15(pos+n) = wt_t(n) * p_top + wt_b(n) * p_bot
2317  s15(pos+n) = wt_t(n) * s_top + wt_b(n) * s_bot
2318  t15(pos+n) = wt_t(n) * t_top + wt_b(n) * t_bot
2319  enddo
2320  enddo
2321 
2322  call calculate_spec_vol(t15, s15, p15, a15, 1, 15, eos, alpha_ref)
2323 
2324  intp(1) = dza(i,j) ; intp(5) = dza(i,j+1)
2325  do m=2,4
2326  ! Use Bode's rule to estimate the interface height anomaly change.
2327  ! The integrals at the ends of the segment are already known.
2328  pos = (m-2)*5
2329  intp(m) = dp_90(m) * ((7.0*(a15(pos+1)+a15(pos+5)) + &
2330  32.0*(a15(pos+2)+a15(pos+4))) + 12.0*a15(pos+3))
2331  enddo
2332  ! Use Bode's rule to integrate the interface height anomaly values in x.
2333  inty_dza(i,j) = c1_90*((7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4))) + &
2334  12.0*intp(3))
2335  enddo ; enddo ; endif
2336 
2337 end subroutine int_spec_vol_dp_generic_plm
2338 
2339 !> Convert T&S to Absolute Salinity and Conservative Temperature if using TEOS10
2340 subroutine convert_temp_salt_for_teos10(T, S, press, G, kd, mask_z, EOS)
2342 
2343  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
2344  real, dimension(SZI_(G),SZJ_(G), SZK_(G)), &
2345  intent(inout) :: t !< Potential temperature referenced to the surface [degC]
2346  real, dimension(SZI_(G),SZJ_(G), SZK_(G)), &
2347  intent(inout) :: s !< Salinity [ppt]
2348  real, dimension(:), intent(in) :: press !< Pressure at the top of the layer [Pa].
2349  type(eos_type), pointer :: eos !< Equation of state structure
2350  real, dimension(SZI_(G),SZJ_(G), SZK_(G)), &
2351  intent(in) :: mask_z !< 3d mask regulating which points to convert.
2352  integer, intent(in) :: kd !< The number of layers to work on
2353 
2354  integer :: i,j,k
2355  real :: gsw_sr_from_sp, gsw_ct_from_pt, gsw_sa_from_sp
2356  real :: p
2357 
2358  if (.not.associated(eos)) call mom_error(fatal, &
2359  "convert_temp_salt_to_TEOS10 called with an unassociated EOS_type EOS.")
2360 
2361  if ((eos%form_of_EOS /= eos_teos10) .and. (eos%form_of_EOS /= eos_nemo)) return
2362 
2363  do k=1,kd ; do j=g%jsc,g%jec ; do i=g%isc,g%iec
2364  if (mask_z(i,j,k) >= 1.0) then
2365  s(i,j,k) = gsw_sr_from_sp(s(i,j,k))
2366 ! p=press(k)/10000. !convert pascal to dbar
2367 ! S(i,j,k) = gsw_sa_from_sp(S(i,j,k),p,G%geoLonT(i,j),G%geoLatT(i,j))
2368  t(i,j,k) = gsw_ct_from_pt(s(i,j,k),t(i,j,k))
2369  endif
2370  enddo ; enddo ; enddo
2371 end subroutine convert_temp_salt_for_teos10
2372 
2373 !> Extractor routine for the EOS type if the members need to be accessed outside this module
2374 subroutine extract_member_eos(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, &
2375  Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp)
2376  type(eos_type), pointer :: eos !< Equation of state structure
2377  integer, optional, intent(out) :: form_of_eos !< A coded integer indicating the equation of state to use.
2378  integer, optional, intent(out) :: form_of_tfreeze !< A coded integer indicating the expression for
2379  !! the potential temperature of the freezing point.
2380  logical, optional, intent(out) :: eos_quadrature !< If true, always use the generic (quadrature)
2381  !! code for the integrals of density.
2382  logical, optional, intent(out) :: compressible !< If true, in situ density is a function of pressure.
2383  real , optional, intent(out) :: rho_t0_s0 !< Density at T=0 degC and S=0 ppt [kg m-3]
2384  real , optional, intent(out) :: drho_dt !< Partial derivative of density with temperature
2385  !! in [kg m-3 degC-1]
2386  real , optional, intent(out) :: drho_ds !< Partial derivative of density with salinity
2387  !! in [kg m-3 ppt-1]
2388  real , optional, intent(out) :: tfr_s0_p0 !< The freezing potential temperature at S=0, P=0 [degC].
2389  real , optional, intent(out) :: dtfr_ds !< The derivative of freezing point with salinity
2390  !! [degC PSU-1].
2391  real , optional, intent(out) :: dtfr_dp !< The derivative of freezing point with pressure
2392  !! [degC Pa-1].
2393 
2394  if (present(form_of_eos )) form_of_eos = eos%form_of_EOS
2395  if (present(form_of_tfreeze)) form_of_tfreeze = eos%form_of_TFreeze
2396  if (present(eos_quadrature )) eos_quadrature = eos%EOS_quadrature
2397  if (present(compressible )) compressible = eos%Compressible
2398  if (present(rho_t0_s0 )) rho_t0_s0 = eos%Rho_T0_S0
2399  if (present(drho_dt )) drho_dt = eos%drho_dT
2400  if (present(drho_ds )) drho_ds = eos%dRho_dS
2401  if (present(tfr_s0_p0 )) tfr_s0_p0 = eos%TFr_S0_P0
2402  if (present(dtfr_ds )) dtfr_ds = eos%dTFr_dS
2403  if (present(dtfr_dp )) dtfr_dp = eos%dTFr_dp
2404 
2405 end subroutine extract_member_eos
2406 
2407 end module mom_eos
2408 
2409 !> \namespace mom_eos
2410 !!
2411 !! The MOM_EOS module is a wrapper for various equations of state (e.g. Linear,
2412 !! Wright, UNESCO) and provides a uniform interface to the rest of the model
2413 !! independent of which equation of state is being used.
mom_eos_unesco::calculate_spec_vol_unesco
Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect to a refe...
Definition: MOM_EOS_UNESCO.F90:29
mom_eos_linear::calculate_density_second_derivs_linear
For a given thermodynamic state, return the second derivatives of density with various combinations o...
Definition: MOM_EOS_linear.F90:47
mom_eos_unesco
The equation of state using the Jackett and McDougall fits to the UNESCO EOS.
Definition: MOM_EOS_UNESCO.F90:2
mom_file_parser::log_version
An overloaded interface to log version information about modules.
Definition: MOM_file_parser.F90:109
mom_eos_linear::calculate_density_derivs_linear
For a given thermodynamic state, return the derivatives of density with temperature and salinity usin...
Definition: MOM_EOS_linear.F90:40
mom_eos_linear
A simple linear equation of state for sea water with constant coefficients.
Definition: MOM_EOS_linear.F90:2
mom_string_functions
Handy functions for manipulating strings.
Definition: MOM_string_functions.F90:2
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_hor_index
Defines the horizontal index type (hor_index_type) used for providing index ranges.
Definition: MOM_hor_index.F90:2
mom_eos_teos10::calculate_spec_vol_teos10
Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect to a refe...
Definition: MOM_EOS_TEOS10.F90:35
mom_eos::calculate_tfreeze
Calculates the freezing point of sea water from T, S and P.
Definition: MOM_EOS.F90:81
mom_eos_teos10::calculate_density_teos10
Compute the in situ density of sea water ([kg m-3]), or its anomaly with respect to a reference densi...
Definition: MOM_EOS_TEOS10.F90:28
mom_eos_wright
The equation of state using the Wright 1997 expressions.
Definition: MOM_EOS_Wright.F90:2
mom_eos::eos_type
A control structure for the equation of state.
Definition: MOM_EOS.F90:86
mom_eos_teos10
The equation of state using the TEOS10 expressions.
Definition: MOM_EOS_TEOS10.F90:2
mom_eos_nemo
The equation of state using the expressions of Roquet et al. that are used in NEMO.
Definition: MOM_EOS_NEMO.F90:2
mom_eos_wright::calculate_density_wright
Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to a reference de...
Definition: MOM_EOS_Wright.F90:32
mom_tfreeze
Freezing point expressions.
Definition: MOM_TFreeze.F90:2
mom_tfreeze::calculate_tfreeze_millero
Compute the freezing point potential temperature [degC] from salinity [PSU] and pressure [Pa] using t...
Definition: MOM_TFreeze.F90:27
mom_eos_nemo::calculate_density_derivs_nemo
For a given thermodynamic state, return the derivatives of density with conservative temperature and ...
Definition: MOM_EOS_NEMO.F90:34
mom_eos_nemo::calculate_density_nemo
Compute the in situ density of sea water ([kg m-3]), or its anomaly with respect to a reference densi...
Definition: MOM_EOS_NEMO.F90:28
mom_tfreeze::calculate_tfreeze_linear
Compute the freezing point potential temperature [degC] from salinity [ppt] and pressure [Pa] using a...
Definition: MOM_TFreeze.F90:18
mom_eos::calculate_density_second_derivs
Calculates the second derivatives of density with various combinations of temperature,...
Definition: MOM_EOS.F90:76
mom_eos_teos10::calculate_density_second_derivs_teos10
For a given thermodynamic state, return the second derivatives of density with various combinations o...
Definition: MOM_EOS_TEOS10.F90:47
mom_file_parser
The MOM6 facility to parse input files for runtime parameters.
Definition: MOM_file_parser.F90:2
mom_eos_linear::calculate_spec_vol_linear
Compute the specific volume of sea water (in m^3/kg), or its anomaly from a reference value,...
Definition: MOM_EOS_linear.F90:34
mom_eos_teos10::calculate_density_derivs_teos10
For a given thermodynamic state, return the derivatives of density with conservative temperature and ...
Definition: MOM_EOS_TEOS10.F90:41
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_eos_linear::calculate_density_linear
Compute the density of sea water (in kg/m^3), or its anomaly from a reference density,...
Definition: MOM_EOS_linear.F90:27
mom_hor_index::hor_index_type
Container for horizontal index ranges for data, computational and global domains.
Definition: MOM_hor_index.F90:15
mom_eos_wright::calculate_density_derivs_wright
For a given thermodynamic state, return the derivatives of density with temperature and salinity.
Definition: MOM_EOS_Wright.F90:44
mom_grid
Provides the ocean grid type.
Definition: MOM_grid.F90:2
mom_eos_wright::calculate_spec_vol_wright
Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect to a refe...
Definition: MOM_EOS_Wright.F90:39
mom_eos_wright::calculate_density_second_derivs_wright
For a given thermodynamic state, return the second derivatives of density with various combinations o...
Definition: MOM_EOS_Wright.F90:50
mom_eos_unesco::calculate_density_unesco
Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to a reference de...
Definition: MOM_EOS_UNESCO.F90:22
mom_error_handler
Routines for error handling and I/O management.
Definition: MOM_error_handler.F90:2
mom_tfreeze::calculate_tfreeze_teos10
Compute the freezing point conservative temperature [degC] from absolute salinity [g/kg] and pressure...
Definition: MOM_TFreeze.F90:33
mom_eos::calculate_spec_vol
Calculates specific volume of sea water from T, S and P.
Definition: MOM_EOS.F90:65
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:25
mom_eos::calculate_density
Calculates density of sea water from T, S and P.
Definition: MOM_EOS.F90:60