LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
ssymm.f
Go to the documentation of this file.
00001 *> \brief \b SSYMM
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 SSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       REAL ALPHA,BETA
00015 *       INTEGER LDA,LDB,LDC,M,N
00016 *       CHARACTER SIDE,UPLO
00017 *       ..
00018 *       .. Array Arguments ..
00019 *       REAL A(LDA,*),B(LDB,*),C(LDC,*)
00020 *       ..
00021 *  
00022 *
00023 *> \par Purpose:
00024 *  =============
00025 *>
00026 *> \verbatim
00027 *>
00028 *> SSYMM  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 REAL
00085 *>           On entry, ALPHA specifies the scalar alpha.
00086 *> \endverbatim
00087 *>
00088 *> \param[in] A
00089 *> \verbatim
00090 *>          A is REAL 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 REAL 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 REAL
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 REAL 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 single_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 SSYMM(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       REAL ALPHA,BETA
00199       INTEGER LDA,LDB,LDC,M,N
00200       CHARACTER SIDE,UPLO
00201 *     ..
00202 *     .. Array Arguments ..
00203       REAL 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       REAL TEMP1,TEMP2
00220       INTEGER I,INFO,J,K,NROWA
00221       LOGICAL UPPER
00222 *     ..
00223 *     .. Parameters ..
00224       REAL ONE,ZERO
00225       PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
00226 *     ..
00227 *
00228 *     Set NROWA as the number of rows of A.
00229 *
00230       IF (LSAME(SIDE,'L')) THEN
00231           NROWA = M
00232       ELSE
00233           NROWA = N
00234       END IF
00235       UPPER = LSAME(UPLO,'U')
00236 *
00237 *     Test the input parameters.
00238 *
00239       INFO = 0
00240       IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
00241           INFO = 1
00242       ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
00243           INFO = 2
00244       ELSE IF (M.LT.0) THEN
00245           INFO = 3
00246       ELSE IF (N.LT.0) THEN
00247           INFO = 4
00248       ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
00249           INFO = 7
00250       ELSE IF (LDB.LT.MAX(1,M)) THEN
00251           INFO = 9
00252       ELSE IF (LDC.LT.MAX(1,M)) THEN
00253           INFO = 12
00254       END IF
00255       IF (INFO.NE.0) THEN
00256           CALL XERBLA('SSYMM ',INFO)
00257           RETURN
00258       END IF
00259 *
00260 *     Quick return if possible.
00261 *
00262       IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
00263      +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
00264 *
00265 *     And when  alpha.eq.zero.
00266 *
00267       IF (ALPHA.EQ.ZERO) THEN
00268           IF (BETA.EQ.ZERO) THEN
00269               DO 20 J = 1,N
00270                   DO 10 I = 1,M
00271                       C(I,J) = ZERO
00272    10             CONTINUE
00273    20         CONTINUE
00274           ELSE
00275               DO 40 J = 1,N
00276                   DO 30 I = 1,M
00277                       C(I,J) = BETA*C(I,J)
00278    30             CONTINUE
00279    40         CONTINUE
00280           END IF
00281           RETURN
00282       END IF
00283 *
00284 *     Start the operations.
00285 *
00286       IF (LSAME(SIDE,'L')) THEN
00287 *
00288 *        Form  C := alpha*A*B + beta*C.
00289 *
00290           IF (UPPER) THEN
00291               DO 70 J = 1,N
00292                   DO 60 I = 1,M
00293                       TEMP1 = ALPHA*B(I,J)
00294                       TEMP2 = ZERO
00295                       DO 50 K = 1,I - 1
00296                           C(K,J) = C(K,J) + TEMP1*A(K,I)
00297                           TEMP2 = TEMP2 + B(K,J)*A(K,I)
00298    50                 CONTINUE
00299                       IF (BETA.EQ.ZERO) THEN
00300                           C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
00301                       ELSE
00302                           C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
00303      +                             ALPHA*TEMP2
00304                       END IF
00305    60             CONTINUE
00306    70         CONTINUE
00307           ELSE
00308               DO 100 J = 1,N
00309                   DO 90 I = M,1,-1
00310                       TEMP1 = ALPHA*B(I,J)
00311                       TEMP2 = ZERO
00312                       DO 80 K = I + 1,M
00313                           C(K,J) = C(K,J) + TEMP1*A(K,I)
00314                           TEMP2 = TEMP2 + B(K,J)*A(K,I)
00315    80                 CONTINUE
00316                       IF (BETA.EQ.ZERO) THEN
00317                           C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
00318                       ELSE
00319                           C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
00320      +                             ALPHA*TEMP2
00321                       END IF
00322    90             CONTINUE
00323   100         CONTINUE
00324           END IF
00325       ELSE
00326 *
00327 *        Form  C := alpha*B*A + beta*C.
00328 *
00329           DO 170 J = 1,N
00330               TEMP1 = ALPHA*A(J,J)
00331               IF (BETA.EQ.ZERO) THEN
00332                   DO 110 I = 1,M
00333                       C(I,J) = TEMP1*B(I,J)
00334   110             CONTINUE
00335               ELSE
00336                   DO 120 I = 1,M
00337                       C(I,J) = BETA*C(I,J) + TEMP1*B(I,J)
00338   120             CONTINUE
00339               END IF
00340               DO 140 K = 1,J - 1
00341                   IF (UPPER) THEN
00342                       TEMP1 = ALPHA*A(K,J)
00343                   ELSE
00344                       TEMP1 = ALPHA*A(J,K)
00345                   END IF
00346                   DO 130 I = 1,M
00347                       C(I,J) = C(I,J) + TEMP1*B(I,K)
00348   130             CONTINUE
00349   140         CONTINUE
00350               DO 160 K = J + 1,N
00351                   IF (UPPER) THEN
00352                       TEMP1 = ALPHA*A(J,K)
00353                   ELSE
00354                       TEMP1 = ALPHA*A(K,J)
00355                   END IF
00356                   DO 150 I = 1,M
00357                       C(I,J) = C(I,J) + TEMP1*B(I,K)
00358   150             CONTINUE
00359   160         CONTINUE
00360   170     CONTINUE
00361       END IF
00362 *
00363       RETURN
00364 *
00365 *     End of SSYMM .
00366 *
00367       END
 All Files Functions