subroutine sumbio(isr)
C ***************************************************************** wjr
C Contains init code from main
C
C       Edit History
C       04-Mar-99       wjr     created
C
      include 'p1werm.inc'
      include 's1layr.inc'
      include 'c1db1.inc'
      include 'b1glob.inc'
      include 'c1glob.inc'
      include 'd1glob.inc'
      include 'main/main.inc'
C
C arguments
C
      integer isr
C
C local variables
C
      integer idx,jdx
      real atotal, amax, stm_dia, a(0:mnbpls)
C
c     + + + FUNCTIONS CALLED + + +
      real    biodrag

c *****************************************************************
c     Compute total number of stems

      abdstm(isr) = acdstm(isr)
      do 10 idx=1,mnbpls
        abdstm(isr) = abdstm(isr) + addstm(idx,isr)
10    continue
c *****************************************************************
c     compute the weighted average biomass height

c     determine weighting factor (silhouette area)
      a(0) = aczht(isr) * acdstm(isr) * acxstmrep(isr)
      atotal = a(0)
      do 15 idx=1,mnbpls
        a(idx) = adzht(idx,isr) * addstm(idx,isr) * adxstmrep(idx,isr)
        atotal = atotal + a(idx)
15    continue

c     determine pool with maximum weighting factor
c     and use the stem diameter for that pool
      amax = a(0)
      stm_dia = acxstm(isr)
      do 20 idx=1,mnbpls
        if (amax .lt. a(idx)) then
          amax = a(idx)
          stm_dia = adxstmrep(idx,isr)
        end if
20    continue

	  ! check to see if we really have standing biomass out there
      if ((stm_dia .le. 0.0) .or. (abdstm(isr) .le. 0.0)) then
        abzht(isr) = 0.0
      else
        abzht(isr) = atotal / (abdstm(isr) * stm_dia)
      endif
c *****************************************************************
c     determine the pool with the tallest biomass height
c     and use that value
      abzmht(isr) = aczht(isr)
      do 30 idx=1,mnbpls
        if (abzmht(isr) .lt. adzht(idx,isr)) then
          abzmht(isr) = adzht(idx,isr)
        end if
30    continue
c *****************************************************************
c     sum the flat biomass from each pool (decomp only here)
c     sum the standing biomass from each pool
c     sum the buried biomass from each pool (decomp only here)
c     sum the root biomass from each pool
      abmf(isr) = 0.0
      abmst(isr) = acmst(isr)
      abmbg(isr) = 0.0
      abmrt(isr) = acmrt(isr)
      do 40 idx=1,mnbpls
        abmf(isr) = abmf(isr) + admf(idx,isr)
        abmst(isr) = abmst(isr) + admst(idx,isr)
        abmbg(isr) = abmbg(isr) + admbg(idx,isr)
        abmrt(isr) = abmrt(isr) + admrt(idx,isr)
40    continue
c *****************************************************************
c     sum the yield (reproductive component) of pools (only crop here)
      abmyld(isr) = acmyld(isr)
c     determine the total mass of biomass
      abm(isr) = abmst(isr) + abmf(isr) + abmbg(isr)
     &           + abmrt(isr) + abmyld(isr)
c *****************************************************************
c     sum the buried biomass by layer
c     sum the root mass by layer
      do 60 jdx=1,nslay(isr)
        abmbgz(jdx,isr) = 0.0
        abmrtz(jdx,isr) = 0.0
        do 50 idx=1,mnbpls
          abmbgz(jdx,isr) = abmbgz(jdx,isr) + admbgz(jdx,idx,isr)
          abmrtz(jdx,isr) = abmrtz(jdx,isr) + admrtz(jdx,idx,isr)
50      continue
60    continue
c *****************************************************************
c     sum the stem area index and leaf area index values
      abrsai(isr) = acrsai(isr)
      abrlai(isr) = acrlai(isr)
      do 70 idx=1,mnbpls
        abrsai(isr) = abrsai(isr) + adrsai(idx,isr)
        abrlai(isr) = abrlai(isr) + adrlai(idx,isr)
70    continue
c     compute "effective biomass (live and dead) silhouette area
c     from SAI and LAI values
      abrcd(isr) = biodrag(abrlai(isr),abrsai(isr))
c     compute "effective live crop silhouette area as SAI + LAI
      acrcd(isr) = biodrag(acrlai(isr),acrsai(isr))
c *****************************************************************
c     sum the stem area index and leaf area index values by height
c     this is based upon the "tallest" biomass pool height value
c     (abzmht) determined previously.

c     will complete later since it isn't used yet - LEW
      do 80 idx=1,mnbpls
        abrsaz(idx,isr) = 0.0
        abrlaz(idx,isr) = 0.0
80    continue
c *****************************************************************
c     sum the flat biomass cover from each pool (decomp only here)
c     sum the standing biomass cover from all pools (including canopy cover)
c     sum the total biomass cover from all pools

c     Note that these values shouldn't ever exceed 1.0 or be less than zero

      abffcv(isr) = 0.0
      abfscv(isr) = acfscv(isr)
      abftcv(isr) = acftcv(isr)
C ***        write(*,*) ' sumbio before: abffcv acfscv acftcv ',
C ***     *  abffcv(isr), acfscv(isr),acftcv(isr)
      do 100 idx=1,mnbpls
C ***          write(*,*) ' sumbio before: adffcv adfscv adftcv ',
C ***     *    adffcv(idx,isr), adfscv(idx,isr),adftcv(idx,isr)
        abffcv(isr) = abffcv(isr) + adffcv(idx,isr) * (1.0-abffcv(isr))
        abfscv(isr) = abfscv(isr) + adfscv(idx,isr) * (1.0-abfscv(isr))
        abftcv(isr) = abftcv(isr) + adftcv(idx,isr) * (1.0-abftcv(isr))
100   continue
c ***      write(*,*) ' sumbio after: abffcv abfscv abftcv ',
c ***    *  abffcv(isr), abfscv(isr),abftcv(isr)

      return
      end