slaeda()

subroutine slaeda	(	integer	n,
		integer	tlvls,
		integer	curlvl,
		integer	curpbm,
		integer, dimension( * )	prmptr,
		integer, dimension( * )	perm,
		integer, dimension( * )	givptr,
		integer, dimension( 2, * )	givcol,
		real, dimension( 2, * )	givnum,
		real, dimension( * )	q,
		integer, dimension( * )	qptr,
		real, dimension( * )	z,
		real, dimension( * )	ztemp,
		integer	info )

SLAEDA used by SSTEDC. Computes the Z vector determining the rank-one modification of the diagonal matrix. Used when the original matrix is dense.

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

Purpose:

!>
!> SLAEDA computes the Z vector corresponding to the merge step in the
!> CURLVLth step of the merge process with TLVLS steps for the CURPBMth
!> problem.
!> 

Parameters

[in]	N	!> N is INTEGER !> The dimension of the symmetric tridiagonal matrix. N >= 0. !>
[in]	TLVLS	!> TLVLS is INTEGER !> The total number of merging levels in the overall divide and !> conquer tree. !>
[in]	CURLVL	!> CURLVL is INTEGER !> The current level in the overall merge routine, !> 0 <= curlvl <= tlvls. !>
[in]	CURPBM	!> CURPBM is INTEGER !> The current problem in the current level in the overall !> merge routine (counting from upper left to lower right). !>
[in]	PRMPTR	!> PRMPTR is INTEGER array, dimension (N lg N) !> Contains a list of pointers which indicate where in PERM a !> level's permutation is stored. PRMPTR(i+1) - PRMPTR(i) !> indicates the size of the permutation and incidentally the !> size of the full, non-deflated problem. !>
[in]	PERM	!> PERM is INTEGER array, dimension (N lg N) !> Contains the permutations (from deflation and sorting) to be !> applied to each eigenblock. !>
[in]	GIVPTR	!> GIVPTR is INTEGER array, dimension (N lg N) !> Contains a list of pointers which indicate where in GIVCOL a !> level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i) !> indicates the number of Givens rotations. !>
[in]	GIVCOL	!> GIVCOL is INTEGER array, dimension (2, N lg N) !> Each pair of numbers indicates a pair of columns to take place !> in a Givens rotation. !>
[in]	GIVNUM	!> GIVNUM is REAL array, dimension (2, N lg N) !> Each number indicates the S value to be used in the !> corresponding Givens rotation. !>
[in]	Q	!> Q is REAL array, dimension (N**2) !> Contains the square eigenblocks from previous levels, the !> starting positions for blocks are given by QPTR. !>
[in]	QPTR	!> QPTR is INTEGER array, dimension (N+2) !> Contains a list of pointers which indicate where in Q an !> eigenblock is stored. SQRT( QPTR(i+1) - QPTR(i) ) indicates !> the size of the block. !>
[out]	Z	!> Z is REAL array, dimension (N) !> On output this vector contains the updating vector (the last !> row of the first sub-eigenvector matrix and the first row of !> the second sub-eigenvector matrix). !>
[out]	ZTEMP	!> ZTEMP is REAL array, dimension (N) !>
[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.

Contributors:

Jeff Rutter, Computer Science Division, University of California at Berkeley, USA

Definition at line 162 of file slaeda.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            CURLVL, CURPBM, INFO, N, TLVLS
*     ..
*     .. Array Arguments ..
      INTEGER            GIVCOL( 2, * ), GIVPTR( * ), PERM( * ),
     $                   PRMPTR( * ), QPTR( * )
      REAL               GIVNUM( 2, * ), Q( * ), Z( * ), ZTEMP( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, HALF, ONE
      parameter( zero = 0.0e0, half = 0.5e0, one = 1.0e0 )
*     ..
*     .. Local Scalars ..
      INTEGER            BSIZ1, BSIZ2, CURR, I, K, MID, PSIZ1, PSIZ2,
     $                   PTR, ZPTR1
*     ..
*     .. External Subroutines ..
      EXTERNAL           scopy, sgemv, srot, xerbla
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          int, real, sqrt
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      info = 0
*
      IF( n.LT.0 ) THEN
         info = -1
      END IF
      IF( info.NE.0 ) THEN
         CALL xerbla( 'SLAEDA', -info )
         RETURN
      END IF
*
*     Quick return if possible
*
      IF( n.EQ.0 )
     $   RETURN
*
*     Determine location of first number in second half.
*
      mid = n / 2 + 1
*
*     Gather last/first rows of appropriate eigenblocks into center of Z
*
      ptr = 1
*
*     Determine location of lowest level subproblem in the full storage
*     scheme
*
      curr = ptr + curpbm*2**curlvl + 2**( curlvl-1 ) - 1
*
*     Determine size of these matrices.  We add HALF to the value of
*     the SQRT in case the machine underestimates one of these square
*     roots.
*
      bsiz1 = int( half+sqrt( real( qptr( curr+1 )-qptr( curr ) ) ) )
      bsiz2 = int( half+sqrt( real( qptr( curr+2 )-qptr( curr+1 ) ) ) )
      DO 10 k = 1, mid - bsiz1 - 1
         z( k ) = zero
   10 CONTINUE
      CALL scopy( bsiz1, q( qptr( curr )+bsiz1-1 ), bsiz1,
     $            z( mid-bsiz1 ), 1 )
      CALL scopy( bsiz2, q( qptr( curr+1 ) ), bsiz2, z( mid ), 1 )
      DO 20 k = mid + bsiz2, n
         z( k ) = zero
   20 CONTINUE
*
*     Loop through remaining levels 1 -> CURLVL applying the Givens
*     rotations and permutation and then multiplying the center matrices
*     against the current Z.
*
      ptr = 2**tlvls + 1
      DO 70 k = 1, curlvl - 1
         curr = ptr + curpbm*2**( curlvl-k ) + 2**( curlvl-k-1 ) - 1
         psiz1 = prmptr( curr+1 ) - prmptr( curr )
         psiz2 = prmptr( curr+2 ) - prmptr( curr+1 )
         zptr1 = mid - psiz1
*
*       Apply Givens at CURR and CURR+1
*
         DO 30 i = givptr( curr ), givptr( curr+1 ) - 1
            CALL srot( 1, z( zptr1+givcol( 1, i )-1 ), 1,
     $                 z( zptr1+givcol( 2, i )-1 ), 1, givnum( 1, i ),
     $                 givnum( 2, i ) )
   30    CONTINUE
         DO 40 i = givptr( curr+1 ), givptr( curr+2 ) - 1
            CALL srot( 1, z( mid-1+givcol( 1, i ) ), 1,
     $                 z( mid-1+givcol( 2, i ) ), 1, givnum( 1, i ),
     $                 givnum( 2, i ) )
   40    CONTINUE
         psiz1 = prmptr( curr+1 ) - prmptr( curr )
         psiz2 = prmptr( curr+2 ) - prmptr( curr+1 )
         DO 50 i = 0, psiz1 - 1
            ztemp( i+1 ) = z( zptr1+perm( prmptr( curr )+i )-1 )
   50    CONTINUE
         DO 60 i = 0, psiz2 - 1
            ztemp( psiz1+i+1 ) = z( mid+perm( prmptr( curr+1 )+i )-1 )
   60    CONTINUE
*
*        Multiply Blocks at CURR and CURR+1
*
*        Determine size of these matrices.  We add HALF to the value of
*        the SQRT in case the machine underestimates one of these
*        square roots.
*
         bsiz1 = int( half+sqrt( real( qptr( curr+1 )-qptr( curr ) ) ) )
         bsiz2 = int( half+sqrt( real( qptr( curr+2 )-qptr( curr+
     $           1 ) ) ) )
         IF( bsiz1.GT.0 ) THEN
            CALL sgemv( 'T', bsiz1, bsiz1, one, q( qptr( curr ) ),
     $                  bsiz1, ztemp( 1 ), 1, zero, z( zptr1 ), 1 )
         END IF
         CALL scopy( psiz1-bsiz1, ztemp( bsiz1+1 ), 1,
     $               z( zptr1+bsiz1 ),
     $               1 )
         IF( bsiz2.GT.0 ) THEN
            CALL sgemv( 'T', bsiz2, bsiz2, one, q( qptr( curr+1 ) ),
     $                  bsiz2, ztemp( psiz1+1 ), 1, zero, z( mid ), 1 )
         END IF
         CALL scopy( psiz2-bsiz2, ztemp( psiz1+bsiz2+1 ), 1,
     $               z( mid+bsiz2 ), 1 )
*
         ptr = ptr + 2**( tlvls-k )
   70 CONTINUE
*
      RETURN
*
*     End of SLAEDA
*

Here is the call graph for this function:

Here is the caller graph for this function: