!$Author: wagner $ !$Date: 2006-08-11 18:44:39 $ !$Revision: 1.1 $ !$Source: /weru/cvs/weps/weps_ref/src/ref_susp.f95,v $ ! +++ PURPOSE +++ ! Calculate the horizontal suspension discharge based upon ! the physical processes involved. Each of the primary sources ! and sinks/traps are represented as individual contributing processes REAL FUNCTION dqss_dx (Gssen,Gssan,Gssbk, Gssdp, Cssi, wus, wustd) ! net suspension discharge flux IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: Gssen ! vert. susp. emission flux from loose aggs REAL, INTENT (IN) :: Gssan ! vert. susp. flux from abrasion of surf. clods and crust REAL, INTENT (IN) :: Gssbk ! vert. susp. flux from breakage of salt/creep aggs REAL, INTENT (IN) :: Gssdp ! vert. susp. flux (deposition) above a non-eroding surface REAL, INTENT (IN) :: Cssi ! fraction of intercepted susp. size agg flux REAL, INTENT (IN) :: wus ! friction velocity REAL, INTENT (IN) :: wustd ! dynamic threshold friction velocity ! dqss_dx - net suspension discharge flux (kg/m2/s) ! Gssen - vertical susp. emission flux from loose aggs (kg/m^2/s) ! Gssan - vertical susp. emission flux from abrasion of surface clods and crust (kg/m^2/s) ! Gssbk - vertical susp. emission flux from breakage of salt/creep aggs (kg/m^2/s) ! Gssdp - vert. susp. flux (deposition) above a non-eroding surface (kg/m^2/s) ! Cssi - fraction of intercepted susp. size agg flux due to standing biomass ! wustd - dynamic threshold friction velocity (m/s) ! wust - emission threshold friction velocity (m/s) IF (wus .gt. wustd) THEN dqss_dx = (Gssen + Gssan + Gssbk) * (1.0 - Cssi) ELSE ! (wus .lt. wustd) dqss_dx = -Gssdp END IF END FUNCTION dqss_dx ! +++ PURPOSE +++ ! Calculate the vertical flux from emission of loose aggregates in the ! control volume for the suspension component REAL FUNCTION Gssen (SFssen, Cen, Cm, qen, q) ! vert. susp. emission flux from loose aggs IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: SFssen ! mass fract. of susp-size among loose aggs REAL, INTENT (IN) :: Cen ! coefficient of emission REAL, INTENT (IN) :: Cm ! coefficient of mixing REAL, INTENT (IN) :: qen ! transport capacity REAL, INTENT (IN) :: q ! horizontal saltation/creep discharge ! Gssen - vertical susp. emission flux from loose aggs (kg/m^2/s) ! SFssen - mass fraction of susp-size (<0.10 mm) among loose aggs (<2.0 mm dia.) ! Cen - coefficient of emission (1/m) ! Cm - coefficient of mixing (1/m) ! qen - transport capacity (kg/m/s) ! q - horizontal saltation/creep discharge (kg/m/s) Gssen = SFssen * Cen * (qen - q) + Cm * q END FUNCTION Gssen ! +++ PURPOSE +++ ! Calculate the vertical flux from abrasion of surface clods and crust in the ! control volume for the suspension component REAL FUNCTION Gssan (SFssan, Fancr, Cancr, Fancl, Cancl, q) ! vert. susp. flux from abrasion of surf. clods and crust IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: SFssan ! mass fract. of susp-size from abrasion of clods and crust REAL, INTENT (IN) :: Fancr ! mass fraction of saltation impacting crust REAL, INTENT (IN) :: Cancr ! coefficient of abrasion on crust REAL, INTENT (IN) :: Fancl ! mass fraction of saltation impacting clods REAL, INTENT (IN) :: Cancl ! coefficient of abrasion on clods REAL, INTENT (IN) :: q ! horizontal saltation/creep discharge ! Gssan - vertical susp. emission flux from abrasion of surface clods and crust (kg/m^2/s) ! SFssan - mass fraction of susp-size (<0.10 mm) from abrasion of clods and crust ! Fancr - mass fraction of saltation impacting crust ! Cancr - coefficient of abrasion on crust (1/m) ! Fancl - mass fraction of saltation impacting clods ! Cancl - coefficient of abrasion on clods (1/m) ! q - horizontal saltation/creep discharge (kg/m/s) Gssan = SFssan * ((Fancr*Cancr)+(Fancl*Cancl)) * q END FUNCTION Gssan ! +++ PURPOSE +++ ! Calculate the vertical flux (sink) for the removal (trapping) of suspension ! discharge (loss) from the air stream when no active saltation is occurring ! to maintain the suspension flux from the surface. Typically, this implies the ! presence of a vegetated, water or rough armored surface. Through diffusion, ! and settling, the larger suspension-size particles move rapidly back towards ! non-eroding surfaces. In WEPS, these processes are simulated in the ! control volume for the suspension component. REAL FUNCTION Gssdp (Cdp, qss, qsso, q) ! vert. flux from settling of suspension material IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: Cdp ! coefficient of deposition of suspension-size material REAL, INTENT (IN) :: qss ! horizontal suspension component discharge REAL, INTENT (IN) :: qsso ! max. value of qss entering deposition region REAL, INTENT (IN) :: q ! horizontal saltation/creep discharge ! Gtp - vertical flux from settling of suspension material (kg/m^2/s) ! Cdp - coefficient of deposition of suspension-size material (1/m) ! qss - horizontal suspension component discharge (kg/m/s) ! qsso - max. value of qss entering deposition region (kg/m/s) ! q - horizontal saltation/creep discharge (kg/m/s) IF (qss .GT. (0.5*qsso)) THEN Gssdp = Cdp * (qss - (0.5 * qsso)) ELSE Gssdp = 0.0 ENDIF END FUNCTION Gssdp !----------------------------------------------------------------------- ! +++ PURPOSE +++ ! Calculate the horizontal suspension discharge based upon ! the physical processes involved. Each of the primary sources ! and sinks/traps are represented as individual contributing processes ! (Same as "dqss_dx" but with the source and sink terms re-arranged) REAL FUNCTION dqss_dx_1 (F, G, q) ! net suspension discharge flux IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: F ! intercept coefficient REAL, INTENT (IN) :: G ! linear coefficient REAL, INTENT (IN) :: q ! horizontal suspension discharge ! dqss_dx_1 - net suspension discharge flux (kg/m2/s) ! F - intercept coefficient (kg/m^2/s) ! G - linear coefficient (unitless) ! q - horizontal suspension discharge (kg/m/s) dqss_dx_1 = F + G*q END FUNCTION dqss_dx_1 ! +++ PURPOSE +++ ! Calculate the "intercept" component of the vertical flux in the ! control volume for the suspension component REAL FUNCTION F (SFssen, Cen, Cssi, qen) ! "intercept" component vert. flux eqn. IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: SFssen ! mass fract. of susp-size among loose aggs REAL, INTENT (IN) :: Cen ! coefficient of emission REAL, INTENT (IN) :: Cssi ! fraction of intercepted susp. size agg flux REAL, INTENT (IN) :: qen ! transport capacity ! F - "intercept" component of vertical flux (kg/m^2/s) ! SFssen - mass fraction of susp-size (<0.10 mm) among loose aggs (<2.0 mm dia.) ! Cen - coefficient of emission (1/m) ! Cssi - fraction of intercepted susp. size agg flux due to standing biomass ! qen - transport capacity (kg/m/s) F = (SFssen * Cen) * (1.0 - Cssi) * qen END FUNCTION F ! +++ PURPOSE +++ ! Calculate the "linear" component of the vertical flux in the ! control volume for the suspension component REAL FUNCTION G (SFssen, Cen, SFssan, Fancr, Cancr, Fancl, Cancl, & & Cbk, Cssi) ! "linear" component of vert. flux eqn. IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: SFssen ! mass fract. of susp-size among loose aggs REAL, INTENT (IN) :: Cen ! coefficient of emission REAL, INTENT (IN) :: SFssan ! mass fract. of susp-size from abrasion of clods and crust REAL, INTENT (IN) :: Fancr ! mass fraction of saltation impacting crust REAL, INTENT (IN) :: Cancr ! coefficient of abrasion on crust REAL, INTENT (IN) :: Fancl ! mass fraction of saltation impacting clods REAL, INTENT (IN) :: Cancl ! coefficient of abrasion on clods REAL, INTENT (IN) :: Cbk ! coefficient of breakage REAL, INTENT (IN) :: Cssi ! fraction of intercepted susp. size agg flux ! G - "linear" component of vertical flux (unitless) ! SFssen - mass fraction of susp-size (<0.10 mm) among loose aggs (<2.0 mm dia.) ! Cen - coefficient of emission (1/m) ! SFssan - mass fraction of susp-size (<0.10 mm) from abrasion of clods and crust ! Fancr - mass fraction of saltation impacting crust ! Cancr - coefficient of abrasion on crust (1/m) ! Fancl - mass fraction of saltation impacting clods ! Cancl - coefficient of abrasion on clods (1/m) ! Cbk - coefficient of breakage (1/m) ! Cssi - fraction of intercepted susp. size agg flux due to standing biomass G = (SFssen*Cen + SFssan*((Fancr*Cancr) + (Fancl*Cancl)) + Cbk) * & & (1.0 - Cssi) END FUNCTION G !----------------------------------------------------------------------- ! +++ PURPOSE +++ ! Calculate net soil loss from the ! control volume for the suspension component REAL FUNCTION qsso (A, B, C, F, G, lx, qssi, wus, wustd, Cdp) ! net suspension discharge IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: A ! intercept coefficient (salt/creep) REAL, INTENT (IN) :: B ! linear coefficient (salt/creep) REAL, INTENT (IN) :: C ! quadratic coefficient (salt/creep) REAL, INTENT (IN) :: F ! intercept coefficient REAL, INTENT (IN) :: G ! linear coefficient REAL, INTENT (IN) :: lx ! length of control volume REAL, INTENT (IN) :: qssi ! incoming suspension REAL, INTENT (IN) :: wus ! friction velocity REAL, INTENT (IN) :: wustd ! dynamic threshold friction velocity REAL, INTENT (IN) :: Cdp ! coefficient of deposition of suspension-size material ! qo - net suspension discharge (kg/m) ! A - intercept coefficient (kg/m^2/s) ! B - linear coefficient (unitless) ! C - quadratic coefficient (s/m^2/kg) ! G - intercept coefficient (kg/m^2/s) ! F - linear coefficient (unitless) ! lx - length of control volume (m) ! qssi - incoming horizontal suspension (kg/m) ! wustd - dynamic threshold friction velocity (m/s) ! wust - emission threshold friction velocity (m/s) ! Cdp - coefficient of deposition of suspension-size material (1/m) REAL :: S ! temporary variables S = (4.0*A*C + B*B)**0.5 ! Would like to know what "physical" conditions can cause p IF (wus .gt. wustd) THEN qsso = qssi + (1.0/(C*C)) * ( (G*S + G*B + F*F*C*C)*(lx) + & & G*G * (log(exp(S*(-lx))*(B+S) - B + S) ) ) ELSE ! (wus .lt. wustd) qsso = (0.5 * qssi) * (1.0 + exp(-Cdp * lx)) END IF END FUNCTION qsso ! +++ PURPOSE +++ ! Calculate net soil loss from the ! control volume for the suspension component REAL FUNCTION qsso_1 (A, B, C, F, G, lx, qssi, qi) ! net suspension discharge IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: A ! intercept coefficient (salt/creep) REAL, INTENT (IN) :: B ! linear coefficient (salt/creep) REAL, INTENT (IN) :: C ! quadratic coefficient (salt/creep) REAL, INTENT (IN) :: F ! intercept coefficient REAL, INTENT (IN) :: G ! linear coefficient REAL, INTENT (IN) :: lx ! length of control volume REAL, INTENT (IN) :: qssi ! incoming suspension REAL, INTENT (IN) :: qi ! incoming saltation/creep ! qo - net suspension discharge (kg/m) ! A - intercept coefficient (kg/m^2/s) ! B - linear coefficient (unitless) ! C - quadratic coefficient (s/m^2/kg) ! G - intercept coefficient (kg/m^2/s) ! F - linear coefficient (unitless) ! lx - length of control volume (m) ! qssi - incoming horizontal suspension (kg/m) ! qi - incoming horizontal saltation/creep (kg/m) REAL :: S, p, t2 ! temporary variables S = (4.0*A*C + B*B)**0.5 p = (-(C+C)*qi + B) / S ! Would like to know what "physical" conditions can cause (S*lx) ! to go out of range - LEW IF ((S*lx) .gt. 40.0) THEN S = 40.0/lx ENDIF ! Would like to know what "physical" conditions can cause p ! to go out of range (-1 < p < 1) - LEW IF (p .gt. 1.0) THEN t2 = log(2.0) ! Why the arbritrary values? ELSE IF (p .le. -1.0) THEN t2 = log(exp(S*lx)*2.0) ! Why the arbritrary values? ELSE t2 = log(exp(S*lx)*(1.0-p) + p + 1.0) END IF qsso_1 = qssi + (1.0/(C*C)) * ( (-G*S + G*B + F*F*C*C)*(lx) + & & G*G * (-log(2.0) + t2)) !qsso_1 = (0.5 * qssi) * (1.0 + exp(-Cdp * lx)) END FUNCTION qsso_1