c$Author: fredfox $
c$Date: 2001-08-15 16:31:54 $
c$Revision: 1.7.2.2 $
c$Source: /weru/cvs/weps/weps.src/soil/updlay.for,v $
      subroutine updlay(
     *  szlyd, bhrwc0, bhrwc,
     *  bseagmx, bseagmn, bseags,
     *  bhrwca, bhrwcw,
     *  bhtsmn, bhtmx0, bhtsmx,
     *  bsecr,
     *  bsk4d, bslmin, bslmax,
     *  bslagm,
     *  bs0ags, bslagx, bsdblk,
     *  dcump, 
     *  bszlyt, bsdagd, bslay, bsdcr,
     *  bsdsblk, bsdwblk,
     *  bhzwid)

c     + + + GLOBAL COMMON BLOCKS + + +
      include 'p1werm.inc'

c     + + + ARGUMENT DECLARATIONS + + +

      real szlyd(0:mnsz),
     *  bhrwc0(mnsz), bhrwc(mnsz),
     *  bseagmx(mnsz), bseagmn(mnsz), bseags(0:mnsz),
     *  bhrwca(mnsz), bhrwcw(mnsz),
     *  bhtsmn(mnsz), bhtmx0(mnsz), bhtsmx(mnsz),
     *  bsecr
      real bsk4d(mnsz), bslmin(mnsz), bslmax(mnsz),
     * bslagm(0:mnsz),
     * bs0ags(0:mnsz), bslagx(0:mnsz), 
     * bsdblk(0:mnsz), dcump, 
     * bszlyt(mnsz), bsdagd(0:mnsz),
     * bsdcr, bsdsblk(mnsz), bsdwblk(mnsz),
     * bhzwid

      integer bslay

c     + + + LOCAL VARIABLES + + + 
      real k4f, k4w
      parameter (k4f = 1.4, k4w = 0.36)
      real se0, se1
      integer ldx

c     + + + LOCAL DEFINITIONS + + +
c   k4f       - freezing process coef. to calc. aggregate stability
c   k4w       - wetting process coef. to calc. aggregate stability
c   se0       - relative aggregate stability prior to SOIL update
c   se1       - relative aggregate stability after SOIL update

c  + + +  UPDATE LAYERS: + + +

C ***      do while ((szlyd(ldx) .le. 300.) .or. (ldx .eq. 1))
      do ldx = 1, bslay

c        check for dry soil - then no changes
         if ((bhrwc(ldx) .le. bhrwcw(ldx)) .and.
     &      (bhrwc0(ldx) .le. bhrwcw(ldx))) go to 90

         call aggsta(bseags(ldx), bseagmn(ldx), bseagmx(ldx),
     *    bhrwc0(ldx), bhrwcw(ldx), 
     *    bhrwca(ldx),
     *    bhrwc(ldx),
     *    bhtmx0(ldx), bhtsmn(ldx), bhtsmx(ldx), bsk4d(ldx),
     *    se0, k4f, se1, k4w)

         call asd(bslagm(ldx), bslmin(ldx),
     *    bslmax(ldx), bhtsmx(ldx), bs0ags(ldx),
     *    bslagx(ldx), se0, se1)

         call den(bsdblk(ldx), bsdsblk(ldx), bsdwblk(ldx),
     *    bszlyt(ldx), bsdagd(ldx), bhrwc0(ldx), bhrwc(ldx),
     *    bhrwca(ldx), bhrwcw(ldx), dcump, bhzwid)

   90    continue

c      if(ldx.eq.2) write(*,*) 'updlay:',bseags(2),se0,se1

C ***      if (szlyd(ldx) .gt. 300.) exit
      end do

c     calc. new crust stability
      bsecr = bseags(1)

c     update crust density                                         (S-58)
      bsdcr = 0.576 + 0.603 * bsdsblk(1)
      end