c$Header: /weru/cvs/weps/weps.src/asd/asd2m.for,v 1.3.8.2 2001-08-15 22:12:33 fredfox 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
c              if( j.eq.1 ) write(*,*) 'asd2m: mf(',i,j,')',mf(i,j)
  10      continue

c         get mass fraction for upper-most sieve cut
          mf(nsieve+1,j) = prev
c        if( j.eq.1 )write(*,*)'asd2m: mf(',nsieve+1,j,')',mf(nsieve+1,j)

c         zero out the rest of the array which is used every where else
          do i=nsieve+2, msieve+1
              mf(i,j) = 0.0
          end do

  20  continue
      return
      end
c
c$Log: not supported by cvs2svn $
cRevision 1.3.8.1  2001/07/05 19:04:09  fredfox
cPrevious change in method of data initialization did not account for using fewer than maximum number of sieves. Creation of sieve cuts extended to zero out all possible sieve elements
c
cRevision 1.3  1999/04/06 18:03:17  wjr
cremoved debugging lines
c
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