Skip to content

Commit 4058462

Browse files
Hallberg-NOAAmarshallward
authored andcommittedApr 30, 2024·
Refactoring density integrals for efficiency
Refactored 4 routines (int_density_generic_pcm, int_density_generic_ppm, int_spec_vol_generic_pcm and int_spec_vol_generic_plm) in density integrals for greater computational efficiency by doing fewer calls to the equation of state routines but calculating entire rows of densities at subgrid locations with each each call, replicating what was already being done int_density_dz_generic_plm. To accomplish this, a number of variables now use larger arrays than previously. The total computational cost of the non-Boussinesq pressure gradient force calculation was more than 50% greater with the previous code in some tests. All answers are bitwise identical.
1 parent 01b2ea9 commit 4058462

File tree

1 file changed

+716
-525
lines changed

1 file changed

+716
-525
lines changed
 

‎src/core/MOM_density_integrals.F90

+716-525
Original file line numberDiff line numberDiff line change
@@ -141,14 +141,21 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
141141
real, optional, intent(in) :: Z_0p !< The height at which the pressure is 0 [Z ~> m]
142142

143143
! Local variables
144-
real :: T5(5), S5(5) ! Temperatures and salinities at five quadrature points [C ~> degC] and [S ~> ppt]
145-
real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa]
146-
real :: r5(5) ! Densities at five quadrature points [R ~> kg m-3]
144+
real :: T5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Temperatures along a line of subgrid locations [C ~> degC]
145+
real :: S5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Salinities along a line of subgrid locations [S ~> ppt]
146+
real :: p5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Pressures along a line of subgrid locations [R L2 T-2 ~> Pa]
147+
real :: r5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Densities anomalies along a line of subgrid locations [R ~> kg m-3]
148+
real :: T15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Temperatures at an array of subgrid locations [C ~> degC]
149+
real :: S15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Salinities at an array of subgrid locations [S ~> ppt]
150+
real :: p15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Pressures at an array of subgrid locations [R L2 T-2 ~> Pa]
151+
real :: r15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Densities at an array of subgrid locations [R ~> kg m-3]
147152
real :: rho_anom ! The depth averaged density anomaly [R ~> kg m-3]
148153
real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim]
149154
real :: GxRho ! The product of the gravitational acceleration and reference density [R L2 Z-1 T-2 ~> Pa m-1]
150155
real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1]
151156
real :: dz ! The layer thickness [Z ~> m]
157+
real :: dz_x(5,HI%iscB:HI%iecB) ! Layer thicknesses along an x-line of subgrid locations [Z ~> m]
158+
real :: dz_y(5,HI%isc:HI%iec) ! Layer thicknesses along a y-line of subgrid locations [Z ~> m]
152159
real :: z0pres ! The height at which the pressure is zero [Z ~> m]
153160
real :: hWght ! A pressure-thickness below topography [Z ~> m]
154161
real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m]
@@ -162,7 +169,10 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
162169
logical :: do_massWeight ! Indicates whether to do mass weighting.
163170
logical :: use_rho_ref ! Pass rho_ref to the equation of state for more accurate calculation
164171
! of density anomalies.
165-
integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, m, n
172+
integer, dimension(2) :: EOSdom_h5 ! The 5-point h-point i-computational domain for the equation of state
173+
integer, dimension(2) :: EOSdom_q15 ! The 3x5-point q-point i-computational domain for the equation of state
174+
integer, dimension(2) :: EOSdom_h15 ! The 3x5-point h-point i-computational domain for the equation of state
175+
integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, m, n, pos
166176

167177
! These array bounds work for the indexing convention of the input arrays, but
168178
! on the computational domain defined for the output arrays.
@@ -188,123 +198,169 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
188198
"dz_neglect must be present if useMassWghtInterp is present and true.")
189199
endif ; endif
190200

191-
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
192-
dz = z_t(i,j) - z_b(i,j)
193-
do n=1,5
194-
T5(n) = T(i,j) ; S5(n) = S(i,j)
195-
p5(n) = -GxRho*((z_t(i,j) - z0pres) - 0.25*real(n-1)*dz)
201+
! Set the loop ranges for equation of state calculations at various points.
202+
EOSdom_h5(1) = 1 ; EOSdom_h5(2) = 5*(Ieq-Isq+2)
203+
EOSdom_q15(1) = 1 ; EOSdom_q15(2) = 15*(Ieq-Isq+1)
204+
EOSdom_h15(1) = 1 ; EOSdom_h15(2) = 15*(HI%iec-HI%isc+1)
205+
206+
do j=Jsq,Jeq+1
207+
do i=Isq,Ieq+1
208+
dz = z_t(i,j) - z_b(i,j)
209+
do n=1,5
210+
T5(i*5+n) = T(i,j) ; S5(i*5+n) = S(i,j)
211+
p5(i*5+n) = -GxRho*((z_t(i,j) - z0pres) - 0.25*real(n-1)*dz)
212+
enddo
196213
enddo
214+
197215
if (use_rho_ref) then
198-
call calculate_density(T5, S5, p5, r5, EOS, rho_ref=rho_ref)
199-
! Use Boole's rule to estimate the pressure anomaly change.
200-
rho_anom = C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3))
216+
call calculate_density(T5, S5, p5, r5, EOS, EOSdom_h5, rho_ref=rho_ref)
201217
else
202-
call calculate_density(T5, S5, p5, r5, EOS)
203-
! Use Boole's rule to estimate the pressure anomaly change.
204-
rho_anom = C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) - rho_ref
218+
call calculate_density(T5, S5, p5, r5, EOS, EOSdom_h5)
205219
endif
206220

207-
dpa(i,j) = G_e*dz*rho_anom
208-
! Use a Boole's-rule-like fifth-order accurate estimate of the double integral of
209-
! the pressure anomaly.
210-
if (present(intz_dpa)) intz_dpa(i,j) = 0.5*G_e*dz**2 * &
211-
(rho_anom - C1_90*(16.0*(r5(4)-r5(2)) + 7.0*(r5(5)-r5(1))) )
212-
enddo ; enddo
221+
do i=Isq,Ieq+1
222+
! Use Boole's rule to estimate the pressure anomaly change.
223+
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))
224+
if (.not.use_rho_ref) rho_anom = rho_anom - rho_ref
225+
dz = z_t(i,j) - z_b(i,j)
226+
dpa(i,j) = G_e*dz*rho_anom
227+
! Use a Boole's-rule-like fifth-order accurate estimate of the double integral of
228+
! the pressure anomaly.
229+
if (present(intz_dpa)) intz_dpa(i,j) = 0.5*G_e*dz**2 * &
230+
(rho_anom - C1_90*(16.0*(r5(i*5+4)-r5(i*5+2)) + 7.0*(r5(i*5+5)-r5(i*5+1))) )
231+
enddo
232+
enddo
213233

214-
if (present(intx_dpa)) then ; do j=js,je ; do I=Isq,Ieq
215-
! hWght is the distance measure by which the cell is violation of
216-
! hydrostatic consistency. For large hWght we bias the interpolation of
217-
! T & S along the top and bottom integrals, akin to thickness weighting.
218-
hWght = 0.0
219-
if (do_massWeight) &
220-
hWght = max(0., -bathyT(i,j)-z_t(i+1,j), -bathyT(i+1,j)-z_t(i,j))
221-
if (hWght > 0.) then
222-
hL = (z_t(i,j) - z_b(i,j)) + dz_neglect
223-
hR = (z_t(i+1,j) - z_b(i+1,j)) + dz_neglect
224-
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
225-
iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR )
226-
hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom
227-
hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom
234+
if (present(intx_dpa)) then ; do j=js,je
235+
do I=Isq,Ieq
236+
! hWght is the distance measure by which the cell is violation of
237+
! hydrostatic consistency. For large hWght we bias the interpolation of
238+
! T & S along the top and bottom integrals, akin to thickness weighting.
239+
hWght = 0.0
240+
if (do_massWeight) &
241+
hWght = max(0., -bathyT(i,j)-z_t(i+1,j), -bathyT(i+1,j)-z_t(i,j))
242+
if (hWght > 0.) then
243+
hL = (z_t(i,j) - z_b(i,j)) + dz_neglect
244+
hR = (z_t(i+1,j) - z_b(i+1,j)) + dz_neglect
245+
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
246+
iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR )
247+
hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom
248+
hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom
249+
else
250+
hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0
251+
endif
252+
253+
do m=2,4
254+
! T, S, and z are interpolated in the horizontal. The z interpolation
255+
! is linear, but for T and S it may be thickness weighted.
256+
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
257+
wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
258+
dz_x(m,i) = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i+1,j) - z_b(i+1,j))
259+
pos = i*15+(m-2)*5
260+
T15(pos+1) = wtT_L*T(i,j) + wtT_R*T(i+1,j)
261+
S15(pos+1) = wtT_L*S(i,j) + wtT_R*S(i+1,j)
262+
p15(pos+1) = -GxRho*((wt_L*z_t(i,j) + wt_R*z_t(i+1,j)) - z0pres)
263+
do n=2,5
264+
T15(pos+n) = T15(pos+1) ; S15(pos+n) = S15(pos+1)
265+
p15(pos+n) = p15(pos+n-1) + GxRho*0.25*dz_x(m,i)
266+
enddo
267+
enddo
268+
enddo
269+
270+
if (use_rho_ref) then
271+
call calculate_density(T15, S15, p15, r15, EOS, EOSdom_q15, rho_ref=rho_ref)
228272
else
229-
hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0
273+
call calculate_density(T15, S15, p15, r15, EOS, EOSdom_q15)
230274
endif
231275

232-
intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j)
233-
do m=2,4
234-
! T, S, and z are interpolated in the horizontal. The z interpolation
235-
! is linear, but for T and S it may be thickness weighted.
236-
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
237-
wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
238-
dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i+1,j) - z_b(i+1,j))
239-
T5(1) = wtT_L*T(i,j) + wtT_R*T(i+1,j)
240-
S5(1) = wtT_L*S(i,j) + wtT_R*S(i+1,j)
241-
p5(1) = -GxRho*((wt_L*z_t(i,j) + wt_R*z_t(i+1,j)) - z0pres)
242-
do n=2,5
243-
T5(n) = T5(1) ; S5(n) = S5(1) ; p5(n) = p5(n-1) + GxRho*0.25*dz
244-
enddo
276+
do I=Isq,Ieq
277+
intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j)
278+
! Use Boole's rule to estimate the pressure anomaly change.
245279
if (use_rho_ref) then
246-
call calculate_density(T5, S5, p5, r5, EOS, rho_ref=rho_ref)
247-
! Use Boole's rule to estimate the pressure anomaly change.
248-
intz(m) = G_e*dz*( C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)))
280+
do m=2,4
281+
pos = i*15+(m-2)*5
282+
intz(m) = G_e*dz_x(m,i)*( C1_90*( 7.0*(r15(pos+1)+r15(pos+5)) + &
283+
32.0*(r15(pos+2)+r15(pos+4)) + &
284+
12.0*r15(pos+3)))
285+
enddo
249286
else
250-
call calculate_density(T5, S5, p5, r5, EOS)
251-
! Use Boole's rule to estimate the pressure anomaly change.
252-
intz(m) = G_e*dz*( C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) - rho_ref )
287+
do m=2,4
288+
pos = i*15+(m-2)*5
289+
intz(m) = G_e*dz_x(m,i)*( C1_90*( 7.0*(r15(pos+1)+r15(pos+5)) + &
290+
32.0*(r15(pos+2)+r15(pos+4)) + &
291+
12.0*r15(pos+3)) - rho_ref )
292+
enddo
253293
endif
294+
! Use Boole's rule to integrate the bottom pressure anomaly values in x.
295+
intx_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + &
296+
12.0*intz(3))
297+
enddo
298+
enddo ; endif
254299

