[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.11 and 1.12

version 1.11, 2012/08/22 09:48:37 version 1.12, 2012/12/14 12:30:33
Line 1 Line 1
 *> \brief \b ZLARFB  *> \brief \b ZLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix.
 *  *
 *  =========== DOCUMENTATION ===========  *  =========== DOCUMENTATION ===========
 *  *
Line 159 Line 159
 *> \author Univ. of Colorado Denver   *> \author Univ. of Colorado Denver 
 *> \author NAG Ltd.   *> \author NAG Ltd. 
 *  *
 *> \date November 2011  *> \date September 2012
 *  *
 *> \ingroup complex16OTHERauxiliary  *> \ingroup complex16OTHERauxiliary
 *  *
Line 195 Line 195
       SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,        SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
      $                   T, LDT, C, LDC, WORK, LDWORK )       $                   T, LDT, C, LDC, WORK, LDWORK )
 *  *
 *  -- LAPACK auxiliary routine (version 3.4.0) --  *  -- LAPACK auxiliary routine (version 3.4.2) --
 *  -- 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 2011  *     September 2012
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       CHARACTER          DIRECT, SIDE, STOREV, TRANS        CHARACTER          DIRECT, SIDE, STOREV, TRANS
Line 382 Line 382
 *              Form  H * C  or  H**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 ) )                 LASTC = ILAZLC( M, N, C, LDC )
                LASTC = ILAZLC( LASTV, N, C, LDC )  
 *  *
 *              W := C**H * V  =  (C1**H * V1 + C2**H * V2)  (stored in WORK)  *              W := C**H * V  =  (C1**H * V1 + C2**H * V2)  (stored in WORK)
 *  *
 *              W := C2**H  *              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( M-K+J, 1 ), LDC,
      $                 WORK( 1, J ), 1 )       $                 WORK( 1, J ), 1 )
                   CALL ZLACGV( LASTC, WORK( 1, J ), 1 )                    CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
    70          CONTINUE     70          CONTINUE
Line 398 Line 397
 *              W := W * V2  *              W := W * V2
 *  *
                CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',                 CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
      $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,       $              LASTC, K, ONE, V( M-K+1, 1 ), LDV,
      $              WORK, LDWORK )       $              WORK, LDWORK )
                IF( LASTV.GT.K ) THEN                 IF( M.GT.K ) THEN
 *  *
 *                 W := W + C1**H*V1  *                 W := W + C1**H*V1
 *  *
                   CALL ZGEMM( 'Conjugate transpose', 'No transpose',                    CALL ZGEMM( 'Conjugate transpose', 'No transpose',
      $                 LASTC, K, LASTV-K,       $                 LASTC, K, M-K,
      $                 ONE, C, LDC, V, LDV,       $                 ONE, C, LDC, V, LDV,
      $                 ONE, WORK, LDWORK )       $                 ONE, WORK, LDWORK )
                END IF                 END IF
Line 417 Line 416
 *  *
 *              C := C - V * W**H  *              C := C - V * W**H
 *  *
                IF( LASTV.GT.K ) THEN                 IF( M.GT.K ) THEN
 *  *
 *                 C1 := C1 - V1 * W**H  *                 C1 := C1 - V1 * W**H
 *  *
                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',                    CALL ZGEMM( 'No transpose', 'Conjugate transpose',
      $                 LASTV-K, LASTC, K,       $                 M-K, LASTC, K,
      $                 -ONE, V, LDV, WORK, LDWORK,       $                 -ONE, V, LDV, WORK, LDWORK,
      $                 ONE, C, LDC )       $                 ONE, C, LDC )
                END IF                 END IF
Line 430 Line 429
 *              W := W * V2**H  *              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( M-K+1, 1 ), LDV,
      $              WORK, LDWORK )       $              WORK, LDWORK )
 *  *
 *              C2 := C2 - W**H  *              C2 := C2 - W**H
 *  *
                DO 90 J = 1, K                 DO 90 J = 1, K
                   DO 80 I = 1, LASTC                    DO 80 I = 1, LASTC
                      C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -                       C( M-K+J, I ) = C( M-K+J, I ) -
      $                               DCONJG( WORK( I, J ) )       $                               DCONJG( WORK( I, J ) )
    80             CONTINUE     80             CONTINUE
    90          CONTINUE     90          CONTINUE
Line 446 Line 445
 *  *
 *              Form  C * H  or  C * H**H  where  C = ( C1  C2 )  *              Form  C * H  or  C * H**H  where  C = ( C1  C2 )
 *  *
                LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )                 LASTC = ILAZLR( M, N, C, LDC )
                LASTC = ILAZLR( M, LASTV, C, LDC )  
 *  *
 *              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)  *              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
 *  *
 *              W := C2  *              W := C2
 *  *
                DO 100 J = 1, K                 DO 100 J = 1, K
                   CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,                    CALL ZCOPY( LASTC, C( 1, N-K+J ), 1,
      $                 WORK( 1, J ), 1 )       $                 WORK( 1, J ), 1 )
   100          CONTINUE    100          CONTINUE
 *  *
 *              W := W * V2  *              W := W * V2
 *  *
                CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',                 CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
      $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,       $              LASTC, K, ONE, V( N-K+1, 1 ), LDV,
      $              WORK, LDWORK )       $              WORK, LDWORK )
                IF( LASTV.GT.K ) THEN                 IF( N.GT.K ) THEN
 *  *
 *                 W := W + C1 * V1  *                 W := W + C1 * V1
 *  *
                   CALL ZGEMM( 'No transpose', 'No transpose',                    CALL ZGEMM( 'No transpose', 'No transpose',
      $                 LASTC, K, LASTV-K,       $                 LASTC, K, N-K,
      $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )       $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
                END IF                 END IF
 *  *
Line 479 Line 477
 *  *
 *              C := C - W * V**H  *              C := C - W * V**H
 *  *
                IF( LASTV.GT.K ) THEN                 IF( N.GT.K ) THEN
 *  *
 *                 C1 := C1 - W * V1**H  *                 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, N-K, K, -ONE, WORK, LDWORK, V, LDV,
      $                 ONE, C, LDC )       $                 ONE, C, LDC )
                END IF                 END IF
 *  *
 *              W := W * V2**H  *              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( N-K+1, 1 ), LDV,
      $              WORK, LDWORK )       $              WORK, LDWORK )
 *  *
 *              C2 := C2 - W  *              C2 := C2 - W
 *  *
                DO 120 J = 1, K                 DO 120 J = 1, K
                   DO 110 I = 1, LASTC                    DO 110 I = 1, LASTC
                      C( I, LASTV-K+J ) = C( I, LASTV-K+J )                       C( I, N-K+J ) = C( I, N-K+J )
      $                    - WORK( I, J )       $                    - WORK( I, J )
   110             CONTINUE    110             CONTINUE
   120          CONTINUE    120          CONTINUE
Line 643 Line 641
 *              Form  H * C  or  H**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 ) )                 LASTC = ILAZLC( M, N, C, LDC )
                LASTC = ILAZLC( LASTV, N, C, LDC )  
 *  *
 *              W := C**H * V**H  =  (C1**H * V1**H + C2**H * V2**H) (stored in WORK)  *              W := C**H * V**H  =  (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
 *  *
 *              W := C2**H  *              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( M-K+J, 1 ), LDC,
      $                 WORK( 1, J ), 1 )       $                 WORK( 1, J ), 1 )
                   CALL ZLACGV( LASTC, WORK( 1, J ), 1 )                    CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
   190          CONTINUE    190          CONTINUE
