Provided by: liblapack-doc_3.3.1-1_all bug

NAME

SYNOPSIS

       SUBROUTINE CLAQR3( WANTT,  WANTZ,  N,  KTOP, KBOT, NW, H, LDH, ILOZ, IHIZ, Z, LDZ, NS, ND,
                          SH, V, LDV, NH, T, LDT, NV, WV, LDWV, WORK, LWORK )

           INTEGER        IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV, LDZ, LWORK, N, ND, NH, NS,
                          NV, NW

           LOGICAL        WANTT, WANTZ

           COMPLEX        H(  LDH, * ), SH( * ), T( LDT, * ), V( LDV, * ), WORK( * ), WV( LDWV, *
                          ), Z( LDZ, * )

           COMPLEX        ZERO, ONE

           PARAMETER      ( ZERO = ( 0.0e0, 0.0e0 ), ONE = ( 1.0e0, 0.0e0 ) )

           REAL           RZERO, RONE

           PARAMETER      ( RZERO = 0.0e0, RONE = 1.0e0 )

           COMPLEX        BETA, CDUM, S, TAU

           REAL           FOO, SAFMAX, SAFMIN, SMLNUM, ULP

           INTEGER        I, IFST, ILST, INFO, INFQR, J, JW, KCOL, KLN, KNT, KROW,  KWTOP,  LTOP,
                          LWK1, LWK2, LWK3, LWKOPT, NMIN

           REAL           SLAMCH

           INTEGER        ILAENV

           EXTERNAL       SLAMCH, ILAENV

           EXTERNAL       CCOPY,  CGEHRD,  CGEMM,  CLACPY, CLAHQR, CLAQR4, CLARF, CLARFG, CLASET,
                          CTREXC, CUNMHR, SLABAD

           INTRINSIC      ABS, AIMAG, CMPLX, CONJG, INT, MAX, MIN, REAL

           REAL           CABS1

           CABS1(         CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) )

           JW             = MIN( NW, KBOT-KTOP+1 )

           IF(            JW.LE.2 ) THEN

           LWKOPT         = 1

           ELSE

           CALL           CGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )

           LWK1           = INT( WORK( 1 ) )

           CALL           CUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV, WORK, -1, INFO
                          )

           LWK2           = INT( WORK( 1 ) )

           CALL           CLAQR4( .true., .true., JW, 1, JW, T, LDT, SH, 1, JW, V, LDV, WORK, -1,
                          INFQR )

           LWK3           = INT( WORK( 1 ) )

           LWKOPT         = MAX( JW+MAX( LWK1, LWK2 ), LWK3 )

           END            IF

           IF(            LWORK.EQ.-1 ) THEN

           WORK(          1 ) = CMPLX( LWKOPT, 0 )

           RETURN

           END            IF

           NS             = 0

           ND             = 0

           WORK(          1 ) = ONE

           IF(            KTOP.GT.KBOT ) RETURN

           IF(            NW.LT.1 ) RETURN

           SAFMIN         = SLAMCH( 'SAFE MINIMUM' )

           SAFMAX         = RONE / SAFMIN

           CALL           SLABAD( SAFMIN, SAFMAX )

           ULP            = SLAMCH( 'PRECISION' )

           SMLNUM         = SAFMIN*( REAL( N ) / ULP )

           JW             = MIN( NW, KBOT-KTOP+1 )

           KWTOP          = KBOT - JW + 1

           IF(            KWTOP.EQ.KTOP ) THEN

           S              = ZERO

           ELSE

           S              = H( KWTOP, KWTOP-1 )

           END            IF

           IF(            KBOT.EQ.KWTOP ) THEN

           SH(            KWTOP ) = H( KWTOP, KWTOP )

           NS             = 1

           ND             = 0

           IF(            CABS1( S ).LE.MAX( SMLNUM, ULP*CABS1( H( KWTOP, KWTOP ) ) ) ) THEN

           NS             = 0

           ND             = 1

           IF(            KWTOP.GT.KTOP ) H( KWTOP, KWTOP-1 ) = ZERO

           END            IF

           WORK(          1 ) = ONE

           RETURN

           END            IF

           CALL           CLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )

           CALL           CCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )

           CALL           CLASET( 'A', JW, JW, ZERO, ONE, V, LDV )

           NMIN           = ILAENV( 12, 'CLAQR3', 'SV', JW, 1, JW, LWORK )

           IF(            JW.GT.NMIN ) THEN

           CALL           CLAQR4( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1, JW, V,  LDV,
                          WORK, LWORK, INFQR )

           ELSE

           CALL           CLAHQR(  .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1, JW, V, LDV,
                          INFQR )

           END            IF

           NS             = JW

           ILST           = INFQR + 1

           DO             10 KNT = INFQR + 1, JW

           FOO            = CABS1( T( NS, NS ) )

           IF(            FOO.EQ.RZERO ) FOO = CABS1( S )

           IF(            CABS1( S )*CABS1( V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) ) THEN

           NS             = NS - 1

           ELSE

           IFST           = NS

           CALL           CTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )

           ILST           = ILST + 1

           END            IF

           10             CONTINUE

           IF(            NS.EQ.0 ) S = ZERO

           IF(            NS.LT.JW ) THEN

           DO             30 I = INFQR + 1, NS

           IFST           = I

           DO             20 J = I + 1, NS

           IF(            CABS1( T( J, J ) ).GT.CABS1( T( IFST, IFST ) ) ) IFST = J

           20             CONTINUE

           ILST           = I

           IF(            IFST.NE.ILST ) CALL CTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )

           30             CONTINUE

           END            IF

           DO             40 I = INFQR + 1, JW

           SH(            KWTOP+I-1 ) = T( I, I )

           40             CONTINUE

           IF(            NS.LT.JW .OR. S.EQ.ZERO ) THEN

           IF(            NS.GT.1 .AND. S.NE.ZERO ) THEN

           CALL           CCOPY( NS, V, LDV, WORK, 1 )

           DO             50 I = 1, NS

           WORK(          I ) = CONJG( WORK( I ) )

           50             CONTINUE

           BETA           = WORK( 1 )

           CALL           CLARFG( NS, BETA, WORK( 2 ), 1, TAU )

           WORK(          1 ) = ONE

           CALL           CLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )

           CALL           CLARF( 'L', NS, JW, WORK, 1, CONJG( TAU ), T, LDT, WORK( JW+1 ) )

           CALL           CLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT, WORK( JW+1 ) )

           CALL           CLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV, WORK( JW+1 ) )

           CALL           CGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ), LWORK-JW, INFO )

           END            IF

           IF(            KWTOP.GT.1 ) H( KWTOP, KWTOP-1 ) = S*CONJG( V( 1, 1 ) )

           CALL           CLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )

           CALL           CCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ), LDH+1 )

           IF(            NS.GT.1 .AND. S.NE.ZERO ) CALL CUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT,
                          WORK, V, LDV, WORK( JW+1 ), LWORK-JW, INFO )

           IF(            WANTT ) THEN

           LTOP           = 1

           ELSE

           LTOP           = KTOP

           END            IF

           DO             60 KROW = LTOP, KWTOP - 1, NV

           KLN            = MIN( NV, KWTOP-KROW )

           CALL           CGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ), LDH, V, LDV, ZERO,
                          WV, LDWV )

           CALL           CLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )

           60             CONTINUE

           IF(            WANTT ) THEN

           DO             70 KCOL = KBOT + 1, N, NH

           KLN            = MIN( NH, N-KCOL+1 )

           CALL           CGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV, H( KWTOP, KCOL ), LDH, ZERO,
                          T, LDT )

           CALL           CLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ), LDH )

           70             CONTINUE

           END            IF

           IF(            WANTZ ) THEN

           DO             80 KROW = ILOZ, IHIZ, NV

           KLN            = MIN( NV, IHIZ-KROW+1 )

           CALL           CGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ), LDZ, V, LDV, ZERO,
                          WV, LDWV )

           CALL           CLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ), LDZ )

           80             CONTINUE

           END            IF

           END            IF

           ND             = JW - NS

           NS             = NS - INFQR

           WORK(          1 ) = CMPLX( LWKOPT, 0 )

           END

PURPOSE

 LAPACK auxiliary routine (version 3.2.1)   April 2011                            CLAQR3(3lapack)