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

Diff for /rpl/lapack/lapack/dlaqr5.f between versions 1.6 and 1.9

version 1.6, 2010/08/13 21:03:50 version 1.9, 2011/07/22 07:38:07
Line 2 Line 2
      $                   SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U,       $                   SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U,
      $                   LDU, NV, WV, LDWV, NH, WH, LDWH )       $                   LDU, NV, WV, LDWV, NH, WH, LDWH )
 *  *
 *  -- LAPACK auxiliary routine (version 3.2) --  *  -- LAPACK auxiliary routine (version 3.3.0) --
 *  -- 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  *     November 2010
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       INTEGER            IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV,        INTEGER            IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV,
Line 453 Line 453
 *           ==== Special case: 2-by-2 reflection (if needed) ====  *           ==== Special case: 2-by-2 reflection (if needed) ====
 *  *
             K = KRCOL + 3*( M22-1 )              K = KRCOL + 3*( M22-1 )
             IF( BMP22 .AND. ( V( 1, M22 ).NE.ZERO ) ) THEN              IF( BMP22 ) THEN
                DO 100 J = JTOP, MIN( KBOT, K+3 )                 IF ( V( 1, M22 ).NE.ZERO ) THEN
                   REFSUM = V( 1, M22 )*( H( J, K+1 )+V( 2, M22 )*                    DO 100 J = JTOP, MIN( KBOT, K+3 )
      $                     H( J, K+2 ) )                       REFSUM = V( 1, M22 )*( H( J, K+1 )+V( 2, M22 )*
                   H( J, K+1 ) = H( J, K+1 ) - REFSUM       $                        H( J, K+2 ) )
                   H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M22 )                       H( J, K+1 ) = H( J, K+1 ) - REFSUM
   100          CONTINUE                       H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M22 )
 *    100             CONTINUE
                IF( ACCUM ) THEN  *
                   KMS = K - INCOL                    IF( ACCUM ) THEN
                   DO 110 J = MAX( 1, KTOP-INCOL ), KDU                       KMS = K - INCOL
                      REFSUM = V( 1, M22 )*( U( J, KMS+1 )+V( 2, M22 )*                       DO 110 J = MAX( 1, KTOP-INCOL ), KDU
      $                        U( J, KMS+2 ) )                          REFSUM = V( 1, M22 )*( U( J, KMS+1 )+
                      U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM       $                           V( 2, M22 )*U( J, KMS+2 ) )
                      U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*V( 2, M22 )                          U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
                           U( J, KMS+2 ) = U( J, KMS+2 ) -
        $                                  REFSUM*V( 2, M22 )
   110             CONTINUE    110             CONTINUE
                ELSE IF( WANTZ ) THEN                    ELSE IF( WANTZ ) THEN
                   DO 120 J = ILOZ, IHIZ                       DO 120 J = ILOZ, IHIZ
                      REFSUM = V( 1, M22 )*( Z( J, K+1 )+V( 2, M22 )*                          REFSUM = V( 1, M22 )*( Z( J, K+1 )+V( 2, M22 )*
      $                        Z( J, K+2 ) )       $                           Z( J, K+2 ) )
                      Z( J, K+1 ) = Z( J, K+1 ) - REFSUM                          Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
                      Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M22 )                          Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M22 )
   120             CONTINUE    120                CONTINUE
                     END IF
                END IF                 END IF
             END IF              END IF
 *  *
Line 639 Line 642
                   CALL DLACPY( 'ALL', KNZ, JLEN, H( INCOL+1+J2, JCOL ),                    CALL DLACPY( 'ALL', KNZ, JLEN, H( INCOL+1+J2, JCOL ),
      $                         LDH, WH( KZS+1, 1 ), LDWH )       $                         LDH, WH( KZS+1, 1 ), LDWH )
 *  *
 *                 ==== Multiply by U21' ====  *                 ==== Multiply by U21**T ====
 *  *
                   CALL DLASET( 'ALL', KZS, JLEN, ZERO, ZERO, WH, LDWH )                    CALL DLASET( 'ALL', KZS, JLEN, ZERO, ZERO, WH, LDWH )
                   CALL DTRMM( 'L', 'U', 'C', 'N', KNZ, JLEN, ONE,                    CALL DTRMM( 'L', 'U', 'C', 'N', KNZ, JLEN, ONE,
      $                        U( J2+1, 1+KZS ), LDU, WH( KZS+1, 1 ),       $                        U( J2+1, 1+KZS ), LDU, WH( KZS+1, 1 ),
      $                        LDWH )       $                        LDWH )
 *  *
 *                 ==== Multiply top of H by U11' ====  *                 ==== Multiply top of H by U11**T ====
 *  *
                   CALL DGEMM( 'C', 'N', I2, JLEN, J2, ONE, U, LDU,                    CALL DGEMM( 'C', 'N', I2, JLEN, J2, ONE, U, LDU,
      $                        H( INCOL+1, JCOL ), LDH, ONE, WH, LDWH )       $                        H( INCOL+1, JCOL ), LDH, ONE, WH, LDWH )
Line 656 Line 659
                   CALL DLACPY( 'ALL', J2, JLEN, H( INCOL+1, JCOL ), LDH,                    CALL DLACPY( 'ALL', J2, JLEN, H( INCOL+1, JCOL ), LDH,
      $                         WH( I2+1, 1 ), LDWH )       $                         WH( I2+1, 1 ), LDWH )
 *  *
 *                 ==== Multiply by U21' ====  *                 ==== Multiply by U21**T ====
 *  *
                   CALL DTRMM( 'L', 'L', 'C', 'N', J2, JLEN, ONE,                    CALL DTRMM( 'L', 'L', 'C', 'N', J2, JLEN, ONE,
      $                        U( 1, I2+1 ), LDU, WH( I2+1, 1 ), LDWH )       $                        U( 1, I2+1 ), LDU, WH( I2+1, 1 ), LDWH )
Removed from v.1.6  
changed lines
  Added in v.1.9

CVSweb interface <joel.bertrand@systella.fr>