slaqr5 (l) - Linux Manuals

NAME

SYNOPSIS

SUBROUTINE SLAQR5(
WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV, WV, LDWV, NH, WH, LDWH )

    
INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV, LDWH, LDWV, LDZ, N, NH, NSHFTS, NV

    
LOGICAL WANTT, WANTZ

    
REAL H( LDH, * ), SI( * ), SR( * ), U( LDU, * ), V( LDV, * ), WH( LDWH, * ), WV( LDWV, * ), Z( LDZ, * )

    
REAL ZERO, ONE

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

    
REAL ALPHA, BETA, H11, H12, H21, H22, REFSUM, SAFMAX, SAFMIN, SCL, SMLNUM, SWAP, TST1, TST2, ULP

    
INTEGER I, I2, I4, INCOL, J, J2, J4, JBOT, JCOL, JLEN, JROW, JTOP, K, K1, KDU, KMS, KNZ, KRCOL, KZS, M, M22, MBOT, MEND, MSTART, MTOP, NBMPS, NDCOL, NS, NU

    
LOGICAL ACCUM, BLK22, BMP22

    
REAL SLAMCH

    
EXTERNAL SLAMCH

    
INTRINSIC ABS, MAX, MIN, MOD, REAL

    
REAL VT( 3 )

    
EXTERNAL SGEMM, SLABAD, SLACPY, SLAQR1, SLARFG, SLASET, STRMM

    
IF( NSHFTS.LT.2 ) RETURN

    
IF( KTOP.GE.KBOT ) RETURN

    
DO 10 I = 1, NSHFTS - 2, 2

    
IF( SI( I ).NE.-SI( I+1 ) ) THEN

    
SWAP = SR( I )

    
SR( I ) = SR( I+1 )

    
SR( I+1 ) = SR( I+2 )

    
SR( I+2 ) = SWAP

    
SWAP = SI( I )

    
SI( I ) = SI( I+1 )

    
SI( I+1 ) = SI( I+2 )

    
SI( I+2 ) = SWAP

    
END IF

    
10 CONTINUE

    
NS = NSHFTS - MOD( NSHFTS, 2 )

    
SAFMIN = SLAMCH( aqSAFE MINIMUMaq )

    
SAFMAX = ONE / SAFMIN

    
CALL SLABAD( SAFMIN, SAFMAX )

    
ULP = SLAMCH( aqPRECISIONaq )

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

    
ACCUM = ( KACC22.EQ.1 ) .OR. ( KACC22.EQ.2 )

    
BLK22 = ( NS.GT.2 ) .AND. ( KACC22.EQ.2 )

    
IF( KTOP+2.LE.KBOT ) H( KTOP+2, KTOP ) = ZERO

    
NBMPS = NS / 2

    
KDU = 6*NBMPS - 3

    
DO 220 INCOL = 3*( 1-NBMPS ) + KTOP - 1, KBOT - 2, 3*NBMPS - 2

    
NDCOL = INCOL + KDU

    
IF( ACCUM ) CALL SLASET( aqALLaq, KDU, KDU, ZERO, ONE, U, LDU )

    
DO 150 KRCOL = INCOL, MIN( INCOL+3*NBMPS-3, KBOT-2 )

    
MTOP = MAX( 1, ( ( KTOP-1 )-KRCOL+2 ) / 3+1 )

    
MBOT = MIN( NBMPS, ( KBOT-KRCOL ) / 3 )

    
M22 = MBOT + 1

    
BMP22 = ( MBOT.LT.NBMPS ) .AND. ( KRCOL+3*( M22-1 ) ).EQ. ( KBOT-2 )

    
DO 20 M = MTOP, MBOT

    
K = KRCOL + 3*( M-1 )

    
IF( K.EQ.KTOP-1 ) THEN

    
CALL SLAQR1( 3, H( KTOP, KTOP ), LDH, SR( 2*M-1 ), SI( 2*M-1 ), SR( 2*M ), SI( 2*M ), V( 1, M ) )

    
ALPHA = V( 1, M )

    
CALL SLARFG( 3, ALPHA, V( 2, M ), 1, V( 1, M ) )

    
ELSE

    
BETA = H( K+1, K )

    
V( 2, M ) = H( K+2, K )

    
V( 3, M ) = H( K+3, K )

    
CALL SLARFG( 3, BETA, V( 2, M ), 1, V( 1, M ) )

    
IF( H( K+3, K ).NE.ZERO .OR. H( K+3, K+1 ).NE. ZERO .OR. H( K+3, K+2 ).EQ.ZERO ) THEN

    
H( K+1, K ) = BETA

    
H( K+2, K ) = ZERO

    
H( K+3, K ) = ZERO

    
ELSE

    
CALL SLAQR1( 3, H( K+1, K+1 ), LDH, SR( 2*M-1 ), SI( 2*M-1 ), SR( 2*M ), SI( 2*M ), VT )

    
ALPHA = VT( 1 )

    
CALL SLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )

    
REFSUM = VT( 1 )*( H( K+1, K )+VT( 2 )* H( K+2, K ) )

    
IF( ABS( H( K+2, K )-REFSUM*VT( 2 ) )+ ABS( REFSUM*VT( 3 ) ).GT.ULP* ( ABS( H( K, K ) )+ABS( H( K+1, K+1 ) )+ABS( H( K+2, K+2 ) ) ) ) THEN

    
H( K+1, K ) = BETA

    
H( K+2, K ) = ZERO

    
H( K+3, K ) = ZERO

    
ELSE

    
H( K+1, K ) = H( K+1, K ) - REFSUM

    
H( K+2, K ) = ZERO

    
H( K+3, K ) = ZERO

    
V( 1, M ) = VT( 1 )

    
V( 2, M ) = VT( 2 )

    
V( 3, M ) = VT( 3 )

    
END IF

    
END IF

    
END IF

    
20 CONTINUE

    
K = KRCOL + 3*( M22-1 )

    
IF( BMP22 ) THEN

    
IF( K.EQ.KTOP-1 ) THEN

    
CALL SLAQR1( 2, H( K+1, K+1 ), LDH, SR( 2*M22-1 ), SI( 2*M22-1 ), SR( 2*M22 ), SI( 2*M22 ), V( 1, M22 ) )

    
BETA = V( 1, M22 )

    
CALL SLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )

    
ELSE

    
BETA = H( K+1, K )

    
V( 2, M22 ) = H( K+2, K )

    
CALL SLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )

    
H( K+1, K ) = BETA

    
H( K+2, K ) = ZERO

    
END IF

    
END IF

    
IF( ACCUM ) THEN

    
JBOT = MIN( NDCOL, KBOT )

    
ELSE IF( WANTT ) THEN

    
JBOT = N

    
ELSE

    
JBOT = KBOT

    
END IF

    
DO 40 J = MAX( KTOP, KRCOL ), JBOT

    
MEND = MIN( MBOT, ( J-KRCOL+2 ) / 3 )

    
DO 30 M = MTOP, MEND

    
K = KRCOL + 3*( M-1 )

    
REFSUM = V( 1, M )*( H( K+1, J )+V( 2, M )* H( K+2, J )+V( 3, M )*H( K+3, J ) )

    
H( K+1, J ) = H( K+1, J ) - REFSUM

    
H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M )

    
H( K+3, J ) = H( K+3, J ) - REFSUM*V( 3, M )

    
30 CONTINUE

    
40 CONTINUE

    
IF( BMP22 ) THEN

    
K = KRCOL + 3*( M22-1 )

    
DO 50 J = MAX( K+1, KTOP ), JBOT

    
REFSUM = V( 1, M22 )*( H( K+1, J )+V( 2, M22 )* H( K+2, J ) )

    
H( K+1, J ) = H( K+1, J ) - REFSUM

    
H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M22 )

    
50 CONTINUE

    
END IF

    
IF( ACCUM ) THEN

    
JTOP = MAX( KTOP, INCOL )

    
ELSE IF( WANTT ) THEN

    
JTOP = 1

    
ELSE

    
JTOP = KTOP

    
END IF

    
DO 90 M = MTOP, MBOT

    
IF( V( 1, M ).NE.ZERO ) THEN

    
K = KRCOL + 3*( M-1 )

    
DO 60 J = JTOP, MIN( KBOT, K+3 )

    
REFSUM = V( 1, M )*( H( J, K+1 )+V( 2, M )* H( J, K+2 )+V( 3, M )*H( J, K+3 ) )

    
H( J, K+1 ) = H( J, K+1 ) - REFSUM

    
H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M )

    
H( J, K+3 ) = H( J, K+3 ) - REFSUM*V( 3, M )

    
60 CONTINUE

    
IF( ACCUM ) THEN

    
KMS = K - INCOL

    
DO 70 J = MAX( 1, KTOP-INCOL ), KDU

    
REFSUM = V( 1, M )*( U( J, KMS+1 )+V( 2, M )* U( J, KMS+2 )+V( 3, M )*U( J, KMS+3 ) )

    
U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM

    
U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*V( 2, M )

    
U( J, KMS+3 ) = U( J, KMS+3 ) - REFSUM*V( 3, M )

    
70 CONTINUE

    
ELSE IF( WANTZ ) THEN

    
DO 80 J = ILOZ, IHIZ

    
REFSUM = V( 1, M )*( Z( J, K+1 )+V( 2, M )* Z( J, K+2 )+V( 3, M )*Z( J, K+3 ) )

    
Z( J, K+1 ) = Z( J, K+1 ) - REFSUM

    
Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M )

    
Z( J, K+3 ) = Z( J, K+3 ) - REFSUM*V( 3, M )

    
80 CONTINUE

    
END IF

    
END IF

    
90 CONTINUE

    
K = KRCOL + 3*( M22-1 )

    
IF( BMP22 .AND. ( V( 1, M22 ).NE.ZERO ) ) THEN

    
DO 100 J = JTOP, MIN( KBOT, K+3 )

    
REFSUM = V( 1, M22 )*( H( J, K+1 )+V( 2, M22 )* H( J, K+2 ) )

    
H( J, K+1 ) = H( J, K+1 ) - REFSUM

    
H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M22 )

    
100 CONTINUE

    
IF( ACCUM ) THEN

    
KMS = K - INCOL

    
DO 110 J = MAX( 1, KTOP-INCOL ), KDU

    
REFSUM = V( 1, M22 )*( U( J, KMS+1 )+V( 2, M22 )* U( J, KMS+2 ) )

    
U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM

    
U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*V( 2, M22 )

    
110 CONTINUE

    
ELSE IF( WANTZ ) THEN

    
DO 120 J = ILOZ, IHIZ

    
REFSUM = V( 1, M22 )*( Z( J, K+1 )+V( 2, M22 )* Z( J, K+2 ) )

    
Z( J, K+1 ) = Z( J, K+1 ) - REFSUM

    
Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M22 )

    
120 CONTINUE

    
END IF

    
END IF

    
MSTART = MTOP

    
IF( KRCOL+3*( MSTART-1 ).LT.KTOP ) MSTART = MSTART + 1

    
MEND = MBOT

    
IF( BMP22 ) MEND = MEND + 1

    
IF( KRCOL.EQ.KBOT-2 ) MEND = MEND + 1

    
DO 130 M = MSTART, MEND

    
K = MIN( KBOT-1, KRCOL+3*( M-1 ) )

    
IF( H( K+1, K ).NE.ZERO ) THEN

    
TST1 = ABS( H( K, K ) ) + ABS( H( K+1, K+1 ) )

    
IF( TST1.EQ.ZERO ) THEN

    
IF( K.GE.KTOP+1 ) TST1 = TST1 + ABS( H( K, K-1 ) )

    
IF( K.GE.KTOP+2 ) TST1 = TST1 + ABS( H( K, K-2 ) )

    
IF( K.GE.KTOP+3 ) TST1 = TST1 + ABS( H( K, K-3 ) )

    
IF( K.LE.KBOT-2 ) TST1 = TST1 + ABS( H( K+2, K+1 ) )

    
IF( K.LE.KBOT-3 ) TST1 = TST1 + ABS( H( K+3, K+1 ) )

    
IF( K.LE.KBOT-4 ) TST1 = TST1 + ABS( H( K+4, K+1 ) )

    
END IF

    
IF( ABS( H( K+1, K ) ).LE.MAX( SMLNUM, ULP*TST1 ) ) THEN

    
H12 = MAX( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )

    
H21 = MIN( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )

    
H11 = MAX( ABS( H( K+1, K+1 ) ), ABS( H( K, K )-H( K+1, K+1 ) ) )

    
H22 = MIN( ABS( H( K+1, K+1 ) ), ABS( H( K, K )-H( K+1, K+1 ) ) )

    
SCL = H11 + H12

    
TST2 = H22*( H11 / SCL )

    
IF( TST2.EQ.ZERO .OR. H21*( H12 / SCL ).LE. MAX( SMLNUM, ULP*TST2 ) )H( K+1, K ) = ZERO

    
END IF

    
END IF

    
130 CONTINUE

    
MEND = MIN( NBMPS, ( KBOT-KRCOL-1 ) / 3 )

    
DO 140 M = MTOP, MEND

    
K = KRCOL + 3*( M-1 )

    
REFSUM = V( 1, M )*V( 3, M )*H( K+4, K+3 )

    
H( K+4, K+1 ) = -REFSUM

    
H( K+4, K+2 ) = -REFSUM*V( 2, M )

    
H( K+4, K+3 ) = H( K+4, K+3 ) - REFSUM*V( 3, M )

    
140 CONTINUE

    
150 CONTINUE

    
IF( ACCUM ) THEN

    
IF( WANTT ) THEN

    
JTOP = 1

    
JBOT = N

    
ELSE

    
JTOP = KTOP

    
JBOT = KBOT

    
END IF

    
IF( ( .NOT.BLK22 ) .OR. ( INCOL.LT.KTOP ) .OR. ( NDCOL.GT.KBOT ) .OR. ( NS.LE.2 ) ) THEN

    
K1 = MAX( 1, KTOP-INCOL )

    
NU = ( KDU-MAX( 0, NDCOL-KBOT ) ) - K1 + 1

    
DO 160 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH

    
JLEN = MIN( NH, JBOT-JCOL+1 )

    
CALL SGEMM( aqCaq, aqNaq, NU, JLEN, NU, ONE, U( K1, K1 ), LDU, H( INCOL+K1, JCOL ), LDH, ZERO, WH, LDWH )

    
CALL SLACPY( aqALLaq, NU, JLEN, WH, LDWH, H( INCOL+K1, JCOL ), LDH )

    
160 CONTINUE

    
DO 170 JROW = JTOP, MAX( KTOP, INCOL ) - 1, NV

    
JLEN = MIN( NV, MAX( KTOP, INCOL )-JROW )

    
CALL SGEMM( aqNaq, aqNaq, JLEN, NU, NU, ONE, H( JROW, INCOL+K1 ), LDH, U( K1, K1 ), LDU, ZERO, WV, LDWV )

    
CALL SLACPY( aqALLaq, JLEN, NU, WV, LDWV, H( JROW, INCOL+K1 ), LDH )

    
170 CONTINUE

    
IF( WANTZ ) THEN

    
DO 180 JROW = ILOZ, IHIZ, NV

    
JLEN = MIN( NV, IHIZ-JROW+1 )

    
CALL SGEMM( aqNaq, aqNaq, JLEN, NU, NU, ONE, Z( JROW, INCOL+K1 ), LDZ, U( K1, K1 ), LDU, ZERO, WV, LDWV )

    
CALL SLACPY( aqALLaq, JLEN, NU, WV, LDWV, Z( JROW, INCOL+K1 ), LDZ )

    
180 CONTINUE

    
END IF

    
ELSE

    
I2 = ( KDU+1 ) / 2

    
I4 = KDU

    
J2 = I4 - I2

    
J4 = KDU

    
KZS = ( J4-J2 ) - ( NS+1 )

    
KNZ = NS + 1

    
DO 190 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH

    
JLEN = MIN( NH, JBOT-JCOL+1 )

    
CALL SLACPY( aqALLaq, KNZ, JLEN, H( INCOL+1+J2, JCOL ), LDH, WH( KZS+1, 1 ), LDWH )

    
CALL SLASET( aqALLaq, KZS, JLEN, ZERO, ZERO, WH, LDWH )

    
CALL STRMM( aqLaq, aqUaq, aqCaq, aqNaq, KNZ, JLEN, ONE, U( J2+1, 1+KZS ), LDU, WH( KZS+1, 1 ), LDWH )

    
CALL SGEMM( aqCaq, aqNaq, I2, JLEN, J2, ONE, U, LDU, H( INCOL+1, JCOL ), LDH, ONE, WH, LDWH )

    
CALL SLACPY( aqALLaq, J2, JLEN, H( INCOL+1, JCOL ), LDH, WH( I2+1, 1 ), LDWH )

    
CALL STRMM( aqLaq, aqLaq, aqCaq, aqNaq, J2, JLEN, ONE, U( 1, I2+1 ), LDU, WH( I2+1, 1 ), LDWH )

    
CALL SGEMM( aqCaq, aqNaq, I4-I2, JLEN, J4-J2, ONE, U( J2+1, I2+1 ), LDU, H( INCOL+1+J2, JCOL ), LDH, ONE, WH( I2+1, 1 ), LDWH )

    
CALL SLACPY( aqALLaq, KDU, JLEN, WH, LDWH, H( INCOL+1, JCOL ), LDH )

    
190 CONTINUE

    
DO 200 JROW = JTOP, MAX( INCOL, KTOP ) - 1, NV

    
JLEN = MIN( NV, MAX( INCOL, KTOP )-JROW )

    
CALL SLACPY( aqALLaq, JLEN, KNZ, H( JROW, INCOL+1+J2 ), LDH, WV( 1, 1+KZS ), LDWV )

    
CALL SLASET( aqALLaq, JLEN, KZS, ZERO, ZERO, WV, LDWV )

    
CALL STRMM( aqRaq, aqUaq, aqNaq, aqNaq, JLEN, KNZ, ONE, U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ), LDWV )

    
CALL SGEMM( aqNaq, aqNaq, JLEN, I2, J2, ONE, H( JROW, INCOL+1 ), LDH, U, LDU, ONE, WV, LDWV )

    
CALL SLACPY( aqALLaq, JLEN, J2, H( JROW, INCOL+1 ), LDH, WV( 1, 1+I2 ), LDWV )

    
CALL STRMM( aqRaq, aqLaq, aqNaq, aqNaq, JLEN, I4-I2, ONE, U( 1, I2+1 ), LDU, WV( 1, 1+I2 ), LDWV )

    
CALL SGEMM( aqNaq, aqNaq, JLEN, I4-I2, J4-J2, ONE, H( JROW, INCOL+1+J2 ), LDH, U( J2+1, I2+1 ), LDU, ONE, WV( 1, 1+I2 ), LDWV )

    
CALL SLACPY( aqALLaq, JLEN, KDU, WV, LDWV, H( JROW, INCOL+1 ), LDH )

    
200 CONTINUE

    
IF( WANTZ ) THEN

    
DO 210 JROW = ILOZ, IHIZ, NV

    
JLEN = MIN( NV, IHIZ-JROW+1 )

    
CALL SLACPY( aqALLaq, JLEN, KNZ, Z( JROW, INCOL+1+J2 ), LDZ, WV( 1, 1+KZS ), LDWV )

    
CALL SLASET( aqALLaq, JLEN, KZS, ZERO, ZERO, WV, LDWV )

    
CALL STRMM( aqRaq, aqUaq, aqNaq, aqNaq, JLEN, KNZ, ONE, U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ), LDWV )

    
CALL SGEMM( aqNaq, aqNaq, JLEN, I2, J2, ONE, Z( JROW, INCOL+1 ), LDZ, U, LDU, ONE, WV, LDWV )

    
CALL SLACPY( aqALLaq, JLEN, J2, Z( JROW, INCOL+1 ), LDZ, WV( 1, 1+I2 ), LDWV )

    
CALL STRMM( aqRaq, aqLaq, aqNaq, aqNaq, JLEN, I4-I2, ONE, U( 1, I2+1 ), LDU, WV( 1, 1+I2 ), LDWV )

    
CALL SGEMM( aqNaq, aqNaq, JLEN, I4-I2, J4-J2, ONE, Z( JROW, INCOL+1+J2 ), LDZ, U( J2+1, I2+1 ), LDU, ONE, WV( 1, 1+I2 ), LDWV )

    
CALL SLACPY( aqALLaq, JLEN, KDU, WV, LDWV, Z( JROW, INCOL+1 ), LDZ )

    
210 CONTINUE

    
END IF

    
END IF

    
END IF

    
220 CONTINUE

    
END

PURPOSE

Pages related to slaqr5

  • slaqr5 (3)
  • slaqr0 (l) - SLAQR0 compute the eigenvalues of a Hessenberg matrix H and, optionally, the matrices T and Z from the Schur decomposition H = Z T Z**T, where T is an upper quasi-triangular matrix (the Schur form), and Z is the orthogonal matrix of Schur vectors
  • slaqr1 (l)
  • slaqr2 (l)
  • slaqr3 (l)
  • slaqr4 (l) - SLAQR4 compute the eigenvalues of a Hessenberg matrix H and, optionally, the matrices T and Z from the Schur decomposition H = Z T Z**T, where T is an upper quasi-triangular matrix (the Schur form), and Z is the orthogonal matrix of Schur vectors
  • slaqgb (l) - equilibrates a general M by N band matrix A with KL subdiagonals and KU superdiagonals using the row and scaling factors in the vectors R and C
  • slaqge (l) - equilibrates a general M by N matrix A using the row and column scaling factors in the vectors R and C
  • slaqp2 (l) - computes a QR factorization with column pivoting of the block A(OFFSET+1:M,1:N)
  • slaqps (l) - computes a step of QR factorization with column pivoting of a real M-by-N matrix A by using Blas-3