300+
if (present(inty_dpa)) then ; do J=Jsq,Jeq
301+
do i=is,ie
302+
! hWght is the distance measure by which the cell is violation of
303+
! hydrostatic consistency. For large hWght we bias the interpolation of
304+
! T & S along the top and bottom integrals, akin to thickness weighting.
305+
hWght = 0.0
306+
if (do_massWeight) &
307+
hWght = max(0., -bathyT(i,j)-z_t(i,j+1), -bathyT(i,j+1)-z_t(i,j))
308+
if (hWght > 0.) then
309+
hL = (z_t(i,j) - z_b(i,j)) + dz_neglect
310+
hR = (z_t(i,j+1) - z_b(i,j+1)) + dz_neglect
311+
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
312+
iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR )
313+
hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom
314+
hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom
315+
else
316+
hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0
317+
endif
318+
319+
do m=2,4
320+
! T, S, and z are interpolated in the horizontal. The z interpolation
321+
! is linear, but for T and S it may be thickness weighted.
322+
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
323+
wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
324+
dz_y(m,i) = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i,j+1) - z_b(i,j+1))
325+
pos = i*15+(m-2)*5
326+
T15(pos+1) = wtT_L*T(i,j) + wtT_R*T(i,j+1)
327+
S15(pos+1) = wtT_L*S(i,j) + wtT_R*S(i,j+1)
328+
p15(pos+1) = -GxRho*((wt_L*z_t(i,j) + wt_R*z_t(i,j+1)) - z0pres)
329+
do n=2,5
330+
T15(pos+n) = T15(pos+1) ; S15(pos+n) = S15(pos+1)
331+
p15(pos+n) = p15(pos+n-1) + GxRho*0.25*dz_y(m,i)
332+
enddo
333+
enddo
255334
enddo
256-
! Use Boole's rule to integrate the bottom pressure anomaly values in x.
257-
intx_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + &
258-
12.0*intz(3))
259-
enddo ; enddo ; endif
260335

261-
if (present(inty_dpa)) then ; do J=Jsq,Jeq ; do i=is,ie
262-
! hWght is the distance measure by which the cell is violation of
263-
! hydrostatic consistency. For large hWght we bias the interpolation of
264-
! T & S along the top and bottom integrals, akin to thickness weighting.
265-
hWght = 0.0
266-
if (do_massWeight) &
267-
hWght = max(0., -bathyT(i,j)-z_t(i,j+1), -bathyT(i,j+1)-z_t(i,j))
268-
if (hWght > 0.) then
269-
hL = (z_t(i,j) - z_b(i,j)) + dz_neglect
270-
hR = (z_t(i,j+1) - z_b(i,j+1)) + dz_neglect
271-
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
272-
iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR )
273-
hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom
274-
hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom
336+
if (use_rho_ref) then
337+
call calculate_density(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), &
338+
r15(15*HI%isc+1:), EOS, EOSdom_h15, rho_ref=rho_ref)
275339
else
276-
hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0
340+
call calculate_density(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), &
341+
r15(15*HI%isc+1:), EOS, EOSdom_h15)
277342
endif
278343

279-
intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1)
280-
do m=2,4
281-
! T, S, and z are interpolated in the horizontal. The z interpolation
282-
! is linear, but for T and S it may be thickness weighted.
283-
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
284-
wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
285-
dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i,j+1) - z_b(i,j+1))
286-
T5(1) = wtT_L*T(i,j) + wtT_R*T(i,j+1)
287-
S5(1) = wtT_L*S(i,j) + wtT_R*S(i,j+1)
288-
p5(1) = -GxRho*((wt_L*z_t(i,j) + wt_R*z_t(i,j+1)) - z0pres)
289-
do n=2,5
290-
T5(n) = T5(1) ; S5(n) = S5(1)
291-
p5(n) = p5(n-1) + GxRho*0.25*dz
344+
do i=is,ie
345+
intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1)
346+
! Use Boole's rule to estimate the pressure anomaly change.
347+
do m=2,4
348+
pos = i*15+(m-2)*5
349+
if (use_rho_ref) then
350+
intz(m) = G_e*dz_y(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + &
351+
32.0*(r15(pos+2)+r15(pos+4)) + &
352+
12.0*r15(pos+3)))
353+
else
354+
intz(m) = G_e*dz_y(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + &
355+
32.0*(r15(pos+2)+r15(pos+4)) + &
356+
12.0*r15(pos+3)) - rho_ref )
357+
endif
292358
enddo
293-
if (use_rho_ref) then
294-
call calculate_density(T5, S5, p5, r5, EOS, rho_ref=rho_ref)
295-
! Use Boole's rule to estimate the pressure anomaly change.
296-
intz(m) = G_e*dz*( C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)))
297-
else
298-
call calculate_density(T5, S5, p5, r5, EOS)
299-
! Use Boole's rule to estimate the pressure anomaly change.
300-
intz(m) = G_e*dz*( C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) - rho_ref )
301-
endif
302-
359+
! Use Boole's rule to integrate the values.
360+
inty_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + &
361+
12.0*intz(3))
303362
enddo
304-
! Use Boole's rule to integrate the values.
305-
inty_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + &
306-
12.0*intz(3))
307-
enddo ; enddo ; endif
363+
enddo ; endif
308364
end subroutine int_density_dz_generic_pcm
309365

310366

@@ -414,10 +470,9 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
414470
logical :: use_rho_ref ! Pass rho_ref to the equation of state for more accurate calculation
415471
! of density anomalies.
416472
logical :: use_varT, use_varS, use_covarTS ! Logicals for SGS variances fields
417-
integer, dimension(2) :: EOSdom_q5 ! The 5-point q-point i-computational domain for the equation of state
473+
integer, dimension(2) :: EOSdom_h5 ! The 5-point h-point i-computational domain for the equation of state
418474
integer, dimension(2) :: EOSdom_q15 ! The 3x5-point q-point i-computational domain for the equation of state
419475
integer, dimension(2) :: EOSdom_h15 ! The 3x5-point h-point i-computational domain for the equation of state
420-
421476
integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n, pos
422477

423478
Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB
@@ -456,8 +511,8 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
456511
enddo
457512

458513
! Set the loop ranges for equation of state calculations at various points.
459-
EOSdom_q5(1) = 1 ; EOSdom_q5(2) = (ieq-isq+2)*5
460-
EOSdom_q15(1) = 1 ; EOSdom_q15(2) = 15*(ieq-isq+1)
514+
EOSdom_h5(1) = 1 ; EOSdom_h5(2) = 5*(Ieq-Isq+2)
515+
EOSdom_q15(1) = 1 ; EOSdom_q15(2) = 15*(Ieq-Isq+1)
461516
EOSdom_h15(1) = 1 ; EOSdom_h15(2) = 15*(HI%iec-HI%isc+1)
462517

463518
! 1. Compute vertical integrals
@@ -475,12 +530,12 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
475530
if (use_varS) S25(i*5+1:i*5+5) = tv%varS(i,j,k)
476531
enddo
477532
if (use_Stanley_eos) then
478-
call calculate_density(T5, S5, p5, T25, TS5, S25, r5, EOS, EOSdom_q5, rho_ref=rho_ref)
533+
call calculate_density(T5, S5, p5, T25, TS5, S25, r5, EOS, EOSdom_h5, rho_ref=rho_ref)
479534
else
480535
if (use_rho_ref) then
481-
call calculate_density(T5, S5, p5, r5, EOS, EOSdom_q5, rho_ref=rho_ref)
536+
call calculate_density(T5, S5, p5, r5, EOS, EOSdom_h5, rho_ref=rho_ref)
482537
else
483-
call calculate_density(T5, S5, p5, r5, EOS, EOSdom_q5)
538+
call calculate_density(T5, S5, p5, r5, EOS, EOSdom_h5)
484539
u5(:) = r5(:) - rho_ref
485540
endif
486541
endif
@@ -491,8 +546,8 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
491546
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))
492547
dpa(i,j) = G_e*dz(i)*rho_anom
493548
if (present(intz_dpa)) then
494-
! Use a Boole's-rule-like fifth-order accurate estimate of
495-
! the double integral of the pressure anomaly.
549+
! Use a Boole's-rule-like fifth-order accurate estimate of
550+
! the double integral of the pressure anomaly.
496551
intz_dpa(i,j) = 0.5*G_e*dz(i)**2 * &
497552
(rho_anom - C1_90*(16.0*(r5(i*5+4)-r5(i*5+2)) + 7.0*(r5(i*5+5)-r5(i*5+1))) )
498553
endif
@@ -504,8 +559,8 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
504559
- rho_ref
505560
dpa(i,j) = G_e*dz(i)*rho_anom
506561
if (present(intz_dpa)) then
507-
! Use a Boole's-rule-like fifth-order accurate estimate of
508-
! the double integral of the pressure anomaly.
562+
! Use a Boole's-rule-like fifth-order accurate estimate of
563+
! the double integral of the pressure anomaly.
509564
intz_dpa(i,j) = 0.5*G_e*dz(i)**2 * &
510565
(rho_anom - C1_90*(16.0*(u5(i*5+4)-u5(i*5+2)) + 7.0*(u5(i*5+5)-u5(i*5+1))) )
511566
endif
@@ -774,13 +829,26 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
774829
! a parabolic interpolation is used to compute intermediate values.
775830

