LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
strmm.f
Go to the documentation of this file.
00001 *> \brief \b STRMM
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 STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       REAL ALPHA
00015 *       INTEGER LDA,LDB,M,N
00016 *       CHARACTER DIAG,SIDE,TRANSA,UPLO
00017 *       ..
00018 *       .. Array Arguments ..
00019 *       REAL A(LDA,*),B(LDB,*)
00020 *       ..
00021 *  
00022 *
00023 *> \par Purpose:
00024 *  =============
00025 *>
00026 *> \verbatim
00027 *>
00028 *> STRMM  performs one of the matrix-matrix operations
00029 *>
00030 *>    B := alpha*op( A )*B,   or   B := alpha*B*op( A ),
00031 *>
00032 *> where  alpha  is a scalar,  B  is an m by n matrix,  A  is a unit, or
00033 *> non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
00034 *>
00035 *>    op( A ) = A   or   op( A ) = A**T.
00036 *> \endverbatim
00037 *
00038 *  Arguments:
00039 *  ==========
00040 *
00041 *> \param[in] SIDE
00042 *> \verbatim
00043 *>          SIDE is CHARACTER*1
00044 *>           On entry,  SIDE specifies whether  op( A ) multiplies B from
00045 *>           the left or right as follows:
00046 *>
00047 *>              SIDE = 'L' or 'l'   B := alpha*op( A )*B.
00048 *>
00049 *>              SIDE = 'R' or 'r'   B := alpha*B*op( A ).
00050 *> \endverbatim
00051 *>
00052 *> \param[in] UPLO
00053 *> \verbatim
00054 *>          UPLO is CHARACTER*1
00055 *>           On entry, UPLO specifies whether the matrix A is an upper or
00056 *>           lower triangular matrix as follows:
00057 *>
00058 *>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
00059 *>
00060 *>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
00061 *> \endverbatim
00062 *>
00063 *> \param[in] TRANSA
00064 *> \verbatim
00065 *>          TRANSA is CHARACTER*1
00066 *>           On entry, TRANSA specifies the form of op( A ) to be used in
00067 *>           the matrix multiplication as follows:
00068 *>
00069 *>              TRANSA = 'N' or 'n'   op( A ) = A.
00070 *>
00071 *>              TRANSA = 'T' or 't'   op( A ) = A**T.
00072 *>
00073 *>              TRANSA = 'C' or 'c'   op( A ) = A**T.
00074 *> \endverbatim
00075 *>
00076 *> \param[in] DIAG
00077 *> \verbatim
00078 *>          DIAG is CHARACTER*1
00079 *>           On entry, DIAG specifies whether or not A is unit triangular
00080 *>           as follows:
00081 *>
00082 *>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
00083 *>
00084 *>              DIAG = 'N' or 'n'   A is not assumed to be unit
00085 *>                                  triangular.
00086 *> \endverbatim
00087 *>
00088 *> \param[in] M
00089 *> \verbatim
00090 *>          M is INTEGER
00091 *>           On entry, M specifies the number of rows of B. M must be at
00092 *>           least zero.
00093 *> \endverbatim
00094 *>
00095 *> \param[in] N
00096 *> \verbatim
00097 *>          N is INTEGER
00098 *>           On entry, N specifies the number of columns of B.  N must be
00099 *>           at least zero.
00100 *> \endverbatim
00101 *>
00102 *> \param[in] ALPHA
00103 *> \verbatim
00104 *>          ALPHA is REAL
00105 *>           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
00106 *>           zero then  A is not referenced and  B need not be set before
00107 *>           entry.
00108 *> \endverbatim
00109 *>
00110 *> \param[in] A
00111 *> \verbatim
00112 *>          A is REAL array of DIMENSION ( LDA, k ), where k is m
00113 *>           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
00114 *>           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
00115 *>           upper triangular part of the array  A must contain the upper
00116 *>           triangular matrix  and the strictly lower triangular part of
00117 *>           A is not referenced.
00118 *>           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
00119 *>           lower triangular part of the array  A must contain the lower
00120 *>           triangular matrix  and the strictly upper triangular part of
00121 *>           A is not referenced.
00122 *>           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
00123 *>           A  are not referenced either,  but are assumed to be  unity.
00124 *> \endverbatim
00125 *>
00126 *> \param[in] LDA
00127 *> \verbatim
00128 *>          LDA is INTEGER
00129 *>           On entry, LDA specifies the first dimension of A as declared
00130 *>           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
00131 *>           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
00132 *>           then LDA must be at least max( 1, n ).
00133 *> \endverbatim
00134 *>
00135 *> \param[in,out] B
00136 *> \verbatim
00137 *>          B is REAL array of DIMENSION ( LDB, n ).
00138 *>           Before entry,  the leading  m by n part of the array  B must
00139 *>           contain the matrix  B,  and  on exit  is overwritten  by the
00140 *>           transformed matrix.
00141 *> \endverbatim
00142 *>
00143 *> \param[in] LDB
00144 *> \verbatim
00145 *>          LDB is INTEGER
00146 *>           On entry, LDB specifies the first dimension of B as declared
00147 *>           in  the  calling  (sub)  program.   LDB  must  be  at  least
00148 *>           max( 1, m ).
00149 *> \endverbatim
00150 *
00151 *  Authors:
00152 *  ========
00153 *
00154 *> \author Univ. of Tennessee 
00155 *> \author Univ. of California Berkeley 
00156 *> \author Univ. of Colorado Denver 
00157 *> \author NAG Ltd. 
00158 *
00159 *> \date November 2011
00160 *
00161 *> \ingroup single_blas_level3
00162 *
00163 *> \par Further Details:
00164 *  =====================
00165 *>
00166 *> \verbatim
00167 *>
00168 *>  Level 3 Blas routine.
00169 *>
00170 *>  -- Written on 8-February-1989.
00171 *>     Jack Dongarra, Argonne National Laboratory.
00172 *>     Iain Duff, AERE Harwell.
00173 *>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
00174 *>     Sven Hammarling, Numerical Algorithms Group Ltd.
00175 *> \endverbatim
00176 *>
00177 *  =====================================================================
00178       SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
00179 *
00180 *  -- Reference BLAS level3 routine (version 3.4.0) --
00181 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
00182 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00183 *     November 2011
00184 *
00185 *     .. Scalar Arguments ..
00186       REAL ALPHA
00187       INTEGER LDA,LDB,M,N
00188       CHARACTER DIAG,SIDE,TRANSA,UPLO
00189 *     ..
00190 *     .. Array Arguments ..
00191       REAL A(LDA,*),B(LDB,*)
00192 *     ..
00193 *
00194 *  =====================================================================
00195 *
00196 *     .. External Functions ..
00197       LOGICAL LSAME
00198       EXTERNAL LSAME
00199 *     ..
00200 *     .. External Subroutines ..
00201       EXTERNAL XERBLA
00202 *     ..
00203 *     .. Intrinsic Functions ..
00204       INTRINSIC MAX
00205 *     ..
00206 *     .. Local Scalars ..
00207       REAL TEMP
00208       INTEGER I,INFO,J,K,NROWA
00209       LOGICAL LSIDE,NOUNIT,UPPER
00210 *     ..
00211 *     .. Parameters ..
00212       REAL ONE,ZERO
00213       PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
00214 *     ..
00215 *
00216 *     Test the input parameters.
00217 *
00218       LSIDE = LSAME(SIDE,'L')
00219       IF (LSIDE) THEN
00220           NROWA = M
00221       ELSE
00222           NROWA = N
00223       END IF
00224       NOUNIT = LSAME(DIAG,'N')
00225       UPPER = LSAME(UPLO,'U')
00226 *
00227       INFO = 0
00228       IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
00229           INFO = 1
00230       ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
00231           INFO = 2
00232       ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
00233      +         (.NOT.LSAME(TRANSA,'T')) .AND.
00234      +         (.NOT.LSAME(TRANSA,'C'))) THEN
00235           INFO = 3
00236       ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
00237           INFO = 4
00238       ELSE IF (M.LT.0) THEN
00239           INFO = 5
00240       ELSE IF (N.LT.0) THEN
00241           INFO = 6
00242       ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
00243           INFO = 9
00244       ELSE IF (LDB.LT.MAX(1,M)) THEN
00245           INFO = 11
00246       END IF
00247       IF (INFO.NE.0) THEN
00248           CALL XERBLA('STRMM ',INFO)
00249           RETURN
00250       END IF
00251 *
00252 *     Quick return if possible.
00253 *
00254       IF (M.EQ.0 .OR. N.EQ.0) RETURN
00255 *
00256 *     And when  alpha.eq.zero.
00257 *
00258       IF (ALPHA.EQ.ZERO) THEN
00259           DO 20 J = 1,N
00260               DO 10 I = 1,M
00261                   B(I,J) = ZERO
00262    10         CONTINUE
00263    20     CONTINUE
00264           RETURN
00265       END IF
00266 *
00267 *     Start the operations.
00268 *
00269       IF (LSIDE) THEN
00270           IF (LSAME(TRANSA,'N')) THEN
00271 *
00272 *           Form  B := alpha*A*B.
00273 *
00274               IF (UPPER) THEN
00275                   DO 50 J = 1,N
00276                       DO 40 K = 1,M
00277                           IF (B(K,J).NE.ZERO) THEN
00278                               TEMP = ALPHA*B(K,J)
00279                               DO 30 I = 1,K - 1
00280                                   B(I,J) = B(I,J) + TEMP*A(I,K)
00281    30                         CONTINUE
00282                               IF (NOUNIT) TEMP = TEMP*A(K,K)
00283                               B(K,J) = TEMP
00284                           END IF
00285    40                 CONTINUE
00286    50             CONTINUE
00287               ELSE
00288                   DO 80 J = 1,N
00289                       DO 70 K = M,1,-1
00290                           IF (B(K,J).NE.ZERO) THEN
00291                               TEMP = ALPHA*B(K,J)
00292                               B(K,J) = TEMP
00293                               IF (NOUNIT) B(K,J) = B(K,J)*A(K,K)
00294                               DO 60 I = K + 1,M
00295                                   B(I,J) = B(I,J) + TEMP*A(I,K)
00296    60                         CONTINUE
00297                           END IF
00298    70                 CONTINUE
00299    80             CONTINUE
00300               END IF
00301           ELSE
00302 *
00303 *           Form  B := alpha*A**T*B.
00304 *
00305               IF (UPPER) THEN
00306                   DO 110 J = 1,N
00307                       DO 100 I = M,1,-1
00308                           TEMP = B(I,J)
00309                           IF (NOUNIT) TEMP = TEMP*A(I,I)
00310                           DO 90 K = 1,I - 1
00311                               TEMP = TEMP + A(K,I)*B(K,J)
00312    90                     CONTINUE
00313                           B(I,J) = ALPHA*TEMP
00314   100                 CONTINUE
00315   110             CONTINUE
00316               ELSE
00317                   DO 140 J = 1,N
00318                       DO 130 I = 1,M
00319                           TEMP = B(I,J)
00320                           IF (NOUNIT) TEMP = TEMP*A(I,I)
00321                           DO 120 K = I + 1,M
00322                               TEMP = TEMP + A(K,I)*B(K,J)
00323   120                     CONTINUE
00324                           B(I,J) = ALPHA*TEMP
00325   130                 CONTINUE
00326   140             CONTINUE
00327               END IF
00328           END IF
00329       ELSE
00330           IF (LSAME(TRANSA,'N')) THEN
00331 *
00332 *           Form  B := alpha*B*A.
00333 *
00334               IF (UPPER) THEN
00335                   DO 180 J = N,1,-1
00336                       TEMP = ALPHA
00337                       IF (NOUNIT) TEMP = TEMP*A(J,J)
00338                       DO 150 I = 1,M
00339                           B(I,J) = TEMP*B(I,J)
00340   150                 CONTINUE
00341                       DO 170 K = 1,J - 1
00342                           IF (A(K,J).NE.ZERO) THEN
00343                               TEMP = ALPHA*A(K,J)
00344                               DO 160 I = 1,M
00345                                   B(I,J) = B(I,J) + TEMP*B(I,K)
00346   160                         CONTINUE
00347                           END IF
00348   170                 CONTINUE
00349   180             CONTINUE
00350               ELSE
00351                   DO 220 J = 1,N
00352                       TEMP = ALPHA
00353                       IF (NOUNIT) TEMP = TEMP*A(J,J)
00354                       DO 190 I = 1,M
00355                           B(I,J) = TEMP*B(I,J)
00356   190                 CONTINUE
00357                       DO 210 K = J + 1,N
00358                           IF (A(K,J).NE.ZERO) THEN
00359                               TEMP = ALPHA*A(K,J)
00360                               DO 200 I = 1,M
00361                                   B(I,J) = B(I,J) + TEMP*B(I,K)
00362   200                         CONTINUE
00363                           END IF
00364   210                 CONTINUE
00365   220             CONTINUE
00366               END IF
00367           ELSE
00368 *
00369 *           Form  B := alpha*B*A**T.
00370 *
00371               IF (UPPER) THEN
00372                   DO 260 K = 1,N
00373                       DO 240 J = 1,K - 1
00374                           IF (A(J,K).NE.ZERO) THEN
00375                               TEMP = ALPHA*A(J,K)
00376                               DO 230 I = 1,M
00377                                   B(I,J) = B(I,J) + TEMP*B(I,K)
00378   230                         CONTINUE
00379                           END IF
00380   240                 CONTINUE
00381                       TEMP = ALPHA
00382                       IF (NOUNIT) TEMP = TEMP*A(K,K)
00383                       IF (TEMP.NE.ONE) THEN
00384                           DO 250 I = 1,M
00385                               B(I,K) = TEMP*B(I,K)
00386   250                     CONTINUE
00387                       END IF
00388   260             CONTINUE
00389               ELSE
00390                   DO 300 K = N,1,-1
00391                       DO 280 J = K + 1,N
00392                           IF (A(J,K).NE.ZERO) THEN
00393                               TEMP = ALPHA*A(J,K)
00394                               DO 270 I = 1,M
00395                                   B(I,J) = B(I,J) + TEMP*B(I,K)
00396   270                         CONTINUE
00397                           END IF
00398   280                 CONTINUE
00399                       TEMP = ALPHA
00400                       IF (NOUNIT) TEMP = TEMP*A(K,K)
00401                       IF (TEMP.NE.ONE) THEN
00402                           DO 290 I = 1,M
00403                               B(I,K) = TEMP*B(I,K)
00404   290                     CONTINUE
00405                       END IF
00406   300             CONTINUE
00407               END IF
00408           END IF
00409       END IF
00410 *
00411       RETURN
00412 *
00413 *     End of STRMM .
00414 *
00415       END
 All Files Functions