slaqr2(l) - Linux man page

Name

Synopsis

SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, IHIZ, Z, LDZ, NS, ND, SR, SI, 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

REAL

H( LDH, * ), SI( * ), SR( * ), T( LDT, * ), V( LDV, * ), WORK( * ), WV( LDWV, * ), Z( LDZ, * )

REAL

ZERO, ONE

PARAMETER

( ZERO = 0.0e0, ONE = 1.0e0 )

REAL

AA, BB, BETA, CC, CS, DD, EVI, EVK, FOO, S, SAFMAX, SAFMIN, SMLNUM, SN, TAU, ULP

INTEGER

I, IFST, ILST, INFO, INFQR, J, JW, K, KCOL, KEND, KLN, KROW, KWTOP, LTOP, LWK1, LWK2, LWKOPT

LOGICAL

BULGE, SORTED

REAL

SLAMCH

EXTERNAL

SLAMCH

EXTERNAL

SCOPY, SGEHRD, SGEMM, SLABAD, SLACPY, SLAHQR, SLANV2, SLARF, SLARFG, SLASET, SORMHR, STREXC

INTRINSIC

ABS, INT, MAX, MIN, REAL, SQRT

= MIN( NW, KBOT-KTOP+1 )

IF(

JW.LE.2 ) THEN

LWKOPT

= 1

ELSE

CALL

SGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )

LWK1

= INT( WORK( 1 ) )

CALL

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

LWK2

= INT( WORK( 1 ) )

LWKOPT

= JW + MAX( LWK1, LWK2 )

END

IF(

LWORK.EQ.-1 ) THEN

WORK(

1 ) = REAL( LWKOPT )

RETURN

END

= 0

WORK(

1 ) = ONE

IF(

KTOP.GT.KBOT ) RETURN

IF(

NW.LT.1 ) RETURN

SAFMIN

= SLAMCH( 'SAFE MINIMUM' )

SAFMAX

= ONE / SAFMIN

CALL

SLABAD( SAFMIN, SAFMAX )

ULP

= SLAMCH( 'PRECISION' )

SMLNUM

= SAFMIN*( REAL( N ) / ULP )

= MIN( NW, KBOT-KTOP+1 )

KWTOP

= KBOT - JW + 1

IF(

KWTOP.EQ.KTOP ) THEN

= ZERO

ELSE

= H( KWTOP, KWTOP-1 )

END

IF(

KBOT.EQ.KWTOP ) THEN

SR(

KWTOP ) = H( KWTOP, KWTOP )

SI(

KWTOP ) = ZERO

= 1

= 0

IF(

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

= 0

= 1

IF(

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

END

WORK(

1 ) = ONE

RETURN

END

CALL

SLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )

CALL

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

CALL

SLASET( 'A', JW, JW, ZERO, ONE, V, LDV )

CALL

SLAHQR( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ), SI( KWTOP ), 1, JW, V, LDV, INFQR )

10 J = 1, JW - 3

J+2, J ) = ZERO

J+3, J ) = ZERO

CONTINUE

IF(

JW.GT.2 ) T( JW, JW-2 ) = ZERO

= JW

ILST

= INFQR + 1

CONTINUE

IF(

ILST.LE.NS ) THEN

IF(

NS.EQ.1 ) THEN

BULGE

= .FALSE.

ELSE

BULGE

= T( NS, NS-1 ).NE.ZERO

END

IF(

FOO

= ABS( T( NS, NS ) )

IF(

FOO.EQ.ZERO ) FOO = ABS( S )

IF(

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

= NS - 1

ELSE

IFST

= NS

CALL

STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, INFO )

ILST

= ILST + 1

END

ELSE

FOO

= ABS( T( NS, NS ) ) + SQRT( ABS( T( NS, NS-1 ) ) )* SQRT( ABS( T( NS-1, NS ) ) )

IF(

FOO.EQ.ZERO ) FOO = ABS( S )

IF(

MAX( ABS( S*V( 1, NS ) ), ABS( S*V( 1, NS-1 ) ) ).LE. MAX( SMLNUM, ULP*FOO ) ) THEN

= NS - 2

ELSE

IFST

= NS

CALL

STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, INFO )

