!*==sbwind.spg  processed by SPAG 6.70Rc at 15:33 on 10 Dec 2012
!*------------------   SPAG Configuration Options   --------------------
!*--0323,76 000101,-1 000000102011332010100002000000210211210,136 10 --
!*--1100000011112111000000000000,10,10,10,10,10,10,900,100 200000000 --
!*--000000010000000000000,72,72 73,42,38,33 00011112110000100000000  --
!*----------------------------------------------------------------------
!$Author: joelevin $
!$Date: 2011-03-24 11:33:26 -0500 (Thu, 24 Mar 2011) $
!$Revision: 11724 $
!$HeadURL: https://eweru-dev1.eweru.ksu.edu/svn/code/weps1/branches/WEPS_F90_update/weps.src/src/lib_erosion/sbwind.for $
!***********************************************************************
!*     subroutine sbwind
!***********************************************************************
      subroutine sbwind(wustfl,awu,wind_dir,ntstep,intstep,rusust)
      use i_p1werm
      use i_c1gen
      use i_m1geo
      use i_b1glob
      use i_c1glob
      use i_d1glob
      use i_h1db1
      use i_p1const
      use i_s1agg
      use i_s1dbh
      use i_s1sgeo
      use i_m2geo
      use i_w2wind
      use i_e2grid
      use i_e3grid
      use i_s2agg
      use i_s2sgeo
      use i_s2surf
      use s_sbwus
      use s_sbwust
      use s_sbzo
      implicit none
!*--SBWIND37
!
!*** Start of declarations rewritten by SPAG
!
! Dummy arguments
!
      real :: awu,rusust,wind_dir
      integer :: intstep,ntstep,wustfl
      intent (in) intstep,ntstep,wustfl
      intent (inout) rusust
!
! Local variables
!
      real :: at,brcd,rintstep,sfcv,wubsts,wucdts,wucsts,wucwts,wzorg,  &
            & wzorr,wzzo,wzzov
      integer :: i,icsr,j,k
!
!*** End of declarations rewritten by SPAG
!
!
!     +++ PURPOSE +++
!     to update wzzo at each grid point;
!     To update  soil friction velocity on each grid point
!     and modify it for barriers and hills;
!     To initialize en thresh. and cp thresh. fr. velocites on grid;
!     To calculate max ratios of friction velocity to threshold
!     friction velocity
!
!     +++ ARGUMENT DECLARATIONS +++
!
!     +++ ARGUMENT DEFINITIONS +++
!     intstep  - current index of ntstep thru time
!     ntstep   - max. no. of time steps in day
!     icsr     - index of current subregion.
!     wusp     - subregion soil threshold friction vel. trans. cap. (m/s)
!     rusust    - max ratio of friction velocity to thresh. friction vel.
!     imax     - no. grid intervals in x-direction.
!     jmax     - no. grid intervals in y-direction.
!     wus      - soil friction velocity at grid points corrected for
!                hills and barriers (m/s).
!     wust     - threshold fr. vel. for en. at grid points
!     wusp     - threshold fr. vel. for trans. cap. at grid points
!     wind_dir - direction of wind (degrees from north)
!
!     + + + GLOBAL COMMON BLOCKS + + +
 
!
!     + + + LOCAL COMMON BLOCKS + + +
!
!     +++ LOCAL VARIABLES +++
!
!     +++ SUBROUTINES CALLED
!     sbzo
!     sbwus
!     sbwust
!
!     + + + END SPECIFICATIONS + + +
 
!     assign subregion index, currently only one
      icsr = 1
      rusust = 0.1
 
!     loop through grid interior to update
      do i = 1,imax - 1
         do j = 1,jmax - 1
 
!     update aerodynamic roughness
! ^^^ tmp out
!     write (*,*) 'in sbwind, call to sbzo'
 
            call sbzo&(sxprg(icsr),szrgh(i,j),slrr(i,j),&wzoflg,        &
                    & adrlaitot(icsr),adrsaitot(icsr),abzht(icsr),      &
                    & &acrlai(icsr),acrsai(icsr),aczht(icsr),           &
                    & &acxrow(icsr),ac0rg(icsr),wzorg,wzorr,&wzzo,wzzov,&
                    & awzzo,brcd)
 
! ^^^ tmp out
!      write (*,*) 'in sbwind, call to sbwus'
!     update surface (below canopy) friction velocity
 
            call sbwus(anemht,awzzo,awu,wzzov,brcd,wus(i,j))
 
!     correct friction velocity for hills
!      if (nhill .ne. 0 ) then
!           wus(i,j) = wus(i,j) * w0hill(i,j,kbr)
!        endif
!
!     correct friction velocity for barriers
            if (nbr/=0) wus(i,j) = wus(i,j)*w0br(i,j,kbr)
 
            if (wustfl==1) then
        ! update threshold friction velocities
        ! calculate hour k for surface water content
               rintstep = intstep
               k = aint(rintstep*23.75/ntstep) + 1
 
               call sbwust&(sf84(i,j),asdagd(1,icsr),sfcr(i,j),         &
                         & svroc(i,j),&sflos(i,j),abffcv(icsr),wzzo,    &
                         & ahrwc0(k,icsr),ahrwcw(1,icsr),&wus(i,j),     &
                         & sf84ic,asvroc(1,1),dmlos(i,j),&wust(i,j),    &
                         & wusp(i,j),wusto,sf84mn(i,j),smaglos(i,j),    &
                         & &smaglosmx(i,j),wubsts,wucsts,wucwts,wucdts, &
                         & sfcv)
 
! ^^^ tmp out
!      if( wust(i,j) .le. 0.0 ) then
!       write(*,*) "sbwind: i,j", i, j
!       write(*,*) "sbwind: wus(i,j), wust(i,j), rusust",                &
!     &            wus(i,j), wust(i,j), rusust
!       write(*,*) "sf84(i,j) = ", sf84(i,j)
!       write(*,*) "asdagd(1,icsr)", asdagd(1,icsr)
!       write(*,*) "sfcr(i,j)", sfcr(i,j)
!       write(*,*) "svroc(i,j)", svroc(i,j)
!       write(*,*) "sflos(i,j) ",sflos(i,j)
!       write(*,*) "abffcv(icsr)", abffcv(icsr)
!       write(*,*) "wzzo", wzzo
!       write(*,*) "ahrwc0(k,icsr)", ahrwc0(k,icsr)
!       write(*,*) "ahrwcw(1,icsr)", ahrwcw(1,icsr)
!       write(*,*) "wus(i,j)", wus(i,j)
!       write(*,*) "sf84ic", sf84ic
!       write(*,*) "rusust", rusust
!       write(*,*) "asvroc(1,1)", asvroc(1,1)
!       write(*,*) "dmlos(i,j)", dmlos(i,j)
!       write(*,*) "wust(i,j)", wust(i,j)
!       write(*,*) "wusp(i,j)", wusp(i,j)
!       write(*,*) "sf84mn(i,j)", sf84mn(i,j)
!       write(*,*) "smaglos(i,j)", smaglos(i,j)
!       stop
!      end if
 
            end if
 
            at = wus(i,j)/wust(i,j)
            rusust = amax1(rusust,at)
 
         end do
      end do
 
!     write (*,*) 'at exit sbwind rusust =', rusust
!     write (*,*) ' wus(3,3), wust(3,3)', wus(3,3), wust(3,3)
 
      end subroutine sbwind