SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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
subroutine sascal(n, alpha, x, incx)
Definition sascal.f:2