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