17 use mom_eos,
only : int_density_dz, int_specific_vol_dp
18 use mom_eos,
only : int_density_dz_generic_plm, int_density_dz_generic_ppm
19 use mom_eos,
only : int_spec_vol_dp_generic_plm
20 use mom_eos,
only : int_density_dz_generic, int_spec_vol_dp_generic
21 use mom_ale,
only : pressure_gradient_plm, pressure_gradient_ppm,
ale_cs
23 implicit none ;
private
25 #include <MOM_memory.h>
27 public pressureforce_afv, pressureforce_afv_init, pressureforce_afv_end
28 public pressureforce_afv_bouss, pressureforce_afv_nonbouss
42 type(time_type),
pointer :: time
45 logical :: usemasswghtinterp
46 logical :: boundary_extrap
49 logical :: reconstruct
54 integer :: recon_scheme
58 integer :: id_e_tidal = -1
66 subroutine pressureforce_afv(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta)
70 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
72 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)),
intent(out) :: pfu
73 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)),
intent(out) :: pfv
75 type(
ale_cs),
pointer :: ale_csp
76 real,
dimension(:,:),
optional,
pointer :: p_atm
78 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
optional,
intent(out) :: pbce
81 real,
dimension(SZI_(G),SZJ_(G)),
optional,
intent(out) :: eta
85 if (gv%Boussinesq)
then
86 call pressureforce_afv_bouss(h, tv, pfu, pfv, g, gv, us, cs, ale_csp, p_atm, pbce, eta)
88 call pressureforce_afv_nonbouss(h, tv, pfu, pfv, g, gv, us, cs, ale_csp, p_atm, pbce, eta)
91 end subroutine pressureforce_afv
102 subroutine pressureforce_afv_nonbouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta)
106 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
108 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)),
intent(out) :: pfu
109 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)),
intent(out) :: pfv
111 type(
ale_cs),
pointer :: ale_csp
112 real,
dimension(:,:),
optional,
pointer :: p_atm
114 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
optional,
intent(out) :: pbce
117 real,
dimension(SZI_(G),SZJ_(G)),
optional,
intent(out) :: eta
121 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p
122 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
target :: &
127 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: &
132 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: &
137 real,
dimension(SZI_(G),SZJ_(G)) :: &
147 real,
dimension(SZI_(G)) :: rho_cv_bl
149 real,
dimension(SZIB_(G),SZJ_(G)) :: &
152 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: &
154 real,
dimension(SZI_(G),SZJB_(G)) :: &
157 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)) :: &
159 real :: p_ref(szi_(g))
176 real :: rho_in_situ(szi_(g))
179 real,
parameter :: c1_6 = 1.0/6.0
180 integer :: is, ie, js, je, isq, ieq, jsq, jeq, nz, nkmb
183 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
184 nkmb=gv%nk_rho_varies
185 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
187 if (.not.
associated(cs))
call mom_error(fatal, &
188 "MOM_PressureForce_AFV_nonBouss: Module must be initialized before it is used.")
191 if (
present(p_atm))
then ;
if (
associated(p_atm)) use_p_atm = .true. ;
endif
192 use_eos =
associated(tv%eqn_of_state)
194 if (
associated(ale_csp)) use_ale = cs%reconstruct .and. use_eos
196 dp_neglect = gv%H_to_Pa * gv%H_subroundoff
197 alpha_ref = 1.0/cs%Rho0
198 g_earth_z = us%L_T_to_m_s**2 * gv%g_Earth
199 i_gearth = 1.0 / g_earth_z
203 do j=jsq,jeq+1 ;
do i=isq,ieq+1
204 p(i,j,1) = p_atm(i,j)
208 do j=jsq,jeq+1 ;
do i=isq,ieq+1
213 do j=jsq,jeq+1 ;
do k=2,nz+1 ;
do i=isq,ieq+1
214 p(i,j,k) = p(i,j,k-1) + gv%H_to_Pa * h(i,j,k-1)
215 enddo ;
enddo ;
enddo
223 tv_tmp%T => t_tmp ; tv_tmp%S => s_tmp
224 tv_tmp%eqn_of_state => tv%eqn_of_state
225 do i=isq,ieq+1 ; p_ref(i) = tv%P_Ref ;
enddo
228 do k=1,nkmb ;
do i=isq,ieq+1
229 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k)
232 rho_cv_bl(:), isq, ieq-isq+2, tv%eqn_of_state)
233 do k=nkmb+1,nz ;
do i=isq,ieq+1
234 if (gv%Rlay(k) < rho_cv_bl(i))
then
235 tv_tmp%T(i,j,k) = tv%T(i,j,nkmb) ; tv_tmp%S(i,j,k) = tv%S(i,j,nkmb)
237 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k)
242 tv_tmp%T => tv%T ; tv_tmp%S => tv%S
243 tv_tmp%eqn_of_state => tv%eqn_of_state
252 if ( cs%Recon_Scheme == 1 )
then
253 call pressure_gradient_plm(ale_csp, s_t, s_b, t_t, t_b, g, gv, tv, h, cs%boundary_extrap)
254 elseif ( cs%Recon_Scheme == 2)
then
255 call pressure_gradient_ppm(ale_csp, s_t, s_b, t_t, t_b, g, gv, tv, h, cs%boundary_extrap)
265 if ( cs%Recon_Scheme == 1 )
then
266 call int_spec_vol_dp_generic_plm( t_t(:,:,k), t_b(:,:,k), &
267 s_t(:,:,k), s_b(:,:,k), p(:,:,k), p(:,:,k+1), &
268 alpha_ref, dp_neglect, p(:,:,nz+1), g%HI, &
269 tv%eqn_of_state, dza(:,:,k), intp_dza(:,:,k), &
270 intx_dza(:,:,k), inty_dza(:,:,k), &
271 usemasswghtinterp = cs%useMassWghtInterp)
273 elseif ( cs%Recon_Scheme == 2 )
then
274 call mom_error(fatal,
"PressureForce_AFV_nonBouss: "//&
275 "int_spec_vol_dp_generic_ppm does not exist yet.")
282 call int_specific_vol_dp(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), p(:,:,k), &
283 p(:,:,k+1), alpha_ref, g%HI, tv%eqn_of_state, &
284 dza(:,:,k), intp_dza(:,:,k), intx_dza(:,:,k), &
285 inty_dza(:,:,k), bathyp=p(:,:,nz+1), dp_tiny=dp_neglect, &
286 usemasswghtinterp = cs%useMassWghtInterp)
289 alpha_anom = 1.0/gv%Rlay(k) - alpha_ref
290 do j=jsq,jeq+1 ;
do i=isq,ieq+1
291 dp(i,j) = gv%H_to_Pa * h(i,j,k)
292 dza(i,j,k) = alpha_anom * dp(i,j)
293 intp_dza(i,j,k) = 0.5 * alpha_anom * dp(i,j)**2
295 do j=js,je ;
do i=isq,ieq
296 intx_dza(i,j,k) = 0.5 * alpha_anom * (dp(i,j)+dp(i+1,j))
298 do j=jsq,jeq ;
do i=is,ie
299 inty_dza(i,j,k) = 0.5 * alpha_anom * (dp(i,j)+dp(i,j+1))
315 za(i,j) = alpha_ref*p(i,j,nz+1) - g_earth_z*g%bathyT(i,j)
317 do k=nz,1,-1 ;
do i=isq,ieq+1
318 za(i,j) = za(i,j) + dza(i,j,k)
325 do j=jsq,jeq+1 ;
do i=isq,ieq+1
326 ssh(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * i_gearth
328 call calc_tidal_forcing(cs%Time, ssh, e_tidal, g, cs%tides_CSp, m_to_z=us%m_to_Z)
330 do j=jsq,jeq+1 ;
do i=isq,ieq+1
331 za(i,j) = za(i,j) - g_earth_z * e_tidal(i,j)
335 if (cs%GFS_scale < 1.0)
then
341 rho_in_situ, isq, ieq-isq+2, tv%eqn_of_state)
344 dm(i,j) = (cs%GFS_scale - 1.0) * &
345 (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j))
350 do j=jsq,jeq+1 ;
do i=isq,ieq+1
351 dm(i,j) = (cs%GFS_scale - 1.0) * &
352 (p(i,j,1)*(1.0/gv%Rlay(1) - alpha_ref) + za(i,j))
365 do j=js,je ;
do i=isq,ieq
366 intx_za(i,j) = 0.5*(za(i,j) + za(i+1,j))
369 do j=jsq,jeq ;
do i=is,ie
370 inty_za(i,j) = 0.5*(za(i,j) + za(i,j+1))
376 do j=jsq,jeq+1 ;
do i=isq,ieq+1
377 dp(i,j) = gv%H_to_Pa*h(i,j,k)
378 za(i,j) = za(i,j) - dza(i,j,k)
381 do j=js,je ;
do i=isq,ieq
382 intx_za(i,j) = intx_za(i,j) - intx_dza(i,j,k)
383 pfu(i,j,k) = (((za(i,j)*dp(i,j) + intp_dza(i,j,k)) - &
384 (za(i+1,j)*dp(i+1,j) + intp_dza(i+1,j,k))) + &
385 ((dp(i+1,j) - dp(i,j)) * intx_za(i,j) - &
386 (p(i+1,j,k) - p(i,j,k)) * intx_dza(i,j,k))) * &
387 (2.0*g%IdxCu(i,j) / ((dp(i,j) + dp(i+1,j)) + &
391 do j=jsq,jeq ;
do i=is,ie
392 inty_za(i,j) = inty_za(i,j) - inty_dza(i,j,k)
393 pfv(i,j,k) = (((za(i,j)*dp(i,j) + intp_dza(i,j,k)) - &
394 (za(i,j+1)*dp(i,j+1) + intp_dza(i,j+1,k))) + &
395 ((dp(i,j+1) - dp(i,j)) * inty_za(i,j) - &
396 (p(i,j+1,k) - p(i,j,k)) * inty_dza(i,j,k))) * &
397 (2.0*g%IdyCv(i,j) / ((dp(i,j) + dp(i,j+1)) + &
401 if (cs%GFS_scale < 1.0)
then
404 do j=js,je ;
do i=isq,ieq
405 pfu(i,j,k) = pfu(i,j,k) - (dm(i+1,j) - dm(i,j)) * g%IdxCu(i,j)
408 do j=jsq,jeq ;
do i=is,ie
409 pfv(i,j,k) = pfv(i,j,k) - (dm(i,j+1) - dm(i,j)) * g%IdyCv(i,j)
414 if (
present(pbce))
then
415 call set_pbce_nonbouss(p, tv_tmp, g, gv, us, cs%GFS_scale, pbce)
418 if (
present(eta))
then
419 pa_to_h = 1.0 / gv%H_to_Pa
422 do j=jsq,jeq+1 ;
do i=isq,ieq+1
423 eta(i,j) = (p(i,j,nz+1) - p_atm(i,j))*pa_to_h
427 do j=jsq,jeq+1 ;
do i=isq,ieq+1
428 eta(i,j) = p(i,j,nz+1)*pa_to_h
433 if (cs%id_e_tidal>0)
call post_data(cs%id_e_tidal, e_tidal, cs%diag)
435 end subroutine pressureforce_afv_nonbouss
445 subroutine pressureforce_afv_bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta)
449 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
451 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)),
intent(out) :: pfu
452 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)),
intent(out) :: pfv
454 type(
ale_cs),
pointer :: ale_csp
455 real,
dimension(:,:),
optional,
pointer :: p_atm
457 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
optional,
intent(out) :: pbce
460 real,
dimension(SZI_(G),SZJ_(G)),
optional,
intent(out) :: eta
464 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e
465 real,
dimension(SZI_(G),SZJ_(G)) :: &
470 real,
dimension(SZI_(G)) :: &
473 real,
dimension(SZI_(G),SZJ_(G)) :: &
481 real,
dimension(SZIB_(G),SZJ_(G)) :: &
485 real,
dimension(SZI_(G),SZJB_(G)) :: &
490 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
target :: &
495 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: &
498 real :: rho_in_situ(szi_(g))
499 real :: p_ref(szi_(g))
514 real,
parameter :: c1_6 = 1.0/6.0
515 integer :: is, ie, js, je, isq, ieq, jsq, jeq, nz, nkmb
518 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
519 nkmb=gv%nk_rho_varies
520 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
522 if (.not.
associated(cs))
call mom_error(fatal, &
523 "MOM_PressureForce_AFV_Bouss: Module must be initialized before it is used.")
526 if (
present(p_atm))
then ;
if (
associated(p_atm)) use_p_atm = .true. ;
endif
527 use_eos =
associated(tv%eqn_of_state)
528 do i=isq,ieq+1 ; p0(i) = 0.0 ;
enddo
530 if (
associated(ale_csp)) use_ale = cs%reconstruct .and. use_eos
532 h_neglect = gv%H_subroundoff
533 dz_neglect = gv%H_subroundoff * gv%H_to_Z
535 g_earth_z = us%L_T_to_m_s**2 * gv%g_Earth
536 g_rho0 = g_earth_z/gv%Rho0
547 e(i,j,1) = -g%bathyT(i,j)
549 do k=1,nz ;
do i=isq,ieq+1
550 e(i,j,1) = e(i,j,1) + h(i,j,k)*gv%H_to_Z
553 call calc_tidal_forcing(cs%Time, e(:,:,1), e_tidal, g, cs%tides_CSp, m_to_z=us%m_to_Z)
559 do j=jsq,jeq+1 ;
do i=isq,ieq+1
560 e(i,j,nz+1) = -(g%bathyT(i,j) + e_tidal(i,j))
564 do j=jsq,jeq+1 ;
do i=isq,ieq+1
565 e(i,j,nz+1) = -g%bathyT(i,j)
569 do j=jsq,jeq+1;
do k=nz,1,-1 ;
do i=isq,ieq+1
570 e(i,j,k) = e(i,j,k+1) + h(i,j,k)*gv%H_to_Z
571 enddo ;
enddo ;
enddo
580 tv_tmp%T => t_tmp ; tv_tmp%S => s_tmp
581 tv_tmp%eqn_of_state => tv%eqn_of_state
583 do i=isq,ieq+1 ; p_ref(i) = tv%P_Ref ;
enddo
586 do k=1,nkmb ;
do i=isq,ieq+1
587 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k)
590 rho_cv_bl(:), isq, ieq-isq+2, tv%eqn_of_state)
592 do k=nkmb+1,nz ;
do i=isq,ieq+1
593 if (gv%Rlay(k) < rho_cv_bl(i))
then
594 tv_tmp%T(i,j,k) = tv%T(i,j,nkmb) ; tv_tmp%S(i,j,k) = tv%S(i,j,nkmb)
596 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k)
601 tv_tmp%T => tv%T ; tv_tmp%S => tv%S
602 tv_tmp%eqn_of_state => tv%eqn_of_state
606 if (cs%GFS_scale < 1.0)
then
613 rho_in_situ, isq, ieq-isq+2, tv%eqn_of_state)
616 rho_in_situ, isq, ieq-isq+2, tv%eqn_of_state)
619 dm(i,j) = (cs%GFS_scale - 1.0) * (g_rho0 * rho_in_situ(i)) * e(i,j,1)
624 do j=jsq,jeq+1 ;
do i=isq,ieq+1
625 dm(i,j) = (cs%GFS_scale - 1.0) * (g_rho0 * gv%Rlay(1)) * e(i,j,1)
636 if ( cs%Recon_Scheme == 1 )
then
637 call pressure_gradient_plm(ale_csp, s_t, s_b, t_t, t_b, g, gv, tv, h, cs%boundary_extrap)
638 elseif ( cs%Recon_Scheme == 2 )
then
639 call pressure_gradient_ppm(ale_csp, s_t, s_b, t_t, t_b, g, gv, tv, h, cs%boundary_extrap)
648 do j=jsq,jeq+1 ;
do i=isq,ieq+1
649 pa(i,j) = (rho_ref*g_earth_z)*e(i,j,1) + p_atm(i,j)
653 do j=jsq,jeq+1 ;
do i=isq,ieq+1
654 pa(i,j) = (rho_ref*g_earth_z)*e(i,j,1)
658 do j=js,je ;
do i=isq,ieq
659 intx_pa(i,j) = 0.5*(pa(i,j) + pa(i+1,j))
662 do j=jsq,jeq ;
do i=is,ie
663 inty_pa(i,j) = 0.5*(pa(i,j) + pa(i,j+1))
677 if ( cs%Recon_Scheme == 1 )
then
678 call int_density_dz_generic_plm( t_t(:,:,k), t_b(:,:,k), &
679 s_t(:,:,k), s_b(:,:,k), e(:,:,k), e(:,:,k+1), &
680 rho_ref, cs%Rho0, g_earth_z, &
681 dz_neglect, g%bathyT, g%HI, g%HI, &
682 tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, &
683 usemasswghtinterp = cs%useMassWghtInterp)
684 elseif ( cs%Recon_Scheme == 2 )
then
685 call int_density_dz_generic_ppm( tv%T(:,:,k), t_t(:,:,k), t_b(:,:,k), &
686 tv%S(:,:,k), s_t(:,:,k), s_b(:,:,k), e(:,:,k), e(:,:,k+1), &
687 rho_ref, cs%Rho0, g_earth_z, &
688 g%HI, g%HI, tv%eqn_of_state, dpa, intz_dpa, &
692 call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,k), e(:,:,k+1), &
693 rho_ref, cs%Rho0, g_earth_z, g%HI, g%HI, tv%eqn_of_state, &
694 dpa, intz_dpa, intx_dpa, inty_dpa, &
695 g%bathyT, dz_neglect, cs%useMassWghtInterp)
698 do j=jsq,jeq+1 ;
do i=isq,ieq+1
699 intz_dpa(i,j) = intz_dpa(i,j)*gv%Z_to_H
703 do j=jsq,jeq+1 ;
do i=isq,ieq+1
704 dz(i,j) = g_earth_z * gv%H_to_Z*h(i,j,k)
705 dpa(i,j) = (gv%Rlay(k) - rho_ref)*dz(i,j)
706 intz_dpa(i,j) = 0.5*(gv%Rlay(k) - rho_ref)*dz(i,j)*h(i,j,k)
709 do j=js,je ;
do i=isq,ieq
710 intx_dpa(i,j) = 0.5*(gv%Rlay(k) - rho_ref) * (dz(i,j)+dz(i+1,j))
713 do j=jsq,jeq ;
do i=is,ie
714 inty_dpa(i,j) = 0.5*(gv%Rlay(k) - rho_ref) * (dz(i,j)+dz(i,j+1))
720 do j=js,je ;
do i=isq,ieq
721 pfu(i,j,k) = (((pa(i,j)*h(i,j,k) + intz_dpa(i,j)) - &
722 (pa(i+1,j)*h(i+1,j,k) + intz_dpa(i+1,j))) + &
723 ((h(i+1,j,k) - h(i,j,k)) * intx_pa(i,j) - &
724 (e(i+1,j,k+1) - e(i,j,k+1)) * intx_dpa(i,j) * gv%Z_to_H)) * &
725 ((2.0*i_rho0*g%IdxCu(i,j)) / &
726 ((h(i,j,k) + h(i+1,j,k)) + h_neglect))
727 intx_pa(i,j) = intx_pa(i,j) + intx_dpa(i,j)
731 do j=jsq,jeq ;
do i=is,ie
732 pfv(i,j,k) = (((pa(i,j)*h(i,j,k) + intz_dpa(i,j)) - &
733 (pa(i,j+1)*h(i,j+1,k) + intz_dpa(i,j+1))) + &
734 ((h(i,j+1,k) - h(i,j,k)) * inty_pa(i,j) - &
735 (e(i,j+1,k+1) - e(i,j,k+1)) * inty_dpa(i,j) * gv%Z_to_H)) * &
736 ((2.0*i_rho0*g%IdyCv(i,j)) / &
737 ((h(i,j,k) + h(i,j+1,k)) + h_neglect))
738 inty_pa(i,j) = inty_pa(i,j) + inty_dpa(i,j)
741 do j=jsq,jeq+1 ;
do i=isq,ieq+1
742 pa(i,j) = pa(i,j) + dpa(i,j)
746 if (cs%GFS_scale < 1.0)
then
749 do j=js,je ;
do i=isq,ieq
750 pfu(i,j,k) = pfu(i,j,k) - (dm(i+1,j) - dm(i,j)) * g%IdxCu(i,j)
753 do j=jsq,jeq ;
do i=is,ie
754 pfv(i,j,k) = pfv(i,j,k) - (dm(i,j+1) - dm(i,j)) * g%IdyCv(i,j)
759 if (
present(pbce))
then
760 call set_pbce_bouss(e, tv_tmp, g, gv, us, cs%Rho0, cs%GFS_scale, pbce)
763 if (
present(eta))
then
769 do j=jsq,jeq+1 ;
do i=isq,ieq+1
770 eta(i,j) = e(i,j,1)*gv%Z_to_H + e_tidal(i,j)*gv%Z_to_H
774 do j=jsq,jeq+1 ;
do i=isq,ieq+1
775 eta(i,j) = e(i,j,1)*gv%Z_to_H
780 if (cs%id_e_tidal>0)
call post_data(cs%id_e_tidal, e_tidal, cs%diag)
782 end subroutine pressureforce_afv_bouss
785 subroutine pressureforce_afv_init(Time, G, GV, US, param_file, diag, CS, tides_CSp)
786 type(time_type),
target,
intent(in) :: time
791 type(
diag_ctrl),
target,
intent(inout) :: diag
795 #include "version_variable.h"
796 character(len=40) :: mdl
799 if (
associated(cs))
then
800 call mom_error(warning,
"PressureForce_init called with an associated "// &
801 "control structure.")
803 else ;
allocate(cs) ;
endif
805 cs%diag => diag ; cs%Time => time
806 if (
present(tides_csp))
then
807 if (
associated(tides_csp)) cs%tides_CSp => tides_csp
810 mdl =
"MOM_PressureForce_AFV"
812 call get_param(param_file, mdl,
"RHO_0", cs%Rho0, &
813 "The mean ocean density used with BOUSSINESQ true to "//&
814 "calculate accelerations and the mass for conservation "//&
815 "properties, or with BOUSSINSEQ false to convert some "//&
816 "parameters from vertical units of m to kg m-2.", &
817 units=
"kg m-3", default=1035.0)
818 call get_param(param_file, mdl,
"TIDES", cs%tides, &
819 "If true, apply tidal momentum forcing.", default=.false.)
820 call get_param(param_file,
"MOM",
"USE_REGRIDDING", use_ale, &
821 "If True, use the ALE algorithm (regridding/remapping). "//&
822 "If False, use the layered isopycnal algorithm.", default=.false. )
823 call get_param(param_file, mdl,
"MASS_WEIGHT_IN_PRESSURE_GRADIENT", cs%useMassWghtInterp, &
824 "If true, use mass weighting when interpolating T/S for "//&
825 "integrals near the bathymetry in AFV pressure gradient "//&
826 "calculations.", default=.false.)
827 call get_param(param_file, mdl,
"RECONSTRUCT_FOR_PRESSURE", cs%reconstruct, &
828 "If True, use vertical reconstruction of T & S within "//&
829 "the integrals of the FV pressure gradient calculation. "//&
830 "If False, use the constant-by-layer algorithm. "//&
831 "The default is set by USE_REGRIDDING.", &
833 call get_param(param_file, mdl,
"PRESSURE_RECONSTRUCTION_SCHEME", cs%Recon_Scheme, &
834 "Order of vertical reconstruction of T/S to use in the "//&
835 "integrals within the FV pressure gradient calculation.\n"//&
836 " 0: PCM or no reconstruction.\n"//&
837 " 1: PLM reconstruction.\n"//&
838 " 2: PPM reconstruction.", default=1)
839 call get_param(param_file, mdl,
"BOUNDARY_EXTRAPOLATION_PRESSURE", cs%boundary_extrap, &
840 "If true, the reconstruction of T & S for pressure in "//&
841 "boundary cells is extrapolated, rather than using PCM "//&
842 "in these cells. If true, the same order polynomial is "//&
843 "used as is used for the interior cells.", default=.true.)
846 cs%id_e_tidal = register_diag_field(
'ocean_model',
'e_tidal', diag%axesT1, &
847 time,
'Tidal Forcing Astronomical and SAL Height Anomaly',
'meter', conversion=us%Z_to_m)
851 if (gv%g_prime(1) /= gv%g_Earth) cs%GFS_scale = gv%g_prime(1) / gv%g_Earth
853 call log_param(param_file, mdl,
"GFS / G_EARTH", cs%GFS_scale)
855 end subroutine pressureforce_afv_init
858 subroutine pressureforce_afv_end(CS)
861 if (
associated(cs))
deallocate(cs)
862 end subroutine pressureforce_afv_end