OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dasymv.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine dasymv (uplo, n, alpha, a, lda, x, incx, beta, y, incy)

Function/Subroutine Documentation

◆ dasymv()

subroutine dasymv ( character*1 uplo,
integer n,
double precision alpha,
double precision, dimension( lda, * ) a,
integer lda,
double precision, dimension( * ) x,
integer incx,
double precision beta,
double precision, dimension( * ) y,
integer incy )

Definition at line 1 of file dasymv.f.

3*
4* -- PBLAS auxiliary routine (version 2.0) --
5* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
6* and University of California, Berkeley.
7* April 1, 1998
8*
9* .. Scalar Arguments ..
10 CHARACTER*1 UPLO
11 INTEGER INCX, INCY, LDA, N
12 DOUBLE PRECISION ALPHA, BETA
13* ..
14* .. Array Arguments ..
15 DOUBLE PRECISION A( LDA, * ), X( * ), Y( * )
16* ..
17*
18* Purpose
19* =======
20*
21* DASYMV performs the following matrix-vector operation
22*
23* y := abs( alpha )*abs( A )*abs( x )+ abs( beta*y ),
24*
25* where alpha and beta are real scalars, y is a real vector, x is a
26* vector and A is an n by n symmetric matrix.
27*
28* Arguments
29* =========
30*
31* UPLO (input) CHARACTER*1
32* On entry, UPLO specifies whether the upper or lower triangu-
33* lar part of the array A is to be referenced as follows:
34*
35* UPLO = 'U' or 'u' Only the upper triangular part of A is
36* to be referenced.
37* UPLO = 'L' or 'l' Only the lower triangular part of A is
38* to be referenced.
39*
40* N (input) INTEGER
41* On entry, N specifies the order of the matrix A. N must be at
42* least zero.
43*
44* ALPHA (input) DOUBLE PRECISION
45* On entry, ALPHA specifies the real scalar alpha.
46*
47* A (input) DOUBLE PRECISION array
48* On entry, A is an array of dimension (LDA,N). Before entry
49* with UPLO = 'U' or 'u', the leading n by n part of the array
50* A must contain the upper triangular part of the symmetric ma-
51* trix and the strictly lower triangular part of A is not refe-
52* renced. When UPLO = 'L' or 'l', the leading n by n part of
53* the array A must contain the lower triangular part of the
54* symmetric matrix and the strictly upper trapezoidal part of A
55* is not referenced.
56*
57* LDA (input) INTEGER
58* On entry, LDA specifies the leading dimension of the array A.
59* LDA must be at least max( 1, N ).
60*
61* X (input) DOUBLE PRECISION array of dimension at least
62* ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented
63* array X must contain the vector x.
64*
65* INCX (input) INTEGER
66* On entry, INCX specifies the increment for the elements of X.
67* INCX must not be zero.
68*
69* BETA (input) DOUBLE PRECISION
70* On entry, BETA specifies the real scalar beta. When BETA is
71* supplied as zero then Y need not be set on input.
72*
73* Y (input/output) DOUBLE PRECISION array of dimension at least
74* ( 1 + ( n - 1 )*abs( INCY ) ). Before entry with BETA non-
75* zero, the incremented array Y must contain the vector y. On
76* exit, the incremented array Y is overwritten by the updated
77* vector y.
78*
79* INCY (input) INTEGER
80* On entry, INCY specifies the increment for the elements of Y.
81* INCY must not be zero.
82*
83* -- Written on April 1, 1998 by
84* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
85*
86* =====================================================================
87*
88* .. Parameters ..
89 DOUBLE PRECISION ONE, ZERO
90 parameter( one = 1.0d+0, zero = 0.0d+0 )
91* ..
92* .. Local Scalars ..
93 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
94 DOUBLE PRECISION TALPHA, TEMP0, TEMP1, TEMP2
95* ..
96* .. External Functions ..
97 LOGICAL LSAME
98 EXTERNAL lsame
99* ..
100* .. External Subroutines ..
101 EXTERNAL xerbla
102* ..
103* .. Intrinsic Functions ..
104 INTRINSIC abs, max
105* ..
106* .. Executable Statements ..
107*
108* Test the input parameters.
109*
110 info = 0
111 IF ( .NOT.lsame( uplo, 'u.AND.' )
112.NOT. $ LSAME( UPLO, 'l' ) )THEN
113 INFO = 1
114.LT. ELSE IF( N0 )THEN
115 INFO = 2
116.LT. ELSE IF( LDAMAX( 1, N ) )THEN
117 INFO = 5
118.EQ. ELSE IF( INCX0 )THEN
119 INFO = 7
120.EQ. ELSE IF( INCY0 )THEN
121 INFO = 10
122 END IF
123.NE. IF( INFO0 )THEN
124 CALL XERBLA( 'dasymv', INFO )
125 RETURN
126 END IF
127*
128* Quick return if possible.
129*
130.EQ..OR..EQ..AND..EQ. IF( ( N0 )( ( ALPHAZERO )( BETAONE ) ) )
131 $ RETURN
132*
133* Set up the start points in X and Y.
134*
135.GT. IF( INCX0 ) THEN
136 KX = 1
137 ELSE
138 KX = 1 - ( N - 1 ) * INCX
139 END IF
140.GT. IF( INCY0 )THEN
141 KY = 1
142 ELSE
143 KY = 1 - ( N - 1 ) * INCY
144 END IF
145*
146* Start the operations. In this version the elements of A are
147* accessed sequentially with one pass through the triangular part
148* of A.
149*
150* First form y := abs( beta * y ).
151*
152.NE. IF( BETAONE ) THEN
153.EQ. IF( INCY1 ) THEN
154.EQ. IF( BETAZERO ) THEN
155 DO 10, I = 1, N
156 Y( I ) = ZERO
157 10 CONTINUE
158 ELSE
159 DO 20, I = 1, N
160 Y( I ) = ABS( BETA * Y( I ) )
161 20 CONTINUE
162 END IF
163 ELSE
164 IY = KY
165.EQ. IF( BETAZERO ) THEN
166 DO 30, I = 1, N
167 Y( IY ) = ZERO
168 IY = IY + INCY
169 30 CONTINUE
170 ELSE
171 DO 40, I = 1, N
172 Y( IY ) = ABS( BETA * Y( IY ) )
173 IY = IY + INCY
174 40 CONTINUE
175 END IF
176 END IF
177 END IF
178*
179.EQ. IF( ALPHAZERO )
180 $ RETURN
181*
182 TALPHA = ABS( ALPHA )
183*
184 IF( LSAME( UPLO, 'u' ) ) THEN
185*
186* Form y when A is stored in upper triangle.
187*
188.EQ..AND..EQ. IF( ( INCX1 )( INCY1 ) ) THEN
189 DO 60, J = 1, N
190 TEMP1 = TALPHA * ABS( X( J ) )
191 TEMP2 = ZERO
192 DO 50, I = 1, J - 1
193 TEMP0 = ABS( A( I, J ) )
194 Y( I ) = Y( I ) + TEMP1 * TEMP0
195 TEMP2 = TEMP2 + TEMP0 * ABS( X( I ) )
196 50 CONTINUE
197 Y( J ) = Y( J ) + TEMP1 * ABS( A( J, J ) ) +
198 $ ALPHA * TEMP2
199*
200 60 CONTINUE
201*
202 ELSE
203*
204 JX = KX
205 JY = KY
206*
207 DO 80, J = 1, N
208 TEMP1 = TALPHA * ABS( X( JX ) )
209 TEMP2 = ZERO
210 IX = KX
211 IY = KY
212*
213 DO 70, I = 1, J - 1
214 TEMP0 = ABS( A( I, J ) )
215 Y( IY ) = Y( IY ) + TEMP1 * TEMP0
216 TEMP2 = TEMP2 + TEMP0 * ABS( X( IX ) )
217 IX = IX + INCX
218 IY = IY + INCY
219 70 CONTINUE
220 Y( JY ) = Y( JY ) + TEMP1 * ABS( A( J, J ) ) +
221 $ ALPHA * TEMP2
222 JX = JX + INCX
223 JY = JY + INCY
224*
225 80 CONTINUE
226*
227 END IF
228*
229 ELSE
230*
231* Form y when A is stored in lower triangle.
232*
233.EQ..AND..EQ. IF( ( INCX1 )( INCY1 ) ) THEN
234*
235 DO 100, J = 1, N
236*
237 TEMP1 = TALPHA * ABS( X( J ) )
238 TEMP2 = ZERO
239 Y( J ) = Y( J ) + TEMP1 * ABS( A( J, J ) )
240*
241 DO 90, I = J + 1, N
242 TEMP0 = ABS( A( I, J ) )
243 Y( I ) = Y( I ) + TEMP1 * TEMP0
244 TEMP2 = TEMP2 + TEMP0 * ABS( X( I ) )
245*
246 90 CONTINUE
247*
248 Y( J ) = Y( J ) + ALPHA * TEMP2
249*
250 100 CONTINUE
251*
252 ELSE
253*
254 JX = KX
255 JY = KY
256*
257 DO 120, J = 1, N
258 TEMP1 = TALPHA * ABS( X( JX ) )
259 TEMP2 = ZERO
260 Y( JY ) = Y( JY ) + TEMP1 * ABS( A( J, J ) )
261 IX = JX
262 IY = JY
263*
264 DO 110, I = J + 1, N
265*
266 IX = IX + INCX
267 IY = IY + INCY
268 TEMP0 = ABS( A( I, J ) )
269 Y( IY ) = Y( IY ) + TEMP1 * TEMP0
270 TEMP2 = TEMP2 + TEMP0 * ABS( X( IX ) )
271*
272 110 CONTINUE
273*
274 Y( JY ) = Y( JY ) + ALPHA * TEMP2
275 JX = JX + INCX
276 JY = JY + INCY
277*
278 120 CONTINUE
279*
280 END IF
281*
282 END IF
283*
284 RETURN
285*
286* End of DASYMV
287*
dasymv
subroutine dasymv(uplo, n, alpha, a, lda, x, incx, beta, y, incy)
Definition dasymv.f:3
xerbla
subroutine xerbla(srname, info)
XERBLA
Definition xerbla.f:60
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:53
max
#define max(a, b)
Definition macros.h:21