claqr5(l) - Linux man page

Name

Synopsis

SUBROUTINE CLAQR5( 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

H( LDH, * ), S( * ), U( LDU, * ), V( LDV, * ), WH( LDWH, * ), 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

ALPHA, BETA, CDUM, REFSUM

REAL

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

REAL

SLAMCH

EXTERNAL

SLAMCH

INTRINSIC

ABS, AIMAG, CONJG, MAX, MIN, MOD, REAL

COMPLEX

VT( 3 )

EXTERNAL

CGEMM, CLACPY, CLAQR1, CLARFG, CLASET, CTRMM, SLABAD

REAL

CABS1

CABS1(

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

IF(

NSHFTS.LT.2 ) RETURN

IF(

KTOP.GE.KBOT ) RETURN

= NSHFTS - MOD( NSHFTS, 2 )

SAFMIN

= SLAMCH( 'SAFE MINIMUM' )

SAFMAX

= RONE / SAFMIN

CALL

SLABAD( SAFMIN, SAFMAX )

ULP

= SLAMCH( 'PRECISION' )

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

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

NDCOL

= INCOL + KDU

IF(

ACCUM ) CALL CLASET( '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

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

ALPHA

= V( 1, M )

CALL

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

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

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

ALPHA

= VT( 1 )

CALL

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

REFSUM

= CONJG( VT( 1 ) )* ( H( K+1, K )+CONJG( 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

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

BETA

= V( 1, M22 )

CALL

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

ELSE

BETA

= H( K+1, K )

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

CALL

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

= CONJG( V( 1, M ) )* ( H( K+1, J )+CONJG( V( 2, M ) )*H( K+2, J )+ CONJG( 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

= CONJG( V( 1, M22 ) )* ( H( K+1, J )+CONJG( 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*CONJG( V( 2, M ) )

J, K+3 ) = H( J, K+3 ) - REFSUM*CONJG( 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*CONJG( V( 2, M ) )

J, KMS+3 ) = U( J, KMS+3 ) - REFSUM*CONJG( 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*CONJG( V( 2, M ) )

J, K+3 ) = Z( J, K+3 ) - REFSUM*CONJG( 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*CONJG( 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*CONJG( 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*CONJG( 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*CONJG( V( 2, M ) )

K+4, K+3 ) = H( K+4, K+3 ) - REFSUM*CONJG( 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

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

CALL

CLACPY( '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

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

CALL

CLACPY( '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

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

CALL

CLACPY( '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

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

CALL

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

CALL

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

CALL

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

CALL

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

CALL

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

CALL

CGEMM( '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

CLACPY( '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

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

CALL

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

CALL

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

CALL

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

CALL

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

CALL

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

CALL

CGEMM( '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

CLACPY( '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

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

CALL

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

CALL

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

CALL

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

CALL

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

CALL

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

CALL

CGEMM( '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

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

200

CONTINUE

END

210

CONTINUE

END

claqr5(l) - Linux man page

Name

Synopsis

Purpose