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

Go to the source code of this file.

Functions/Subroutines

subroutine dagemv (trans, m, n, alpha, a, lda, x, incx, beta, y, incy)

Function/Subroutine Documentation

◆ dagemv()

subroutine dagemv ( character*1 trans,
integer m,
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 dagemv.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 TRANS
11 INTEGER INCX, INCY, LDA, M, N
12 DOUBLE PRECISION ALPHA, BETA
13* ..
14* .. Array Arguments ..
15 DOUBLE PRECISION A( LDA, * ), X( * ), Y( * )
16* ..
17*
18* Purpose
19* =======
20*
21* DAGEMV performs one of the matrix-vector operations
22*
23* y := abs( alpha )*abs( A )*abs( x )+ abs( beta*y ),
24*
25* or
26*
27* y := abs( alpha )*abs( A' )*abs( x ) + abs( beta*y ),
28*
29* where alpha and beta are real scalars, y is a real vector, x is a
30* vector and A is an m by n matrix.
31*
32* Arguments
33* =========
34*
35* TRANS (input) CHARACTER*1
36* On entry, TRANS specifies the operation to be performed as
37* follows:
38*
39* TRANS = 'N' or 'n':
40* y := abs( alpha )*abs( A )*abs( x )+ abs( beta*y )
41*
42* TRANS = 'T' or 't':
43* y := abs( alpha )*abs( A' )*abs( x ) + abs( beta*y )
44*
45* TRANS = 'C' or 'c':
46* y := abs( alpha )*abs( A' )*abs( x ) + abs( beta*y )
47*
48* M (input) INTEGER
49* On entry, M specifies the number of rows of the matrix A. M
50* must be at least zero.
51*
52* N (input) INTEGER
53* On entry, N specifies the number of columns of the matrix A.
54* N must be at least zero.
55*
56* ALPHA (input) DOUBLE PRECISION
57* On entry, ALPHA specifies the real scalar alpha.
58*
59* A (input) DOUBLE PRECISION array of dimension ( LDA, n ).
60* On entry, A is an array of dimension ( LDA, N ). The leading
61* m by n part of the array A must contain the matrix of coef-
62* ficients.
63*
64* LDA (input) INTEGER
65* On entry, LDA specifies the leading dimension of the array A.
66* LDA must be at least max( 1, M ).
67*
68* X (input) DOUBLE PRECISION array of dimension at least
69* ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' and at
70* least ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. Before entry,
71* the incremented array X must contain the vector x.
72*
73* INCX (input) INTEGER
74* On entry, INCX specifies the increment for the elements of X.
75* INCX must not be zero.
76*
77* BETA (input) DOUBLE PRECISION
78* On entry, BETA specifies the real scalar beta. When BETA is
79* supplied as zero then Y need not be set on input.
80*
81* Y (input/output) DOUBLE PRECISION array of dimension at least
82* ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' and at
83* least ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. Before entry
84* with BETA non-zero, the incremented array Y must contain the
85* vector y. On exit, the incremented array Y is overwritten by
86* the updated vector y.
87*
88* INCY (input) INTEGER
89* On entry, INCY specifies the increment for the elements of Y.
90* INCY must not be zero.
91*
92* -- Written on April 1, 1998 by
93* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
94*
95* =====================================================================
96*
97* .. Parameters ..
98 DOUBLE PRECISION ONE, ZERO
99 parameter( one = 1.0d+0, zero = 0.0d+0 )
100* ..
101* .. Local Scalars ..
102 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
103 DOUBLE PRECISION ABSX, TALPHA, TEMP
104* ..
105* .. External Functions ..
106 LOGICAL LSAME
107 EXTERNAL lsame
108* ..
109* .. External Subroutines ..
110 EXTERNAL xerbla
111* ..
112* .. Intrinsic Functions ..
113 INTRINSIC abs, max
114* ..
115* .. Executable Statements ..
116*
117* Test the input parameters.
118*
119 info = 0
120 IF( .NOT.lsame( trans, 'N' ) .AND.
121 $ .NOT.lsame( trans, 'T' ) .AND.
122 $ .NOT.lsame( trans, 'C' ) ) THEN
123 info = 1
124 ELSE IF( m.LT.0 ) THEN
125 info = 2
126 ELSE IF( n.LT.0 ) THEN
127 info = 3
128 ELSE IF( lda.LT.max( 1, m ) ) THEN
129 info = 6
130 ELSE IF( incx.EQ.0 ) THEN
131 info = 8
132 ELSE IF( incy.EQ.0 ) THEN
133 info = 11
134 END IF
135 IF( info.NE.0 ) THEN
136 CALL xerbla( 'DAGEMV', info )
137 RETURN
138 END IF
139*
140* Quick return if possible.
141*
142 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
143 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
144 $ RETURN
145*
146* Set LENX and LENY, the lengths of the vectors x and y, and set
147* up the start points in X and Y.
148*
149 IF( lsame( trans, 'N' ) ) THEN
150 lenx = n
151 leny = m
152 ELSE
153 lenx = m
154 leny = n
155 END IF
156 IF( incx.GT.0 ) THEN
157 kx = 1
158 ELSE
159 kx = 1 - ( lenx - 1 )*incx
160 END IF
161 IF( incy.GT.0 ) THEN
162 ky = 1
163 ELSE
164 ky = 1 - ( leny - 1 )*incy
165 END IF
166*
167* Start the operations. In this version the elements of A are
168* accessed sequentially with one pass through A.
169*
170* First form y := abs( beta*y ).
171*
172 IF( incy.EQ.1 ) THEN
173 IF( beta.EQ.zero ) THEN
174 DO 10, i = 1, leny
175 y( i ) = zero
176 10 CONTINUE
177 ELSE IF( beta.EQ.one ) THEN
178 DO 20, i = 1, leny
179 y( i ) = abs( y( i ) )
180 20 CONTINUE
181 ELSE
182 DO 30, i = 1, leny
183 y( i ) = abs( beta * y( i ) )
184 30 CONTINUE
185 END IF
186 ELSE
187 iy = ky
188 IF( beta.EQ.zero ) THEN
189 DO 40, i = 1, leny
190 y( iy ) = zero
191 iy = iy + incy
192 40 CONTINUE
193 ELSE IF( beta.EQ.one ) THEN
194 DO 50, i = 1, leny
195 y( iy ) = abs( y( iy ) )
196 iy = iy + incy
197 50 CONTINUE
198 ELSE
199 DO 60, i = 1, leny
200 y( iy ) = abs( beta * y( iy ) )
201 iy = iy + incy
202 60 CONTINUE
203 END IF
204 END IF
205*
206 IF( alpha.EQ.zero )
207 $ RETURN
208*
209 talpha = abs( alpha )
210*
211 IF( lsame( trans, 'N' ) ) THEN
212*
213* Form y := abs( alpha ) * abs( A ) * abs( x ) + y.
214*
215 jx = kx
216 IF( incy.EQ.1 ) THEN
217 DO 80, j = 1, n
218 absx = abs( x( jx ) )
219 IF( absx.NE.zero ) THEN
220 temp = talpha * absx
221 DO 70, i = 1, m
222 y( i ) = y( i ) + temp * abs( a( i, j ) )
223 70 CONTINUE
224 END IF
225 jx = jx + incx
226 80 CONTINUE
227 ELSE
228 DO 100, j = 1, n
229 absx = abs( x( jx ) )
230 IF( absx.NE.zero ) THEN
231 temp = talpha * absx
232 iy = ky
233 DO 90, i = 1, m
234 y( iy ) = y( iy ) + temp * abs( a( i, j ) )
235 iy = iy + incy
236 90 CONTINUE
237 END IF
238 jx = jx + incx
239 100 CONTINUE
240 END IF
241*
242 ELSE
243*
244* Form y := abs( alpha ) * abs( A' ) * abs( x ) + y.
245*
246 jy = ky
247 IF( incx.EQ.1 ) THEN
248 DO 120, j = 1, n
249 temp = zero
250 DO 110, i = 1, m
251 temp = temp + abs( a( i, j ) * x( i ) )
252 110 CONTINUE
253 y( jy ) = y( jy ) + talpha * temp
254 jy = jy + incy
255 120 CONTINUE
256 ELSE
257 DO 140, j = 1, n
258 temp = zero
259 ix = kx
260 DO 130, i = 1, m
261 temp = temp + abs( a( i, j ) * x( ix ) )
262 ix = ix + incx
263 130 CONTINUE
264 y( jy ) = y( jy ) + talpha * temp
265 jy = jy + incy
266 140 CONTINUE
267 END IF
268 END IF
269*
270 RETURN
271*
272* End of DAGEMV
273*
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