BLAS/SRC/csymm.f

   1 *> \brief \b CSYMM
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE CSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
  12 *
  13 *       .. Scalar Arguments ..
  14 *       COMPLEX ALPHA,BETA
  15 *       INTEGER LDA,LDB,LDC,M,N
  16 *       CHARACTER SIDE,UPLO
  17 *       ..
  18 *       .. Array Arguments ..
  19 *       COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
  20 *       ..
  21 *
  22 *
  23 *> \par Purpose:
  24 *  =============
  25 *>
  26 *> \verbatim
  27 *>
  28 *> CSYMM  performs one of the matrix-matrix operations
  29 *>
  30 *>    C := alpha*A*B + beta*C,
  31 *>
  32 *> or
  33 *>
  34 *>    C := alpha*B*A + beta*C,
  35 *>
  36 *> where  alpha and beta are scalars, A is a symmetric matrix and  B and
  37 *> C are m by n matrices.
  38 *> \endverbatim
  39 *
  40 *  Arguments:
  41 *  ==========
  42 *
  43 *> \param[in] SIDE
  44 *> \verbatim
  45 *>          SIDE is CHARACTER*1
  46 *>           On entry,  SIDE  specifies whether  the  symmetric matrix  A
  47 *>           appears on the  left or right  in the  operation as follows:
  48 *>
  49 *>              SIDE = 'L' or 'l'   C := alpha*A*B + beta*C,
  50 *>
  51 *>              SIDE = 'R' or 'r'   C := alpha*B*A + beta*C,
  52 *> \endverbatim
  53 *>
  54 *> \param[in] UPLO
  55 *> \verbatim
  56 *>          UPLO is CHARACTER*1
  57 *>           On  entry,   UPLO  specifies  whether  the  upper  or  lower
  58 *>           triangular  part  of  the  symmetric  matrix   A  is  to  be
  59 *>           referenced as follows:
  60 *>
  61 *>              UPLO = 'U' or 'u'   Only the upper triangular part of the
  62 *>                                  symmetric matrix is to be referenced.
  63 *>
  64 *>              UPLO = 'L' or 'l'   Only the lower triangular part of the
  65 *>                                  symmetric matrix is to be referenced.
  66 *> \endverbatim
  67 *>
  68 *> \param[in] M
  69 *> \verbatim
  70 *>          M is INTEGER
  71 *>           On entry,  M  specifies the number of rows of the matrix  C.
  72 *>           M  must be at least zero.
  73 *> \endverbatim
  74 *>
  75 *> \param[in] N
  76 *> \verbatim
  77 *>          N is INTEGER
  78 *>           On entry, N specifies the number of columns of the matrix C.
  79 *>           N  must be at least zero.
  80 *> \endverbatim
  81 *>
  82 *> \param[in] ALPHA
  83 *> \verbatim
  84 *>          ALPHA is COMPLEX
  85 *>           On entry, ALPHA specifies the scalar alpha.
  86 *> \endverbatim
  87 *>
  88 *> \param[in] A
  89 *> \verbatim
  90 *>          A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
  91 *>           m  when  SIDE = 'L' or 'l'  and is n  otherwise.
  92 *>           Before entry  with  SIDE = 'L' or 'l',  the  m by m  part of
  93 *>           the array  A  must contain the  symmetric matrix,  such that
  94 *>           when  UPLO = 'U' or 'u', the leading m by m upper triangular
  95 *>           part of the array  A  must contain the upper triangular part
  96 *>           of the  symmetric matrix and the  strictly  lower triangular
  97 *>           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
  98 *>           the leading  m by m  lower triangular part  of the  array  A
  99 *>           must  contain  the  lower triangular part  of the  symmetric
 100 *>           matrix and the  strictly upper triangular part of  A  is not
 101 *>           referenced.
 102 *>           Before entry  with  SIDE = 'R' or 'r',  the  n by n  part of
 103 *>           the array  A  must contain the  symmetric matrix,  such that
 104 *>           when  UPLO = 'U' or 'u', the leading n by n upper triangular
 105 *>           part of the array  A  must contain the upper triangular part
 106 *>           of the  symmetric matrix and the  strictly  lower triangular
 107 *>           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
 108 *>           the leading  n by n  lower triangular part  of the  array  A
 109 *>           must  contain  the  lower triangular part  of the  symmetric
 110 *>           matrix and the  strictly upper triangular part of  A  is not
 111 *>           referenced.
 112 *> \endverbatim
 113 *>
 114 *> \param[in] LDA
 115 *> \verbatim
 116 *>          LDA is INTEGER
 117 *>           On entry, LDA specifies the first dimension of A as declared
 118 *>           in the  calling (sub) program. When  SIDE = 'L' or 'l'  then
 119 *>           LDA must be at least  max( 1, m ), otherwise  LDA must be at
 120 *>           least max( 1, n ).
 121 *> \endverbatim
 122 *>
 123 *> \param[in] B
 124 *> \verbatim
 125 *>          B is COMPLEX array of DIMENSION ( LDB, n ).
 126 *>           Before entry, the leading  m by n part of the array  B  must
 127 *>           contain the matrix B.
 128 *> \endverbatim
 129 *>
 130 *> \param[in] LDB
 131 *> \verbatim
 132 *>          LDB is INTEGER
 133 *>           On entry, LDB specifies the first dimension of B as declared
 134 *>           in  the  calling  (sub)  program.   LDB  must  be  at  least
 135 *>           max( 1, m ).
 136 *> \endverbatim
 137 *>
 138 *> \param[in] BETA
 139 *> \verbatim
 140 *>          BETA is COMPLEX
 141 *>           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
 142 *>           supplied as zero then C need not be set on input.
 143 *> \endverbatim
 144 *>
 145 *> \param[in,out] C
 146 *> \verbatim
 147 *>          C is COMPLEX array of DIMENSION ( LDC, n ).
 148 *>           Before entry, the leading  m by n  part of the array  C must
 149 *>           contain the matrix  C,  except when  beta  is zero, in which
 150 *>           case C need not be set on entry.
 151 *>           On exit, the array  C  is overwritten by the  m by n updated
 152 *>           matrix.
 153 *> \endverbatim
 154 *>
 155 *> \param[in] LDC
 156 *> \verbatim
 157 *>          LDC is INTEGER
 158 *>           On entry, LDC specifies the first dimension of C as declared
 159 *>           in  the  calling  (sub)  program.   LDC  must  be  at  least
 160 *>           max( 1, m ).
 161 *> \endverbatim
 162 *
 163 *  Authors:
 164 *  ========
 165 *
 166 *> \author Univ. of Tennessee
 167 *> \author Univ. of California Berkeley
 168 *> \author Univ. of Colorado Denver
 169 *> \author NAG Ltd.
 170 *
 171 *> \date November 2011
 172 *
 173 *> \ingroup complex_blas_level3
 174 *
 175 *> \par Further Details:
 176 *  =====================
 177 *>
 178 *> \verbatim
 179 *>
 180 *>  Level 3 Blas routine.
 181 *>
 182 *>  -- Written on 8-February-1989.
 183 *>     Jack Dongarra, Argonne National Laboratory.
 184 *>     Iain Duff, AERE Harwell.
 185 *>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
 186 *>     Sven Hammarling, Numerical Algorithms Group Ltd.
 187 *> \endverbatim
 188 *>
 189 *  =====================================================================
 190       SUBROUTINE CSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
 191 *
 192 *  -- Reference BLAS level3 routine (version 3.4.0) --
 193 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 194 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 195 *     November 2011
 196 *
 197 *     .. Scalar Arguments ..
 198       COMPLEX ALPHA,BETA
 199       INTEGER LDA,LDB,LDC,M,N
 200       CHARACTER SIDE,UPLO
 201 *     ..
 202 *     .. Array Arguments ..
 203       COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
 204 *     ..
 205 *
 206 *  =====================================================================
 207 *
 208 *     .. External Functions ..
 209       LOGICAL LSAME
 210       EXTERNAL LSAME
 211 *     ..
 212 *     .. External Subroutines ..
 213       EXTERNAL XERBLA
 214 *     ..
 215 *     .. Intrinsic Functions ..
 216       INTRINSIC MAX
 217 *     ..
 218 *     .. Local Scalars ..
 219       COMPLEX TEMP1,TEMP2
 220       INTEGER I,INFO,J,K,NROWA
 221       LOGICAL UPPER
 222 *     ..
 223 *     .. Parameters ..
 224       COMPLEX ONE
 225       PARAMETER (ONE= (1.0E+0,0.0E+0))
 226       COMPLEX ZERO
 227       PARAMETER (ZERO= (0.0E+0,0.0E+0))
 228 *     ..
 229 *
 230 *     Set NROWA as the number of rows of A.
 231 *
 232       IF (LSAME(SIDE,'L')) THEN
 233           NROWA = M
 234       ELSE
 235           NROWA = N
 236       END IF
 237       UPPER = LSAME(UPLO,'U')
 238 *
 239 *     Test the input parameters.
 240 *
 241       INFO = 0
 242       IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
 243           INFO = 1
 244       ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
 245           INFO = 2
 246       ELSE IF (M.LT.0) THEN
 247           INFO = 3
 248       ELSE IF (N.LT.0) THEN
 249           INFO = 4
 250       ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
 251           INFO = 7
 252       ELSE IF (LDB.LT.MAX(1,M)) THEN
 253           INFO = 9
 254       ELSE IF (LDC.LT.MAX(1,M)) THEN
 255           INFO = 12
 256       END IF
 257       IF (INFO.NE.0) THEN
 258           CALL XERBLA('CSYMM ',INFO)
 259           RETURN
 260       END IF
 261 *
 262 *     Quick return if possible.
 263 *
 264       IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
 265      +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
 266 *
 267 *     And when  alpha.eq.zero.
 268 *
 269       IF (ALPHA.EQ.ZERO) THEN
 270           IF (BETA.EQ.ZERO) THEN
 271               DO 20 J = 1,N
 272                   DO 10 I = 1,M
 273                       C(I,J) = ZERO
 274    10             CONTINUE
 275    20         CONTINUE
 276           ELSE
 277               DO 40 J = 1,N
 278                   DO 30 I = 1,M
 279                       C(I,J) = BETA*C(I,J)
 280    30             CONTINUE
 281    40         CONTINUE
 282           END IF
 283           RETURN
 284       END IF
 285 *
 286 *     Start the operations.
 287 *
 288       IF (LSAME(SIDE,'L')) THEN
 289 *
 290 *        Form  C := alpha*A*B + beta*C.
 291 *
 292           IF (UPPER) THEN
 293               DO 70 J = 1,N
 294                   DO 60 I = 1,M
 295                       TEMP1 = ALPHA*B(I,J)
 296                       TEMP2 = ZERO
 297                       DO 50 K = 1,I - 1
 298                           C(K,J) = C(K,J) + TEMP1*A(K,I)
 299                           TEMP2 = TEMP2 + B(K,J)*A(K,I)
 300    50                 CONTINUE
 301                       IF (BETA.EQ.ZERO) THEN
 302                           C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
 303                       ELSE
 304                           C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
 305      +                             ALPHA*TEMP2
 306                       END IF
 307    60             CONTINUE
 308    70         CONTINUE
 309           ELSE
 310               DO 100 J = 1,N
 311                   DO 90 I = M,1,-1
 312                       TEMP1 = ALPHA*B(I,J)
 313                       TEMP2 = ZERO
 314                       DO 80 K = I + 1,M
 315                           C(K,J) = C(K,J) + TEMP1*A(K,I)
 316                           TEMP2 = TEMP2 + B(K,J)*A(K,I)
 317    80                 CONTINUE
 318                       IF (BETA.EQ.ZERO) THEN
 319                           C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
 320                       ELSE
 321                           C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
 322      +                             ALPHA*TEMP2
 323                       END IF
 324    90             CONTINUE
 325   100         CONTINUE
 326           END IF
 327       ELSE
 328 *
 329 *        Form  C := alpha*B*A + beta*C.
 330 *
 331           DO 170 J = 1,N
 332               TEMP1 = ALPHA*A(J,J)
 333               IF (BETA.EQ.ZERO) THEN
 334                   DO 110 I = 1,M
 335                       C(I,J) = TEMP1*B(I,J)
 336   110             CONTINUE
 337               ELSE
 338                   DO 120 I = 1,M
 339                       C(I,J) = BETA*C(I,J) + TEMP1*B(I,J)
 340   120             CONTINUE
 341               END IF
 342               DO 140 K = 1,J - 1
 343                   IF (UPPER) THEN
 344                       TEMP1 = ALPHA*A(K,J)
 345                   ELSE
 346                       TEMP1 = ALPHA*A(J,K)
 347                   END IF
 348                   DO 130 I = 1,M
 349                       C(I,J) = C(I,J) + TEMP1*B(I,K)
 350   130             CONTINUE
 351   140         CONTINUE
 352               DO 160 K = J + 1,N
 353                   IF (UPPER) THEN
 354                       TEMP1 = ALPHA*A(J,K)
 355                   ELSE
 356                       TEMP1 = ALPHA*A(K,J)
 357                   END IF
 358                   DO 150 I = 1,M
 359                       C(I,J) = C(I,J) + TEMP1*B(I,K)
 360   150             CONTINUE
 361   160         CONTINUE
 362   170     CONTINUE
 363       END IF
 364 *
 365       RETURN
 366 *
 367 *     End of CSYMM .
 368 *
 369       END