1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
SUBROUTINE DASCAL( 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
DOUBLE PRECISION ALPHA
* ..
* .. Array Arguments ..
DOUBLE PRECISION X( * )
* ..
*
* Purpose
* =======
*
* DASCAL 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) DOUBLE PRECISION
* On entry, ALPHA specifies the scalar alpha.
*
* X (input/output) DOUBLE PRECISION 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 ..
DOUBLE PRECISION ONE, ZERO
PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+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( 'DASCAL', 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 DASCAL
*
END
|
