ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
sascal.f
Go to the documentation of this file.
1  SUBROUTINE sascal( N, ALPHA, X, INCX )
2 *
3 * -- PBLAS auxiliary routine (version 2.0) --
4 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5 * and University of California, Berkeley.
6 * April 1, 1998
7 *
8 * .. Scalar Arguments ..
9  INTEGER INCX, N
10  REAL ALPHA
11 * ..
12 * .. Array Arguments ..
13  REAL X( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * SASCAL performs the following operation:
20 *
21 * x := abs( alpha ) * abs( x ),
22 *
23 * where alpha is a scalar and x is an n vector.
24 *
25 * Arguments
26 * =========
27 *
28 * N (input) INTEGER
29 * On entry, N specifies the length of the vector x. N must be
30 * at least zero.
31 *
32 * ALPHA (input) REAL
33 * On entry, ALPHA specifies the scalar alpha.
34 *
35 * X (input/output) REAL array of dimension at least
36 * ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented
37 * array X must contain the vector x. On exit, entries of the
38 * incremented array X are mutiplied by alpha in absolute value.
39 *
40 * INCX (input) INTEGER
41 * On entry, INCX specifies the increment for the elements of X.
42 * INCX must not be zero.
43 *
44 * -- Written on April 1, 1998 by
45 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
46 *
47 * =====================================================================
48 *
49 * .. Parameters ..
50  REAL ONE, ZERO
51  parameter( one = 1.0e+0, zero = 0.0e+0 )
52 * ..
53 * .. Local Scalars ..
54  INTEGER I, INFO, IX, M, MP1
55 * ..
56 * .. External Subroutines ..
57  EXTERNAL xerbla
58 * ..
59 * .. Intrinsic Functions ..
60  INTRINSIC abs, mod
61 * ..
62 * .. Executable Statements ..
63 *
64 * Test the input parameters.
65 *
66  info = 0
67  IF( n.LT.0 ) THEN
68  info = 1
69  ELSE IF( incx.EQ.0 ) THEN
70  info = 4
71  END IF
72  IF( info.NE.0 ) THEN
73  CALL xerbla( 'SASCAL', info )
74  RETURN
75  END IF
76 *
77 * Quick return if possible.
78 *
79  IF( n.LE.0 )
80  $ RETURN
81 *
82 * Form x := abs( alpha ) * abs( x )
83 *
84  IF( incx.EQ.1 )
85  $ GO TO 40
86 *
87 * code for increments not equal to 1
88 *
89 * Set up the start point in X.
90 *
91  IF( incx.GT.0 ) THEN
92  ix = 1
93  ELSE
94  ix = 1 - ( n - 1 ) * incx
95  END IF
96 *
97  IF( alpha.EQ.zero ) THEN
98  DO 10 i = 1, n
99  x( ix ) = zero
100  ix = ix + incx
101  10 CONTINUE
102  ELSE IF( alpha.EQ.one ) THEN
103  DO 20 i = 1, n
104  x( ix ) = abs( x( ix ) )
105  ix = ix + incx
106  20 CONTINUE
107  ELSE
108  DO 30 i = 1, n
109  x( ix ) = abs( alpha * x( ix ) )
110  ix = ix + incx
111  30 CONTINUE
112  END IF
113 *
114  RETURN
115 *
116 * code for increment equal to 1
117 *
118 * clean-up loop
119 *
120  40 m = mod( n, 4 )
121 *
122  IF( m.EQ.0 )
123  $ GO TO 80
124 *
125  IF( alpha.EQ.zero ) THEN
126  DO 50 i = 1, m
127  x( i ) = zero
128  50 CONTINUE
129  ELSE IF( alpha.EQ.one ) THEN
130  DO 60 i = 1, m
131  x( i ) = abs( x( i ) )
132  60 CONTINUE
133  ELSE
134  DO 70 i = 1, m
135  x( i ) = abs( alpha * x( i ) )
136  70 CONTINUE
137  END IF
138 *
139  IF( n.LT.4 )
140  $ RETURN
141 *
142  80 mp1 = m + 1
143 *
144  IF( alpha.EQ.zero ) THEN
145  DO 90 i = mp1, n, 4
146  x( i ) = zero
147  x( i + 1 ) = zero
148  x( i + 2 ) = zero
149  x( i + 3 ) = zero
150  90 CONTINUE
151  ELSE IF( alpha.EQ.one ) THEN
152  DO 100 i = mp1, n, 4
153  x( i ) = abs( x( i ) )
154  x( i + 1 ) = abs( x( i + 1 ) )
155  x( i + 2 ) = abs( x( i + 2 ) )
156  x( i + 3 ) = abs( x( i + 3 ) )
157  100 CONTINUE
158  ELSE
159  DO 110 i = mp1, n, 4
160  x( i ) = abs( alpha * x( i ) )
161  x( i + 1 ) = abs( alpha * x( i + 1 ) )
162  x( i + 2 ) = abs( alpha * x( i + 2 ) )
163  x( i + 3 ) = abs( alpha * x( i + 3 ) )
164  110 CONTINUE
165  END IF
166 *
167  RETURN
168 *
169 * End of SASCAL
170 *
171  END
sascal
subroutine sascal(N, ALPHA, X, INCX)
Definition: sascal.f:2