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

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

version 1.7, 2010/12/21 13:53:32 version 1.8, 2011/07/22 07:38:07
Line 1 Line 1
       SUBROUTINE DLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,        SUBROUTINE DLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
      $                   LDV, T, LDT, C, LDC, WORK, LDWORK )       $                   LDV, T, LDT, C, LDC, WORK, LDWORK )
 *  *
 *  -- LAPACK routine (version 3.2) --  *  -- LAPACK 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 27 Line 27
 *  =========  *  =========
 *  *
 *  SIDE    (input) CHARACTER*1  *  SIDE    (input) CHARACTER*1
 *          = 'L': apply H or H' from the Left  *          = 'L': apply H or H**T from the Left
 *          = 'R': apply H or H' from the Right  *          = 'R': apply H or H**T from the Right
 *  *
 *  TRANS   (input) CHARACTER*1  *  TRANS   (input) CHARACTER*1
 *          = 'N': apply H (No transpose)  *          = 'N': apply H (No transpose)
 *          = 'C': apply H' (Transpose)  *          = 'C': apply H**T (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 77 Line 77
 *  *
 *  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)  *  C       (input/output) DOUBLE PRECISION 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**T*C or C*H or C*H**T.
 *  *
 *  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 140 Line 140
 *  *
       IF( LSAME( SIDE, 'L' ) ) THEN        IF( LSAME( SIDE, 'L' ) ) THEN
 *  *
 *        Form  H * C  or  H' * C  *        Form  H * C  or  H**T * C
 *  *
 *        W( 1:n, 1:k ) = C( 1:k, 1:n )'  *        W( 1:n, 1:k ) = C( 1:k, 1:n )**T
 *  *
          DO 10 J = 1, K           DO 10 J = 1, K
             CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )              CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
    10    CONTINUE     10    CONTINUE
 *  *
 *        W( 1:n, 1:k ) = W( 1:n, 1:k ) + ...  *        W( 1:n, 1:k ) = W( 1:n, 1:k ) + ...
 *                        C( m-l+1:m, 1:n )' * V( 1:k, 1:l )'  *                        C( m-l+1:m, 1:n )**T * V( 1:k, 1:l )**T
 *  *
          IF( L.GT.0 )           IF( L.GT.0 )
      $      CALL DGEMM( 'Transpose', 'Transpose', N, K, L, ONE,       $      CALL DGEMM( 'Transpose', 'Transpose', N, K, L, ONE,
      $                  C( M-L+1, 1 ), LDC, V, LDV, ONE, WORK, LDWORK )       $                  C( M-L+1, 1 ), LDC, V, LDV, ONE, WORK, LDWORK )
 *  *
 *        W( 1:n, 1:k ) = W( 1:n, 1:k ) * T'  or  W( 1:m, 1:k ) * T  *        W( 1:n, 1:k ) = W( 1:n, 1:k ) * T**T  or  W( 1:m, 1:k ) * T
 *  *
          CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, T,           CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, T,
      $               LDT, WORK, LDWORK )       $               LDT, WORK, LDWORK )
 *  *
 *        C( 1:k, 1:n ) = C( 1:k, 1:n ) - W( 1:n, 1:k )'  *        C( 1:k, 1:n ) = C( 1:k, 1:n ) - W( 1:n, 1:k )**T
 *  *
          DO 30 J = 1, N           DO 30 J = 1, N
             DO 20 I = 1, K              DO 20 I = 1, K
Line 169 Line 169
    30    CONTINUE     30    CONTINUE
 *  *
 *        C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...  *        C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
 *                            V( 1:k, 1:l )' * W( 1:n, 1:k )'  *                            V( 1:k, 1:l )**T * W( 1:n, 1:k )**T
 *  *
          IF( L.GT.0 )           IF( L.GT.0 )
      $      CALL DGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, LDV,       $      CALL DGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, LDV,
Line 177 Line 177
 *  *
       ELSE IF( LSAME( SIDE, 'R' ) ) THEN        ELSE IF( LSAME( SIDE, 'R' ) ) THEN
 *  *
 *        Form  C * H  or  C * H'  *        Form  C * H  or  C * H**T
 *  *
 *        W( 1:m, 1:k ) = C( 1:m, 1:k )  *        W( 1:m, 1:k ) = C( 1:m, 1:k )
 *  *
Line 186 Line 186
    40    CONTINUE     40    CONTINUE
 *  *
 *        W( 1:m, 1:k ) = W( 1:m, 1:k ) + ...  *        W( 1:m, 1:k ) = W( 1:m, 1:k ) + ...
 *                        C( 1:m, n-l+1:n ) * V( 1:k, 1:l )'  *                        C( 1:m, n-l+1:n ) * V( 1:k, 1:l )**T
 *  *
          IF( L.GT.0 )           IF( L.GT.0 )
      $      CALL DGEMM( 'No transpose', 'Transpose', M, K, L, ONE,       $      CALL DGEMM( 'No transpose', 'Transpose', M, K, L, ONE,
      $                  C( 1, N-L+1 ), LDC, V, LDV, ONE, WORK, LDWORK )       $                  C( 1, N-L+1 ), LDC, V, LDV, ONE, WORK, LDWORK )
 *  *
 *        W( 1:m, 1:k ) = W( 1:m, 1:k ) * T  or  W( 1:m, 1:k ) * T'  *        W( 1:m, 1:k ) = W( 1:m, 1:k ) * T  or  W( 1:m, 1:k ) * T**T
 *  *
          CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, T,           CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, T,
      $               LDT, WORK, LDWORK )       $               LDT, WORK, LDWORK )
Removed from v.1.7  
changed lines
  Added in v.1.8

CVSweb interface <joel.bertrand@systella.fr>