Skip to content

Commit 28514de

Browse files
nmizukaminmizukami
authored
Merge pull request #619 from nmizukami/negative_qsurf
Ok, thanks and I will merge it.
2 parents ccc3c33 + faa139c commit 28514de

5 files changed

Lines changed: 58 additions & 38 deletions

File tree

‎route/build/cpl/RtmMod.F90‎

Lines changed: 50 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -389,7 +389,9 @@ SUBROUTINE route_run(rstwr)
389389
flush(iulog)
390390

391391
associate(nt_liq => ctl%nt_liq, &
392-
nt_ice => ctl%nt_ice)
392+
nt_ice => ctl%nt_ice, &
393+
begr => ctl%begr, &
394+
endr => ctl%endr)
393395

394396
!-------------------------------------------------------
395397
! Initialize mizuRoute history handler and fields
@@ -435,20 +437,23 @@ SUBROUTINE route_run(rstwr)
435437
! 2. direct_to_outlet: send negative flow to an outlet of the reach and subtract the flow from the outlet reach
436438
call t_startf('mizuRoute_bypass_route')
437439

440+
allocate(qSend(ctl%lnumr))
441+
qSend = 0._r8
442+
438443
select case(trim(bypass_routing_option))
439444
case('direct_in_place')
440445
ctl%direct = 0._r8
441-
do nr = ctl%begr,ctl%endr
442-
! --- Transfer qgwl [mm/s] to ocean
443-
if (trim(qgwl_runoff_option) == 'all') then ! send all qgwl flow to ocean
444-
ctl%direct(nr,nt_liq) = ctl%qgwl(nr,nt_liq)
445-
ctl%qgwl(nr,nt_liq) = 0._r8
446-
else if (trim(qgwl_runoff_option) == 'negative') then ! send only negative qgwl flow to ocean
447-
if(ctl%qgwl(nr,nt_liq) < 0._r8) then
448-
ctl%direct(nr,nt_liq) = ctl%qgwl(nr,nt_liq)
449-
ctl%qgwl(nr,nt_liq) = 0._r8
450-
endif
451-
else if (trim(qgwl_runoff_option) == 'threshold') then
446+
! --- Transfer qgwl [mm/s] to ocean
447+
if (trim(qgwl_runoff_option) == 'all') then ! send all qgwl flow to ocean
448+
ctl%direct(begr:endr, nt_liq) = ctl%direct(begr:endr, nt_liq) + ctl%qgwl(begr:endr, nt_liq)
449+
ctl%qgwl(begr:endr, nt_liq) = 0._r8
450+
else if (trim(qgwl_runoff_option) == 'negative') then ! send only negative qgwl flow to ocean
451+
where (ctl%qgwl(begr:endr, nt_liq) < 0._r8)
452+
ctl%direct(begr:endr, nt_liq) = ctl%direct(begr:endr, nt_liq) + ctl%qgwl(begr:endr, nt_liq)
453+
ctl%qgwl(begr:endr, nt_liq) = 0._r8
454+
end where
455+
else if (trim(qgwl_runoff_option) == 'threshold') then
456+
do nr = begr,endr
452457
! if qgwl is negative, and adding it to the main channel
453458
! would bring main channel storage below a threshold,
454459
! send qgwl directly to ocean
@@ -462,26 +467,38 @@ SUBROUTINE route_run(rstwr)
462467
ctl%direct(nr,nt_liq) = ctl%qgwl(nr,nt_liq)
463468
ctl%qgwl(nr,nt_liq) = 0._r8
464469
end if
465-
end if
466-
! --- Transfer qsub to ocean [mm/s]
467-
if(ctl%qsub(nr,nt_liq) < 0._r8) then
468-
ctl%direct(nr,nt_liq) = ctl%direct(nr,nt_liq)+ ctl%qsub(nr,nt_liq)
469-
ctl%qsub(nr,nt_liq) = 0._r8
470-
endif
471-
end do
470+
end do
471+
end if
472+
! --- Transfer negative qsub to ocean [mm/s]
473+
where (ctl%qsub(begr:endr, nt_liq) < 0._r8)
474+
ctl%direct(begr:endr, nt_liq) = ctl%direct(begr:endr, nt_liq) + ctl%qsub(begr:endr, nt_liq)
475+
ctl%qsub(begr:endr, nt_liq) = 0._r8
476+
end where
477+
478+
! --- Transfer negative qsur to ocean [mm/s]
479+
where (ctl%qsur(begr:endr, nt_liq) < 0._r8)
480+
ctl%direct(begr:endr, nt_liq) = ctl%direct(begr:endr, nt_liq) + ctl%qsur(begr:endr, nt_liq)
481+
ctl%qsur(begr:endr, nt_liq) = 0._r8
482+
end where
483+
472484
case('direct_to_outlet')
473-
allocate(qSend(ctl%lnumr))
474-
qSend(:) = 0._r8 ! total negative q [mm/s] to be sent to the outlet (converted to +)
475-
do nr = ctl%begr,ctl%endr
476-
if(ctl%qgwl(nr,nt_liq) < 0._r8) then
477-
qSend(nr) = ctl%qgwl(nr,nt_liq)
478-
ctl%qgwl(nr,nt_liq) = 0._r8
479-
end if
480-
if(ctl%qsub(nr,nt_liq) < 0._r8) then
481-
qSend(nr) = qSend(nr) + ctl%qsub(nr,nt_liq)
482-
ctl%qsub(nr,nt_liq) = 0._r8
483-
end if
484-
end do
485+
! ---- qgwl [mm/s]
486+
select case(trim(qgwl_runoff_option))
487+
case('all') ! send all qgwl flow to the outlet
488+
qSend(begr:endr) = qSend(begr:endr) + ctl%qgwl(begr:endr, nt_liq)
489+
ctl%qgwl(begr:endr, nt_liq) = 0._r8
490+
case('negative') ! send negative qgwl flow to the outlet
491+
where (ctl%qgwl(begr:endr, nt_liq) < 0._r8)
492+
qSend(begr:endr) = qSend(begr:endr) + ctl%qgwl(begr:endr, nt_liq)
493+
ctl%qgwl(begr:endr, nt_liq) = 0._r8
494+
end where
495+
case default; call shr_sys_abort(trim(subname)//'unexpected qgwl_runoff_option for direct_to_outlet')
496+
end select
497+
! ---- qsub [mm/s]
498+
where (ctl%qsub(begr:endr, nt_liq) < 0._r8)
499+
qSend(begr:endr) = qSend(begr:endr) + ctl%qsub(begr:endr, nt_liq)
500+
ctl%qsub(begr:endr, nt_liq) = 0._r8
501+
end where
485502

486503
! Distribute "direct runoff to ocean" to targe reach (i.e., outlet of river network)
487504
call shr_mpi_sparse_distribute(qSend, commRch(:)%destTask, commRch(:)%destIndex, ctl%direct(:,nt_liq), fillvalue=0._r8)
@@ -495,10 +512,8 @@ SUBROUTINE route_run(rstwr)
495512

496513
call t_startf('mizuRoute_direct_to_outlet_land_ice')
497514

498-
qSend(:) = 0._r8 ! total negative q [mm/s] to be sent to the outlet (converted to +)
499-
do nr = ctl%begr,ctl%endr
500-
qSend(nr) = ctl%qsur(nr,nt_ice) + ctl%qsub(nr,nt_ice) + ctl%qgwl(nr,nt_ice)
501-
end do
515+
qSend(:) = 0._r8
516+
qSend(begr:endr) = qSend(begr:endr) + ctl%qsur(begr:endr, nt_ice) + ctl%qsub(begr:endr, nt_ice) + ctl%qgwl(begr:endr, nt_ice)
502517

503518
! Distribute "direct runoff to ocean" to targe reach (i.e., outlet of river network)
504519
call shr_mpi_sparse_distribute(qSend, commRch(:)%destTask, commRch(:)%destIndex, ctl%direct(:,nt_ice), fillvalue=0._r8)

‎route/build/cpl/nuopc/rof_import_export.F90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -346,7 +346,7 @@ subroutine export_fields (gcomp, begr, endr, rc)
346346
! Flooding back to land, sign convention is positive in land->rof direction
347347
! so if water is sent from rof to land, the flux must be negative.
348348
do n = begr, endr
349-
flood(n) = ctl%flood(n) ! floodplain volume per HRU area [mm/s]
349+
flood(n) = -1._r8*ctl%flood(n) ! floodplain volume per HRU area [mm/s]
350350
volr(n) = ctl%volr(n) ! volume (channel+floodplain) per HRU area [m]
351351
volrmch(n) = ctl%volr(n) ! volume per HRU area [m]
352352
end do

‎route/build/src/mpi_process.f90‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -725,6 +725,8 @@ subroutine mpi_restart(pid, & ! input: proc id
725725
USE globalData, ONLY: nTribOutlet !
726726
USE globalData, ONLY: ixRch_order ! global reach index in the order of proc assignment (size = total number of reaches in the entire network)
727727
USE globalData, ONLY: global_ix_comm ! global reach index at tributary reach outlets to mainstem (size = sum of tributary outlets within entire network)
728+
USE globalData, ONLY: NETOPO_trib ! tributary reach parameter structure
729+
USE globalData, ONLY: NETOPO_main ! mainstem reach parameter structure
728730
USE globalData, ONLY: RPARAM_trib ! tributary reach parameter structure
729731
USE globalData, ONLY: RPARAM_main ! mainstem reach parameter structure
730732
USE globalData, ONLY: RCHFLX_trib ! tributary reach flux structure
@@ -977,6 +979,7 @@ subroutine mpi_restart(pid, & ! input: proc id
977979
if (nRch_mainstem>0) then ! populate flood volume (NOTE channel volume is already populated) for mainstem
978980
do iSeg = 1, nRch_mainstem
979981
RCHFLX_trib(iSeg)%ROUTE(idxDW)%FLOOD_VOL(1) = 0._dp
982+
if (is_lake_sim .and. NETOPO_main(iSeg)%isLake) cycle ! if lake keep 0 for flood_vol
980983
if (RCHFLX_trib(iSeg)%ROUTE(idxDW)%REACH_VOL(1) > RPARAM_main(iSeg)%R_STORAGE) then
981984
RCHFLX_trib(iSeg)%ROUTE(idxDW)%FLOOD_VOL(1) = RCHFLX_trib(iSeg)%ROUTE(idxDW)%REACH_VOL(1) - RPARAM_main(iSeg)%R_STORAGE
982985
end if
@@ -986,6 +989,7 @@ subroutine mpi_restart(pid, & ! input: proc id
986989
RCHFLX_trib(nRch_mainstem+nTribOutlet+iSeg)%ROUTE(idxDW)%REACH_VOL(1) = vol_local(iSeg)
987990
! populate flood volume
988991
RCHFLX_trib(nRch_mainstem+nTribOutlet+iSeg)%ROUTE(idxDW)%FLOOD_VOL(1) = 0._dp
992+
if (is_lake_sim .and. NETOPO_trib(iSeg)%isLake) cycle ! if lake keep 0 for flood_vol
989993
if (vol_local(iSeg) > RPARAM_trib(iSeg)%R_STORAGE) then
990994
RCHFLX_trib(nRch_mainstem+nTribOutlet+iSeg)%ROUTE(idxDW)%FLOOD_VOL(1) = vol_local(iSeg)-RPARAM_trib(iSeg)%R_STORAGE
991995
end if
@@ -995,6 +999,7 @@ subroutine mpi_restart(pid, & ! input: proc id
995999
RCHFLX_trib(iSeg)%ROUTE(idxDW)%REACH_VOL(1) = vol_local(iSeg)
9961000
! populate flood volume
9971001
RCHFLX_trib(iSeg)%ROUTE(idxDW)%FLOOD_VOL(1) = 0._dp
1002+
if (is_lake_sim .and. NETOPO_trib(iSeg)%isLake) cycle ! if lake keep 0 for flood_vol
9981003
if (vol_local(iSeg) > RPARAM_trib(iSeg)%R_STORAGE) then
9991004
RCHFLX_trib(iSeg)%ROUTE(idxDW)%FLOOD_VOL(1) = vol_local(iSeg)-RPARAM_trib(iSeg)%R_STORAGE
10001005
end if

‎route/build/src/public_var.f90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ MODULE public_var
2929
real(dp), parameter,public :: verySmall=tiny(1.0_dp) ! a very small number
3030
real(dp), parameter,public :: min_slope=1.e-6_dp ! minimum slope
3131
real(dp), parameter,public :: negRunoffTol=-1.e-3_dp ! nagative runoff tolerance
32-
real(dp), parameter,public :: lakeWBtol=1.e-3_dp ! lake water balance tolerance
32+
real(dp), parameter,public :: lakeWBtol=2.e-2_dp ! lake water balance tolerance
3333
real(dp), parameter,public :: negVolTol=-1.0e-50_dp ! negative channel volume tolerance
3434

3535
! routing related constants

‎route/settings/SAMPLE-coupled.control‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@
1919
<doesBasinRoute> 1 ! basin routing options 0-> no, 1->gamma-diestribution UH, otherwise error
2020
<is_flux_wm> T ! switch for water abstraction/injection
2121
<hw_drain_point> 1 ! how lateral flow is put into a headwater reach 1-> top of headwater, 2-> bottom of headwater
22-
<floodplain> T ! logical: floodwater is computed, otherwise, channel is unlimited bank depth
22+
<floodplain> F ! logical: floodwater is computed, otherwise, channel is unlimited bank depth
2323
<fname_state_in> STATE_IN_NC ! input restart netCDF name. remove for run without any particular initial channel states
2424
<newFileFrequency> monthly ! frequency for new output files (daily, monthly, yearly, single)
2525
<outputFrequency> monthly ! time frequency used for temporal aggregation of output variables - numeric or daily, monthyly, or yearly

0 commit comments

Comments
 (0)