sgehrd()

subroutine sgehrd	(	integer	n,
		integer	ilo,
		integer	ihi,
		real, dimension( lda, * )	a,
		integer	lda,
		real, dimension( * )	tau,
		real, dimension( * )	work,
		integer	lwork,
		integer	info )

SGEHRD

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

Purpose:

!>
!> SGEHRD reduces a real general matrix A to upper Hessenberg form H by
!> an orthogonal similarity transformation:  Q**T * A * Q = H .
!> 

Parameters

[in]	N	!> N is INTEGER !> The order of the matrix A. N >= 0. !>
[in]	ILO	!> ILO is INTEGER !>
[in]	IHI	!> IHI is INTEGER !> !> It is assumed that A is already upper triangular in rows !> and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally !> set by a previous call to SGEBAL; otherwise they should be !> set to 1 and N respectively. See Further Details. !> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. !>
[in,out]	A	!> A is REAL array, dimension (LDA,N) !> On entry, the N-by-N general matrix to be reduced. !> On exit, the upper triangle and the first subdiagonal of A !> are overwritten with the upper Hessenberg matrix H, and the !> elements below the first subdiagonal, with the array TAU, !> represent the orthogonal matrix Q as a product of elementary !> reflectors. See Further Details. !>
[in]	LDA	!> LDA is INTEGER !> The leading dimension of the array A. LDA >= max(1,N). !>
[out]	TAU	!> TAU is REAL array, dimension (N-1) !> The scalar factors of the elementary reflectors (see Further !> Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to !> zero. !>
[out]	WORK	!> WORK is REAL array, dimension (MAX(1,LWORK)) !> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. !>
[in]	LWORK	!> LWORK is INTEGER !> The length of the array WORK. LWORK >= max(1,N). !> For good performance, LWORK should generally be larger. !> !> If LWORK = -1, then a workspace query is assumed; the routine !> only calculates the optimal size of the WORK array, returns !> this value as the first entry of the WORK array, and no error !> message related to LWORK is issued by XERBLA. !>
[out]	INFO	!> INFO is INTEGER !> = 0: successful exit !> < 0: if INFO = -i, the i-th argument had an illegal value. !>

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Further Details:

!>
!>  The matrix Q is represented as a product of (ihi-ilo) elementary
!>  reflectors
!>
!>     Q = H(ilo) H(ilo+1) . . . H(ihi-1).
!>
!>  Each H(i) has the form
!>
!>     H(i) = I - tau * v * v**T
!>
!>  where tau is a real scalar, and v is a real vector with
!>  v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
!>  exit in A(i+2:ihi,i), and tau in TAU(i).
!>
!>  The contents of A are illustrated by the following example, with
!>  n = 7, ilo = 2 and ihi = 6:
!>
!>  on entry,                        on exit,
!>
!>  ( a   a   a   a   a   a   a )    (  a   a   h   h   h   h   a )
!>  (     a   a   a   a   a   a )    (      a   h   h   h   h   a )
!>  (     a   a   a   a   a   a )    (      h   h   h   h   h   h )
!>  (     a   a   a   a   a   a )    (      v2  h   h   h   h   h )
!>  (     a   a   a   a   a   a )    (      v2  v3  h   h   h   h )
!>  (     a   a   a   a   a   a )    (      v2  v3  v4  h   h   h )
!>  (                         a )    (                          a )
!>
!>  where a denotes an element of the original matrix A, h denotes a
!>  modified element of the upper Hessenberg matrix H, and vi denotes an
!>  element of the vector defining H(i).
!>
!>  This file is a slight modification of LAPACK-3.0's SGEHRD
!>  subroutine incorporating improvements proposed by Quintana-Orti and
!>  Van de Geijn (2006). (See SLAHR2.)
!> 

Definition at line 164 of file sgehrd.f.

*
*  -- LAPACK computational routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      INTEGER            IHI, ILO, INFO, LDA, LWORK, N
*     ..
*     .. Array Arguments ..
      REAL               A( LDA, * ), TAU( * ), WORK( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            NBMAX, LDT, TSIZE
      parameter( nbmax = 64, ldt = nbmax+1,
     $                     tsize = ldt*nbmax )
      REAL               ZERO, ONE
      parameter( zero = 0.0e+0,
     $                     one = 1.0e+0 )
*     ..
*     .. Local Scalars ..
      LOGICAL            LQUERY
      INTEGER            I, IB, IINFO, IWT, J, LDWORK, LWKOPT, NB,
     $                   NBMIN, NH, NX
      REAL               EI
*     ..
*     .. External Subroutines ..
      EXTERNAL           saxpy, sgehd2, sgemm, slahr2, slarfb,
     $                   strmm,
     $                   xerbla
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          max, min
*     ..
*     .. External Functions ..
      INTEGER            ILAENV
      REAL               SROUNDUP_LWORK
      EXTERNAL           ilaenv, sroundup_lwork
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters
*
      info = 0
      lquery = ( lwork.EQ.-1 )
      IF( n.LT.0 ) THEN
         info = -1
      ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) ) THEN
         info = -2
      ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n ) THEN
         info = -3
      ELSE IF( lda.LT.max( 1, n ) ) THEN
         info = -5
      ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery ) THEN
         info = -8
      END IF
