LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sger.f
Go to the documentation of this file.
1*> \brief \b SGER
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE SGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
12*
13* .. Scalar Arguments ..
14* REAL ALPHA
15* INTEGER INCX,INCY,LDA,M,N
16* ..
17* .. Array Arguments ..
18* REAL A(LDA,*),X(*),Y(*)
19* ..
20*
21*
22*> \par Purpose:
23* =============
24*>
25*> \verbatim
26*>
27*> SGER performs the rank 1 operation
28*>
29*> A := alpha*x*y**T + A,
30*>
31*> where alpha is a scalar, x is an m element vector, y is an n element
32*> vector and A is an m by n matrix.
33*> \endverbatim
34*
35* Arguments:
36* ==========
37*
38*> \param[in] M
39*> \verbatim
40*> M is INTEGER
41*> On entry, M specifies the number of rows of the matrix A.
42*> M must be at least zero.
43*> \endverbatim
44*>
45*> \param[in] N
46*> \verbatim
47*> N is INTEGER
48*> On entry, N specifies the number of columns of the matrix A.
49*> N must be at least zero.
50*> \endverbatim
51*>
52*> \param[in] ALPHA
53*> \verbatim
54*> ALPHA is REAL
55*> On entry, ALPHA specifies the scalar alpha.
56*> \endverbatim
57*>
58*> \param[in] X
59*> \verbatim
60*> X is REAL array, dimension at least
61*> ( 1 + ( m - 1 )*abs( INCX ) ).
62*> Before entry, the incremented array X must contain the m
63*> element vector x.
64*> \endverbatim
65*>
66*> \param[in] INCX
67*> \verbatim
68*> INCX is INTEGER
69*> On entry, INCX specifies the increment for the elements of
70*> X. INCX must not be zero.
71*> \endverbatim
72*>
73*> \param[in] Y
74*> \verbatim
75*> Y is REAL array, dimension at least
76*> ( 1 + ( n - 1 )*abs( INCY ) ).
77*> Before entry, the incremented array Y must contain the n
78*> element vector y.
79*> \endverbatim
80*>
81*> \param[in] INCY
82*> \verbatim
83*> INCY is INTEGER
84*> On entry, INCY specifies the increment for the elements of
85*> Y. INCY must not be zero.
86*> \endverbatim
87*>
88*> \param[in,out] A
89*> \verbatim
90*> A is REAL array, dimension ( LDA, N )
91*> Before entry, the leading m by n part of the array A must
92*> contain the matrix of coefficients. On exit, A is
93*> overwritten by the updated matrix.
94*> \endverbatim
95*>
96*> \param[in] LDA
97*> \verbatim
98*> LDA is INTEGER
99*> On entry, LDA specifies the first dimension of A as declared
100*> in the calling (sub) program. LDA must be at least
101*> max( 1, m ).
102*> \endverbatim
103*
104* Authors:
105* ========
106*
107*> \author Univ. of Tennessee
108*> \author Univ. of California Berkeley
109*> \author Univ. of Colorado Denver
110*> \author NAG Ltd.
111*
112*> \ingroup ger
113*
114*> \par Further Details:
115* =====================
116*>
117*> \verbatim
118*>
119*> Level 2 Blas routine.
120*>
121*> -- Written on 22-October-1986.
122*> Jack Dongarra, Argonne National Lab.
123*> Jeremy Du Croz, Nag Central Office.
124*> Sven Hammarling, Nag Central Office.
125*> Richard Hanson, Sandia National Labs.
126*> \endverbatim
127*>
128* =====================================================================
129 SUBROUTINE sger(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
130*
131* -- Reference BLAS level2 routine --
132* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
133* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
134*
135* .. Scalar Arguments ..
136 REAL ALPHA
137 INTEGER INCX,INCY,LDA,M,N
138* ..
139* .. Array Arguments ..
140 REAL A(LDA,*),X(*),Y(*)
141* ..
142*
143* =====================================================================
144*
145* .. Parameters ..
146 REAL ZERO
147 parameter(zero=0.0e+0)
148* ..
149* .. Local Scalars ..
150 REAL TEMP
151 INTEGER I,INFO,IX,J,JY,KX
152* ..
153* .. External Subroutines ..
154 EXTERNAL xerbla
155* ..
156* .. Intrinsic Functions ..
157 INTRINSIC max
158* ..
159*
160* Test the input parameters.
161*
162 info = 0
163 IF (m.LT.0) THEN
164 info = 1
165 ELSE IF (n.LT.0) THEN
166 info = 2
167 ELSE IF (incx.EQ.0) THEN
168 info = 5
169 ELSE IF (incy.EQ.0) THEN
170 info = 7
171 ELSE IF (lda.LT.max(1,m)) THEN
172 info = 9
173 END IF
174 IF (info.NE.0) THEN
175 CALL xerbla('SGER ',info)
176 RETURN
177 END IF
178*
179* Quick return if possible.
180*
181 IF ((m.EQ.0) .OR. (n.EQ.0) .OR. (alpha.EQ.zero)) RETURN
182*
183* Start the operations. In this version the elements of A are
184* accessed sequentially with one pass through A.
185*
186 IF (incy.GT.0) THEN
187 jy = 1
188 ELSE
189 jy = 1 - (n-1)*incy
190 END IF
191 IF (incx.EQ.1) THEN
192 DO 20 j = 1,n
193 IF (y(jy).NE.zero) THEN
194 temp = alpha*y(jy)
195 DO 10 i = 1,m
196 a(i,j) = a(i,j) + x(i)*temp
197 10 CONTINUE
198 END IF
199 jy = jy + incy
200 20 CONTINUE
201 ELSE
202 IF (incx.GT.0) THEN
203 kx = 1
204 ELSE
205 kx = 1 - (m-1)*incx
206 END IF
207 DO 40 j = 1,n
208 IF (y(jy).NE.zero) THEN
209 temp = alpha*y(jy)
210 ix = kx
211 DO 30 i = 1,m
212 a(i,j) = a(i,j) + x(ix)*temp
213 ix = ix + incx
214 30 CONTINUE
215 END IF
216 jy = jy + incy
217 40 CONTINUE
218 END IF
219*
220 RETURN
221*
222* End of SGER
223*
224 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine sger(m, n, alpha, x, incx, y, incy, a, lda)
SGER
Definition sger.f:130