776831
! Local variables
777-
real :: T5(5) ! Temperatures along a line of subgrid locations [C ~> degC]
778-
real :: S5(5) ! Salinities along a line of subgrid locations [S ~> ppt]
779-
real :: T25(5) ! SGS temperature variance along a line of subgrid locations [C2 ~> degC2]
780-
real :: TS5(5) ! SGS temperature-salinity covariance along a line of subgrid locations [C S ~> degC ppt]
781-
real :: S25(5) ! SGS salinity variance along a line of subgrid locations [S2 ~> ppt2]
782-
real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa]
783-
real :: r5(5) ! Density anomalies from rho_ref at quadrature points [R ~> kg m-3]
832+
real :: T5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Temperatures along a line of subgrid locations [C ~> degC]
833+
real :: S5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Salinities along a line of subgrid locations [S ~> ppt]
834+
real :: T25((5*HI%iscB+1):(5*(HI%iecB+2))) ! SGS temperature variance along a line of subgrid
835+
! locations [C2 ~> degC2]
836+
real :: TS5((5*HI%iscB+1):(5*(HI%iecB+2))) ! SGS temp-salt covariance along a line of subgrid
837+
! locations [C S ~> degC ppt]
838+
real :: S25((5*HI%iscB+1):(5*(HI%iecB+2))) ! SGS salinity variance along a line of subgrid locations [S2 ~> ppt2]
839+
real :: p5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Pressures along a line of subgrid locations [R L2 T-2 ~> Pa]
840+
real :: r5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Densities anomalies along a line of subgrid
841+
! locations [R ~> kg m-3]
842+
real :: T15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Temperatures at an array of subgrid locations [C ~> degC]
843+
real :: S15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Salinities at an array of subgrid locations [S ~> ppt]
844+
real :: T215((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS temperature variance along a line of subgrid
845+
! locations [C2 ~> degC2]
846+
real :: TS15((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS temp-salt covariance along a line of subgrid
847+
! locations [C S ~> degC ppt]
848+
real :: S215((15*HI%iscB+1):(15*(HI%iecB+1))) ! SGS salinity variance along a line of subgrid
849+
! locations [S2 ~> ppt2]
850+
real :: p15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Pressures at an array of subgrid locations [R L2 T-2 ~> Pa]
851+
real :: r15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Densities at an array of subgrid locations [R ~> kg m-3]
784852
real :: wt_t(5), wt_b(5) ! Top and bottom weights [nondim]
785853
real :: rho_anom ! The integrated density anomaly [R ~> kg m-3]
786854
real :: w_left, w_right ! Left and right weights [nondim]
@@ -790,6 +858,8 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
790858
real :: GxRho ! The gravitational acceleration times density [R L2 Z-1 T-2 ~> kg m-2 s-2]
791859
real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1]
792860
real :: dz ! Layer thicknesses at tracer points [Z ~> m]
861+
real :: dz_x(5,HI%iscB:HI%iecB) ! Layer thicknesses along an x-line of subgrid locations [Z ~> m]
862+
real :: dz_y(5,HI%isc:HI%iec) ! Layer thicknesses along a y-line of subgrid locations [Z ~> m]
793863
real :: massWeightToggle ! A non-dimensional toggle factor (0 or 1) [nondim]
794864
real :: Ttl, Tbl, Tml, Ttr, Tbr, Tmr ! Temperatures at the velocity cell corners [C ~> degC]
795865
real :: Stl, Sbl, Sml, Str, Sbr, Smr ! Salinities at the velocity cell corners [S ~> ppt]
@@ -801,9 +871,12 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
801871
real :: hWght ! A topographically limited thickness weight [Z ~> m]
802872
real :: hL, hR ! Thicknesses to the left and right [Z ~> m]
803873
real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2]
804-
integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n
874+
integer, dimension(2) :: EOSdom_h5 ! The 5-point h-point i-computational domain for the equation of state
875+
integer, dimension(2) :: EOSdom_q15 ! The 3x5-point q-point i-computational domain for the equation of state
876+
integer, dimension(2) :: EOSdom_h15 ! The 3x5-point h-point i-computational domain for the equation of state
877+
integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n, pos
805878
logical :: use_PPM ! If false, assume zero curvature in reconstruction, i.e. PLM
806-
logical :: use_varT, use_varS, use_covarTS
879+
logical :: use_varT, use_varS, use_covarTS ! Logicals for SGS variances fields
807880

808881
Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB
809882

@@ -824,226 +897,277 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
824897
use_covarTS = .false.
825898
use_varS = .false.
826899
if (use_stanley_eos) then
827-
use_varT = associated(tv%varT)
828-
use_covarTS = associated(tv%covarTS)
829-
use_varS = associated(tv%varS)
900+
use_varT = associated(tv%varT)
901+
use_covarTS = associated(tv%covarTS)
902+
use_varS = associated(tv%varS)
830903
endif
831904

832905
T25(:) = 0.
833906
TS5(:) = 0.
834907
S25(:) = 0.
908+
T215(:) = 0.
909+
TS15(:) = 0.
910+
S215(:) = 0.
835911

836912
do n = 1, 5
837913
wt_t(n) = 0.25 * real(5-n)
838914
wt_b(n) = 1.0 - wt_t(n)
839915
enddo
840916

917+
! Set the loop ranges for equation of state calculations at various points.
918+
EOSdom_h5(1) = 1 ; EOSdom_h5(2) = 5*(Ieq-Isq+2)
919+
EOSdom_q15(1) = 1 ; EOSdom_q15(2) = 15*(Ieq-Isq+1)
920+
EOSdom_h15(1) = 1 ; EOSdom_h15(2) = 15*(HI%iec-HI%isc+1)
921+
841922
! 1. Compute vertical integrals
842-
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
843-
if (use_PPM) then
844-
! Curvature coefficient of the parabolas
845-
s6 = 3.0 * ( 2.0*tv%S(i,j,k) - ( S_t(i,j,k) + S_b(i,j,k) ) )
846-
t6 = 3.0 * ( 2.0*tv%T(i,j,k) - ( T_t(i,j,k) + T_b(i,j,k) ) )
847-
endif
848-
dz = e(i,j,K) - e(i,j,K+1)
849-
do n=1,5
850-
p5(n) = -GxRho*((e(i,j,K) - z0pres) - 0.25*real(n-1)*dz)
851-
! Salinity and temperature points are reconstructed with PPM
852-
S5(n) = wt_t(n) * S_t(i,j,k) + wt_b(n) * ( S_b(i,j,k) + s6 * wt_t(n) )
853-
T5(n) = wt_t(n) * T_t(i,j,k) + wt_b(n) * ( T_b(i,j,k) + t6 * wt_t(n) )
923+
do j=Jsq,Jeq+1
924+
do i=Isq,Ieq+1
925+
if (use_PPM) then
926+
! Curvature coefficient of the parabolas
927+
s6 = 3.0 * ( 2.0*tv%S(i,j,k) - ( S_t(i,j,k) + S_b(i,j,k) ) )
928+
t6 = 3.0 * ( 2.0*tv%T(i,j,k) - ( T_t(i,j,k) + T_b(i,j,k) ) )
929+
endif
930+
dz = e(i,j,K) - e(i,j,K+1)
931+
do n=1,5
932+
p5(I*5+n) = -GxRho*((e(i,j,K) - z0pres) - 0.25*real(n-1)*dz)
933+
! Salinity and temperature points are reconstructed with PPM
934+
S5(I*5+n) = wt_t(n) * S_t(i,j,k) + wt_b(n) * ( S_b(i,j,k) + s6 * wt_t(n) )
935+
T5(I*5+n) = wt_t(n) * T_t(i,j,k) + wt_b(n) * ( T_b(i,j,k) + t6 * wt_t(n) )
936+
enddo
937+
if (use_stanley_eos) then
938+
if (use_varT) T25(I*5+1:I*5+5) = tv%varT(i,j,k)
939+
if (use_covarTS) TS5(I*5+1:I*5+5) = tv%covarTS(i,j,k)
940+
if (use_varS) S25(I*5+1:I*5+5) = tv%varS(i,j,k)
941+
endif
854942
enddo
943+
855944
if (use_stanley_eos) then
856-
if (use_varT) T25(:) = tv%varT(i,j,k)
857-
if (use_covarTS) TS5(:) = tv%covarTS(i,j,k)
858-
if (use_varS) S25(:) = tv%varS(i,j,k)
859-
call calculate_density(T5, S5, p5, T25, TS5, S25, r5, EOS, rho_ref=rho_ref)
945+
call calculate_density(T5, S5, p5, T25, TS5, S25, r5, EOS, EOSdom_h5, rho_ref=rho_ref)
860946
else
861-
call calculate_density(T5, S5, p5, r5, EOS, rho_ref=rho_ref)
947+
call calculate_density(T5, S5, p5, r5, EOS, EOSdom_h5, rho_ref=rho_ref)
862948
endif
863949

864-
! Use Boole's rule to estimate the pressure anomaly change.
865-
rho_anom = C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3))
866-
dpa(i,j) = G_e*dz*rho_anom
867-
if (present(intz_dpa)) then
868-
! Use a Boole's-rule-like fifth-order accurate estimate of
869-
! the double integral of the pressure anomaly.
870-
intz_dpa(i,j) = 0.5*G_e*dz**2 * &
871-
(rho_anom - C1_90*(16.0*(r5(4)-r5(2)) + 7.0*(r5(5)-r5(1))) )
872-
endif
873-
enddo ; enddo ! end loops on j and i
950+
do i=Isq,Ieq+1
951+
dz = e(i,j,K) - e(i,j,K+1)
952+
! Use Boole's rule to estimate the pressure anomaly change.
953+
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))
954+
dpa(i,j) = G_e*dz*rho_anom
955+
if (present(intz_dpa)) then
956+
! Use a Boole's-rule-like fifth-order accurate estimate of
957+
! the double integral of the pressure anomaly.
958+
intz_dpa(i,j) = 0.5*G_e*dz**2 * &
959+
(rho_anom - C1_90*(16.0*(r5(i*5+4)-r5(i*5+2)) + 7.0*(r5(i*5+5)-r5(i*5+1))) )
960+
endif
961+
enddo ! end loop on i
962+
enddo ! end loop on j
874963

