subroutine river_route_erosion(j, inum1, chc, chxk, yd)
!**** PURPOSE: THIS SUBROUTINE ROUTES SEDIMENT FROM SUB-BASIN TO BASIN OUTLET
!**** CALLED IN: ROUTE
! METHOD: from J. WILLIAMS (SWAT98)
! DEPOSITION IS BASED ON FALL VELOCITY AND DEGRADATION - ON STREAM POWER
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! PARAMETERS & VARIABLES
!
! >>>>> COMMON PARAMETERS & VARIABLES
! chc(j) = channel USLE C factor
! chnn(j) = channel N value
! chss(j) = channel slope, m/m
! chw(2, j) = average width of main channel, m
! chxk(j) = channel USLE K factor
! ida = current day
! irout = switch code to print from routfun()
! prf = coef. to estimate peak runoff in stream
! sdti = water inflow + storage in the reach, m3/sec.
! sdtsav(ir) = water storage in the reach, m3
! spcon = rate parameter for estimation of sediment transport, readbas
! spexp = exponent for estimation of sediment transport, readbas
! xxqd = surface flow - daily input in reaches, m3
! yd = daily soil loss from subbasin caused by water erosion, t
! >>>>>
! >>>>> STATIC PARAMETERS
! ach = local par
! bwd = local par
! cych = local par
! cyin = local par
! d = f(sdti, chnn, chw, chss)
! deg = degradation
! dep = deposition
! depnet = local par
! nsz = local par
! prst = peak runoff in stream
! qdin = surface inflow + water storage
! vc = f(sdti, chw, d)
! vs = local par
! ydin = yd
! >>>>>
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!**** Include common parameters
real(dp), dimension(:), intent(in) :: chc
real(dp), dimension(:), intent(in) :: chxk
real(dp), intent(inout) :: yd
integer j, inum1
real(dp) ach, cych, cyin, d, deg, dep, depnet, prst, qdin
real(dp) vc, ydin
prst = prf * sdti
qdin = xxqd + sdtsav(inum1)
ydin = yd
if (qdin .le. 0.01) return
!**** COMPUTE FLOW DEPTH
d = ((prst * chnn(j)) / (chw(2, j) * chss(j) ** .5)) ** .6
ach = d * chw(2, j)
if (d .lt. .010) then
vc = 0.01
else
vc = prst / ach
endif
if (vc .gt. 3.) vc = 3.
!**** CALCULATE DEPOSITION & DEGRADATION (either - or)
cyin = ydin / qdin
cych = spcon * vc ** spexp
depnet = qdin * (cych - cyin)
if (depnet .gt. 0.) then
deg = depnet * chxk(j) * chc(j)
dep = 0.
else
dep = - depnet
deg = 0.
endif
yd = yd + deg - dep
if (yd .lt. 0.) yd = 0.
return
end subroutine river_route_erosion