LAPACK: SRC/zlarfb.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
00002      $                   T, LDT, C, LDC, WORK, LDWORK )
00003       IMPLICIT NONE
00004 *
00005 *  -- LAPACK auxiliary routine (version 3.2) --
00006 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00007 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00008 *     November 2006
00009 *
00010 *     .. Scalar Arguments ..
00011       CHARACTER          DIRECT, SIDE, STOREV, TRANS
00012       INTEGER            K, LDC, LDT, LDV, LDWORK, M, N
00013 *     ..
00014 *     .. Array Arguments ..
00015       COMPLEX*16         C( LDC, * ), T( LDT, * ), V( LDV, * ),
00016      $                   WORK( LDWORK, * )
00017 *     ..
00018 *
00019 *  Purpose
00020 *  =======
00021 *
00022 *  ZLARFB applies a complex block reflector H or its transpose H' to a
00023 *  complex M-by-N matrix C, from either the left or the right.
00024 *
00025 *  Arguments
00026 *  =========
00027 *
00028 *  SIDE    (input) CHARACTER*1
00029 *          = 'L': apply H or H' from the Left
00030 *          = 'R': apply H or H' from the Right
00031 *
00032 *  TRANS   (input) CHARACTER*1
00033 *          = 'N': apply H (No transpose)
00034 *          = 'C': apply H' (Conjugate transpose)
00035 *
00036 *  DIRECT  (input) CHARACTER*1
00037 *          Indicates how H is formed from a product of elementary
00038 *          reflectors
00039 *          = 'F': H = H(1) H(2) . . . H(k) (Forward)
00040 *          = 'B': H = H(k) . . . H(2) H(1) (Backward)
00041 *
00042 *  STOREV  (input) CHARACTER*1
00043 *          Indicates how the vectors which define the elementary
00044 *          reflectors are stored:
00045 *          = 'C': Columnwise
00046 *          = 'R': Rowwise
00047 *
00048 *  M       (input) INTEGER
00049 *          The number of rows of the matrix C.
00050 *
00051 *  N       (input) INTEGER
00052 *          The number of columns of the matrix C.
00053 *
00054 *  K       (input) INTEGER
00055 *          The order of the matrix T (= the number of elementary
00056 *          reflectors whose product defines the block reflector).
00057 *
00058 *  V       (input) COMPLEX*16 array, dimension
00059 *                                (LDV,K) if STOREV = 'C'
00060 *                                (LDV,M) if STOREV = 'R' and SIDE = 'L'
00061 *                                (LDV,N) if STOREV = 'R' and SIDE = 'R'
00062 *          The matrix V. See further details.
00063 *
00064 *  LDV     (input) INTEGER
00065 *          The leading dimension of the array V.
00066 *          If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
00067 *          if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
00068 *          if STOREV = 'R', LDV >= K.
00069 *
00070 *  T       (input) COMPLEX*16 array, dimension (LDT,K)
00071 *          The triangular K-by-K matrix T in the representation of the
00072 *          block reflector.
00073 *
00074 *  LDT     (input) INTEGER
00075 *          The leading dimension of the array T. LDT >= K.
00076 *
00077 *  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
00078 *          On entry, the M-by-N matrix C.
00079 *          On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
00080 *
00081 *  LDC     (input) INTEGER
00082 *          The leading dimension of the array C. LDC >= max(1,M).
00083 *
00084 *  WORK    (workspace) COMPLEX*16 array, dimension (LDWORK,K)
00085 *
00086 *  LDWORK  (input) INTEGER
00087 *          The leading dimension of the array WORK.
00088 *          If SIDE = 'L', LDWORK >= max(1,N);
00089 *          if SIDE = 'R', LDWORK >= max(1,M).
00090 *
00091 *  =====================================================================
00092 *
00093 *     .. Parameters ..
00094       COMPLEX*16         ONE
00095       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
00096 *     ..
00097 *     .. Local Scalars ..
00098       CHARACTER          TRANST
00099       INTEGER            I, J, LASTV, LASTC
00100 *     ..
00101 *     .. External Functions ..
00102       LOGICAL            LSAME
00103       INTEGER            ILAZLR, ILAZLC
00104       EXTERNAL           LSAME, ILAZLR, ILAZLC
00105 *     ..
00106 *     .. External Subroutines ..
00107       EXTERNAL           ZCOPY, ZGEMM, ZLACGV, ZTRMM
00108 *     ..
00109 *     .. Intrinsic Functions ..
00110       INTRINSIC          DCONJG
00111 *     ..
00112 *     .. Executable Statements ..
00113 *
00114 *     Quick return if possible
00115 *
00116       IF( M.LE.0 .OR. N.LE.0 )
00117      $   RETURN
00118 *
00119       IF( LSAME( TRANS, 'N' ) ) THEN
00120          TRANST = 'C'
00121       ELSE
00122          TRANST = 'N'
00123       END IF
00124 *
00125       IF( LSAME( STOREV, 'C' ) ) THEN
00126 *
00127          IF( LSAME( DIRECT, 'F' ) ) THEN
00128 *
00129 *           Let  V =  ( V1 )    (first K rows)
00130 *                     ( V2 )
00131 *           where  V1  is unit lower triangular.
00132 *
00133             IF( LSAME( SIDE, 'L' ) ) THEN
00134 *
00135 *              Form  H * C  or  H' * C  where  C = ( C1 )
00136 *                                                  ( C2 )
00137 *
00138                LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )
00139                LASTC = ILAZLC( LASTV, N, C, LDC )
00140 *
00141 *              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)
00142 *
00143 *              W := C1'
00144 *
00145                DO 10 J = 1, K
00146                   CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
00147                   CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
00148    10          CONTINUE
00149 *
00150 *              W := W * V1
00151 *
00152                CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
00153      $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
00154                IF( LASTV.GT.K ) THEN
00155 *
00156 *                 W := W + C2'*V2
00157 *
00158                   CALL ZGEMM( 'Conjugate transpose', 'No transpose',
00159      $                 LASTC, K, LASTV-K, ONE, C( K+1, 1 ), LDC,
00160      $                 V( K+1, 1 ), LDV, ONE, WORK, LDWORK )
00161                END IF
00162 *
00163 *              W := W * T'  or  W * T
00164 *
00165                CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
00166      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
00167 *
00168 *              C := C - V * W'
00169 *
00170                IF( M.GT.K ) THEN
00171 *
00172 *                 C2 := C2 - V2 * W'
00173 *
00174                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
00175      $                 LASTV-K, LASTC, K,
00176      $                 -ONE, V( K+1, 1 ), LDV, WORK, LDWORK,
00177      $                 ONE, C( K+1, 1 ), LDC )
00178                END IF
00179 *
00180 *              W := W * V1'
00181 *
00182                CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
00183      $              'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
00184 *
00185 *              C1 := C1 - W'
00186 *
00187                DO 30 J = 1, K
00188                   DO 20 I = 1, LASTC
00189                      C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
00190    20             CONTINUE
00191    30          CONTINUE
00192 *
00193             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
00194 *
00195 *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
00196 *
00197                LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )
00198                LASTC = ILAZLR( M, LASTV, C, LDC )
00199 *
00200 *              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
00201 *
00202 *              W := C1
00203 *
00204                DO 40 J = 1, K
00205                   CALL ZCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
00206    40          CONTINUE
00207 *
00208 *              W := W * V1
00209 *
00210                CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
00211      $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
00212                IF( LASTV.GT.K ) THEN
00213 *
00214 *                 W := W + C2 * V2
00215 *
00216                   CALL ZGEMM( 'No transpose', 'No transpose',
00217      $                 LASTC, K, LASTV-K,
00218      $                 ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
00219      $                 ONE, WORK, LDWORK )
00220                END IF
00221 *
00222 *              W := W * T  or  W * T'
00223 *
00224                CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
00225      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
00226 *
00227 *              C := C - W * V'
00228 *
00229                IF( LASTV.GT.K ) THEN
00230 *
00231 *                 C2 := C2 - W * V2'
00232 *
00233                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
00234      $                 LASTC, LASTV-K, K,
00235      $                 -ONE, WORK, LDWORK, V( K+1, 1 ), LDV,
00236      $                 ONE, C( 1, K+1 ), LDC )
00237                END IF
00238 *
00239 *              W := W * V1'
00240 *
00241                CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
00242      $              'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
00243 *
00244 *              C1 := C1 - W
00245 *
00246                DO 60 J = 1, K
00247                   DO 50 I = 1, LASTC
00248                      C( I, J ) = C( I, J ) - WORK( I, J )
00249    50             CONTINUE
00250    60          CONTINUE
00251             END IF
00252 *
00253          ELSE
00254 *
00255 *           Let  V =  ( V1 )
00256 *                     ( V2 )    (last K rows)
00257 *           where  V2  is unit upper triangular.
00258 *
00259             IF( LSAME( SIDE, 'L' ) ) THEN
00260 *
00261 *              Form  H * C  or  H' * C  where  C = ( C1 )
00262 *                                                  ( C2 )
00263 *
00264                LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )
00265                LASTC = ILAZLC( LASTV, N, C, LDC )
00266 *
00267 *              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)
00268 *
00269 *              W := C2'
00270 *
00271                DO 70 J = 1, K
00272                   CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
00273      $                 WORK( 1, J ), 1 )
00274                   CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
00275    70          CONTINUE
00276 *
00277 *              W := W * V2
00278 *
00279                CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
00280      $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
00281      $              WORK, LDWORK )
00282                IF( LASTV.GT.K ) THEN
00283 *
00284 *                 W := W + C1'*V1
00285 *
00286                   CALL ZGEMM( 'Conjugate transpose', 'No transpose',
00287      $                 LASTC, K, LASTV-K,
00288      $                 ONE, C, LDC, V, LDV,
00289      $                 ONE, WORK, LDWORK )
00290                END IF
00291 *
00292 *              W := W * T'  or  W * T
00293 *
00294                CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
00295      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
00296 *
00297 *              C := C - V * W'
00298 *
00299                IF( LASTV.GT.K ) THEN
00300 *
00301 *                 C1 := C1 - V1 * W'
00302 *
00303                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
00304      $                 LASTV-K, LASTC, K,
00305      $                 -ONE, V, LDV, WORK, LDWORK,
00306      $                 ONE, C, LDC )
00307                END IF
00308 *
00309 *              W := W * V2'
00310 *
00311                CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
00312      $              'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
00313      $              WORK, LDWORK )
00314 *
00315 *              C2 := C2 - W'
00316 *
00317                DO 90 J = 1, K
00318                   DO 80 I = 1, LASTC
00319                      C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
00320      $                               DCONJG( WORK( I, J ) )
00321    80             CONTINUE
00322    90          CONTINUE
00323 *
00324             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
00325 *
00326 *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
00327 *
00328                LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )
00329                LASTC = ILAZLR( M, LASTV, C, LDC )
00330 *
00331 *              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
00332 *
00333 *              W := C2
00334 *
00335                DO 100 J = 1, K
00336                   CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,
00337      $                 WORK( 1, J ), 1 )
00338   100          CONTINUE
00339 *
00340 *              W := W * V2
00341 *
00342                CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
00343      $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
00344      $              WORK, LDWORK )
00345                IF( LASTV.GT.K ) THEN
00346 *
00347 *                 W := W + C1 * V1
00348 *
00349                   CALL ZGEMM( 'No transpose', 'No transpose',
00350      $                 LASTC, K, LASTV-K,
00351      $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
00352                END IF
00353 *
00354 *              W := W * T  or  W * T'
00355 *
00356                CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
00357      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
00358 *
00359 *              C := C - W * V'
00360 *
00361                IF( LASTV.GT.K ) THEN
00362 *
00363 *                 C1 := C1 - W * V1'
00364 *
00365                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
00366      $                 LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
00367      $                 ONE, C, LDC )
00368                END IF
00369 *
00370 *              W := W * V2'
00371 *
00372                CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
00373      $              'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
00374      $              WORK, LDWORK )
00375 *
00376 *              C2 := C2 - W
00377 *
00378                DO 120 J = 1, K
00379                   DO 110 I = 1, LASTC
00380                      C( I, LASTV-K+J ) = C( I, LASTV-K+J )
00381      $                    - WORK( I, J )
00382   110             CONTINUE
00383   120          CONTINUE
00384             END IF
00385          END IF
00386 *
00387       ELSE IF( LSAME( STOREV, 'R' ) ) THEN
00388 *
00389          IF( LSAME( DIRECT, 'F' ) ) THEN
00390 *
00391 *           Let  V =  ( V1  V2 )    (V1: first K columns)
00392 *           where  V1  is unit upper triangular.
00393 *
00394             IF( LSAME( SIDE, 'L' ) ) THEN
00395 *
00396 *              Form  H * C  or  H' * C  where  C = ( C1 )
00397 *                                                  ( C2 )
00398 *
00399                LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
00400                LASTC = ILAZLC( LASTV, N, C, LDC )
00401 *
00402 *              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
00403 *
00404 *              W := C1'
00405 *
00406                DO 130 J = 1, K
00407                   CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
00408                   CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
00409   130          CONTINUE
00410 *
00411 *              W := W * V1'
00412 *
00413                CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
00414      $                     'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
00415                IF( LASTV.GT.K ) THEN
00416 *
00417 *                 W := W + C2'*V2'
00418 *
00419                   CALL ZGEMM( 'Conjugate transpose',
00420      $                 'Conjugate transpose', LASTC, K, LASTV-K,
00421      $                 ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
00422      $                 ONE, WORK, LDWORK )
00423                END IF
00424 *
00425 *              W := W * T'  or  W * T
00426 *
00427                CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
00428      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
00429 *
00430 *              C := C - V' * W'
00431 *
00432                IF( LASTV.GT.K ) THEN
00433 *
00434 *                 C2 := C2 - V2' * W'
00435 *
00436                   CALL ZGEMM( 'Conjugate transpose',
00437      $                 'Conjugate transpose', LASTV-K, LASTC, K,
00438      $                 -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
00439      $                 ONE, C( K+1, 1 ), LDC )
00440                END IF
00441 *
00442 *              W := W * V1
00443 *
00444                CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
00445      $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
00446 *
00447 *              C1 := C1 - W'
00448 *
00449                DO 150 J = 1, K
00450                   DO 140 I = 1, LASTC
00451                      C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
00452   140             CONTINUE
00453   150          CONTINUE
00454 *
00455             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
00456 *
00457 *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
00458 *
00459                LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
00460                LASTC = ILAZLR( M, LASTV, C, LDC )
00461 *
00462 *              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
00463 *
00464 *              W := C1
00465 *
00466                DO 160 J = 1, K
00467                   CALL ZCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
00468   160          CONTINUE
00469 *
00470 *              W := W * V1'
00471 *
00472                CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
00473      $                     'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
00474                IF( LASTV.GT.K ) THEN
00475 *
00476 *                 W := W + C2 * V2'
00477 *
00478                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
00479      $                 LASTC, K, LASTV-K, ONE, C( 1, K+1 ), LDC,
00480      $                 V( 1, K+1 ), LDV, ONE, WORK, LDWORK )
00481                END IF
00482 *
00483 *              W := W * T  or  W * T'
00484 *
00485                CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
00486      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
00487 *
00488 *              C := C - W * V
00489 *
00490                IF( LASTV.GT.K ) THEN
00491 *
00492 *                 C2 := C2 - W * V2
00493 *
00494                   CALL ZGEMM( 'No transpose', 'No transpose',
00495      $                 LASTC, LASTV-K, K,
00496      $                 -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
00497      $                 ONE, C( 1, K+1 ), LDC )
00498                END IF
00499 *
00500 *              W := W * V1
00501 *
00502                CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
00503      $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
00504 *
00505 *              C1 := C1 - W
00506 *
00507                DO 180 J = 1, K
00508                   DO 170 I = 1, LASTC
00509                      C( I, J ) = C( I, J ) - WORK( I, J )
00510   170             CONTINUE
00511   180          CONTINUE
00512 *
00513             END IF
00514 *
00515          ELSE
00516 *
00517 *           Let  V =  ( V1  V2 )    (V2: last K columns)
00518 *           where  V2  is unit lower triangular.
00519 *
00520             IF( LSAME( SIDE, 'L' ) ) THEN
00521 *
00522 *              Form  H * C  or  H' * C  where  C = ( C1 )
00523 *                                                  ( C2 )
00524 *
00525                LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
00526                LASTC = ILAZLC( LASTV, N, C, LDC )
00527 *
00528 *              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
00529 *
00530 *              W := C2'
00531 *
00532                DO 190 J = 1, K
00533                   CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
00534      $                 WORK( 1, J ), 1 )
00535                   CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
00536   190          CONTINUE
00537 *
00538 *              W := W * V2'
00539 *
00540                CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
00541      $              'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
00542      $              WORK, LDWORK )
00543                IF( LASTV.GT.K ) THEN
00544 *
00545 *                 W := W + C1'*V1'
00546 *
00547                   CALL ZGEMM( 'Conjugate transpose',
00548      $                 'Conjugate transpose', LASTC, K, LASTV-K,
00549      $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
00550                END IF
00551 *
00552 *              W := W * T'  or  W * T
00553 *
00554                CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
00555      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
00556 *
00557 *              C := C - V' * W'
00558 *
00559                IF( LASTV.GT.K ) THEN
00560 *
00561 *                 C1 := C1 - V1' * W'
00562 *
00563                   CALL ZGEMM( 'Conjugate transpose',
00564      $                 'Conjugate transpose', LASTV-K, LASTC, K,
00565      $                 -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
00566                END IF
00567 *
00568 *              W := W * V2
00569 *
00570                CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
00571      $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
00572      $              WORK, LDWORK )
00573 *
00574 *              C2 := C2 - W'
00575 *
00576                DO 210 J = 1, K
00577                   DO 200 I = 1, LASTC
00578                      C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
00579      $                               DCONJG( WORK( I, J ) )
00580   200             CONTINUE
00581   210          CONTINUE
00582 *
00583             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
00584 *
00585 *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
00586 *
00587                LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
00588                LASTC = ILAZLR( M, LASTV, C, LDC )
00589 *
00590 *              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
00591 *
00592 *              W := C2
00593 *
00594                DO 220 J = 1, K
00595                   CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,
00596      $                 WORK( 1, J ), 1 )
00597   220          CONTINUE
00598 *
00599 *              W := W * V2'
00600 *
00601                CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
00602      $              'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
00603      $              WORK, LDWORK )
00604                IF( LASTV.GT.K ) THEN
00605 *
00606 *                 W := W + C1 * V1'
00607 *
00608                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
00609      $                 LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, ONE,
00610      $                 WORK, LDWORK )
00611                END IF
00612 *
00613 *              W := W * T  or  W * T'
00614 *
00615                CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
00616      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
00617 *
00618 *              C := C - W * V
00619 *
00620                IF( LASTV.GT.K ) THEN
00621 *
00622 *                 C1 := C1 - W * V1
00623 *
00624                   CALL ZGEMM( 'No transpose', 'No transpose',
00625      $                 LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
00626      $                 ONE, C, LDC )
00627                END IF
00628 *
00629 *              W := W * V2
00630 *
00631                CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
00632      $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
00633      $              WORK, LDWORK )
00634 *
00635 *              C1 := C1 - W
00636 *
00637                DO 240 J = 1, K
00638                   DO 230 I = 1, LASTC
00639                      C( I, LASTV-K+J ) = C( I, LASTV-K+J )
00640      $                    - WORK( I, J )
00641   230             CONTINUE
00642   240          CONTINUE
00643 *
00644             END IF
00645 *
00646          END IF
00647       END IF
00648 *
00649       RETURN
00650 *
00651 *     End of ZLARFB
00652 *
00653       END