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 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
subroutine ctrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO)
CTREXC