166 SUBROUTINE dlaeda( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR,
167 $ givcol, givnum, q, qptr, z, ztemp, info )
175 INTEGER curlvl, curpbm, info, n, tlvls
178 INTEGER givcol( 2, * ), givptr( * ), perm( * ),
179 $ prmptr( * ), qptr( * )
180 DOUBLE PRECISION givnum( 2, * ), q( * ), z( * ), ztemp( * )
186 DOUBLE PRECISION zero, half, one
187 parameter( zero = 0.0d0, half = 0.5d0, one = 1.0d0 )
190 INTEGER bsiz1, bsiz2, curr, i, k, mid, psiz1, psiz2,
197 INTRINSIC dble, int, sqrt
209 CALL
xerbla(
'DLAEDA', -info )
229 curr = ptr + curpbm*2**curlvl + 2**( curlvl-1 ) - 1
235 bsiz1 = int( half+sqrt( dble( qptr( curr+1 )-qptr( curr ) ) ) )
236 bsiz2 = int( half+sqrt( dble( qptr( curr+2 )-qptr( curr+1 ) ) ) )
237 DO 10 k = 1, mid - bsiz1 - 1
240 CALL
dcopy( bsiz1, q( qptr( curr )+bsiz1-1 ), bsiz1,
241 $ z( mid-bsiz1 ), 1 )
242 CALL
dcopy( bsiz2, q( qptr( curr+1 ) ), bsiz2, z( mid ), 1 )
243 DO 20 k = mid + bsiz2, n
252 DO 70 k = 1, curlvl - 1
253 curr = ptr + curpbm*2**( curlvl-k ) + 2**( curlvl-k-1 ) - 1
254 psiz1 = prmptr( curr+1 ) - prmptr( curr )
255 psiz2 = prmptr( curr+2 ) - prmptr( curr+1 )
260 DO 30 i = givptr( curr ), givptr( curr+1 ) - 1
261 CALL
drot( 1, z( zptr1+givcol( 1, i )-1 ), 1,
262 $ z( zptr1+givcol( 2, i )-1 ), 1, givnum( 1, i ),
265 DO 40 i = givptr( curr+1 ), givptr( curr+2 ) - 1
266 CALL
drot( 1, z( mid-1+givcol( 1, i ) ), 1,
267 $ z( mid-1+givcol( 2, i ) ), 1, givnum( 1, i ),
270 psiz1 = prmptr( curr+1 ) - prmptr( curr )
271 psiz2 = prmptr( curr+2 ) - prmptr( curr+1 )
272 DO 50 i = 0, psiz1 - 1
273 ztemp( i+1 ) = z( zptr1+perm( prmptr( curr )+i )-1 )
275 DO 60 i = 0, psiz2 - 1
276 ztemp( psiz1+i+1 ) = z( mid+perm( prmptr( curr+1 )+i )-1 )
285 bsiz1 = int( half+sqrt( dble( qptr( curr+1 )-qptr( curr ) ) ) )
286 bsiz2 = int( half+sqrt( dble( qptr( curr+2 )-qptr( curr+
288 IF( bsiz1.GT.0 )
THEN
289 CALL
dgemv(
'T', bsiz1, bsiz1, one, q( qptr( curr ) ),
290 $ bsiz1, ztemp( 1 ), 1, zero, z( zptr1 ), 1 )
292 CALL
dcopy( psiz1-bsiz1, ztemp( bsiz1+1 ), 1, z( zptr1+bsiz1 ),
294 IF( bsiz2.GT.0 )
THEN
295 CALL
dgemv(
'T', bsiz2, bsiz2, one, q( qptr( curr+1 ) ),
296 $ bsiz2, ztemp( psiz1+1 ), 1, zero, z( mid ), 1 )
298 CALL
dcopy( psiz2-bsiz2, ztemp( psiz1+bsiz2+1 ), 1,
299 $ z( mid+bsiz2 ), 1 )
301 ptr = ptr + 2**( tlvls-k )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlaeda(N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR, GIVCOL, GIVNUM, Q, QPTR, Z, ZTEMP, INFO)
DLAEDA used by sstedc. Computes the Z vector determining the rank-one modification of the diagonal ma...
subroutine drot(N, DX, INCX, DY, INCY, C, S)
DROT
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV