86 SUBROUTINE zget36( RMAX, LMAX, NINFO, KNT, NIN )
94 INTEGER KNT, LMAX, NIN, NINFO
101 DOUBLE PRECISION ZERO, ONE
102 parameter ( zero = 0.0d+0, one = 1.0d+0 )
103 COMPLEX*16 CZERO, CONE
104 parameter ( czero = ( 0.0d+0, 0.0d+0 ),
105 $ cone = ( 1.0d+0, 0.0d+0 ) )
107 parameter ( ldt = 10, lwork = 2*ldt*ldt )
110 INTEGER I, IFST, ILST, INFO1, INFO2, J, N
111 DOUBLE PRECISION EPS, RES
115 DOUBLE PRECISION RESULT( 2 ), RWORK( ldt )
116 COMPLEX*16 DIAG( ldt ), Q( ldt, ldt ), T1( ldt, ldt ),
117 $ t2( ldt, ldt ), tmp( ldt, ldt ), work( lwork )
120 DOUBLE PRECISION DLAMCH
137 READ( nin, fmt = * )n, ifst, ilst
142 READ( nin, fmt = * )( tmp( i, j ), j = 1, n )
144 CALL zlacpy(
'F', n, n, tmp, ldt, t1, ldt )
145 CALL zlacpy(
'F', n, n, tmp, ldt, t2, ldt )
150 CALL zlaset(
'Full', n, n, czero, cone, q, ldt )
151 CALL ztrexc(
'N', n, t1, ldt, q, ldt, ifst, ilst, info1 )
154 IF( i.EQ.j .AND. q( i, j ).NE.cone )
155 $ res = res + one / eps
156 IF( i.NE.j .AND. q( i, j ).NE.czero )
157 $ res = res + one / eps
163 CALL zlaset(
'Full', n, n, czero, cone, q, ldt )
164 CALL ztrexc(
'V', n, t2, ldt, q, ldt, ifst, ilst, info2 )
170 IF( t1( i, j ).NE.t2( i, j ) )
171 $ res = res + one / eps
174 IF( info1.NE.0 .OR. info2.NE.0 )
177 $ res = res + one / eps
181 CALL zcopy( n, tmp, ldt+1, diag, 1 )
182 IF( ifst.LT.ilst )
THEN
183 DO 70 i = ifst + 1, ilst
185 diag( i ) = diag( i-1 )
188 ELSE IF( ifst.GT.ilst )
THEN
189 DO 80 i = ifst - 1, ilst, -1
191 diag( i+1 ) = diag( i )
196 IF( t2( i, i ).NE.diag( i ) )
197 $ res = res + one / eps
202 CALL zhst01( n, 1, n, tmp, ldt, t2, ldt, q, ldt, work, lwork,
204 res = res + result( 1 ) + result( 2 )
210 IF( t2( i, j ).NE.czero )
211 $ res = res + one / eps
214 IF( res.GT.rmax )
THEN
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zhst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RWORK, RESULT)
ZHST01
subroutine zget36(RMAX, LMAX, NINFO, KNT, NIN)
ZGET36
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine ztrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO)
ZTREXC