[BACK]Return to zlarfb.f CVS log [TXT] [DIR] Up to [local] / rpl / lapack / lapack

Diff for /rpl/lapack/lapack/zlarfb.f between versions 1.7 and 1.8

version 1.7, 2010/12/21 13:53:51 version 1.8, 2011/07/22 07:38:17
Line 2 Line 2
      $                   T, LDT, C, LDC, WORK, LDWORK )       $                   T, LDT, C, LDC, WORK, LDWORK )
       IMPLICIT NONE        IMPLICIT NONE
 *  *
 *  -- LAPACK auxiliary routine (version 3.2) --  *  -- LAPACK auxiliary routine (version 3.3.1) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --  *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--  *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *     November 2006  *  -- April 2011                                                      --
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       CHARACTER          DIRECT, SIDE, STOREV, TRANS        CHARACTER          DIRECT, SIDE, STOREV, TRANS
Line 19 Line 19
 *  Purpose  *  Purpose
 *  =======  *  =======
 *  *
 *  ZLARFB applies a complex block reflector H or its transpose H' to a  *  ZLARFB applies a complex block reflector H or its transpose H**H to a
 *  complex M-by-N matrix C, from either the left or the right.  *  complex M-by-N matrix C, from either the left or the right.
 *  *
 *  Arguments  *  Arguments
 *  =========  *  =========
 *  *
 *  SIDE    (input) CHARACTER*1  *  SIDE    (input) CHARACTER*1
 *          = 'L': apply H or H' from the Left  *          = 'L': apply H or H**H from the Left
 *          = 'R': apply H or H' from the Right  *          = 'R': apply H or H**H from the Right
 *  *
 *  TRANS   (input) CHARACTER*1  *  TRANS   (input) CHARACTER*1
 *          = 'N': apply H (No transpose)  *          = 'N': apply H (No transpose)
 *          = 'C': apply H' (Conjugate transpose)  *          = 'C': apply H**H (Conjugate transpose)
 *  *
 *  DIRECT  (input) CHARACTER*1  *  DIRECT  (input) CHARACTER*1
 *          Indicates how H is formed from a product of elementary  *          Indicates how H is formed from a product of elementary
Line 59 Line 59
 *                                (LDV,K) if STOREV = 'C'  *                                (LDV,K) if STOREV = 'C'
 *                                (LDV,M) if STOREV = 'R' and SIDE = 'L'  *                                (LDV,M) if STOREV = 'R' and SIDE = 'L'
 *                                (LDV,N) if STOREV = 'R' and SIDE = 'R'  *                                (LDV,N) if STOREV = 'R' and SIDE = 'R'
 *          The matrix V. See further details.  *          The matrix V. See Further Details.
 *  *
 *  LDV     (input) INTEGER  *  LDV     (input) INTEGER
 *          The leading dimension of the array V.  *          The leading dimension of the array V.
Line 76 Line 76
 *  *
 *  C       (input/output) COMPLEX*16 array, dimension (LDC,N)  *  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
 *          On entry, the M-by-N matrix C.  *          On entry, the M-by-N matrix C.
 *          On exit, C is overwritten by H*C or H'*C or C*H or C*H'.  *          On exit, C is overwritten by H*C or H**H*C or C*H or C*H**H.
 *  *
 *  LDC     (input) INTEGER  *  LDC     (input) INTEGER
 *          The leading dimension of the array C. LDC >= max(1,M).  *          The leading dimension of the array C. LDC >= max(1,M).
Line 88 Line 88
 *          If SIDE = 'L', LDWORK >= max(1,N);  *          If SIDE = 'L', LDWORK >= max(1,N);
 *          if SIDE = 'R', LDWORK >= max(1,M).  *          if SIDE = 'R', LDWORK >= max(1,M).
 *  *
   *  Further Details
   *  ===============
   *
   *  The shape of the matrix V and the storage of the vectors which define
   *  the H(i) is best illustrated by the following example with n = 5 and
   *  k = 3. The elements equal to 1 are not stored; the corresponding
   *  array elements are modified but restored on exit. The rest of the
   *  array is not used.
   *
   *  DIRECT = 'F' and STOREV = 'C':         DIRECT = 'F' and STOREV = 'R':
   *
   *               V = (  1       )                 V = (  1 v1 v1 v1 v1 )
   *                   ( v1  1    )                     (     1 v2 v2 v2 )
   *                   ( v1 v2  1 )                     (        1 v3 v3 )
   *                   ( v1 v2 v3 )
   *                   ( v1 v2 v3 )
   *
   *  DIRECT = 'B' and STOREV = 'C':         DIRECT = 'B' and STOREV = 'R':
   *
   *               V = ( v1 v2 v3 )                 V = ( v1 v1  1       )
   *                   ( v1 v2 v3 )                     ( v2 v2 v2  1    )
   *                   (  1 v2 v3 )                     ( v3 v3 v3 v3  1 )
   *                   (     1 v3 )
   *                   (        1 )
   *
 *  =====================================================================  *  =====================================================================
 *  *
 *     .. Parameters ..  *     .. Parameters ..
