subroutine nutrient_nitrate_cycle(j, je, k, cbn, flu, fon, fop, frar, nn, rsd, rtn, ste, te, ul, yone)
!**** PURPOSE: THIS SUBROUTINE ESTIMATES DAILY N AND P MINERALIZATION &
! IMMOBILIZATION CONSIDERING FRESH ORGANIC MATERIAL (CROP RESIDUE)
! AND ACTIVE AND STABLE HUMUS MATERIAL.
!**** 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
! cbn(l, k) = organic carbon content in a layer, %
! csf = combined water/temperature factor
! dflow(j, je, 20) = monthly flows for water and N (see writhru.f)
! flu(j) = fraction of subbasin area in the basin
! fon(j, je, l) = fresh organic N from residue in a layer, kg/ha
! fop(j, je, l) = fresh organic P from residue in a layer, kg/ha
! frar(j, je) = fractional areas of hydrotope in subbasin
! humn = N mineralization from humus mineralization, kg/ha
! ida = current day
! inuhd = number of hydrotope to print from ncycle(), if inutr=1
! inusb = number of subbasin to print from ncycle(), if inutr=1
! inutr = switch code to print from ncycle()
! nn = number of soil layers, from subbasin
! plab(j, je, l) = labile P content in a layer, kg/ha
! qd = daily surface runoff, mm
! rsd(j, je, 2) = crop residue, kg/ha
! rtn = active N pool fraction, = 0.15
! sasnf = SUM(asnflow): flow between active and stable org. N
! for basin, kg/ha
! sdnit = SUM(denit): daily N-NO3 loss by denitrification
! for basin, kg/ha
! sfomn = SUM(fomn): mineralisation from fresh org. N for basin,
! kg/ha
! shumn = SUM(humn): humus N minerlisation for basin, kg/ha
! ste(j, je, l) = water storage in a layer, mm, recalc here
! te(j, je, l) = daily ave temp at the bottom of each layer, degree C
! ul(l, k) = upper limit water content in layer, mm
! xnflow(1:17) = N flows for a choosen hydrotope to write in nutr.prn
! xnflow(1) = N loss with surface flow calc nlch, kg/ha
! xnflow(2) = N loss with subsurface flow calc nlch, kg/ha
! xnflow(3) = N loss with percolation calc nlch, kg/ha
! xnflow(4) = N concentration in layer 2 calc nlch, kg/ha
! xnflow(5) = N input with precip calc nlch, kg/ha
! xnflow(6) = N loss from layer 2 calc nlch, kg/ha
! xnflow(7) = N fertilization calc fert, kg/ha
! xnflow(8) = N uptake by plants calc nuptake, kg/ha
! xnflow(9) = N denit calc ncycle, kg/ha
! xnflow(10) = N miner from fresh org N calc ncycle, kg/ha
! xnflow(11) = N miner from humus calc ncycle, kg/ha
! xnflow(12) = xhumcdg/xhumn calc ncycle
! xnflow(13) = xhumsut/xhumn calc ncycle
! xnflow(14) = xhumcsf/xhumn calc ncycle
! xnflow(15) = xfomcdg calc ncycle
! xnflow(16) = xfomsut calc ncycle
! xnflow(17) = xfomcsf calc ncycle
! yone(j) = org. N lost with erosion (calc in orgnsed), kg/ha
! >>>>>
! >>>>> STATIC PARAMETERS
! asnflow = flow between active and stable org. N Pools, kg/ha
! ca = minimum of CN and CP-ratio factor
! cdg = temperature factor for humus mineralization
! cdn = shape coefficient for combined temp-carbon factor
! cmn = humus rate constant for N (normally set to 0.0003)
! cnr = CN-ratio
! cnrf = CN-ratio facto
! cpr = CP-ratio
! cprf = CP-ratio factor
! decr = decompostion rate for residue
! denit = daily N-NO3 loss by denitrification
! deth = threshold of soil water content for denitrification
! fomn = mineralisation from fresh org. N, kg/ha
! ik = local par
! l = local par
! ll = local par
! nraz = local par
! r4 = CN- or CP-ratio
! resdc = decompostion rate for fresh org. material
! sut = soil water factor for humus mineralization
! sut4 = local par
! xden = accumulated denit
! xfomcdg = cdg (temperature factor)
! xfomcsf = csf (combined water/temperature factor)
! xfomn = accumulated fomn
! xfomsut = sut (water factor)
! xhumcdg = cdg*humn (temperature factor*humn)
! xhumcsf = csf*humn (combined water/temperature factor*humn)
! xhumn = accumulated humn
! xhumsut = sut*humn (water factor*humn)
! xx = local par
! xx1 = local par
! xx2 = local par
! >>>>>
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!**** Include common parameters
real(dp), dimension(:, :), intent(in) :: cbn
real(dp), dimension(:), intent(in) :: flu
real(dp), dimension(:, :, :), intent(inout) :: fon
real(dp), dimension(:, :, :), intent(in) :: fop
real(dp), dimension(:, :), intent(in) :: frar
integer, intent(in) :: nn
real(dp), dimension(:, :, :), intent(inout) :: rsd
real(dp), intent(in) :: rtn
real(dp), dimension(:, :, :), intent(in) :: ste
real(dp), dimension(:, :, :), intent(in) :: te
real(dp), dimension(:, :), intent(in) :: ul
real(dp), dimension(:), intent(inout) :: yone
integer j, je, k, l, ll, nraz
real(dp) asnflow, ca, cdg, cnr, cnrf, cpr, cprf, decr, denit
real(dp) deth, fomn, r4, resdc, sut, sut4, xden, xx, xx1, xx2, xfomcdg
real(dp) xfomcsf, xfomn, xfomsut, xhumcdg, xhumcsf, xhumn, xhumsut
!**** INITIALIZATION
xx1 = 0.
xx2 = 0.
xden = 0.
xfomn = 0.
xhumn = 0.
xhumcdg = 0.
xhumsut = 0.
xhumcsf = 0.
xfomcdg = 0.
xfomsut = 0.
xfomcsf = 0.
nraz = 0
!**** SUBTRACT org N lost with erosion
anors(j, je, 1) = anors(j, je, 1) - yone(j)
if (anors(j, je, 1) .le. 0.) anors(j, je, 1) = 0.
yone(j) = 0.
!*********************************************************** START OF CYCLE 10
do l = 1, nn
!**** CALC soil water factor for humus mineralization: sut
ll = l
if (l .eq. 1) ll = 2
xx = te(j, je, ll)
sut = ste(j, je, ll) / (ul(ll, k) + 1.e-10)
if (sut .gt. 1.) sut = 1.
if (sut .lt. 0.) sut = 1.e-10
sut4 = .06 * exp(3. * sut)
!**** CALC temperature factor for humus mineralization: cdg
if (xx .gt. 0.) then
cdg = xx / (xx + exp(6.82-.232 * xx) + 1.e-6)
else
cdg = 0.
endif
!**** CALC combined water & temperature factor: csf
csf = sqrt(cdg * sut)
!**** CALC daily NO3-N loss by denitrification: denit, xden
deth = 0.9
if (sut .ge. deth) then
denit = sut4 * ano3(j, je, l) * (1. - exp(cdn * cdg * cbn(l, k)))
else
denit = 0.
end if
ano3(j, je, l) = ano3(j, je, l) - denit
xden = xden + denit
!**** CALC asnflow - N flow between act. & stab. org N; RECALC pools
asnflow = .1e-4 * (anora(j, je, l) * (1. / rtn-1.)-anors(j, je, l))
anors(j, je, l) = anors(j, je, l) + asnflow
anora(j, je, l) = anora(j, je, l) - asnflow
!**** CALC humus mineralization: humn; RECALC pools
humn = cmn * csf * anora(j, je, l)
xx = anora(j, je, l) + anors(j, je, l)
xhumcdg = xhumcdg + cdg * humn
xhumsut = xhumsut + sut * humn
xhumcsf = xhumcsf + csf * humn
if (humn .gt. 0.) nraz = nraz + 1
anora(j, je, l) = anora(j, je, l) - humn
ano3(j, je, l) = ano3(j, je, l) + humn
xhumn = xhumn + humn
!**** CALC mineralization of fresh organic matter: fomn; RECALC pools
! CALC residue decomposition (only here, not in pcycle!)
if (l .le. 2) then
r4 = .58 * rsd(j, je, l)
cnr = r4 / (fon(j, je, l) + ano3(j, je, l) + 1.e-6)
cpr = r4 / (fop(j, je, l) + plab(j, je, l) + 1.e-6)
if (cnr .gt. 25.) then
cnrf = exp(- .693 * (cnr - 25.) / 25.)
else
cnrf = 1.0_dp
end if
if (cpr .gt. 200.) then
cprf = exp(- .693 * (cpr - 200.) / 200.)
else
cprf = 1.0_dp
end if
ca = amin1(real(cnrf, 4), real(cprf, 4))
decr = .05 * ca * csf
fomn = decr * fon(j, je, l)
resdc = decr * rsd(j, je, l)
rsd(j, je, l) = rsd(j, je, l) - resdc
fon(j, je, l) = fon(j, je, l) - fomn
xfomcdg = cdg
xfomsut = sut
xfomcsf = csf
else
fomn = 0.
end if
anora(j, je, l) = anora(j, je, l) + .2 * fomn
ano3(j, je, l) = ano3(j, je, l) + .8 * fomn
xfomn = xfomn + .8 * fomn
!**** CALC SUMS for basin
shumn = shumn + humn * flu(j) * frar(j, je)
sasnf = sasnf + asnflow * flu(j) * frar(j, je)
sfomn = sfomn + fomn * flu(j) * frar(j, je)
sdnit = sdnit + denit * flu(j) * frar(j, je)
end do
!*********************************************************** END OF CYCLE 10
!**** CALC N flows for a choosen hydrotope (output in ncycle)
if (inutr .eq. 1 .and. j .eq. inusb .and. je .eq. inuhd) then
xnflow(9) = xden
xnflow(10) = xfomn
xnflow(11) = xhumn
endif
!**** CALC monthly flows for selected HRUs (output in writhru.f)
dflow(j, je, 16) = dflow(j, je, 16) + xfomn
dflow(j, je, 17) = dflow(j, je, 17) + xhumn
dflow(j, je, 9) = dflow(j, je, 9) + xden
return
end subroutine nutrient_nitrate_cycle