875964
! 2. Compute horizontal integrals in the x direction
876-
if (present(intx_dpa)) then ; do j=HI%jsc,HI%jec ; do I=Isq,Ieq
877-
! Corner values of T and S
878-
! hWght is the distance measure by which the cell is violation of
879-
! hydrostatic consistency. For large hWght we bias the interpolation
880-
! of T,S along the top and bottom integrals, almost like thickness
881-
! weighting.
882-
! Note: To work in terrain following coordinates we could offset
883-
! this distance by the layer thickness to replicate other models.
884-
hWght = massWeightToggle * &
885-
max(0., -bathyT(i,j)-e(i+1,j,K), -bathyT(i+1,j)-e(i,j,K))
886-
if (hWght > 0.) then
887-
hL = (e(i,j,K) - e(i,j,K+1)) + dz_subroundoff
888-
hR = (e(i+1,j,K) - e(i+1,j,K+1)) + dz_subroundoff
889-
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
890-
iDenom = 1./( hWght*(hR + hL) + hL*hR )
891-
Ttl = ( (hWght*hR)*T_t(i+1,j,k) + (hWght*hL + hR*hL)*T_t(i,j,k) ) * iDenom
892-
Tbl = ( (hWght*hR)*T_b(i+1,j,k) + (hWght*hL + hR*hL)*T_b(i,j,k) ) * iDenom
893-
Tml = ( (hWght*hR)*tv%T(i+1,j,k)+ (hWght*hL + hR*hL)*tv%T(i,j,k) ) * iDenom
894-
Ttr = ( (hWght*hL)*T_t(i,j,k) + (hWght*hR + hR*hL)*T_t(i+1,j,k) ) * iDenom
895-
Tbr = ( (hWght*hL)*T_b(i,j,k) + (hWght*hR + hR*hL)*T_b(i+1,j,k) ) * iDenom
896-
Tmr = ( (hWght*hL)*tv%T(i,j,k) + (hWght*hR + hR*hL)*tv%T(i+1,j,k) ) * iDenom
897-
Stl = ( (hWght*hR)*S_t(i+1,j,k) + (hWght*hL + hR*hL)*S_t(i,j,k) ) * iDenom
898-
Sbl = ( (hWght*hR)*S_b(i+1,j,k) + (hWght*hL + hR*hL)*S_b(i,j,k) ) * iDenom
899-
Sml = ( (hWght*hR)*tv%S(i+1,j,k) + (hWght*hL + hR*hL)*tv%S(i,j,k) ) * iDenom
900-
Str = ( (hWght*hL)*S_t(i,j,k) + (hWght*hR + hR*hL)*S_t(i+1,j,k) ) * iDenom
901-
Sbr = ( (hWght*hL)*S_b(i,j,k) + (hWght*hR + hR*hL)*S_b(i+1,j,k) ) * iDenom
902-
Smr = ( (hWght*hL)*tv%S(i,j,k) + (hWght*hR + hR*hL)*tv%S(i+1,j,k) ) * iDenom
903-
else
904-
Ttl = T_t(i,j,k); Tbl = T_b(i,j,k); Ttr = T_t(i+1,j,k); Tbr = T_b(i+1,j,k)
905-
Tml = tv%T(i,j,k); Tmr = tv%T(i+1,j,k)
906-
Stl = S_t(i,j,k); Sbl = S_b(i,j,k); Str = S_t(i+1,j,k); Sbr = S_b(i+1,j,k)
907-
Sml = tv%S(i,j,k); Smr = tv%S(i+1,j,k)
908-
endif
909-
910-
do m=2,4
911-
w_left = wt_t(m) ; w_right = wt_b(m)
912-
913-
! Salinity and temperature points are linearly interpolated in
914-
! the horizontal. The subscript (1) refers to the top value in
915-
! the vertical profile while subscript (5) refers to the bottom
916-
! value in the vertical profile.
917-
T_top = w_left*Ttl + w_right*Ttr
918-
T_mn = w_left*Tml + w_right*Tmr
919-
T_bot = w_left*Tbl + w_right*Tbr
920-
921-
S_top = w_left*Stl + w_right*Str
922-
S_mn = w_left*Sml + w_right*Smr
923-
S_bot = w_left*Sbl + w_right*Sbr
924-
925-
! Pressure
926-
dz = w_left*(e(i,j,K) - e(i,j,K+1)) + w_right*(e(i+1,j,K) - e(i+1,j,K+1))
927-
p5(1) = -GxRho*((w_left*e(i,j,K) + w_right*e(i+1,j,K)) - z0pres)
928-
do n=2,5
929-
p5(n) = p5(n-1) + GxRho*0.25*dz
930-
enddo
931-
932-
! Parabolic reconstructions in the vertical for T and S
933-
if (use_PPM) then
934-
! Coefficients of the parabolas
935-
s6 = 3.0 * ( 2.0*S_mn - ( S_top + S_bot ) )
936-
t6 = 3.0 * ( 2.0*T_mn - ( T_top + T_bot ) )
937-
endif
938-
do n=1,5
939-
S5(n) = wt_t(n) * S_top + wt_b(n) * ( S_bot + s6 * wt_t(n) )
940-
T5(n) = wt_t(n) * T_top + wt_b(n) * ( T_bot + t6 * wt_t(n) )
941-
enddo
942-
if (use_stanley_eos) then
943-
if (use_varT) T25(:) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i+1,j,k)
944-
if (use_covarTS) TS5(:) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i+1,j,k)
945-
if (use_varS) S25(:) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i+1,j,k)
946-
call calculate_density(T5, S5, p5, T25, TS5, S25, r5, EOS, rho_ref=rho_ref)
965+
if (present(intx_dpa)) then ; do j=HI%jsc,HI%jec
966+
do I=Isq,Ieq
967+
! Corner values of T and S
968+
! hWght is the distance measure by which the cell is violation of
969+
! hydrostatic consistency. For large hWght we bias the interpolation
970+
! of T,S along the top and bottom integrals, almost like thickness
971+
! weighting.
972+
! Note: To work in terrain following coordinates we could offset
973+
! this distance by the layer thickness to replicate other models.
974+
hWght = massWeightToggle * &
975+
max(0., -bathyT(i,j)-e(i+1,j,K), -bathyT(i+1,j)-e(i,j,K))
976+
if (hWght > 0.) then
977+
hL = (e(i,j,K) - e(i,j,K+1)) + dz_subroundoff
978+
hR = (e(i+1,j,K) - e(i+1,j,K+1)) + dz_subroundoff
979+
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
980+
iDenom = 1./( hWght*(hR + hL) + hL*hR )
981+
Ttl = ( (hWght*hR)*T_t(i+1,j,k) + (hWght*hL + hR*hL)*T_t(i,j,k) ) * iDenom
982+
Tbl = ( (hWght*hR)*T_b(i+1,j,k) + (hWght*hL + hR*hL)*T_b(i,j,k) ) * iDenom
983+
Tml = ( (hWght*hR)*tv%T(i+1,j,k)+ (hWght*hL + hR*hL)*tv%T(i,j,k) ) * iDenom
984+
Ttr = ( (hWght*hL)*T_t(i,j,k) + (hWght*hR + hR*hL)*T_t(i+1,j,k) ) * iDenom
985+
Tbr = ( (hWght*hL)*T_b(i,j,k) + (hWght*hR + hR*hL)*T_b(i+1,j,k) ) * iDenom
986+
Tmr = ( (hWght*hL)*tv%T(i,j,k) + (hWght*hR + hR*hL)*tv%T(i+1,j,k) ) * iDenom
987+
Stl = ( (hWght*hR)*S_t(i+1,j,k) + (hWght*hL + hR*hL)*S_t(i,j,k) ) * iDenom
988+
Sbl = ( (hWght*hR)*S_b(i+1,j,k) + (hWght*hL + hR*hL)*S_b(i,j,k) ) * iDenom
989+
Sml = ( (hWght*hR)*tv%S(i+1,j,k) + (hWght*hL + hR*hL)*tv%S(i,j,k) ) * iDenom
990+
Str = ( (hWght*hL)*S_t(i,j,k) + (hWght*hR + hR*hL)*S_t(i+1,j,k) ) * iDenom
991+
Sbr = ( (hWght*hL)*S_b(i,j,k) + (hWght*hR + hR*hL)*S_b(i+1,j,k) ) * iDenom
992+
Smr = ( (hWght*hL)*tv%S(i,j,k) + (hWght*hR + hR*hL)*tv%S(i+1,j,k) ) * iDenom
947993
else
948-
call calculate_density(T5, S5, p5, r5, EOS, rho_ref=rho_ref)
994+
Ttl = T_t(i,j,k); Tbl = T_b(i,j,k); Ttr = T_t(i+1,j,k); Tbr = T_b(i+1,j,k)
995+
Tml = tv%T(i,j,k); Tmr = tv%T(i+1,j,k)
996+
Stl = S_t(i,j,k); Sbl = S_b(i,j,k); Str = S_t(i+1,j,k); Sbr = S_b(i+1,j,k)
997+
Sml = tv%S(i,j,k); Smr = tv%S(i+1,j,k)
949998
endif
950999

951-
! Use Boole's rule to estimate the pressure anomaly change.
952-
intz(m) = G_e*dz*( C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) )
953-
enddo ! m
954-
intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j)
1000+
do m=2,4
1001+
w_left = wt_t(m) ; w_right = wt_b(m)
9551002

956-
! Use Boole's rule to integrate the bottom pressure anomaly values in x.
957-
intx_dpa(I,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + 12.0*intz(3))
1003+
! Salinity and temperature points are linearly interpolated in
1004+
! the horizontal. The subscript (1) refers to the top value in
1005+
! the vertical profile while subscript (5) refers to the bottom
1006+
! value in the vertical profile.
1007+
T_top = w_left*Ttl + w_right*Ttr
1008+
T_mn = w_left*Tml + w_right*Tmr
1009+
T_bot = w_left*Tbl + w_right*Tbr
9581010

959-
enddo ; enddo ; endif
1011+
S_top = w_left*Stl + w_right*Str
1012+
S_mn = w_left*Sml + w_right*Smr
1013+
S_bot = w_left*Sbl + w_right*Sbr
9601014

961-
! 3. Compute horizontal integrals in the y direction
962-
if (present(inty_dpa)) then ; do J=Jsq,Jeq ; do i=HI%isc,HI%iec
963-
! Corner values of T and S
964-
! hWght is the distance measure by which the cell is violation of
965-
! hydrostatic consistency. For large hWght we bias the interpolation
966-
! of T,S along the top and bottom integrals, almost like thickness
967-
! weighting.
968-
! Note: To work in terrain following coordinates we could offset
969-
! this distance by the layer thickness to replicate other models.
970-
hWght = massWeightToggle * &
971-
max(0., -bathyT(i,j)-e(i,j+1,K), -bathyT(i,j+1)-e(i,j,K))
972-
if (hWght > 0.) then
973-
hL = (e(i,j,K) - e(i,j,K+1)) + dz_subroundoff
974-
hR = (e(i,j+1,K) - e(i,j+1,K+1)) + dz_subroundoff
975-
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
976-
iDenom = 1./( hWght*(hR + hL) + hL*hR )
977-
Ttl = ( (hWght*hR)*T_t(i,j+1,k) + (hWght*hL + hR*hL)*T_t(i,j,k) ) * iDenom
978-
Tbl = ( (hWght*hR)*T_b(i,j+1,k) + (hWght*hL + hR*hL)*T_b(i,j,k) ) * iDenom
979-
Tml = ( (hWght*hR)*tv%T(i,j+1,k)+ (hWght*hL + hR*hL)*tv%T(i,j,k) ) * iDenom
980-
Ttr = ( (hWght*hL)*T_t(i,j,k) + (hWght*hR + hR*hL)*T_t(i,j+1,k) ) * iDenom
981-
Tbr = ( (hWght*hL)*T_b(i,j,k) + (hWght*hR + hR*hL)*T_b(i,j+1,k) ) * iDenom
982-
Tmr = ( (hWght*hL)*tv%T(i,j,k) + (hWght*hR + hR*hL)*tv%T(i,j+1,k) ) * iDenom
983-
Stl = ( (hWght*hR)*S_t(i,j+1,k) + (hWght*hL + hR*hL)*S_t(i,j,k) ) * iDenom
984-
Sbl = ( (hWght*hR)*S_b(i,j+1,k) + (hWght*hL + hR*hL)*S_b(i,j,k) ) * iDenom
985-
Sml = ( (hWght*hR)*tv%S(i,j+1,k)+ (hWght*hL + hR*hL)*tv%S(i,j,k) ) * iDenom
986-
Str = ( (hWght*hL)*S_t(i,j,k) + (hWght*hR + hR*hL)*S_t(i,j+1,k) ) * iDenom
987-
Sbr = ( (hWght*hL)*S_b(i,j,k) + (hWght*hR + hR*hL)*S_b(i,j+1,k) ) * iDenom
988-
Smr = ( (hWght*hL)*tv%S(i,j,k) + (hWght*hR + hR*hL)*tv%S(i,j+1,k) ) * iDenom
1015+
! Pressure
1016+
dz_x(m,i) = w_left*(e(i,j,K) - e(i,j,K+1)) + w_right*(e(i+1,j,K) - e(i+1,j,K+1))
1017+
1018+
pos = i*15+(m-2)*5
1019+
p15(pos+1) = -GxRho*((w_left*e(i,j,K) + w_right*e(i+1,j,K)) - z0pres)
1020+
do n=2,5
1021+
p15(pos+n) = p15(pos+n-1) + GxRho*0.25*dz_x(m,i)
1022+
enddo
1023+
1024+
! Parabolic reconstructions in the vertical for T and S
1025+
if (use_PPM) then
1026+
! Coefficients of the parabolas
1027+
s6 = 3.0 * ( 2.0*S_mn - ( S_top + S_bot ) )
1028+
t6 = 3.0 * ( 2.0*T_mn - ( T_top + T_bot ) )
1029+
endif
1030+
do n=1,5
1031+
S15(pos+n) = wt_t(n) * S_top + wt_b(n) * ( S_bot + s6 * wt_t(n) )
1032+
T15(pos+n) = wt_t(n) * T_top + wt_b(n) * ( T_bot + t6 * wt_t(n) )
1033+
enddo
1034+
if (use_stanley_eos) then
1035+
if (use_varT) T215(pos+1:pos+5) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i+1,j,k)
1036+
if (use_covarTS) TS15(pos+1:pos+5) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i+1,j,k)
1037+
if (use_varS) S215(pos+1:pos+5) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i+1,j,k)
1038+
endif
1039+
if (use_stanley_eos) then
1040+
call calculate_density(T5, S5, p5, T25, TS5, S25, r5, EOS, rho_ref=rho_ref)
1041+
else
1042+
call calculate_density(T5, S5, p5, r5, EOS, rho_ref=rho_ref)
1043+
endif
1044+
enddo
1045+
enddo
1046+
1047+
if (use_stanley_eos) then
1048+
call calculate_density(T15, S15, p15, T215, TS15, S215, r15, EOS, EOSdom_q15, rho_ref=rho_ref)
9891049
else
990-
Ttl = T_t(i,j,k); Tbl = T_b(i,j,k); Ttr = T_t(i,j+1,k); Tbr = T_b(i,j+1,k)
991-
Tml = tv%T(i,j,k); Tmr = tv%T(i,j+1,k)
992-
Stl = S_t(i,j,k); Sbl = S_b(i,j,k); Str = S_t(i,j+1,k); Sbr = S_b(i,j+1,k)
993-
Sml = tv%S(i,j,k); Smr = tv%S(i,j+1,k)
1050+
call calculate_density(T15, S15, p15, r15, EOS, EOSdom_q15, rho_ref=rho_ref)
9941051
endif
9951052