Line 132 Line 157
 *  *
             IF( LSAME( SIDE, 'L' ) ) THEN              IF( LSAME( SIDE, 'L' ) ) THEN
 *  *
 *              Form  H * C  or  H' * C  where  C = ( C1 )  *              Form  H * C  or  H**H * C  where  C = ( C1 )
 *                                                  ( C2 )  *                                                    ( C2 )
 *  *
                LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )                 LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )
                LASTC = ILAZLC( LASTV, N, C, LDC )                 LASTC = ILAZLC( LASTV, N, C, LDC )
 *  *
 *              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)  *              W := C**H * V  =  (C1**H * V1 + C2**H * V2)  (stored in WORK)
 *  *
 *              W := C1'  *              W := C1**H
 *  *
                DO 10 J = 1, K                 DO 10 J = 1, K
                   CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )                    CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
Line 153 Line 178
      $              LASTC, K, ONE, V, LDV, WORK, LDWORK )       $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
                IF( LASTV.GT.K ) THEN                 IF( LASTV.GT.K ) THEN
 *  *
 *                 W := W + C2'*V2  *                 W := W + C2**H *V2
 *  *
                   CALL ZGEMM( 'Conjugate transpose', 'No transpose',                    CALL ZGEMM( 'Conjugate transpose', 'No transpose',
      $                 LASTC, K, LASTV-K, ONE, C( K+1, 1 ), LDC,       $                 LASTC, K, LASTV-K, ONE, C( K+1, 1 ), LDC,
      $                 V( K+1, 1 ), LDV, ONE, WORK, LDWORK )       $                 V( K+1, 1 ), LDV, ONE, WORK, LDWORK )
                END IF                 END IF
 *  *
 *              W := W * T'  or  W * T  *              W := W * T**H  or  W * T
 *  *
                CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',                 CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )       $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
 *  *
 *              C := C - V * W'  *              C := C - V * W**H
 *  *
                IF( M.GT.K ) THEN                 IF( M.GT.K ) THEN
 *  *
 *                 C2 := C2 - V2 * W'  *                 C2 := C2 - V2 * W**H
 *  *
                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',                    CALL ZGEMM( 'No transpose', 'Conjugate transpose',
      $                 LASTV-K, LASTC, K,       $                 LASTV-K, LASTC, K,
Line 177 Line 202
      $                 ONE, C( K+1, 1 ), LDC )       $                 ONE, C( K+1, 1 ), LDC )
                END IF                 END IF
 *  *
 *              W := W * V1'  *              W := W * V1**H
 *  *
                CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',                 CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
      $              'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )       $              'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
 *  *
 *              C1 := C1 - W'  *              C1 := C1 - W**H
 *  *
                DO 30 J = 1, K                 DO 30 J = 1, K
                   DO 20 I = 1, LASTC                    DO 20 I = 1, LASTC
Line 192 Line 217
 *  *
             ELSE IF( LSAME( SIDE, 'R' ) ) THEN              ELSE IF( LSAME( SIDE, 'R' ) ) THEN
 *  *
 *              Form  C * H  or  C * H'  where  C = ( C1  C2 )  *              Form  C * H  or  C * H**H  where  C = ( C1  C2 )
 *  *
                LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )                 LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )
                LASTC = ILAZLR( M, LASTV, C, LDC )                 LASTC = ILAZLR( M, LASTV, C, LDC )
Line 219 Line 244
      $                 ONE, WORK, LDWORK )       $                 ONE, WORK, LDWORK )
                END IF                 END IF
 *  *
 *              W := W * T  or  W * T'  *              W := W * T  or  W * T**H
 *  *
                CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',                 CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )       $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
 *  *
 *              C := C - W * V'  *              C := C - W * V**H
 *  *
                IF( LASTV.GT.K ) THEN                 IF( LASTV.GT.K ) THEN
 *  *
 *                 C2 := C2 - W * V2'  *                 C2 := C2 - W * V2**H
 *  *
                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',                    CALL ZGEMM( 'No transpose', 'Conjugate transpose',
      $                 LASTC, LASTV-K, K,       $                 LASTC, LASTV-K, K,
