1 SUBROUTINE CGERC(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
2 * .. Scalar Arguments ..
3 COMPLEX ALPHA
4 INTEGER INCX,INCY,LDA,M,N
5 * ..
6 * .. Array Arguments ..
7 COMPLEX A(LDA,*),X(*),Y(*)
8 * ..
9 *
10 * Purpose
11 * =======
12 *
13 * CGERC performs the rank 1 operation
14 *
15 * A := alpha*x*y**H + A,
16 *
17 * where alpha is a scalar, x is an m element vector, y is an n element
18 * vector and A is an m by n matrix.
19 *
20 * Arguments
21 * ==========
22 *
23 * M - INTEGER.
24 * On entry, M specifies the number of rows of the matrix A.
25 * M must be at least zero.
26 * Unchanged on exit.
27 *
28 * N - INTEGER.
29 * On entry, N specifies the number of columns of the matrix A.
30 * N must be at least zero.
31 * Unchanged on exit.
32 *
33 * ALPHA - COMPLEX .
34 * On entry, ALPHA specifies the scalar alpha.
35 * Unchanged on exit.
36 *
37 * X - COMPLEX array of dimension at least
38 * ( 1 + ( m - 1 )*abs( INCX ) ).
39 * Before entry, the incremented array X must contain the m
40 * element vector x.
41 * Unchanged on exit.
42 *
43 * INCX - INTEGER.
44 * On entry, INCX specifies the increment for the elements of
45 * X. INCX must not be zero.
46 * Unchanged on exit.
47 *
48 * Y - COMPLEX array of dimension at least
49 * ( 1 + ( n - 1 )*abs( INCY ) ).
50 * Before entry, the incremented array Y must contain the n
51 * element vector y.
52 * Unchanged on exit.
53 *
54 * INCY - INTEGER.
55 * On entry, INCY specifies the increment for the elements of
56 * Y. INCY must not be zero.
57 * Unchanged on exit.
58 *
59 * A - COMPLEX array of DIMENSION ( LDA, n ).
60 * Before entry, the leading m by n part of the array A must
61 * contain the matrix of coefficients. On exit, A is
62 * overwritten by the updated matrix.
63 *
64 * LDA - INTEGER.
65 * On entry, LDA specifies the first dimension of A as declared
66 * in the calling (sub) program. LDA must be at least
67 * max( 1, m ).
68 * Unchanged on exit.
69 *
70 * Further Details
71 * ===============
72 *
73 * Level 2 Blas routine.
74 *
75 * -- Written on 22-October-1986.
76 * Jack Dongarra, Argonne National Lab.
77 * Jeremy Du Croz, Nag Central Office.
78 * Sven Hammarling, Nag Central Office.
79 * Richard Hanson, Sandia National Labs.
80 *
81 * =====================================================================
82 *
83 * .. Parameters ..
84 COMPLEX ZERO
85 PARAMETER (ZERO= (0.0E+0,0.0E+0))
86 * ..
87 * .. Local Scalars ..
88 COMPLEX TEMP
89 INTEGER I,INFO,IX,J,JY,KX
90 * ..
91 * .. External Subroutines ..
92 EXTERNAL XERBLA
93 * ..
94 * .. Intrinsic Functions ..
95 INTRINSIC CONJG,MAX
96 * ..
97 *
98 * Test the input parameters.
99 *
100 INFO = 0
101 IF (M.LT.0) THEN
102 INFO = 1
103 ELSE IF (N.LT.0) THEN
104 INFO = 2
105 ELSE IF (INCX.EQ.0) THEN
106 INFO = 5
107 ELSE IF (INCY.EQ.0) THEN
108 INFO = 7
109 ELSE IF (LDA.LT.MAX(1,M)) THEN
110 INFO = 9
111 END IF
112 IF (INFO.NE.0) THEN
113 CALL XERBLA('CGERC ',INFO)
114 RETURN
115 END IF
116 *
117 * Quick return if possible.
118 *
119 IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
120 *
121 * Start the operations. In this version the elements of A are
122 * accessed sequentially with one pass through A.
123 *
124 IF (INCY.GT.0) THEN
125 JY = 1
126 ELSE
127 JY = 1 - (N-1)*INCY
128 END IF
129 IF (INCX.EQ.1) THEN
130 DO 20 J = 1,N
131 IF (Y(JY).NE.ZERO) THEN
132 TEMP = ALPHA*CONJG(Y(JY))
133 DO 10 I = 1,M
134 A(I,J) = A(I,J) + X(I)*TEMP
135 10 CONTINUE
136 END IF
137 JY = JY + INCY
138 20 CONTINUE
139 ELSE
140 IF (INCX.GT.0) THEN
141 KX = 1
142 ELSE
143 KX = 1 - (M-1)*INCX
144 END IF
145 DO 40 J = 1,N
146 IF (Y(JY).NE.ZERO) THEN
147 TEMP = ALPHA*CONJG(Y(JY))
148 IX = KX
149 DO 30 I = 1,M
150 A(I,J) = A(I,J) + X(IX)*TEMP
151 IX = IX + INCX
152 30 CONTINUE
153 END IF
154 JY = JY + INCY
155 40 CONTINUE
156 END IF
157 *
158 RETURN
159 *
160 * End of CGERC .
161 *
162 END
2 * .. Scalar Arguments ..
3 COMPLEX ALPHA
4 INTEGER INCX,INCY,LDA,M,N
5 * ..
6 * .. Array Arguments ..
7 COMPLEX A(LDA,*),X(*),Y(*)
8 * ..
9 *
10 * Purpose
11 * =======
12 *
13 * CGERC performs the rank 1 operation
14 *
15 * A := alpha*x*y**H + A,
16 *
17 * where alpha is a scalar, x is an m element vector, y is an n element
18 * vector and A is an m by n matrix.
19 *
20 * Arguments
21 * ==========
22 *
23 * M - INTEGER.
24 * On entry, M specifies the number of rows of the matrix A.
25 * M must be at least zero.
26 * Unchanged on exit.
27 *
28 * N - INTEGER.
29 * On entry, N specifies the number of columns of the matrix A.
30 * N must be at least zero.
31 * Unchanged on exit.
32 *
33 * ALPHA - COMPLEX .
34 * On entry, ALPHA specifies the scalar alpha.
35 * Unchanged on exit.
36 *
37 * X - COMPLEX array of dimension at least
38 * ( 1 + ( m - 1 )*abs( INCX ) ).
39 * Before entry, the incremented array X must contain the m
40 * element vector x.
41 * Unchanged on exit.
42 *
43 * INCX - INTEGER.
44 * On entry, INCX specifies the increment for the elements of
45 * X. INCX must not be zero.
46 * Unchanged on exit.
47 *
48 * Y - COMPLEX array of dimension at least
49 * ( 1 + ( n - 1 )*abs( INCY ) ).
50 * Before entry, the incremented array Y must contain the n
51 * element vector y.
52 * Unchanged on exit.
53 *
54 * INCY - INTEGER.
55 * On entry, INCY specifies the increment for the elements of
56 * Y. INCY must not be zero.
57 * Unchanged on exit.
58 *
59 * A - COMPLEX array of DIMENSION ( LDA, n ).
60 * Before entry, the leading m by n part of the array A must
61 * contain the matrix of coefficients. On exit, A is
62 * overwritten by the updated matrix.
63 *
64 * LDA - INTEGER.
65 * On entry, LDA specifies the first dimension of A as declared
66 * in the calling (sub) program. LDA must be at least
67 * max( 1, m ).
68 * Unchanged on exit.
69 *
70 * Further Details
71 * ===============
72 *
73 * Level 2 Blas routine.
74 *
75 * -- Written on 22-October-1986.
76 * Jack Dongarra, Argonne National Lab.
77 * Jeremy Du Croz, Nag Central Office.
78 * Sven Hammarling, Nag Central Office.
79 * Richard Hanson, Sandia National Labs.
80 *
81 * =====================================================================
82 *
83 * .. Parameters ..
84 COMPLEX ZERO
85 PARAMETER (ZERO= (0.0E+0,0.0E+0))
86 * ..
87 * .. Local Scalars ..
88 COMPLEX TEMP
89 INTEGER I,INFO,IX,J,JY,KX
90 * ..
91 * .. External Subroutines ..
92 EXTERNAL XERBLA
93 * ..
94 * .. Intrinsic Functions ..
95 INTRINSIC CONJG,MAX
96 * ..
97 *
98 * Test the input parameters.
99 *
100 INFO = 0
101 IF (M.LT.0) THEN
102 INFO = 1
103 ELSE IF (N.LT.0) THEN
104 INFO = 2
105 ELSE IF (INCX.EQ.0) THEN
106 INFO = 5
107 ELSE IF (INCY.EQ.0) THEN
108 INFO = 7
109 ELSE IF (LDA.LT.MAX(1,M)) THEN
110 INFO = 9
111 END IF
112 IF (INFO.NE.0) THEN
113 CALL XERBLA('CGERC ',INFO)
114 RETURN
115 END IF
116 *
117 * Quick return if possible.
118 *
119 IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
120 *
121 * Start the operations. In this version the elements of A are
122 * accessed sequentially with one pass through A.
123 *
124 IF (INCY.GT.0) THEN
125 JY = 1
126 ELSE
127 JY = 1 - (N-1)*INCY
128 END IF
129 IF (INCX.EQ.1) THEN
130 DO 20 J = 1,N
131 IF (Y(JY).NE.ZERO) THEN
132 TEMP = ALPHA*CONJG(Y(JY))
133 DO 10 I = 1,M
134 A(I,J) = A(I,J) + X(I)*TEMP
135 10 CONTINUE
136 END IF
137 JY = JY + INCY
138 20 CONTINUE
139 ELSE
140 IF (INCX.GT.0) THEN
141 KX = 1
142 ELSE
143 KX = 1 - (M-1)*INCX
144 END IF
145 DO 40 J = 1,N
146 IF (Y(JY).NE.ZERO) THEN
147 TEMP = ALPHA*CONJG(Y(JY))
148 IX = KX
149 DO 30 I = 1,M
150 A(I,J) = A(I,J) + X(IX)*TEMP
151 IX = IX + INCX
152 30 CONTINUE
153 END IF
154 JY = JY + INCY
155 40 CONTINUE
156 END IF
157 *
158 RETURN
159 *
160 * End of CGERC .
161 *
162 END