c********************************************************************** c subroutine sbwust c********************************************************************** subroutine sbwust i (slagm, s0ags, slagn, slagx, sdagd, sfcr, svroc, sflos, bffcv, i wzzo, hrwc, hrwcw, o wust, wusp) c c + + + PURPOSE + + + c Calculate threshold soil surface friction velocity c as a function of ag size dist., aerodynamic roughness, c crust, rock, & flat biomass cover,and soil surface wetness c c + + + ARGUMENT DECLARATIONS + + + real*4 slagm, s0ags, slagn, slagx, sdagd, sfcr, svroc, sflos real*4 bffcv,wzzo, hrwc, hrwcw, wust, wusp c c + + + ARGUMENT DEFINITIONS + + + c slagm - aggregate distribution geometric mean diameter (mm). c s0ags - aggregate distribution geometric standard deviation. c slagn - aggregate distribution lower limit (mm). c slagx - aggregate distribution upper limit (mm). c sdagd - aggregate density (Mg/m^3) c sfcr - fraction of crust cover. c svroc - surface vol. rock > 2.0 mm (m^3/m^3). c sflos - soil fraction loose material cover on crust (m^3/m^3) c bffcv - biomass fraction of flat cover (m^2/m^2) c wzzo - aerodynamic roughness length (mm). c hrwc - soil water content on mass basis (at surface) (kg/kg). c hrwcw - soil water content on mass basis, at -1.5 MPa (kg/kg) c wust - friction velocity theshold for en (m/s) c wusp - friction velocity threshold of tp and trans. cap.(m/s) c c + + + LOCAL VARIABLES + + + real*4 sfcv, b1, b2, wubsts, wucsts, wucwts real*4 sf84, sfccv c c + + + END SPECIFICATIONS + + + c c calc soil mass < 0.84 mm call sbsfdi i(slagm, s0ags, slagn, slagx, 0.84, o sf84) c c calc fraction bare surface that does not emit sfcv = ((1 - sfcr)*(1 - sf84) + sfcr - sflos)*(1 - svroc) +svroc c to avoid a zero value sfcv = sfcv + 0.0001 c c calculate bare static threshold friction velocity b1 = -0.179 + 0.225*(alog(1 + wzzo))**0.891 b2 = 0.3 + 0.06*wzzo**1.2 wubsts = 1.7 - 1.35*exp(-b1-b2*sfcv**2) wusp = 1.7 - 1.35*exp(-b1-b2*0.4**2) c c calculate change in surface cover & threshold vel with flat biomass sfccv = (1 - sfcv)*bffcv if (sfccv .gt. 0) then wucsts = sfccv else wucsts = 0.0 endif c c calc change in threshold vel with wetness C *** debugging fix C *** if ( (hrwc/hrwcw) .gt. 0.2) then if ( (hrwc/hrwcw) .gt. 0.3) then C *** eodf wucwts = 0.48*hrwc/hrwcw else wucwts = 0.0 endif c c calc final static threshold friction velocity wust = wubsts + wucsts + wucwts wusp = wusp + wucsts + wucwts c correct for ag density, if needed c wust = wust * 2.65/sdagd wusp = wusp * sdagd/sdagd c c temp out code return end c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++