slaqz1()

subroutine slaqz1	(	real, dimension( lda, * ), intent(in)	a,
		integer, intent(in)	lda,
		real, dimension( ldb, * ), intent(in)	b,
		integer, intent(in)	ldb,
		real, intent(in)	sr1,
		real, intent(in)	sr2,
		real, intent(in)	si,
		real, intent(in)	beta1,
		real, intent(in)	beta2,
		real, dimension( * ), intent(out)	v )

SLAQZ1

Download SLAQZ1 + dependencies [TGZ] [ZIP] [TXT]

Purpose:

!>
!>      Given a 3-by-3 matrix pencil (A,B), SLAQZ1 sets v to a
!>      scalar multiple of the first column of the product
!>
!>      (*)  K = (A - (beta2*sr2 - i*si)*B)*B^(-1)*(beta1*A - (sr2 + i*si2)*B)*B^(-1).
!>
!>      It is assumed that either
!>
!>              1) sr1 = sr2
!>          or
!>              2) si = 0.
!>
!>      This is useful for starting double implicit shift bulges
!>      in the QZ algorithm.
!> 

Parameters

[in]	A	!> A is REAL array, dimension (LDA,N) !> The 3-by-3 matrix A in (*). !>
[in]	LDA	!> LDA is INTEGER !> The leading dimension of A as declared in !> the calling procedure. !>
[in]	B	!> B is REAL array, dimension (LDB,N) !> The 3-by-3 matrix B in (*). !>
[in]	LDB	!> LDB is INTEGER !> The leading dimension of B as declared in !> the calling procedure. !>
[in]	SR1	!> SR1 is REAL !>
[in]	SR2	!> SR2 is REAL !>
[in]	SI	!> SI is REAL !>
[in]	BETA1	!> BETA1 is REAL !>
[in]	BETA2	!> BETA2 is REAL !>
[out]	V	!> V is REAL array, dimension (N) !> A scalar multiple of the first column of the !> matrix K in (*). !>

Author

Thijs Steel, KU Leuven

Date

May 2020

Definition at line 123 of file slaqz1.f.

      IMPLICIT NONE
*
*     Arguments
      INTEGER, INTENT( IN ) :: LDA, LDB
      REAL, INTENT( IN ) :: A( LDA, * ), B( LDB, * ), SR1, SR2, SI,
     $   BETA1, BETA2
      REAL, INTENT( OUT ) :: V( * )
*
*     Parameters
      REAL :: ZERO, ONE, HALF
      parameter( zero = 0.0, one = 1.0, half = 0.5 )
*
*     Local scalars
      REAL :: W( 2 ), SAFMIN, SAFMAX, SCALE1, SCALE2
*
*     External Functions
      REAL, EXTERNAL :: SLAMCH
      LOGICAL, EXTERNAL :: SISNAN
*
      safmin = slamch( 'SAFE MINIMUM' )
      safmax = one/safmin
*
*     Calculate first shifted vector
*
      w( 1 ) = beta1*a( 1, 1 )-sr1*b( 1, 1 )
      w( 2 ) = beta1*a( 2, 1 )-sr1*b( 2, 1 )
      scale1 = sqrt( abs( w( 1 ) ) ) * sqrt( abs( w( 2 ) ) )
      IF( scale1 .GE. safmin .AND. scale1 .LE. safmax ) THEN
         w( 1 ) = w( 1 )/scale1
         w( 2 ) = w( 2 )/scale1
      END IF
*
*     Solve linear system
*
      w( 2 ) = w( 2 )/b( 2, 2 )
      w( 1 ) = ( w( 1 )-b( 1, 2 )*w( 2 ) )/b( 1, 1 )
      scale2 = sqrt( abs( w( 1 ) ) ) * sqrt( abs( w( 2 ) ) )
      IF( scale2 .GE. safmin .AND. scale2 .LE. safmax ) THEN
         w( 1 ) = w( 1 )/scale2
         w( 2 ) = w( 2 )/scale2
      END IF
*
*     Apply second shift
*
      v( 1 ) = beta2*( a( 1, 1 )*w( 1 )+a( 1, 2 )*w( 2 ) )-sr2*( b( 1,
     $   1 )*w( 1 )+b( 1, 2 )*w( 2 ) )
      v( 2 ) = beta2*( a( 2, 1 )*w( 1 )+a( 2, 2 )*w( 2 ) )-sr2*( b( 2,
     $   1 )*w( 1 )+b( 2, 2 )*w( 2 ) )
      v( 3 ) = beta2*( a( 3, 1 )*w( 1 )+a( 3, 2 )*w( 2 ) )-sr2*( b( 3,
     $   1 )*w( 1 )+b( 3, 2 )*w( 2 ) )
*
*     Account for imaginary part
*
      v( 1 ) = v( 1 )+si*si*b( 1, 1 )/scale1/scale2
*
*     Check for overflow
*
      IF( abs( v( 1 ) ).GT.safmax .OR. abs( v( 2 ) ) .GT. safmax .OR.
     $   abs( v( 3 ) ).GT.safmax .OR. sisnan( v( 1 ) ) .OR.
     $   sisnan( v( 2 ) ) .OR. sisnan( v( 3 ) ) ) THEN
         v( 1 ) = zero
         v( 2 ) = zero
         v( 3 ) = zero
      END IF
*
*     End of SLAQZ1
*

Here is the caller graph for this function: