1 SUBROUTINE ZSYRKF ( UPLO, TRANS, N, K, ALPHA, A, LDA,
3 * .. Scalar Arguments ..
4 CHARACTER*1 UPLO, TRANS
7 * .. Array Arguments ..
8 COMPLEX*16 A( LDA, * ), C( LDC, * )
14 * ZSYRK performs one of the symmetric rank k operations
16 * C := alpha*A*A' + beta*C,
20 * C := alpha*A'*A + beta*C,
22 * where alpha and beta are scalars, C is an n by n symmetric matrix
23 * and A is an n by k matrix in the first case and a k by n matrix
30 * On entry, UPLO specifies whether the upper or lower
31 * triangular part of the array C is to be referenced as
34 * UPLO = 'U' or 'u' Only the upper triangular part of C
35 * is to be referenced.
37 * UPLO = 'L' or 'l' Only the lower triangular part of C
38 * is to be referenced.
42 * TRANS - CHARACTER*1.
43 * On entry, TRANS specifies the operation to be performed as
46 * TRANS = 'N' or 'n' C := alpha*A*A' + beta*C.
48 * TRANS = 'T' or 't' C := alpha*A'*A + beta*C.
53 * On entry, N specifies the order of the matrix C. N must be
58 * On entry with TRANS = 'N' or 'n', K specifies the number
59 * of columns of the matrix A, and on entry with
60 * TRANS = 'T' or 't', K specifies the number of rows of the
61 * matrix A. K must be at least zero.
64 * ALPHA - COMPLEX*16 .
65 * On entry, ALPHA specifies the scalar alpha.
68 * A - COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
69 * k when TRANS = 'N' or 'n', and is n otherwise.
70 * Before entry with TRANS = 'N' or 'n', the leading n by k
71 * part of the array A must contain the matrix A, otherwise
72 * the leading k by n part of the array A must contain the
77 * On entry, LDA specifies the first dimension of A as declared
78 * in the calling (sub) program. When TRANS = 'N' or 'n'
79 * then LDA must be at least max( 1, n ), otherwise LDA must
80 * be at least max( 1, k ).
84 * On entry, BETA specifies the scalar beta.
87 * C - COMPLEX*16 array of DIMENSION ( LDC, n ).
88 * Before entry with UPLO = 'U' or 'u', the leading n by n
89 * upper triangular part of the array C must contain the upper
90 * triangular part of the symmetric matrix and the strictly
91 * lower triangular part of C is not referenced. On exit, the
92 * upper triangular part of the array C is overwritten by the
93 * upper triangular part of the updated matrix.
94 * Before entry with UPLO = 'L' or 'l', the leading n by n
95 * lower triangular part of the array C must contain the lower
96 * triangular part of the symmetric matrix and the strictly
97 * upper triangular part of C is not referenced. On exit, the
98 * lower triangular part of the array C is overwritten by the
99 * lower triangular part of the updated matrix.
102 * On entry, LDC specifies the first dimension of C as declared
103 * in the calling (sub) program. LDC must be at least
108 * Level 3 Blas routine.
110 * -- Written on 8-February-1989.
111 * Jack Dongarra, Argonne National Laboratory.
112 * Iain Duff, AERE Harwell.
113 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
114 * Sven Hammarling, Numerical Algorithms Group Ltd.
117 * .. External Functions ..
120 * .. External Subroutines ..
122 * .. Intrinsic Functions ..
124 * .. Local Scalars ..
126 INTEGER I, INFO, J, L, NROWA
130 PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
132 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
134 * .. Executable Statements ..
136 * Test the input parameters.
138 IF( LSAME( TRANS, 'N' ) )THEN
143 UPPER = LSAME( UPLO, 'U' )
146 IF( ( .NOT.UPPER ).AND.
147 $ ( .NOT.LSAME( UPLO , 'L' ) ) )THEN
149 ELSE IF( ( .NOT.LSAME( TRANS, 'N' ) ).AND.
150 $ ( .NOT.LSAME( TRANS, 'T' ) ) )THEN
152 ELSE IF( N .LT.0 )THEN
154 ELSE IF( K .LT.0 )THEN
156 ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
158 ELSE IF( LDC.LT.MAX( 1, N ) )THEN
162 CALL XERBLA( 'ZSYRK ', INFO )
166 * Quick return if possible.
169 $ ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )
172 * And when alpha.eq.zero.
174 IF( ALPHA.EQ.ZERO )THEN
176 IF( BETA.EQ.ZERO )THEN
185 C( I, J ) = BETA*C( I, J )
190 IF( BETA.EQ.ZERO )THEN
199 C( I, J ) = BETA*C( I, J )
207 * Start the operations.
209 IF( LSAME( TRANS, 'N' ) )THEN
211 * Form C := alpha*A*A' + beta*C.
215 IF( BETA.EQ.ZERO )THEN
219 ELSE IF( BETA.NE.ONE )THEN
221 C( I, J ) = BETA*C( I, J )
225 IF( A( J, L ).NE.ZERO )THEN
226 TEMP = ALPHA*A( J, L )
228 C( I, J ) = C( I, J ) + TEMP*A( I, L )
235 IF( BETA.EQ.ZERO )THEN
239 ELSE IF( BETA.NE.ONE )THEN
241 C( I, J ) = BETA*C( I, J )
245 IF( A( J, L ).NE.ZERO )THEN
246 TEMP = ALPHA*A( J, L )
248 C( I, J ) = C( I, J ) + TEMP*A( I, L )
256 * Form C := alpha*A'*A + beta*C.
263 TEMP = TEMP + A( L, I )*A( L, J )
265 IF( BETA.EQ.ZERO )THEN
266 C( I, J ) = ALPHA*TEMP
268 C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
277 TEMP = TEMP + A( L, I )*A( L, J )
279 IF( BETA.EQ.ZERO )THEN
280 C( I, J ) = ALPHA*TEMP
282 C( I, J ) = ALPHA*TEMP + BETA*C( I, J )