89 SUBROUTINE dget36( RMAX, LMAX, NINFO, KNT, NIN )
97 INTEGER knt, lmax, nin
107 DOUBLE PRECISION zero, one
108 parameter( zero = 0.0d0, one = 1.0d0 )
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
115 DOUBLE PRECISION eps, res
118 DOUBLE PRECISION 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
dlacpy(
'F', n, n, tmp, ldt, t1, ldt )
152 CALL
dlacpy(
'F', n, n, tmp, ldt, t2, ldt )
163 CALL
dlaset(
'Full', n, n, zero, one, q, ldt )
164 CALL
dtrexc(
'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
dlaset(
'Full', n, n, zero, one, q, ldt )
177 CALL
dtrexc(
'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
dhst01( 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