Skip to content

Commit

Permalink
Refactor horizontally_average_field
Browse files Browse the repository at this point in the history 
  Refactored the horizontally_average_field() routine in MOM_diag_remap to work
in rescaled units by making use of the unscale arguments to the
reproducing_sum() routines.  A total of 9 rescaling variables were moved into
unscale arguments.  All answers and diagnostics are bitwise identical, and no
interfaces are changed.
  • Loading branch information
@Hallberg-NOAA
Hallberg-NOAA committed Dec 12, 2024
1 parent a4d13e8 commit 8c8e218
Showing 1 changed file with 15 additions and 16 deletions.
31 changes: 15 additions & 16 deletions src/framework/MOM_diag_remap.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -820,9 +820,11 @@ subroutine horizontally_average_field(G, GV, isdf, jsdf, h, staggered_in_x, stag
logical, dimension(:), intent(out) :: averaged_mask !< Mask for horizontally averaged field [nondim]

! Local variables
real :: volume(G%isc:G%iec, G%jsc:G%jec, size(field,3)) ! The area [m2], volume [m3] or mass [kg] of each cell.
real :: volume(G%isc:G%iec, G%jsc:G%jec, size(field,3)) ! The area [L2 ~> m2], volume [L2 m ~> m3]
! or mass [L2 kg m-2 ~> kg] of each cell.
real :: stuff(G%isc:G%iec, G%jsc:G%jec, size(field,3)) ! The area, volume or mass-weighted integral of the
! field being averaged in each cell, in [m2 A], [m3 A] or [kg A],
! field being averaged in each cell, in [L2 a ~> m2 A],
! [L2 m a ~> m3 A] or [L2 kg m-2 A ~> kg A],
! depending on the weighting for the averages and whether the
! model makes the Boussinesq approximation.
real, dimension(size(field, 3)) :: vol_sum ! The global sum of the areas [m2], volumes [m3] or mass [kg]
Expand All @@ -847,22 +849,21 @@ subroutine horizontally_average_field(G, GV, isdf, jsdf, h, staggered_in_x, stag
stuff_sum(k) = 0.
if (is_extensive) then
do j=G%jsc, G%jec ; do I=G%isc, G%iec
volume(I,j,k) = (G%US%L_to_m**2 * G%areaCu(I,j)) * G%mask2dCu(I,j)
volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j)
stuff(I,j,k) = volume(I,j,k) * field(I,j,k)
enddo ; enddo
else ! Intensive
do j=G%jsc, G%jec ; do I=G%isc, G%iec
height = 0.5 * (h(i,j,k) + h(i+1,j,k))
volume(I,j,k) = (G%US%L_to_m**2 * G%areaCu(I,j)) &
* (GV%H_to_MKS * height) * G%mask2dCu(I,j)
volume(I,j,k) = G%areaCu(I,j) * (GV%H_to_MKS * height) * G%mask2dCu(I,j)
stuff(I,j,k) = volume(I,j,k) * field(I,j,k)
enddo ; enddo
endif
enddo
else ! Interface
do k=1,nz
do j=G%jsc, G%jec ; do I=G%isc, G%iec
volume(I,j,k) = (G%US%L_to_m**2 * G%areaCu(I,j)) * G%mask2dCu(I,j)
volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j)
stuff(I,j,k) = volume(I,j,k) * field(I,j,k)
enddo ; enddo
enddo
Expand All @@ -873,22 +874,21 @@ subroutine horizontally_average_field(G, GV, isdf, jsdf, h, staggered_in_x, stag
do k=1,nz
if (is_extensive) then
do J=G%jsc, G%jec ; do i=G%isc, G%iec
volume(i,J,k) = (G%US%L_to_m**2 * G%areaCv(i,J)) * G%mask2dCv(i,J)
volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J)
stuff(i,J,k) = volume(i,J,k) * field(i,J,k)
enddo ; enddo
else ! Intensive
do J=G%jsc, G%jec ; do i=G%isc, G%iec
height = 0.5 * (h(i,j,k) + h(i,j+1,k))
volume(i,J,k) = (G%US%L_to_m**2 * G%areaCv(i,J)) &
* (GV%H_to_MKS * height) * G%mask2dCv(i,J)
volume(i,J,k) = G%areaCv(i,J) * (GV%H_to_MKS * height) * G%mask2dCv(i,J)
stuff(i,J,k) = volume(i,J,k) * field(i,J,k)
enddo ; enddo
endif
enddo
else ! Interface
do k=1,nz
do J=G%jsc, G%jec ; do i=G%isc, G%iec
volume(i,J,k) = (G%US%L_to_m**2 * G%areaCv(i,J)) * G%mask2dCv(i,J)
volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J)
stuff(i,J,k) = volume(i,J,k) * field(i,J,k)
enddo ; enddo
enddo
Expand All @@ -900,7 +900,7 @@ subroutine horizontally_average_field(G, GV, isdf, jsdf, h, staggered_in_x, stag
if (is_extensive) then
do j=G%jsc, G%jec ; do i=G%isc, G%iec
if (h(i,j,k) > 0.) then
volume(i,j,k) = (G%US%L_to_m**2 * G%areaT(i,j)) * G%mask2dT(i,j)
volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j)
stuff(i,j,k) = volume(i,j,k) * field(i,j,k)
else
volume(i,j,k) = 0.
Expand All @@ -909,16 +909,15 @@ subroutine horizontally_average_field(G, GV, isdf, jsdf, h, staggered_in_x, stag
enddo ; enddo
else ! Intensive
do j=G%jsc, G%jec ; do i=G%isc, G%iec
volume(i,j,k) = (G%US%L_to_m**2 * G%areaT(i,j)) &
* (GV%H_to_MKS * h(i,j,k)) * G%mask2dT(i,j)
volume(i,j,k) = G%areaT(i,j) * (GV%H_to_MKS * h(i,j,k)) * G%mask2dT(i,j)
stuff(i,j,k) = volume(i,j,k) * field(i,j,k)
enddo ; enddo
endif
enddo
else ! Interface
do k=1,nz
do j=G%jsc, G%jec ; do i=G%isc, G%iec
volume(i,j,k) = (G%US%L_to_m**2 * G%areaT(i,j)) * G%mask2dT(i,j)
volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j)
stuff(i,j,k) = volume(i,j,k) * field(i,j,k)
enddo ; enddo
enddo
Expand All @@ -930,8 +929,8 @@ subroutine horizontally_average_field(G, GV, isdf, jsdf, h, staggered_in_x, stag
! Packing the sums into a single array with a single call to sum across PEs saves reduces
! the costs of communication.
do k=1,nz
sums_EFP(2*k-1) = reproducing_sum_EFP(volume(:,:,k), only_on_PE=.true.)
sums_EFP(2*k) = reproducing_sum_EFP(stuff(:,:,k), only_on_PE=.true.)
sums_EFP(2*k-1) = reproducing_sum_EFP(volume(:,:,k), only_on_PE=.true., unscale=G%US%L_to_m**2)
sums_EFP(2*k) = reproducing_sum_EFP(stuff(:,:,k), only_on_PE=.true., unscale=G%US%L_to_m**2)
enddo
call EFP_sum_across_PEs(sums_EFP, 2*nz)
do k=1,nz
Expand Down

0 comments on commit 8c8e218

Please sign in to comment.