Skip to content

Commit

Permalink
Cleanup
Browse files Browse the repository at this point in the history
  • Loading branch information
andrew-c-ross committed Aug 6, 2024
1 parent b0f0b0a commit 0fb2043
Show file tree
Hide file tree
Showing 5 changed files with 36 additions and 60 deletions.
20 changes: 8 additions & 12 deletions src/tracer/MOM_generic_tracer.F90
Original file line number Diff line number Diff line change
Expand Up @@ -612,27 +612,23 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml,
if (g_tracer_is_prog(g_tracer)) then
do k=1,nk ;do j=jsc,jec ; do i=isc,iec
h_work(i,j,k) = h_old(i,j,k)
!liao
g_tracer%boundary_forcing_tend(i,j,k) = 0
if (g_tracer%diag_id_boundary_forcing_tend .gt. 0) then
g_tracer%boundary_forcing_tend(i,j,k) = g_tracer%field(i,j,k,1)
endif
!liao
enddo ; enddo ; enddo
call applyTracerBoundaryFluxesInOut(G, GV, g_tracer%field(:,:,:,1), dt, &
fluxes, h_work, evap_CFL_limit, minimum_forcing_depth)
!liao
if (g_tracer%diag_id_boundary_forcing_tend .gt. 0) then
do k=1,nk ;do j=jsc,jec ; do i=isc,iec
g_tracer%boundary_forcing_tend(i,j,k)=G%mask2dT(i,j)*(g_tracer%field(i,j,k,1) &
- g_tracer%boundary_forcing_tend(i,j,k))/dt
enddo ; enddo ; enddo
endif
!liao
if (g_tracer%diag_id_boundary_forcing_tend .gt. 0) then
do k=1,nk ;do j=jsc,jec ; do i=isc,iec
g_tracer%boundary_forcing_tend(i,j,k)=G%mask2dT(i,j)*(g_tracer%field(i,j,k,1) &
- g_tracer%boundary_forcing_tend(i,j,k))/dt
enddo ; enddo ; enddo
endif
endif

!traverse the linked list till hit NULL
call g_tracer_get_next(g_tracer, g_tracer_next)
!traverse the linked list till hit NULL
call g_tracer_get_next(g_tracer, g_tracer_next)
if (.NOT. associated(g_tracer_next)) exit
g_tracer=>g_tracer_next
enddo
Expand Down
15 changes: 4 additions & 11 deletions src/tracer/MOM_tracer_advect.F90
Original file line number Diff line number Diff line change
Expand Up @@ -368,7 +368,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
! the grid box, both in [H L2 ~> m3 or kg].
real :: uhh(SZIB_(G)) ! The zonal flux that occurs during the
! current iteration [H L2 ~> m3 or kg].
real, dimension(SZIB_(G)) :: tprev !< tracer conc at the end of !liao
real, dimension(SZIB_(G)) :: tprev !< tracer conc at the end of previous step.
real, dimension(SZIB_(G)) :: &
hlst, & ! Work variable [H L2 ~> m3 or kg].
Ihnew, & ! Work variable [H-1 L-2 ~> m-3 or kg-1].
Expand Down Expand Up @@ -659,7 +659,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
do i=is,ie
if (do_i(i,j)) then
if (Ihnew(i) > 0.0) then
tprev(i)=Tr(m)%t(i,j,k) !liao
tprev(i)=Tr(m)%t(i,j,k)
Tr(m)%t(i,j,k) = (Tr(m)%t(i,j,k) * hlst(i) - &
(flux_x(I,j,m) - flux_x(I-1,j,m))) * Ihnew(i)
endif
Expand All @@ -679,7 +679,6 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
Idt * G%IareaT(i,j)
endif ; enddo
endif
!liao
if (associated(Tr(m)%advectionc_xy)) then
do i=is,ie ; if (do_i(i,j)) then
Tr(m)%advectionc_xy(i,j,k) = Tr(m)%advectionc_xy(i,j,k)+(Tr(m)%t(i,j,k) - tprev(i))*Idt*G%mask2dT(i,j)
Expand All @@ -690,8 +689,6 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
Tr(m)%advectionc_x(i,j,k) =(Tr(m)%t(i,j,k) - tprev(i))*Idt*G%mask2dT(i,j)
endif ; enddo
endif
!liao

