pcerrnrm2()

subroutine pcerrnrm2	(	real	errbnd,
		integer	n,
		real	usclr,
		complex, dimension( * )	x,
		integer	incx,
		real	prec
	)

Definition at line 3425 of file pcblas1tst.f.

*
*  -- PBLAS test routine (version 2.0) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     April 1, 1998
*
*     .. Scalar Arguments ..
      INTEGER            INCX, N
      REAL               ERRBND, PREC, USCLR
*     ..
*     .. Array Arguments ..
      COMPLEX            X( * )
*     ..
*
*  Purpose
*  =======
*
*  PCERRNRM2  serially  computes  the  2-norm the vector X and returns a
*  scaled relative acceptable error bound on the result.
*
*  Notes
*  =====
*
*  If  norm1 = SCLR  and  norm2  are two different computed results, and
*  norm1 being assumed to be correct, we require
*
*     abs( norm1 - norm2 ) <= ERRBND = ERRFACT * abs( norm1 ),
*
*  where ERRFACT is computed as the maximum of the positive and negative
*  partial  sums  multiplied  by  a constant proportional to the machine
*  precision.
*
*  Arguments
*  =========
*
*  ERRBND  (global output) REAL
*          On exit, ERRBND  specifies the scaled relative acceptable er-
*          ror bound.
*
*  N       (global input) INTEGER
*          On entry, N specifies the length of the vector operand.
*
*  USCLR   (global output) REAL
*          On exit, USCLR specifies the 2-norm of the vector X.
*
*  X       (global input) COMPLEX array
*          On   entry,   X   is   an   array   of   dimension  at  least
*          ( 1 + ( n - 1 )*abs( INCX ) ).  Before  entry,  the incremen-
*          ted array X must contain the vector x.
*
*  INCX    (global input) INTEGER.
*          On entry, INCX specifies the increment for the elements of X.
*          INCX must not be zero.
*
*  PREC    (global input) REAL
*          On entry, PREC specifies the machine precision.
*
*  -- Written on April 1, 1998 by
*     Antoine Petitet, University  of  Tennessee, Knoxville 37996, USA.
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ONE, TWO, ZERO
      parameter( one = 1.0e+0, two = 2.0e+0,
     $                   zero = 0.0e+0 )
*     ..
*     .. Local Scalars ..
      INTEGER            IX
      REAL               ABSXI, ADDBND, FACT, SCALE, SSQ, SUMSCA, SUMSSQ
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, aimag, real
*     ..
*     .. Executable Statements ..
*
      usclr = zero
      sumssq = one
      sumsca = zero
      addbnd = two * two * two * prec
      fact = one + two * ( ( one + prec )**3 - one )
*
      scale = zero
      ssq = one
      DO 10 ix = 1, 1 + ( n - 1 )*incx, incx
         IF( real( x( ix ) ).NE.zero ) THEN
            absxi = abs( real( x( ix ) ) )
            IF( scale.LT.absxi )THEN
               sumssq = one + ( ssq*( scale/absxi )**2 ) * fact
               errbnd = addbnd * sumssq
               sumssq = sumssq + errbnd
               ssq    = one + ssq*( scale/absxi )**2
               sumsca = absxi
               scale  = absxi
            ELSE
               sumssq = ssq + ( ( absxi/scale )**2 ) * fact
               errbnd = addbnd * sumssq
               sumssq = sumssq + errbnd
               ssq    = ssq + ( absxi/scale )**2
            END IF
         END IF
         IF( aimag( x( ix ) ).NE.zero ) THEN
            absxi = abs( aimag( x( ix ) ) )
            IF( scale.LT.absxi )THEN
               sumssq = one + ( ssq*( scale/absxi )**2 ) * fact
               errbnd = addbnd * sumssq
               sumssq = sumssq + errbnd
               ssq    = one + ssq*( scale/absxi )**2
               sumsca = absxi
               scale  = absxi
            ELSE
               sumssq = ssq + ( ( absxi/scale )**2 ) * fact
               errbnd = addbnd * sumssq
               sumssq = sumssq + errbnd
               ssq    = ssq + ( absxi/scale )**2
            END IF
         END IF
   10 CONTINUE
*
      usclr = scale * sqrt( ssq )
*
*     Error on square root
*
      errbnd = sqrt( sumssq ) * ( one + two * ( 1.00001e+0 * prec ) )
*
      errbnd = ( sumsca * errbnd ) - usclr
*
      RETURN
*
*     End of PCERRNRM2
*

Here is the caller graph for this function: