7 use mom_eos, only : eos_quadrature
8 use mom_eos, only : analytic_int_density_dz
9 use mom_eos, only : analytic_int_specific_vol_dp
21 implicit none ;
private 23 #include <MOM_memory.h> 26 public int_density_dz_generic_pcm
27 public int_density_dz_generic_plm
28 public int_density_dz_generic_ppm
29 public int_specific_vol_dp
30 public int_spec_vol_dp_generic_pcm
31 public int_spec_vol_dp_generic_plm
32 public find_depth_of_pressure_in_cell
40 subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, US, dpa, &
41 intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp)
43 real,
dimension(SZI_(HI),SZJ_(HI)), &
45 real,
dimension(SZI_(HI),SZJ_(HI)), &
47 real,
dimension(SZI_(HI),SZJ_(HI)), &
49 real,
dimension(SZI_(HI),SZJ_(HI)), &
51 real,
intent(in) :: rho_ref
54 real,
intent(in) :: rho_0
57 real,
intent(in) :: G_e
61 real,
dimension(SZI_(HI),SZJ_(HI)), &
64 real,
dimension(SZI_(HI),SZJ_(HI)), &
65 optional,
intent(inout) :: intz_dpa
68 real,
dimension(SZIB_(HI),SZJ_(HI)), &
69 optional,
intent(inout) :: intx_dpa
72 real,
dimension(SZI_(HI),SZJB_(HI)), &
73 optional,
intent(inout) :: inty_dpa
76 real,
dimension(SZI_(HI),SZJ_(HI)), &
77 optional,
intent(in) :: bathyT
78 real,
optional,
intent(in) :: dz_neglect
79 logical,
optional,
intent(in) :: useMassWghtInterp
82 if (eos_quadrature(eos))
then 83 call int_density_dz_generic_pcm(t, s, z_t, z_b, rho_ref, rho_0, g_e, hi, eos, us, dpa, &
84 intz_dpa, intx_dpa, inty_dpa, bathyt, dz_neglect, usemasswghtinterp)
86 call analytic_int_density_dz(t, s, z_t, z_b, rho_ref, rho_0, g_e, hi, eos, dpa, &
87 intz_dpa, intx_dpa, inty_dpa, bathyt, dz_neglect, usemasswghtinterp)
90 end subroutine int_density_dz
95 subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
96 EOS, US, dpa, intz_dpa, intx_dpa, inty_dpa, &
97 bathyT, dz_neglect, useMassWghtInterp)
99 real,
dimension(SZI_(HI),SZJ_(HI)), &
101 real,
dimension(SZI_(HI),SZJ_(HI)), &
103 real,
dimension(SZI_(HI),SZJ_(HI)), &
105 real,
dimension(SZI_(HI),SZJ_(HI)), &
107 real,
intent(in) :: rho_ref
110 real,
intent(in) :: rho_0
113 real,
intent(in) :: G_e
117 real,
dimension(SZI_(HI),SZJ_(HI)), &
120 real,
dimension(SZI_(HI),SZJ_(HI)), &
121 optional,
intent(inout) :: intz_dpa
124 real,
dimension(SZIB_(HI),SZJ_(HI)), &
125 optional,
intent(inout) :: intx_dpa
128 real,
dimension(SZI_(HI),SZJB_(HI)), &
129 optional,
intent(inout) :: inty_dpa
132 real,
dimension(SZI_(HI),SZJ_(HI)), &
133 optional,
intent(in) :: bathyT
134 real,
optional,
intent(in) :: dz_neglect
135 logical,
optional,
intent(in) :: useMassWghtInterp
142 real :: w_left, w_right
143 real,
parameter :: C1_90 = 1.0/90.0
152 real :: hWt_LL, hWt_LR
153 real :: hWt_RL, hWt_RR
158 logical :: do_massWeight
159 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, m, n
163 isq = hi%IscB ; ieq = hi%IecB
164 jsq = hi%JscB ; jeq = hi%JecB
165 is = hi%isc ; ie = hi%iec
166 js = hi%jsc ; je = hi%jec
168 rho_scale = us%kg_m3_to_R
169 gxrho = us%RL2_T2_to_Pa * g_e * rho_0
170 rho_ref_mks = rho_ref * us%R_to_kg_m3
173 do_massweight = .false.
174 if (
present(usemasswghtinterp))
then ;
if (usemasswghtinterp)
then 175 do_massweight = .true.
176 if (.not.
present(bathyt))
call mom_error(fatal,
"int_density_dz_generic: "//&
177 "bathyT must be present if useMassWghtInterp is present and true.")
178 if (.not.
present(dz_neglect))
call mom_error(fatal,
"int_density_dz_generic: "//&
179 "dz_neglect must be present if useMassWghtInterp is present and true.")
182 do j=jsq,jeq+1 ;
do i=isq,ieq+1
183 dz = z_t(i,j) - z_b(i,j)
185 t5(n) = t(i,j) ; s5(n) = s(i,j)
186 p5(n) = -gxrho*(z_t(i,j) - 0.25*
real(n-1)*dz)
188 if (rho_scale /= 1.0)
then 189 call calculate_density(t5, s5, p5, r5, 1, 5, eos, rho_ref=rho_ref_mks, scale=rho_scale)
195 rho_anom = c1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3))
196 dpa(i,j) = g_e*dz*rho_anom
199 if (
present(intz_dpa)) intz_dpa(i,j) = 0.5*g_e*dz**2 * &
200 (rho_anom - c1_90*(16.0*(r5(4)-r5(2)) + 7.0*(r5(5)-r5(1))) )
203 if (
present(intx_dpa))
then ;
do j=js,je ;
do i=isq,ieq
209 hwght = max(0., -bathyt(i,j)-z_t(i+1,j), -bathyt(i+1,j)-z_t(i,j))
211 hl = (z_t(i,j) - z_b(i,j)) + dz_neglect
212 hr = (z_t(i+1,j) - z_b(i+1,j)) + dz_neglect
213 hwght = hwght * ( (hl-hr)/(hl+hr) )**2
214 idenom = 1.0 / ( hwght*(hr + hl) + hl*hr )
215 hwt_ll = (hwght*hl + hr*hl) * idenom ; hwt_lr = (hwght*hr) * idenom
216 hwt_rr = (hwght*hr + hr*hl) * idenom ; hwt_rl = (hwght*hl) * idenom
218 hwt_ll = 1.0 ; hwt_lr = 0.0 ; hwt_rr = 1.0 ; hwt_rl = 0.0
221 intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j)
225 wt_l = 0.25*
real(5-m) ; wt_R = 1.0-wt_l
226 wtt_l = wt_l*hwt_ll + wt_r*hwt_rl ; wtt_r = wt_l*hwt_lr + wt_r*hwt_rr
227 dz = wt_l*(z_t(i,j) - z_b(i,j)) + wt_r*(z_t(i+1,j) - z_b(i+1,j))
228 t5(1) = wtt_l*t(i,j) + wtt_r*t(i+1,j)
229 s5(1) = wtt_l*s(i,j) + wtt_r*s(i+1,j)
230 p5(1) = -gxrho*(wt_l*z_t(i,j) + wt_r*z_t(i+1,j))
232 t5(n) = t5(1) ; s5(n) = s5(1) ; p5(n) = p5(n-1) + gxrho*0.25*dz
234 if (rho_scale /= 1.0)
then 235 call calculate_density(t5, s5, p5, r5, 1, 5, eos, rho_ref=rho_ref_mks, scale=rho_scale)
241 intz(m) = g_e*dz*( c1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)))
244 intx_dpa(i,j) = c1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + &
246 enddo ;
enddo ;
endif 248 if (
present(inty_dpa))
then ;
do j=jsq,jeq ;
do i=is,ie
254 hwght = max(0., -bathyt(i,j)-z_t(i,j+1), -bathyt(i,j+1)-z_t(i,j))
256 hl = (z_t(i,j) - z_b(i,j)) + dz_neglect
257 hr = (z_t(i,j+1) - z_b(i,j+1)) + dz_neglect
258 hwght = hwght * ( (hl-hr)/(hl+hr) )**2
259 idenom = 1.0 / ( hwght*(hr + hl) + hl*hr )
260 hwt_ll = (hwght*hl + hr*hl) * idenom ; hwt_lr = (hwght*hr) * idenom
261 hwt_rr = (hwght*hr + hr*hl) * idenom ; hwt_rl = (hwght*hl) * idenom
263 hwt_ll = 1.0 ; hwt_lr = 0.0 ; hwt_rr = 1.0 ; hwt_rl = 0.0
266 intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1)
270 wt_l = 0.25*
real(5-m) ; wt_R = 1.0-wt_l
271 wtt_l = wt_l*hwt_ll + wt_r*hwt_rl ; wtt_r = wt_l*hwt_lr + wt_r*hwt_rr
272 dz = wt_l*(z_t(i,j) - z_b(i,j)) + wt_r*(z_t(i,j+1) - z_b(i,j+1))
273 t5(1) = wtt_l*t(i,j) + wtt_r*t(i,j+1)
274 s5(1) = wtt_l*s(i,j) + wtt_r*s(i,j+1)
275 p5(1) = -gxrho*(wt_l*z_t(i,j) + wt_r*z_t(i,j+1))
277 t5(n) = t5(1) ; s5(n) = s5(1)
278 p5(n) = p5(n-1) + gxrho*0.25*dz
280 if (rho_scale /= 1.0)
then 281 call calculate_density(t5, s5, p5, r5, 1, 5, eos, rho_ref=rho_ref_mks, scale=rho_scale)
287 intz(m) = g_e*dz*( c1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)))
290 inty_dpa(i,j) = c1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + &
292 enddo ;
enddo ;
endif 293 end subroutine int_density_dz_generic_pcm
298 subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
299 rho_0, G_e, dz_subroundoff, bathyT, HI, GV, EOS, US, dpa, &
300 intz_dpa, intx_dpa, inty_dpa, useMassWghtInterp)
301 integer,
intent(in) :: k
305 real,
dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), &
307 real,
dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), &
309 real,
dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), &
311 real,
dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), &
313 real,
dimension(SZI_(HI),SZJ_(HI),SZK_(GV)+1), &
315 real,
intent(in) :: rho_ref
317 real,
intent(in) :: rho_0
319 real,
intent(in) :: G_e
320 real,
intent(in) :: dz_subroundoff
321 real,
dimension(SZI_(HI),SZJ_(HI)), &
325 real,
dimension(SZI_(HI),SZJ_(HI)), &
327 real,
dimension(SZI_(HI),SZJ_(HI)), &
328 optional,
intent(inout) :: intz_dpa
331 real,
dimension(SZIB_(HI),SZJ_(HI)), &
332 optional,
intent(inout) :: intx_dpa
335 real,
dimension(SZI_(HI),SZJB_(HI)), &
336 optional,
intent(inout) :: inty_dpa
339 logical,
optional,
intent(in) :: useMassWghtInterp
354 real :: T5((5*hi%iscb+1):(5*(hi%iecb+2)))
355 real :: S5((5*hi%iscb+1):(5*(hi%iecb+2)))
356 real :: T25((5*hi%iscb+1):(5*(hi%iecb+2)))
357 real :: TS5((5*hi%iscb+1):(5*(hi%iecb+2)))
358 real :: S25((5*hi%iscb+1):(5*(hi%iecb+2)))
359 real :: p5((5*hi%iscb+1):(5*(hi%iecb+2)))
361 real :: r5((5*hi%iscb+1):(5*(hi%iecb+2)))
363 real :: T15((15*hi%iscb+1):(15*(hi%iecb+1)))
364 real :: S15((15*hi%iscb+1):(15*(hi%iecb+1)))
365 real :: T215((15*hi%iscb+1):(15*(hi%iecb+1)))
366 real :: TS15((15*hi%iscb+1):(15*(hi%iecb+1)))
367 real :: S215((15*hi%iscb+1):(15*(hi%iecb+1)))
368 real :: p15((15*hi%iscb+1):(15*(hi%iecb+1)))
369 real :: r15((15*hi%iscb+1):(15*(hi%iecb+1)))
371 real :: wt_t(5), wt_b(5)
373 real :: w_left, w_right
376 real,
parameter :: C1_90 = 1.0/90.0
381 real :: dz(hi%iscb:hi%iecb+1)
382 real :: dz_x(5,hi%iscb:hi%iecb)
383 real :: dz_y(5,hi%isc:hi%iec)
384 real :: massWeightToggle
385 real :: Ttl, Tbl, Ttr, Tbr
386 real :: Stl, Sbl, Str, Sbr
390 logical :: use_stanley_eos
391 logical :: use_varT, use_varS, use_covarTS
392 integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n
395 isq = hi%IscB ; ieq = hi%IecB ; jsq = hi%JscB ; jeq = hi%JecB
397 rho_scale = us%kg_m3_to_R
398 gxrho = us%RL2_T2_to_Pa * g_e * rho_0
399 rho_ref_mks = rho_ref * us%R_to_kg_m3
401 massweighttoggle = 0.
402 if (
present(usemasswghtinterp))
then 403 if (usemasswghtinterp) massweighttoggle = 1.
406 use_vart =
associated(tv%varT)
407 use_covarts =
associated(tv%covarTS)
408 use_vars =
associated(tv%varS)
409 use_stanley_eos = use_vart .or. use_covarts .or. use_vars
418 wt_t(n) = 0.25 *
real(5-n)
419 wt_b(n) = 1.0 - wt_t(n)
425 dz(i) = e(i,j,k) - e(i,j,k+1)
427 p5(i*5+n) = -gxrho*(e(i,j,k) - 0.25*
real(n-1)*dz(i))
429 s5(i*5+n) = wt_t(n) * s_t(i,j,k) + wt_b(n) * s_b(i,j,k)
430 t5(i*5+n) = wt_t(n) * t_t(i,j,k) + wt_b(n) * t_b(i,j,k)
432 if (use_vart) t25(i*5+1:i*5+5) = tv%varT(i,j,k)
433 if (use_covarts) ts5(i*5+1:i*5+5) = tv%covarTS(i,j,k)
434 if (use_vars) s25(i*5+1:i*5+5) = tv%varS(i,j,k)
436 if (use_stanley_eos)
then 437 if (rho_scale /= 1.0)
then 438 call calculate_density(t5, s5, p5, t25, ts5, s25, r5, 1, (ieq-isq+2)*5, eos, &
439 rho_ref=rho_ref_mks, scale=rho_scale)
441 call calculate_density(t5, s5, p5, t25, ts5, s25, r5, 1, (ieq-isq+2)*5, eos, &
445 if (rho_scale /= 1.0)
then 446 call calculate_density(t5, s5, p5, r5, 1, (ieq-isq+2)*5, eos, rho_ref=rho_ref_mks, &
449 call calculate_density(t5, s5, p5, r5, 1, (ieq-isq+2)*5, eos, rho_ref=rho_ref_mks)
455 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))
456 dpa(i,j) = g_e*dz(i)*rho_anom
457 if (
present(intz_dpa))
then 460 intz_dpa(i,j) = 0.5*g_e*dz(i)**2 * &
461 (rho_anom - c1_90*(16.0*(r5(i*5+4)-r5(i*5+2)) + 7.0*(r5(i*5+5)-r5(i*5+1))) )
467 if (
present(intx_dpa))
then ;
do j=hi%jsc,hi%jec
476 hwght = massweighttoggle * &
477 max(0., -bathyt(i,j)-e(i+1,j,k), -bathyt(i+1,j)-e(i,j,k))
479 hl = (e(i,j,k) - e(i,j,k+1)) + dz_subroundoff
480 hr = (e(i+1,j,k) - e(i+1,j,k+1)) + dz_subroundoff
481 hwght = hwght * ( (hl-hr)/(hl+hr) )**2
482 idenom = 1./( hwght*(hr + hl) + hl*hr )
483 ttl = ( (hwght*hr)*t_t(i+1,j,k) + (hwght*hl + hr*hl)*t_t(i,j,k) ) * idenom
484 ttr = ( (hwght*hl)*t_t(i,j,k) + (hwght*hr + hr*hl)*t_t(i+1,j,k) ) * idenom
485 tbl = ( (hwght*hr)*t_b(i+1,j,k) + (hwght*hl + hr*hl)*t_b(i,j,k) ) * idenom
486 tbr = ( (hwght*hl)*t_b(i,j,k) + (hwght*hr + hr*hl)*t_b(i+1,j,k) ) * idenom
487 stl = ( (hwght*hr)*s_t(i+1,j,k) + (hwght*hl + hr*hl)*s_t(i,j,k) ) * idenom
488 str = ( (hwght*hl)*s_t(i,j,k) + (hwght*hr + hr*hl)*s_t(i+1,j,k) ) * idenom
489 sbl = ( (hwght*hr)*s_b(i+1,j,k) + (hwght*hl + hr*hl)*s_b(i,j,k) ) * idenom
490 sbr = ( (hwght*hl)*s_b(i,j,k) + (hwght*hr + hr*hl)*s_b(i+1,j,k) ) * idenom
492 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)
493 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)
497 w_left = wt_t(m) ; w_right = wt_b(m)
498 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))
505 t15(pos+1) = w_left*ttl + w_right*ttr
506 t15(pos+5) = w_left*tbl + w_right*tbr
508 s15(pos+1) = w_left*stl + w_right*str
509 s15(pos+5) = w_left*sbl + w_right*sbr
511 p15(pos+1) = -gxrho*(w_left*e(i,j,k) + w_right*e(i+1,j,k))
515 p15(pos+n) = p15(pos+n-1) + gxrho*0.25*dz_x(m,i)
520 s15(pos+n) = wt_t(n) * s15(pos+1) + wt_b(n) * s15(pos+5)
521 t15(pos+n) = wt_t(n) * t15(pos+1) + wt_b(n) * t15(pos+5)
523 if (use_vart) t215(pos+1:pos+5) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i+1,j,k)
524 if (use_covarts) ts15(pos+1:pos+5) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i+1,j,k)
525 if (use_vars) s215(pos+1:pos+5) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i+1,j,k)
529 if (use_stanley_eos)
then 530 if (rho_scale /= 1.0)
then 531 call calculate_density(t15, s15, p15, t215, ts15, s215, r15, 1, 15*(ieq-isq+1), eos, &
532 rho_ref=rho_ref_mks, scale=rho_scale)
534 call calculate_density(t15, s15, p15, t215, ts15, s215, r15, 1, 15*(ieq-isq+1), eos, &
538 if (rho_scale /= 1.0)
then 539 call calculate_density(t15, s15, p15, r15, 1, 15*(ieq-isq+1), eos, rho_ref=rho_ref_mks, &
542 call calculate_density(t15, s15, p15, r15, 1, 15*(ieq-isq+1), eos, rho_ref=rho_ref_mks)
547 intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j)
552 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)) + &
556 intx_dpa(i,j) = c1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + &
562 if (
present(inty_dpa))
then ;
do j=jsq,jeq
571 hwght = massweighttoggle * &
572 max(0., -bathyt(i,j)-e(i,j+1,k), -bathyt(i,j+1)-e(i,j,k))
574 hl = (e(i,j,k) - e(i,j,k+1)) + dz_subroundoff
575 hr = (e(i,j+1,k) - e(i,j+1,k+1)) + dz_subroundoff
576 hwght = hwght * ( (hl-hr)/(hl+hr) )**2
577 idenom = 1./( hwght*(hr + hl) + hl*hr )
578 ttl = ( (hwght*hr)*t_t(i,j+1,k) + (hwght*hl + hr*hl)*t_t(i,j,k) ) * idenom
579 ttr = ( (hwght*hl)*t_t(i,j,k) + (hwght*hr + hr*hl)*t_t(i,j+1,k) ) * idenom
580 tbl = ( (hwght*hr)*t_b(i,j+1,k) + (hwght*hl + hr*hl)*t_b(i,j,k) ) * idenom
581 tbr = ( (hwght*hl)*t_b(i,j,k) + (hwght*hr + hr*hl)*t_b(i,j+1,k) ) * idenom
582 stl = ( (hwght*hr)*s_t(i,j+1,k) + (hwght*hl + hr*hl)*s_t(i,j,k) ) * idenom
583 str = ( (hwght*hl)*s_t(i,j,k) + (hwght*hr + hr*hl)*s_t(i,j+1,k) ) * idenom
584 sbl = ( (hwght*hr)*s_b(i,j+1,k) + (hwght*hl + hr*hl)*s_b(i,j,k) ) * idenom
585 sbr = ( (hwght*hl)*s_b(i,j,k) + (hwght*hr + hr*hl)*s_b(i,j+1,k) ) * idenom
587 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)
588 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)
592 w_left = wt_t(m) ; w_right = wt_b(m)
593 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))
600 t15(pos+1) = w_left*ttl + w_right*ttr
601 t15(pos+5) = w_left*tbl + w_right*tbr
603 s15(pos+1) = w_left*stl + w_right*str
604 s15(pos+5) = w_left*sbl + w_right*sbr
606 p15(pos+1) = -gxrho*(w_left*e(i,j,k) + w_right*e(i,j+1,k))
610 p15(pos+n) = p15(pos+n-1) + gxrho*0.25*dz_y(m,i)
615 s15(pos+n) = wt_t(n) * s15(pos+1) + wt_b(n) * s15(pos+5)
616 t15(pos+n) = wt_t(n) * t15(pos+1) + wt_b(n) * t15(pos+5)
618 if (use_vart) t215(pos+1:pos+5) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i,j+1,k)
619 if (use_covarts) ts15(pos+1:pos+5) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i,j+1,k)
620 if (use_vars) s215(pos+1:pos+5) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i,j+1,k)
624 if (use_stanley_eos)
then 625 if (rho_scale /= 1.0)
then 626 call calculate_density(t15(15*hi%isc+1:), s15(15*hi%isc+1:), p15(15*hi%isc+1:), &
627 t215(15*hi%isc+1:), ts15(15*hi%isc+1:), s215(15*hi%isc+1:), &
628 r15(15*hi%isc+1:), 1, 15*(hi%iec-hi%isc+1), eos, &
629 rho_ref=rho_ref_mks, scale=rho_scale)
631 call calculate_density(t15(15*hi%isc+1:), s15(15*hi%isc+1:), p15(15*hi%isc+1:), &
632 t215(15*hi%isc+1:), ts15(15*hi%isc+1:), s215(15*hi%isc+1:), &
633 r15(15*hi%isc+1:), 1, 15*(hi%iec-hi%isc+1), eos, rho_ref=rho_ref_mks)
636 if (rho_scale /= 1.0)
then 637 call calculate_density(t15(15*hi%isc+1:), s15(15*hi%isc+1:), p15(15*hi%isc+1:), &
638 r15(15*hi%isc+1:), 1, 15*(hi%iec-hi%isc+1), eos, &
639 rho_ref=rho_ref_mks, scale=rho_scale)
641 call calculate_density(t15(15*hi%isc+1:), s15(15*hi%isc+1:), p15(15*hi%isc+1:), &
642 r15(15*hi%isc+1:), 1, 15*(hi%iec-hi%isc+1), eos, rho_ref=rho_ref_mks)
647 intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1)
652 intz(m) = g_e*dz_y(m,i)*( c1_90*(7.0*(r15(pos+1)+r15(pos+5)) + &
653 32.0*(r15(pos+2)+r15(pos+4)) + &
657 inty_dpa(i,j) = c1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + &
662 end subroutine int_density_dz_generic_plm
667 subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
668 rho_ref, rho_0, G_e, dz_subroundoff, bathyT, HI, GV, EOS, US, &
669 dpa, intz_dpa, intx_dpa, inty_dpa, useMassWghtInterp)
670 integer,
intent(in) :: k
674 real,
dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), &
676 real,
dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), &
678 real,
dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), &
680 real,
dimension(SZI_(HI),SZJ_(HI),SZK_(GV)), &
682 real,
dimension(SZI_(HI),SZJ_(HI),SZK_(GV)+1), &
684 real,
intent(in) :: rho_ref
686 real,
intent(in) :: rho_0
688 real,
intent(in) :: G_e
689 real,
intent(in) :: dz_subroundoff
690 real,
dimension(SZI_(HI),SZJ_(HI)), &
694 real,
dimension(SZI_(HI),SZJ_(HI)), &
696 real,
dimension(SZI_(HI),SZJ_(HI)), &
697 optional,
intent(inout) :: intz_dpa
700 real,
dimension(SZIB_(HI),SZJ_(HI)), &
701 optional,
intent(inout) :: intx_dpa
704 real,
dimension(SZI_(HI),SZJB_(HI)), &
705 optional,
intent(inout) :: inty_dpa
708 logical,
optional,
intent(in) :: useMassWghtInterp
730 real :: wt_t(5), wt_b(5)
732 real :: w_left, w_right
735 real,
parameter :: C1_90 = 1.0/90.0
741 real :: massWeightToggle
742 real :: Ttl, Tbl, Tml, Ttr, Tbr, Tmr
743 real :: Stl, Sbl, Sml, Str, Sbr, Smr
746 real :: T_top, T_mn, T_bot
747 real :: S_top, S_mn, S_bot
751 integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n
753 logical :: use_stanley_eos
754 logical :: use_varT, use_varS, use_covarTS
756 isq = hi%IscB ; ieq = hi%IecB ; jsq = hi%JscB ; jeq = hi%JecB
758 rho_scale = us%kg_m3_to_R
759 gxrho = us%RL2_T2_to_Pa * g_e * rho_0
760 rho_ref_mks = rho_ref * us%R_to_kg_m3
762 massweighttoggle = 0.
763 if (
present(usemasswghtinterp))
then 764 if (usemasswghtinterp) massweighttoggle = 1.
772 use_vart =
associated(tv%varT)
773 use_covarts =
associated(tv%covarTS)
774 use_vars =
associated(tv%varS)
775 use_stanley_eos = use_vart .or. use_covarts .or. use_vars
781 wt_t(n) = 0.25 *
real(5-n)
782 wt_b(n) = 1.0 - wt_t(n)
786 do j=jsq,jeq+1 ;
do i=isq,ieq+1
789 s6 = 3.0 * ( 2.0*tv%S(i,j,k) - ( s_t(i,j,k) + s_b(i,j,k) ) )
790 t6 = 3.0 * ( 2.0*tv%T(i,j,k) - ( t_t(i,j,k) + t_b(i,j,k) ) )
792 dz = e(i,j,k) - e(i,j,k+1)
794 p5(n) = -gxrho*(e(i,j,k) - 0.25*
real(n-1)*dz)
796 s5(n) = wt_t(n) * s_t(i,j,k) + wt_b(n) * ( s_b(i,j,k) + s6 * wt_t(n) )
797 t5(n) = wt_t(n) * t_t(i,j,k) + wt_b(n) * ( t_b(i,j,k) + t6 * wt_t(n) )
799 if (use_stanley_eos)
then 800 if (use_vart) t25(:) = tv%varT(i,j,k)
801 if (use_covarts) ts5(:) = tv%covarTS(i,j,k)
802 if (use_vars) s25(:) = tv%varS(i,j,k)
804 1, 5, eos, rho_ref=rho_ref_mks, scale=rho_scale)
806 call calculate_density(t5, s5, p5, r5, 1, 5, eos, rho_ref=rho_ref_mks, scale=rho_scale)
810 rho_anom = c1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3))
811 dpa(i,j) = g_e*dz*rho_anom
812 if (
present(intz_dpa))
then 815 intz_dpa(i,j) = 0.5*g_e*dz**2 * &
816 (rho_anom - c1_90*(16.0*(r5(4)-r5(2)) + 7.0*(r5(5)-r5(1))) )
821 if (
present(intx_dpa))
then ;
do j=hi%jsc,hi%jec ;
do i=isq,ieq
829 hwght = massweighttoggle * &
830 max(0., -bathyt(i,j)-e(i+1,j,k), -bathyt(i+1,j)-e(i,j,k))
832 hl = (e(i,j,k) - e(i,j,k+1)) + dz_subroundoff
833 hr = (e(i+1,j,k) - e(i+1,j,k+1)) + dz_subroundoff
834 hwght = hwght * ( (hl-hr)/(hl+hr) )**2
835 idenom = 1./( hwght*(hr + hl) + hl*hr )
836 ttl = ( (hwght*hr)*t_t(i+1,j,k) + (hwght*hl + hr*hl)*t_t(i,j,k) ) * idenom
837 tbl = ( (hwght*hr)*t_b(i+1,j,k) + (hwght*hl + hr*hl)*t_b(i,j,k) ) * idenom
838 tml = ( (hwght*hr)*tv%T(i+1,j,k)+ (hwght*hl + hr*hl)*tv%T(i,j,k) ) * idenom
839 ttr = ( (hwght*hl)*t_t(i,j,k) + (hwght*hr + hr*hl)*t_t(i+1,j,k) ) * idenom
840 tbr = ( (hwght*hl)*t_b(i,j,k) + (hwght*hr + hr*hl)*t_b(i+1,j,k) ) * idenom
841 tmr = ( (hwght*hl)*tv%T(i,j,k) + (hwght*hr + hr*hl)*tv%T(i+1,j,k) ) * idenom
842 stl = ( (hwght*hr)*s_t(i+1,j,k) + (hwght*hl + hr*hl)*s_t(i,j,k) ) * idenom
843 sbl = ( (hwght*hr)*s_b(i+1,j,k) + (hwght*hl + hr*hl)*s_b(i,j,k) ) * idenom
844 sml = ( (hwght*hr)*tv%S(i+1,j,k) + (hwght*hl + hr*hl)*tv%S(i,j,k) ) * idenom
845 str = ( (hwght*hl)*s_t(i,j,k) + (hwght*hr + hr*hl)*s_t(i+1,j,k) ) * idenom
846 sbr = ( (hwght*hl)*s_b(i,j,k) + (hwght*hr + hr*hl)*s_b(i+1,j,k) ) * idenom
847 smr = ( (hwght*hl)*tv%S(i,j,k) + (hwght*hr + hr*hl)*tv%S(i+1,j,k) ) * idenom
849 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)
850 tml = tv%T(i,j,k); tmr = tv%T(i+1,j,k)
851 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)
852 sml = tv%S(i,j,k); smr = tv%S(i+1,j,k)
856 w_left = wt_t(m) ; w_right = wt_b(m)
862 t_top = w_left*ttl + w_right*ttr
863 t_mn = w_left*tml + w_right*tmr
864 t_bot = w_left*tbl + w_right*tbr
866 s_top = w_left*stl + w_right*str
867 s_mn = w_left*sml + w_right*smr
868 s_bot = w_left*sbl + w_right*sbr
871 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))
872 p5(1) = -gxrho*(w_left*e(i,j,k) + w_right*e(i+1,j,k))
874 p5(n) = p5(n-1) + gxrho*0.25*dz
880 s6 = 3.0 * ( 2.0*s_mn - ( s_top + s_bot ) )
881 t6 = 3.0 * ( 2.0*t_mn - ( t_top + t_bot ) )
884 s5(n) = wt_t(n) * s_top + wt_b(n) * ( s_bot + s6 * wt_t(n) )
885 t5(n) = wt_t(n) * t_top + wt_b(n) * ( t_bot + t6 * wt_t(n) )
888 if (use_stanley_eos)
then 889 if (use_vart) t25(:) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i+1,j,k)
890 if (use_covarts) ts5(:) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i+1,j,k)
891 if (use_vars) s25(:) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i+1,j,k)
893 1, 5, eos, rho_ref=rho_ref_mks, scale=rho_scale)
895 call calculate_density(t5, s5, p5, r5, 1, 5, eos, rho_ref=rho_ref_mks, scale=rho_scale)
899 intz(m) = g_e*dz*( c1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) )
901 intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j)
904 intx_dpa(i,j) = c1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + 12.0*intz(3))
906 enddo ;
enddo ;
endif 909 if (
present(inty_dpa))
then ;
do j=jsq,jeq ;
do i=hi%isc,hi%iec
917 hwght = massweighttoggle * &
918 max(0., -bathyt(i,j)-e(i,j+1,k), -bathyt(i,j+1)-e(i,j,k))
920 hl = (e(i,j,k) - e(i,j,k+1)) + dz_subroundoff
921 hr = (e(i,j+1,k) - e(i,j+1,k+1)) + dz_subroundoff
922 hwght = hwght * ( (hl-hr)/(hl+hr) )**2
923 idenom = 1./( hwght*(hr + hl) + hl*hr )
924 ttl = ( (hwght*hr)*t_t(i,j+1,k) + (hwght*hl + hr*hl)*t_t(i,j,k) ) * idenom
925 tbl = ( (hwght*hr)*t_b(i,j+1,k) + (hwght*hl + hr*hl)*t_b(i,j,k) ) * idenom
926 tml = ( (hwght*hr)*tv%T(i,j+1,k)+ (hwght*hl + hr*hl)*tv%T(i,j,k) ) * idenom
927 ttr = ( (hwght*hl)*t_t(i,j,k) + (hwght*hr + hr*hl)*t_t(i,j+1,k) ) * idenom
928 tbr = ( (hwght*hl)*t_b(i,j,k) + (hwght*hr + hr*hl)*t_b(i,j+1,k) ) * idenom
929 tmr = ( (hwght*hl)*tv%T(i,j,k) + (hwght*hr + hr*hl)*tv%T(i,j+1,k) ) * idenom
930 stl = ( (hwght*hr)*s_t(i,j+1,k) + (hwght*hl + hr*hl)*s_t(i,j,k) ) * idenom
931 sbl = ( (hwght*hr)*s_b(i,j+1,k) + (hwght*hl + hr*hl)*s_b(i,j,k) ) * idenom
932 sml = ( (hwght*hr)*tv%S(i,j+1,k)+ (hwght*hl + hr*hl)*tv%S(i,j,k) ) * idenom
933 str = ( (hwght*hl)*s_t(i,j,k) + (hwght*hr + hr*hl)*s_t(i,j+1,k) ) * idenom
934 sbr = ( (hwght*hl)*s_b(i,j,k) + (hwght*hr + hr*hl)*s_b(i,j+1,k) ) * idenom
935 smr = ( (hwght*hl)*tv%S(i,j,k) + (hwght*hr + hr*hl)*tv%S(i,j+1,k) ) * idenom
937 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)
938 tml = tv%T(i,j,k); tmr = tv%T(i,j+1,k)
939 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)
940 sml = tv%S(i,j,k); smr = tv%S(i,j+1,k)
944 w_left = wt_t(m) ; w_right = wt_b(m)
950 t_top = w_left*ttl + w_right*ttr
951 t_mn = w_left*tml + w_right*tmr
952 t_bot = w_left*tbl + w_right*tbr
954 s_top = w_left*stl + w_right*str
955 s_mn = w_left*sml + w_right*smr
956 s_bot = w_left*sbl + w_right*sbr
959 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))
960 p5(1) = -gxrho*(w_left*e(i,j,k) + w_right*e(i,j+1,k))
962 p5(n) = p5(n-1) + gxrho*0.25*dz
968 s6 = 3.0 * ( 2.0*s_mn - ( s_top + s_bot ) )
969 t6 = 3.0 * ( 2.0*t_mn - ( t_top + t_bot ) )
972 s5(n) = wt_t(n) * s_top + wt_b(n) * ( s_bot + s6 * wt_t(n) )
973 t5(n) = wt_t(n) * t_top + wt_b(n) * ( t_bot + t6 * wt_t(n) )
976 if (use_stanley_eos)
then 977 if (use_vart) t25(:) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i,j+1,k)
978 if (use_covarts) ts5(:) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i,j+1,k)
979 if (use_vars) s25(:) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i,j+1,k)
981 1, 5, eos, rho_ref=rho_ref_mks, scale=rho_scale)
983 call calculate_density(t5, s5, p5, r5, 1, 5, eos, rho_ref=rho_ref_mks, scale=rho_scale)
987 intz(m) = g_e*dz*( c1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) )
989 intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1)
992 inty_dpa(i,j) = c1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + 12.0*intz(3))
994 enddo ;
enddo ;
endif 996 end subroutine int_density_dz_generic_ppm
1004 subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, US, &
1005 dza, intp_dza, intx_dza, inty_dza, halo_size, &
1006 bathyP, dP_tiny, useMassWghtInterp)
1008 real,
dimension(SZI_(HI),SZJ_(HI)), &
1010 real,
dimension(SZI_(HI),SZJ_(HI)), &
1012 real,
dimension(SZI_(HI),SZJ_(HI)), &
1014 real,
dimension(SZI_(HI),SZJ_(HI)), &
1016 real,
intent(in) :: alpha_ref
1022 real,
dimension(SZI_(HI),SZJ_(HI)), &
1023 intent(inout) :: dza
1025 real,
dimension(SZI_(HI),SZJ_(HI)), &
1026 optional,
intent(inout) :: intp_dza
1029 real,
dimension(SZIB_(HI),SZJ_(HI)), &
1030 optional,
intent(inout) :: intx_dza
1033 real,
dimension(SZI_(HI),SZJB_(HI)), &
1034 optional,
intent(inout) :: inty_dza
1037 integer,
optional,
intent(in) :: halo_size
1038 real,
dimension(SZI_(HI),SZJ_(HI)), &
1039 optional,
intent(in) :: bathyP
1040 real,
optional,
intent(in) :: dP_tiny
1042 logical,
optional,
intent(in) :: useMassWghtInterp
1045 if (eos_quadrature(eos))
then 1046 call int_spec_vol_dp_generic_pcm(t, s, p_t, p_b, alpha_ref, hi, eos, us, &
1047 dza, intp_dza, intx_dza, inty_dza, halo_size, &
1048 bathyp, dp_tiny, usemasswghtinterp)
1050 call analytic_int_specific_vol_dp(t, s, p_t, p_b, alpha_ref, hi, eos, &
1051 dza, intp_dza, intx_dza, inty_dza, halo_size, &
1052 bathyp, dp_tiny, usemasswghtinterp)
1055 end subroutine int_specific_vol_dp
1062 subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, dza, &
1063 intp_dza, intx_dza, inty_dza, halo_size, &
1064 bathyP, dP_neglect, useMassWghtInterp)
1066 real,
dimension(SZI_(HI),SZJ_(HI)), &
1068 real,
dimension(SZI_(HI),SZJ_(HI)), &
1070 real,
dimension(SZI_(HI),SZJ_(HI)), &
1072 real,
dimension(SZI_(HI),SZJ_(HI)), &
1074 real,
intent(in) :: alpha_ref
1081 real,
dimension(SZI_(HI),SZJ_(HI)), &
1082 intent(inout) :: dza
1084 real,
dimension(SZI_(HI),SZJ_(HI)), &
1085 optional,
intent(inout) :: intp_dza
1088 real,
dimension(SZIB_(HI),SZJ_(HI)), &
1089 optional,
intent(inout) :: intx_dza
1092 real,
dimension(SZI_(HI),SZJB_(HI)), &
1093 optional,
intent(inout) :: inty_dza
1096 integer,
optional,
intent(in) :: halo_size
1097 real,
dimension(SZI_(HI),SZJ_(HI)), &
1098 optional,
intent(in) :: bathyP
1099 real,
optional,
intent(in) :: dP_neglect
1101 logical,
optional,
intent(in) :: useMassWghtInterp
1120 real :: alpha_ref_mks
1122 real :: hWt_LL, hWt_LR
1123 real :: hWt_RL, hWt_RR
1125 real :: wtT_L, wtT_R
1128 real :: RL2_T2_to_Pa
1131 logical :: do_massWeight
1132 real,
parameter :: C1_90 = 1.0/90.0
1133 integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, n, halo
1135 isq = hi%IscB ; ieq = hi%IecB ; jsq = hi%JscB ; jeq = hi%JecB
1136 halo = 0 ;
if (
present(halo_size)) halo = max(halo_size,0)
1137 ish = hi%isc-halo ; ieh = hi%iec+halo ; jsh = hi%jsc-halo ; jeh = hi%jec+halo
1138 if (
present(intx_dza))
then ; ish = min(isq,ish) ; ieh = max(ieq+1,ieh);
endif 1139 if (
present(inty_dza))
then ; jsh = min(jsq,jsh) ; jeh = max(jeq+1,jeh);
endif 1141 sv_scale = us%R_to_kg_m3
1142 rl2_t2_to_pa = us%RL2_T2_to_Pa
1143 alpha_ref_mks = alpha_ref * us%kg_m3_to_R
1145 do_massweight = .false.
1146 if (
present(usemasswghtinterp))
then ;
if (usemasswghtinterp)
then 1147 do_massweight = .true.
1148 if (.not.
present(bathyp))
call mom_error(fatal,
"int_spec_vol_dp_generic: "//&
1149 "bathyP must be present if useMassWghtInterp is present and true.")
1150 if (.not.
present(dp_neglect))
call mom_error(fatal,
"int_spec_vol_dp_generic: "//&
1151 "dP_neglect must be present if useMassWghtInterp is present and true.")
1154 do j=jsh,jeh ;
do i=ish,ieh
1155 dp = p_b(i,j) - p_t(i,j)
1157 t5(n) = t(i,j) ; s5(n) = s(i,j)
1158 p5(n) = rl2_t2_to_pa * (p_b(i,j) - 0.25*
real(n-1)*dp)
1161 if (sv_scale /= 1.0)
then 1168 alpha_anom = c1_90*(7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4)) + 12.0*a5(3))
1169 dza(i,j) = dp*alpha_anom
1172 if (
present(intp_dza)) intp_dza(i,j) = 0.5*dp**2 * &
1173 (alpha_anom - c1_90*(16.0*(a5(4)-a5(2)) + 7.0*(a5(5)-a5(1))) )
1176 if (
present(intx_dza))
then ;
do j=hi%jsc,hi%jec ;
do i=isq,ieq
1181 if (do_massweight) &
1182 hwght = max(0., bathyp(i,j)-p_t(i+1,j), bathyp(i+1,j)-p_t(i,j))
1183 if (hwght > 0.)
then 1184 hl = (p_b(i,j) - p_t(i,j)) + dp_neglect
1185 hr = (p_b(i+1,j) - p_t(i+1,j)) + dp_neglect
1186 hwght = hwght * ( (hl-hr)/(hl+hr) )**2
1187 idenom = 1.0 / ( hwght*(hr + hl) + hl*hr )
1188 hwt_ll = (hwght*hl + hr*hl) * idenom ; hwt_lr = (hwght*hr) * idenom
1189 hwt_rr = (hwght*hr + hr*hl) * idenom ; hwt_rl = (hwght*hl) * idenom
1191 hwt_ll = 1.0 ; hwt_lr = 0.0 ; hwt_rr = 1.0 ; hwt_rl = 0.0
1194 intp(1) = dza(i,j) ; intp(5) = dza(i+1,j)
1196 wt_l = 0.25*
real(5-m) ; wt_R = 1.0-wt_l
1197 wtt_l = wt_l*hwt_ll + wt_r*hwt_rl ; wtt_r = wt_l*hwt_lr + wt_r*hwt_rr
1201 p5(1) = rl2_t2_to_pa * (wt_l*p_b(i,j) + wt_r*p_b(i+1,j))
1202 dp = wt_l*(p_b(i,j) - p_t(i,j)) + wt_r*(p_b(i+1,j) - p_t(i+1,j))
1203 t5(1) = wtt_l*t(i,j) + wtt_r*t(i+1,j)
1204 s5(1) = wtt_l*s(i,j) + wtt_r*s(i+1,j)
1207 t5(n) = t5(1) ; s5(n) = s5(1) ; p5(n) = p5(n-1) - rl2_t2_to_pa * 0.25*dp
1209 if (sv_scale /= 1.0)
then 1216 intp(m) = dp*( c1_90*(7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4)) + &
1220 intx_dza(i,j) = c1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + &
1222 enddo ;
enddo ;
endif 1224 if (
present(inty_dza))
then ;
do j=jsq,jeq ;
do i=hi%isc,hi%iec
1229 if (do_massweight) &
1230 hwght = max(0., bathyp(i,j)-p_t(i,j+1), bathyp(i,j+1)-p_t(i,j))
1231 if (hwght > 0.)
then 1232 hl = (p_b(i,j) - p_t(i,j)) + dp_neglect
1233 hr = (p_b(i,j+1) - p_t(i,j+1)) + dp_neglect
1234 hwght = hwght * ( (hl-hr)/(hl+hr) )**2
1235 idenom = 1.0 / ( hwght*(hr + hl) + hl*hr )
1236 hwt_ll = (hwght*hl + hr*hl) * idenom ; hwt_lr = (hwght*hr) * idenom
1237 hwt_rr = (hwght*hr + hr*hl) * idenom ; hwt_rl = (hwght*hl) * idenom
1239 hwt_ll = 1.0 ; hwt_lr = 0.0 ; hwt_rr = 1.0 ; hwt_rl = 0.0
1242 intp(1) = dza(i,j) ; intp(5) = dza(i,j+1)
1244 wt_l = 0.25*
real(5-m) ; wt_R = 1.0-wt_l
1245 wtt_l = wt_l*hwt_ll + wt_r*hwt_rl ; wtt_r = wt_l*hwt_lr + wt_r*hwt_rr
1249 p5(1) = rl2_t2_to_pa * (wt_l*p_b(i,j) + wt_r*p_b(i,j+1))
1250 dp = wt_l*(p_b(i,j) - p_t(i,j)) + wt_r*(p_b(i,j+1) - p_t(i,j+1))
1251 t5(1) = wtt_l*t(i,j) + wtt_r*t(i,j+1)
1252 s5(1) = wtt_l*s(i,j) + wtt_r*s(i,j+1)
1254 t5(n) = t5(1) ; s5(n) = s5(1) ; p5(n) = rl2_t2_to_pa * (p5(n-1) - 0.25*dp)
1256 if (sv_scale /= 1.0)
then 1263 intp(m) = dp*( c1_90*(7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4)) + &
1267 inty_dza(i,j) = c1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + &
1269 enddo ;
enddo ;
endif 1271 end subroutine int_spec_vol_dp_generic_pcm
1277 subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, &
1278 dP_neglect, bathyP, HI, EOS, US, dza, &
1279 intp_dza, intx_dza, inty_dza, useMassWghtInterp)
1281 real,
dimension(SZI_(HI),SZJ_(HI)), &
1283 real,
dimension(SZI_(HI),SZJ_(HI)), &
1285 real,
dimension(SZI_(HI),SZJ_(HI)), &
1287 real,
dimension(SZI_(HI),SZJ_(HI)), &
1289 real,
dimension(SZI_(HI),SZJ_(HI)), &
1291 real,
dimension(SZI_(HI),SZJ_(HI)), &
1293 real,
intent(in) :: alpha_ref
1298 real,
intent(in) :: dP_neglect
1300 real,
dimension(SZI_(HI),SZJ_(HI)), &
1301 intent(in) :: bathyP
1304 real,
dimension(SZI_(HI),SZJ_(HI)), &
1305 intent(inout) :: dza
1307 real,
dimension(SZI_(HI),SZJ_(HI)), &
1308 optional,
intent(inout) :: intp_dza
1311 real,
dimension(SZIB_(HI),SZJ_(HI)), &
1312 optional,
intent(inout) :: intx_dza
1315 real,
dimension(SZI_(HI),SZJB_(HI)), &
1316 optional,
intent(inout) :: inty_dza
1319 logical,
optional,
intent(in) :: useMassWghtInterp
1337 real :: wt_t(5), wt_b(5)
1338 real :: T_top, T_bot, S_top, S_bot, P_top, P_bot
1345 real :: alpha_ref_mks
1347 real :: hWt_LL, hWt_LR
1348 real :: hWt_RL, hWt_RR
1350 real :: wtT_L, wtT_R
1353 real :: RL2_T2_to_Pa
1356 real,
parameter :: C1_90 = 1.0/90.0
1357 logical :: do_massWeight
1358 integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n, pos
1360 isq = hi%IscB ; ieq = hi%IecB ; jsq = hi%JscB ; jeq = hi%JecB
1362 do_massweight = .false.
1363 if (
present(usemasswghtinterp)) do_massweight = usemasswghtinterp
1365 sv_scale = us%R_to_kg_m3
1366 rl2_t2_to_pa = us%RL2_T2_to_Pa
1367 alpha_ref_mks = alpha_ref * us%kg_m3_to_R
1370 wt_t(n) = 0.25 *
real(n-1)
1371 wt_b(n) = 1.0 - wt_t(n)
1375 do j=jsq,jeq+1;
do i=isq,ieq+1
1376 dp = p_b(i,j) - p_t(i,j)
1378 p5(n) = rl2_t2_to_pa * (wt_t(n) * p_t(i,j) + wt_b(n) * p_b(i,j))
1379 s5(n) = wt_t(n) * s_t(i,j) + wt_b(n) * s_b(i,j)
1380 t5(n) = wt_t(n) * t_t(i,j) + wt_b(n) * t_b(i,j)
1382 if (sv_scale /= 1.0)
then 1389 alpha_anom = c1_90*((7.0*(a5(1)+a5(5)) + 32.0*(a5(2)+a5(4))) + 12.0*a5(3))
1390 dza(i,j) = dp*alpha_anom
1393 if (
present(intp_dza)) intp_dza(i,j) = 0.5*dp**2 * &
1394 (alpha_anom - c1_90*(16.0*(a5(4)-a5(2)) + 7.0*(a5(5)-a5(1))) )
1398 if (
present(intx_dza))
then ;
do j=hi%jsc,hi%jec ;
do i=isq,ieq
1405 if (do_massweight) &
1406 hwght = max(0., bathyp(i,j)-p_t(i+1,j), bathyp(i+1,j)-p_t(i,j))
1407 if (hwght > 0.)
then 1408 hl = (p_b(i,j) - p_t(i,j)) + dp_neglect
1409 hr = (p_b(i+1,j) - p_t(i+1,j)) + dp_neglect
1410 hwght = hwght * ( (hl-hr)/(hl+hr) )**2
1411 idenom = 1.0 / ( hwght*(hr + hl) + hl*hr )
1412 hwt_ll = (hwght*hl + hr*hl) * idenom ; hwt_lr = (hwght*hr) * idenom
1413 hwt_rr = (hwght*hr + hr*hl) * idenom ; hwt_rl = (hwght*hl) * idenom
1415 hwt_ll = 1.0 ; hwt_lr = 0.0 ; hwt_rr = 1.0 ; hwt_rl = 0.0
1419 wt_l = 0.25*
real(5-m) ; wt_R = 1.0-wt_l
1420 wtt_l = wt_l*hwt_ll + wt_r*hwt_rl ; wtt_r = wt_l*hwt_lr + wt_r*hwt_rr
1424 p_top = wt_l*p_t(i,j) + wt_r*p_t(i+1,j)
1425 p_bot = wt_l*p_b(i,j) + wt_r*p_b(i+1,j)
1426 t_top = wtt_l*t_t(i,j) + wtt_r*t_t(i+1,j)
1427 t_bot = wtt_l*t_b(i,j) + wtt_r*t_b(i+1,j)
1428 s_top = wtt_l*s_t(i,j) + wtt_r*s_t(i+1,j)
1429 s_bot = wtt_l*s_b(i,j) + wtt_r*s_b(i+1,j)
1430 dp_90(m) = c1_90*(p_bot - p_top)
1435 p15(pos+n) = rl2_t2_to_pa * (wt_t(n) * p_top + wt_b(n) * p_bot)
1436 s15(pos+n) = wt_t(n) * s_top + wt_b(n) * s_bot
1437 t15(pos+n) = wt_t(n) * t_top + wt_b(n) * t_bot
1441 if (sv_scale /= 1.0)
then 1442 call calculate_spec_vol(t15, s15, p15, a15, 1, 15, eos, alpha_ref_mks, scale=sv_scale)
1447 intp(1) = dza(i,j) ; intp(5) = dza(i+1,j)
1452 intp(m) = dp_90(m)*((7.0*(a15(pos+1)+a15(pos+5)) + &
1453 32.0*(a15(pos+2)+a15(pos+4))) + 12.0*a15(pos+3))
1456 intx_dza(i,j) = c1_90*((7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4))) + &
1458 enddo ;
enddo ;
endif 1461 if (
present(inty_dza))
then ;
do j=jsq,jeq ;
do i=hi%isc,hi%iec
1466 if (do_massweight) &
1467 hwght = max(0., bathyp(i,j)-p_t(i,j+1), bathyp(i,j+1)-p_t(i,j))
1468 if (hwght > 0.)
then 1469 hl = (p_b(i,j) - p_t(i,j)) + dp_neglect
1470 hr = (p_b(i,j+1) - p_t(i,j+1)) + dp_neglect
1471 hwght = hwght * ( (hl-hr)/(hl+hr) )**2
1472 idenom = 1.0 / ( hwght*(hr + hl) + hl*hr )
1473 hwt_ll = (hwght*hl + hr*hl) * idenom ; hwt_lr = (hwght*hr) * idenom
1474 hwt_rr = (hwght*hr + hr*hl) * idenom ; hwt_rl = (hwght*hl) * idenom
1476 hwt_ll = 1.0 ; hwt_lr = 0.0 ; hwt_rr = 1.0 ; hwt_rl = 0.0
1480 wt_l = 0.25*
real(5-m) ; wt_R = 1.0-wt_l
1481 wtt_l = wt_l*hwt_ll + wt_r*hwt_rl ; wtt_r = wt_l*hwt_lr + wt_r*hwt_rr
1485 p_top = wt_l*p_t(i,j) + wt_r*p_t(i,j+1)
1486 p_bot = wt_l*p_b(i,j) + wt_r*p_b(i,j+1)
1487 t_top = wtt_l*t_t(i,j) + wtt_r*t_t(i,j+1)
1488 t_bot = wtt_l*t_b(i,j) + wtt_r*t_b(i,j+1)
1489 s_top = wtt_l*s_t(i,j) + wtt_r*s_t(i,j+1)
1490 s_bot = wtt_l*s_b(i,j) + wtt_r*s_b(i,j+1)
1491 dp_90(m) = c1_90*(p_bot - p_top)
1496 p15(pos+n) = rl2_t2_to_pa * (wt_t(n) * p_top + wt_b(n) * p_bot)
1497 s15(pos+n) = wt_t(n) * s_top + wt_b(n) * s_bot
1498 t15(pos+n) = wt_t(n) * t_top + wt_b(n) * t_bot
1502 if (sv_scale /= 1.0)
then 1503 call calculate_spec_vol(t15, s15, p15, a15, 1, 15, eos, alpha_ref_mks, scale=sv_scale)
1508 intp(1) = dza(i,j) ; intp(5) = dza(i,j+1)
1513 intp(m) = dp_90(m) * ((7.0*(a15(pos+1)+a15(pos+5)) + &
1514 32.0*(a15(pos+2)+a15(pos+4))) + 12.0*a15(pos+3))
1517 inty_dza(i,j) = c1_90*((7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4))) + &
1519 enddo ;
enddo ;
endif 1521 end subroutine int_spec_vol_dp_generic_plm
1525 subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_tgt, &
1526 rho_ref, G_e, EOS, US, P_b, z_out, z_tol)
1527 real,
intent(in) :: T_t
1528 real,
intent(in) :: T_b
1529 real,
intent(in) :: S_t
1530 real,
intent(in) :: S_b
1531 real,
intent(in) :: z_t
1532 real,
intent(in) :: z_b
1533 real,
intent(in) :: P_t
1535 real,
intent(in) :: P_tgt
1537 real,
intent(in) :: rho_ref
1539 real,
intent(in) :: G_e
1542 real,
intent(out) :: P_b
1543 real,
intent(out) :: z_out
1544 real,
optional,
intent(in) :: z_tol
1548 real :: F_guess, F_l, F_r
1550 real :: Pa, Pa_left, Pa_right, Pa_tol
1551 character(len=240) :: msg
1553 gxrho = g_e * rho_ref
1556 dp = frac_dp_at_pos(t_t, t_b, s_t, s_b, z_t, z_b, rho_ref, g_e, 1.0, eos)
1560 if (p_tgt <= p_t )
then 1565 if (p_tgt >= p_b)
then 1571 pa_left = p_t - p_tgt
1573 pa_right = p_b - p_tgt
1574 pa_tol = gxrho * 1.0e-5*us%m_to_Z
1575 if (
present(z_tol)) pa_tol = gxrho * z_tol
1577 f_guess = f_l - pa_left / (pa_right - pa_left) * (f_r - f_l)
1578 pa = pa_right - pa_left
1579 do while ( abs(pa) > pa_tol )
1581 z_out = z_t + ( z_b - z_t ) * f_guess
1582 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 )
1584 if (pa<pa_left)
then 1585 write(msg,*) pa_left,pa,pa_right,p_t-p_tgt,p_b-p_tgt
1586 call mom_error(fatal,
'find_depth_of_pressure_in_cell out of bounds negative: /n'//msg)
1590 elseif (pa>pa_right)
then 1591 write(msg,*) pa_left,pa,pa_right,p_t-p_tgt,p_b-p_tgt
1592 call mom_error(fatal,
'find_depth_of_pressure_in_cell out of bounds positive: /n'//msg)
1599 f_guess = f_l - pa_left / (pa_right - pa_left) * (f_r - f_l)
1603 end subroutine find_depth_of_pressure_in_cell
1608 real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EOS)
1609 real,
intent(in) :: T_t
1610 real,
intent(in) :: T_b
1611 real,
intent(in) :: S_t
1612 real,
intent(in) :: S_b
1613 real,
intent(in) :: z_t
1614 real,
intent(in) :: z_b
1615 real,
intent(in) :: rho_ref
1617 real,
intent(in) :: G_e
1618 real,
intent(in) :: pos
1620 real :: fract_dp_at_pos
1623 real,
parameter :: C1_90 = 1.0/90.0
1625 real :: top_weight, bottom_weight
1627 real,
dimension(5) :: T5
1628 real,
dimension(5) :: S5
1629 real,
dimension(5) :: p5
1630 real,
dimension(5) :: rho5
1635 bottom_weight = 0.25*
real(n-1) * pos
1636 top_weight = 1.0 - bottom_weight
1638 s5(n) = top_weight * s_t + bottom_weight * s_b
1639 t5(n) = top_weight * t_t + bottom_weight * t_b
1640 p5(n) = ( top_weight * z_t + bottom_weight * z_b ) * ( g_e * rho_ref )
1646 rho_ave = c1_90*(7.0*(rho5(1)+rho5(5)) + 32.0*(rho5(2)+rho5(4)) + 12.0*rho5(3))
1648 dz = ( z_t - z_b ) * pos
1649 frac_dp_at_pos = g_e * dz * rho_ave
1650 end function frac_dp_at_pos
Calculate the derivatives of specific volume with temperature and salinity from T, S, and P.
Calculates density of sea water from T, S and P.
A structure that can be parsed to read and document run-time parameters.
The MOM6 facility to parse input files for runtime parameters.
Defines the horizontal index type (hor_index_type) used for providing index ranges.
Container for horizontal index ranges for data, computational and global domains. ...
Describes various unit conversion factors.
Calculates specific volume of sea water from T, S and P.
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Routines for error handling and I/O management.
Provides subroutines for quantities specific to the equation of state.
An overloaded interface to log version information about modules.
Describes the vertical ocean grid, including unit conversion factors.
Provides integrals of density.
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
Handy functions for manipulating strings.
Provides a transparent vertical ocean grid type and supporting routines.
Provides transparent structures with groups of MOM6 variables and supporting routines.
An overloaded interface to read and log the values of various types of parameters.
A control structure for the equation of state.