enddo

endif ; enddo ! End of j-loop.
Expand Down Expand Up @@ -753,7 +750,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
T_tmp ! The copy of the tracer concentration at constant i,k [conc].
real :: vhh(SZI_(G),SZJB_(G)) ! The meridional flux that occurs during the
! current iteration [H L2 ~> m3 or kg].
real, dimension(SZIB_(G)) :: tprev !< tracer conc at the end of !liao
real, dimension(SZIB_(G)) :: tprev !< tracer conc at the end of previous step.
real :: hup, hlos ! hup is the upwind volume, hlos is the
! part of that volume that might be lost
! due to advection out the other side of
Expand Down Expand Up @@ -1060,11 +1057,10 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
! update tracer and save some diagnostics
do m=1,ntr
do i=is,ie ; if (do_i(i,j)) then
tprev(i)=Tr(m)%t(i,j,k) !liao
tprev(i)=Tr(m)%t(i,j,k)
Tr(m)%t(i,j,k) = (Tr(m)%t(i,j,k) * hlst(i) - &
(flux_y(i,m,J) - flux_y(i,m,J-1))) * Ihnew(i)
endif ; enddo

! diagnose convergence of flux_y and add to convergence of flux_x.
! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt.
if (associated(Tr(m)%advection_xy)) then
Expand All @@ -1073,7 +1069,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
G%IareaT(i,j)
endif ; enddo
endif
!liao
if (associated(Tr(m)%advectionc_xy)) then
do i=is,ie ; if (do_i(i,j)) then
Tr(m)%advectionc_xy(i,j,k) = Tr(m)%advectionc_xy(i,j,k)+(Tr(m)%t(i,j,k) - tprev(i))*Idt*G%mask2dT(i,j)
Expand All @@ -1084,8 +1079,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
Tr(m)%advectionc_y(i,j,k) = (Tr(m)%t(i,j,k) - tprev(i))*Idt*G%mask2dT(i,j)
endif ; enddo
endif
!liao

enddo
endif ; enddo ! End of j-loop.

Expand Down
5 changes: 0 additions & 5 deletions src/tracer/MOM_tracer_hor_diff.F90
Original file line number Diff line number Diff line change
Expand Up @@ -400,19 +400,16 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, visc, G, GV, US, CS, Reg, tv, do_
if (associated(Reg%Tr(m)%df2d_y)) then
do J=js-1,je ; do i=is,ie ; Reg%Tr(m)%df2d_y(i,J) = 0.0 ; enddo ; enddo
endif
! mpoupon
if (associated(Reg%Tr(m)%diffusionc_xy)) then
do k=1,nz ; do j=js,je ; do i=is,ie
Reg%Tr(m)%diffusionc_xy(i,j,k) = 0.0
enddo ; enddo ; enddo
endif

if (associated(Reg%Tr(m)%diffusion_xy)) then
do k=1,nz ; do j=js,je ; do i=is,ie
Reg%Tr(m)%diffusion_xy(i,j,k) = 0.0
enddo ; enddo ; enddo
endif
! mpoupon
enddo

if (CS%use_hor_bnd_diffusion) then
Expand Down Expand Up @@ -582,14 +579,12 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, visc, G, GV, US, CS, Reg, tv, do_
enddo ; enddo ; endif
do j=js,je ; do i=is,ie
Reg%Tr(m)%t(i,j,k) = Reg%Tr(m)%t(i,j,k) + dTr(i,j)
! mpoupon
if (associated(Reg%Tr(m)%diffusionc_xy)) then
Reg%Tr(m)%diffusionc_xy(i,j,k) = dTr(i,j) * Idt
endif
if (associated(Reg%Tr(m)%diffusion_xy)) then
Reg%Tr(m)%diffusion_xy(i,j,k) = dTr(i,j) * Idt * (h(i,j,k)+h_neglect)
endif
! mpoupon
enddo ; enddo
enddo

Expand Down
42 changes: 17 additions & 25 deletions src/tracer/MOM_tracer_registry.F90
Original file line number Diff line number Diff line change
Expand Up @@ -53,8 +53,8 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit
cmor_name, cmor_units, cmor_longname, net_surfflux_name, NLT_budget_name, &
net_surfflux_longname, tr_desc, OBC_inflow, OBC_in_u, OBC_in_v, ad_x, ad_y, &
df_x, df_y, ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, &
advectionc_xy, advectionc_x, advectionc_y, & !liao
diffusionc_xy, diffusion_xy, & ! mpoupon
advectionc_xy, advectionc_x, advectionc_y, &
diffusionc_xy, diffusion_xy, &
conc_scale, flux_nameroot, flux_longname, flux_units, flux_scale, &
convergence_units, convergence_scale, cmor_tendprefix, diag_form, &
restart_CS, mandatory, underflow_conc, Tr_out)
Expand Down Expand Up @@ -102,11 +102,11 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit

real, dimension(:,:,:), optional, pointer :: advection_xy !< convergence of lateral advective tracer fluxes
!! [CU H T-1 ~> conc m s-1 or conc kg m-2 s-1]
real, dimension(:,:,:), optional, pointer :: advectionc_xy !< convergence of lateral advection !liao
real, dimension(:,:,:), optional, pointer :: diffusionc_xy !< convergence of lateral diffusion !mpoupon
real, dimension(:,:,:), optional, pointer :: diffusion_xy !< convergence of lateral diffusive tracer fluxes !mpoupon
real, dimension(:,:,:), optional, pointer :: advectionc_x !< lateral advection concentration !liao
real, dimension(:,:,:), optional, pointer :: advectionc_y !< lateral advection concentration !liao
real, dimension(:,:,:), optional, pointer :: advectionc_xy !< convergence of lateral advection
real, dimension(:,:,:), optional, pointer :: diffusionc_xy !< convergence of lateral diffusion
real, dimension(:,:,:), optional, pointer :: diffusion_xy !< convergence of lateral diffusive tracer fluxes
real, dimension(:,:,:), optional, pointer :: advectionc_x !< lateral advection concentration
real, dimension(:,:,:), optional, pointer :: advectionc_y !< lateral advection concentration

logical, optional, intent(in) :: registry_diags !< If present and true, use the registry for
!! the diagnostics of this tracer.
Expand Down Expand Up @@ -253,11 +253,11 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit
if (present(df_2d_x)) then ; if (associated(df_2d_x)) Tr%df2d_x => df_2d_x ; endif

if (present(advection_xy)) then ; if (associated(advection_xy)) Tr%advection_xy => advection_xy ; endif
if (present(advectionc_xy)) then; if (associated(advectionc_xy)) Tr%advectionc_xy => advectionc_xy ; endif !liao
if (present(diffusionc_xy)) then; if (associated(diffusionc_xy)) Tr%diffusionc_xy => diffusionc_xy ; endif !mpoupon
if (present(diffusion_xy)) then; if (associated(diffusion_xy)) Tr%diffusion_xy => diffusion_xy ; endif !mpoupon
if (present(advectionc_x)) then; if (associated(advectionc_x)) Tr%advectionc_x => advectionc_x ; endif !liao
if (present(advectionc_y)) then; if (associated(advectionc_y)) Tr%advectionc_y => advectionc_y ; endif !liao
if (present(advectionc_xy)) then; if (associated(advectionc_xy)) Tr%advectionc_xy => advectionc_xy ; endif
if (present(diffusionc_xy)) then; if (associated(diffusionc_xy)) Tr%diffusionc_xy => diffusionc_xy ; endif
if (present(diffusion_xy)) then; if (associated(diffusion_xy)) Tr%diffusion_xy => diffusion_xy ; endif
if (present(advectionc_x)) then; if (associated(advectionc_x)) Tr%advectionc_x => advectionc_x ; endif
if (present(advectionc_y)) then; if (associated(advectionc_y)) Tr%advectionc_y => advectionc_y ; endif

if (present(restart_CS)) then
! Register this tracer to be read from and written to restart files.
Expand Down Expand Up @@ -452,15 +452,12 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE, u
'Horizontal convergence of residual mean advective fluxes of '//&
trim(lowercase(flux_longname)), conv_units, v_extensive=.true., &
conversion=Tr%conv_scale*US%s_to_T)
! mpoupon
Tr%id_difc_xy = register_diag_field('ocean_model',trim(shortnm)//"_diffusionc_xy", &
diag%axesTL, Time, "Horizontal convergence of residual mean diffusive fluxes of "//trim(shortnm), &
trim(units)//' s-1')
Tr%id_dif_xy = register_diag_field('ocean_model',trim(shortnm)//"_diffusion_xy", &
diag%axesTL, Time, "Horizontal convergence of residual mean diffusive fluxes of "//trim(shortnm), &
trim(units)//' s-1')
! mpoupon
!liao
Tr%id_advc_xy = register_diag_field('ocean_model',trim(shortnm)//"_advectionc_xy", &
diag%axesTL, Time, "Horizontal convergence of residual mean advective fluxes of "//trim(shortnm), &
trim(units)//' s-1')
Expand All @@ -470,27 +467,22 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE, u
Tr%id_advc_y = register_diag_field("ocean_model",trim(shortnm)//'_advectionc_y', &
diag%axesTL, Time, "Horizontal y mean advective fluxes of "//trim(shortnm), &
trim(units)//' s-1')
!liao
Tr%id_adv_xy_2d = register_diag_field('ocean_model', trim(shortnm)//"_advection_xy_2d", &
diag%axesT1, Time, &
'Vertical sum of horizontal convergence of residual mean advective fluxes of '//&
trim(lowercase(flux_longname)), conv_units, conversion=Tr%conv_scale*US%s_to_T)
if ((Tr%id_adv_xy > 0) .or. (Tr%id_adv_xy_2d > 0)) &
call safe_alloc_ptr(Tr%advection_xy,isd,ied,jsd,jed,nz)
!mpoupon
if (Tr%id_difc_xy > 0) &
call safe_alloc_ptr(Tr%diffusionc_xy,isd,ied,jsd,jed,nz)
if (Tr%id_dif_xy > 0) &
call safe_alloc_ptr(Tr%diffusion_xy,isd,ied,jsd,jed,nz)
!mpoupon
!liao
if (Tr%id_advc_xy > 0) &
call safe_alloc_ptr(Tr%advectionc_xy,isd,ied,jsd,jed,nz)
if (Tr%id_advc_x > 0) &
call safe_alloc_ptr(Tr%advectionc_x,isd,ied,jsd,jed,nz)
if (Tr%id_advc_y > 0) &
call safe_alloc_ptr(Tr%advectionc_y,isd,ied,jsd,jed,nz)
!liao

Tr%id_tendency = register_diag_field('ocean_model', trim(shortnm)//'_tendency', &
diag%axesTL, Time, &
Expand Down Expand Up @@ -786,11 +778,11 @@ subroutine post_tracer_transport_diagnostics(G, GV, Reg, h_diag, diag)
if (Tr%id_dfx_2d > 0) call post_data(Tr%id_dfx_2d, Tr%df2d_x, diag)
if (Tr%id_dfy_2d > 0) call post_data(Tr%id_dfy_2d, Tr%df2d_y, diag)
if (Tr%id_adv_xy > 0) call post_data(Tr%id_adv_xy, Tr%advection_xy, diag, alt_h=h_diag)
if (Tr%id_advc_xy > 0) call post_data(Tr%id_advc_xy, Tr%advectionc_xy, diag, alt_h=h_diag) !liao
if (Tr%id_difc_xy > 0) call post_data(Tr%id_difc_xy, Tr%diffusionc_xy, diag, alt_h=h_diag) !mpoupon
if (Tr%id_dif_xy > 0) call post_data(Tr%id_dif_xy, Tr%diffusion_xy, diag, alt_h=h_diag) !mpoupon
if (Tr%id_advc_x > 0) call post_data(Tr%id_advc_x, Tr%advectionc_x, diag, alt_h=h_diag) !liao
if (Tr%id_advc_y > 0) call post_data(Tr%id_advc_y, Tr%advectionc_y, diag, alt_h=h_diag) !liao
if (Tr%id_advc_xy > 0) call post_data(Tr%id_advc_xy, Tr%advectionc_xy, diag, alt_h=h_diag)
if (Tr%id_difc_xy > 0) call post_data(Tr%id_difc_xy, Tr%diffusionc_xy, diag, alt_h=h_diag)
if (Tr%id_dif_xy > 0) call post_data(Tr%id_dif_xy, Tr%diffusion_xy, diag, alt_h=h_diag)
if (Tr%id_advc_x > 0) call post_data(Tr%id_advc_x, Tr%advectionc_x, diag, alt_h=h_diag)
if (Tr%id_advc_y > 0) call post_data(Tr%id_advc_y, Tr%advectionc_y, diag, alt_h=h_diag)
if (Tr%id_adv_xy_2d > 0) then
work2d(:,:) = 0.0
do k=1,nz ; do j=js,je ; do i=is,ie
Expand Down
14 changes: 7 additions & 7 deletions src/tracer/MOM_tracer_types.F90
Original file line number Diff line number Diff line change
Expand Up @@ -48,11 +48,11 @@ module MOM_tracer_types

real, dimension(:,:,:), pointer :: advection_xy => NULL() !< convergence of lateral advective tracer fluxes
!! [CU H T-1 ~> conc m s-1 or conc kg m-2 s-1]
real, dimension(:,:,:), pointer :: advectionc_xy => NULL() !< convergence of lateral advection concentration liao
real, dimension(:,:,:), pointer :: diffusionc_xy => NULL() !< convergence of lateral diffusion concentration mpoupon
real, dimension(:,:,:), pointer :: diffusion_xy => NULL() !< convergence of lateral diffusion content mpoupon
real, dimension(:,:,:), pointer :: advectionc_x => NULL() !< lateral advection concentration liao
real, dimension(:,:,:), pointer :: advectionc_y => NULL() !< lateral advection concentration liao
real, dimension(:,:,:), pointer :: advectionc_xy => NULL() !< convergence of lateral advection concentration
real, dimension(:,:,:), pointer :: diffusionc_xy => NULL() !< convergence of lateral diffusion concentration
real, dimension(:,:,:), pointer :: diffusion_xy => NULL() !< convergence of lateral diffusion content
real, dimension(:,:,:), pointer :: advectionc_x => NULL() !< lateral advection concentration
real, dimension(:,:,:), pointer :: advectionc_y => NULL() !< lateral advection concentration

! real, dimension(:,:,:), pointer :: diff_cont_xy => NULL() !< convergence of lateral diffusive tracer fluxes
! !! [CU H T-1 ~> conc m s-1 or conc kg m-2 s-1]
Expand Down Expand Up @@ -114,8 +114,8 @@ module MOM_tracer_types
integer :: id_hbd_dfx_2d = -1, id_hbd_dfy_2d = -1
integer :: id_adx_2d = -1, id_ady_2d = -1, id_dfx_2d = -1, id_dfy_2d = -1
integer :: id_adv_xy = -1, id_adv_xy_2d = -1
integer :: id_advc_xy = -1, id_advc_x = -1, id_advc_y = -1 !liao
integer :: id_difc_xy = -1, id_dif_xy = -1 ! mpoupon
integer :: id_advc_xy = -1, id_advc_x = -1, id_advc_y = -1
integer :: id_difc_xy = -1, id_dif_xy = -1
integer :: id_dfxy_cont = -1, id_dfxy_cont_2d = -1, id_dfxy_conc = -1
integer :: id_hbdxy_cont = -1, id_hbdxy_cont_2d = -1, id_hbdxy_conc = -1
integer :: id_remap_conc = -1, id_remap_cont = -1, id_remap_cont_2d = -1
Expand Down

0 comments on commit 0fb2043

Please sign in to comment.