c$Author: fredfox $
c$Date: 2001-09-27 20:37:43 $
c$Revision: 1.2 $
c$Source: /weru/cvs/weps/weps.src/hydro/fricfact.for,v $
      real*4 function fricfact(ref_ranrough, ranrough,
     &                         tot_stems, tot_flat_cov )

c     + + + PURPOSE + + +
c     returns the darcy weisbach friction factor based on random roughness,
c     standing and flat biomass adapted from WEPP (chapter 10)

c     + + + KEY WORDS + + +
c     hydrology, overland flow

c     + + + ARGUMENT DECLARATIONS + + +
      real*4 ref_ranrough, ranrough,
     &       tot_stems, tot_flat_cov,
     &       dw_friction

c     + + +  ARGUMENT DEFINITIONS + + +
c     ref_ranrough   - random roughness of soil surface after last tillage (m)
c     cum_rain       - accumulated rainfall since last rainfall (m)
c     ranrough       - present random roughness (m)
c     tot_stems      - total number of standing stems (#/m^2)
c     tot_flat_cov   - fraction of soil surface covered by flat biomass
c     dw_friction    - darcy weisbach friction factor

c     + + + LOCAL VARIABLES + + +
      real*4 coef_a, coef_b, coef_c, coef_d,
     &       coef_e, coef_f, coef_g, coef_h,
     &       f_stem_max, f_stem, f_flat, f_soil, fsoil_ref,
     &       tot_stems_max, f_soil_ref
      parameter( coef_a = 14.5 )
      parameter( coef_b = 1.55 )
      parameter( coef_c = 3.02 )
      parameter( coef_d = -5.04 )
      parameter( coef_e = -161.0 )
      parameter( coef_f = 0.5 )
      parameter( coef_g = 1.13 )
      parameter( coef_h = -3.09 )

      parameter( f_stem_max = 12 )
      parameter( tot_stems_max=220 )

c     this relationship is unproven, but does give some variation as desired
      f_stem = f_stem_max * tot_stems / tot_stems_max

      f_flat = coef_a * tot_flat_cov ** coef_b

      f_soil_ref = exp( coef_c + coef_d * exp( coef_e * ref_ranrough ))
      if( ref_ranrough.le.ranrough ) then
           f_soil = coef_f * f_soil_ref ** coef_g
      else
           f_soil = coef_f * f_soil_ref ** coef_g 
     &            * exp( coef_h * (1.0-ranrough/ref_ranrough))
      endif

      fricfact = f_stem + f_flat + f_soil

      return
      end