86 SUBROUTINE cget36( RMAX, LMAX, NINFO, KNT, NIN )
94 INTEGER KNT, LMAX, NIN, NINFO
102 parameter( zero = 0.0e+0, one = 1.0e+0 )
104 parameter( czero = ( 0.0e+0, 0.0e+0 ),
105 $ cone = ( 1.0e+0, 0.0e+0 ) )
107 parameter( ldt = 10, lwork = 2*ldt*ldt )
110 INTEGER I, IFST, ILST, INFO1, INFO2, J, N
115 REAL RESULT( 2 ), RWORK( ldt )
116 COMPLEX DIAG( ldt ), Q( ldt, ldt ), T1( ldt, ldt ),
117 $ t2( ldt, ldt ), tmp( ldt, ldt ), work( lwork )
137 READ( nin, fmt = * )n, ifst, ilst
142 READ( nin, fmt = * )( tmp( i, j ), j = 1, n )
144 CALL
clacpy(
'F', n, n, tmp, ldt, t1, ldt )
145 CALL
clacpy(
'F', n, n, tmp, ldt, t2, ldt )
150 CALL
claset(
'Full', n, n, czero, cone, q, ldt )
151 CALL
ctrexc(
'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
claset(
'Full', n, n, czero, cone, q, ldt )
164 CALL
ctrexc(
'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
ccopy( 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
chst01( 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 claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine ctrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO)
CTREXC
subroutine chst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RWORK, RESULT)
CHST01
subroutine cget36(RMAX, LMAX, NINFO, KNT, NIN)
CGET36
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY