LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
ztrmm.f
Go to the documentation of this file.
00001 *> \brief \b ZTRMM
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 ZTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       COMPLEX*16 ALPHA
00015 *       INTEGER LDA,LDB,M,N
00016 *       CHARACTER DIAG,SIDE,TRANSA,UPLO
00017 *       ..
00018 *       .. Array Arguments ..
00019 *       COMPLEX*16 A(LDA,*),B(LDB,*)
00020 *       ..
00021 *  
00022 *
00023 *> \par Purpose:
00024 *  =============
00025 *>
00026 *> \verbatim
00027 *>
00028 *> ZTRMM  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   or   op( A ) = A**H.
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**H.
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 COMPLEX*16
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 COMPLEX*16 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] B
00136 *> \verbatim
00137 *>          B is (input/output) COMPLEX*16 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 complex16_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 ZTRMM(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       COMPLEX*16 ALPHA
00187       INTEGER LDA,LDB,M,N
00188       CHARACTER DIAG,SIDE,TRANSA,UPLO
00189 *     ..
00190 *     .. Array Arguments ..
00191       COMPLEX*16 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 DCONJG,MAX
00205 *     ..
00206 *     .. Local Scalars ..
00207       COMPLEX*16 TEMP
00208       INTEGER I,INFO,J,K,NROWA
00209       LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER
00210 *     ..
00211 *     .. Parameters ..
00212       COMPLEX*16 ONE
00213       PARAMETER (ONE= (1.0D+0,0.0D+0))
00214       COMPLEX*16 ZERO
00215       PARAMETER (ZERO= (0.0D+0,0.0D+0))
00216 *     ..
00217 *
00218 *     Test the input parameters.
00219 *
00220       LSIDE = LSAME(SIDE,'L')
00221       IF (LSIDE) THEN
00222           NROWA = M
00223       ELSE
00224           NROWA = N
00225       END IF
00226       NOCONJ = LSAME(TRANSA,'T')
00227       NOUNIT = LSAME(DIAG,'N')
00228       UPPER = LSAME(UPLO,'U')
00229 *
00230       INFO = 0
00231       IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
00232           INFO = 1
00233       ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
00234           INFO = 2
00235       ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
00236      +         (.NOT.LSAME(TRANSA,'T')) .AND.
00237      +         (.NOT.LSAME(TRANSA,'C'))) THEN
00238           INFO = 3
00239       ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
00240           INFO = 4
00241       ELSE IF (M.LT.0) THEN
00242           INFO = 5
00243       ELSE IF (N.LT.0) THEN
00244           INFO = 6
00245       ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
00246           INFO = 9
00247       ELSE IF (LDB.LT.MAX(1,M)) THEN
00248           INFO = 11
00249       END IF
00250       IF (INFO.NE.0) THEN
00251           CALL XERBLA('ZTRMM ',INFO)
00252           RETURN
00253       END IF
00254 *
00255 *     Quick return if possible.
00256 *
00257       IF (M.EQ.0 .OR. N.EQ.0) RETURN
00258 *
00259 *     And when  alpha.eq.zero.
00260 *
00261       IF (ALPHA.EQ.ZERO) THEN
00262           DO 20 J = 1,N
00263               DO 10 I = 1,M
00264                   B(I,J) = ZERO
00265    10         CONTINUE
00266    20     CONTINUE
00267           RETURN
00268       END IF
00269 *
00270 *     Start the operations.
00271 *
00272       IF (LSIDE) THEN
00273           IF (LSAME(TRANSA,'N')) THEN
00274 *
00275 *           Form  B := alpha*A*B.
00276 *
00277               IF (UPPER) THEN
00278                   DO 50 J = 1,N
00279                       DO 40 K = 1,M
00280                           IF (B(K,J).NE.ZERO) THEN
00281                               TEMP = ALPHA*B(K,J)
00282                               DO 30 I = 1,K - 1
00283                                   B(I,J) = B(I,J) + TEMP*A(I,K)
00284    30                         CONTINUE
00285                               IF (NOUNIT) TEMP = TEMP*A(K,K)
00286                               B(K,J) = TEMP
00287                           END IF
00288    40                 CONTINUE
00289    50             CONTINUE
00290               ELSE
00291                   DO 80 J = 1,N
00292                       DO 70 K = M,1,-1
00293                           IF (B(K,J).NE.ZERO) THEN
00294                               TEMP = ALPHA*B(K,J)
00295                               B(K,J) = TEMP
00296                               IF (NOUNIT) B(K,J) = B(K,J)*A(K,K)
00297                               DO 60 I = K + 1,M
00298                                   B(I,J) = B(I,J) + TEMP*A(I,K)
00299    60                         CONTINUE
00300                           END IF
00301    70                 CONTINUE
00302    80             CONTINUE
00303               END IF
00304           ELSE
00305 *
00306 *           Form  B := alpha*A**T*B   or   B := alpha*A**H*B.
00307 *
00308               IF (UPPER) THEN
00309                   DO 120 J = 1,N
00310                       DO 110 I = M,1,-1
00311                           TEMP = B(I,J)
00312                           IF (NOCONJ) THEN
00313                               IF (NOUNIT) TEMP = TEMP*A(I,I)
00314                               DO 90 K = 1,I - 1
00315                                   TEMP = TEMP + A(K,I)*B(K,J)
00316    90                         CONTINUE
00317                           ELSE
00318                               IF (NOUNIT) TEMP = TEMP*DCONJG(A(I,I))
00319                               DO 100 K = 1,I - 1
00320                                   TEMP = TEMP + DCONJG(A(K,I))*B(K,J)
00321   100                         CONTINUE
00322                           END IF
00323                           B(I,J) = ALPHA*TEMP
00324   110                 CONTINUE
00325   120             CONTINUE
00326               ELSE
00327                   DO 160 J = 1,N
00328                       DO 150 I = 1,M
00329                           TEMP = B(I,J)
00330                           IF (NOCONJ) THEN
00331                               IF (NOUNIT) TEMP = TEMP*A(I,I)
00332                               DO 130 K = I + 1,M
00333                                   TEMP = TEMP + A(K,I)*B(K,J)
00334   130                         CONTINUE
00335                           ELSE
00336                               IF (NOUNIT) TEMP = TEMP*DCONJG(A(I,I))
00337                               DO 140 K = I + 1,M
00338                                   TEMP = TEMP + DCONJG(A(K,I))*B(K,J)
00339   140                         CONTINUE
00340                           END IF
00341                           B(I,J) = ALPHA*TEMP
00342   150                 CONTINUE
00343   160             CONTINUE
00344               END IF
00345           END IF
00346       ELSE
00347           IF (LSAME(TRANSA,'N')) THEN
00348 *
00349 *           Form  B := alpha*B*A.
00350 *
00351               IF (UPPER) THEN
00352                   DO 200 J = N,1,-1
00353                       TEMP = ALPHA
00354                       IF (NOUNIT) TEMP = TEMP*A(J,J)
00355                       DO 170 I = 1,M
00356                           B(I,J) = TEMP*B(I,J)
00357   170                 CONTINUE
00358                       DO 190 K = 1,J - 1
00359                           IF (A(K,J).NE.ZERO) THEN
00360                               TEMP = ALPHA*A(K,J)
00361                               DO 180 I = 1,M
00362                                   B(I,J) = B(I,J) + TEMP*B(I,K)
00363   180                         CONTINUE
00364                           END IF
00365   190                 CONTINUE
00366   200             CONTINUE
00367               ELSE
00368                   DO 240 J = 1,N
00369                       TEMP = ALPHA
00370                       IF (NOUNIT) TEMP = TEMP*A(J,J)
00371                       DO 210 I = 1,M
00372                           B(I,J) = TEMP*B(I,J)
00373   210                 CONTINUE
00374                       DO 230 K = J + 1,N
00375                           IF (A(K,J).NE.ZERO) THEN
00376                               TEMP = ALPHA*A(K,J)
00377                               DO 220 I = 1,M
00378                                   B(I,J) = B(I,J) + TEMP*B(I,K)
00379   220                         CONTINUE
00380                           END IF
00381   230                 CONTINUE
00382   240             CONTINUE
00383               END IF
00384           ELSE
00385 *
00386 *           Form  B := alpha*B*A**T   or   B := alpha*B*A**H.
00387 *
00388               IF (UPPER) THEN
00389                   DO 280 K = 1,N
00390                       DO 260 J = 1,K - 1
00391                           IF (A(J,K).NE.ZERO) THEN
00392                               IF (NOCONJ) THEN
00393                                   TEMP = ALPHA*A(J,K)
00394                               ELSE
00395                                   TEMP = ALPHA*DCONJG(A(J,K))
00396                               END IF
00397                               DO 250 I = 1,M
00398                                   B(I,J) = B(I,J) + TEMP*B(I,K)
00399   250                         CONTINUE
00400                           END IF
00401   260                 CONTINUE
00402                       TEMP = ALPHA
00403                       IF (NOUNIT) THEN
00404                           IF (NOCONJ) THEN
00405                               TEMP = TEMP*A(K,K)
00406                           ELSE
00407                               TEMP = TEMP*DCONJG(A(K,K))
00408                           END IF
00409                       END IF
00410                       IF (TEMP.NE.ONE) THEN
00411                           DO 270 I = 1,M
00412                               B(I,K) = TEMP*B(I,K)
00413   270                     CONTINUE
00414                       END IF
00415   280             CONTINUE
00416               ELSE
00417                   DO 320 K = N,1,-1
00418                       DO 300 J = K + 1,N
00419                           IF (A(J,K).NE.ZERO) THEN
00420                               IF (NOCONJ) THEN
00421                                   TEMP = ALPHA*A(J,K)
00422                               ELSE
00423                                   TEMP = ALPHA*DCONJG(A(J,K))
00424                               END IF
00425                               DO 290 I = 1,M
00426                                   B(I,J) = B(I,J) + TEMP*B(I,K)
00427   290                         CONTINUE
00428                           END IF
00429   300                 CONTINUE
00430                       TEMP = ALPHA
00431                       IF (NOUNIT) THEN
00432                           IF (NOCONJ) THEN
00433                               TEMP = TEMP*A(K,K)
00434                           ELSE
00435                               TEMP = TEMP*DCONJG(A(K,K))
00436                           END IF
00437                       END IF
00438                       IF (TEMP.NE.ONE) THEN
00439                           DO 310 I = 1,M
00440                               B(I,K) = TEMP*B(I,K)
00441   310                     CONTINUE
00442                       END IF
00443   320             CONTINUE
00444               END IF
00445           END IF
00446       END IF
00447 *
00448       RETURN
00449 *
00450 *     End of ZTRMM .
00451 *
00452       END
 All Files Functions