rpl/lapack/lapack/zhgeqz.f - diff

Return to zhgeqz.f CVS log

Up to [local] / rpl / lapack / lapack

Diff for /rpl/lapack/lapack/zhgeqz.f between versions 1.19 and 1.20

version 1.19, 2018/05/29 07:18:21	version 1.20, 2023/08/07 08:39:25
Line 266	Line 266
*> \author Univ. of Colorado Denver	*> \author Univ. of Colorado Denver
*> \author NAG Ltd.	*> \author NAG Ltd.
*	*
*> \date April 2012
*
*> \ingroup complex16GEcomputational	*> \ingroup complex16GEcomputational
*	*
*> \par Further Details:	*> \par Further Details:
Line 284	Line 282
$ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK,	$ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK,
$ RWORK, INFO )	$ RWORK, INFO )
*	*
* -- LAPACK computational routine (version 3.7.0) --	* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --	* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--	* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
*	*
* .. Scalar Arguments ..	* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ, JOB	CHARACTER COMPQ, COMPZ, JOB
Line 319	Line 316
DOUBLE PRECISION ABSB, ANORM, ASCALE, ATOL, BNORM, BSCALE, BTOL,	DOUBLE PRECISION ABSB, ANORM, ASCALE, ATOL, BNORM, BSCALE, BTOL,
$ C, SAFMIN, TEMP, TEMP2, TEMPR, ULP	$ C, SAFMIN, TEMP, TEMP2, TEMPR, ULP
COMPLEX*16 ABI22, AD11, AD12, AD21, AD22, CTEMP, CTEMP2,	COMPLEX*16 ABI22, AD11, AD12, AD21, AD22, CTEMP, CTEMP2,
$ CTEMP3, ESHIFT, RTDISC, S, SHIFT, SIGNBC, T1,	$ CTEMP3, ESHIFT, S, SHIFT, SIGNBC,
$ U12, X	$ U12, X, ABI12, Y
* ..	* ..
* .. External Functions ..	* .. External Functions ..
	COMPLEX*16 ZLADIV
LOGICAL LSAME	LOGICAL LSAME
DOUBLE PRECISION DLAMCH, ZLANHS	DOUBLE PRECISION DLAMCH, ZLANHS
EXTERNAL LSAME, DLAMCH, ZLANHS	EXTERNAL ZLADIV, LSAME, DLAMCH, ZLANHS
* ..	* ..
* .. External Subroutines ..	* .. External Subroutines ..
EXTERNAL XERBLA, ZLARTG, ZLASET, ZROT, ZSCAL	EXTERNAL XERBLA, ZLARTG, ZLASET, ZROT, ZSCAL
Line 351	Line 349
ILSCHR = .TRUE.	ILSCHR = .TRUE.
ISCHUR = 2	ISCHUR = 2
ELSE	ELSE
	ILSCHR = .TRUE.
ISCHUR = 0	ISCHUR = 0
END IF	END IF
*	*
Line 364	Line 363
ILQ = .TRUE.	ILQ = .TRUE.
ICOMPQ = 3	ICOMPQ = 3
ELSE	ELSE
	ILQ = .TRUE.
ICOMPQ = 0	ICOMPQ = 0
END IF	END IF
*	*
Line 377	Line 377
ILZ = .TRUE.	ILZ = .TRUE.
ICOMPZ = 3	ICOMPZ = 3
ELSE	ELSE
	ILZ = .TRUE.
ICOMPZ = 0	ICOMPZ = 0
END IF	END IF
*	*
Line 515	Line 516
IF( ILAST.EQ.ILO ) THEN	IF( ILAST.EQ.ILO ) THEN
GO TO 60	GO TO 60
ELSE	ELSE
IF( ABS1( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN	IF( ABS1( H( ILAST, ILAST-1 ) ).LE.MAX( SAFMIN, ULP*(
	$ ABS1( H( ILAST, ILAST ) ) + ABS1( H( ILAST-1, ILAST-1 )
	$ ) ) ) ) THEN
H( ILAST, ILAST-1 ) = CZERO	H( ILAST, ILAST-1 ) = CZERO
GO TO 60	GO TO 60
END IF	END IF
Line 535	Line 538
IF( J.EQ.ILO ) THEN	IF( J.EQ.ILO ) THEN
ILAZRO = .TRUE.	ILAZRO = .TRUE.
ELSE	ELSE
IF( ABS1( H( J, J-1 ) ).LE.ATOL ) THEN	IF( ABS1( H( J, J-1 ) ).LE.MAX( SAFMIN, ULP*(
	$ ABS1( H( J, J ) ) + ABS1( H( J-1, J-1 ) )
	$ ) ) ) THEN
H( J, J-1 ) = CZERO	H( J, J-1 ) = CZERO
ILAZRO = .TRUE.	ILAZRO = .TRUE.
ELSE	ELSE
Line 730	Line 735
AD22 = ( ASCALE*H( ILAST, ILAST ) ) /	AD22 = ( ASCALE*H( ILAST, ILAST ) ) /
$ ( BSCALE*T( ILAST, ILAST ) )	$ ( BSCALE*T( ILAST, ILAST ) )
ABI22 = AD22 - U12*AD21	ABI22 = AD22 - U12*AD21
	ABI12 = AD12 - U12*AD11
*	*
T1 = HALF*( AD11+ABI22 )	SHIFT = ABI22
RTDISC = SQRT( T1*2+AD12AD21-AD11*AD22 )	CTEMP = SQRT( ABI12 )*SQRT( AD21 )
TEMP = DBLE( T1-ABI22 )*DBLE( RTDISC ) +	TEMP = ABS1( CTEMP )
$ DIMAG( T1-ABI22 )*DIMAG( RTDISC )	IF( CTEMP.NE.ZERO ) THEN
IF( TEMP.LE.ZERO ) THEN	X = HALF*( AD11-SHIFT )
SHIFT = T1 + RTDISC	TEMP2 = ABS1( X )
ELSE	TEMP = MAX( TEMP, ABS1( X ) )
SHIFT = T1 - RTDISC	Y = TEMPSQRT( ( X / TEMP )2+( CTEMP / TEMP )*2 )
	IF( TEMP2.GT.ZERO ) THEN
	IF( DBLE( X / TEMP2 )*DBLE( Y )+
	$ DIMAG( X / TEMP2 )*DIMAG( Y ).LT.ZERO )Y = -Y
	END IF
	SHIFT = SHIFT - CTEMP*ZLADIV( CTEMP, ( X+Y ) )
END IF	END IF
ELSE	ELSE
*	*
* Exceptional shift. Chosen for no particularly good reason.	* Exceptional shift. Chosen for no particularly good reason.
*	*
ESHIFT = ESHIFT + (ASCALE*H(ILAST,ILAST-1))/	IF( ( IITER / 20 )*20.EQ.IITER .AND.
$ (BSCALE*T(ILAST-1,ILAST-1))	$ BSCALE*ABS1(T( ILAST, ILAST )).GT.SAFMIN ) THEN
	ESHIFT = ESHIFT + ( ASCALE*H( ILAST,
	$ ILAST ) )/( BSCALE*T( ILAST, ILAST ) )
	ELSE
	ESHIFT = ESHIFT + ( ASCALE*H( ILAST,
	$ ILAST-1 ) )/( BSCALE*T( ILAST-1, ILAST-1 ) )
	END IF
SHIFT = ESHIFT	SHIFT = ESHIFT
END IF	END IF
*	*

CVSweb interface <joel.bertrand@systella.fr>

Removed from v.1.19
changed lines
	Added in v.1.20