sascal.f

Go to the documentation of this file.

      SUBROUTINE sascal( N, ALPHA, X, INCX )
*
*  -- PBLAS auxiliary 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               ALPHA
*     ..
*     .. Array Arguments ..
      REAL               X( * )
*     ..
*
*  Purpose
*  =======
*
*  SASCAL performs the following operation:
*
*                   x := abs( alpha ) * abs( x ),
*
*  where alpha is a scalar and x is an n vector.
*
*  Arguments
*  =========
*
*  N       (input) INTEGER
*          On entry, N specifies the length of the vector x. N  must  be
*          at least zero.
*
*  ALPHA   (input) REAL
*          On entry, ALPHA specifies the scalar alpha.
*
*  X       (input/output) REAL array of dimension at least
*          ( 1 + ( n - 1 )*abs( INCX ) ). Before entry,  the incremented
*          array  X  must  contain the vector x. On exit, entries of the
*          incremented array X are mutiplied by alpha in absolute value.
*
*  INCX    (input) INTEGER
*          On entry, INCX specifies the increment for the elements of X.
*          INCX must not be zero.
*
*  -- Written on April 1, 1998 by
*     Antoine Petitet, University  of  Tennessee, Knoxville 37996, USA.
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ONE, ZERO
      parameter( one = 1.0e+0, zero = 0.0e+0 )
*     ..
*     .. Local Scalars ..
      INTEGER            I, INFO, IX, M, MP1
*     ..
*     .. External Subroutines ..
      EXTERNAL           xerbla
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, mod
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      info = 0
      IF( n.LT.0 ) THEN
         info = 1
      ELSE IF( incx.EQ.0 ) THEN
         info = 4
      END IF
      IF( info.NE.0 ) THEN
         CALL xerbla( 'SASCAL', info )
         RETURN
      END IF
*
*     Quick return if possible.
*
      IF( n.LE.0 )
     $   RETURN
*
*     Form  x := abs( alpha ) * abs( x )
*
      IF( incx.EQ.1 )
     $   GO TO 40
*
*     code for increments not equal to 1
*
*     Set up the start point in  X.
*
      IF( incx.GT.0 ) THEN
         ix = 1
      ELSE
         ix = 1 - ( n - 1 ) * incx
      END IF
*
      IF( alpha.EQ.zero ) THEN
         DO 10 i = 1, n
           x( ix ) = zero
           ix = ix + incx
   10    CONTINUE
      ELSE IF( alpha.EQ.one ) THEN
         DO 20 i = 1, n
           x( ix ) = abs( x( ix ) )
           ix = ix + incx
   20    CONTINUE
      ELSE
         DO 30 i = 1, n
           x( ix ) = abs( alpha * x( ix ) )
           ix = ix + incx
   30    CONTINUE
      END IF
*
      RETURN
*
*     code for increment equal to 1
*
*     clean-up loop
*
   40 m = mod( n, 4 )
*
      IF( m.EQ.0 )
     $   GO TO 80
*
      IF( alpha.EQ.zero ) THEN
         DO 50 i = 1, m
           x( i ) = zero
   50    CONTINUE
      ELSE IF( alpha.EQ.one ) THEN
         DO 60 i = 1, m
           x( i ) = abs( x( i ) )
   60    CONTINUE
      ELSE
         DO 70 i = 1, m
           x( i ) = abs( alpha * x( i ) )
   70    CONTINUE
      END IF
*
      IF( n.LT.4 )
     $   RETURN
*
   80 mp1 = m + 1
*
      IF( alpha.EQ.zero ) THEN
         DO 90 i = mp1, n, 4
            x( i     ) = zero
            x( i + 1 ) = zero
            x( i + 2 ) = zero
            x( i + 3 ) = zero
   90    CONTINUE
      ELSE IF( alpha.EQ.one ) THEN
         DO 100 i = mp1, n, 4
            x( i     ) = abs( x( i     ) )
            x( i + 1 ) = abs( x( i + 1 ) )
            x( i + 2 ) = abs( x( i + 2 ) )
            x( i + 3 ) = abs( x( i + 3 ) )
  100    CONTINUE
      ELSE
         DO 110 i = mp1, n, 4
            x( i     ) = abs( alpha * x( i     ) )
            x( i + 1 ) = abs( alpha * x( i + 1 ) )
            x( i + 2 ) = abs( alpha * x( i + 2 ) )
            x( i + 3 ) = abs( alpha * x( i + 3 ) )
  110    CONTINUE
      END IF
*
      RETURN
*
*     End of SASCAL
*
      END