Skip to content

Commit

Permalink
Merge 3a095a7 into 615e57f
Browse files Browse the repository at this point in the history
  • Loading branch information
@Hallberg-NOAA
Hallberg-NOAA authored Oct 30, 2023
2 parents 615e57f + 3a095a7 commit 9848963
Show file tree
Hide file tree
Showing 3 changed files with 5 additions and 144 deletions.
111 changes: 3 additions & 108 deletions src/ALE/MOM_regridding.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -855,9 +855,6 @@ subroutine regridding_main( remapCS, CS, G, GV, US, h, tv, h_new, dzInterface, &
case ( REGRIDDING_RHO )
call build_rho_grid( G, GV, G%US, h, nom_depth_H, tv, dzInterface, remapCS, CS, frac_shelf_h )
call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new)
case ( REGRIDDING_ARBITRARY )
call build_grid_arbitrary( G, GV, h, nom_depth_H, dzInterface, trickGnuCompiler, CS )
call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new)
case ( REGRIDDING_HYCOM1 )
call build_grid_HyCOM1( G, GV, G%US, h, nom_depth_H, tv, h_new, dzInterface, remapCS, CS, &
frac_shelf_h, zScale=Z_to_H )
Expand All @@ -868,6 +865,9 @@ subroutine regridding_main( remapCS, CS, G, GV, US, h, tv, h_new, dzInterface, &
call build_grid_adaptive(G, GV, G%US, h, nom_depth_H, tv, dzInterface, remapCS, CS)
call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new)

case ( REGRIDDING_ARBITRARY )
call MOM_error(FATAL,'MOM_regridding, regridding_main: '//&
'Regridding mode "ARB" is not implemented.')

Check warning on line 870 in src/ALE/MOM_regridding.F90

View check run for this annotation

Codecov / codecov/patch

src/ALE/MOM_regridding.F90#L870 

Added line #L870 was not covered by tests
case default
call MOM_error(FATAL,'MOM_regridding, regridding_main: '//&
'Unknown regridding scheme selected!')
Expand Down Expand Up @@ -1762,111 +1762,6 @@ subroutine adjust_interface_motion( CS, nk, h_old, dz_int )

end subroutine adjust_interface_motion

!------------------------------------------------------------------------------
! Build arbitrary grid
!------------------------------------------------------------------------------
subroutine build_grid_arbitrary( G, GV, h, nom_depth_H, dzInterface, h_new, CS )
!------------------------------------------------------------------------------
! This routine builds a grid based on arbitrary rules
!------------------------------------------------------------------------------

