erosion_phosphorus_loss Subroutine

  1. erosion.f95
  2. erosion
  3. erosion_phosphorus_loss

public subroutine erosion_phosphorus_loss(j, da9, yd, yph)

! if (yph.lt.xporgp) yph = 0.

Arguments

Type IntentOptional AttributesName
integer :: j
real(kind=dp), intent(in) :: da9
real(kind=dp), intent(in) :: yd
real(kind=dp), intent(inout) :: yph

Called by

proc~~erosion_phosphorus_loss~~CalledByGraph proc~erosion_phosphorus_loss erosion_phosphorus_loss proc~runsubbasin runsubbasin proc~runsubbasin->proc~erosion_phosphorus_loss proc~time_process_day time_process_day proc~time_process_day->proc~runsubbasin proc~time_process_month time_process_month proc~time_process_month->proc~time_process_day proc~time_process_years time_process_years proc~time_process_years->proc~time_process_month program~swim swim program~swim->proc~time_process_years

Contents

Source Code

erosion_phosphorus_loss

Source Code

  subroutine erosion_phosphorus_loss(j, da9, yd, yph)
    !**** PURPOSE: COMPUTES P loss with erosion
    !**** CALLED IN: SUBBASIN
    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    !     PARAMETERS & VARIABLES
    !
    !      >>>>> COMMON PARAMETERS & VARIABLES
    !      cpp = xporg * er, g/t
    !      da9 = 100. * da = basin area in ha, from readbas
    !      er = enrichment ration, from enrsb
    !      xporg = P org. in I layer in subbasin, g/t
    !      xpsedp = SUM(porg+pms+pma) in subbasin, kg/ha
    !      yd = daily soil loss, in t, calc in ysed
    !      yph = P org. loss with erosion, kg/ha
    !      yphe(j) = P org. loss with erosion, kg/ha
    !      >>>>>
    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    !**** Include common parameters

    real(dp), intent(in) :: da9
    real(dp), intent(in) :: yd
    real(dp), intent(inout) :: yph
    integer j

    !**** CALC P org. loss with erosion
    cpp = xporg * er
    yph = .001 * cpp * yd / da9

    !**** Correction: AnjaH
    !!!      if (yph.lt.xporgp) yph = 0.
    if (yph .gt. xpsedp) yph = xpsedp
    if (yph .le. 0) yph = 0.
    yphe(j) = yph
    return
  end subroutine erosion_phosphorus_loss