996-
do m=2,4
997-
w_left = wt_t(m) ; w_right = wt_b(m)
998-
999-
! Salinity and temperature points are linearly interpolated in
1000-
! the horizontal. The subscript (1) refers to the top value in
1001-
! the vertical profile while subscript (5) refers to the bottom
1002-
! value in the vertical profile.
1003-
T_top = w_left*Ttl + w_right*Ttr
1004-
T_mn = w_left*Tml + w_right*Tmr
1005-
T_bot = w_left*Tbl + w_right*Tbr
1006-
1007-
S_top = w_left*Stl + w_right*Str
1008-
S_mn = w_left*Sml + w_right*Smr
1009-
S_bot = w_left*Sbl + w_right*Sbr
1010-
1011-
! Pressure
1012-
dz = w_left*(e(i,j,K) - e(i,j,K+1)) + w_right*(e(i,j+1,K) - e(i,j+1,K+1))
1013-
p5(1) = -GxRho*((w_left*e(i,j,K) + w_right*e(i,j+1,K)) - z0pres)
1014-
do n=2,5
1015-
p5(n) = p5(n-1) + GxRho*0.25*dz
1016-
enddo
1053+
do I=Isq,Ieq
1054+
do m=2,4
1055+
pos = i*15+(m-2)*5
1056+
! Use Boole's rule to estimate the pressure anomaly change.
1057+
intz(m) = G_e*dz_x(m,i)*( C1_90*( 7.0*(r15(pos+1)+r15(pos+5)) + &
1058+
32.0*(r15(pos+2)+r15(pos+4)) + &
1059+
12.0*r15(pos+3)) )
1060+
enddo ! m
1061+
intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j)
10171062

1018-
! Parabolic reconstructions in the vertical for T and S
1019-
if (use_PPM) then
1020-
! Coefficients of the parabolas
1021-
s6 = 3.0 * ( 2.0*S_mn - ( S_top + S_bot ) )
1022-
t6 = 3.0 * ( 2.0*T_mn - ( T_top + T_bot ) )
1023-
endif
1024-
do n=1,5
1025-
S5(n) = wt_t(n) * S_top + wt_b(n) * ( S_bot + s6 * wt_t(n) )
1026-
T5(n) = wt_t(n) * T_top + wt_b(n) * ( T_bot + t6 * wt_t(n) )
1027-
enddo
1063+
! Use Boole's rule to integrate the bottom pressure anomaly values in x.
1064+
intx_dpa(I,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + 12.0*intz(3))
10281065

1029-
if (use_stanley_eos) then
1030-
if (use_varT) T25(:) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i,j+1,k)
1031-
if (use_covarTS) TS5(:) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i,j+1,k)
1032-
if (use_varS) S25(:) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i,j+1,k)
1033-
call calculate_density(T5, S5, p5, T25, TS5, S25, r5, EOS, rho_ref=rho_ref)
1066+
enddo
1067+
enddo ; endif
1068+
1069+
! 3. Compute horizontal integrals in the y direction
1070+
if (present(inty_dpa)) then ; do J=Jsq,Jeq
1071+
do i=HI%isc,HI%iec
1072+
! Corner values of T and S
1073+
! hWght is the distance measure by which the cell is violation of
1074+
! hydrostatic consistency. For large hWght we bias the interpolation
1075+
! of T,S along the top and bottom integrals, almost like thickness
1076+
! weighting.
1077+
! Note: To work in terrain following coordinates we could offset
1078+
! this distance by the layer thickness to replicate other models.
1079+
hWght = massWeightToggle * &
1080+
max(0., -bathyT(i,j)-e(i,j+1,K), -bathyT(i,j+1)-e(i,j,K))
1081+
if (hWght > 0.) then
1082+
hL = (e(i,j,K) - e(i,j,K+1)) + dz_subroundoff
1083+
hR = (e(i,j+1,K) - e(i,j+1,K+1)) + dz_subroundoff
1084+
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
1085+
iDenom = 1./( hWght*(hR + hL) + hL*hR )
1086+
Ttl = ( (hWght*hR)*T_t(i,j+1,k) + (hWght*hL + hR*hL)*T_t(i,j,k) ) * iDenom
1087+
Tbl = ( (hWght*hR)*T_b(i,j+1,k) + (hWght*hL + hR*hL)*T_b(i,j,k) ) * iDenom
1088+
Tml = ( (hWght*hR)*tv%T(i,j+1,k)+ (hWght*hL + hR*hL)*tv%T(i,j,k) ) * iDenom
1089+
Ttr = ( (hWght*hL)*T_t(i,j,k) + (hWght*hR + hR*hL)*T_t(i,j+1,k) ) * iDenom
1090+
Tbr = ( (hWght*hL)*T_b(i,j,k) + (hWght*hR + hR*hL)*T_b(i,j+1,k) ) * iDenom
1091+
Tmr = ( (hWght*hL)*tv%T(i,j,k) + (hWght*hR + hR*hL)*tv%T(i,j+1,k) ) * iDenom
1092+
Stl = ( (hWght*hR)*S_t(i,j+1,k) + (hWght*hL + hR*hL)*S_t(i,j,k) ) * iDenom
1093+
Sbl = ( (hWght*hR)*S_b(i,j+1,k) + (hWght*hL + hR*hL)*S_b(i,j,k) ) * iDenom
1094+
Sml = ( (hWght*hR)*tv%S(i,j+1,k)+ (hWght*hL + hR*hL)*tv%S(i,j,k) ) * iDenom
1095+
Str = ( (hWght*hL)*S_t(i,j,k) + (hWght*hR + hR*hL)*S_t(i,j+1,k) ) * iDenom
1096+
Sbr = ( (hWght*hL)*S_b(i,j,k) + (hWght*hR + hR*hL)*S_b(i,j+1,k) ) * iDenom
1097+
Smr = ( (hWght*hL)*tv%S(i,j,k) + (hWght*hR + hR*hL)*tv%S(i,j+1,k) ) * iDenom
10341098
else
1035-
call calculate_density(T5, S5, p5, r5, EOS, rho_ref=rho_ref)
1099+
Ttl = T_t(i,j,k); Tbl = T_b(i,j,k); Ttr = T_t(i,j+1,k); Tbr = T_b(i,j+1,k)
1100+
Tml = tv%T(i,j,k); Tmr = tv%T(i,j+1,k)
1101+
Stl = S_t(i,j,k); Sbl = S_b(i,j,k); Str = S_t(i,j+1,k); Sbr = S_b(i,j+1,k)
1102+
Sml = tv%S(i,j,k); Smr = tv%S(i,j+1,k)
10361103
endif
10371104

1038-
! Use Boole's rule to estimate the pressure anomaly change.
1039-
intz(m) = G_e*dz*( C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) )
1040-
enddo ! m
1041-
intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1)
1105+
do m=2,4
1106+
w_left = wt_t(m) ; w_right = wt_b(m)
1107+
1108+
! Salinity and temperature points are linearly interpolated in
1109+
! the horizontal. The subscript (1) refers to the top value in
1110+
! the vertical profile while subscript (5) refers to the bottom
1111+
! value in the vertical profile.
1112+
T_top = w_left*Ttl + w_right*Ttr
1113+
T_mn = w_left*Tml + w_right*Tmr
1114+
T_bot = w_left*Tbl + w_right*Tbr
1115+
1116+
S_top = w_left*Stl + w_right*Str
1117+
S_mn = w_left*Sml + w_right*Smr
1118+
S_bot = w_left*Sbl + w_right*Sbr
1119+
1120+
! Pressure
1121+
dz_y(m,i) = w_left*(e(i,j,K) - e(i,j,K+1)) + w_right*(e(i,j+1,K) - e(i,j+1,K+1))
1122+
1123+
pos = i*15+(m-2)*5
1124+
p15(pos+1) = -GxRho*((w_left*e(i,j,K) + w_right*e(i,j+1,K)) - z0pres)
1125+
do n=2,5
1126+
p15(pos+n) = p15(pos+n-1) + GxRho*0.25*dz_y(m,i)
1127+
enddo
1128+
1129+
! Parabolic reconstructions in the vertical for T and S
1130+
if (use_PPM) then
1131+
! Coefficients of the parabolas
1132+
s6 = 3.0 * ( 2.0*S_mn - ( S_top + S_bot ) )
1133+
t6 = 3.0 * ( 2.0*T_mn - ( T_top + T_bot ) )
1134+
endif
1135+
do n=1,5
1136+
S15(pos+n) = wt_t(n) * S_top + wt_b(n) * ( S_bot + s6 * wt_t(n) )
1137+
T15(pos+n) = wt_t(n) * T_top + wt_b(n) * ( T_bot + t6 * wt_t(n) )
1138+
enddo
1139+
1140+
if (use_stanley_eos) then
1141+
if (use_varT) T215(pos+1:pos+5) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i,j+1,k)
1142+
if (use_covarTS) TS15(pos+1:pos+5) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i,j+1,k)
1143+
if (use_varS) S215(pos+1:pos+5) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i,j+1,k)
1144+
endif
1145+
enddo
1146+
enddo
1147+
1148+
if (use_stanley_eos) then
1149+
call calculate_density(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), &
1150+
T215(15*HI%isc+1:), TS15(15*HI%isc+1:), S215(15*HI%isc+1:), &
1151+
r15(15*HI%isc+1:), EOS, EOSdom_h15, rho_ref=rho_ref)
1152+
else
1153+
call calculate_density(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), &
1154+
r15(15*HI%isc+1:), EOS, EOSdom_h15, rho_ref=rho_ref)
1155+
endif
10421156

1043-
! Use Boole's rule to integrate the bottom pressure anomaly values in y.
1044-
inty_dpa(i,J) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + 12.0*intz(3))
1157+
do i=HI%isc,HI%iec
1158+
do m=2,4
1159+
! Use Boole's rule to estimate the pressure anomaly change.
1160+
pos = i*15+(m-2)*5
1161+
intz(m) = G_e*dz_y(m,i)*( C1_90*( 7.0*(r15(pos+1)+r15(pos+5)) + &
1162+
32.0*(r15(pos+2)+r15(pos+4)) + &
1163+
12.0*r15(pos+3)) )
1164+
enddo ! m
1165+
intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1)
10451166

1046-
enddo ; enddo ; endif
1167+
! Use Boole's rule to integrate the bottom pressure anomaly values in y.
1168+
inty_dpa(i,J) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + 12.0*intz(3))
1169+
enddo
1170+
enddo ; endif
10471171

10481172
end subroutine int_density_dz_generic_ppm
10491173

@@ -1161,12 +1285,19 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d
11611285
! series for log(1-eps/1+eps) that assumes that |eps| < 0.34.
11621286

