LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zsyrk.f
Go to the documentation of this file.
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
 All Files Functions