LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zhemm.f
Go to the documentation of this file.
00001 *> \brief \b ZHEMM
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 ZHEMM(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 *> ZHEMM  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 an hermitian 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  hermitian 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  hermitian  matrix   A  is  to  be
00059 *>           referenced as follows:
00060 *>
00061 *>              UPLO = 'U' or 'u'   Only the upper triangular part of the
00062 *>                                  hermitian matrix is to be referenced.
00063 *>
00064 *>              UPLO = 'L' or 'l'   Only the lower triangular part of the
00065 *>                                  hermitian 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  hermitian 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  hermitian 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  hermitian
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  hermitian 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  hermitian 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  hermitian
00110 *>           matrix and the  strictly upper triangular part of  A  is not
00111 *>           referenced.
00112 *>           Note that the imaginary parts  of the diagonal elements need
00113 *>           not be set, they are assumed to be zero.
00114 *> \endverbatim
00115 *>
00116 *> \param[in] LDA
00117 *> \verbatim
00118 *>          LDA is INTEGER
00119 *>           On entry, LDA specifies the first dimension of A as declared
00120 *>           in the  calling (sub) program. When  SIDE = 'L' or 'l'  then
00121 *>           LDA must be at least  max( 1, m ), otherwise  LDA must be at
00122 *>           least max( 1, n ).
00123 *> \endverbatim
00124 *>
00125 *> \param[in] B
00126 *> \verbatim
00127 *>          B is COMPLEX*16 array of DIMENSION ( LDB, n ).
00128 *>           Before entry, the leading  m by n part of the array  B  must
00129 *>           contain the matrix B.
00130 *> \endverbatim
00131 *>
00132 *> \param[in] LDB
00133 *> \verbatim
00134 *>          LDB is INTEGER
00135 *>           On entry, LDB specifies the first dimension of B as declared
00136 *>           in  the  calling  (sub)  program.   LDB  must  be  at  least
00137 *>           max( 1, m ).
00138 *> \endverbatim
00139 *>
00140 *> \param[in] BETA
00141 *> \verbatim
00142 *>          BETA is COMPLEX*16
00143 *>           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
00144 *>           supplied as zero then C need not be set on input.
00145 *> \endverbatim
00146 *>
00147 *> \param[in,out] C
00148 *> \verbatim
00149 *>          C is COMPLEX*16 array of DIMENSION ( LDC, n ).
00150 *>           Before entry, the leading  m by n  part of the array  C must
00151 *>           contain the matrix  C,  except when  beta  is zero, in which
00152 *>           case C need not be set on entry.
00153 *>           On exit, the array  C  is overwritten by the  m by n updated
00154 *>           matrix.
00155 *> \endverbatim
00156 *>
00157 *> \param[in] LDC
00158 *> \verbatim
00159 *>          LDC is INTEGER
00160 *>           On entry, LDC specifies the first dimension of C as declared
00161 *>           in  the  calling  (sub)  program.   LDC  must  be  at  least
00162 *>           max( 1, m ).
00163 *> \endverbatim
00164 *
00165 *  Authors:
00166 *  ========
00167 *
00168 *> \author Univ. of Tennessee 
00169 *> \author Univ. of California Berkeley 
00170 *> \author Univ. of Colorado Denver 
00171 *> \author NAG Ltd. 
00172 *
00173 *> \date November 2011
00174 *
00175 *> \ingroup complex16_blas_level3
00176 *
00177 *> \par Further Details:
00178 *  =====================
00179 *>
00180 *> \verbatim
00181 *>
00182 *>  Level 3 Blas routine.
00183 *>
00184 *>  -- Written on 8-February-1989.
00185 *>     Jack Dongarra, Argonne National Laboratory.
00186 *>     Iain Duff, AERE Harwell.
00187 *>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
00188 *>     Sven Hammarling, Numerical Algorithms Group Ltd.
00189 *> \endverbatim
00190 *>
00191 *  =====================================================================
00192       SUBROUTINE ZHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
00193 *
00194 *  -- Reference BLAS level3 routine (version 3.4.0) --
00195 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
00196 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00197 *     November 2011
00198 *
00199 *     .. Scalar Arguments ..
00200       COMPLEX*16 ALPHA,BETA
00201       INTEGER LDA,LDB,LDC,M,N
00202       CHARACTER SIDE,UPLO
00203 *     ..
00204 *     .. Array Arguments ..
00205       COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
00206 *     ..
00207 *
00208 *  =====================================================================
00209 *
00210 *     .. External Functions ..
00211       LOGICAL LSAME
00212       EXTERNAL LSAME
00213 *     ..
00214 *     .. External Subroutines ..
00215       EXTERNAL XERBLA
00216 *     ..
00217 *     .. Intrinsic Functions ..
00218       INTRINSIC DBLE,DCONJG,MAX
00219 *     ..
00220 *     .. Local Scalars ..
00221       COMPLEX*16 TEMP1,TEMP2
00222       INTEGER I,INFO,J,K,NROWA
00223       LOGICAL UPPER
00224 *     ..
00225 *     .. Parameters ..
00226       COMPLEX*16 ONE
00227       PARAMETER (ONE= (1.0D+0,0.0D+0))
00228       COMPLEX*16 ZERO
00229       PARAMETER (ZERO= (0.0D+0,0.0D+0))
00230 *     ..
00231 *
00232 *     Set NROWA as the number of rows of A.
00233 *
00234       IF (LSAME(SIDE,'L')) THEN
00235           NROWA = M
00236       ELSE
00237           NROWA = N
00238       END IF
00239       UPPER = LSAME(UPLO,'U')
00240 *
00241 *     Test the input parameters.
00242 *
00243       INFO = 0
00244       IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
00245           INFO = 1
00246       ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
00247           INFO = 2
00248       ELSE IF (M.LT.0) THEN
00249           INFO = 3
00250       ELSE IF (N.LT.0) THEN
00251           INFO = 4
00252       ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
00253           INFO = 7
00254       ELSE IF (LDB.LT.MAX(1,M)) THEN
00255           INFO = 9
00256       ELSE IF (LDC.LT.MAX(1,M)) THEN
00257           INFO = 12
00258       END IF
00259       IF (INFO.NE.0) THEN
00260           CALL XERBLA('ZHEMM ',INFO)
00261           RETURN
00262       END IF
00263 *
00264 *     Quick return if possible.
00265 *
00266       IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
00267      +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
00268 *
00269 *     And when  alpha.eq.zero.
00270 *
00271       IF (ALPHA.EQ.ZERO) THEN
00272           IF (BETA.EQ.ZERO) THEN
00273               DO 20 J = 1,N
00274                   DO 10 I = 1,M
00275                       C(I,J) = ZERO
00276    10             CONTINUE
00277    20         CONTINUE
00278           ELSE
00279               DO 40 J = 1,N
00280                   DO 30 I = 1,M
00281                       C(I,J) = BETA*C(I,J)
00282    30             CONTINUE
00283    40         CONTINUE
00284           END IF
00285           RETURN
00286       END IF
00287 *
00288 *     Start the operations.
00289 *
00290       IF (LSAME(SIDE,'L')) THEN
00291 *
00292 *        Form  C := alpha*A*B + beta*C.
00293 *
00294           IF (UPPER) THEN
00295               DO 70 J = 1,N
00296                   DO 60 I = 1,M
00297                       TEMP1 = ALPHA*B(I,J)
00298                       TEMP2 = ZERO
00299                       DO 50 K = 1,I - 1
00300                           C(K,J) = C(K,J) + TEMP1*A(K,I)
00301                           TEMP2 = TEMP2 + B(K,J)*DCONJG(A(K,I))
00302    50                 CONTINUE
00303                       IF (BETA.EQ.ZERO) THEN
00304                           C(I,J) = TEMP1*DBLE(A(I,I)) + ALPHA*TEMP2
00305                       ELSE
00306                           C(I,J) = BETA*C(I,J) + TEMP1*DBLE(A(I,I)) +
00307      +                             ALPHA*TEMP2
00308                       END IF
00309    60             CONTINUE
00310    70         CONTINUE
00311           ELSE
00312               DO 100 J = 1,N
00313                   DO 90 I = M,1,-1
00314                       TEMP1 = ALPHA*B(I,J)
00315                       TEMP2 = ZERO
00316                       DO 80 K = I + 1,M
00317                           C(K,J) = C(K,J) + TEMP1*A(K,I)
00318                           TEMP2 = TEMP2 + B(K,J)*DCONJG(A(K,I))
00319    80                 CONTINUE
00320                       IF (BETA.EQ.ZERO) THEN
00321                           C(I,J) = TEMP1*DBLE(A(I,I)) + ALPHA*TEMP2
00322                       ELSE
00323                           C(I,J) = BETA*C(I,J) + TEMP1*DBLE(A(I,I)) +
00324      +                             ALPHA*TEMP2
00325                       END IF
00326    90             CONTINUE
00327   100         CONTINUE
00328           END IF
00329       ELSE
00330 *
00331 *        Form  C := alpha*B*A + beta*C.
00332 *
00333           DO 170 J = 1,N
00334               TEMP1 = ALPHA*DBLE(A(J,J))
00335               IF (BETA.EQ.ZERO) THEN
00336                   DO 110 I = 1,M
00337                       C(I,J) = TEMP1*B(I,J)
00338   110             CONTINUE
00339               ELSE
00340                   DO 120 I = 1,M
00341                       C(I,J) = BETA*C(I,J) + TEMP1*B(I,J)
00342   120             CONTINUE
00343               END IF
00344               DO 140 K = 1,J - 1
00345                   IF (UPPER) THEN
00346                       TEMP1 = ALPHA*A(K,J)
00347                   ELSE
00348                       TEMP1 = ALPHA*DCONJG(A(J,K))
00349                   END IF
00350                   DO 130 I = 1,M
00351                       C(I,J) = C(I,J) + TEMP1*B(I,K)
00352   130             CONTINUE
00353   140         CONTINUE
00354               DO 160 K = J + 1,N
00355                   IF (UPPER) THEN
00356                       TEMP1 = ALPHA*DCONJG(A(J,K))
00357                   ELSE
00358                       TEMP1 = ALPHA*A(K,J)
00359                   END IF
00360                   DO 150 I = 1,M
00361                       C(I,J) = C(I,J) + TEMP1*B(I,K)
00362   150             CONTINUE
00363   160         CONTINUE
00364   170     CONTINUE
00365       END IF
00366 *
00367       RETURN
00368 *
00369 *     End of ZHEMM .
00370 *
00371       END
 All Files Functions