src/LAPACK/zlassq.f

   1       SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
   2 *
   3 *  -- LAPACK auxiliary routine (version 3.1) --
   4 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
   5 *     November 2006
   6 *
   7 *     .. Scalar Arguments ..
   8       INTEGER            INCX, N
   9       DOUBLE PRECISION   SCALE, SUMSQ
  10 *     ..
  11 *     .. Array Arguments ..
  12       COMPLEX*16         X( * )
  13 *     ..
  14 *
  15 *  Purpose
  16 *  =======
  17 *
  18 *  ZLASSQ returns the values scl and ssq such that
  19 *
  20 *     ( scl**2 )*ssq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
  21 *
  22 *  where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is
  23 *  assumed to be at least unity and the value of ssq will then satisfy
  24 *
  25 *     1.0 .le. ssq .le. ( sumsq + 2*n ).
  26 *
  27 *  scale is assumed to be non-negative and scl returns the value
  28 *
  29 *     scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ),
  30 *            i
  31 *
  32 *  scale and sumsq must be supplied in SCALE and SUMSQ respectively.
  33 *  SCALE and SUMSQ are overwritten by scl and ssq respectively.
  34 *
  35 *  The routine makes only one pass through the vector X.
  36 *
  37 *  Arguments
  38 *  =========
  39 *
  40 *  N       (input) INTEGER
  41 *          The number of elements to be used from the vector X.
  42 *
  43 *  X       (input) COMPLEX*16 array, dimension (N)
  44 *          The vector x as described above.
  45 *             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
  46 *
  47 *  INCX    (input) INTEGER
  48 *          The increment between successive values of the vector X.
  49 *          INCX > 0.
  50 *
  51 *  SCALE   (input/output) DOUBLE PRECISION
  52 *          On entry, the value  scale  in the equation above.
  53 *          On exit, SCALE is overwritten with the value  scl .
  54 *
  55 *  SUMSQ   (input/output) DOUBLE PRECISION
  56 *          On entry, the value  sumsq  in the equation above.
  57 *          On exit, SUMSQ is overwritten with the value  ssq .
  58 *
  59 * =====================================================================
  60 *
  61 *     .. Parameters ..
  62       DOUBLE PRECISION   ZERO
  63       PARAMETER          ( ZERO = 0.0D+0 )
  64 *     ..
  65 *     .. Local Scalars ..
  66       INTEGER            IX
  67       DOUBLE PRECISION   TEMP1
  68 *     ..
  69 *     .. Intrinsic Functions ..
  70       INTRINSIC          ABS, DBLE, DIMAG
  71 *     ..
  72 *     .. Executable Statements ..
  73 *
  74       IF( N.GT.0 ) THEN
  75          DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
  76             IF( DBLE( X( IX ) ).NE.ZERO ) THEN
  77                TEMP1 = ABS( DBLE( X( IX ) ) )
  78                IF( SCALE.LT.TEMP1 ) THEN
  79                   SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
  80                   SCALE = TEMP1
  81                ELSE
  82                   SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
  83                END IF
  84             END IF
  85             IF( DIMAG( X( IX ) ).NE.ZERO ) THEN
  86                TEMP1 = ABS( DIMAG( X( IX ) ) )
  87                IF( SCALE.LT.TEMP1 ) THEN
  88                   SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
  89                   SCALE = TEMP1
  90                ELSE
  91                   SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
  92                END IF
  93             END IF
  94    10    CONTINUE
  95       END IF
  96 *
  97       RETURN
  98 *
  99 *     End of ZLASSQ
 100 *
 101       END