Line 236 Line 261
      $                 ONE, C( 1, K+1 ), LDC )       $                 ONE, C( 1, K+1 ), LDC )
                END IF                 END IF
 *  *
 *              W := W * V1'  *              W := W * V1**H
 *  *
                CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',                 CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
      $              'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )       $              'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
Line 258 Line 283
 *  *
             IF( LSAME( SIDE, 'L' ) ) THEN              IF( LSAME( SIDE, 'L' ) ) THEN
 *  *
 *              Form  H * C  or  H' * C  where  C = ( C1 )  *              Form  H * C  or  H**H * C  where  C = ( C1 )
 *                                                  ( C2 )  *                                                    ( C2 )
 *  *
                LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )                 LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )
                LASTC = ILAZLC( LASTV, N, C, LDC )                 LASTC = ILAZLC( LASTV, N, C, LDC )
 *  *
 *              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)  *              W := C**H * V  =  (C1**H * V1 + C2**H * V2)  (stored in WORK)
 *  *
 *              W := C2'  *              W := C2**H
 *  *
                DO 70 J = 1, K                 DO 70 J = 1, K
                   CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,                    CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
Line 281 Line 306
      $              WORK, LDWORK )       $              WORK, LDWORK )
                IF( LASTV.GT.K ) THEN                 IF( LASTV.GT.K ) THEN
 *  *
 *                 W := W + C1'*V1  *                 W := W + C1**H*V1
 *  *
                   CALL ZGEMM( 'Conjugate transpose', 'No transpose',                    CALL ZGEMM( 'Conjugate transpose', 'No transpose',
      $                 LASTC, K, LASTV-K,       $                 LASTC, K, LASTV-K,
Line 289 Line 314
      $                 ONE, WORK, LDWORK )       $                 ONE, WORK, LDWORK )
                END IF                 END IF
 *  *
 *              W := W * T'  or  W * T  *              W := W * T**H  or  W * T
 *  *
                CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',                 CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )       $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
 *  *
 *              C := C - V * W'  *              C := C - V * W**H
 *  *
                IF( LASTV.GT.K ) THEN                 IF( LASTV.GT.K ) THEN
 *  *
 *                 C1 := C1 - V1 * W'  *                 C1 := C1 - V1 * W**H
 *  *
                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',                    CALL ZGEMM( 'No transpose', 'Conjugate transpose',
      $                 LASTV-K, LASTC, K,       $                 LASTV-K, LASTC, K,
Line 306 Line 331
      $                 ONE, C, LDC )       $                 ONE, C, LDC )
                END IF                 END IF
 *  *
 *              W := W * V2'  *              W := W * V2**H
 *  *
                CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',                 CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
      $              'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,       $              'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
      $              WORK, LDWORK )       $              WORK, LDWORK )
 *  *
 *              C2 := C2 - W'  *              C2 := C2 - W**H
 *  *
                DO 90 J = 1, K                 DO 90 J = 1, K
                   DO 80 I = 1, LASTC                    DO 80 I = 1, LASTC
Line 323 Line 348
 *  *
             ELSE IF( LSAME( SIDE, 'R' ) ) THEN              ELSE IF( LSAME( SIDE, 'R' ) ) THEN
 *  *
 *              Form  C * H  or  C * H'  where  C = ( C1  C2 )  *              Form  C * H  or  C * H**H  where  C = ( C1  C2 )
 *  *
                LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )                 LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )
                LASTC = ILAZLR( M, LASTV, C, LDC )                 LASTC = ILAZLR( M, LASTV, C, LDC )
Line 351 Line 376
      $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )       $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
                END IF                 END IF
 *  *
 *              W := W * T  or  W * T'  *              W := W * T  or  W * T**H
 *  *
                CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',                 CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )       $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
 *  *
 *              C := C - W * V'  *              C := C - W * V**H
 *  *
                IF( LASTV.GT.K ) THEN                 IF( LASTV.GT.K ) THEN
 *  *
 *                 C1 := C1 - W * V1'  *                 C1 := C1 - W * V1**H
 *  *
                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',                    CALL ZGEMM( 'No transpose', 'Conjugate transpose',
      $                 LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,       $                 LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
      $                 ONE, C, LDC )       $                 ONE, C, LDC )
                END IF                 END IF
 *  *
 *              W := W * V2'  *              W := W * V2**H
 *  *
                CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',                 CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
      $              'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,       $              'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
