zlaqr5(l) - Linux man page

Name

Synopsis

SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S, 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

COMPLEX*16

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

COMPLEX*16

ZERO, ONE

PARAMETER

( ZERO = ( 0.0d0, 0.0d0 ), ONE = ( 1.0d0, 0.0d0 ) )

DOUBLE

PRECISION RZERO, RONE

PARAMETER

( RZERO = 0.0d0, RONE = 1.0d0 )

COMPLEX*16

ALPHA, BETA, CDUM, REFSUM

DOUBLE

PRECISION H11, H12, H21, H22, SAFMAX, SAFMIN, SCL, SMLNUM, TST1, TST2, ULP

INTEGER

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

DOUBLE

PRECISION DLAMCH

EXTERNAL

DLAMCH

INTRINSIC

ABS, DBLE, DCONJG, DIMAG, MAX, MIN, MOD

COMPLEX*16

VT( 3 )

EXTERNAL

DLABAD, ZGEMM, ZLACPY, ZLAQR1, ZLARFG, ZLASET, ZTRMM

DOUBLE

PRECISION CABS1

CABS1(

CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )

IF(

NSHFTS.LT.2 ) RETURN

IF(

KTOP.GE.KBOT ) RETURN

= NSHFTS - MOD( NSHFTS, 2 )

SAFMIN

= DLAMCH( 'SAFE MINIMUM' )

SAFMAX

= RONE / SAFMIN

CALL

DLABAD( SAFMIN, SAFMAX )

ULP

= DLAMCH( 'PRECISION' )

SMLNUM

= SAFMIN*( DBLE( 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

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

NDCOL

= INCOL + KDU

IF(

ACCUM ) CALL ZLASET( 'ALL', KDU, KDU, ZERO, ONE, U, LDU )

140 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 )

10 M = MTOP, MBOT

= KRCOL + 3*( M-1 )

IF(

K.EQ.KTOP-1 ) THEN

CALL

ZLAQR1( 3, H( KTOP, KTOP ), LDH, S( 2*M-1 ), S( 2*M ), V( 1, M ) )

ALPHA

= V( 1, M )

CALL

ZLARFG( 3, ALPHA, V( 2, M ), 1, V( 1, M ) )

ELSE

BETA

= H( K+1, K )

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

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

CALL

ZLARFG( 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

K+1, K ) = BETA

K+2, K ) = ZERO

K+3, K ) = ZERO

ELSE

CALL

ZLAQR1( 3, H( K+1, K+1 ), LDH, S( 2*M-1 ), S( 2*M ), VT )

ALPHA

= VT( 1 )

CALL

ZLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )

REFSUM

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

IF(

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

K+1, K ) = BETA

K+2, K ) = ZERO

K+3, K ) = ZERO

ELSE

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

K+2, K ) = ZERO

K+3, K ) = ZERO

1, M ) = VT( 1 )

2, M ) = VT( 2 )

3, M ) = VT( 3 )

END

CONTINUE

= KRCOL + 3*( M22-1 )

IF(

BMP22 ) THEN

IF(

K.EQ.KTOP-1 ) THEN

CALL

ZLAQR1( 2, H( K+1, K+1 ), LDH, S( 2*M22-1 ), S( 2*M22 ), V( 1, M22 ) )

BETA

= V( 1, M22 )

CALL

ZLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )

ELSE

BETA

= H( K+1, K )

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

CALL

ZLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )

K+1, K ) = BETA

K+2, K ) = ZERO

END

IF(

ACCUM ) THEN

JBOT

= MIN( NDCOL, KBOT )

ELSE

IF( WANTT ) THEN

JBOT

= N

ELSE

JBOT

= KBOT

END

30 J = MAX( KTOP, KRCOL ), JBOT

MEND

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

20 M = MTOP, MEND

= KRCOL + 3*( M-1 )

REFSUM

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

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

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

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

CONTINUE

