89 SUBROUTINE sget36( RMAX, LMAX, NINFO, KNT, NIN )
97 INTEGER KNT, LMAX, NIN
108 parameter ( zero = 0.0e0, one = 1.0e0 )
110 parameter ( ldt = 10, lwork = 2*ldt*ldt )
113 INTEGER I, IFST, IFST1, IFST2, IFSTSV, ILST, ILST1,
114 $ ilst2, ilstsv, info1, info2, j, loc, n
118 REAL Q( ldt, ldt ), RESULT( 2 ), T1( ldt, ldt ),
119 $ t2( ldt, ldt ), tmp( ldt, ldt ), work( lwork )
144 READ( nin, fmt = * )n, ifst, ilst
149 READ( nin, fmt = * )( tmp( i, j ), j = 1, n )
151 CALL slacpy(
'F', n, n, tmp, ldt, t1, ldt )
152 CALL slacpy(
'F', n, n, tmp, ldt, t2, ldt )
163 CALL slaset(
'Full', n, n, zero, one, q, ldt )
164 CALL strexc(
'N', n, t1, ldt, q, ldt, ifst1, ilst1, work, info1 )
167 IF( i.EQ.j .AND. q( i, j ).NE.one )
168 $ res = res + one / eps
169 IF( i.NE.j .AND. q( i, j ).NE.zero )
170 $ res = res + one / eps
176 CALL slaset(
'Full', n, n, zero, one, q, ldt )
177 CALL strexc(
'V', n, t2, ldt, q, ldt, ifst2, ilst2, work, info2 )
183 IF( t1( i, j ).NE.t2( i, j ) )
184 $ res = res + one / eps
188 $ res = res + one / eps
190 $ res = res + one / eps
192 $ res = res + one / eps
196 IF( info2.NE.0 )
THEN
197 ninfo( info2 ) = ninfo( info2 ) + 1
199 IF( abs( ifst2-ifstsv ).GT.1 )
200 $ res = res + one / eps
201 IF( abs( ilst2-ilstsv ).GT.1 )
202 $ res = res + one / eps
207 CALL shst01( n, 1, n, tmp, ldt, t2, ldt, q, ldt, work, lwork,
209 res = res + result( 1 ) + result( 2 )
215 IF( t2( loc+1, loc ).NE.zero )
THEN
219 IF( t2( loc, loc+1 ).EQ.zero .OR. t2( loc, loc ).NE.
220 $ t2( loc+1, loc+1 ) .OR. sign( one, t2( loc, loc+1 ) ).EQ.
221 $ sign( one, t2( loc+1, loc ) ) )res = res + one / eps
223 IF( t2( i, loc ).NE.zero )
224 $ res = res + one / res
225 IF( t2( i, loc+1 ).NE.zero )
226 $ res = res + one / res
234 IF( t2( i, loc ).NE.zero )
235 $ res = res + one / res
241 IF( res.GT.rmax )
THEN
subroutine shst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RESULT)
SHST01
subroutine strexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, INFO)
STREXC
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 slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sget36(RMAX, LMAX, NINFO, KNT, NIN)
SGET36