Line 393 Line 418
 *  *
             IF( LSAME( SIDE, 'L' ) ) THEN              IF( LSAME( SIDE, 'L' ) ) THEN
 *  *
 *              Form  H * C  or  H' * C  where  C = ( C1 )  *              Form  H * C  or  H**H * C  where  C = ( C1 )
 *                                                  ( C2 )  *                                                    ( C2 )
 *  *
                LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )                 LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
                LASTC = ILAZLC( LASTV, N, C, LDC )                 LASTC = ILAZLC( LASTV, N, C, LDC )
 *  *
 *              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)  *              W := C**H * V**H  =  (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
 *  *
 *              W := C1'  *              W := C1**H
 *  *
                DO 130 J = 1, K                 DO 130 J = 1, K
                   CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )                    CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
                   CALL ZLACGV( LASTC, WORK( 1, J ), 1 )                    CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
   130          CONTINUE    130          CONTINUE
 *  *
 *              W := W * V1'  *              W := W * V1**H
 *  *
                CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',                 CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
      $                     'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )       $                     'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
                IF( LASTV.GT.K ) THEN                 IF( LASTV.GT.K ) THEN
 *  *
 *                 W := W + C2'*V2'  *                 W := W + C2**H*V2**H
 *  *
                   CALL ZGEMM( 'Conjugate transpose',                    CALL ZGEMM( 'Conjugate transpose',
      $                 'Conjugate transpose', LASTC, K, LASTV-K,       $                 'Conjugate transpose', LASTC, K, LASTV-K,
Line 422 Line 447
      $                 ONE, WORK, LDWORK )       $                 ONE, WORK, LDWORK )
                END IF                 END IF
 *  *
 *              W := W * T'  or  W * T  *              W := W * T**H  or  W * T
 *  *
                CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',                 CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )       $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
 *  *
 *              C := C - V' * W'  *              C := C - V**H * W**H
 *  *
                IF( LASTV.GT.K ) THEN                 IF( LASTV.GT.K ) THEN
 *  *
 *                 C2 := C2 - V2' * W'  *                 C2 := C2 - V2**H * W**H
 *  *
                   CALL ZGEMM( 'Conjugate transpose',                    CALL ZGEMM( 'Conjugate transpose',
      $                 'Conjugate transpose', LASTV-K, LASTC, K,       $                 'Conjugate transpose', LASTV-K, LASTC, K,
Line 444 Line 469
                CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',                 CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
      $              LASTC, K, ONE, V, LDV, WORK, LDWORK )       $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
 *  *
 *              C1 := C1 - W'  *              C1 := C1 - W**H
 *  *
                DO 150 J = 1, K                 DO 150 J = 1, K
                   DO 140 I = 1, LASTC                    DO 140 I = 1, LASTC
Line 454 Line 479
 *  *
             ELSE IF( LSAME( SIDE, 'R' ) ) THEN              ELSE IF( LSAME( SIDE, 'R' ) ) THEN
 *  *
 *              Form  C * H  or  C * H'  where  C = ( C1  C2 )  *              Form  C * H  or  C * H**H  where  C = ( C1  C2 )
 *  *
                LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )                 LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
                LASTC = ILAZLR( M, LASTV, C, LDC )                 LASTC = ILAZLR( M, LASTV, C, LDC )
 *  *
 *              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)  *              W := C * V**H  =  (C1*V1**H + C2*V2**H)  (stored in WORK)
 *  *
 *              W := C1  *              W := C1
 *  *
Line 467 Line 492
                   CALL ZCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )                    CALL ZCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
   160          CONTINUE    160          CONTINUE
 *  *
 *              W := W * V1'  *              W := W * V1**H
 *  *
                CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',                 CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
      $                     'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )       $                     'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
                IF( LASTV.GT.K ) THEN                 IF( LASTV.GT.K ) THEN
 *  *
 *                 W := W + C2 * V2'  *                 W := W + C2 * V2**H
 *  *
                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',                    CALL ZGEMM( 'No transpose', 'Conjugate transpose',
      $                 LASTC, K, LASTV-K, ONE, C( 1, K+1 ), LDC,       $                 LASTC, K, LASTV-K, ONE, C( 1, K+1 ), LDC,
      $                 V( 1, K+1 ), LDV, ONE, WORK, LDWORK )       $                 V( 1, K+1 ), LDV, ONE, WORK, LDWORK )
                END IF                 END IF
 *  *
 *              W := W * T  or  W * T'  *              W := W * T  or  W * T**H
 *  *
                CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',                 CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )       $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
