subroutine nutrient_nitrate_leaching(j, je, k, flate, nn, poe, preinf, qd, ul)
!**** PURPOSE: THIS SUBROUTINE CALCULATES NITRATE LEACHING
!**** CALLED IN: HYDROTOP
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! PARAMETERS & VARIABLES
!
! >>>>> COMMON PARAMETERS & VARIABLES
! ano3(j, je, l) = nitrate (NO3-N) content in a layer, kg/ha
! anora(j, je, l) = active org. N content in a layer, kg/ha
! anors(j, je, l) = stable org. N content in a layer, kg/ha
! dflow(j, je, 20) = monthly flows for water and N (see writhru.f)
! flate(j, je, l) = subsurface flow, mm, from purk
! inuhd = number of hydrotope to print from ncycle(), if inutr=1
! inusb = number of subbasin to print from ncycle(), if inutr=1
! nn = number of soil layers, from subbasin
! percn = N leaching to g-w, kg/ha
! poe(j, je, l) = percolation, mm, from purk
! precip = precipitation, mm
! qd = daily surface runoff, mm
! ssfn = N loss with subsurface flow, kg/ha
! ul(l, k) = upper limit water content in layer, mm
! xnflow(1:17) = N flow for a choosen hydrotope to write in nutr.prn
! (see ncycle)
! yno3 = N loss with surface flow, kg/ha
! >>>>>
! >>>>> STATIC PARAMETERS
! co = average daily concentration of N-NO3 in the layer, kg/ha
! l = local par
! qip = input with precip, then - input in a layer from the layer above
! rcn = local par
! sro = local variable: surface runoff
! vno3 = amount of N-NO3 lost from the layer
! vv = total amount of water lost from the soil layer
! >>>>>
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!**** Include common parameters
real(dp), dimension(:, :, :), intent(in) :: flate
integer, intent(in) :: nn
real(dp), dimension(:, :, :), intent(in) :: poe
real(dp), dimension(:, :), intent(in) :: preinf
real(dp), intent(in) :: qd
real(dp), dimension(:, :), intent(in) :: ul
integer j, je, k, l
real(dp) co, qip, sro, vno3, vv
!**** INITIALIZATION
qip = .01 * rcn * preinf(j, je)
if (j .eq. inusb .and. je .eq. inuhd) xnflow(5) = qip
sro = qd
ssfn = 0.
xnflow(6) = 0.
vno3 = 0.
co = 0.
!**** CALC nitrate loss in surface and subsurface runoff: yno3, ssfn
! RECALC ano3()
do l = 1, nn
vv = poe(j, je, l) + sro + flate(j, je, l) + 1.e-10
ano3(j, je, l) = ano3(j, je, l) + qip
vno3 = ano3(j, je, l) * (1. - exp(- vv / ul(l, k)))
co = vno3 / vv
if (l .eq. 1.) yno3 = qd * co
ano3(j, je, l) = ano3(j, je, l) - vno3
qip = co * poe(j, je, l)
sro = 0.
ssfn = ssfn + co * flate(j, je, l)
end do
!**** CALC nitrate leaching into ground water: percn
percn = qip
!**** CALC N flows for a choosen hydrotope (output in ncycle)
if (j .eq. inusb .and. je .eq. inuhd) then
xnflow(1) = yno3
xnflow(2) = ssfn
xnflow(3) = percn
endif
if (j .eq. inusb .and. je .eq. inuhd .and. l .eq. 2) &
xnflow(4) = co
if (j .eq. inusb .and. je .eq. inuhd .and. l .eq. 2) &
xnflow(6) = xnflow(6) + vno3 - qip
!**** CALC monthly flows for selected HRUs (output in writhru.f)
dflow(j, je, 5) = dflow(j, je, 5) + yno3
dflow(j, je, 6) = dflow(j, je, 6) + ssfn
dflow(j, je, 7) = dflow(j, je, 7) + percn
dflow(j, je, 10) = dflow(j, je, 10) + ano3(j, je, 1) + &
ano3(j, je, 2) + ano3(j, je, 3) + ano3(j, je, 4) + ano3(j, je, 5)
dflow(j, je, 11) = dflow(j, je, 11) + anora(j, je, 1) + anora(j, je, 2) &
+ anora(j, je, 3) + anora(j, je, 4) + anora(j, je, 5)
dflow(j, je, 12) = dflow(j, je, 12) + anors(j, je, 1) + anors(j, je, 2) &
+ anors(j, je, 3) + anors(j, je, 4) + anors(j, je, 5)
dflow(j, je, 13) = dflow(j, je, 13) + ano3(j, je, 3)
dflow(j, je, 14) = dflow(j, je, 14) + ano3(j, je, 4)
dflow(j, je, 15) = dflow(j, je, 15) + ano3(j, je, 5)
return
end subroutine nutrient_nitrate_leaching