-
Notifications
You must be signed in to change notification settings - Fork 42
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Added a new module, slab_ice, for the ancient sea-ice code from the Manabe model, including the subroutines slab_ice_transport and slab_ice_dynamics. All answers are bitwise identical.
- Loading branch information
1 parent
6c6df59
commit 90a4cb7
Showing
1 changed file
with
114 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,114 @@ | ||
!> Does the transport and redistribution between thickness categories for the SIS2 sea ice model. | ||
module slab_ice | ||
|
||
! This file is a part of SIS2. See LICENSE.md for the licnese. | ||
|
||
! use MOM_coms, only : reproducing_sum, EFP_type, EFP_to_real, EFP_real_diff | ||
use MOM_domains, only : pass_var, pass_vector, BGRID_NE, CGRID_NE | ||
use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING | ||
use MOM_error_handler, only : SIS_mesg=>MOM_mesg, is_root_pe | ||
! use MOM_file_parser, only : get_param, log_param, read_param, log_version, param_file_type | ||
use MOM_hor_index, only : hor_index_type | ||
use MOM_obsolete_params, only : obsolete_logical, obsolete_real | ||
! use SIS_diag_mediator, only : post_SIS_data, query_SIS_averaging_enabled, SIS_diag_ctrl | ||
! use SIS_diag_mediator, only : register_diag_field=>register_SIS_diag_field, time_type | ||
! use SIS_diag_mediator, only : safe_alloc_alloc | ||
use SIS_hor_grid, only : SIS_hor_grid_type | ||
use ice_grid, only : ice_grid_type | ||
|
||
implicit none ; private | ||
|
||
#include <SIS2_memory.h> | ||
|
||
public :: slab_ice_advect, slab_ice_dynamics | ||
|
||
contains | ||
|
||
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! | ||
!> Advect an ice tracer or the thickness using a very old slab-ice algorithm | ||
!! dating back to the Manabe model. | ||
subroutine slab_ice_advect(uc, vc, trc, stop_lim, dt_slow, G, part_sz, nsteps) | ||
type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type | ||
real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: uc !< x-face advecting velocity in m s-1 | ||
real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: vc !< y-face advecting velocity in m s-1 | ||
real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: trc !< Depth integrated amount of the tracer to | ||
!! advect, in m kg kg-1 or other units, or the | ||
!! total ice mass in m or kg m-2. | ||
real, intent(in ) :: stop_lim !< A tracer amount below which to | ||
!! stop advection, in the same units as tr | ||
real, intent(in ) :: dt_slow !< The time covered by this call, in s. | ||
real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: part_sz !< A part size that is set based on | ||
!! whether trc (which may be mass) exceeds 0. | ||
integer, optional, intent(in ) :: nsteps !< The number of advective substeps. | ||
|
||
! Local variables | ||
real, dimension(SZIB_(G),SZJ_(G)) :: uflx | ||
real, dimension(SZI_(G),SZJB_(G)) :: vflx | ||
real :: avg, dif | ||
real :: dt_adv | ||
integer :: i, j, n, isc, iec, jsc, jec, n_substeps | ||
isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec | ||
|
||
n_substeps = 1 ; if (present(nsteps)) n_substeps = nsteps | ||
if (n_substeps==0) return | ||
dt_adv = dt_slow / n_substeps | ||
|
||
do n=1,n_substeps | ||
do j=jsc,jec ; do I=isc-1,iec | ||
avg = 0.5*( trc(i,j) + trc(i+1,j) ) | ||
dif = trc(i+1,j) - trc(i,j) | ||
if ( avg > stop_lim .and. uc(I,j) * dif > 0.0) then | ||
uflx(I,j) = 0.0 | ||
elseif ( uc(i,j) > 0.0 ) then | ||
uflx(I,j) = uc(I,j) * trc(i,j) * G%dy_Cu(I,j) | ||
else | ||
uflx(I,j) = uc(I,j) * trc(i+1,j) * G%dy_Cu(I,j) | ||
endif | ||
enddo ; enddo | ||
|
||
do J=jsc-1,jec ; do i=isc,iec | ||
avg = 0.5*( trc(i,j) + trc(i,j+1) ) | ||
dif = trc(i,j+1) - trc(i,j) | ||
if (avg > stop_lim .and. vc(i,J) * dif > 0.0) then | ||
vflx(i,J) = 0.0 | ||
elseif ( vc(i,J) > 0.0 ) then | ||
vflx(i,J) = vc(i,J) * trc(i,j) * G%dx_Cv(i,J) | ||
else | ||
vflx(i,J) = vc(i,J) * trc(i,j+1) * G%dx_Cv(i,J) | ||
endif | ||
enddo ; enddo | ||
|
||
do j=jsc,jec ; do i=isc,iec | ||
trc(i,j) = trc(i,j) + dt_adv * ((uflx(I-1,j) - uflx(I,j)) + & | ||
(vflx(i,J-1) - vflx(i,J)) ) * G%IareaT(i,j) | ||
enddo ; enddo | ||
|
||
call pass_var(trc, G%Domain) | ||
enddo | ||
|
||
if (present(part_sz)) then ; do j=G%jsd,G%jed ; do i=G%isd,G%ied | ||
part_sz(i,j) = 0.0 ; if (trc(i,j) > 0.0) part_sz(i,j) = 1.0 | ||
enddo ; enddo ; endif | ||
|
||
end subroutine slab_ice_advect | ||
|
||
!> slab_ice_dynamics updates the B-grid ice velocities and ice-ocean stresses as in the | ||
!! very old slab-ice algorithm dating back to the Manabe model. This code works for either | ||
!! B-grid or C-grid discretiztions, but the velocity and stress variables must have consistent | ||
!! array sizes. | ||
subroutine slab_ice_dynamics(ui, vi, uo, vo, fxat, fyat, fxoc, fyoc) | ||
real, dimension(:,:), intent(inout) :: ui !< Zonal ice velocity in m s-1 | ||
real, dimension(:,:), intent(inout) :: vi !< Meridional ice velocity in m s-1 | ||
real, dimension(:,:), intent(in ) :: uo !< Zonal ocean velocity in m s-1 | ||
real, dimension(:,:), intent(in ) :: vo !< Meridional ocean velocity in m s-1 | ||
real, dimension(:,:), intent(in ) :: fxat !< Zonal air stress on ice in Pa | ||
real, dimension(:,:), intent(in ) :: fyat !< Meridional air stress on ice in Pa | ||
real, dimension(:,:), intent( out) :: fxoc !< Zonal ice stress on ocean in Pa | ||
real, dimension(:,:), intent( out) :: fyoc !< Meridional ice stress on ocean in Pa | ||
|
||
ui(:,:) = uo(:,:) ; vi(:,:) = vo(:,:) | ||
fxoc(:,:) = fxat(:,:) ; fyoc(:,:) = fyat(:,:) | ||
|
||
end subroutine slab_ice_dynamics | ||
|
||
end module slab_ice |