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