subroutine aptalsh (xl, xr, nbins, nb, np, xran, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTALSH
c
c     call aptalsh (xl, xr, nbins, nb, np, xran, nerr)
c
c     Version:  aptalsh  Updated    1990 July 19 13:00.
c               aptalsh  Originated 1990 July 19 13:00.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To randomly sample np values of xran from nbins bins.
c               Each bin has a relative probability distribution function
c               which is uniform from xl(n) on the left to xr(n) on the right.
c               Each value xran(n) is to be sampled from bin nb(n), where nb
c               must be in the range from 1 to nbins.
c               Flag nerr indicates any input error.
c
c     Note:     Use subroutines aptalsb, aptalst, aptcums, aptcumt,
c               apteqsb or apteqxs to randomly sample the bin indices nb
c               from any tabulated aliased, cumulative, or equal-probability
c               probability distribution function.
c               Use subroutine aptalsl instead of aptalsh when the distribution
c               in each bin is linear instead of uniform.
c
c     Input:    xl, xr, nbins, nb, np.
c
c     Output:   xran, nerr.
c
c     Glossary:
c
c     nb        Input    Bin number for which a value of xran is to be randomly
c                          sampled.  Must be in the range from 1 to nbins.
c                          Size np.
c
c     nbins     Input    Size of arrays xl, xr.
c
c     nerr      Output   Indicates an input error, if not 0.
c                          1 if nbins is not positive.
c                          2 if np is not positive.
c
c     np        Input    Number of random samples xran.  Size of nb, xran.
c
c     xl, xr    Input    Values of random variable xran at the left and right
c                          boundaries of the bin, respectively.  Size nbins.
c
c     xran      Output   Randomly sampled value from bin nb(n).  Size np.
c                          in the range from xl(nb(n)) to xr(nb(n).
c                          In a bin, the expected value of xran is
c                           = 0.5 * (xl + xr).
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

c---- Index of bin to be sampled.
      dimension nb      (1)
c---- Value of xran at left of bin.
      dimension xl      (1)
c---- Value of xran at right of bin.
      dimension xr      (1)
c---- Randomly sampled value of xran.
      dimension xran    (1)

c.... Local variables.

c---- Index in local array.
      common /laptalsh/ n
c---- First index of subset of data.
      common /laptalsh/ n1
c---- Last index of subset of data.
      common /laptalsh/ n2
c---- Index of a bin.
      common /laptalsh/ nbin
c---- Index in external array.
      common /laptalsh/ nn
c---- Size of current subset of data.
      common /laptalsh/ ns
c---- Random number from 0.0 to 1.0.
      common /laptalsh/ ranfp   (64)
cbugc***DEBUG begins.
cbugc---- Mean value of sample in bin.
cbug      common /laptalsh/ xavg
cbugc---- Total of samples in bin.
cbug      common /laptalsh/ xtot
cbug 9901 format (/ 'aptalsh sampling from specified uniform bins.' /
cbug     &  (i3,' xl,xr=',1p2e22.14))
cbug 9902 format (/ 'np=',i5,'  nb=' / (20i4))
cbug      write ( 3, 9901) (n, xl(n), xr(n), n = 1, nbins)
cbug      write ( 3, 9902) np, (nb(n), n = 1, np)
cbugc***DEBUG ends.

c.... initialize.

      nerr = 0

c.... Test for input errors.

      if (nbins .le. 0) then
        nerr = 1
        go to 210
      endif

      if (np .le. 0) then
        nerr = 2
        go to 210
      endif

c.... Set up the indices of the first subset of data.

      n1 = 1
      n2 = min (np, 64)
c---- Loop over subset of samples.
  110 ns = n2 - n1 + 1

c.... Generate ns pairs of random numbers.

c---- Loop over local arrays.
      do 120 n = 1, ns
        ranfp(n) = ranf( )
c---- End of loop over local arrays.
  120 continue

c.... Randomly sample values of xran from the bins.

c---- Loop over samples.
      do 130 n = 1, ns

        nn       = n + n1 - 1
        nbin     = nb(nn)
        xran(nn) = xl(nbin) + ranfp(n) * (xr(nbin) - xl(nbin))

c---- End of loop over samples.
  130 continue

c.... See if all data subsets are done.

c---- Do another subset of samples.
      if (n2 .lt. np) then
        n1 = n2 + 1
        n2 = min (np, n1 + 63)
c---- End of loop over subset of samples.
        go to 110
      endif
cbugc***DEBUG begins.
cbug 9903 format (/ 'aptalsh results:  xran')
cbug 9904 format ('  n=',i5,' nb=',i3,' xran=',1pe22.14)
cbug      write ( 3, 9903)
cbug      write ( 3, 9904) (n, nb(n), xran(n), n = 1, np)
cbug
cbug 9905 format (/ '  summary by bins:')
cbug 9906 format (i5,' xavg=',1pe22.14,' samples=',i5)
cbug      write ( 3, 9905)
cbugc---- Loop over bins.
cbug      do 150 nbin = 1, nbins
cbug        ns   = 0
cbug        xtot = 0.0
cbugc---- Loop over samples.
cbug        do 140 n = 1, np
cbug          if (nb(n) .eq. nbin) then
cbug            ns   = ns + 1
cbug            xtot = xtot + xran(n)
cbug          endif
cbugc---- End of loop over samples.
cbug  140   continue
cbug        xavg = xtot / (ns + 1.e-99)
cbug        write ( 3, 9906) nbin, xavg, ns
cbugc---- End of loop over bins.
cbug  150 continue
cbugc***DEBUG ends.

  210 return

c.... End of subroutine aptalsh.      (+1 line.)
      end

UCRL-WEB-209832