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
- NS
-
= 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
- DO
-
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 )
- DO
-
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 )
- DO
-
10 M = MTOP, MBOT
- K
-
= 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 )
- V(
-
2, M ) = H( K+2, K )
- V(
-
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
- H(
-
K+1, K ) = BETA
- H(
-
K+2, K ) = ZERO
- H(
-
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
- 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
- 10
-
CONTINUE
- K
-
= 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 )
- V(
-
2, M22 ) = H( K+2, K )
- CALL
-
ZLARFG( 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
-
30 J = MAX( KTOP, KRCOL ), JBOT
- MEND
-
= MIN( MBOT, ( J-KRCOL+2 ) / 3 )
- DO
-
20 M = MTOP, MEND
- K
-
= 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 ) )
- 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 )
- 20
-
CONTINUE
- 30
-
CONTINUE
- IF(
-
BMP22 ) THEN
- K
-
= KRCOL + 3*( M22-1 )
- DO
-
40 J = MAX( K+1, KTOP ), JBOT
- REFSUM
-
= DCONJG( V( 1, M22 ) )* ( H( K+1, J )+DCONJG( 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 )
- 40
-
CONTINUE
- END
-
IF
- IF(
-
ACCUM ) THEN
- JTOP
-
= MAX( KTOP, INCOL )
- ELSE
-
IF( WANTT ) THEN
- JTOP
-
= 1
- ELSE
- JTOP
-
= KTOP
- END
-
IF
- DO
-
80 M = MTOP, MBOT
- IF(
-
V( 1, M ).NE.ZERO ) THEN
- K
-
= KRCOL + 3*( M-1 )
- DO
-
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 ) )
- H(
-
J, K+1 ) = H( J, K+1 ) - REFSUM
- H(
-
J, K+2 ) = H( J, K+2 ) - REFSUM*DCONJG( V( 2, M ) )
- H(
-
J, K+3 ) = H( J, K+3 ) - REFSUM*DCONJG( V( 3, M ) )
- 50
-
CONTINUE
- IF(
-
ACCUM ) THEN
- KMS
-
= K - INCOL
- DO
-
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 ) )
- U(
-
J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
- U(
-
J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*DCONJG( V( 2, M ) )
- U(
-
J, KMS+3 ) = U( J, KMS+3 ) - REFSUM*DCONJG( V( 3, M ) )
- 60
-
CONTINUE
- ELSE
-
IF( WANTZ ) THEN
- DO
-
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 ) )
- Z(
-
J, K+1 ) = Z( J, K+1 ) - REFSUM
- Z(
-
J, K+2 ) = Z( J, K+2 ) - REFSUM*DCONJG( V( 2, M ) )
- Z(
-
J, K+3 ) = Z( J, K+3 ) - REFSUM*DCONJG( V( 3, M ) )
- 70
-
CONTINUE
- END
-
IF
- END
-
IF
- 80
-
CONTINUE
- K
-
= KRCOL + 3*( M22-1 )
- IF(
-
BMP22 .AND. ( V( 1, M22 ).NE.ZERO ) ) THEN
- DO
-
90 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*DCONJG( V( 2, M22 ) )
- 90
-
CONTINUE
- IF(
-
ACCUM ) THEN
- KMS
-
= K - INCOL
- DO
-
100 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*DCONJG( V( 2, M22 ) )
- 100
-
CONTINUE
- ELSE
-
IF( WANTZ ) THEN
- DO
-
110 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*DCONJG( V( 2, M22 ) )
- 110
-
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
-
120 M = MSTART, MEND
- K
-
= 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
- 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
-
IF
- END
-
IF
- 120
-
CONTINUE
- MEND
-
= MIN( NBMPS, ( KBOT-KRCOL-1 ) / 3 )
- DO
-
130 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*DCONJG( V( 2, M ) )
- H(
-
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
- 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
-
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
- DO
-
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
- DO
-
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
-
IF
- ELSE
- I2
-
= ( KDU+1 ) / 2
- I4
-
= KDU
- J2
-
= I4 - I2
- J4
-
= KDU
- KZS
-
= ( J4-J2 ) - ( NS+1 )
- KNZ
-
= NS + 1
- DO
-
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
- DO
-
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
- DO
-
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
-
IF
- END
-
IF
- END
-
IF
- 210
-
CONTINUE
- END