subroutine aptrfpt (np, xmin, xmax, frstr, xran, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTRFPT
c
c     call aptrfpt (np, xmin, xmax, frstr, xran, nerr)
c
c     Version:  aptrfpt  Updated    1990 December 12 12:00.
c               aptrfpt  Originated 1990 December 12 12:00.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To randomly sample np values uniformly between xmin and xmax.
c               Any fraction frstr of sampling may be striated, from 0.0 to 1.0.
c               The results are stored in xran.  All are floating-point.
c               Flag nerr indicates any input error.
c
c     WARNING:  STRIATED SAMPLING INTRODUCES CORRELATIONS BETWEEN SAMPLE INDICES
c               AND INTEGER VALUES.  USE ONLY WHEN SUCH CORRELATIONS ACCEPTABLE.
c               HOWEVER, THE RESULTS MAY BE RANDOMLY REORDERED WITH APTRAND.
c
c     Input:    np, xmin, xmax, frstr.
c
c     Output:   xran, nerr.
c
c     Glossary:
c
c     frstr     Input    The fraction (from 0.0 to 1.0) of samples to striate
c                          over the values.  Remaining samples will be
c                          randomly sampled over the values.
c
c     nerr      Output   Indicates an input error, if not 0.
c                          1 if np is not positive.
c                          2 if frstr is less than 0.0 or more than 1.0.
c
c     np        Input    Size of array xran.  Number of samples.
c
c     xmin      Input    The minimum floating-point value to be sampled.
c
c     xmax      Input    The maximum floating-point value to be sampled.
c
c     xran      Output   The randomly sampled floating-point values.  Size np.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

c---- Randomly sampled value.
      dimension xran    (1)

c.... Local variables.

c---- Index in internal array.
      common /laptrfpt/ n
c---- First index of subset of data.
      common /laptrfpt/ n1
c---- Last index of subset of data.
      common /laptrfpt/ n2
c---- Index in external array.
      common /laptrfpt/ nn
c---- Size of current subset of data.
      common /laptrfpt/ ns
c---- Number of striated samples.
      common /laptrfpt/ nstrd
c---- Number of unstriated samples.
      common /laptrfpt/ nunst
c---- Random numbers in range 0.0 to 1.0.
      common /laptrfpt/ ranfp   (64)
c---- Striated random number, 0.0 to 1.0.
      common /laptrfpt/ ranst
cbugc***DEBUG begins.
cbugc---- Mean value of xran.
cbug      common /laptrfpt/ xmean
cbugc---- Standard deviation from xmean.
cbug      common /laptrfpt/ xdev
cbug 9901 format (/ 'aptrfpt sampling from values.  np=',i5,
cbug     &  ' frstr=',f10.7 /
cbug     &  '  xmin=',1pe22.14,' xmax=',1pe22.14)
cbug      write ( 3, 9901) np, frstr, xmin, xmax
cbugc***DEBUG ends.

c.... Test for input errors.

      nerr = 0

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

      if ((frstr .lt. 0.0) .or. (frstr .gt. 1.0)) then
        nerr = 2
        go to 210
      endif

c.... Find the number of striated and unstriated samples.

      nstrd = frstr * np + 0.5
      nunst = np - nstrd

c.... See if any unstriated samples are needed.

c---- Need unstriated samples.
      if (nunst .gt. 0) then

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

        n1 = 1
        n2 = min (nunst, 64)

c....   Loop over the subset of samples.

c---- Loop over subset of samples.
  110   ns = n2 - n1 + 1

c....   Generate the needed random numbers.

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

c....   Randomly sample values.

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

          nn       = n + n1 - 1
          xran(nn) = xmin + ranfp(n) * (xmax - xmin)

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

c....   See if all subsets of samples are done.

c---- Do another subset of data.
        if (n2 .lt. nunst) then
          n1 = n2 + 1
          n2 = min (nunst, n1 + 63)
c---- End of loop over subset of samples.
          go to 110
        endif

c---- Tested nunst.
      endif

c.... See if any striated samples are needed.

c---- Need striated samples.
      if (nstrd .gt. 0) then

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

        n1 = 1 + nunst
        n2 = min (np, n1 + 63)

c....   Loop over the subset of samples.

c---- Loop over subset of samples.
  140   ns = n2 - n1 + 1

c....   Generate the needed random numbers.

c---- Loop over samples.
        do 150 n = 1, ns
          ranfp(n) = ranf( )
c---- End of loop over samples.
  150   continue

c....   Randomly sample values, using striated sampling.

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

          nn       = n + n1 - 1
          ranst    = (nn - nunst - ranfp(n)) / nstrd
          xran(nn) = xmin + ranst * (xmax - xmin)

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

c....   See if all subsets of samples are done.

c---- Do another subset of data.
        if (n2 .lt. np) then
          n1 = n2 + 1
          n2 = min (np, n1 + 63)
c---- End of loop over subset of samples.
          go to 140
        endif

c---- Tested nstrd.
      endif

  210 continue
cbugc***DEBUG begins.
cbug 9904 format (/ 'aptrfpt results:  nerr=',i3,
cbug     &  ' nunst=',i5,' nstrd=',i5)
cbug      write ( 3, 9904) nerr, nunst, nstrd
cbug      if (nerr .ne. 0) return
cbug      call aptmean (xran, np, 1.e-11, xmean, xdev, nerr)
cbugc***DEBUG ends.

      return

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

UCRL-WEB-209832