Line 659 Line 656
 *              W := W * V2**H  *              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, M-K+1 ), LDV,
      $              WORK, LDWORK )       $              WORK, LDWORK )
                IF( LASTV.GT.K ) THEN                 IF( M.GT.K ) THEN
 *  *
 *                 W := W + C1**H * V1**H  *                 W := W + C1**H * V1**H
 *  *
                   CALL ZGEMM( 'Conjugate transpose',                    CALL ZGEMM( 'Conjugate transpose',
      $                 'Conjugate transpose', LASTC, K, LASTV-K,       $                 'Conjugate transpose', LASTC, K, M-K,
      $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )       $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
                END IF                 END IF
 *  *
Line 677 Line 674
 *  *
 *              C := C - V**H * W**H  *              C := C - V**H * W**H
 *  *
                IF( LASTV.GT.K ) THEN                 IF( M.GT.K ) THEN
 *  *
 *                 C1 := C1 - V1**H * W**H  *                 C1 := C1 - V1**H * W**H
 *  *
                   CALL ZGEMM( 'Conjugate transpose',                    CALL ZGEMM( 'Conjugate transpose',
      $                 'Conjugate transpose', LASTV-K, LASTC, K,       $                 'Conjugate transpose', M-K, LASTC, K,
      $                 -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )       $                 -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
                END IF                 END IF
 *  *
 *              W := W * V2  *              W := W * V2
 *  *
                CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',                 CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
      $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,       $              LASTC, K, ONE, V( 1, M-K+1 ), LDV,
      $              WORK, LDWORK )       $              WORK, LDWORK )
 *  *
 *              C2 := C2 - W**H  *              C2 := C2 - W**H
 *  *
                DO 210 J = 1, K                 DO 210 J = 1, K
                   DO 200 I = 1, LASTC                    DO 200 I = 1, LASTC
                      C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -                       C( M-K+J, I ) = C( M-K+J, I ) -
      $                               DCONJG( WORK( I, J ) )       $                               DCONJG( WORK( I, J ) )
   200             CONTINUE    200             CONTINUE
   210          CONTINUE    210          CONTINUE
Line 705 Line 702
 *  *
 *              Form  C * H  or  C * H**H  where  C = ( C1  C2 )  *              Form  C * H  or  C * H**H  where  C = ( C1  C2 )
 *  *
                LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )                 LASTC = ILAZLR( M, N, C, LDC )
                LASTC = ILAZLR( M, LASTV, C, LDC )  
 *  *
 *              W := C * V**H  =  (C1*V1**H + C2*V2**H)  (stored in WORK)  *              W := C * V**H  =  (C1*V1**H + C2*V2**H)  (stored in WORK)
 *  *
 *              W := C2  *              W := C2
 *  *
                DO 220 J = 1, K                 DO 220 J = 1, K
                   CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,                    CALL ZCOPY( LASTC, C( 1, N-K+J ), 1,
      $                 WORK( 1, J ), 1 )       $                 WORK( 1, J ), 1 )
   220          CONTINUE    220          CONTINUE
 *  *
 *              W := W * V2**H  *              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, N-K+1 ), LDV,
      $              WORK, LDWORK )       $              WORK, LDWORK )
                IF( LASTV.GT.K ) THEN                 IF( N.GT.K ) THEN
 *  *
 *                 W := W + C1 * V1**H  *                 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, N-K, ONE, C, LDC, V, LDV, ONE,
      $                 WORK, LDWORK )       $                 WORK, LDWORK )
                END IF                 END IF
 *  *
Line 738 Line 734
 *  *
 *              C := C - W * V  *              C := C - W * V
 *  *
                IF( LASTV.GT.K ) THEN                 IF( N.GT.K ) THEN
 *  *
 *                 C1 := C1 - W * V1  *                 C1 := C1 - W * V1
 *  *
                   CALL ZGEMM( 'No transpose', 'No transpose',                    CALL ZGEMM( 'No transpose', 'No transpose',
      $                 LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,       $                 LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
      $                 ONE, C, LDC )       $                 ONE, C, LDC )
                END IF                 END IF
 *  *
 *              W := W * V2  *              W := W * V2
 *  *
                CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',                 CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
      $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,       $              LASTC, K, ONE, V( 1, N-K+1 ), LDV,
      $              WORK, LDWORK )       $              WORK, LDWORK )
 *  *
 *              C1 := C1 - W  *              C1 := C1 - W
 *  *
                DO 240 J = 1, K                 DO 240 J = 1, K
                   DO 230 I = 1, LASTC                    DO 230 I = 1, LASTC
                      C( I, LASTV-K+J ) = C( I, LASTV-K+J )                       C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
      $                    - WORK( I, J )  
   230             CONTINUE    230             CONTINUE
   240          CONTINUE    240          CONTINUE
 *  *
Removed from v.1.11  
changed lines
  Added in v.1.12

CVSweb interface <joel.bertrand@systella.fr>