Skip to content

Commit

Permalink
Merge pull request #1 from apcraig/fsdfixes_tc02
Browse files Browse the repository at this point in the history 
Update fsd
  • Loading branch information
@dabail10
dabail10 authored Oct 25, 2024
2 parents 07ded3b + 9a745f0 commit 5a703ba
Show file tree
Hide file tree
Showing 7 changed files with 130 additions and 114 deletions.
77 changes: 62 additions & 15 deletions columnphysics/icepack_fsd.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -90,11 +90,23 @@ module icepack_fsd
!
! authors: Lettie Roach, NIWA/VUW and C. M. Bitz, UW

subroutine icepack_init_fsd_bounds( write_diags ) ! flag for writing diagnostics
subroutine icepack_init_fsd_bounds( &
floe_rad_l_out, & ! fsd size lower bound in m (radius)
floe_rad_c_out, & ! fsd size bin centre in m (radius)
floe_binwidth_out, & ! fsd size bin width in m (radius)
c_fsd_range_out, & ! string for history output
write_diags) ! flag for writing diagnostics

real(kind=dbl_kind), dimension(:), intent(out), optional :: &
floe_rad_l_out, & ! fsd size lower bound in m (radius)
floe_rad_c_out, & ! fsd size bin centre in m (radius)
floe_binwidth_out ! fsd size bin width in m (radius)

character (len=35), dimension(:), intent(out), optional :: &
c_fsd_range_out ! string for history output

logical (kind=log_kind), intent(in), optional :: &
write_diags ! write diags flag
write_diags ! write diags flag

!autodocument_end

Expand Down Expand Up @@ -216,20 +228,56 @@ subroutine icepack_init_fsd_bounds( write_diags ) ! flag for writing diagnostic
enddo

if (present(write_diags)) then
if (write_diags) then
write(warnstr,*) ' '
call icepack_warnings_add(warnstr)
write(warnstr,*) subname
call icepack_warnings_add(warnstr)
write(warnstr,*) 'floe_rad(n-1) < fsd Cat n < floe_rad(n)'
call icepack_warnings_add(warnstr)
do n = 1, nfsd
write(warnstr,*) floe_rad(n-1),' < fsd Cat ',n, ' < ',floe_rad(n)
if (write_diags) then
write(warnstr,*) ' '
call icepack_warnings_add(warnstr)
enddo
write(warnstr,*) ' '
call icepack_warnings_add(warnstr)
write(warnstr,*) subname
call icepack_warnings_add(warnstr)
write(warnstr,*) 'floe_rad(n-1) < fsd Cat n < floe_rad(n)'
call icepack_warnings_add(warnstr)
do n = 1, nfsd
write(warnstr,*) floe_rad(n-1),' < fsd Cat ',n, ' < ',floe_rad(n)
call icepack_warnings_add(warnstr)
enddo
write(warnstr,*) ' '
call icepack_warnings_add(warnstr)
endif
endif

