207 SUBROUTINE dgghrd( 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 DOUBLE PRECISION a( lda, * ),
b( ldb, * ), q( ldq, * ),
227 DOUBLE PRECISION one, zero
228 parameter( one = 1.0d+0, zero = 0.0d+0 )
232 INTEGER icompq, icompz, jcol, jrow
233 DOUBLE PRECISION c, s, temp
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(
'DGGHRD', -info )
307 $ CALL
dlaset(
'Full', n, n, zero, one, q, ldq )
309 $ CALL
dlaset(
'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
dlartg( temp, a( jrow, jcol ), c, s,
334 $ a( jrow-1, jcol ) )
335 a( jrow, jcol ) = zero
336 CALL
drot( n-jcol, a( jrow-1, jcol+1 ), lda,
337 $ a( jrow, jcol+1 ), lda, c, s )
338 CALL
drot( n+2-jrow,
b( jrow-1, jrow-1 ), ldb,
339 $
b( jrow, jrow-1 ), ldb, c, s )
341 $ CALL
drot( n, q( 1, jrow-1 ), 1, q( 1, jrow ), 1, c, s )
345 temp =
b( jrow, jrow )
346 CALL
dlartg( temp,
b( jrow, jrow-1 ), c, s,
348 b( jrow, jrow-1 ) = zero
349 CALL
drot( ihi, a( 1, jrow ), 1, a( 1, jrow-1 ), 1, c, s )
350 CALL
drot( jrow-1,
b( 1, jrow ), 1,
b( 1, jrow-1 ), 1, c,
353 $ CALL
drot( n, z( 1, jrow ), 1, z( 1, jrow-1 ), 1, c, s )
subroutine dlartg(F, G, CS, SN, R)
DLARTG generates a plane rotation with real cosine and real sine.
subroutine dgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
DGGHRD
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine drot(N, DX, INCX, DY, INCY, C, S)
DROT
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...