subroutine nut_solp !! ~ ~ ~ PURPOSE ~ ~ ~ !! this subroutine calculates the amount of phosphorus lost from the soil !! profile in runoff and the movement of soluble phosphorus from the first !! to the second layer via percolation !! ~ ~ ~ INCOMING VARIABLES ~ ~ ~ !! name |units |definition !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! ihru |none |HRU number !! surfq(:) |mm H2O |surface runoff generated on day in HRU !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~ !! Intrinsic: Min, Max !! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~ use basin_module use organic_mineral_mass_module use gwflow_module, only : gw_soil_flag, gw_solute_flag, hru_soil, gwflow_percsol use hru_module, only : hru, surqsolp, surfq, i_sep, ihru, qtile, gwsoilp use soil_module use output_landscape_module use hydrograph_module, only : ht1 implicit none integer :: j = 0 !none |HRU number integer :: jj = 0 !none |counter real :: xx = 0. !none |variable to hold intermediate calculation ! |result real :: vap = 0. !kg P/ha |exponential coefficient for P leached and tile flow real :: plch = 0. !kg P/ha |amount of P leached from soil layer integer :: ly = 0 !none real :: tmp_calc = 0. j = ihru !rtb gwflow: add P mass transferred to soil profile from the aquifer if(gw_soil_flag.eq.1 .and. gw_solute_flag == 1) then do jj = 1,soil(j)%nly soil1(j)%mp(jj)%lab = soil1(j)%mp(jj)%lab + hru_soil(j,jj,2) !kg/ha gwsoilp(j) = gwsoilp(j) + hru_soil(j,jj,2) !HRU total enddo endif hls_d(j)%surqsolp = 0. hls_d(j)%lchlabp = 0. hls_d(j)%tilelabp = 0. !Add solp into hru from surface runon to calculations HAK/KDW 7/14/22 soil1(j)%mp(1)%lab = soil1(j)%mp(1)%lab + ht1%solp !HAK/KDW !! compute soluble P lost in surface runoff xx = soil(j)%phys(1)%bd * soil(j)%phys(1)%d * bsn_prm%phoskd surqsolp(j) = soil1(j)%mp(1)%lab * surfq(j) / (xx + 1.) !dont merge !!units ==> surqsolp = [kg/ha * mm] / [t/m^3 * mm * m^3/t] = kg/ha surqsolp(j) = Min(surqsolp(j), soil1(j)%mp(1)%lab) surqsolp(j) = Max(surqsolp(j), 0.) hls_d(j)%surqsolp = surqsolp(j) soil1(j)%mp(1)%lab = soil1(j)%mp(1)%lab - surqsolp(j) !! compute soluble P leaching do ly = 1, soil(j)%nly vap = 0. if (ly /= i_sep(j)) then vap = -soil(j)%ly(ly)%prk / (.01 * soil(j)%phys(ly)%st + .1 * bsn_prm%pperco * soil(j)%phys(ly)%bd) if (vap < -80.0) then ! This check was added to prevent gfortran aborting on the Exp(ww) function below. vap = -80 endif plch = .001 * soil1(j)%mp(ly)%lab * (1. - Exp(vap)) plch = Min(plch, soil1(j)%mp(ly)%lab) soil1(j)%mp(ly)%lab = soil1(j)%mp(ly)%lab - plch if (ly == soil(j)%nly) then !! leach p from bottom layer hls_d(j)%lchlabp = plch else !! perc p to next layer soil1(j)%mp(ly+1)%lab = soil1(j)%mp(ly+1)%lab + plch endif !! tile p if (ly == hru(j)%lumv%ldrain) then vap = -qtile / (.01 * soil(j)%phys(ly)%st + .1 * bsn_prm%pperco * soil(j)%phys(ly)%bd) plch = .001 * soil1(j)%mp(ly)%lab * (1. - Exp(vap)) plch = Min(plch, soil1(j)%mp(ly)%lab) soil1(j)%mp(ly)%lab = soil1(j)%mp(ly)%lab - plch hls_d(j)%tilelabp = plch endif endif !rtb gwflow: store phosphorus leaching concentration for gwflow module if(bsn_cc%gwflow == 1 .and. gw_solute_flag == 1) then gwflow_percsol(j,2) = hls_d(j)%lchlabp endif end do return end subroutine nut_solp