ILST

= ILST + 2

END

TO 20

END

IF(

NS.EQ.0 ) S = ZERO

IF(

NS.LT.JW ) THEN

SORTED

= .false.

= NS + 1

CONTINUE

IF(

SORTED ) GO TO 50

SORTED

= .true.

KEND

= I - 1

= INFQR + 1

IF(

I.EQ.NS ) THEN

= I + 1

ELSE

IF( T( I+1, I ).EQ.ZERO ) THEN

= I + 1

ELSE

= I + 2

END

CONTINUE

IF(

K.LE.KEND ) THEN

IF(

K.EQ.I+1 ) THEN

EVI

= ABS( T( I, I ) )

ELSE

EVI

= ABS( T( I, I ) ) + SQRT( ABS( T( I+1, I ) ) )* SQRT( ABS( T( I, I+1 ) ) )

END

IF(

K.EQ.KEND ) THEN

EVK

= ABS( T( K, K ) )

ELSE

IF( T( K+1, K ).EQ.ZERO ) THEN

EVK

= ABS( T( K, K ) )

ELSE

EVK

= ABS( T( K, K ) ) + SQRT( ABS( T( K+1, K ) ) )* SQRT( ABS( T( K, K+1 ) ) )

END

IF(

EVI.GE.EVK ) THEN

= K

ELSE

SORTED

= .false.

IFST

= I

ILST

= K

CALL

STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, INFO )

IF(

INFO.EQ.0 ) THEN

= ILST

ELSE

= K

END

IF(

I.EQ.KEND ) THEN

= I + 1

ELSE

IF( T( I+1, I ).EQ.ZERO ) THEN

= I + 1

ELSE

= I + 2

END

TO 40

END

TO 30

CONTINUE

END

= JW

CONTINUE

IF(

I.GE.INFQR+1 ) THEN

IF(

I.EQ.INFQR+1 ) THEN

SR(

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

SI(

KWTOP+I-1 ) = ZERO

= I - 1

ELSE

IF( T( I, I-1 ).EQ.ZERO ) THEN

SR(

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

SI(

KWTOP+I-1 ) = ZERO

= I - 1

ELSE

= T( I-1, I-1 )

= T( I, I-1 )

= T( I-1, I )

= T( I, I )

CALL

SLANV2( AA, BB, CC, DD, SR( KWTOP+I-2 ), SI( KWTOP+I-2 ), SR( KWTOP+I-1 ), SI( KWTOP+I-1 ), CS, SN )

= I - 2

END

TO 60

END

IF(

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

IF(

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

CALL

SCOPY( NS, V, LDV, WORK, 1 )

BETA

= WORK( 1 )

CALL

SLARFG( NS, BETA, WORK( 2 ), 1, TAU )

WORK(

1 ) = ONE

CALL

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

CALL

SLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT, WORK( JW+1 ) )

CALL

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

CALL

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

CALL

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

END

IF(

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

CALL

SLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )

CALL

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

IF(

NS.GT.1 .AND. S.NE.ZERO ) CALL SORMHR( '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

70 KROW = LTOP, KWTOP - 1, NV

KLN

= MIN( NV, KWTOP-KROW )

CALL

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

CALL

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

CONTINUE

IF(

WANTT ) THEN

80 KCOL = KBOT + 1, N, NH

KLN

= MIN( NH, N-KCOL+1 )

CALL

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

CALL

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

CONTINUE

END

IF(

WANTZ ) THEN

90 KROW = ILOZ, IHIZ, NV

KLN

= MIN( NV, IHIZ-KROW+1 )

CALL

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

CALL

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

CONTINUE

END

= JW - NS

= NS - INFQR

WORK(

1 ) = REAL( LWKOPT )

END

slaqr2(l) - Linux man page

Name

Synopsis

Purpose