!*==sbinit.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/sbinit.for $
!**********************************************************************
!     subroutine sbinit
!**********************************************************************
 
      subroutine sbinit
      use i_p1werm
      use i_m1subr
      use i_s1phys
      use i_s1agg
      use i_s1dbh
      use i_s1surf
      use i_s1sgeo
      use i_b1glob
      use i_w1clig
      use i_p1erode
      use i_m2geo
      use i_e2grid
      use i_s2agg
      use i_s2surf
      use i_s2sgeo
      use i_e2erod
      use s_sbpm10
      use s_sbsfdi
      implicit none
!*--SBINIT36
!
!*** Start of declarations rewritten by SPAG
!
! Local variables
!
      integer :: i,icsr,j
      real,dimension(mnsub) :: sfd1,sfd10,sfd200,sfd84
!
!*** End of declarations rewritten by SPAG
!
 
!     +++ purpose +++
!     Input subregion values of variables from other submodels
!     to the grid points of the erosion submodel which erosion changes
!     Initialize output grid array
!     Calc. soil fraction of 4 dia. from asd, & rr shelter angles
!
!     +++ ARGUMENT DECLARATIONS +++
!
!     +++ ARGUMENT DEFINITIONS +++
!
!     +++ PARAMETER +++
!
!     + + + GLOBAL COMMON BLOCKS + + +
 
!
!     + + +  LOCAL COMMON BLOCKS + + +
!
!
!     + + + LOCAL VARIABLES + + +
 
!     + + + LOCAL VARIABLE DEFINITIONS + + +
!     icsr  = index of current subregion
!
!     + + + SUBROUTINES CALLED + + +
!     sbsfdi
!     sbpm10
!     + + + END SPECIFICATION + + +
!
!     calculate abrasion and pm10 parameters    edit LH 3-4-05
      do icsr = 1,nsubr
         call sbpm10&(aseags(1,icsr),asecr(icsr),asfcla(1,icsr),        &
                   & asfsan(1,icsr),&awzypt,acanag(icsr),acancr(icsr),  &
                   & &asf10an(icsr),asf10en(icsr),asf10bk(icsr))
!
!     calculate fraction less than diameter from asd
!       determine current subregion
!      do 5  icsr = 1, nsubr
         call sbsfdi&(aslagm(1,icsr),as0ags(1,icsr),aslagn(1,icsr),     &
                   & &aslagx(1,icsr),0.01,sfd1(icsr))
         call sbsfdi&(aslagm(1,icsr),as0ags(1,icsr),aslagn(1,icsr),     &
                   & &aslagx(1,icsr),0.1,sfd10(icsr))
         call sbsfdi&(aslagm(1,icsr),as0ags(1,icsr),aslagn(1,icsr),     &
                   & &aslagx(1,icsr),0.84,sfd84(icsr))
!     store initial sf84
         sf84ic = sfd84(icsr)
         sf84ic = min(0.9999,max(sf84ic,0.0001))           !set limits
!     store initial sf10
         sf10ic = sfd10(icsr)
!
!^^^ tmp out
!      write (*,*)
!      write (*,*) 'sbinit out'
!      write (*,*) 'aslagm as0ags aslagn aslagx sfd84',
!     &     aslagm(1,icsr), as0ags(1,icsr),aslagn(1,icsr),
!     &     aslagx(1,icsr),sfd84(icsr)
!      write (*,*)
!^^^ tmp end
 
         call sbsfdi&(aslagm(1,icsr),as0ags(1,icsr),aslagn(1,icsr),     &
                   & &aslagx(1,icsr),2.0,sfd200(icsr))
      end do
!
      do j = 0,jmax
         do i = 0,imax
 
!     determine subregion (at present only 1 subregion)
!     input variables to grid cells
            icsr = csr(i,j)
            sf1(i,j) = sfd1(icsr)
            sf10(i,j) = sfd10(icsr)
            sf84(i,j) = sfd84(icsr)
            sf200(i,j) = sfd200(icsr)
!     edit ljh - 1-22-04
            svroc(i,j) = asvroc(1,icsr)
                                     ! if ifc has surface rock, 1st index maybe 0.
!
            szcr(i,j) = aszcr(icsr)
            sfcr(i,j) = asfcr(icsr)
            smlos(i,j) = asmlos(icsr)
            sflos(i,j) = asflos(icsr)
!
            szrgh(i,j) = aszrgh(icsr)
 
      !initialize RR values for each grid cell
            slrr(i,j) = aslrr(icsr)
 
            if (slrr(i,j)<slrr_min) then
               slrr(i,j) = slrr_min
            else if (slrr(i,j)>slrr_max) then
               slrr(i,j) = slrr_max
            end if
 
            dmlos(i,j) = 0.0
            smaglos(i,j) = 0.0
            smaglosmx(i,j) = 0.0
            sf84mn(i,j) = 0.0
!
!     initialize output array- now in sbigrd
!      egt(i,j)    = 0
!      egtss(i,j)  = 0
!      egt10(i,j)  = 0
!
         end do
      end do
!
      end subroutine sbinit