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 ELSE IF( n.LT.0 )THEN
115 info = 2
116 ELSE IF( lda.LT.max( 1, n ) )THEN
117 info = 5
118 ELSE IF( incx.EQ.0 )THEN
119 info = 7
120 ELSE IF( incy.EQ.0 )THEN
121 info = 10
122 END IF
123 IF( info.NE.0 )THEN
124 CALL xerbla( 'DASYMV', info )
125 RETURN
126 END IF
127*
128* Quick return if possible.
129*
130 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
131 $ RETURN
132*
133* Set up the start points in X and Y.
134*
135 IF( incx.GT.0 ) THEN
136 kx = 1
137 ELSE
138 kx = 1 - ( n - 1 ) * incx
139 END IF
140 IF( incy.GT.0 )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 IF( beta.NE.one ) THEN
153 IF( incy.EQ.1 ) THEN
154 IF( beta.EQ.zero ) 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 IF( beta.EQ.zero ) 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 IF( alpha.EQ.zero )
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 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) ) 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 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) ) 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*
alpha
#define alpha
Definition eval.h:35
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