subroutine aptmean (x, np, tol, xmean, xdev, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTMEAN c c call aptmean (x, np, tol, xmean, xdev, nerr) c c Version: aptmean Updated 1990 January 31 14:10. c aptmean Originated 1990 January 31 14:10. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To find, for the np values of x, the mean value xmean and c the standard deviation xdev of x from xmean. c Flag nerr indicates any input error. c c Input: x, np, tol. c c Output: xmean, xdev, nerr. c c Glossary: c c nerr Output If not 0, indicates an input error. c 1 if np is not positive. c c np Input Size of array x. c c tol Input Truncation error limit. c On Cray computers, recommend 1.e-11. c c x Input A scalar value. Size np. c c xdev Output Standard deviation of x from xmean. c sqrt (mean (x**2) - (mean (x))**2). c c xmean Output Mean value of x. Sum (x) / np. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccend. c.... Dimensioned arguments. c---- A scalar value. dimension x (1) c.... Local variables. c---- Index in array. common /laptmean/ n c---- Estimated error in xdev. common /laptmean/ edev c---- Estimated error in xmean. common /laptmean/ emean c---- A very small number. common /laptmean/ fuz c---- Estimated error in xvar. common /laptmean/ evar c---- Second moment around xmean. common /laptmean/ xvar cbugc***DEBUG begins. cbug 9901 format (/ 'aptmean finding mean, xdev. np=',i6,' tol=',1pe13.5 / cbug & (i6,' x= ',1pe22.14)) cbug write ( 3, 9901) np, tol, (n, x(n), n = 1, np) cbugc***DEBUG ends. c.... Initialize. c---- A very small number. fuz = 1.e-99 nerr = 0 c.... Test for input errors. if (np .le. 0) then nerr = 1 go to 210 endif c.... Find mean value and its estimated error. xmean = 0.0 emean = 0.0 c---- Loop over array. do 110 n = 1, np xmean = xmean + x(n) emean = emean + abs (x(n)) c---- End of loop over array. 110 continue xmean = xmean / np emean = tol * emean / np c.... See if mean value should be truncated to zero. if (abs (xmean) .lt. emean) then xmean = 0.0 endif c.... Find second moment around mean, and its estimated error. xvar = 0.0 evar = 0.0 do 120 n = 1, np xvar = xvar + (x(n) - xmean)**2 evar = evar + 2.0 * (tol * abs (x(n)) + emean) * & (abs (x(n)) + xmean) 120 continue xvar = xvar / np evar = evar / np c.... Find standard deviation from mean, and its estimated error. xdev = sqrt (xvar) edev = 0.5 * evar / (xdev + fuz) cbugc***DEBUG begins. cbug 9902 format (/ 'aptmean results:' / cbug & ' xmean=',1pe22.14,' xdev=',1pe22.14 / cbug & ' emean=',1pe22.14,' edev=',1pe22.14) cbug write ( 3, 9902) xmean, xdev, emean, evar cbugc***DEBUG ends. 210 return c.... End of subroutine aptmean. (+1 line.) end UCRL-WEB-209832