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