Skip to content

Commit

Permalink
changes towards passing om4p5 jra55 regression tests. In absence of D…
Browse files Browse the repository at this point in the history 
…EM,MTS, or footloose, reset when grid to particle intepolations occur to the original convention. Only save footloose variables in restart files if footloose is active.
  • Loading branch information
@alex-huth
alex-huth committed Nov 21, 2022
1 parent 20cb345 commit 28a755d
Show file tree
Hide file tree
Showing 3 changed files with 67 additions and 28 deletions.
45 changes: 31 additions & 14 deletions src/icebergs.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2437,14 +2437,22 @@ subroutine accel(bergs, berg, i, j, xi, yj, lat, uvel, vvel, uvel0, vvel0, dt, r
grd=>bergs%grd

! Interpolate gridded fields to berg
!if (bergs%mts) then
!gridded fields already saved on berg
! !if (bergs%mts) then
! !gridded fields already saved on berg
! uo=berg%uo; vo=berg%vo; ua=berg%ua; va=berg%va; ui=berg%ui; vi=berg%vi;
! ssh_x=berg%ssh_x; ssh_y=berg%ssh_y; sst=berg%sst; sss=berg%sss; cn=berg%cn; hi=berg%hi; od=berg%od
! !else
! ! call interp_flds(grd, berg%lon, berg%lat, i, j, xi, yj, rx, ry, uo, vo, ui, vi, ua, va, ssh_x, &
! ! ssh_y, sst, sss, cn, hi, od)
! !end if

if (bergs%old_interp_flds_order) then
call interp_flds(grd, berg%lon, berg%lat, i, j, xi, yj, rx, ry, uo, vo, ui, vi, ua, va, ssh_x, &
ssh_y, sst, sss, cn, hi, od)
else
uo=berg%uo; vo=berg%vo; ua=berg%ua; va=berg%va; ui=berg%ui; vi=berg%vi;
ssh_x=berg%ssh_x; ssh_y=berg%ssh_y; sst=berg%sst; sss=berg%sss; cn=berg%cn; hi=berg%hi; od=berg%od
!else
! call interp_flds(grd, berg%lon, berg%lat, i, j, xi, yj, rx, ry, uo, vo, ui, vi, ua, va, ssh_x, &
! ssh_y, sst, sss, cn, hi, od)
!end if
end if

if ((grd%grid_is_latlon) .and. (.not. bergs%use_f_plane)) then
f_cori=(2.*omega)*sin(pi_180*lat)
Expand Down Expand Up @@ -3355,9 +3363,13 @@ subroutine thermodynamics(bergs)
this=>bergs%list(grdi,grdj)%first
do while(associated(this))
if (debug) call check_position(grd, this, 'thermodynamics (top)')
! call interp_flds(grd, this%lon, this%lat, this%ine, this%jne, this%xi, this%yj, 0., 0., &
! this%uo, this%vo, this%ui, this%vi, this%ua, this%va, this%ssh_x, &
! this%ssh_y, this%sst, this%sss,this%cn, this%hi)

if (bergs%old_interp_flds_order) then
call interp_flds(grd, this%lon, this%lat, this%ine, this%jne, this%xi, this%yj, 0., 0., &
this%uo, this%vo, this%ui, this%vi, this%ua, this%va, this%ssh_x, &
this%ssh_y, this%sst, this%sss,this%cn, this%hi)
end if

SST=this%sst
SSS=this%sss
IC=min(1.,this%cn+bergs%sicn_shift) ! Shift sea-ice concentration
Expand Down Expand Up @@ -6012,7 +6024,9 @@ subroutine icebergs_run(bergs, time, calving, uo, vo, ui, vi, tauxa, tauya, ssh,
if (mpp_pe()==0) write(*,'(a)') 'KID, iceberg_run: completed first visit initialization'
endif

if (.not. bergs%mts) call interp_gridded_fields_to_bergs(bergs)
!if (.not. bergs%mts) call interp_gridded_fields_to_bergs(bergs)
!call this for footloose
if ((.not. bergs%mts) .and. (.not. bergs%old_interp_flds_order)) call interp_gridded_fields_to_bergs(bergs)

! For each berg, evolve
call mpp_clock_begin(bergs%clock_mom)
Expand Down Expand Up @@ -6063,7 +6077,7 @@ subroutine icebergs_run(bergs, time, calving, uo, vo, ui, vi, tauxa, tauya, ssh,
call set_conglom_ids(bergs)
endif
endif
call interp_gridded_fields_to_bergs(bergs)
if (.not. bergs%old_interp_flds_order) call interp_gridded_fields_to_bergs(bergs)
endif
if (debug) call bergs_chksum(bergs, 'run bergs (exchanged)')
if (debug) call checksum_gridded(bergs%grd, 's/r run after exchange')
Expand Down Expand Up @@ -6976,9 +6990,12 @@ subroutine calve_icebergs(bergs)
call getRandomNumbers(rns, ry)
rx = 2.*rx - 1.; ry = 2.*ry - 1.
endif
call interp_flds(grd, newberg%lon, newberg%lat, i, j, xi, yj, rx, ry, newberg%uo, newberg%vo, newberg%ui, &
newberg%vi, newberg%ua, newberg%va, newberg%ssh_x, newberg%ssh_y, newberg%sst, newberg%sss, newberg%cn, &
newberg%hi, newberg%od)

if (.not. bergs%old_interp_flds_order) then
call interp_flds(grd, newberg%lon, newberg%lat, i, j, xi, yj, rx, ry, newberg%uo, newberg%vo, newberg%ui, &
newberg%vi, newberg%ua, newberg%va, newberg%ssh_x, newberg%ssh_y, newberg%sst, newberg%sss, newberg%cn, &
newberg%hi, newberg%od)
end if

call add_new_berg_to_list(bergs%list(i,j)%first, newberg)
calved_to_berg=initial_mass*mass_scaling ! Units of kg
Expand Down
6 changes: 6 additions & 0 deletions src/icebergs_framework.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -686,6 +686,9 @@ module ice_bergs_framework
real :: fl_bits_scale_l=0.9 !< For determining dimensions of FL bits berg; FL_bits length = fl_bits_scale_l * 3*l_b
real :: fl_bits_scale_w=0.9 !< For determining dimensions of FL bits berg; FL_bits width = fl_bits_scale_w * 3*l_b
real :: fl_bits_scale_t=0.9 !< For determining dimensions of FL bits berg; FL_bits thickness = fl_bits_scale_t * T

!backwards compatibility
logical :: old_interp_flds_order=.false. !< Use old order of when to interpolate grid variables to bergs. Will be false if MTS, DEM, or footloose (.not. fl_r>0)
end type icebergs

!> Read original restarts. Needs to be module global so can be public to icebergs_mod.
Expand Down Expand Up @@ -1625,6 +1628,9 @@ subroutine ice_bergs_framework_init(bergs, &
endif
endif

!backwards compatibility
if (.not. (bergs%mts .or. bergs%dem .or. bergs%fl_r>0.)) bergs%old_interp_flds_order=.true.

if (bergs%contact_distance>0) then
dx_dlon=1; dy_dlat=1
if (grd%grid_is_latlon) dy_dlat=pi_180*Rearth
Expand Down
44 changes: 30 additions & 14 deletions src/icebergs_io.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -221,15 +221,12 @@ subroutine write_restart(bergs, time_stamp)
allocate(thickness(nbergs))
allocate(width(nbergs))
allocate(length(nbergs))
allocate(fl_k(nbergs))
allocate(start_lon(nbergs))
allocate(start_lat(nbergs))
allocate(start_day(nbergs))
allocate(start_mass(nbergs))
allocate(mass_scaling(nbergs))
allocate(mass_of_bits(nbergs))
allocate(mass_of_fl_bits(nbergs))
allocate(mass_of_fl_bergy_bits(nbergs))
allocate(heat_density(nbergs))
allocate(static_berg(nbergs))

Expand All @@ -239,6 +236,12 @@ subroutine write_restart(bergs, time_stamp)
allocate(id_cnt(nbergs))
allocate(id_ij(nbergs))

if (bergs%fl_r>0) then
allocate(fl_k(nbergs))
allocate(mass_of_fl_bits(nbergs))
allocate(mass_of_fl_bergy_bits(nbergs))
end if

if (mts) then
allocate(axn_fast(nbergs))
allocate(ayn_fast(nbergs))
Expand Down Expand Up @@ -285,7 +288,6 @@ subroutine write_restart(bergs, time_stamp)
id = register_restart_field(bergs_restart,filename,'thickness',thickness,longname='thickness',units='m')
id = register_restart_field(bergs_restart,filename,'width',width,longname='width',units='m')
id = register_restart_field(bergs_restart,filename,'length',length,longname='length',units='m')
id = register_restart_field(bergs_restart,filename,'fl_k',fl_k,longname='footloose calving k',units='m')
id = register_restart_field(bergs_restart,filename,'start_lon',start_lon, &
longname='longitude of calving location',units='degrees_E')
id = register_restart_field(bergs_restart,filename,'start_lat',start_lat, &
Expand All @@ -304,13 +306,17 @@ subroutine write_restart(bergs, time_stamp)
longname='scaling factor for mass of calving berg',units='none')
id = register_restart_field(bergs_restart,filename,'mass_of_bits',mass_of_bits, &
longname='mass of bergy bits',units='kg')
id = register_restart_field(bergs_restart,filename,'mass_of_fl_bits',mass_of_fl_bits, &
longname='mass of footloose bits',units='kg')
id = register_restart_field(bergs_restart,filename,'mass_of_fl_bergy_bits',mass_of_fl_bergy_bits, &
longname='mass of bergy bits associated with footloose bits',units='kg')
id = register_restart_field(bergs_restart,filename,'heat_density',heat_density, &
longname='heat density',units='J/kg')

if (bergs%fl_r>0) then
id = register_restart_field(bergs_restart,filename,'fl_k',fl_k,longname='footloose calving k',units='m')
id = register_restart_field(bergs_restart,filename,'mass_of_fl_bits',mass_of_fl_bits, &
longname='mass of footloose bits',units='kg')
id = register_restart_field(bergs_restart,filename,'mass_of_fl_bergy_bits',mass_of_fl_bergy_bits, &
longname='mass of bergy bits associated with footloose bits',units='kg')
end if

if (mts) then
id = register_restart_field(bergs_restart,filename,'axn_fast',axn_fast,&
longname='sub-step explicit zonal acceleration',units='m/s^2')
Expand Down Expand Up @@ -370,14 +376,20 @@ subroutine write_restart(bergs, time_stamp)
axn(i) = this%axn; ayn(i) = this%ayn !Added by Alon
bxn(i) = this%bxn; byn(i) = this%byn !Added by Alon
width(i) = this%width; length(i) = this%length
fl_k(i) = this%fl_k
start_lon(i) = this%start_lon; start_lat(i) = this%start_lat
start_year(i) = this%start_year; start_day(i) = this%start_day
start_mass(i) = this%start_mass; mass_scaling(i) = this%mass_scaling
static_berg(i) = this%static_berg
call split_id(this%id, id_cnt(i), id_ij(i))
mass_of_bits(i) = this%mass_of_bits; mass_of_fl_bits(i) = this%mass_of_fl_bits
mass_of_fl_bergy_bits(i) = this%mass_of_fl_bergy_bits; heat_density(i) = this%heat_density
mass_of_bits(i) = this%mass_of_bits
heat_density(i) = this%heat_density

if (bergs%fl_r>0) then
fl_k(i) = this%fl_k
mass_of_fl_bits(i) = this%mass_of_fl_bits
mass_of_fl_bergy_bits(i) = this%mass_of_fl_bergy_bits
end if

if (mts) then
axn_fast(i) = this%axn_fast
ayn_fast(i) = this%ayn_fast
Expand Down Expand Up @@ -418,17 +430,21 @@ subroutine write_restart(bergs, time_stamp)
thickness, &
width, &
length, &
fl_k, &
start_lon, &
start_lat, &
start_day, &
start_mass, &
mass_scaling, &
mass_of_bits, &
mass_of_fl_bits, &
mass_of_fl_bergy_bits, &
static_berg, &
heat_density)

if (bergs%fl_r>0.) then
deallocate( &
fl_k, &
mass_of_fl_bits, &
mass_of_fl_bergy_bits)
end if
if (mts) then
deallocate( &
axn_fast, &
Expand Down

0 comments on commit 28a755d

Please sign in to comment.