! Arguments
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Original layer thicknesses [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: nom_depth_H !< The bathymetric depth of this column
!! relative to mean sea level or another locally
!! valid reference height, converted to thickness
!! units [H ~> m or kg m-2]
type(regridding_CS), intent(in) :: CS !< Regridding control structure
real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in interface
!! depth [H ~> m or kg m-2]
real, intent(inout) :: h_new !< New layer thicknesses [H ~> m or kg m-2]

! Local variables
integer :: i, j, k
integer :: nz
real :: z_inter(SZK_(GV)+1)
real :: total_height
real :: delta_h
real :: max_depth
real :: eta ! local elevation [H ~> m or kg m-2]
real :: local_depth ! The local ocean depth relative to mean sea level in thickness units [H ~> m or kg m-2]
real :: x1, y1, x2, y2
real :: x, t

nz = GV%ke
max_depth = G%max_depth*GV%Z_to_H

do j = G%jsc-1,G%jec+1
do i = G%isc-1,G%iec+1

! Local depth
local_depth = nom_depth_H(i,j)

! Determine water column height
total_height = 0.0
do k = 1,nz
total_height = total_height + h(i,j,k)
enddo

eta = total_height - local_depth

! Compute new thicknesses based on stretched water column
delta_h = (max_depth + eta) / nz

! Define interfaces
z_inter(1) = eta
do k = 1,nz
z_inter(k+1) = z_inter(k) - delta_h
enddo

! Refine grid in the middle
do k = 1,nz+1
x1 = 0.35; y1 = 0.45; x2 = 0.65; y2 = 0.55

x = - ( z_inter(k) - eta ) / max_depth

if ( x <= x1 ) then
t = y1*x/x1
elseif ( (x > x1 ) .and. ( x < x2 )) then
t = y1 + (y2-y1) * (x-x1) / (x2-x1)
else
t = y2 + (1.0-y2) * (x-x2) / (1.0-x2)
endif

z_inter(k) = -t * max_depth + eta

enddo

! Modify interface heights to account for topography
z_inter(nz+1) = - local_depth

! Modify interface heights to avoid layers of zero thicknesses
do k = nz,1,-1
if ( z_inter(k) < (z_inter(k+1) + CS%min_thickness) ) then
z_inter(k) = z_inter(k+1) + CS%min_thickness
endif
enddo

! Change in interface position
x = 0. ! Left boundary at x=0
dzInterface(i,j,1) = 0.
do k = 2,nz
x = x + h(i,j,k)
dzInterface(i,j,k) = z_inter(k) - x
enddo
dzInterface(i,j,nz+1) = 0.

enddo
enddo

stop 'OOOOOOPS' ! For some reason the gnu compiler will not let me delete this
! routine????

end subroutine build_grid_arbitrary



!------------------------------------------------------------------------------
! Check grid integrity
Expand Down
2 changes: 1 addition & 1 deletion src/core/MOM.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -89,7 +89,7 @@ module MOM
use MOM_forcing_type, only : copy_common_forcing_fields, set_derived_forcing_fields
use MOM_forcing_type, only : homogenize_forcing, homogenize_mech_forcing
use MOM_grid, only : ocean_grid_type, MOM_grid_init, MOM_grid_end
use MOM_grid, only : set_first_direction, rescale_grid_bathymetry
use MOM_grid, only : set_first_direction
use MOM_hor_index, only : hor_index_type, hor_index_init
use MOM_hor_index, only : rotate_hor_index
use MOM_interface_heights, only : find_eta, calc_derived_thermo, thickness_to_dz
Expand Down
36 changes: 1 addition & 35 deletions src/core/MOM_grid.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ module MOM_grid
#include <MOM_memory.h>

public MOM_grid_init, MOM_grid_end, set_derived_metrics, set_first_direction
public isPointInCell, hor_index_type, get_global_grid_size, rescale_grid_bathymetry
public isPointInCell, hor_index_type, get_global_grid_size

! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
Expand Down Expand Up @@ -400,40 +400,6 @@ subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_v

end subroutine MOM_grid_init

!> rescale_grid_bathymetry permits a change in the internal units for the bathymetry on the grid,
!! both rescaling the depths and recording the new internal units.
subroutine rescale_grid_bathymetry(G, m_in_new_units)
type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure
real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth.
!### It appears that this routine is never called.

! Local variables
real :: rescale ! A unit rescaling factor [various combinations of units ~> 1]
integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB

isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB

if (m_in_new_units == 1.0) return
if (m_in_new_units < 0.0) &
call MOM_error(FATAL, "rescale_grid_bathymetry: Negative depth units are not permitted.")
if (m_in_new_units == 0.0) &
call MOM_error(FATAL, "rescale_grid_bathymetry: Zero depth units are not permitted.")

rescale = 1.0 / m_in_new_units
do j=jsd,jed ; do i=isd,ied
G%bathyT(i,j) = rescale*G%bathyT(i,j)
enddo ; enddo
if (G%bathymetry_at_vel) then ; do j=jsd,jed ; do I=IsdB,IedB
G%Dblock_u(I,j) = rescale*G%Dblock_u(I,j) ; G%Dopen_u(I,j) = rescale*G%Dopen_u(I,j)
enddo ; enddo ; endif
if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied
G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J)
enddo ; enddo ; endif
G%max_depth = rescale*G%max_depth

end subroutine rescale_grid_bathymetry

!> set_derived_metrics calculates metric terms that are derived from other metrics.
subroutine set_derived_metrics(G, US)
type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure
Expand Down

0 comments on commit 9848963

Please sign in to comment.