claqr2 man page on Scientific

Man page or keyword search:  
man Server   26626 pages
apropos Keyword Search (all sections)
Output format
Scientific logo
[printable version]

CLAQR2(1)	    LAPACK auxiliary routine (version 3.2)	     CLAQR2(1)

NAME
SYNOPSIS
       SUBROUTINE CLAQR2( 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, LWKOPT

	   REAL		  SLAMCH

	   EXTERNAL	  SLAMCH

	   EXTERNAL	  CCOPY, CGEHRD, CGEMM, CLACPY, CLAHQR, 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 ) )

	   LWKOPT	  = JW + MAX( LWK1, LWK2 )

	   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 )

	   CALL		  CLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP
			  ), 1, JW, V, LDV, INFQR )

	   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			     CLAQR2(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]
Tweet
Polarhome, production since 1999.
Member of Polarhome portal.
Based on Fawad Halim's script.
....................................................................
Vote for polarhome
Free Shell Accounts :: the biggest list on the net