IF(

BMP22 ) THEN

= KRCOL + 3*( M22-1 )

40 J = MAX( K+1, KTOP ), JBOT

REFSUM

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

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

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

CONTINUE

END

IF(

ACCUM ) THEN

JTOP

= MAX( KTOP, INCOL )

ELSE

IF( WANTT ) THEN

JTOP

= 1

ELSE

JTOP

= KTOP

END

80 M = MTOP, MBOT

IF(

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

= KRCOL + 3*( M-1 )

50 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 ) )

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

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

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

CONTINUE

IF(

ACCUM ) THEN

KMS

= K - INCOL

60 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 ) )

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

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

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

CONTINUE

ELSE

IF( WANTZ ) THEN

70 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 ) )

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

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

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

CONTINUE

END

CONTINUE

= KRCOL + 3*( M22-1 )

IF(

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

90 J = JTOP, MIN( KBOT, K+3 )

REFSUM

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

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

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

CONTINUE

IF(

ACCUM ) THEN

KMS

= K - INCOL

100 J = MAX( 1, KTOP-INCOL ), KDU

REFSUM

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

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

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

100

CONTINUE

ELSE

IF( WANTZ ) THEN

110 J = ILOZ, IHIZ

REFSUM

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

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

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

110

CONTINUE

END

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

120 M = MSTART, MEND

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

IF(

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

TST1

= CABS1( H( K, K ) ) + CABS1( H( K+1, K+1 ) )

IF(

TST1.EQ.RZERO ) THEN

IF(

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

IF(

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

IF(

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

IF(

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

IF(

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

IF(

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

END

IF(

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

H12

= MAX( CABS1( H( K+1, K ) ), CABS1( H( K, K+1 ) ) )

H21

= MIN( CABS1( H( K+1, K ) ), CABS1( H( K, K+1 ) ) )

H11

= MAX( CABS1( H( K+1, K+1 ) ), CABS1( H( K, K )-H( K+1, K+1 ) ) )

H22

= MIN( CABS1( H( K+1, K+1 ) ), CABS1( H( K, K )-H( K+1, K+1 ) ) )

SCL

= H11 + H12

TST2

= H22*( H11 / SCL )

IF(

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

END

120

CONTINUE

MEND

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

130 M = MTOP, MEND

= KRCOL + 3*( M-1 )

REFSUM

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

K+4, K+1 ) = -REFSUM

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

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

130

CONTINUE

140

CONTINUE

IF(

ACCUM ) THEN

IF(

WANTT ) THEN

JTOP

= 1

JBOT

= N

ELSE

JTOP

= KTOP

JBOT

= KBOT

END

IF(

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

= MAX( 1, KTOP-INCOL )

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

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

JLEN

= MIN( NH, JBOT-JCOL+1 )

CALL

ZGEMM( 'C', 'N', NU, JLEN, NU, ONE, U( K1, K1 ), LDU, H( INCOL+K1, JCOL ), LDH, ZERO, WH, LDWH )

CALL

ZLACPY( 'ALL', NU, JLEN, WH, LDWH, H( INCOL+K1, JCOL ), LDH )

150

CONTINUE

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

JLEN

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

CALL

ZGEMM( 'N', 'N', JLEN, NU, NU, ONE, H( JROW, INCOL+K1 ), LDH, U( K1, K1 ), LDU, ZERO, WV, LDWV )

CALL

ZLACPY( 'ALL', JLEN, NU, WV, LDWV, H( JROW, INCOL+K1 ), LDH )

160

CONTINUE

IF(

WANTZ ) THEN

170 JROW = ILOZ, IHIZ, NV

JLEN

= MIN( NV, IHIZ-JROW+1 )

CALL

ZGEMM( 'N', 'N', JLEN, NU, NU, ONE, Z( JROW, INCOL+K1 ), LDZ, U( K1, K1 ), LDU, ZERO, WV, LDWV )

CALL

ZLACPY( 'ALL', JLEN, NU, WV, LDWV, Z( JROW, INCOL+K1 ), LDZ )

170

CONTINUE

END

ELSE

= ( KDU+1 ) / 2

= KDU

= I4 - I2

= KDU

KZS

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

KNZ

= NS + 1

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

JLEN

= MIN( NH, JBOT-JCOL+1 )

CALL

ZLACPY( 'ALL', KNZ, JLEN, H( INCOL+1+J2, JCOL ), LDH, WH( KZS+1, 1 ), LDWH )

CALL

ZLASET( 'ALL', KZS, JLEN, ZERO, ZERO, WH, LDWH )

CALL

ZTRMM( 'L', 'U', 'C', 'N', KNZ, JLEN, ONE, U( J2+1, 1+KZS ), LDU, WH( KZS+1, 1 ), LDWH )

CALL

ZGEMM( 'C', 'N', I2, JLEN, J2, ONE, U, LDU, H( INCOL+1, JCOL ), LDH, ONE, WH, LDWH )

CALL

ZLACPY( 'ALL', J2, JLEN, H( INCOL+1, JCOL ), LDH, WH( I2+1, 1 ), LDWH )

CALL

ZTRMM( 'L', 'L', 'C', 'N', J2, JLEN, ONE, U( 1, I2+1 ), LDU, WH( I2+1, 1 ), LDWH )

CALL

ZGEMM( 'C', 'N', 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

ZLACPY( 'ALL', KDU, JLEN, WH, LDWH, H( INCOL+1, JCOL ), LDH )

180

CONTINUE

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

JLEN

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

CALL

ZLACPY( 'ALL', JLEN, KNZ, H( JROW, INCOL+1+J2 ), LDH, WV( 1, 1+KZS ), LDWV )

CALL

ZLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV, LDWV )

CALL

ZTRMM( 'R', 'U', 'N', 'N', JLEN, KNZ, ONE, U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ), LDWV )

CALL

ZGEMM( 'N', 'N', JLEN, I2, J2, ONE, H( JROW, INCOL+1 ), LDH, U, LDU, ONE, WV, LDWV )

CALL

ZLACPY( 'ALL', JLEN, J2, H( JROW, INCOL+1 ), LDH, WV( 1, 1+I2 ), LDWV )

CALL

ZTRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE, U( 1, I2+1 ), LDU, WV( 1, 1+I2 ), LDWV )

CALL

ZGEMM( 'N', 'N', 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

ZLACPY( 'ALL', JLEN, KDU, WV, LDWV, H( JROW, INCOL+1 ), LDH )

190

CONTINUE

IF(

WANTZ ) THEN

200 JROW = ILOZ, IHIZ, NV

JLEN

= MIN( NV, IHIZ-JROW+1 )

CALL

ZLACPY( 'ALL', JLEN, KNZ, Z( JROW, INCOL+1+J2 ), LDZ, WV( 1, 1+KZS ), LDWV )

CALL

ZLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV, LDWV )

CALL

ZTRMM( 'R', 'U', 'N', 'N', JLEN, KNZ, ONE, U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ), LDWV )

CALL

ZGEMM( 'N', 'N', JLEN, I2, J2, ONE, Z( JROW, INCOL+1 ), LDZ, U, LDU, ONE, WV, LDWV )

CALL

ZLACPY( 'ALL', JLEN, J2, Z( JROW, INCOL+1 ), LDZ, WV( 1, 1+I2 ), LDWV )

CALL

ZTRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE, U( 1, I2+1 ), LDU, WV( 1, 1+I2 ), LDWV )

CALL

ZGEMM( 'N', 'N', 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

ZLACPY( 'ALL', JLEN, KDU, WV, LDWV, Z( JROW, INCOL+1 ), LDZ )

200

CONTINUE

END

210

CONTINUE

END

zlaqr5(l) - Linux man page

Name

Synopsis

Purpose