claqr3 man page on Scientific
[printable version]
CLAQR3(1) LAPACK auxiliary routine (version 3.2) CLAQR3(1)
NAME
SYNOPSIS
SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, IHIZ,
Z, LDZ, NS, ND, SH, 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
COMPLEX H( LDH, * ), SH( * ), T( LDT, * ), V( LDV, * ),
WORK( * ), 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 BETA, CDUM, S, TAU
REAL FOO, SAFMAX, SAFMIN, SMLNUM, ULP
INTEGER I, IFST, ILST, INFO, INFQR, J, JW, KCOL, KLN, KNT,
KROW, KWTOP, LTOP, LWK1, LWK2, LWK3, LWKOPT, NMIN
REAL SLAMCH
INTEGER ILAENV
EXTERNAL SLAMCH, ILAENV
EXTERNAL CCOPY, CGEHRD, CGEMM, CLACPY, CLAHQR, CLAQR4, CLARF,
CLARFG, CLASET, CTREXC, CUNMHR, SLABAD
INTRINSIC ABS, AIMAG, CMPLX, CONJG, INT, MAX, MIN, REAL
REAL CABS1
CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) )
JW = MIN( NW, KBOT-KTOP+1 )
IF( JW.LE.2 ) THEN
LWKOPT = 1
ELSE
CALL CGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
LWK1 = INT( WORK( 1 ) )
CALL CUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V,
LDV, WORK, -1, INFO )
LWK2 = INT( WORK( 1 ) )
CALL CLAQR4( .true., .true., JW, 1, JW, T, LDT, SH, 1,
JW, V, LDV, WORK, -1, INFQR )
LWK3 = INT( WORK( 1 ) )
LWKOPT = MAX( JW+MAX( LWK1, LWK2 ), LWK3 )
END IF
IF( LWORK.EQ.-1 ) THEN
WORK( 1 ) = CMPLX( LWKOPT, 0 )
RETURN
END IF
NS = 0
ND = 0
WORK( 1 ) = ONE
IF( KTOP.GT.KBOT ) RETURN
IF( NW.LT.1 ) RETURN
SAFMIN = SLAMCH( 'SAFE MINIMUM' )
SAFMAX = RONE / SAFMIN
CALL SLABAD( SAFMIN, SAFMAX )
ULP = SLAMCH( 'PRECISION' )
SMLNUM = SAFMIN*( REAL( N ) / ULP )
JW = MIN( NW, KBOT-KTOP+1 )
KWTOP = KBOT - JW + 1
IF( KWTOP.EQ.KTOP ) THEN
S = ZERO
ELSE
S = H( KWTOP, KWTOP-1 )
END IF
IF( KBOT.EQ.KWTOP ) THEN
SH( KWTOP ) = H( KWTOP, KWTOP )
NS = 1
ND = 0
IF( CABS1( S ).LE.MAX( SMLNUM, ULP*CABS1( H( KWTOP,
KWTOP ) ) ) ) THEN
NS = 0
ND = 1
IF( KWTOP.GT.KTOP ) H( KWTOP, KWTOP-1 ) = ZERO
END IF
WORK( 1 ) = ONE
RETURN
END IF
CALL CLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT
)
CALL CCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ),
LDT+1 )
CALL CLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
NMIN = ILAENV( 12, 'CLAQR3', 'SV', JW, 1, JW, LWORK )
IF( JW.GT.NMIN ) THEN
CALL CLAQR4( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP
), 1, JW, V, LDV, WORK, LWORK, INFQR )
ELSE
CALL CLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP
), 1, JW, V, LDV, INFQR )
END IF
NS = JW
ILST = INFQR + 1
DO 10 KNT = INFQR + 1, JW
FOO = CABS1( T( NS, NS ) )
IF( FOO.EQ.RZERO ) FOO = CABS1( S )
IF( CABS1( S )*CABS1( V( 1, NS ) ).LE.MAX( SMLNUM,
ULP*FOO ) ) THEN
NS = NS - 1
ELSE
IFST = NS
CALL CTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )
ILST = ILST + 1
END IF
10 CONTINUE
IF( NS.EQ.0 ) S = ZERO
IF( NS.LT.JW ) THEN
DO 30 I = INFQR + 1, NS
IFST = I
DO 20 J = I + 1, NS
IF( CABS1( T( J, J ) ).GT.CABS1( T( IFST, IFST ) ) )
IFST = J
20 CONTINUE
ILST = I
IF( IFST.NE.ILST ) CALL CTREXC( 'V', JW, T, LDT, V, LDV,
IFST, ILST, INFO )
30 CONTINUE
END IF
DO 40 I = INFQR + 1, JW
SH( KWTOP+I-1 ) = T( I, I )
40 CONTINUE
IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN
IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
CALL CCOPY( NS, V, LDV, WORK, 1 )
DO 50 I = 1, NS
WORK( I ) = CONJG( WORK( I ) )
50 CONTINUE
BETA = WORK( 1 )
CALL CLARFG( NS, BETA, WORK( 2 ), 1, TAU )
WORK( 1 ) = ONE
CALL CLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT
)
CALL CLARF( 'L', NS, JW, WORK, 1, CONJG( TAU ), T, LDT,
WORK( JW+1 ) )
CALL CLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT, WORK( JW+1
) )
CALL CLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV, WORK( JW+1
) )
CALL CGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
LWORK-JW, INFO )
END IF
IF( KWTOP.GT.1 ) H( KWTOP, KWTOP-1 ) = S*CONJG( V( 1, 1
) )
CALL CLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH
)
CALL CCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ),
LDH+1 )
IF( NS.GT.1 .AND. S.NE.ZERO ) CALL CUNMHR( '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 IF
DO 60 KROW = LTOP, KWTOP - 1, NV
KLN = MIN( NV, KWTOP-KROW )
CALL CGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
LDH, V, LDV, ZERO, WV, LDWV )
CALL CLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ),
LDH )
60 CONTINUE
IF( WANTT ) THEN
DO 70 KCOL = KBOT + 1, N, NH
KLN = MIN( NH, N-KCOL+1 )
CALL CGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV, H( KWTOP,
KCOL ), LDH, ZERO, T, LDT )
CALL CLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ), LDH
)
70 CONTINUE
END IF
IF( WANTZ ) THEN
DO 80 KROW = ILOZ, IHIZ, NV
KLN = MIN( NV, IHIZ-KROW+1 )
CALL CGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
LDZ, V, LDV, ZERO, WV, LDWV )
CALL CLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
LDZ )
80 CONTINUE
END IF
END IF
ND = JW - NS
NS = NS - INFQR
WORK( 1 ) = CMPLX( LWKOPT, 0 )
END
PURPOSE
LAPACK auxiliary routine (versioNovember 2008 CLAQR3(1)
[top]
List of man pages available for Scientific
Copyright (c) for man pages and the logo by the respective OS vendor.
For those who want to learn more, the polarhome community provides shell access and support.
[legal]
[privacy]
[GNU]
[policy]
[cookies]
[netiquette]
[sponsors]
[FAQ]
Polarhome, production since 1999.
Member of Polarhome portal.
Based on Fawad Halim's script.
....................................................................
|
Vote for polarhome
|