Skip to content

Commit

Permalink
Requested changes after review. Only changed in seabed stress and not…
Browse files Browse the repository at this point in the history
… bit for bit if cor=0.0
  • Loading branch information
TillRasmussen committed Feb 21, 2022
1 parent c833f90 commit 4ba345a
Show file tree
Hide file tree
Showing 2 changed files with 19 additions and 13 deletions.
20 changes: 10 additions & 10 deletions cicecore/cicedynB/dynamics/ice_dyn_evp.F90
Original file line number Diff line number Diff line change
Expand Up @@ -483,16 +483,16 @@ subroutine evp (dt)
! on last subcycle, save quantities for mechanical redistribution
!-----------------------------------------------------------------

call deformations (nx_block , ny_block , &
icellt(iblk) , &
indxti(:,iblk) , indxtj(:,iblk) , &
uvel(:,:,iblk) , vvel(:,:,iblk) , &
dxt(:,:,iblk) , dyt(:,:,iblk) , &
cxp(:,:,iblk) , cyp(:,:,iblk) , &
cxm(:,:,iblk) , cym(:,:,iblk) , &
tarear(:,:,iblk) , &
shear(:,:,iblk) , divu(:,:,iblk) , &
rdg_conv(:,:,iblk) , rdg_shear(:,:,iblk) )
call deformations (nx_block , ny_block , &
icellt(iblk) , &
indxti(:,iblk) , indxtj(:,iblk) , &
uvel(:,:,iblk) , vvel(:,:,iblk) , &
dxt(:,:,iblk) , dyt(:,:,iblk) , &
cxp(:,:,iblk) , cyp(:,:,iblk) , &
cxm(:,:,iblk) , cym(:,:,iblk) , &
tarear(:,:,iblk) , &
shear(:,:,iblk) , divu(:,:,iblk) , &
rdg_conv(:,:,iblk), rdg_shear(:,:,iblk) )


!-----------------------------------------------------------------
Expand Down
12 changes: 9 additions & 3 deletions cicecore/cicedynB/dynamics/ice_dyn_shared.F90
Original file line number Diff line number Diff line change
Expand Up @@ -176,7 +176,7 @@ subroutine init_dyn (dt)
if (trim(coriolis) == 'constant') then
fcor_blk(i,j,iblk) = 1.46e-4_dbl_kind ! Hibler 1979, N. Hem; 1/s
else if (trim(coriolis) == 'zero') then
fcor_blk(i,j,iblk) = 0.0
fcor_blk(i,j,iblk) = c0
else
fcor_blk(i,j,iblk) = c2*omega*sin(ULAT(i,j,iblk)) ! 1/s
endif
Expand Down Expand Up @@ -906,7 +906,9 @@ subroutine seabed_stress_factor_LKD (nx_block, ny_block, &
hwu = min(hwater(i,j),hwater(i+1,j),hwater(i,j+1),hwater(i+1,j+1))

! if (hwu < threshold_hw) then
docalc_tbu = max(sign(c1,threshold_hw-hwu),c0)
! docalc_tbu = max(sign(c1,threshold_hw-hwu),c0)
docalc_tbu = merge(c1,c0,hwu < threshold_hw)


au = max(aice(i,j),aice(i+1,j),aice(i,j+1),aice(i+1,j+1))
hu = max(vice(i,j),vice(i+1,j),vice(i,j+1),vice(i+1,j+1))
Expand Down Expand Up @@ -1395,7 +1397,8 @@ subroutine viscous_coeffs_and_rep_pressure (strength, tinyarea, &
tmpcalcne, tmpcalcnw, tmpcalcsw, tmpcalcse

! NOTE: for comp. efficiency 2 x zeta and 2 x eta are used in the code


! if (trim(yield_curve) == 'ellipse') then
tmpcalcne = capping *(strength/max(Deltane, tinyarea))+ &
(c1-capping)* strength/ (Deltane+ tinyarea)
tmpcalcnw = capping *(strength/max(Deltanw, tinyarea))+ &
Expand All @@ -1420,6 +1423,9 @@ subroutine viscous_coeffs_and_rep_pressure (strength, tinyarea, &
zetax2se = (c1+Ktens)*tmpcalcse ! southeast
rep_prsse = (c1-Ktens)*tmpcalcse*Deltase
etax2se = epp2i*zetax2se
! else

! endif

end subroutine viscous_coeffs_and_rep_pressure

Expand Down

0 comments on commit 4ba345a

Please sign in to comment.