subroutine aptrand (xran, np, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTRAND
c
c     call aptrand (xran, np, nerr)
c
c     Version:  aptrand  Updated    2007 January 12 16:00.
c               aptrand  Originated 1990 July 23 10:00.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (415) 422-4123.
c
c
c     Purpose:  To randomize the order of the array xran(n), n = 1, np.
c               Flag nerr indicates any input errors.
c
c               For example, if xran is type integer, and consists of the
c               integers from 1 to np, the results could be used to randomly
c               reorder any table with np rows, any number of columns.
c
c     Input:    xran, np.
c
c     Output:   xran, nerr.
c
c     Glossary:
c
c     nerr      Output   Indicates an input error, if not 0.
c                          1 if np is less than 2.
c
c     np        Input    Size of array xran.
c
c     xran      In/Out   Array to be reordered randomly.  Size np.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

      dimension xran    (1)           ! Array of length np.

c.... Local variables.

      common /laptrand/ n             ! Index in array xran.
      common /laptrand/ nn            ! Index in array xran.
      common /laptrand/ xtemp         ! Temporary value of xran.
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptrand randomly reordering an array.' /
cbug     &  (i3,' xran=    ',1p3e22.14 ))
cbug      write ( 3, 9901) (n, xran(n), n = 1, np)
cbugc***DEBUG ends.

c.... initialize.

      nerr = 0

c.... Test for errors in scalar input.

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

      do 110 n = np, 2, -1            ! Loop over table swaps.

        nn       = 1 + ranf () * np
        xtemp    = xran(n)
        xran(n)  = xran(nn)
        xran(nn) = xtemp

  110 continue                        ! End of loop over table swaps.

  210 continue
cbugc***DEBUG begins.
cbug 9902 format (/ 'aptrand results:' /
cbug     &  (i3,' xran=   ',1pe22.14 ))
cbug      write ( 3, 9902) (n, xran(n), n = 1, np)
cbugc***DEBUG ends.
      return

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

UCRL-WEB-209832