*
      nh = ihi - ilo + 1
      IF( info.EQ.0 ) THEN
*
*       Compute the workspace requirements
*
         IF( nh.LE.1 ) THEN
            lwkopt = 1
         ELSE
            nb = min( nbmax, ilaenv( 1, 'SGEHRD', ' ', n, ilo, ihi,
     $                              -1 ) )
            lwkopt = n*nb + tsize
         ENDIF
         work( 1 ) = sroundup_lwork( lwkopt )
      END IF
*
      IF( info.NE.0 ) THEN
         CALL xerbla( 'SGEHRD', -info )
         RETURN
      ELSE IF( lquery ) THEN
         RETURN
      END IF
*
*     Set elements 1:ILO-1 and IHI:N-1 of TAU to zero
*
      DO 10 i = 1, ilo - 1
         tau( i ) = zero
   10 CONTINUE
      DO 20 i = max( 1, ihi ), n - 1
         tau( i ) = zero
   20 CONTINUE
*
*     Quick return if possible
*
      IF( nh.LE.1 ) THEN
         work( 1 ) = 1
         RETURN
      END IF
*
*     Determine the block size
*
      nb = min( nbmax, ilaenv( 1, 'SGEHRD', ' ', n, ilo, ihi, -1 ) )
      nbmin = 2
      IF( nb.GT.1 .AND. nb.LT.nh ) THEN
*
*        Determine when to cross over from blocked to unblocked code
*        (last block is always handled by unblocked code)
*
         nx = max( nb, ilaenv( 3, 'SGEHRD', ' ', n, ilo, ihi, -1 ) )
         IF( nx.LT.nh ) THEN
*
*           Determine if workspace is large enough for blocked code
*
            IF( lwork.LT.lwkopt ) THEN
*
*              Not enough workspace to use optimal NB:  determine the
*              minimum value of NB, and reduce NB or force use of
*              unblocked code
*
               nbmin = max( 2, ilaenv( 2, 'SGEHRD', ' ', n, ilo, ihi,
     $                 -1 ) )
               IF( lwork.GE.(n*nbmin + tsize) ) THEN
                  nb = (lwork-tsize) / n
               ELSE
                  nb = 1
               END IF
            END IF
         END IF
      END IF
      ldwork = n
*
      IF( nb.LT.nbmin .OR. nb.GE.nh ) THEN
*
*        Use unblocked code below
*
         i = ilo
*
      ELSE
*
*        Use blocked code
*
         iwt = 1 + n*nb
         DO 40 i = ilo, ihi - 1 - nx, nb
            ib = min( nb, ihi-i )
*
*           Reduce columns i:i+ib-1 to Hessenberg form, returning the
*           matrices V and T of the block reflector H = I - V*T*V**T
*           which performs the reduction, and also the matrix Y = A*V*T
*
            CALL slahr2( ihi, i, ib, a( 1, i ), lda, tau( i ),
     $                   work( iwt ), ldt, work, ldwork )
*
*           Apply the block reflector H to A(1:ihi,i+ib:ihi) from the
*           right, computing  A := A - Y * V**T. V(i+ib,ib-1) must be set
*           to 1
*
            ei = a( i+ib, i+ib-1 )
            a( i+ib, i+ib-1 ) = one
            CALL sgemm( 'No transpose', 'Transpose',
     $                  ihi, ihi-i-ib+1,
     $                  ib, -one, work, ldwork, a( i+ib, i ), lda, one,
     $                  a( 1, i+ib ), lda )
            a( i+ib, i+ib-1 ) = ei
*
*           Apply the block reflector H to A(1:i,i+1:i+ib-1) from the
*           right
*
            CALL strmm( 'Right', 'Lower', 'Transpose',
     $                  'Unit', i, ib-1,
     $                  one, a( i+1, i ), lda, work, ldwork )
            DO 30 j = 0, ib-2
               CALL saxpy( i, -one, work( ldwork*j+1 ), 1,
     $                     a( 1, i+j+1 ), 1 )
   30       CONTINUE
*
*           Apply the block reflector H to A(i+1:ihi,i+ib:n) from the
*           left
*
            CALL slarfb( 'Left', 'Transpose', 'Forward',
     $                   'Columnwise',
     $                   ihi-i, n-i-ib+1, ib, a( i+1, i ), lda,
     $                   work( iwt ), ldt, a( i+1, i+ib ), lda,
     $                   work, ldwork )
   40    CONTINUE
      END IF
*
*     Use unblocked code to reduce the rest of the matrix
*
      CALL sgehd2( n, i, ihi, a, lda, tau, work, iinfo )
*
      work( 1 ) = sroundup_lwork( lwkopt )
*
      RETURN
*
*     End of SGEHRD
*

Here is the call graph for this function:

Here is the caller graph for this function: