Skip to content

Commit

Permalink
+(*)Corrected halo data when VERTEX_SHEAR=True
Browse files Browse the repository at this point in the history 
  Added code to work on extra points or do appropriate halo updates for those
calls that modify temperatures, salinities and thicknesses before the call to
set_diffusivity in both diabatic and legacy_diabatic.  All answers are bitwise
identical in the existing MOM6 test cases, but this corrects a problem with
answers that do not reproduce across PE layouts when VERTEX_SHEAR=True.
  • Loading branch information
@Hallberg-NOAA
Hallberg-NOAA committed Sep 10, 2018
1 parent 1cc8d72 commit 9ede9b6
Showing 1 changed file with 22 additions and 14 deletions.
36 changes: 22 additions & 14 deletions src/parameterizations/vertical/MOM_diabatic_driver.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -154,7 +154,8 @@ module MOM_diabatic_driver
!! fluxes are applied, in m.
real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be
!! evaporated in one time-step (non-dim).

integer :: halo_TS_diff = 0 !< The temperature, salinity and thickness halo size that
!! must be valid for the diffusivity calculations.
logical :: useKPP = .false. !< use CVMix/KPP diffusivities and non-local transport
logical :: salt_reject_below_ML !< If true, add salt below mixed layer (layer mode only)
logical :: KPPisPassive !< If true, KPP is in passive mode, not changing answers.
Expand Down Expand Up @@ -379,7 +380,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth
integer :: dir_flag ! An integer encoding the directions in which to do halo updates.
logical :: showCallTree ! If true, show the call tree
integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m
integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo

integer :: ig, jg ! global indices for testing testing itide point source (BDM)
logical :: avg_enabled ! for testing internal tides (BDM)
Expand Down Expand Up @@ -447,9 +448,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
endif

if (associated(fluxes%p_surf_full)) then
call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full)
call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff)
else
call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp)
call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff)
endif
if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)")

Expand All @@ -465,15 +466,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G)

if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then
!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml)
do k=1,nz ; do j=js,je ; do i=is,ie
halo = CS%halo_TS_diff
!$OMP parallel do default(shared)
do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo
h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0
enddo ; enddo ; enddo
endif

if (CS%use_geothermal) then
call cpu_clock_begin(id_clock_geothermal)
call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp)
call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff)
call cpu_clock_end(id_clock_geothermal)
if (showCallTree) call callTree_waypoint("geothermal (diabatic)")
if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G)
Expand Down Expand Up @@ -1258,7 +1260,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth
integer :: dir_flag ! An integer encoding the directions in which to do halo updates.
logical :: showCallTree ! If true, show the call tree
integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m
integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo

integer :: ig, jg ! global indices for testing testing itide point source (BDM)
logical :: avg_enabled ! for testing internal tides (BDM)
Expand Down Expand Up @@ -1323,9 +1325,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
endif

if (associated(fluxes%p_surf_full)) then
call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full)
call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff)
else
call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp)
call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff)
endif
if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)")

Expand All @@ -1340,15 +1342,16 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G)

if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then
!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml)
do k=1,nz ; do j=js,je ; do i=is,ie
halo = CS%halo_TS_diff
!$OMP parallel do default(shared)
do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo
h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0
enddo ; enddo ; enddo
endif

if (CS%use_geothermal) then
call cpu_clock_begin(id_clock_geothermal)
call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp)
call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff)
call cpu_clock_end(id_clock_geothermal)
if (showCallTree) call callTree_waypoint("geothermal (diabatic)")
if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G)
Expand Down Expand Up @@ -1478,6 +1481,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en
! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S
! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ????
! And sets visc%Kv_shear
if ((CS%halo_TS_diff > 0) .and. (CS%ML_mix_first > 0.0)) then
if (associated(tv%T)) call pass_var(tv%T, G%Domain, halo=CS%halo_TS_diff, complete=.false.)
if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.)
call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.)
endif
call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, Kd_int)
call cpu_clock_end(id_clock_set_diffusivity)
if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)")
Expand Down Expand Up @@ -3277,7 +3285,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag,

! initialize module for setting diffusivities
call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, &
CS%int_tide_CSp, CS%tidal_mixing_CSp)
CS%int_tide_CSp, CS%tidal_mixing_CSp, CS%halo_TS_diff)


! set up the clocks for this module
Expand Down

0 comments on commit 9ede9b6

Please sign in to comment.