Line 519 Line 544
 *  *
             IF( LSAME( SIDE, 'L' ) ) THEN              IF( LSAME( SIDE, 'L' ) ) THEN
 *  *
 *              Form  H * C  or  H' * C  where  C = ( C1 )  *              Form  H * C  or  H**H * C  where  C = ( C1 )
 *                                                  ( C2 )  *                                                    ( C2 )
 *  *
                LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )                 LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
                LASTC = ILAZLC( LASTV, N, C, LDC )                 LASTC = ILAZLC( LASTV, N, C, LDC )
 *  *
 *              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)  *              W := C**H * V**H  =  (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
 *  *
 *              W := C2'  *              W := C2**H
 *  *
                DO 190 J = 1, K                 DO 190 J = 1, K
                   CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,                    CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
Line 535 Line 560
                   CALL ZLACGV( LASTC, WORK( 1, J ), 1 )                    CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
   190          CONTINUE    190          CONTINUE
 *  *
 *              W := W * V2'  *              W := W * V2**H
 *  *
                CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',                 CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
      $              'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,       $              'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
      $              WORK, LDWORK )       $              WORK, LDWORK )
                IF( LASTV.GT.K ) THEN                 IF( LASTV.GT.K ) THEN
 *  *
 *                 W := W + C1'*V1'  *                 W := W + C1**H * V1**H
 *  *
                   CALL ZGEMM( 'Conjugate transpose',                    CALL ZGEMM( 'Conjugate transpose',
      $                 'Conjugate transpose', LASTC, K, LASTV-K,       $                 'Conjugate transpose', LASTC, K, LASTV-K,
      $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )       $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
                END IF                 END IF
 *  *
 *              W := W * T'  or  W * T  *              W := W * T**H  or  W * T
 *  *
                CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',                 CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )       $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
 *  *
 *              C := C - V' * W'  *              C := C - V**H * W**H
 *  *
                IF( LASTV.GT.K ) THEN                 IF( LASTV.GT.K ) THEN
 *  *
 *                 C1 := C1 - V1' * W'  *                 C1 := C1 - V1**H * W**H
 *  *
                   CALL ZGEMM( 'Conjugate transpose',                    CALL ZGEMM( 'Conjugate transpose',
      $                 'Conjugate transpose', LASTV-K, LASTC, K,       $                 'Conjugate transpose', LASTV-K, LASTC, K,
Line 571 Line 596
      $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,       $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
      $              WORK, LDWORK )       $              WORK, LDWORK )
 *  *
 *              C2 := C2 - W'  *              C2 := C2 - W**H
 *  *
                DO 210 J = 1, K                 DO 210 J = 1, K
                   DO 200 I = 1, LASTC                    DO 200 I = 1, LASTC
Line 582 Line 607
 *  *
             ELSE IF( LSAME( SIDE, 'R' ) ) THEN              ELSE IF( LSAME( SIDE, 'R' ) ) THEN
 *  *
 *              Form  C * H  or  C * H'  where  C = ( C1  C2 )  *              Form  C * H  or  C * H**H  where  C = ( C1  C2 )
 *  *
                LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )                 LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
                LASTC = ILAZLR( M, LASTV, C, LDC )                 LASTC = ILAZLR( M, LASTV, C, LDC )
 *  *
 *              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)  *              W := C * V**H  =  (C1*V1**H + C2*V2**H)  (stored in WORK)
 *  *
 *              W := C2  *              W := C2
 *  *
Line 596 Line 621
      $                 WORK( 1, J ), 1 )       $                 WORK( 1, J ), 1 )
   220          CONTINUE    220          CONTINUE
 *  *
 *              W := W * V2'  *              W := W * V2**H
 *  *
                CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',                 CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
      $              'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,       $              'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
      $              WORK, LDWORK )       $              WORK, LDWORK )
                IF( LASTV.GT.K ) THEN                 IF( LASTV.GT.K ) THEN
 *  *
 *                 W := W + C1 * V1'  *                 W := W + C1 * V1**H
 *  *
                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',                    CALL ZGEMM( 'No transpose', 'Conjugate transpose',
      $                 LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, ONE,       $                 LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, ONE,
      $                 WORK, LDWORK )       $                 WORK, LDWORK )
                END IF                 END IF
 *  *
 *              W := W * T  or  W * T'  *              W := W * T  or  W * T**H
 *  *
                CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',                 CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )       $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
Removed from v.1.7  
changed lines
  Added in v.1.8

CVSweb interface <joel.bertrand@systella.fr>