11631287
! Local variables
1164-
real :: T5(5) ! Temperatures at five quadrature points [C ~> degC]
1165-
real :: S5(5) ! Salinities at five quadrature points [S ~> ppt]
1166-
real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa]
1167-
real :: a5(5) ! Specific volumes at five quadrature points [R-1 ~> m3 kg-1]
1288+
real :: T5((5*HI%isd+1):(5*(HI%ied+2))) ! Temperatures along a line of subgrid locations [C ~> degC]
1289+
real :: S5((5*HI%isd+1):(5*(HI%ied+2))) ! Salinities along a line of subgrid locations [S ~> ppt]
1290+
real :: p5((5*HI%isd+1):(5*(HI%ied+2))) ! Pressures along a line of subgrid locations [R L2 T-2 ~> Pa]
1291+
real :: a5((5*HI%isd+1):(5*(HI%ied+2))) ! Specific volumes anomalies along a line of subgrid
1292+
! locations [R-1 ~> m3 kg-3]
1293+
real :: T15((15*HI%isd+1):(15*(HI%ied+1))) ! Temperatures at an array of subgrid locations [C ~> degC]
1294+
real :: S15((15*HI%isd+1):(15*(HI%ied+1))) ! Salinities at an array of subgrid locations [S ~> ppt]
1295+
real :: p15((15*HI%isd+1):(15*(HI%ied+1))) ! Pressures at an array of subgrid locations [R L2 T-2 ~> Pa]
1296+
real :: a15((15*HI%isd+1):(15*(HI%ied+1))) ! Specific volumes at an array of subgrid locations [R ~> kg m-3]
11681297
real :: alpha_anom ! The depth averaged specific density anomaly [R-1 ~> m3 kg-1]
11691298
real :: dp ! The pressure change through a layer [R L2 T-2 ~> Pa]
1299+
real :: dp_x(5,SZIB_(HI)) ! The pressure change through a layer along an x-line of subgrid locations [Z ~> m]
1300+
real :: dp_y(5,SZI_(HI)) ! The pressure change through a layer along a y-line of subgrid locations [Z ~> m]
11701301
real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa]
11711302
real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [R L2 T-2 ~> Pa]
11721303
real :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-4 ~> Pa-2]
@@ -1178,7 +1309,10 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d
11781309
! 5 sub-column locations [L2 T-2 ~> m2 s-2]
11791310
logical :: do_massWeight ! Indicates whether to do mass weighting.
11801311
real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim]
1181-
integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, n, halo
1312+
integer, dimension(2) :: EOSdom_h5 ! The 5-point h-point i-computational domain for the equation of state
1313+
integer, dimension(2) :: EOSdom_q15 ! The 3x5-point q-point i-computational domain for the equation of state
1314+
integer, dimension(2) :: EOSdom_h15 ! The 3x5-point h-point i-computational domain for the equation of state
1315+
integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, n, pos, halo
11821316

11831317
Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB
11841318
halo = 0 ; if (present(halo_size)) halo = MAX(halo_size,0)
@@ -1195,110 +1329,146 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d
11951329
"dP_neglect must be present if useMassWghtInterp is present and true.")
11961330
endif ; endif
11971331

1198-
do j=jsh,jeh ; do i=ish,ieh
1199-
dp = p_b(i,j) - p_t(i,j)
1200-
do n=1,5
1201-
T5(n) = T(i,j) ; S5(n) = S(i,j)
1202-
p5(n) = p_b(i,j) - 0.25*real(n-1)*dp
1332+
! Set the loop ranges for equation of state calculations at various points.
1333+
EOSdom_h5(1) = 1 ; EOSdom_h5(2) = 5*(ieh-ish+1)
1334+
EOSdom_q15(1) = 1 ; EOSdom_q15(2) = 15*(Ieq-Isq+1)
1335+
EOSdom_h15(1) = 1 ; EOSdom_h15(2) = 15*(HI%iec-HI%isc+1)
1336+
1337+
do j=jsh,jeh
1338+
do i=ish,ieh
1339+
dp = p_b(i,j) - p_t(i,j)
1340+
pos = 5*i
1341+
do n=1,5
1342+
T5(pos+n) = T(i,j) ; S5(pos+n) = S(i,j)
1343+
p5(pos+n) = p_b(i,j) - 0.25*real(n-1)*dp
1344+
enddo
12031345
enddo
12041346

1205-
call calculate_spec_vol(T5, S5, p5, a5, EOS, spv_ref=alpha_ref)
1347+
call calculate_spec_vol(T5(5*ish+1:), S5(5*ish+1:), p5(5*ish+1:), a5(5*ish+1:), EOS, &
1348+
EOSdom_h5, spv_ref=alpha_ref)
12061349

1207-
! Use Boole's rule to estimate the interface height anomaly change.
1208-
alpha_anom = C1_90*(7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4)) + 12.0*a5(3))
1209-
dza(i,j) = dp*alpha_anom
1210-
! Use a Boole's-rule-like fifth-order accurate estimate of the double integral of
1211-
! the interface height anomaly.
1212-
if (present(intp_dza)) intp_dza(i,j) = 0.5*dp**2 * &
1213-
(alpha_anom - C1_90*(16.0*(a5(4)-a5(2)) + 7.0*(a5(5)-a5(1))) )
1214-
enddo ; enddo
1350+
do i=ish,ieh
1351+
dp = p_b(i,j) - p_t(i,j)
1352+
! Use Boole's rule to estimate the interface height anomaly change.
1353+
pos = 5*i
1354+
alpha_anom = C1_90*(7.0*(a5(pos+1)+a5(pos+5)) + 32.0*(a5(pos+2)+a5(pos+4)) + 12.0*a5(pos+3))
1355+
dza(i,j) = dp*alpha_anom
1356+
! Use a Boole's-rule-like fifth-order accurate estimate of the double integral of
1357+
! the interface height anomaly.
1358+
if (present(intp_dza)) intp_dza(i,j) = 0.5*dp**2 * &
1359+
(alpha_anom - C1_90*(16.0*(a5(pos+4)-a5(pos+2)) + 7.0*(a5(pos+5)-a5(pos+1))) )
1360+
enddo
1361+
enddo
12151362

1216-
if (present(intx_dza)) then ; do j=HI%jsc,HI%jec ; do I=Isq,Ieq
1217-
! hWght is the distance measure by which the cell is violation of
1218-
! hydrostatic consistency. For large hWght we bias the interpolation of
1219-
! T & S along the top and bottom integrals, akin to thickness weighting.
1220-
hWght = 0.0
1221-
if (do_massWeight) &
1222-
hWght = max(0., bathyP(i,j)-p_t(i+1,j), bathyP(i+1,j)-p_t(i,j))
1223-
if (hWght > 0.) then
1224-
hL = (p_b(i,j) - p_t(i,j)) + dP_neglect
1225-
hR = (p_b(i+1,j) - p_t(i+1,j)) + dP_neglect
1226-
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
1227-
iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR )
1228-
hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom
1229-
hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom
1230-
else
1231-
hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0
1232-
endif
1363+
if (present(intx_dza)) then ; do j=HI%jsc,HI%jec
1364+
do I=Isq,Ieq
1365+
! hWght is the distance measure by which the cell is violation of
1366+
! hydrostatic consistency. For large hWght we bias the interpolation of
1367+
! T & S along the top and bottom integrals, akin to thickness weighting.
1368+
hWght = 0.0
1369+
if (do_massWeight) &
1370+
hWght = max(0., bathyP(i,j)-p_t(i+1,j), bathyP(i+1,j)-p_t(i,j))
1371+
if (hWght > 0.) then
1372+
hL = (p_b(i,j) - p_t(i,j)) + dP_neglect
1373+
hR = (p_b(i+1,j) - p_t(i+1,j)) + dP_neglect
1374+
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
1375+
iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR )
1376+
hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom
1377+
hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom
1378+
else
1379+
hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0
1380+
endif
12331381

1234-
intp(1) = dza(i,j) ; intp(5) = dza(i+1,j)
1235-
do m=2,4
1236-
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
1237-
wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
1382+
do m=2,4
1383+
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
1384+
wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
1385+
pos = i*15+(m-2)*5
12381386

1239-
! T, S, and p are interpolated in the horizontal. The p interpolation
1240-
! is linear, but for T and S it may be thickness weighted.
1241-
p5(1) = wt_L*p_b(i,j) + wt_R*p_b(i+1,j)
1242-
dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i+1,j) - p_t(i+1,j))
1243-
T5(1) = wtT_L*T(i,j) + wtT_R*T(i+1,j)
1244-
S5(1) = wtT_L*S(i,j) + wtT_R*S(i+1,j)
1387+
! T, S, and p are interpolated in the horizontal. The p interpolation
1388+
! is linear, but for T and S it may be thickness weighted.
1389+
p15(pos+1) = wt_L*p_b(i,j) + wt_R*p_b(i+1,j)
1390+
dp_x(m,I) = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i+1,j) - p_t(i+1,j))
1391+
T15(pos+1) = wtT_L*T(i,j) + wtT_R*T(i+1,j)
1392+
S15(pos+1) = wtT_L*S(i,j) + wtT_R*S(i+1,j)
12451393

1246-
do n=2,5
1247-
T5(n) = T5(1) ; S5(n) = S5(1) ; p5(n) = p5(n-1) - 0.25*dp
1394+
do n=2,5
1395+
T15(pos+n) = T15(pos+1) ; S15(pos+n) = S15(pos+1)
1396+
p15(pos+n) = p15(pos+n-1) - 0.25*dp_x(m,I)
1397+
enddo
12481398
enddo
1249-
call calculate_spec_vol(T5, S5, p5, a5, EOS, spv_ref=alpha_ref)
1399+
enddo
1400+
1401+
call calculate_spec_vol(T15(15*Isq+1:), S15(15*Isq+1:), p15(15*Isq+1:), &
1402+
a15(15*Isq+1:), EOS, EOSdom_q15, spv_ref=alpha_ref)
12501403

1251-
! Use Boole's rule to estimate the interface height anomaly change.
1252-
intp(m) = dp*( C1_90*(7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4)) + &
1253-
12.0*a5(3)))
1404+
do I=Isq,Ieq
1405+
intp(1) = dza(i,j) ; intp(5) = dza(i+1,j)
1406+
! Use Boole's rule to estimate the interface height anomaly change.
1407+
do m=2,4
1408+
pos = i*15+(m-2)*5
1409+
intp(m) = dp_x(m,I)*( C1_90*(7.0*(a15(pos+1)+a15(pos+5)) + 32.0*(a15(pos+2)+a15(pos+4)) + &
1410+
12.0*a15(pos+3)))
1411+
enddo
1412+
! Use Boole's rule to integrate the interface height anomaly values in x.
1413+
intx_dza(i,j) = C1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + &
1414+
12.0*intp(3))
12541415
enddo
1255-
! Use Boole's rule to integrate the interface height anomaly values in x.
1256-
intx_dza(i,j) = C1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + &
1257-
12.0*intp(3))
1258-
enddo ; enddo ; endif
1416+
enddo ; endif
12591417

1260-
if (present(inty_dza)) then ; do J=Jsq,Jeq ; do i=HI%isc,HI%iec
1261-
! hWght is the distance measure by which the cell is violation of
1262-
! hydrostatic consistency. For large hWght we bias the interpolation of
1263-
! T & S along the top and bottom integrals, akin to thickness weighting.
1264-
hWght = 0.0
1265-
if (do_massWeight) &
1266-
hWght = max(0., bathyP(i,j)-p_t(i,j+1), bathyP(i,j+1)-p_t(i,j))
1267-
if (hWght > 0.) then
1268-
hL = (p_b(i,j) - p_t(i,j)) + dP_neglect
1269-
hR = (p_b(i,j+1) - p_t(i,j+1)) + dP_neglect
1270-
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
1271-
iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR )
1272-
hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom
1273-
hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom
1274-
else
1275-
hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0
1276-
endif
1418+
if (present(inty_dza)) then ; do J=Jsq,Jeq
1419+
do i=HI%isc,HI%iec
1420+
! hWght is the distance measure by which the cell is violation of
1421+
! hydrostatic consistency. For large hWght we bias the interpolation of
1422+
! T & S along the top and bottom integrals, akin to thickness weighting.
1423+
hWght = 0.0
1424+
if (do_massWeight) &
1425+
hWght = max(0., bathyP(i,j)-p_t(i,j+1), bathyP(i,j+1)-p_t(i,j))
1426+
if (hWght > 0.) then
1427+
hL = (p_b(i,j) - p_t(i,j)) + dP_neglect
1428+
hR = (p_b(i,j+1) - p_t(i,j+1)) + dP_neglect
1429+
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
1430+
iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR )
1431+
hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom
1432+
hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom
1433+
else
1434+
hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0
1435+
endif
1436+
1437+
do m=2,4
1438+
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
1439+
wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
1440+
pos = i*15+(m-2)*5
12771441

