![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZSYRK 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE ZSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) 00012 * 00013 * .. Scalar Arguments .. 00014 * COMPLEX*16 ALPHA,BETA 00015 * INTEGER K,LDA,LDC,N 00016 * CHARACTER TRANS,UPLO 00017 * .. 00018 * .. Array Arguments .. 00019 * COMPLEX*16 A(LDA,*),C(LDC,*) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> ZSYRK performs one of the symmetric rank k operations 00029 *> 00030 *> C := alpha*A*A**T + beta*C, 00031 *> 00032 *> or 00033 *> 00034 *> C := alpha*A**T*A + beta*C, 00035 *> 00036 *> where alpha and beta are scalars, C is an n by n symmetric matrix 00037 *> and A is an n by k matrix in the first case and a k by n matrix 00038 *> in the second case. 00039 *> \endverbatim 00040 * 00041 * Arguments: 00042 * ========== 00043 * 00044 *> \param[in] UPLO 00045 *> \verbatim 00046 *> UPLO is CHARACTER*1 00047 *> On entry, UPLO specifies whether the upper or lower 00048 *> triangular part of the array C is to be referenced as 00049 *> follows: 00050 *> 00051 *> UPLO = 'U' or 'u' Only the upper triangular part of C 00052 *> is to be referenced. 00053 *> 00054 *> UPLO = 'L' or 'l' Only the lower triangular part of C 00055 *> is to be referenced. 00056 *> \endverbatim 00057 *> 00058 *> \param[in] TRANS 00059 *> \verbatim 00060 *> TRANS is CHARACTER*1 00061 *> On entry, TRANS specifies the operation to be performed as 00062 *> follows: 00063 *> 00064 *> TRANS = 'N' or 'n' C := alpha*A*A**T + beta*C. 00065 *> 00066 *> TRANS = 'T' or 't' C := alpha*A**T*A + beta*C. 00067 *> \endverbatim 00068 *> 00069 *> \param[in] N 00070 *> \verbatim 00071 *> N is INTEGER 00072 *> On entry, N specifies the order of the matrix C. N must be 00073 *> at least zero. 00074 *> \endverbatim 00075 *> 00076 *> \param[in] K 00077 *> \verbatim 00078 *> K is INTEGER 00079 *> On entry with TRANS = 'N' or 'n', K specifies the number 00080 *> of columns of the matrix A, and on entry with 00081 *> TRANS = 'T' or 't', K specifies the number of rows of the 00082 *> matrix A. K must be at least zero. 00083 *> \endverbatim 00084 *> 00085 *> \param[in] ALPHA 00086 *> \verbatim 00087 *> ALPHA is COMPLEX*16 00088 *> On entry, ALPHA specifies the scalar alpha. 00089 *> \endverbatim 00090 *> 00091 *> \param[in] A 00092 *> \verbatim 00093 *> A is COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is 00094 *> k when TRANS = 'N' or 'n', and is n otherwise. 00095 *> Before entry with TRANS = 'N' or 'n', the leading n by k 00096 *> part of the array A must contain the matrix A, otherwise 00097 *> the leading k by n part of the array A must contain the 00098 *> matrix A. 00099 *> \endverbatim 00100 *> 00101 *> \param[in] LDA 00102 *> \verbatim 00103 *> LDA is INTEGER 00104 *> On entry, LDA specifies the first dimension of A as declared 00105 *> in the calling (sub) program. When TRANS = 'N' or 'n' 00106 *> then LDA must be at least max( 1, n ), otherwise LDA must 00107 *> be at least max( 1, k ). 00108 *> \endverbatim 00109 *> 00110 *> \param[in] BETA 00111 *> \verbatim 00112 *> BETA is COMPLEX*16 00113 *> On entry, BETA specifies the scalar beta. 00114 *> \endverbatim 00115 *> 00116 *> \param[in,out] C 00117 *> \verbatim 00118 *> C is COMPLEX*16 array of DIMENSION ( LDC, n ). 00119 *> Before entry with UPLO = 'U' or 'u', the leading n by n 00120 *> upper triangular part of the array C must contain the upper 00121 *> triangular part of the symmetric matrix and the strictly 00122 *> lower triangular part of C is not referenced. On exit, the 00123 *> upper triangular part of the array C is overwritten by the 00124 *> upper triangular part of the updated matrix. 00125 *> Before entry with UPLO = 'L' or 'l', the leading n by n 00126 *> lower triangular part of the array C must contain the lower 00127 *> triangular part of the symmetric matrix and the strictly 00128 *> upper triangular part of C is not referenced. On exit, the 00129 *> lower triangular part of the array C is overwritten by the 00130 *> lower triangular part of the updated matrix. 00131 *> \endverbatim 00132 *> 00133 *> \param[in] LDC 00134 *> \verbatim 00135 *> LDC is INTEGER 00136 *> On entry, LDC specifies the first dimension of C as declared 00137 *> in the calling (sub) program. LDC must be at least 00138 *> max( 1, n ). 00139 *> \endverbatim 00140 * 00141 * Authors: 00142 * ======== 00143 * 00144 *> \author Univ. of Tennessee 00145 *> \author Univ. of California Berkeley 00146 *> \author Univ. of Colorado Denver 00147 *> \author NAG Ltd. 00148 * 00149 *> \date November 2011 00150 * 00151 *> \ingroup complex16_blas_level3 00152 * 00153 *> \par Further Details: 00154 * ===================== 00155 *> 00156 *> \verbatim 00157 *> 00158 *> Level 3 Blas routine. 00159 *> 00160 *> -- Written on 8-February-1989. 00161 *> Jack Dongarra, Argonne National Laboratory. 00162 *> Iain Duff, AERE Harwell. 00163 *> Jeremy Du Croz, Numerical Algorithms Group Ltd. 00164 *> Sven Hammarling, Numerical Algorithms Group Ltd. 00165 *> \endverbatim 00166 *> 00167 * ===================================================================== 00168 SUBROUTINE ZSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) 00169 * 00170 * -- Reference BLAS level3 routine (version 3.4.0) -- 00171 * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 00172 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00173 * November 2011 00174 * 00175 * .. Scalar Arguments .. 00176 COMPLEX*16 ALPHA,BETA 00177 INTEGER K,LDA,LDC,N 00178 CHARACTER TRANS,UPLO 00179 * .. 00180 * .. Array Arguments .. 00181 COMPLEX*16 A(LDA,*),C(LDC,*) 00182 * .. 00183 * 00184 * ===================================================================== 00185 * 00186 * .. External Functions .. 00187 LOGICAL LSAME 00188 EXTERNAL LSAME 00189 * .. 00190 * .. External Subroutines .. 00191 EXTERNAL XERBLA 00192 * .. 00193 * .. Intrinsic Functions .. 00194 INTRINSIC MAX 00195 * .. 00196 * .. Local Scalars .. 00197 COMPLEX*16 TEMP 00198 INTEGER I,INFO,J,L,NROWA 00199 LOGICAL UPPER 00200 * .. 00201 * .. Parameters .. 00202 COMPLEX*16 ONE 00203 PARAMETER (ONE= (1.0D+0,0.0D+0)) 00204 COMPLEX*16 ZERO 00205 PARAMETER (ZERO= (0.0D+0,0.0D+0)) 00206 * .. 00207 * 00208 * Test the input parameters. 00209 * 00210 IF (LSAME(TRANS,'N')) THEN 00211 NROWA = N 00212 ELSE 00213 NROWA = K 00214 END IF 00215 UPPER = LSAME(UPLO,'U') 00216 * 00217 INFO = 0 00218 IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN 00219 INFO = 1 00220 ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND. 00221 + (.NOT.LSAME(TRANS,'T'))) THEN 00222 INFO = 2 00223 ELSE IF (N.LT.0) THEN 00224 INFO = 3 00225 ELSE IF (K.LT.0) THEN 00226 INFO = 4 00227 ELSE IF (LDA.LT.MAX(1,NROWA)) THEN 00228 INFO = 7 00229 ELSE IF (LDC.LT.MAX(1,N)) THEN 00230 INFO = 10 00231 END IF 00232 IF (INFO.NE.0) THEN 00233 CALL XERBLA('ZSYRK ',INFO) 00234 RETURN 00235 END IF 00236 * 00237 * Quick return if possible. 00238 * 00239 IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR. 00240 + (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN 00241 * 00242 * And when alpha.eq.zero. 00243 * 00244 IF (ALPHA.EQ.ZERO) THEN 00245 IF (UPPER) THEN 00246 IF (BETA.EQ.ZERO) THEN 00247 DO 20 J = 1,N 00248 DO 10 I = 1,J 00249 C(I,J) = ZERO 00250 10 CONTINUE 00251 20 CONTINUE 00252 ELSE 00253 DO 40 J = 1,N 00254 DO 30 I = 1,J 00255 C(I,J) = BETA*C(I,J) 00256 30 CONTINUE 00257 40 CONTINUE 00258 END IF 00259 ELSE 00260 IF (BETA.EQ.ZERO) THEN 00261 DO 60 J = 1,N 00262 DO 50 I = J,N 00263 C(I,J) = ZERO 00264 50 CONTINUE 00265 60 CONTINUE 00266 ELSE 00267 DO 80 J = 1,N 00268 DO 70 I = J,N 00269 C(I,J) = BETA*C(I,J) 00270 70 CONTINUE 00271 80 CONTINUE 00272 END IF 00273 END IF 00274 RETURN 00275 END IF 00276 * 00277 * Start the operations. 00278 * 00279 IF (LSAME(TRANS,'N')) THEN 00280 * 00281 * Form C := alpha*A*A**T + beta*C. 00282 * 00283 IF (UPPER) THEN 00284 DO 130 J = 1,N 00285 IF (BETA.EQ.ZERO) THEN 00286 DO 90 I = 1,J 00287 C(I,J) = ZERO 00288 90 CONTINUE 00289 ELSE IF (BETA.NE.ONE) THEN 00290 DO 100 I = 1,J 00291 C(I,J) = BETA*C(I,J) 00292 100 CONTINUE 00293 END IF 00294 DO 120 L = 1,K 00295 IF (A(J,L).NE.ZERO) THEN 00296 TEMP = ALPHA*A(J,L) 00297 DO 110 I = 1,J 00298 C(I,J) = C(I,J) + TEMP*A(I,L) 00299 110 CONTINUE 00300 END IF 00301 120 CONTINUE 00302 130 CONTINUE 00303 ELSE 00304 DO 180 J = 1,N 00305 IF (BETA.EQ.ZERO) THEN 00306 DO 140 I = J,N 00307 C(I,J) = ZERO 00308 140 CONTINUE 00309 ELSE IF (BETA.NE.ONE) THEN 00310 DO 150 I = J,N 00311 C(I,J) = BETA*C(I,J) 00312 150 CONTINUE 00313 END IF 00314 DO 170 L = 1,K 00315 IF (A(J,L).NE.ZERO) THEN 00316 TEMP = ALPHA*A(J,L) 00317 DO 160 I = J,N 00318 C(I,J) = C(I,J) + TEMP*A(I,L) 00319 160 CONTINUE 00320 END IF 00321 170 CONTINUE 00322 180 CONTINUE 00323 END IF 00324 ELSE 00325 * 00326 * Form C := alpha*A**T*A + beta*C. 00327 * 00328 IF (UPPER) THEN 00329 DO 210 J = 1,N 00330 DO 200 I = 1,J 00331 TEMP = ZERO 00332 DO 190 L = 1,K 00333 TEMP = TEMP + A(L,I)*A(L,J) 00334 190 CONTINUE 00335 IF (BETA.EQ.ZERO) THEN 00336 C(I,J) = ALPHA*TEMP 00337 ELSE 00338 C(I,J) = ALPHA*TEMP + BETA*C(I,J) 00339 END IF 00340 200 CONTINUE 00341 210 CONTINUE 00342 ELSE 00343 DO 240 J = 1,N 00344 DO 230 I = J,N 00345 TEMP = ZERO 00346 DO 220 L = 1,K 00347 TEMP = TEMP + A(L,I)*A(L,J) 00348 220 CONTINUE 00349 IF (BETA.EQ.ZERO) THEN 00350 C(I,J) = ALPHA*TEMP 00351 ELSE 00352 C(I,J) = ALPHA*TEMP + BETA*C(I,J) 00353 END IF 00354 230 CONTINUE 00355 240 CONTINUE 00356 END IF 00357 END IF 00358 * 00359 RETURN 00360 * 00361 * End of ZSYRK . 00362 * 00363 END