!$Author: wagner $ !$Date: 2006-08-11 18:44:39 $ !$Revision: 1.1 $ !$Source: /weru/cvs/weps/weps_ref/src/ref_salt_creep.f95,v $ ! +++ PURPOSE +++ ! Calculate the horizontal saltation/creep discharge based upon ! the physical processes involved. Each of the primary sources ! and sinks/traps are represented as individual contributing processes REAL FUNCTION dq_dx (Gen, Gan, Gssbk, Gtp)! net saltation/creep discharge flux IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: Gen ! vert. flux from emission of loose aggs REAL, INTENT (IN) :: Gan ! vert. flux from abrasion of surf. clods and crust REAL, INTENT (IN) :: Gssbk ! vert. flux of susp aggs from breakage of salt/creep aggs REAL, INTENT (IN) :: Gtp ! vert. flux from trapping of salt/creep aggs ! dq_dx - net saltation/creep discharge flux (kg/m2/s) ! Gen - vertical flux from emission of loose aggs (kg/m^2/s) ! Gan - vertical flux from abrasion of surface clods and crust (kg/m^2/s) ! Gssbk - vertical flux of susp aggs from breakage of salt/creep aggs (kg/m^2/s) ! Gtp - vertical flux from trapping of salt/creep aggs (kg/m^2/s) dq_dx = Gen + Gan - Gssbk - Gtp END FUNCTION dq_dx ! +++ PURPOSE +++ ! Calculate the vertical flux from emission of loose aggregates in the ! control volume for the saltation/creep component REAL FUNCTION Gen (SFssen, Cen, qen, q)! vert. flux from emission of 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) :: qen ! transport capacity REAL, INTENT (IN) :: q ! horizontal saltation/creep discharge ! Gen - vertical flux from emission of 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) ! qen - transport capacity (kg/m/s) ! q - horizontal saltation/creep discharge (kg/m/s) Gen = (1.0 - SFssen) * Cen * (qen - q) END FUNCTION Gen ! +++ PURPOSE +++ ! Calculate the vertical flux from abrasion of surface clods and crust in the ! control volume for the saltation/creep component REAL FUNCTION Gan (SFssan, Fancr, Cancr, Fancl, Cancl, qen, q) ! vert. 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) :: qen ! transport capacity REAL, INTENT (IN) :: q ! horizontal saltation/creep discharge ! Gan - vertical 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) ! qen - transport capacity (kg/m/s) ! q - horizontal saltation/creep discharge (kg/m/s) Gan = (1.0 - SFssan)*((Fancr*Cancr)+(Fancl*Cancl))*q*(qen - q)/qen END FUNCTION Gan ! +++ PURPOSE +++ ! Calculate the vertical flux (sink) for the saltation/creep dishcharge (loss) ! that occurs when these aggregates are broken into suspension-size and ! carried off in "suspension mode" within the control volume for the saltation/creep component REAL FUNCTION Gssbk (Cbk, Fs_bk, q)! vert. flux of susp aggs from breakage of salt/creep aggs IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: Cbk ! coefficient of breakage !REAL, INTENT (IN) :: qs ! discharge of primary (non-breakable) sand particles REAL, INTENT (IN) :: Fs_bk ! mass fraction of (breakable) coarse sand particles REAL, INTENT (IN) :: q ! horizontal saltation/creep discharge ! Gen - vertical flux from emission of loose aggs (kg/m^2/s) ! Cbk - coefficient of breakage (1/m) ! qs - discharge of primary (non-breakable) sand particles (kg/m/s) ! Fs_bk - mass fraction of (breakable) coarse sand particles (sfsan-sfvfs) ! q - horizontal saltation/creep discharge (kg/m/s) !Gssbk = Cbk * (q - qs) !Gssbk = Cbk * (sfsan-sfvfs) * q Gssbk = Cbk * (Fs_bk) * q END FUNCTION Gssbk ! +++ PURPOSE +++ ! Calculate the vertical flux (sink) for the removal of saltation/creep ! discharge (loss) from the air stream by trapping mechanisms. In WEPS, ! surface trapping and plant interception are simulated in the ! control volume for the saltation/creep component REAL FUNCTION Gtp (Ct, Ci, qcp, qen, q) ! vert. flux from trapping of salt/creep aggs IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: Ct ! coefficient of surface trapping REAL, INTENT (IN) :: Ci ! coefficient of plant interception REAL, INTENT (IN) :: qcp ! transport capacity of the surface when >= 40% armored REAL, INTENT (IN) :: qen ! transport capacity REAL, INTENT (IN) :: q ! horizontal saltation/creep discharge ! Gtp - vertical flux from trapping of salt/creep aggs (kg/m^2/s) ! Ct - coefficient of surface trapping (1/m) ! Ci - coefficient of plant interception (1/m) ! qcp - transport capacity of the surface when >=40% armored (kg/m/s) ! qen - transport capacity (kg/m/s) ! q - horizontal saltation/creep discharge (kg/m/s) IF (qen .GE. qcp) THEN Gtp = Ct * (1.0 - (qcp/qen)) * q + Ci * q ELSE Gtp = 0.0 ENDIF END FUNCTION Gtp !----------------------------------------------------------------------- ! +++ PURPOSE +++ ! Calculate the horizontal saltation/creep discharge based upon ! the physical processes involved. Each of the primary sources ! and sinks/traps are represented as individual contributing processes ! (Same as "dq_dx" but with the source and sink terms re-arranged) REAL FUNCTION dq_dx_1 (A, B, C, q) ! net saltation/creep discharge flux IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: A ! intercept coefficient REAL, INTENT (IN) :: B ! linear coefficient REAL, INTENT (IN) :: C ! quadratic coefficient REAL, INTENT (IN) :: q ! horizontal saltation/creep discharge ! dq_dx_1 - net saltation/creep discharge flux (kg/m2/s) ! A - intercept coefficient (kg/m^2/s) ! B - linear coefficient (unitless) ! C - quadratic coefficient (s/m^2/kg) ! q - horizontal saltation/creep discharge (kg/m/s) dq_dx_1 = A + B*q -C*q*q END FUNCTION dq_dx_1 ! +++ PURPOSE +++ ! Calculate the "intercept" component of the vertical flux in the ! control volume for the saltation/creep component REAL FUNCTION A (SFssen, Cen, 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) :: qen ! transport capacity ! A - "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) ! qen - transport capacity (kg/m/s) A = (1.0 - SFssen) * Cen * qen END FUNCTION A ! +++ PURPOSE +++ ! Calculate the "linear" component of the vertical flux in the ! control volume for the saltation/creep component REAL FUNCTION B (SFssan, Fancr, Cancr, Fancl, Cancl, SFssen, Cen, & & Cbk, Ci, Ct, qcp, qen) ! "linear" component of vert. flux eqn. 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) :: SFssen ! mass fract. of susp-size among loose aggs REAL, INTENT (IN) :: Cen ! coefficient of emission REAL, INTENT (IN) :: Cbk ! coefficient of breakage REAL, INTENT (IN) :: Ci ! coefficient of plant interception REAL, INTENT (IN) :: Ct ! coefficient of surface trapping REAL, INTENT (IN) :: qcp ! transport capacity of the surface when >= 40% armored REAL, INTENT (IN) :: qen ! transport capacity ! B - "linear" component of vertical flux (unitless) ! 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) ! SFssen - mass fraction of susp-size (<0.10 mm) among loose aggs (<2.0 mm dia.) ! Cen - coefficient of emission (1/m) ! Cbk - coefficient of breakage (1/m) ! Fs_bk - mass fraction of (breakable) coarse sand particles (sfsan-sfvfs) ! Ci - coefficient of plant interception (1/m) ! Ct - coefficient of surface trapping (1/m) ! qcp - transport capacity of the surface when >=40% armored (kg/m/s) ! qen - transport capacity (kg/m/s) B = (1.0 - SFssan)*((Fancr*Cancr) + (Fancl*Cancl)) - & & (1.0 - SFssen)*Cen - Cbk - Ci - Ct*(1.0 - qcp/qen) END FUNCTION B ! +++ PURPOSE +++ ! Calculate the "quadratic" component of the vertical flux in the ! control volume for the saltation/creep component REAL FUNCTION C (SFssan, Fancr, Cancr, Fancl, Cancl, qen) ! "quadratic" component of vert. flux eqn. 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) :: qen ! transport capacity ! C - quadratic coefficient (s/m^2/kg) ! 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) ! qen - transport capacity (kg/m/s) C = (1.0 - SFssan) * (((Fancr*Cancr) + (Fancl*Cancl)) / qen) END FUNCTION C ! +++ PURPOSE +++ ! Calculate intermediate tmp value used in computing ! saltation/creep component (and suspension) REAL FUNCTION S (A, B, C) ! intermediate tmp value IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: A ! intercept coefficient REAL, INTENT (IN) :: B ! linear coefficient REAL, INTENT (IN) :: C ! quadratic coefficient ! S - intermediate tmp value ! A - intercept coefficient (kg/m^2/s) ! B - linear coefficient (unitless) ! C - quadratic coefficient (s/m^2/kg) S = (4.0*A*C + B*B)**0.5 END FUNCTION S ! +++ PURPOSE +++ ! Calculate intermediate tmp value used in computing ! saltation/creep component (and suspension) REAL FUNCTION p (S, B, C, qi) ! intermediate tmp value IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: S ! intermediate tmp value REAL, INTENT (IN) :: B ! linear coefficient REAL, INTENT (IN) :: C ! quadratic coefficient REAL, INTENT (IN) :: qi ! incoming saltation/creep ! p - intermediate tmp value ! S - intermediate tmp value ! B - linear coefficient (unitless) ! C - quadratic coefficient (s/m^2/kg) ! qi - incoming horizontal saltation/creep (kg/m) p = (-(C+C)*qi + B) / S END FUNCTION p !----------------------------------------------------------------------- ! +++ PURPOSE +++ ! Calculate net soil loss from the ! control volume for the saltation/creep component REAL FUNCTION qo (A, B, C, lx, qi) ! net saltation/creep discharge IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: A ! intercept coefficient REAL, INTENT (IN) :: B ! linear coefficient REAL, INTENT (IN) :: C ! quadratic coefficient REAL, INTENT (IN) :: lx ! length of control volume REAL, INTENT (IN) :: qi ! incoming saltation/creep ! qo - net saltation/creep discharge (kg/m) ! A - intercept coefficient (kg/m^2/s) ! B - linear coefficient (unitless) ! C - quadratic coefficient (s/m^2/kg) ! lx - length of control volume (m) ! qi - incoming horizontal saltation/creep (kg/m) REAL :: S, p, t1 ! temporary variables S = (4.0*A*C + B*B)**0.5 p = (-(C+C)*qi + B) / S qo = S/(C+C)*(-tanh((S/2.0)*(-lx) + 0.5*log((1+p)/(1-p))) + B/S) END FUNCTION qo ! +++ PURPOSE +++ ! Calculate net soil loss from the ! control volume for the saltation/creep component REAL FUNCTION qo_1 (A, B, C, lx, qi) ! net saltation/creep discharge IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: A ! intercept coefficient REAL, INTENT (IN) :: B ! linear coefficient REAL, INTENT (IN) :: C ! quadratic coefficient REAL, INTENT (IN) :: lx ! length of control volume REAL, INTENT (IN) :: qi ! incoming saltation/creep ! qo - net saltation/creep discharge (kg/m) ! A - intercept coefficient (kg/m^2/s) ! B - linear coefficient (unitless) ! C - quadratic coefficient (s/m^2/kg) ! lx - length of control volume (m) ! qi - incoming horizontal saltation/creep (kg/m) REAL :: S, p, t1 ! 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 p ! to go out of range (-1 < p < 1) - LEW IF (p .le. -1.0) THEN t1 = -20.0 ! Why the arbritrary values? ELSE IF (p .ge. 1.0) THEN t1 = 20.0 ! Why the arbritrary values? ELSE t1 = (S/2.0)*(-lx) + 0.5*log((1+p)/(1-p)) END IF !qo = S/(C+C)*(-tanh((S/2.0)*(-lx) + 0.5*log((1+p)/(1-p))) + B/S) qo_1 = S/(C+C) * (-tanh(t1) + B/S) END FUNCTION qo_1 ! +++ PURPOSE +++ ! Calculate net soil loss from the ! control volume for the saltation/creep component REAL FUNCTION qo_2 (A, B, C, lx, qi, S, p) ! net saltation/creep discharge IMPLICIT NONE ! +++ ARGUMENT DECLARATIONS +++ REAL, INTENT (IN) :: A ! intercept coefficient REAL, INTENT (IN) :: B ! linear coefficient REAL, INTENT (IN) :: C ! quadratic coefficient REAL, INTENT (IN) :: lx ! length of control volume REAL, INTENT (IN) :: qi ! incoming saltation/creep REAL, INTENT (IN) :: S ! intermediate tmp value REAL, INTENT (IN) :: p ! intermediate tmp value ! qo_2 - net saltation/creep discharge (kg/m) ! A - intercept coefficient (kg/m^2/s) ! B - linear coefficient (unitless) ! C - quadratic coefficient (s/m^2/kg) ! lx - length of control volume (m) ! qi - incoming horizontal saltation/creep (kg/m) ! S - intermediate tmp value ! p - intermediate tmp value qo_2= S/(C+C)*(-tanh((S/2.0)*(-lx) + 0.5*log((1+p)/(1-p))) + B/S) END FUNCTION qo_2