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