LAPACK 3.3.1
Linear Algebra PACKage

ztfsm.f

Go to the documentation of this file.
00001       SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A,
00002      $                  B, LDB )
00003 *
00004 *  -- LAPACK routine (version 3.3.1)                                    --
00005 *
00006 *  -- Contributed by Fred Gustavson of the IBM Watson Research Center --
00007 *  -- April 2011                                                      --
00008 *
00009 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00010 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00011 *
00012 *     ..
00013 *     .. Scalar Arguments ..
00014       CHARACTER          TRANSR, DIAG, SIDE, TRANS, UPLO
00015       INTEGER            LDB, M, N
00016       COMPLEX*16         ALPHA
00017 *     ..
00018 *     .. Array Arguments ..
00019       COMPLEX*16         A( 0: * ), B( 0: LDB-1, 0: * )
00020 *     ..
00021 *
00022 *  Purpose
00023 *  =======
00024 *
00025 *  Level 3 BLAS like routine for A in RFP Format.
00026 *
00027 *  ZTFSM  solves the matrix equation
00028 *
00029 *     op( A )*X = alpha*B  or  X*op( A ) = alpha*B
00030 *
00031 *  where alpha is a scalar, X and B are m by n matrices, A is a unit, or
00032 *  non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
00033 *
00034 *     op( A ) = A   or   op( A ) = A**H.
00035 *
00036 *  A is in Rectangular Full Packed (RFP) Format.
00037 *
00038 *  The matrix X is overwritten on B.
00039 *
00040 *  Arguments
00041 *  ==========
00042 *
00043 *  TRANSR  (input) CHARACTER*1
00044 *          = 'N':  The Normal Form of RFP A is stored;
00045 *          = 'C':  The Conjugate-transpose Form of RFP A is stored.
00046 *
00047 *  SIDE    (input) CHARACTER*1
00048 *           On entry, SIDE specifies whether op( A ) appears on the left
00049 *           or right of X as follows:
00050 *
00051 *              SIDE = 'L' or 'l'   op( A )*X = alpha*B.
00052 *
00053 *              SIDE = 'R' or 'r'   X*op( A ) = alpha*B.
00054 *
00055 *           Unchanged on exit.
00056 *
00057 *  UPLO    (input) CHARACTER*1
00058 *           On entry, UPLO specifies whether the RFP matrix A came from
00059 *           an upper or lower triangular matrix as follows:
00060 *           UPLO = 'U' or 'u' RFP A came from an upper triangular matrix
00061 *           UPLO = 'L' or 'l' RFP A came from a  lower triangular matrix
00062 *
00063 *           Unchanged on exit.
00064 *
00065 *  TRANS   (input) CHARACTER*1
00066 *           On entry, TRANS  specifies the form of op( A ) to be used
00067 *           in the matrix multiplication as follows:
00068 *
00069 *              TRANS  = 'N' or 'n'   op( A ) = A.
00070 *
00071 *              TRANS  = 'C' or 'c'   op( A ) = conjg( A' ).
00072 *
00073 *           Unchanged on exit.
00074 *
00075 *  DIAG    (input) CHARACTER*1
00076 *           On entry, DIAG specifies whether or not RFP A is unit
00077 *           triangular as follows:
00078 *
00079 *              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
00080 *
00081 *              DIAG = 'N' or 'n'   A is not assumed to be unit
00082 *                                  triangular.
00083 *
00084 *           Unchanged on exit.
00085 *
00086 *  M       (input) INTEGER
00087 *           On entry, M specifies the number of rows of B. M must be at
00088 *           least zero.
00089 *           Unchanged on exit.
00090 *
00091 *  N       (input) INTEGER
00092 *           On entry, N specifies the number of columns of B.  N must be
00093 *           at least zero.
00094 *           Unchanged on exit.
00095 *
00096 *  ALPHA   (input) COMPLEX*16
00097 *           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
00098 *           zero then  A is not referenced and  B need not be set before
00099 *           entry.
00100 *           Unchanged on exit.
00101 *
00102 *  A       (input) COMPLEX*16 array, dimension (N*(N+1)/2)
00103 *           NT = N*(N+1)/2. On entry, the matrix A in RFP Format.
00104 *           RFP Format is described by TRANSR, UPLO and N as follows:
00105 *           If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
00106 *           K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If
00107 *           TRANSR = 'C' then RFP is the Conjugate-transpose of RFP A as
00108 *           defined when TRANSR = 'N'. The contents of RFP A are defined
00109 *           by UPLO as follows: If UPLO = 'U' the RFP A contains the NT
00110 *           elements of upper packed A either in normal or
00111 *           conjugate-transpose Format. If UPLO = 'L' the RFP A contains
00112 *           the NT elements of lower packed A either in normal or
00113 *           conjugate-transpose Format. The LDA of RFP A is (N+1)/2 when
00114 *           TRANSR = 'C'. When TRANSR is 'N' the LDA is N+1 when N is
00115 *           even and is N when is odd.
00116 *           See the Note below for more details. Unchanged on exit.
00117 *
00118 *  B       (input/output) COMPLEX*16 array, dimension (LDB,N)
00119 *           Before entry,  the leading  m by n part of the array  B must
00120 *           contain  the  right-hand  side  matrix  B,  and  on exit  is
00121 *           overwritten by the solution matrix  X.
00122 *
00123 *  LDB     (input) INTEGER
00124 *           On entry, LDB specifies the first dimension of B as declared
00125 *           in  the  calling  (sub)  program.   LDB  must  be  at  least
00126 *           max( 1, m ).
00127 *           Unchanged on exit.
00128 *
00129 *  Further Details
00130 *  ===============
00131 *
00132 *  We first consider Standard Packed Format when N is even.
00133 *  We give an example where N = 6.
00134 *
00135 *      AP is Upper             AP is Lower
00136 *
00137 *   00 01 02 03 04 05       00
00138 *      11 12 13 14 15       10 11
00139 *         22 23 24 25       20 21 22
00140 *            33 34 35       30 31 32 33
00141 *               44 45       40 41 42 43 44
00142 *                  55       50 51 52 53 54 55
00143 *
00144 *
00145 *  Let TRANSR = 'N'. RFP holds AP as follows:
00146 *  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
00147 *  three columns of AP upper. The lower triangle A(4:6,0:2) consists of
00148 *  conjugate-transpose of the first three columns of AP upper.
00149 *  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
00150 *  three columns of AP lower. The upper triangle A(0:2,0:2) consists of
00151 *  conjugate-transpose of the last three columns of AP lower.
00152 *  To denote conjugate we place -- above the element. This covers the
00153 *  case N even and TRANSR = 'N'.
00154 *
00155 *         RFP A                   RFP A
00156 *
00157 *                                -- -- --
00158 *        03 04 05                33 43 53
00159 *                                   -- --
00160 *        13 14 15                00 44 54
00161 *                                      --
00162 *        23 24 25                10 11 55
00163 *
00164 *        33 34 35                20 21 22
00165 *        --
00166 *        00 44 45                30 31 32
00167 *        -- --
00168 *        01 11 55                40 41 42
00169 *        -- -- --
00170 *        02 12 22                50 51 52
00171 *
00172 *  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
00173 *  transpose of RFP A above. One therefore gets:
00174 *
00175 *
00176 *           RFP A                   RFP A
00177 *
00178 *     -- -- -- --                -- -- -- -- -- --
00179 *     03 13 23 33 00 01 02    33 00 10 20 30 40 50
00180 *     -- -- -- -- --                -- -- -- -- --
00181 *     04 14 24 34 44 11 12    43 44 11 21 31 41 51
00182 *     -- -- -- -- -- --                -- -- -- --
00183 *     05 15 25 35 45 55 22    53 54 55 22 32 42 52
00184 *
00185 *
00186 *  We next  consider Standard Packed Format when N is odd.
00187 *  We give an example where N = 5.
00188 *
00189 *     AP is Upper                 AP is Lower
00190 *
00191 *   00 01 02 03 04              00
00192 *      11 12 13 14              10 11
00193 *         22 23 24              20 21 22
00194 *            33 34              30 31 32 33
00195 *               44              40 41 42 43 44
00196 *
00197 *
00198 *  Let TRANSR = 'N'. RFP holds AP as follows:
00199 *  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
00200 *  three columns of AP upper. The lower triangle A(3:4,0:1) consists of
00201 *  conjugate-transpose of the first two   columns of AP upper.
00202 *  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
00203 *  three columns of AP lower. The upper triangle A(0:1,1:2) consists of
00204 *  conjugate-transpose of the last two   columns of AP lower.
00205 *  To denote conjugate we place -- above the element. This covers the
00206 *  case N odd  and TRANSR = 'N'.
00207 *
00208 *         RFP A                   RFP A
00209 *
00210 *                                   -- --
00211 *        02 03 04                00 33 43
00212 *                                      --
00213 *        12 13 14                10 11 44
00214 *
00215 *        22 23 24                20 21 22
00216 *        --
00217 *        00 33 34                30 31 32
00218 *        -- --
00219 *        01 11 44                40 41 42
00220 *
00221 *  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
00222 *  transpose of RFP A above. One therefore gets:
00223 *
00224 *
00225 *           RFP A                   RFP A
00226 *
00227 *     -- -- --                   -- -- -- -- -- --
00228 *     02 12 22 00 01             00 10 20 30 40 50
00229 *     -- -- -- --                   -- -- -- -- --
00230 *     03 13 23 33 11             33 11 21 31 41 51
00231 *     -- -- -- -- --                   -- -- -- --
00232 *     04 14 24 34 44             43 44 22 32 42 52
00233 *
00234 *  =====================================================================
00235 *     ..
00236 *     .. Parameters ..
00237       COMPLEX*16         CONE, CZERO
00238       PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ),
00239      $                   CZERO = ( 0.0D+0, 0.0D+0 ) )
00240 *     ..
00241 *     .. Local Scalars ..
00242       LOGICAL            LOWER, LSIDE, MISODD, NISODD, NORMALTRANSR,
00243      $                   NOTRANS
00244       INTEGER            M1, M2, N1, N2, K, INFO, I, J
00245 *     ..
00246 *     .. External Functions ..
00247       LOGICAL            LSAME
00248       EXTERNAL           LSAME
00249 *     ..
00250 *     .. External Subroutines ..
00251       EXTERNAL           XERBLA, ZGEMM, ZTRSM
00252 *     ..
00253 *     .. Intrinsic Functions ..
00254       INTRINSIC          MAX, MOD
00255 *     ..
00256 *     .. Executable Statements ..
00257 *
00258 *     Test the input parameters.
00259 *
00260       INFO = 0
00261       NORMALTRANSR = LSAME( TRANSR, 'N' )
00262       LSIDE = LSAME( SIDE, 'L' )
00263       LOWER = LSAME( UPLO, 'L' )
00264       NOTRANS = LSAME( TRANS, 'N' )
00265       IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'C' ) ) THEN
00266          INFO = -1
00267       ELSE IF( .NOT.LSIDE .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
00268          INFO = -2
00269       ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
00270          INFO = -3
00271       ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
00272          INFO = -4
00273       ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) )
00274      $         THEN
00275          INFO = -5
00276       ELSE IF( M.LT.0 ) THEN
00277          INFO = -6
00278       ELSE IF( N.LT.0 ) THEN
00279          INFO = -7
00280       ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
00281          INFO = -11
00282       END IF
00283       IF( INFO.NE.0 ) THEN
00284          CALL XERBLA( 'ZTFSM ', -INFO )
00285          RETURN
00286       END IF
00287 *
00288 *     Quick return when ( (N.EQ.0).OR.(M.EQ.0) )
00289 *
00290       IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
00291      $   RETURN
00292 *
00293 *     Quick return when ALPHA.EQ.(0D+0,0D+0)
00294 *
00295       IF( ALPHA.EQ.CZERO ) THEN
00296          DO 20 J = 0, N - 1
00297             DO 10 I = 0, M - 1
00298                B( I, J ) = CZERO
00299    10       CONTINUE
00300    20    CONTINUE
00301          RETURN
00302       END IF
00303 *
00304       IF( LSIDE ) THEN
00305 *
00306 *        SIDE = 'L'
00307 *
00308 *        A is M-by-M.
00309 *        If M is odd, set NISODD = .TRUE., and M1 and M2.
00310 *        If M is even, NISODD = .FALSE., and M.
00311 *
00312          IF( MOD( M, 2 ).EQ.0 ) THEN
00313             MISODD = .FALSE.
00314             K = M / 2
00315          ELSE
00316             MISODD = .TRUE.
00317             IF( LOWER ) THEN
00318                M2 = M / 2
00319                M1 = M - M2
00320             ELSE
00321                M1 = M / 2
00322                M2 = M - M1
00323             END IF
00324          END IF
00325 *
00326          IF( MISODD ) THEN
00327 *
00328 *           SIDE = 'L' and N is odd
00329 *
00330             IF( NORMALTRANSR ) THEN
00331 *
00332 *              SIDE = 'L', N is odd, and TRANSR = 'N'
00333 *
00334                IF( LOWER ) THEN
00335 *
00336 *                 SIDE  ='L', N is odd, TRANSR = 'N', and UPLO = 'L'
00337 *
00338                   IF( NOTRANS ) THEN
00339 *
00340 *                    SIDE  ='L', N is odd, TRANSR = 'N', UPLO = 'L', and
00341 *                    TRANS = 'N'
00342 *
00343                      IF( M.EQ.1 ) THEN
00344                         CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA,
00345      $                              A, M, B, LDB )
00346                      ELSE
00347                         CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA,
00348      $                              A( 0 ), M, B, LDB )
00349                         CALL ZGEMM( 'N', 'N', M2, N, M1, -CONE, A( M1 ),
00350      $                              M, B, LDB, ALPHA, B( M1, 0 ), LDB )
00351                         CALL ZTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE,
00352      $                              A( M ), M, B( M1, 0 ), LDB )
00353                      END IF
00354 *
00355                   ELSE
00356 *
00357 *                    SIDE  ='L', N is odd, TRANSR = 'N', UPLO = 'L', and
00358 *                    TRANS = 'C'
00359 *
00360                      IF( M.EQ.1 ) THEN
00361                         CALL ZTRSM( 'L', 'L', 'C', DIAG, M1, N, ALPHA,
00362      $                              A( 0 ), M, B, LDB )
00363                      ELSE
00364                         CALL ZTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA,
00365      $                              A( M ), M, B( M1, 0 ), LDB )
00366                         CALL ZGEMM( 'C', 'N', M1, N, M2, -CONE, A( M1 ),
00367      $                              M, B( M1, 0 ), LDB, ALPHA, B, LDB )
00368                         CALL ZTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE,
00369      $                              A( 0 ), M, B, LDB )
00370                      END IF
00371 *
00372                   END IF
00373 *
00374                ELSE
00375 *
00376 *                 SIDE  ='L', N is odd, TRANSR = 'N', and UPLO = 'U'
00377 *
00378                   IF( .NOT.NOTRANS ) THEN
00379 *
00380 *                    SIDE  ='L', N is odd, TRANSR = 'N', UPLO = 'U', and
00381 *                    TRANS = 'N'
00382 *
00383                      CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA,
00384      $                           A( M2 ), M, B, LDB )
00385                      CALL ZGEMM( 'C', 'N', M2, N, M1, -CONE, A( 0 ), M,
00386      $                           B, LDB, ALPHA, B( M1, 0 ), LDB )
00387                      CALL ZTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE,
00388      $                           A( M1 ), M, B( M1, 0 ), LDB )
00389 *
00390                   ELSE
00391 *
00392 *                    SIDE  ='L', N is odd, TRANSR = 'N', UPLO = 'U', and
00393 *                    TRANS = 'C'
00394 *
00395                      CALL ZTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA,
00396      $                           A( M1 ), M, B( M1, 0 ), LDB )
00397                      CALL ZGEMM( 'N', 'N', M1, N, M2, -CONE, A( 0 ), M,
00398      $                           B( M1, 0 ), LDB, ALPHA, B, LDB )
00399                      CALL ZTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE,
00400      $                           A( M2 ), M, B, LDB )
00401 *
00402                   END IF
00403 *
00404                END IF
00405 *
00406             ELSE
00407 *
00408 *              SIDE = 'L', N is odd, and TRANSR = 'C'
00409 *
00410                IF( LOWER ) THEN
00411 *
00412 *                 SIDE  ='L', N is odd, TRANSR = 'C', and UPLO = 'L'
00413 *
00414                   IF( NOTRANS ) THEN
00415 *
00416 *                    SIDE  ='L', N is odd, TRANSR = 'C', UPLO = 'L', and
00417 *                    TRANS = 'N'
00418 *
00419                      IF( M.EQ.1 ) THEN
00420                         CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA,
00421      $                              A( 0 ), M1, B, LDB )
00422                      ELSE
00423                         CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA,
00424      $                              A( 0 ), M1, B, LDB )
00425                         CALL ZGEMM( 'C', 'N', M2, N, M1, -CONE,
00426      $                              A( M1*M1 ), M1, B, LDB, ALPHA,
00427      $                              B( M1, 0 ), LDB )
00428                         CALL ZTRSM( 'L', 'L', 'N', DIAG, M2, N, CONE,
00429      $                              A( 1 ), M1, B( M1, 0 ), LDB )
00430                      END IF
00431 *
00432                   ELSE
00433 *
00434 *                    SIDE  ='L', N is odd, TRANSR = 'C', UPLO = 'L', and
00435 *                    TRANS = 'C'
00436 *
00437                      IF( M.EQ.1 ) THEN
00438                         CALL ZTRSM( 'L', 'U', 'N', DIAG, M1, N, ALPHA,
00439      $                              A( 0 ), M1, B, LDB )
00440                      ELSE
00441                         CALL ZTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA,
00442      $                              A( 1 ), M1, B( M1, 0 ), LDB )
00443                         CALL ZGEMM( 'N', 'N', M1, N, M2, -CONE,
00444      $                              A( M1*M1 ), M1, B( M1, 0 ), LDB,
00445      $                              ALPHA, B, LDB )
00446                         CALL ZTRSM( 'L', 'U', 'N', DIAG, M1, N, CONE,
00447      $                              A( 0 ), M1, B, LDB )
00448                      END IF
00449 *
00450                   END IF
00451 *
00452                ELSE
00453 *
00454 *                 SIDE  ='L', N is odd, TRANSR = 'C', and UPLO = 'U'
00455 *
00456                   IF( .NOT.NOTRANS ) THEN
00457 *
00458 *                    SIDE  ='L', N is odd, TRANSR = 'C', UPLO = 'U', and
00459 *                    TRANS = 'N'
00460 *
00461                      CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA,
00462      $                           A( M2*M2 ), M2, B, LDB )
00463                      CALL ZGEMM( 'N', 'N', M2, N, M1, -CONE, A( 0 ), M2,
00464      $                           B, LDB, ALPHA, B( M1, 0 ), LDB )
00465                      CALL ZTRSM( 'L', 'L', 'N', DIAG, M2, N, CONE,
00466      $                           A( M1*M2 ), M2, B( M1, 0 ), LDB )
00467 *
00468                   ELSE
00469 *
00470 *                    SIDE  ='L', N is odd, TRANSR = 'C', UPLO = 'U', and
00471 *                    TRANS = 'C'
00472 *
00473                      CALL ZTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA,
00474      $                           A( M1*M2 ), M2, B( M1, 0 ), LDB )
00475                      CALL ZGEMM( 'C', 'N', M1, N, M2, -CONE, A( 0 ), M2,
00476      $                           B( M1, 0 ), LDB, ALPHA, B, LDB )
00477                      CALL ZTRSM( 'L', 'U', 'N', DIAG, M1, N, CONE,
00478      $                           A( M2*M2 ), M2, B, LDB )
00479 *
00480                   END IF
00481 *
00482                END IF
00483 *
00484             END IF
00485 *
00486          ELSE
00487 *
00488 *           SIDE = 'L' and N is even
00489 *
00490             IF( NORMALTRANSR ) THEN
00491 *
00492 *              SIDE = 'L', N is even, and TRANSR = 'N'
00493 *
00494                IF( LOWER ) THEN
00495 *
00496 *                 SIDE  ='L', N is even, TRANSR = 'N', and UPLO = 'L'
00497 *
00498                   IF( NOTRANS ) THEN
00499 *
00500 *                    SIDE  ='L', N is even, TRANSR = 'N', UPLO = 'L',
00501 *                    and TRANS = 'N'
00502 *
00503                      CALL ZTRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA,
00504      $                           A( 1 ), M+1, B, LDB )
00505                      CALL ZGEMM( 'N', 'N', K, N, K, -CONE, A( K+1 ),
00506      $                           M+1, B, LDB, ALPHA, B( K, 0 ), LDB )
00507                      CALL ZTRSM( 'L', 'U', 'C', DIAG, K, N, CONE,
00508      $                           A( 0 ), M+1, B( K, 0 ), LDB )
00509 *
00510                   ELSE
00511 *
00512 *                    SIDE  ='L', N is even, TRANSR = 'N', UPLO = 'L',
00513 *                    and TRANS = 'C'
00514 *
00515                      CALL ZTRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA,
00516      $                           A( 0 ), M+1, B( K, 0 ), LDB )
00517                      CALL ZGEMM( 'C', 'N', K, N, K, -CONE, A( K+1 ),
00518      $                           M+1, B( K, 0 ), LDB, ALPHA, B, LDB )
00519                      CALL ZTRSM( 'L', 'L', 'C', DIAG, K, N, CONE,
00520      $                           A( 1 ), M+1, B, LDB )
00521 *
00522                   END IF
00523 *
00524                ELSE
00525 *
00526 *                 SIDE  ='L', N is even, TRANSR = 'N', and UPLO = 'U'
00527 *
00528                   IF( .NOT.NOTRANS ) THEN
00529 *
00530 *                    SIDE  ='L', N is even, TRANSR = 'N', UPLO = 'U',
00531 *                    and TRANS = 'N'
00532 *
00533                      CALL ZTRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA,
00534      $                           A( K+1 ), M+1, B, LDB )
00535                      CALL ZGEMM( 'C', 'N', K, N, K, -CONE, A( 0 ), M+1,
00536      $                           B, LDB, ALPHA, B( K, 0 ), LDB )
00537                      CALL ZTRSM( 'L', 'U', 'C', DIAG, K, N, CONE,
00538      $                           A( K ), M+1, B( K, 0 ), LDB )
00539 *
00540                   ELSE
00541 *
00542 *                    SIDE  ='L', N is even, TRANSR = 'N', UPLO = 'U',
00543 *                    and TRANS = 'C'
00544                      CALL ZTRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA,
00545      $                           A( K ), M+1, B( K, 0 ), LDB )
00546                      CALL ZGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), M+1,
00547      $                           B( K, 0 ), LDB, ALPHA, B, LDB )
00548                      CALL ZTRSM( 'L', 'L', 'C', DIAG, K, N, CONE,
00549      $                           A( K+1 ), M+1, B, LDB )
00550 *
00551                   END IF
00552 *
00553                END IF
00554 *
00555             ELSE
00556 *
00557 *              SIDE = 'L', N is even, and TRANSR = 'C'
00558 *
00559                IF( LOWER ) THEN
00560 *
00561 *                 SIDE  ='L', N is even, TRANSR = 'C', and UPLO = 'L'
00562 *
00563                   IF( NOTRANS ) THEN
00564 *
00565 *                    SIDE  ='L', N is even, TRANSR = 'C', UPLO = 'L',
00566 *                    and TRANS = 'N'
00567 *
00568                      CALL ZTRSM( 'L', 'U', 'C', DIAG, K, N, ALPHA,
00569      $                           A( K ), K, B, LDB )
00570                      CALL ZGEMM( 'C', 'N', K, N, K, -CONE,
00571      $                           A( K*( K+1 ) ), K, B, LDB, ALPHA,
00572      $                           B( K, 0 ), LDB )
00573                      CALL ZTRSM( 'L', 'L', 'N', DIAG, K, N, CONE,
00574      $                           A( 0 ), K, B( K, 0 ), LDB )
00575 *
00576                   ELSE
00577 *
00578 *                    SIDE  ='L', N is even, TRANSR = 'C', UPLO = 'L',
00579 *                    and TRANS = 'C'
00580 *
00581                      CALL ZTRSM( 'L', 'L', 'C', DIAG, K, N, ALPHA,
00582      $                           A( 0 ), K, B( K, 0 ), LDB )
00583                      CALL ZGEMM( 'N', 'N', K, N, K, -CONE,
00584      $                           A( K*( K+1 ) ), K, B( K, 0 ), LDB,
00585      $                           ALPHA, B, LDB )
00586                      CALL ZTRSM( 'L', 'U', 'N', DIAG, K, N, CONE,
00587      $                           A( K ), K, B, LDB )
00588 *
00589                   END IF
00590 *
00591                ELSE
00592 *
00593 *                 SIDE  ='L', N is even, TRANSR = 'C', and UPLO = 'U'
00594 *
00595                   IF( .NOT.NOTRANS ) THEN
00596 *
00597 *                    SIDE  ='L', N is even, TRANSR = 'C', UPLO = 'U',
00598 *                    and TRANS = 'N'
00599 *
00600                      CALL ZTRSM( 'L', 'U', 'C', DIAG, K, N, ALPHA,
00601      $                           A( K*( K+1 ) ), K, B, LDB )
00602                      CALL ZGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), K, B,
00603      $                           LDB, ALPHA, B( K, 0 ), LDB )
00604                      CALL ZTRSM( 'L', 'L', 'N', DIAG, K, N, CONE,
00605      $                           A( K*K ), K, B( K, 0 ), LDB )
00606 *
00607                   ELSE
00608 *
00609 *                    SIDE  ='L', N is even, TRANSR = 'C', UPLO = 'U',
00610 *                    and TRANS = 'C'
00611 *
00612                      CALL ZTRSM( 'L', 'L', 'C', DIAG, K, N, ALPHA,
00613      $                           A( K*K ), K, B( K, 0 ), LDB )
00614                      CALL ZGEMM( 'C', 'N', K, N, K, -CONE, A( 0 ), K,
00615      $                           B( K, 0 ), LDB, ALPHA, B, LDB )
00616                      CALL ZTRSM( 'L', 'U', 'N', DIAG, K, N, CONE,
00617      $                           A( K*( K+1 ) ), K, B, LDB )
00618 *
00619                   END IF
00620 *
00621                END IF
00622 *
00623             END IF
00624 *
00625          END IF
00626 *
00627       ELSE
00628 *
00629 *        SIDE = 'R'
00630 *
00631 *        A is N-by-N.
00632 *        If N is odd, set NISODD = .TRUE., and N1 and N2.
00633 *        If N is even, NISODD = .FALSE., and K.
00634 *
00635          IF( MOD( N, 2 ).EQ.0 ) THEN
00636             NISODD = .FALSE.
00637             K = N / 2
00638          ELSE
00639             NISODD = .TRUE.
00640             IF( LOWER ) THEN
00641                N2 = N / 2
00642                N1 = N - N2
00643             ELSE
00644                N1 = N / 2
00645                N2 = N - N1
00646             END IF
00647          END IF
00648 *
00649          IF( NISODD ) THEN
00650 *
00651 *           SIDE = 'R' and N is odd
00652 *
00653             IF( NORMALTRANSR ) THEN
00654 *
00655 *              SIDE = 'R', N is odd, and TRANSR = 'N'
00656 *
00657                IF( LOWER ) THEN
00658 *
00659 *                 SIDE  ='R', N is odd, TRANSR = 'N', and UPLO = 'L'
00660 *
00661                   IF( NOTRANS ) THEN
00662 *
00663 *                    SIDE  ='R', N is odd, TRANSR = 'N', UPLO = 'L', and
00664 *                    TRANS = 'N'
00665 *
00666                      CALL ZTRSM( 'R', 'U', 'C', DIAG, M, N2, ALPHA,
00667      $                           A( N ), N, B( 0, N1 ), LDB )
00668                      CALL ZGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, N1 ),
00669      $                           LDB, A( N1 ), N, ALPHA, B( 0, 0 ),
00670      $                           LDB )
00671                      CALL ZTRSM( 'R', 'L', 'N', DIAG, M, N1, CONE,
00672      $                           A( 0 ), N, B( 0, 0 ), LDB )
00673 *
00674                   ELSE
00675 *
00676 *                    SIDE  ='R', N is odd, TRANSR = 'N', UPLO = 'L', and
00677 *                    TRANS = 'C'
00678 *
00679                      CALL ZTRSM( 'R', 'L', 'C', DIAG, M, N1, ALPHA,
00680      $                           A( 0 ), N, B( 0, 0 ), LDB )
00681                      CALL ZGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, 0 ),
00682      $                           LDB, A( N1 ), N, ALPHA, B( 0, N1 ),
00683      $                           LDB )
00684                      CALL ZTRSM( 'R', 'U', 'N', DIAG, M, N2, CONE,
00685      $                           A( N ), N, B( 0, N1 ), LDB )
00686 *
00687                   END IF
00688 *
00689                ELSE
00690 *
00691 *                 SIDE  ='R', N is odd, TRANSR = 'N', and UPLO = 'U'
00692 *
00693                   IF( NOTRANS ) THEN
00694 *
00695 *                    SIDE  ='R', N is odd, TRANSR = 'N', UPLO = 'U', and
00696 *                    TRANS = 'N'
00697 *
00698                      CALL ZTRSM( 'R', 'L', 'C', DIAG, M, N1, ALPHA,
00699      $                           A( N2 ), N, B( 0, 0 ), LDB )
00700                      CALL ZGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, 0 ),
00701      $                           LDB, A( 0 ), N, ALPHA, B( 0, N1 ),
00702      $                           LDB )
00703                      CALL ZTRSM( 'R', 'U', 'N', DIAG, M, N2, CONE,
00704      $                           A( N1 ), N, B( 0, N1 ), LDB )
00705 *
00706                   ELSE
00707 *
00708 *                    SIDE  ='R', N is odd, TRANSR = 'N', UPLO = 'U', and
00709 *                    TRANS = 'C'
00710 *
00711                      CALL ZTRSM( 'R', 'U', 'C', DIAG, M, N2, ALPHA,
00712      $                           A( N1 ), N, B( 0, N1 ), LDB )
00713                      CALL ZGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, N1 ),
00714      $                           LDB, A( 0 ), N, ALPHA, B( 0, 0 ), LDB )
00715                      CALL ZTRSM( 'R', 'L', 'N', DIAG, M, N1, CONE,
00716      $                           A( N2 ), N, B( 0, 0 ), LDB )
00717 *
00718                   END IF
00719 *
00720                END IF
00721 *
00722             ELSE
00723 *
00724 *              SIDE = 'R', N is odd, and TRANSR = 'C'
00725 *
00726                IF( LOWER ) THEN
00727 *
00728 *                 SIDE  ='R', N is odd, TRANSR = 'C', and UPLO = 'L'
00729 *
00730                   IF( NOTRANS ) THEN
00731 *
00732 *                    SIDE  ='R', N is odd, TRANSR = 'C', UPLO = 'L', and
00733 *                    TRANS = 'N'
00734 *
00735                      CALL ZTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA,
00736      $                           A( 1 ), N1, B( 0, N1 ), LDB )
00737                      CALL ZGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, N1 ),
00738      $                           LDB, A( N1*N1 ), N1, ALPHA, B( 0, 0 ),
00739      $                           LDB )
00740                      CALL ZTRSM( 'R', 'U', 'C', DIAG, M, N1, CONE,
00741      $                           A( 0 ), N1, B( 0, 0 ), LDB )
00742 *
00743                   ELSE
00744 *
00745 *                    SIDE  ='R', N is odd, TRANSR = 'C', UPLO = 'L', and
00746 *                    TRANS = 'C'
00747 *
00748                      CALL ZTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA,
00749      $                           A( 0 ), N1, B( 0, 0 ), LDB )
00750                      CALL ZGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, 0 ),
00751      $                           LDB, A( N1*N1 ), N1, ALPHA, B( 0, N1 ),
00752      $                           LDB )
00753                      CALL ZTRSM( 'R', 'L', 'C', DIAG, M, N2, CONE,
00754      $                           A( 1 ), N1, B( 0, N1 ), LDB )
00755 *
00756                   END IF
00757 *
00758                ELSE
00759 *
00760 *                 SIDE  ='R', N is odd, TRANSR = 'C', and UPLO = 'U'
00761 *
00762                   IF( NOTRANS ) THEN
00763 *
00764 *                    SIDE  ='R', N is odd, TRANSR = 'C', UPLO = 'U', and
00765 *                    TRANS = 'N'
00766 *
00767                      CALL ZTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA,
00768      $                           A( N2*N2 ), N2, B( 0, 0 ), LDB )
00769                      CALL ZGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, 0 ),
00770      $                           LDB, A( 0 ), N2, ALPHA, B( 0, N1 ),
00771      $                           LDB )
00772                      CALL ZTRSM( 'R', 'L', 'C', DIAG, M, N2, CONE,
00773      $                           A( N1*N2 ), N2, B( 0, N1 ), LDB )
00774 *
00775                   ELSE
00776 *
00777 *                    SIDE  ='R', N is odd, TRANSR = 'C', UPLO = 'U', and
00778 *                    TRANS = 'C'
00779 *
00780                      CALL ZTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA,
00781      $                           A( N1*N2 ), N2, B( 0, N1 ), LDB )
00782                      CALL ZGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, N1 ),
00783      $                           LDB, A( 0 ), N2, ALPHA, B( 0, 0 ),
00784      $                           LDB )
00785                      CALL ZTRSM( 'R', 'U', 'C', DIAG, M, N1, CONE,
00786      $                           A( N2*N2 ), N2, B( 0, 0 ), LDB )
00787 *
00788                   END IF
00789 *
00790                END IF
00791 *
00792             END IF
00793 *
00794          ELSE
00795 *
00796 *           SIDE = 'R' and N is even
00797 *
00798             IF( NORMALTRANSR ) THEN
00799 *
00800 *              SIDE = 'R', N is even, and TRANSR = 'N'
00801 *
00802                IF( LOWER ) THEN
00803 *
00804 *                 SIDE  ='R', N is even, TRANSR = 'N', and UPLO = 'L'
00805 *
00806                   IF( NOTRANS ) THEN
00807 *
00808 *                    SIDE  ='R', N is even, TRANSR = 'N', UPLO = 'L',
00809 *                    and TRANS = 'N'
00810 *
00811                      CALL ZTRSM( 'R', 'U', 'C', DIAG, M, K, ALPHA,
00812      $                           A( 0 ), N+1, B( 0, K ), LDB )
00813                      CALL ZGEMM( 'N', 'N', M, K, K, -CONE, B( 0, K ),
00814      $                           LDB, A( K+1 ), N+1, ALPHA, B( 0, 0 ),
00815      $                           LDB )
00816                      CALL ZTRSM( 'R', 'L', 'N', DIAG, M, K, CONE,
00817      $                           A( 1 ), N+1, B( 0, 0 ), LDB )
00818 *
00819                   ELSE
00820 *
00821 *                    SIDE  ='R', N is even, TRANSR = 'N', UPLO = 'L',
00822 *                    and TRANS = 'C'
00823 *
00824                      CALL ZTRSM( 'R', 'L', 'C', DIAG, M, K, ALPHA,
00825      $                           A( 1 ), N+1, B( 0, 0 ), LDB )
00826                      CALL ZGEMM( 'N', 'C', M, K, K, -CONE, B( 0, 0 ),
00827      $                           LDB, A( K+1 ), N+1, ALPHA, B( 0, K ),
00828      $                           LDB )
00829                      CALL ZTRSM( 'R', 'U', 'N', DIAG, M, K, CONE,
00830      $                           A( 0 ), N+1, B( 0, K ), LDB )
00831 *
00832                   END IF
00833 *
00834                ELSE
00835 *
00836 *                 SIDE  ='R', N is even, TRANSR = 'N', and UPLO = 'U'
00837 *
00838                   IF( NOTRANS ) THEN
00839 *
00840 *                    SIDE  ='R', N is even, TRANSR = 'N', UPLO = 'U',
00841 *                    and TRANS = 'N'
00842 *
00843                      CALL ZTRSM( 'R', 'L', 'C', DIAG, M, K, ALPHA,
00844      $                           A( K+1 ), N+1, B( 0, 0 ), LDB )
00845                      CALL ZGEMM( 'N', 'N', M, K, K, -CONE, B( 0, 0 ),
00846      $                           LDB, A( 0 ), N+1, ALPHA, B( 0, K ),
00847      $                           LDB )
00848                      CALL ZTRSM( 'R', 'U', 'N', DIAG, M, K, CONE,
00849      $                           A( K ), N+1, B( 0, K ), LDB )
00850 *
00851                   ELSE
00852 *
00853 *                    SIDE  ='R', N is even, TRANSR = 'N', UPLO = 'U',
00854 *                    and TRANS = 'C'
00855 *
00856                      CALL ZTRSM( 'R', 'U', 'C', DIAG, M, K, ALPHA,
00857      $                           A( K ), N+1, B( 0, K ), LDB )
00858                      CALL ZGEMM( 'N', 'C', M, K, K, -CONE, B( 0, K ),
00859      $                           LDB, A( 0 ), N+1, ALPHA, B( 0, 0 ),
00860      $                           LDB )
00861                      CALL ZTRSM( 'R', 'L', 'N', DIAG, M, K, CONE,
00862      $                           A( K+1 ), N+1, B( 0, 0 ), LDB )
00863 *
00864                   END IF
00865 *
00866                END IF
00867 *
00868             ELSE
00869 *
00870 *              SIDE = 'R', N is even, and TRANSR = 'C'
00871 *
00872                IF( LOWER ) THEN
00873 *
00874 *                 SIDE  ='R', N is even, TRANSR = 'C', and UPLO = 'L'
00875 *
00876                   IF( NOTRANS ) THEN
00877 *
00878 *                    SIDE  ='R', N is even, TRANSR = 'C', UPLO = 'L',
00879 *                    and TRANS = 'N'
00880 *
00881                      CALL ZTRSM( 'R', 'L', 'N', DIAG, M, K, ALPHA,
00882      $                           A( 0 ), K, B( 0, K ), LDB )
00883                      CALL ZGEMM( 'N', 'C', M, K, K, -CONE, B( 0, K ),
00884      $                           LDB, A( ( K+1 )*K ), K, ALPHA,
00885      $                           B( 0, 0 ), LDB )
00886                      CALL ZTRSM( 'R', 'U', 'C', DIAG, M, K, CONE,
00887      $                           A( K ), K, B( 0, 0 ), LDB )
00888 *
00889                   ELSE
00890 *
00891 *                    SIDE  ='R', N is even, TRANSR = 'C', UPLO = 'L',
00892 *                    and TRANS = 'C'
00893 *
00894                      CALL ZTRSM( 'R', 'U', 'N', DIAG, M, K, ALPHA,
00895      $                           A( K ), K, B( 0, 0 ), LDB )
00896                      CALL ZGEMM( 'N', 'N', M, K, K, -CONE, B( 0, 0 ),
00897      $                           LDB, A( ( K+1 )*K ), K, ALPHA,
00898      $                           B( 0, K ), LDB )
00899                      CALL ZTRSM( 'R', 'L', 'C', DIAG, M, K, CONE,
00900      $                           A( 0 ), K, B( 0, K ), LDB )
00901 *
00902                   END IF
00903 *
00904                ELSE
00905 *
00906 *                 SIDE  ='R', N is even, TRANSR = 'C', and UPLO = 'U'
00907 *
00908                   IF( NOTRANS ) THEN
00909 *
00910 *                    SIDE  ='R', N is even, TRANSR = 'C', UPLO = 'U',
00911 *                    and TRANS = 'N'
00912 *
00913                      CALL ZTRSM( 'R', 'U', 'N', DIAG, M, K, ALPHA,
00914      $                           A( ( K+1 )*K ), K, B( 0, 0 ), LDB )
00915                      CALL ZGEMM( 'N', 'C', M, K, K, -CONE, B( 0, 0 ),
00916      $                           LDB, A( 0 ), K, ALPHA, B( 0, K ), LDB )
00917                      CALL ZTRSM( 'R', 'L', 'C', DIAG, M, K, CONE,
00918      $                           A( K*K ), K, B( 0, K ), LDB )
00919 *
00920                   ELSE
00921 *
00922 *                    SIDE  ='R', N is even, TRANSR = 'C', UPLO = 'U',
00923 *                    and TRANS = 'C'
00924 *
00925                      CALL ZTRSM( 'R', 'L', 'N', DIAG, M, K, ALPHA,
00926      $                           A( K*K ), K, B( 0, K ), LDB )
00927                      CALL ZGEMM( 'N', 'N', M, K, K, -CONE, B( 0, K ),
00928      $                           LDB, A( 0 ), K, ALPHA, B( 0, 0 ), LDB )
00929                      CALL ZTRSM( 'R', 'U', 'C', DIAG, M, K, CONE,
00930      $                           A( ( K+1 )*K ), K, B( 0, 0 ), LDB )
00931 *
00932                   END IF
00933 *
00934                END IF
00935 *
00936             END IF
00937 *
00938          END IF
00939       END IF
00940 *
00941       RETURN
00942 *
00943 *     End of ZTFSM
00944 *
00945       END
 All Files Functions