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