CLAQR5 man page on Scientific

Printed from http://www.polarhome.com/service/man/?qf=CLAQR5&af=0&tf=2&of=Scientific

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

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

	   NS		  = 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

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

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

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

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

	   H(		  K+1, K ) = BETA

	   H(		  K+2, K ) = ZERO

	   H(		  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( REF‐
			  SUM*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		  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 )

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

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

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

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

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

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

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

	   DO		  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

	   DO		  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		  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		  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

	   DO		  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

	   DO		  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		  IF

	   END		  IF

	   END		  IF

	   210		  CONTINUE

	   END

PURPOSE
 LAPACK auxiliary routine (versioNovember 2008			     CLAQR5(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