1278-
intp(1) = dza(i,j) ; intp(5) = dza(i,j+1)
1279-
do m=2,4
1280-
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
1281-
wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
1282-
1283-
! T, S, and p are interpolated in the horizontal. The p interpolation
1284-
! is linear, but for T and S it may be thickness weighted.
1285-
p5(1) = wt_L*p_b(i,j) + wt_R*p_b(i,j+1)
1286-
dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i,j+1) - p_t(i,j+1))
1287-
T5(1) = wtT_L*T(i,j) + wtT_R*T(i,j+1)
1288-
S5(1) = wtT_L*S(i,j) + wtT_R*S(i,j+1)
1289-
do n=2,5
1290-
T5(n) = T5(1) ; S5(n) = S5(1) ; p5(n) = p5(n-1) - 0.25*dp
1442+
! T, S, and p are interpolated in the horizontal. The p interpolation
1443+
! is linear, but for T and S it may be thickness weighted.
1444+
p15(pos+1) = wt_L*p_b(i,j) + wt_R*p_b(i,j+1)
1445+
dp_y(m,i) = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i,j+1) - p_t(i,j+1))
1446+
T15(pos+1) = wtT_L*T(i,j) + wtT_R*T(i,j+1)
1447+
S15(pos+1) = wtT_L*S(i,j) + wtT_R*S(i,j+1)
1448+
do n=2,5
1449+
T15(pos+n) = T15(pos+1) ; S15(pos+n) = S15(pos+1)
1450+
p15(pos+n) = p15(pos+n-1) - 0.25*dp_y(m,i)
1451+
enddo
12911452
enddo
1292-
call calculate_spec_vol(T5, S5, p5, a5, EOS, spv_ref=alpha_ref)
1453+
enddo
1454+
1455+
call calculate_spec_vol(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), &
1456+
a15(15*HI%isc+1:), EOS, EOSdom_h15, spv_ref=alpha_ref)
1457+
1458+
do i=HI%isc,HI%iec
12931459

1294-
! Use Boole's rule to estimate the interface height anomaly change.
1295-
intp(m) = dp*( C1_90*(7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4)) + &
1296-
12.0*a5(3)))
1460+
intp(1) = dza(i,j) ; intp(5) = dza(i,j+1)
1461+
! Use Boole's rule to estimate the interface height anomaly change.
1462+
do m=2,4
1463+
pos = i*15+(m-2)*5
1464+
intp(m) = dp_y(m,i)*( C1_90*(7.0*(a15(pos+1)+a15(pos+5)) + 32.0*(a15(pos+2)+a15(pos+4)) + &
1465+
12.0*a15(pos+3)))
1466+
enddo
1467+
! Use Boole's rule to integrate the interface height anomaly values in y.
1468+
inty_dza(i,j) = C1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + &
1469+
12.0*intp(3))
12971470
enddo
1298-
! Use Boole's rule to integrate the interface height anomaly values in y.
1299-
inty_dza(i,j) = C1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + &
1300-
12.0*intp(3))
1301-
enddo ; enddo ; endif
1471+
enddo ; endif
13021472

13031473
end subroutine int_spec_vol_dp_generic_pcm
13041474

@@ -1358,22 +1528,23 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref,
13581528
! Boole's rule to do the horizontal integrals, and from a truncation in the
13591529
! series for log(1-eps/1+eps) that assumes that |eps| < 0.34.
13601530

1361-
real :: T5(5) ! Temperatures at five quadrature points [C ~> degC]
1362-
real :: S5(5) ! Salinities at five quadrature points [S ~> ppt]
1363-
real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa]
1364-
real :: a5(5) ! Specific volumes at five quadrature points [R-1 ~> m3 kg-1]
1365-
real :: T15(15) ! Temperatures at fifteen interior quadrature points [C ~> degC]
1366-
real :: S15(15) ! Salinities at fifteen interior quadrature points [S ~> ppt]
1367-
real :: p15(15) ! Pressures at fifteen quadrature points [R L2 T-2 ~> Pa]
1368-
real :: a15(15) ! Specific volumes at fifteen quadrature points [R-1 ~> m3 kg-1]
1531+
real :: T5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Temperatures along a line of subgrid locations [C ~> degC]
1532+
real :: S5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Salinities along a line of subgrid locations [S ~> ppt]
1533+
real :: p5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Pressures along a line of subgrid locations [R L2 T-2 ~> Pa]
1534+
real :: a5((5*HI%iscB+1):(5*(HI%iecB+2))) ! Specific volumes anomalies along a line of subgrid
1535+
! locations [R-1 ~> m3 kg-3]
1536+
real :: T15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Temperatures at an array of subgrid locations [C ~> degC]
1537+
real :: S15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Salinities at an array of subgrid locations [S ~> ppt]
1538+
real :: p15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Pressures at an array of subgrid locations [R L2 T-2 ~> Pa]
1539+
real :: a15((15*HI%iscB+1):(15*(HI%iecB+1))) ! Specific volumes at an array of subgrid locations [R ~> kg m-3]
13691540
real :: wt_t(5), wt_b(5) ! Weights of top and bottom values at quadrature points [nondim]
13701541
real :: T_top, T_bot ! Horizontally interpolated temperature at the cell top and bottom [C ~> degC]
13711542
real :: S_top, S_bot ! Horizontally interpolated salinity at the cell top and bottom [S ~> ppt]
13721543
real :: P_top, P_bot ! Horizontally interpolated pressure at the cell top and bottom [R L2 T-2 ~> Pa]
13731544

13741545
real :: alpha_anom ! The depth averaged specific density anomaly [R-1 ~> m3 kg-1]
13751546
real :: dp ! The pressure change through a layer [R L2 T-2 ~> Pa]
1376-
real :: dp_90(2:4) ! The pressure change through a layer divided by 90 [R L2 T-2 ~> Pa]
1547+
real :: dp_90(2:4,SZIB_(HI)) ! The pressure change through a layer divided by 90 [R L2 T-2 ~> Pa]
13771548
real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa]
13781549
real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [R L2 T-2 ~> Pa]
13791550
real :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-4 ~> Pa-2]
@@ -1385,6 +1556,9 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref,
13851556
! 5 sub-column locations [L2 T-2 ~> m2 s-2]
13861557
real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim]
13871558
logical :: do_massWeight ! Indicates whether to do mass weighting.
1559+
integer, dimension(2) :: EOSdom_h5 ! The 5-point h-point i-computational domain for the equation of state
1560+
integer, dimension(2) :: EOSdom_q15 ! The 3x5-point q-point i-computational domain for the equation of state
1561+
integer, dimension(2) :: EOSdom_h15 ! The 3x5-point h-point i-computational domain for the equation of state
13881562
integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n, pos
13891563

13901564
Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB
@@ -1397,140 +1571,157 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref,
13971571
wt_b(n) = 1.0 - wt_t(n)
13981572
enddo
13991573

1574+
! Set the loop ranges for equation of state calculations at various points.
1575+
EOSdom_h5(1) = 1 ; EOSdom_h5(2) = 5*(Ieq-Isq+2)
1576+
EOSdom_q15(1) = 1 ; EOSdom_q15(2) = 15*(Ieq-Isq+1)
1577+
EOSdom_h15(1) = 1 ; EOSdom_h15(2) = 15*(HI%iec-HI%isc+1)
1578+
14001579
! 1. Compute vertical integrals
1401-
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
1402-
dp = p_b(i,j) - p_t(i,j)
1403-
do n=1,5 ! T, S and p are linearly interpolated in the vertical.
1404-
p5(n) = wt_t(n) * p_t(i,j) + wt_b(n) * p_b(i,j)
1405-
S5(n) = wt_t(n) * S_t(i,j) + wt_b(n) * S_b(i,j)
1406-
T5(n) = wt_t(n) * T_t(i,j) + wt_b(n) * T_b(i,j)
1580+
do j=Jsq,Jeq+1
1581+
do i=Isq,Ieq+1
1582+
do n=1,5 ! T, S and p are linearly interpolated in the vertical.
1583+
p5(i*5+n) = wt_t(n) * p_t(i,j) + wt_b(n) * p_b(i,j)
1584+
S5(i*5+n) = wt_t(n) * S_t(i,j) + wt_b(n) * S_b(i,j)
1585+
T5(i*5+n) = wt_t(n) * T_t(i,j) + wt_b(n) * T_b(i,j)
1586+
enddo
14071587
enddo
1408-
call calculate_spec_vol(T5, S5, p5, a5, EOS, spv_ref=alpha_ref)
1409-
1410-
! Use Boole's rule to estimate the interface height anomaly change.
1411-
alpha_anom = C1_90*((7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4))) + 12.0*a5(3))
1412-
dza(i,j) = dp*alpha_anom
1413-
! Use a Boole's-rule-like fifth-order accurate estimate of the double integral of
1414-
! the interface height anomaly.
1415-
if (present(intp_dza)) intp_dza(i,j) = 0.5*dp**2 * &
1416-
(alpha_anom - C1_90*(16.0*(a5(4)-a5(2)) + 7.0*(a5(5)-a5(1))) )
1417-
enddo ; enddo
1588+
call calculate_spec_vol(T5, S5, p5, a5, EOS, EOSdom_h5, spv_ref=alpha_ref)
1589+
do i=Isq,Ieq+1
1590+
! Use Boole's rule to estimate the interface height anomaly change.
1591+
dp = p_b(i,j) - p_t(i,j)
1592+
alpha_anom = C1_90*((7.0*(a5(i*5+1)+a5(i*5+5)) + 32.0*(a5(i*5+2)+a5(i*5+4))) + 12.0*a5(i*5+3))
1593+
dza(i,j) = dp*alpha_anom
1594+
! Use a Boole's-rule-like fifth-order accurate estimate of the double integral of
1595+
! the interface height anomaly.
1596+
if (present(intp_dza)) intp_dza(i,j) = 0.5*dp**2 * &
1597+
(alpha_anom - C1_90*(16.0*(a5(i*5+4)-a5(i*5+2)) + 7.0*(a5(i*5+5)-a5(i*5+1))) )
1598+
enddo
1599+
enddo
14181600

14191601
! 2. Compute horizontal integrals in the x direction
1420-
if (present(intx_dza)) then ; do j=HI%jsc,HI%jec ; do I=Isq,Ieq
1421-
! hWght is the distance measure by which the cell is violation of
1422-
! hydrostatic consistency. For large hWght we bias the interpolation
1423-
! of T,S along the top and bottom integrals, almost like thickness
1424-
! weighting. Note: To work in terrain following coordinates we could
1425-
! offset this distance by the layer thickness to replicate other models.
1426-
hWght = 0.0
1427-
if (do_massWeight) &
1428-
hWght = max(0., bathyP(i,j)-p_t(i+1,j), bathyP(i+1,j)-p_t(i,j))
1429-
if (hWght > 0.) then
1430-
hL = (p_b(i,j) - p_t(i,j)) + dP_neglect
1431-
hR = (p_b(i+1,j) - p_t(i+1,j)) + dP_neglect
1432-
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
1433-
iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR )
1434-
hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom
1435-
hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom
1436-
else
1437-
hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0
1438-
endif
1602+
if (present(intx_dza)) then ; do j=HI%jsc,HI%jec
1603+
do I=Isq,Ieq
1604+
! hWght is the distance measure by which the cell is violation of
1605+
! hydrostatic consistency. For large hWght we bias the interpolation
1606+
! of T,S along the top and bottom integrals, almost like thickness
1607+
! weighting. Note: To work in terrain following coordinates we could
1608+
! offset this distance by the layer thickness to replicate other models.
1609+
hWght = 0.0
1610+
if (do_massWeight) &
1611+
hWght = max(0., bathyP(i,j)-p_t(i+1,j), bathyP(i+1,j)-p_t(i,j))
1612+
if (hWght > 0.) then
1613+
hL = (p_b(i,j) - p_t(i,j)) + dP_neglect
1614+
hR = (p_b(i+1,j) - p_t(i+1,j)) + dP_neglect
1615+
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
1616+
iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR )
1617+
hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom
1618+
hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom
1619+
else
1620+
hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0
1621+
endif
14391622

