c$Header: /weru/cvs/weps/weps.src/asd/asd2m.for,v 1.3 1999-04-06 18:03:17 wjr Exp $
c
c
c	  
      subroutine asd2m
     i                 (mnot, minf, gmd, gsd,
     o                 nlay, mf)

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

c     + + + PURPOSE + + +
c     This subroutine  performs the inverse of subroutine m2asd.
c     asd2m computes the mass fractions for each sieve cut from the
c     lognormal representation of the soil aggregate size distribution.
c
c     The routine decides which lognormal case to apply based on the
c     value of logcas:
c
c     logcas = 0 --> "normal" lognormal case (mnot = 0, minf = infinity)
c     logcas = 1 --> "abnormal" lognormal case (mnot != 0, minf = infinity)
c     logcas = 2 --> "abnormal" lognormal case (mnot = 0, minf != infinity)
c     logcas = 3 --> "abnormal" lognormal case (mnot != 0, minf != infinity)
c
c     + + + KEYWORDS + + +
c     aggregate size distribution, asd, sieves, mass fractions
c
c     + + + ARGUMENT DECLARATIONS + + +
      real    mnot(mnsz), minf(mnsz)
      real    gmd(mnsz), gsd(mnsz)
      integer nlay
      real    mf(msieve+1,mnsz)
c
c
c     + + + ARGUMENT DEFINITIONS + + +
c     mnot   - minimum size aggregate (assumed value is known)
c     minf   - maximum size aggregate (assumed value is known)
c     gmd    - geometric mean diameter of aggregate size distribution
c              (or transformed asd for "modified" lognormal cases)
c     gsd    - geometric standard deviation of aggregate size distribution
c              (or transformed asd for "modified" lognormal cases)
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     nsieve - number of sieves used
c     sdia   - array containing sieve size diameters
c     mdia   - geometric mean dia. for each sieve cut
c     logcas - flag to represent which lognormal case to apply
c
c
c     + + + PARAMETERS + + +
c
c     + + + LOCAL VARIABLES + + +
c
      real     d(msieve+1)
      real     alngmd, alngsd
      real     prev, this
      integer  i, j
      real     erf
c
c     + + + LOCAL VARIABLE DEFINITIONS + + +
c
c     d      - transformed sieve dia. values
c              (if "abnormal" lognormal cases)
c     alngmd - alog(gmd)
c     alngsd - alog(gsd)
c     prev   - contain previous sieve dia. cumulative prob
c     this   - contain this sieve dia. cumulative prob
c     i      - loop variable for sieve sizes
c     j      - loop variable for soil layers
c
c     + + + END SPECIFICATIONS + + +
c
      do 20 j = 1, nlay
c                              compute transformed sieve dia. sizes
          if (logcas .eq. 3) then
              do 1 i = 1, nsieve
                   if (sdia(i) .lt. minf(j)) then
                      d(i) = (sdia(i)-mnot(j))*(minf(j)-mnot(j))/
     &                       (minf(j)-sdia(i))
                   end if
   1          continue
          elseif (logcas .eq. 2) then
              do 2 i = 1, nsieve
                   if (sdia(i) .lt. minf(j)) then
                      d(i) = sdia(i)*minf(j)/(minf(j)-sdia(i))
                   end if
2             continue
          elseif (logcas .eq. 1) then
              do 3 i = 1, nsieve
                   d(i) = sdia(i)-mnot(j)
3             continue
          elseif (logcas .eq. 0) then
              do 4 i = 1, nsieve
                   d(i) = sdia(i)
4             continue
          endif
          alngmd= alog(gmd(j))
          alngsd= sqrt(2.0) * alog(gsd(j))
          prev= 1.0

c         compute each dia. cumulative probability
          do 10 i = 1, nsieve
              if (sdia(i) .lt. minf(j)) then
                 this = 0.5 -0.5*erf((alog(d(i)) - alngmd) / alngsd)
              else
                 this = 1.0
              end if
c             compute mass fraction between prev and this dia
              mf(i,j) = prev - this

c             if roundoff errors or otherwise results in negative
c             mass fraction then set to zero mass
              if (mf(i,j) .lt. 0.0) then
                  mf(i,j) = 0.0
              else
                  prev = this
              endif

10        continue

c         get mass fraction for upper-most sieve cut
          mf(nsieve+1,j) = prev

20    continue
      return
      end
c
c$Log: not supported by cvs2svn $
cRevision 1.1.1.1  1999/03/12 17:05:17  wagner
cBaseline version of WEPS with Bill Rust's modifications
c
c Revision 1.2  1995/09/13  15:49:32  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.4  1994/09/01  22:18:54  jt
c checking for floating point errors? - LEW
c
c Revision 1.3  1992/10/10  21:44:14  wagner
c Changed names appropriate for submodel name change
c from TILLAGE to MANAGEMENT.
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