Skip to content

Commit

Permalink
Ice calving added to runoff, #155
Browse files Browse the repository at this point in the history
  • Loading branch information
nichannah committed Mar 14, 2020
1 parent 0030662 commit 2ce6632
Show file tree
Hide file tree
Showing 3 changed files with 16 additions and 8 deletions.
5 changes: 1 addition & 4 deletions drivers/auscom/cpl_arrays_setup.F90
Original file line number Diff line number Diff line change
Expand Up @@ -85,14 +85,11 @@ module cpl_arrays_setup
tair0, swflx0, lwflx0, uwnd0, vwnd0, qair0, rain0, snow0 & !(for ice)
,runof0, press0, calv0 !(for ocn)

real(kind=dbl_kind), dimension(:,:,:), allocatable :: runof, press
real(kind=dbl_kind), dimension(:,:,:), allocatable :: runof, calv, press

! CORE runoff remapped onto the AusCOM grid
real(kind=dbl_kind), dimension(:,:,:), allocatable :: &
core_runoff
real(kind=dbl_kind), dimension(:,:,:), allocatable :: &
icecalve_runoff


real(kind=dbl_kind), dimension(:,:,:), allocatable :: & !from ocn
ssto, ssso, ssuo, ssvo, sslx, ssly, pfmice
Expand Down
9 changes: 8 additions & 1 deletion drivers/auscom/cpl_forcing_handler.F90
Original file line number Diff line number Diff line change
Expand Up @@ -325,6 +325,7 @@ subroutine newt_forcing_raw
fsnow(:,:,:) = snow0(:,:,:)
press(:,:,:) = press0(:,:,:)
runof(:,:,:) = runof0(:,:,:)
calv(:,:,:) = calv0(:,:,:)

! --- from ocean:
uocn(:,:,:) = ssuo(:,:,:)
Expand Down Expand Up @@ -385,6 +386,8 @@ subroutine save_time0_i2o_fields(fname, nstep)
!!!
if (jf == n_i2a+14 ) vwork = iomelt
if (jf == n_i2a+15 ) vwork = ioform
if (jf == n_i2a+16) vwork = iolicefw
if (jf == n_i2a+17) vwork = iolicefh

call gather_global(gwork, vwork, master_task, distrb_info)
if (my_task == 0) then
Expand Down Expand Up @@ -712,7 +715,9 @@ subroutine get_i2o_fluxes
tiolwflx(:,:,:) = tiolwflx(:,:,:) * (1. - aice(:,:,:))

!11)runoff: relocated onto coastal grid points (pre-processed by Steve Phipps)
tiorunof(:,:,:) = runof(:,:,:)
tiorunof(:,:,:) = runof(:,:,:) + calv(:,:,:)
tiolicefw(:,:,:) = 0.0
tiolicefh(:,:,:) = 0.0

!12)pressure
! if (my_task == 0) write(il_out,*)'size of pice, ',&
Expand Down Expand Up @@ -1101,6 +1106,8 @@ subroutine check_a2i_fields(ncfile,nstep)
if (my_task == 0) call write_nc2D(ncid, 'snow0', gwork, 2, nx_global,ny_global,currstep,ilout=il_out)
call gather_global(gwork, runof0, master_task, distrb_info)
if (my_task == 0) call write_nc2D(ncid, 'runof0', gwork, 2, nx_global,ny_global,currstep,ilout=il_out)
call gather_global(gwork, calv0, master_task, distrb_info)
if (my_task == 0) call write_nc2D(ncid, 'calv0', gwork, 2, nx_global,ny_global,currstep,ilout=il_out)
call gather_global(gwork, press0, master_task, distrb_info)
if (my_task == 0) call write_nc2D(ncid, 'press0', gwork, 2, nx_global,ny_global,currstep,ilout=il_out)

Expand Down
10 changes: 7 additions & 3 deletions drivers/auscom/cpl_interface.F90
Original file line number Diff line number Diff line change
Expand Up @@ -309,6 +309,7 @@ subroutine init_cpl(runtime_seconds, coupling_field_timesteps)
allocate (press0(nx_block, ny_block, max_blocks)); press0(:,:,:) = 0

allocate (runof(nx_block, ny_block, max_blocks)); runof(:,:,:) = 0
allocate (calv(nx_block, ny_block, max_blocks)); calv(:,:,:) = 0
allocate (press(nx_block, ny_block, max_blocks)); press(:,:,:) = 0

allocate (core_runoff(nx_block, ny_block, max_blocks)); core_runoff(:,:,:) = 0.
Expand Down Expand Up @@ -713,13 +714,13 @@ subroutine coupler_termination
!-------------------------------!

deallocate (tair0, swflx0, lwflx0, uwnd0, vwnd0, qair0, rain0, snow0, runof0, press0)
deallocate (runof, press)
deallocate (runof, calv, press)
deallocate (core_runoff)
deallocate (ssto, ssso, ssuo, ssvo, sslx, ssly, pfmice)
deallocate (iostrsu, iostrsv, iorain, iosnow, iostflx, iohtflx, ioswflx, &
ioqflux, iolwflx, ioshflx, iorunof, iopress)
ioqflux, iolwflx, ioshflx, iorunof, iolicefw, iolicefh, iopress)
deallocate (tiostrsu, tiostrsv, tiorain, tiosnow, tiostflx, tiohtflx, tioswflx, &
tioqflux, tiolwflx, tioshflx, tiorunof, tiopress)
tioqflux, tiolwflx, tioshflx, tiorunof, tiolicefw, tiolicefh, tiopress)
deallocate (iomelt, ioform, tiomelt, tioform)
deallocate (gwork, vwork, sicemass)
!
Expand Down Expand Up @@ -770,6 +771,9 @@ subroutine write_boundary_checksums(time)
print*, '[ice chksum] ioaice:', sum(ioaice(isc:iec, jsc:jec, 1))
print*, '[ice chksum] iomelt:', sum(iomelt(isc:iec, jsc:jec, 1))
print*, '[ice chksum] ioform:', sum(ioform(isc:iec, jsc:jec, 1))
print*, '[ice chksum] iorunof:', sum(iorunof(isc:iec, jsc:jec, 1))
print*, '[ice chksum] iolicefw:', sum(iolicefw(isc:iec, jsc:jec, 1))
print*, '[ice chksum] iolicefh:', sum(iolicefh(isc:iec, jsc:jec, 1))

print*, '[ice chksum] ssto:', sum(ssto(isc:iec, jsc:jec, 1))
print*, '[ice chksum] ssso:', sum(ssso(isc:iec, jsc:jec, 1))
Expand Down

0 comments on commit 2ce6632

Please sign in to comment.