1440-
do m=2,4
1441-
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
1442-
wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
1443-
1444-
! T, S, and p are interpolated in the horizontal. The p interpolation
1445-
! is linear, but for T and S it may be thickness weighted.
1446-
P_top = wt_L*p_t(i,j) + wt_R*p_t(i+1,j)
1447-
P_bot = wt_L*p_b(i,j) + wt_R*p_b(i+1,j)
1448-
T_top = wtT_L*T_t(i,j) + wtT_R*T_t(i+1,j)
1449-
T_bot = wtT_L*T_b(i,j) + wtT_R*T_b(i+1,j)
1450-
S_top = wtT_L*S_t(i,j) + wtT_R*S_t(i+1,j)
1451-
S_bot = wtT_L*S_b(i,j) + wtT_R*S_b(i+1,j)
1452-
dp_90(m) = C1_90*(P_bot - P_top)
1453-
1454-
! Salinity, temperature and pressure with linear interpolation in the vertical.
1455-
pos = (m-2)*5
1456-
do n=1,5
1457-
p15(pos+n) = wt_t(n) * P_top + wt_b(n) * P_bot
1458-
S15(pos+n) = wt_t(n) * S_top + wt_b(n) * S_bot
1459-
T15(pos+n) = wt_t(n) * T_top + wt_b(n) * T_bot
1623+
do m=2,4
1624+
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
1625+
wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
1626+
1627+
! T, S, and p are interpolated in the horizontal. The p interpolation
1628+
! is linear, but for T and S it may be thickness weighted.
1629+
P_top = wt_L*p_t(i,j) + wt_R*p_t(i+1,j)
1630+
P_bot = wt_L*p_b(i,j) + wt_R*p_b(i+1,j)
1631+
T_top = wtT_L*T_t(i,j) + wtT_R*T_t(i+1,j)
1632+
T_bot = wtT_L*T_b(i,j) + wtT_R*T_b(i+1,j)
1633+
S_top = wtT_L*S_t(i,j) + wtT_R*S_t(i+1,j)
1634+
S_bot = wtT_L*S_b(i,j) + wtT_R*S_b(i+1,j)
1635+
dp_90(m,I) = C1_90*(P_bot - P_top)
1636+
1637+
! Salinity, temperature and pressure with linear interpolation in the vertical.
1638+
pos = i*15+(m-2)*5
1639+
do n=1,5
1640+
p15(pos+n) = wt_t(n) * P_top + wt_b(n) * P_bot
1641+
S15(pos+n) = wt_t(n) * S_top + wt_b(n) * S_bot
1642+
T15(pos+n) = wt_t(n) * T_top + wt_b(n) * T_bot
1643+
enddo
14601644
enddo
14611645
enddo
14621646

1463-
call calculate_spec_vol(T15, S15, p15, a15, EOS, spv_ref=alpha_ref)
1647+
call calculate_spec_vol(T15, S15, p15, a15, EOS, EOSdom_q15, spv_ref=alpha_ref)
14641648

1465-
intp(1) = dza(i,j) ; intp(5) = dza(i+1,j)
1466-
do m=2,4
1467-
! Use Boole's rule to estimate the interface height anomaly change.
1468-
! The integrals at the ends of the segment are already known.
1469-
pos = (m-2)*5
1470-
intp(m) = dp_90(m)*((7.0*(a15(pos+1)+a15(pos+5)) + &
1471-
32.0*(a15(pos+2)+a15(pos+4))) + 12.0*a15(pos+3))
1649+
do I=Isq,Ieq
1650+
intp(1) = dza(i,j) ; intp(5) = dza(i+1,j)
1651+
do m=2,4
1652+
! Use Boole's rule to estimate the interface height anomaly change.
1653+
! The integrals at the ends of the segment are already known.
1654+
pos = I*15+(m-2)*5
1655+
intp(m) = dp_90(m,I)*((7.0*(a15(pos+1)+a15(pos+5)) + &
1656+
32.0*(a15(pos+2)+a15(pos+4))) + 12.0*a15(pos+3))
1657+
enddo
1658+
! Use Boole's rule to integrate the interface height anomaly values in x.
1659+
intx_dza(I,j) = C1_90*((7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4))) + &
1660+
12.0*intp(3))
14721661
enddo
1473-
! Use Boole's rule to integrate the interface height anomaly values in x.
1474-
intx_dza(I,j) = C1_90*((7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4))) + &
1475-
12.0*intp(3))
1476-
enddo ; enddo ; endif
1662+
enddo ; endif
14771663

14781664
! 3. Compute horizontal integrals in the y direction
1479-
if (present(inty_dza)) then ; do J=Jsq,Jeq ; do i=HI%isc,HI%iec
1480-
! hWght is the distance measure by which the cell is violation of
1481-
! hydrostatic consistency. For large hWght we bias the interpolation
1482-
! of T,S along the top and bottom integrals, like thickness weighting.
1483-
hWght = 0.0
1484-
if (do_massWeight) &
1485-
hWght = max(0., bathyP(i,j)-p_t(i,j+1), bathyP(i,j+1)-p_t(i,j))
1486-
if (hWght > 0.) then
1487-
hL = (p_b(i,j) - p_t(i,j)) + dP_neglect
1488-
hR = (p_b(i,j+1) - p_t(i,j+1)) + dP_neglect
1489-
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
1490-
iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR )
1491-
hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom
1492-
hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom
1493-
else
1494-
hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0
1495-
endif
1665+
if (present(inty_dza)) then ; do J=Jsq,Jeq
1666+
do i=HI%isc,HI%iec
1667+
! hWght is the distance measure by which the cell is violation of
1668+
! hydrostatic consistency. For large hWght we bias the interpolation
1669+
! of T,S along the top and bottom integrals, like thickness weighting.
1670+
hWght = 0.0
1671+
if (do_massWeight) &
1672+
hWght = max(0., bathyP(i,j)-p_t(i,j+1), bathyP(i,j+1)-p_t(i,j))
1673+
if (hWght > 0.) then
1674+
hL = (p_b(i,j) - p_t(i,j)) + dP_neglect
1675+
hR = (p_b(i,j+1) - p_t(i,j+1)) + dP_neglect
1676+
hWght = hWght * ( (hL-hR)/(hL+hR) )**2
1677+
iDenom = 1.0 / ( hWght*(hR + hL) + hL*hR )
1678+
hWt_LL = (hWght*hL + hR*hL) * iDenom ; hWt_LR = (hWght*hR) * iDenom
1679+
hWt_RR = (hWght*hR + hR*hL) * iDenom ; hWt_RL = (hWght*hL) * iDenom
1680+
else
1681+
hWt_LL = 1.0 ; hWt_LR = 0.0 ; hWt_RR = 1.0 ; hWt_RL = 0.0
1682+
endif
14961683

1497-
do m=2,4
1498-
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
1499-
wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
1500-
1501-
! T, S, and p are interpolated in the horizontal. The p interpolation
1502-
! is linear, but for T and S it may be thickness weighted.
1503-
P_top = wt_L*p_t(i,j) + wt_R*p_t(i,j+1)
1504-
P_bot = wt_L*p_b(i,j) + wt_R*p_b(i,j+1)
1505-
T_top = wtT_L*T_t(i,j) + wtT_R*T_t(i,j+1)
1506-
T_bot = wtT_L*T_b(i,j) + wtT_R*T_b(i,j+1)
1507-
S_top = wtT_L*S_t(i,j) + wtT_R*S_t(i,j+1)
1508-
S_bot = wtT_L*S_b(i,j) + wtT_R*S_b(i,j+1)
1509-
dp_90(m) = C1_90*(P_bot - P_top)
1510-
1511-
! Salinity, temperature and pressure with linear interpolation in the vertical.
1512-
pos = (m-2)*5
1513-
do n=1,5
1514-
p15(pos+n) = wt_t(n) * P_top + wt_b(n) * P_bot
1515-
S15(pos+n) = wt_t(n) * S_top + wt_b(n) * S_bot
1516-
T15(pos+n) = wt_t(n) * T_top + wt_b(n) * T_bot
1684+
do m=2,4
1685+
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
1686+
wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
1687+
1688+
! T, S, and p are interpolated in the horizontal. The p interpolation
1689+
! is linear, but for T and S it may be thickness weighted.
1690+
P_top = wt_L*p_t(i,j) + wt_R*p_t(i,j+1)
1691+
P_bot = wt_L*p_b(i,j) + wt_R*p_b(i,j+1)
1692+
T_top = wtT_L*T_t(i,j) + wtT_R*T_t(i,j+1)
1693+
T_bot = wtT_L*T_b(i,j) + wtT_R*T_b(i,j+1)
1694+
S_top = wtT_L*S_t(i,j) + wtT_R*S_t(i,j+1)
1695+
S_bot = wtT_L*S_b(i,j) + wtT_R*S_b(i,j+1)
1696+
dp_90(m,i) = C1_90*(P_bot - P_top)
1697+
1698+
! Salinity, temperature and pressure with linear interpolation in the vertical.
1699+
pos = i*15+(m-2)*5
1700+
do n=1,5
1701+
p15(pos+n) = wt_t(n) * P_top + wt_b(n) * P_bot
1702+
S15(pos+n) = wt_t(n) * S_top + wt_b(n) * S_bot
1703+
T15(pos+n) = wt_t(n) * T_top + wt_b(n) * T_bot
1704+
enddo
15171705
enddo
15181706
enddo
15191707

1520-
call calculate_spec_vol(T15, S15, p15, a15, EOS, spv_ref=alpha_ref)
1708+
call calculate_spec_vol(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), &
1709+
a15(15*HI%isc+1:), EOS, EOSdom_h15, spv_ref=alpha_ref)
15211710

1522-
intp(1) = dza(i,j) ; intp(5) = dza(i,j+1)
1523-
do m=2,4
1524-
! Use Boole's rule to estimate the interface height anomaly change.
1525-
! The integrals at the ends of the segment are already known.
1526-
pos = (m-2)*5
1527-
intp(m) = dp_90(m) * ((7.0*(a15(pos+1)+a15(pos+5)) + &
1528-
32.0*(a15(pos+2)+a15(pos+4))) + 12.0*a15(pos+3))
1711+
do i=HI%isc,HI%iec
1712+
intp(1) = dza(i,j) ; intp(5) = dza(i,j+1)
1713+
do m=2,4
1714+
! Use Boole's rule to estimate the interface height anomaly change.
1715+
! The integrals at the ends of the segment are already known.
1716+
pos = i*15+(m-2)*5
1717+
intp(m) = dp_90(m,i) * ((7.0*(a15(pos+1)+a15(pos+5)) + &
1718+
32.0*(a15(pos+2)+a15(pos+4))) + 12.0*a15(pos+3))
1719+
enddo
1720+
! Use Boole's rule to integrate the interface height anomaly values in x.
1721+
inty_dza(i,J) = C1_90*((7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4))) + &
1722+
12.0*intp(3))
15291723
enddo
1530-
! Use Boole's rule to integrate the interface height anomaly values in x.
1531-
inty_dza(i,J) = C1_90*((7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4))) + &
1532-
12.0*intp(3))
1533-
enddo ; enddo ; endif
1724+
enddo ; endif
15341725

15351726
end subroutine int_spec_vol_dp_generic_plm
15361727

0 commit comments

Comments
 (0)
Please sign in to comment.