90 SUBROUTINE cget38( RMAX, LMAX, NINFO, KNT, NIN )
100 INTEGER LMAX( 3 ), NINFO( 3 )
108 parameter( ldt = 20, lwork = 2*ldt*( 10+ldt ) )
110 parameter( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
112 parameter( epsin = 5.9605e-8 )
114 parameter( czero = ( 0.0e+0, 0.0e+0 ) )
117 INTEGER I, INFO, ISCL, ISRT, ITMP, J, KMIN, M, N, NDIM
118 REAL BIGNUM, EPS, S, SEP, SEPIN, SEPTMP, SIN,
119 $ SMLNUM, STMP, TNRM, TOL, TOLIN, V, VMAX, VMIN,
123 LOGICAL SELECT( LDT )
124 INTEGER IPNT( LDT ), ISELEC( LDT )
125 REAL RESULT( 2 ), RWORK( LDT ), VAL( 3 ),
127 COMPLEX Q( LDT, LDT ), QSAV( LDT, LDT ),
128 $ QTMP( LDT, LDT ), T( LDT, LDT ),
129 $ TMP( LDT, LDT ), TSAV( LDT, LDT ),
130 $ TSAV1( LDT, LDT ), TTMP( LDT, LDT ), W( LDT ),
131 $ WORK( LWORK ), WTMP( LDT )
135 EXTERNAL clange, slamch
142 INTRINSIC aimag, max, real, sqrt
147 smlnum = slamch(
'S' ) / eps
148 bignum = one / smlnum
152 eps = max( eps, epsin )
163 val( 1 ) = sqrt( smlnum )
165 val( 3 ) = sqrt( sqrt( bignum ) )
172 READ( nin, fmt = * )n, ndim, isrt
175 READ( nin, fmt = * )( iselec( i ), i = 1, ndim )
177 READ( nin, fmt = * )( tmp( i, j ), j = 1, n )
179 READ( nin, fmt = * )sin, sepin
181 tnrm = clange(
'M', n, n, tmp, ldt, rwork )
187 CALL clacpy(
'F', n, n, tmp, ldt, t, ldt )
190 CALL csscal( n, vmul, t( 1, i ), 1 )
194 CALL clacpy(
'F', n, n, t, ldt, tsav, ldt )
198 CALL cgehrd( n, 1, n, t, ldt, work( 1 ), work( n+1 ), lwork-n,
202 ninfo( 1 ) = ninfo( 1 ) + 1
208 CALL clacpy(
'L', n, n, t, ldt, q, ldt )
209 CALL cunghr( n, 1, n, q, ldt, work( 1 ), work( n+1 ), lwork-n,
219 CALL chseqr(
'S',
'V', n, 1, n, t, ldt, w, q, ldt, work, lwork,
223 ninfo( 2 ) = ninfo( 2 ) + 1
231 SELECT( i ) = .false.
235 wsrt( i ) = real( w( i ) )
239 wsrt( i ) = aimag( w( i ) )
246 IF( wsrt( j ).LT.vmin )
THEN
251 wsrt( kmin ) = wsrt( i )
254 ipnt( i ) = ipnt( kmin )
258 SELECT( ipnt( iselec( i ) ) ) = .true.
263 CALL clacpy(
'F', n, n, q, ldt, qsav, ldt )
264 CALL clacpy(
'F', n, n, t, ldt, tsav1, ldt )
265 CALL ctrsen(
'B',
'V',
SELECT, n, t, ldt, q, ldt, wtmp, m, s,
266 $ sep, work, lwork, info )
269 ninfo( 3 ) = ninfo( 3 ) + 1
277 CALL chst01( n, 1, n, tsav, ldt, t, ldt, q, ldt, work, lwork,
279 vmax = max( result( 1 ), result( 2 ) )
280 IF( vmax.GT.rmax( 1 ) )
THEN
282 IF( ninfo( 1 ).EQ.0 )
289 v = max( two*real( n )*eps*tnrm, smlnum )
292 IF( v.GT.septmp )
THEN
297 IF( v.GT.sepin )
THEN
302 tol = max( tol, smlnum / eps )
303 tolin = max( tolin, smlnum / eps )
304 IF( eps*( sin-tolin ).GT.stmp+tol )
THEN
306 ELSE IF( sin-tolin.GT.stmp+tol )
THEN
307 vmax = ( sin-tolin ) / ( stmp+tol )
308 ELSE IF( sin+tolin.LT.eps*( stmp-tol ) )
THEN
310 ELSE IF( sin+tolin.LT.stmp-tol )
THEN
311 vmax = ( stmp-tol ) / ( sin+tolin )
315 IF( vmax.GT.rmax( 2 ) )
THEN
317 IF( ninfo( 2 ).EQ.0 )
324 IF( v.GT.septmp*stmp )
THEN
329 IF( v.GT.sepin*sin )
THEN
334 tol = max( tol, smlnum / eps )
335 tolin = max( tolin, smlnum / eps )
336 IF( eps*( sepin-tolin ).GT.septmp+tol )
THEN
338 ELSE IF( sepin-tolin.GT.septmp+tol )
THEN
339 vmax = ( sepin-tolin ) / ( septmp+tol )
340 ELSE IF( sepin+tolin.LT.eps*( septmp-tol ) )
THEN
342 ELSE IF( sepin+tolin.LT.septmp-tol )
THEN
343 vmax = ( septmp-tol ) / ( sepin+tolin )
347 IF( vmax.GT.rmax( 2 ) )
THEN
349 IF( ninfo( 2 ).EQ.0 )
356 IF( sin.LE.real( 2*n )*eps .AND. stmp.LE.real( 2*n )*eps )
THEN
358 ELSE IF( eps*sin.GT.stmp )
THEN
360 ELSE IF( sin.GT.stmp )
THEN
362 ELSE IF( sin.LT.eps*stmp )
THEN
364 ELSE IF( sin.LT.stmp )
THEN
369 IF( vmax.GT.rmax( 3 ) )
THEN
371 IF( ninfo( 3 ).EQ.0 )
378 IF( sepin.LE.v .AND. septmp.LE.v )
THEN
380 ELSE IF( eps*sepin.GT.septmp )
THEN
382 ELSE IF( sepin.GT.septmp )
THEN
383 vmax = sepin / septmp
384 ELSE IF( sepin.LT.eps*septmp )
THEN
386 ELSE IF( sepin.LT.septmp )
THEN
387 vmax = septmp / sepin
391 IF( vmax.GT.rmax( 3 ) )
THEN
393 IF( ninfo( 3 ).EQ.0 )
401 CALL clacpy(
'F', n, n, tsav1, ldt, ttmp, ldt )
402 CALL clacpy(
'F', n, n, qsav, ldt, qtmp, ldt )
405 CALL ctrsen(
'E',
'V',
SELECT, n, ttmp, ldt, qtmp, ldt, wtmp,
406 $ m, stmp, septmp, work, lwork, info )
409 ninfo( 3 ) = ninfo( 3 ) + 1
418 IF( ttmp( i, j ).NE.t( i, j ) )
420 IF( qtmp( i, j ).NE.q( i, j ) )
428 CALL clacpy(
'F', n, n, tsav1, ldt, ttmp, ldt )
429 CALL clacpy(
'F', n, n, qsav, ldt, qtmp, ldt )
432 CALL ctrsen(
'V',
'V',
SELECT, n, ttmp, ldt, qtmp, ldt, wtmp,
433 $ m, stmp, septmp, work, lwork, info )
436 ninfo( 3 ) = ninfo( 3 ) + 1
445 IF( ttmp( i, j ).NE.t( i, j ) )
447 IF( qtmp( i, j ).NE.q( i, j ) )
455 CALL clacpy(
'F', n, n, tsav1, ldt, ttmp, ldt )
456 CALL clacpy(
'F', n, n, qsav, ldt, qtmp, ldt )
459 CALL ctrsen(
'E',
'N',
SELECT, n, ttmp, ldt, qtmp, ldt, wtmp,
460 $ m, stmp, septmp, work, lwork, info )
463 ninfo( 3 ) = ninfo( 3 ) + 1
472 IF( ttmp( i, j ).NE.t( i, j ) )
474 IF( qtmp( i, j ).NE.qsav( i, j ) )
482 CALL clacpy(
'F', n, n, tsav1, ldt, ttmp, ldt )
483 CALL clacpy(
'F', n, n, qsav, ldt, qtmp, ldt )
486 CALL ctrsen(
'V',
'N',
SELECT, n, ttmp, ldt, qtmp, ldt, wtmp,
487 $ m, stmp, septmp, work, lwork, info )
490 ninfo( 3 ) = ninfo( 3 ) + 1
499 IF( ttmp( i, j ).NE.t( i, j ) )
501 IF( qtmp( i, j ).NE.qsav( i, j ) )
505 IF( vmax.GT.rmax( 1 ) )
THEN
507 IF( ninfo( 1 ).EQ.0 )