if (present(floe_rad_l_out)) then
if (size(floe_rad_l_out) /= size(floe_rad_l)) then
call icepack_warnings_add(subname//' floe_rad_l_out incorrect size')
call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
return
endif
floe_rad_l_out(:) = floe_rad_l(:)
endif

if (present(floe_rad_c_out)) then
if (size(floe_rad_c_out) /= size(floe_rad_c)) then
call icepack_warnings_add(subname//' floe_rad_c_out incorrect size')
call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
return
endif
floe_rad_c_out(:) = floe_rad_c(:)
endif

if (present(floe_binwidth_out)) then
if (size(floe_binwidth_out) /= size(floe_binwidth)) then
call icepack_warnings_add(subname//' floe_binwidth_out incorrect size')
call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
return
endif
floe_binwidth_out(:) = floe_binwidth(:)
endif

if (present(c_fsd_range_out)) then
if (size(c_fsd_range_out) /= size(c_fsd_range)) then
call icepack_warnings_add(subname//' c_fsd_range_out incorrect size')
call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
return
endif
c_fsd_range_out(:) = c_fsd_range(:)
endif

end subroutine icepack_init_fsd_bounds
Expand Down Expand Up @@ -312,7 +360,6 @@ subroutine icepack_cleanup_fsd (afsdn)

character(len=*), parameter :: subname='(icepack_cleanup_fsd)'


if (tr_fsd) then

do n = 1, ncat
Expand Down
78 changes: 36 additions & 42 deletions columnphysics/icepack_therm_vertical.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -624,40 +624,40 @@ subroutine frzmlt_bottom_lateral (dt, &

if (tr_fsd) then ! alter rsiden now since floes are not of size floediam

do n = 1, ncat

G_radialn(n) = -wlat_loc ! negative
do n = 1, ncat
G_radialn(n) = -wlat_loc ! negative

if (any(afsdn(:,n) < c0)) then
write(warnstr,*) subname, 'lateral_melt B afsd < 0 ',n
call icepack_warnings_add(warnstr)
endif
! afsdn present check up the calling tree
if (any(afsdn(:,n) < c0)) then
write(warnstr,*) subname, 'lateral_melt B afsd < 0 ',n
call icepack_warnings_add(warnstr)
endif

bin1_arealoss = -afsdn(1,n) / floe_binwidth(1) ! when scaled by *G_radialn(n)*dt*aicen(n)
bin1_arealoss = -afsdn(1,n) / floe_binwidth(1) ! when scaled by *G_radialn(n)*dt*aicen(n)

delta_an(n) = c0
do k = 1, nfsd
! this is delta_an(n) when scaled by *G_radialn(n)*dt*aicen(n)
delta_an(n) = delta_an(n) + ((c2/floe_rad_c(k)) * afsdn(k,n)) ! delta_an < 0
end do
delta_an(n) = c0
do k = 1, nfsd
! this is delta_an(n) when scaled by *G_radialn(n)*dt*aicen(n)
delta_an(n) = delta_an(n) + ((c2/floe_rad_c(k)) * afsdn(k,n)) ! delta_an < 0
end do

! add negative area loss from fsd
delta_an(n) = (delta_an(n) - bin1_arealoss)*G_radialn(n)*dt
! add negative area loss from fsd
delta_an(n) = (delta_an(n) - bin1_arealoss)*G_radialn(n)*dt

if (delta_an(n) > c0) then
write(warnstr,*) subname, 'ERROR delta_an > 0 ',delta_an(n)
call icepack_warnings_add(warnstr)
endif
if (delta_an(n) > c0) then
write(warnstr,*) subname, 'ERROR delta_an > 0 ',delta_an(n)
call icepack_warnings_add(warnstr)
endif

! following original code, not necessary for fsd
if (aicen(n) > c0) rsiden(n) = MIN(-delta_an(n),c1)
! following original code, not necessary for fsd
if (aicen(n) > c0) rsiden(n) = MIN(-delta_an(n),c1)

if (rsiden(n) < c0) then
write(warnstr,*) subname, 'ERROR rsiden < 0 ',rsiden(n)
call icepack_warnings_add(warnstr)
endif
if (rsiden(n) < c0) then
write(warnstr,*) subname, 'ERROR rsiden < 0 ',rsiden(n)
call icepack_warnings_add(warnstr)
endif
enddo ! ncat

enddo ! ncat
endif ! if tr_fsd

!-----------------------------------------------------------------
Expand Down Expand Up @@ -2439,9 +2439,6 @@ subroutine icepack_step_therm1(dt, &
real (kind=dbl_kind), dimension(ncat) :: &
l_meltsliqn ! mass of snow melt local (kg/m^2)

real (kind=dbl_kind), dimension(:,:), allocatable :: &
l_afsdn ! (kg/m^2)

real (kind=dbl_kind) :: &
l_fswthrun_vdr, & ! vis dir SW local n ice to ocean (W/m^2)
l_fswthrun_vdf, & ! vis dif SW local n ice to ocean (W/m^2)
Expand Down Expand Up @@ -2492,7 +2489,12 @@ subroutine icepack_step_therm1(dt, &
endif
if (tr_fsd) then
if (.not.present(afsdn)) then
call icepack_warnings_add(subname//' error in fsd arguments, tr_fsd=T')
call icepack_warnings_add(subname//' error missing afsdn argument, tr_fsd=T')
call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
return
endif
if (size(afsdn,dim=1) /= nfsd .or. size(afsdn,dim=2) /= ncat) then
call icepack_warnings_add(subname//' error size of afsdn argument, tr_fsd=T')
call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
return
endif
Expand All @@ -2510,14 +2512,6 @@ subroutine icepack_step_therm1(dt, &
l_meltsliq = c0
l_meltsliqn = c0

if (tr_fsd) then
allocate(l_afsdn(nfsd,ncat))
l_afsdn(:,:) = afsdn(:,:)
else
allocate(l_afsdn(1,1))
l_afsdn = c0
endif

! solid and liquid components of snow mass
massicen(:,:) = c0
massliqn(:,:) = c0
Expand Down Expand Up @@ -2584,10 +2578,10 @@ subroutine icepack_step_therm1(dt, &
ustar_min, &
fbot_xfer_type, &
strocnxT, strocnyT, &
Tbot, fbot, &
rsiden, Cdn_ocn, &
wlat, aicen, &
afsdn = l_afsdn)
Tbot, fbot, &
rsiden, Cdn_ocn, &
wlat, aicen, &
afsdn)

if (icepack_warnings_aborted(subname)) return

Expand Down
1 change: 0 additions & 1 deletion columnphysics/icepack_wavefracspec.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,6 @@
module icepack_wavefracspec

use icepack_kinds

use icepack_parameters, only: p01, p5, c0, c1, c2, c3, c4, c10
use icepack_parameters, only: bignum, puny, gravit, pi
use icepack_tracers, only: nt_fsd, ncat, nfsd
Expand Down
4 changes: 2 additions & 2 deletions configuration/driver/icedrv_InitMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ module icedrv_InitMod

subroutine icedrv_initialize

use icedrv_arrays_column, only: hin_max, c_hi_range
use icedrv_arrays_column, only: hin_max, c_hi_range, floe_rad_c
use icedrv_calendar, only: dt, time, istep, istep1, &
init_calendar, calendar
use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist
Expand Down Expand Up @@ -96,7 +96,7 @@ subroutine icedrv_initialize
endif

if (tr_fsd) then
call icepack_init_fsd_bounds( write_diags=.true. )
call icepack_init_fsd_bounds(floe_rad_c_out=floe_rad_c, write_diags=.true. )
call icepack_warnings_flush(nu_diag)
if (icepack_warnings_aborted(subname)) then
call icedrv_system_abort(file=__FILE__,line=__LINE__)
Expand Down
17 changes: 5 additions & 12 deletions configuration/driver/icedrv_arrays_column.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -221,29 +221,22 @@ module icedrv_arrays_column

! floe size distribution
real(kind=dbl_kind), dimension(nfsd), public :: &
floe_rad_l, & ! fsd size lower bound in m (radius)
floe_rad_c, & ! fsd size bin centre in m (radius)
floe_binwidth ! fsd size bin width in m (radius)
floe_rad_c ! fsd size bin centre in m (radius)

real (kind=dbl_kind), dimension (nx), public :: &
wave_sig_ht ! significant height of waves (m)
wave_sig_ht ! significant height of waves (m)

real (kind=dbl_kind), dimension (nfreq), public :: &
wavefreq, & ! wave frequencies
dwavefreq ! wave frequency bin widths
wavefreq, & ! wave frequencies
dwavefreq ! wave frequency bin widths

real (kind=dbl_kind), dimension (nx,nfreq), public :: &
wave_spectrum ! wave spectrum
wave_spectrum ! wave spectrum

real (kind=dbl_kind), dimension (nx,nfsd), public :: &
! change in floe size distribution due to processes
d_afsd_newi, d_afsd_latg, d_afsd_latm, d_afsd_wave, d_afsd_weld

character (len=35), public, dimension(nfsd) :: &
c_fsd_range ! fsd floe_rad bounds (m)



!=======================================================================

end module icedrv_arrays_column
Expand Down
1 change: 0 additions & 1 deletion configuration/driver/icedrv_init.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1296,7 +1296,6 @@ subroutine set_state_var (nx, &

use icedrv_arrays_column, only: hin_max
use icedrv_domain_size, only: nilyr, nslyr, max_ntrcr, ncat, nfsd
use icepack_fsd, only: floe_rad_c, floe_binwidth

integer (kind=int_kind), intent(in) :: &
nx ! number of grid cells
Expand Down
Loading

0 comments on commit 5a703ba

Please sign in to comment.