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 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
subroutine xerbla(SRNAME, INFO)
XERBLA
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