LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
csymm.f
Go to the documentation of this file.
00001 *> \brief \b CSYMM
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 CSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       COMPLEX ALPHA,BETA
00015 *       INTEGER LDA,LDB,LDC,M,N
00016 *       CHARACTER SIDE,UPLO
00017 *       ..
00018 *       .. Array Arguments ..
00019 *       COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
00020 *       ..
00021 *  
00022 *
00023 *> \par Purpose:
00024 *  =============
00025 *>
00026 *> \verbatim
00027 *>
00028 *> CSYMM  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
00085 *>           On entry, ALPHA specifies the scalar alpha.
00086 *> \endverbatim
00087 *>
00088 *> \param[in] A
00089 *> \verbatim
00090 *>          A is COMPLEX 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 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
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 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 complex_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 CSYMM(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 ALPHA,BETA
00199       INTEGER LDA,LDB,LDC,M,N
00200       CHARACTER SIDE,UPLO
00201 *     ..
00202 *     .. Array Arguments ..
00203       COMPLEX 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 TEMP1,TEMP2
00220       INTEGER I,INFO,J,K,NROWA
00221       LOGICAL UPPER
00222 *     ..
00223 *     .. Parameters ..
00224       COMPLEX ONE
00225       PARAMETER (ONE= (1.0E+0,0.0E+0))
00226       COMPLEX ZERO
00227       PARAMETER (ZERO= (0.0E+0,0.0E+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('CSYMM ',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 CSYMM .
00368 *
00369       END
 All Files Functions