c$Header: /weru/cvs/weps/weps.src/mproc/crush.for,v 1.3 2000-09-29 19:36:44 fredfox Exp $
c
c
      subroutine crush
     i                 (alpha, beta,
     i                 nlay,
     m                 mf)

*$noreference
      include 'p1werm.inc'
      include 'manage/asd.inc'
*$reference

c     + + + PURPOSE + + +
c     This subroutine  performs the crushing or breaking down of
c     soil aggregates into smaller sizes based on the initial aggregate
c     size distribution and two crushing parameters (alpha and beta).
c     The crushing parameters are assumed to be a function of the
c     soil intrinsic properties, soil water content, and tillage implement.
c     
c     + + + KEYWORDS + + +
c     aggregate size distribution, asd, sieves, mass fractions
c
c     + + + ARGUMENT DECLARATIONS + + +
      real    alpha, beta
      integer nlay
      real    mf(msieve+1,mnsz)
c
c
c     + + + ARGUMENT DEFINITIONS + + +
c
c     alpha  - first crushing coefficient
c     beta   - second crushing coefficient
c     nlay   - number of soil layers used
c     mf     - mass fractions of aggregates within sieve cuts
c              (sum of all mass fractions are expected to = 1.0)
c
c     + + + ACCESSED COMMON BLOCK VARIABLE DEFINITIONS + + +
c
c     mdia   - array containing geometric mean diameters of sieve cuts
c     nsieve - number of sieves used
c
c     + + + PARAMETERS + + +
c
c     + + + LOCAL VARIABLES + + +
c
      real     pmat(msieve+1,msieve+1)
      real     dratio
      real     prob
      real     chk
      integer  i, j, k, m
      real     predmf(msieve+1)
c
c     + + + LOCAL VARIABLE DEFINITIONS + + +
c     
c     pmat   - probability matrix
c     dratio - ratio of sieve cut d to maximum sieve cut d
c     prob   - probability value
c     chk    - variable to chk prob matrix integrity
c     i      - loop variable for sieve cut sizes
c     j      - loop variable for soil layers
c     k      - loop variable for sieve cut probabilities
c     predmf - local array to hold predicted mass fractions
c              before updating mf
c
c     + + + FUNCTIONS CALLED + + +

      real     bino

c     + + + END SPECIFICATIONS + + +
c
c     for each soil layer
      do 500 j=1,nlay
c         compute transition matrix
          do 100 i=1,nsieve+1
              dratio = mdia(i)/mdia(nsieve+1)
              prob = 1.0 - exp(-alpha+dratio*beta)
              chk = 0.0
              do 50 k=1,i
                  pmat(i,k) = bino(i-1,k-1,prob)
                  chk = chk+pmat(i,k)
 50           continue
              if (abs(chk-1.0) .gt. 0.001) then
                  print*, 'Problem transition matrix (crush) chk:',
     &                    (chk-1.0)
c                 debug code to print out transition matrix
                  do 2 k=nsieve+1,1,-1
                      print*,(pmat(k,m), m=k,1,-1)
2                 continue
				  stop
              endif
100       continue
          do 300 i=1,nsieve+1
              predmf(i) = 0.0
              do 200 k=i,nsieve+1
                  predmf(i) = predmf(i) + mf(k,j) * pmat(k,i)
200           continue
300       continue
c         put predicted mass fractions into mf
          do 400 i=1,nsieve+1
              mf(i,j) = predmf(i)
400       continue
500   continue
      return
      end
c
c$Log: not supported by cvs2svn $
cRevision 1.2  2000/06/14 16:55:59  fredfox
cAdded new functionality remove.for
cAdded dubug statementments to crush.for
cAdded limit to soil typ adjustment in rough.for
c
cRevision 1.1.1.1  1999/03/12 17:05:29  wagner
cBaseline version of WEPS with Bill Rust's modifications
c
c Revision 1.2  1995/09/13  15:49:36  wagner
c Necessary changes made to allow FORTRAN src files (*.for) to use the
c extended FORTRAN include statement rather than the MICROSOFT $INCLUDE
c directive as previously used.  This is required to allow use of other
c FORTRAN compilers.
c
c Changes have been made to the prologue.mk, epilogue.mk, and the Unix
c master startup.mk files as well as the src files.
c
c Revision 1.1.1.1  1995/01/18  04:19:56  wagner
c Initial checkin
c
c Revision 1.7  1992/10/13  07:56:55  wagner
c removed debug code (commented it out)
c
c Revision 1.6  1992/10/10  21:44:14  wagner
c Changed names appropriate for submodel name change
c from TILLAGE to MANAGEMENT.
c
c Revision 1.5  1992/06/01  14:59:41  dudley
c *** empty log message ***
c
c Revision 1.4  1992/04/29  15:07:01  wagner
c *** empty log message ***
c
c Revision 1.3  1992/04/17  14:56:55  wagner
c Removed hardcoded md values (dj's).
c
c Revision 1.2  1992/04/16  21:41:37  wagner
c Uses common memory now.
c
c Revision 1.1  1992/04/16  13:29:01  wagner
c Initial revision
c