1 /* blas/zgerc.f -- translated by f2c (version 20050501).
2 You must link the resulting object file with libf2c:
3 on Microsoft Windows system, link with libf2c.lib;
4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5 or, if you install libf2c.a in a standard place, with -lf2c -lm
6 -- in that order, at the end of the command line, as in
7 cc *.o -lf2c -lm
8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
9
10 http://www.netlib.org/f2c/libf2c.zip
11 */
12
13 #ifdef __cplusplus
14 extern "C" {
15 #endif
16 #include "v3p_netlib.h"
17
18 /*< SUBROUTINE ZGERC ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA ) >*/
zgerc_(integer * m,integer * n,doublecomplex * alpha,doublecomplex * x,integer * incx,doublecomplex * y,integer * incy,doublecomplex * a,integer * lda)19 /* Subroutine */ int zgerc_(integer *m, integer *n, doublecomplex *alpha,
20 doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,
21 doublecomplex *a, integer *lda)
22 {
23 /* System generated locals */
24 integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
25 doublecomplex z__1, z__2;
26
27 /* Builtin functions */
28 void d_cnjg(doublecomplex *, doublecomplex *);
29
30 /* Local variables */
31 integer i__, j, ix, jy, kx, info;
32 doublecomplex temp;
33 extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
34
35 /* .. Scalar Arguments .. */
36 /*< COMPLEX*16 ALPHA >*/
37 /*< INTEGER INCX, INCY, LDA, M, N >*/
38 /* .. Array Arguments .. */
39 /*< COMPLEX*16 A( LDA, * ), X( * ), Y( * ) >*/
40 /* .. */
41
42 /* Purpose */
43 /* ======= */
44
45 /* ZGERC performs the rank 1 operation */
46
47 /* A := alpha*x*conjg( y' ) + A, */
48
49 /* where alpha is a scalar, x is an m element vector, y is an n element */
50 /* vector and A is an m by n matrix. */
51
52 /* Parameters */
53 /* ========== */
54
55 /* M - INTEGER. */
56 /* On entry, M specifies the number of rows of the matrix A. */
57 /* M must be at least zero. */
58 /* Unchanged on exit. */
59
60 /* N - INTEGER. */
61 /* On entry, N specifies the number of columns of the matrix A. */
62 /* N must be at least zero. */
63 /* Unchanged on exit. */
64
65 /* ALPHA - COMPLEX*16 . */
66 /* On entry, ALPHA specifies the scalar alpha. */
67 /* Unchanged on exit. */
68
69 /* X - COMPLEX*16 array of dimension at least */
70 /* ( 1 + ( m - 1 )*abs( INCX ) ). */
71 /* Before entry, the incremented array X must contain the m */
72 /* element vector x. */
73 /* Unchanged on exit. */
74
75 /* INCX - INTEGER. */
76 /* On entry, INCX specifies the increment for the elements of */
77 /* X. INCX must not be zero. */
78 /* Unchanged on exit. */
79
80 /* Y - COMPLEX*16 array of dimension at least */
81 /* ( 1 + ( n - 1 )*abs( INCY ) ). */
82 /* Before entry, the incremented array Y must contain the n */
83 /* element vector y. */
84 /* Unchanged on exit. */
85
86 /* INCY - INTEGER. */
87 /* On entry, INCY specifies the increment for the elements of */
88 /* Y. INCY must not be zero. */
89 /* Unchanged on exit. */
90
91 /* A - COMPLEX*16 array of DIMENSION ( LDA, n ). */
92 /* Before entry, the leading m by n part of the array A must */
93 /* contain the matrix of coefficients. On exit, A is */
94 /* overwritten by the updated matrix. */
95
96 /* LDA - INTEGER. */
97 /* On entry, LDA specifies the first dimension of A as declared */
98 /* in the calling (sub) program. LDA must be at least */
99 /* max( 1, m ). */
100 /* Unchanged on exit. */
101
102
103 /* Level 2 Blas routine. */
104
105 /* -- Written on 22-October-1986. */
106 /* Jack Dongarra, Argonne National Lab. */
107 /* Jeremy Du Croz, Nag Central Office. */
108 /* Sven Hammarling, Nag Central Office. */
109 /* Richard Hanson, Sandia National Labs. */
110
111
112 /* .. Parameters .. */
113 /*< COMPLEX*16 ZERO >*/
114 /*< PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) ) >*/
115 /* .. Local Scalars .. */
116 /*< COMPLEX*16 TEMP >*/
117 /*< INTEGER I, INFO, IX, J, JY, KX >*/
118 /* .. External Subroutines .. */
119 /*< EXTERNAL XERBLA >*/
120 /* .. Intrinsic Functions .. */
121 /*< INTRINSIC DCONJG, MAX >*/
122 /* .. */
123 /* .. Executable Statements .. */
124
125 /* Test the input parameters. */
126
127 /*< INFO = 0 >*/
128 /* Parameter adjustments */
129 --x;
130 --y;
131 a_dim1 = *lda;
132 a_offset = 1 + a_dim1;
133 a -= a_offset;
134
135 /* Function Body */
136 info = 0;
137 /*< IF ( M.LT.0 )THEN >*/
138 if (*m < 0) {
139 /*< INFO = 1 >*/
140 info = 1;
141 /*< ELSE IF( N.LT.0 )THEN >*/
142 } else if (*n < 0) {
143 /*< INFO = 2 >*/
144 info = 2;
145 /*< ELSE IF( INCX.EQ.0 )THEN >*/
146 } else if (*incx == 0) {
147 /*< INFO = 5 >*/
148 info = 5;
149 /*< ELSE IF( INCY.EQ.0 )THEN >*/
150 } else if (*incy == 0) {
151 /*< INFO = 7 >*/
152 info = 7;
153 /*< ELSE IF( LDA.LT.MAX( 1, M ) )THEN >*/
154 } else if (*lda < max(1,*m)) {
155 /*< INFO = 9 >*/
156 info = 9;
157 /*< END IF >*/
158 }
159 /*< IF( INFO.NE.0 )THEN >*/
160 if (info != 0) {
161 /*< CALL XERBLA( 'ZGERC ', INFO ) >*/
162 xerbla_("ZGERC ", &info, (ftnlen)6);
163 /*< RETURN >*/
164 return 0;
165 /*< END IF >*/
166 }
167
168 /* Quick return if possible. */
169
170 /*< >*/
171 if (*m == 0 || *n == 0 || (alpha->r == 0. && alpha->i == 0.)) {
172 return 0;
173 }
174
175 /* Start the operations. In this version the elements of A are */
176 /* accessed sequentially with one pass through A. */
177
178 /*< IF( INCY.GT.0 )THEN >*/
179 if (*incy > 0) {
180 /*< JY = 1 >*/
181 jy = 1;
182 /*< ELSE >*/
183 } else {
184 /*< JY = 1 - ( N - 1 )*INCY >*/
185 jy = 1 - (*n - 1) * *incy;
186 /*< END IF >*/
187 }
188 /*< IF( INCX.EQ.1 )THEN >*/
189 if (*incx == 1) {
190 /*< DO 20, J = 1, N >*/
191 i__1 = *n;
192 for (j = 1; j <= i__1; ++j) {
193 /*< IF( Y( JY ).NE.ZERO )THEN >*/
194 i__2 = jy;
195 if (y[i__2].r != 0. || y[i__2].i != 0.) {
196 /*< TEMP = ALPHA*DCONJG( Y( JY ) ) >*/
197 d_cnjg(&z__2, &y[jy]);
198 z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
199 alpha->r * z__2.i + alpha->i * z__2.r;
200 temp.r = z__1.r, temp.i = z__1.i;
201 /*< DO 10, I = 1, M >*/
202 i__2 = *m;
203 for (i__ = 1; i__ <= i__2; ++i__) {
204 /*< A( I, J ) = A( I, J ) + X( I )*TEMP >*/
205 i__3 = i__ + j * a_dim1;
206 i__4 = i__ + j * a_dim1;
207 i__5 = i__;
208 z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
209 x[i__5].r * temp.i + x[i__5].i * temp.r;
210 z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
211 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
212 /*< 10 CONTINUE >*/
213 /* L10: */
214 }
215 /*< END IF >*/
216 }
217 /*< JY = JY + INCY >*/
218 jy += *incy;
219 /*< 20 CONTINUE >*/
220 /* L20: */
221 }
222 /*< ELSE >*/
223 } else {
224 /*< IF( INCX.GT.0 )THEN >*/
225 if (*incx > 0) {
226 /*< KX = 1 >*/
227 kx = 1;
228 /*< ELSE >*/
229 } else {
230 /*< KX = 1 - ( M - 1 )*INCX >*/
231 kx = 1 - (*m - 1) * *incx;
232 /*< END IF >*/
233 }
234 /*< DO 40, J = 1, N >*/
235 i__1 = *n;
236 for (j = 1; j <= i__1; ++j) {
237 /*< IF( Y( JY ).NE.ZERO )THEN >*/
238 i__2 = jy;
239 if (y[i__2].r != 0. || y[i__2].i != 0.) {
240 /*< TEMP = ALPHA*DCONJG( Y( JY ) ) >*/
241 d_cnjg(&z__2, &y[jy]);
242 z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
243 alpha->r * z__2.i + alpha->i * z__2.r;
244 temp.r = z__1.r, temp.i = z__1.i;
245 /*< IX = KX >*/
246 ix = kx;
247 /*< DO 30, I = 1, M >*/
248 i__2 = *m;
249 for (i__ = 1; i__ <= i__2; ++i__) {
250 /*< A( I, J ) = A( I, J ) + X( IX )*TEMP >*/
251 i__3 = i__ + j * a_dim1;
252 i__4 = i__ + j * a_dim1;
253 i__5 = ix;
254 z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
255 x[i__5].r * temp.i + x[i__5].i * temp.r;
256 z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
257 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
258 /*< IX = IX + INCX >*/
259 ix += *incx;
260 /*< 30 CONTINUE >*/
261 /* L30: */
262 }
263 /*< END IF >*/
264 }
265 /*< JY = JY + INCY >*/
266 jy += *incy;
267 /*< 40 CONTINUE >*/
268 /* L40: */
269 }
270 /*< END IF >*/
271 }
272
273 /*< RETURN >*/
274 return 0;
275
276 /* End of ZGERC . */
277
278 /*< END >*/
279 } /* zgerc_ */
280
281 #ifdef __cplusplus
282 }
283 #endif
284