207 SUBROUTINE sgghrd( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
208 $ ldq, z, ldz, info )
216 CHARACTER COMPQ, COMPZ
217 INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, N
220 REAL A( lda, * ), B( ldb, * ), Q( ldq, * ),
228 parameter( one = 1.0e+0, zero = 0.0e+0 )
232 INTEGER ICOMPQ, ICOMPZ, JCOL, JROW
249 IF( lsame( compq,
'N' ) )
THEN
252 ELSE IF( lsame( compq,
'V' ) )
THEN
255 ELSE IF( lsame( compq,
'I' ) )
THEN
264 IF( lsame( compz,
'N' ) )
THEN
267 ELSE IF( lsame( compz,
'V' ) )
THEN
270 ELSE IF( lsame( compz,
'I' ) )
THEN
280 IF( icompq.LE.0 )
THEN
282 ELSE IF( icompz.LE.0 )
THEN
284 ELSE IF( n.LT.0 )
THEN
286 ELSE IF( ilo.LT.1 )
THEN
288 ELSE IF( ihi.GT.n .OR. ihi.LT.ilo-1 )
THEN
290 ELSE IF( lda.LT.max( 1, n ) )
THEN
292 ELSE IF( ldb.LT.max( 1, n ) )
THEN
294 ELSE IF( ( ilq .AND. ldq.LT.n ) .OR. ldq.LT.1 )
THEN
296 ELSE IF( ( ilz .AND. ldz.LT.n ) .OR. ldz.LT.1 )
THEN
300 CALL
xerbla(
'SGGHRD', -info )
307 $ CALL
slaset(
'Full', n, n, zero, one, q, ldq )
309 $ CALL
slaset(
'Full', n, n, zero, one, z, ldz )
318 DO 20 jcol = 1, n - 1
319 DO 10 jrow = jcol + 1, n
320 b( jrow, jcol ) = zero
326 DO 40 jcol = ilo, ihi - 2
328 DO 30 jrow = ihi, jcol + 2, -1
332 temp = a( jrow-1, jcol )
333 CALL
slartg( temp, a( jrow, jcol ), c, s,
334 $ a( jrow-1, jcol ) )
335 a( jrow, jcol ) = zero
336 CALL
srot( n-jcol, a( jrow-1, jcol+1 ), lda,
337 $ a( jrow, jcol+1 ), lda, c, s )
338 CALL
srot( n+2-jrow, b( jrow-1, jrow-1 ), ldb,
339 $ b( jrow, jrow-1 ), ldb, c, s )
341 $ CALL
srot( n, q( 1, jrow-1 ), 1, q( 1, jrow ), 1, c, s )
345 temp = b( jrow, jrow )
346 CALL
slartg( temp, b( jrow, jrow-1 ), c, s,
348 b( jrow, jrow-1 ) = zero
349 CALL
srot( ihi, a( 1, jrow ), 1, a( 1, jrow-1 ), 1, c, s )
350 CALL
srot( jrow-1, b( 1, jrow ), 1, b( 1, jrow-1 ), 1, c,
353 $ CALL
srot( n, z( 1, jrow ), 1, z( 1, jrow-1 ), 1, c, s )
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine sgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
SGGHRD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slartg(F, G, CS, SN, R)
SLARTG generates a plane rotation with real cosine and real sine.
subroutine srot(N, SX, INCX, SY, INCY, C, S)
SROT