120
121
122
123
124
125
126 CHARACTER DIST, TYPE
127 CHARACTER*3 PATH
128 INTEGER IMAT, KL, KU, M, MODE, N
129 REAL ANORM, CNDNUM
130
131
132
133
134
135 REAL SHRINK, TENTH
136 parameter( shrink = 0.25e0, tenth = 0.1e+0 )
137 REAL ONE
138 parameter( one = 1.0e+0 )
139 REAL TWO
140 parameter( two = 2.0e+0 )
141
142
143 LOGICAL FIRST
144 CHARACTER*2 C2
145 INTEGER MAT
146 REAL BADC1, BADC2, EPS, LARGE, SMALL
147
148
149 LOGICAL LSAMEN
150 REAL SLAMCH
152
153
154 INTRINSIC abs, max, sqrt
155
156
157 SAVE eps, small, large, badc1, badc2, first
158
159
160 DATA first / .true. /
161
162
163
164
165
166 IF( first ) THEN
167 first = .false.
168 eps =
slamch(
'Precision' )
169 badc2 = tenth / eps
170 badc1 = sqrt( badc2 )
171 small =
slamch(
'Safe minimum' )
172 large = one / small
173 small = shrink*( small / eps )
174 large = one / small
175 END IF
176
177 c2 = path( 2: 3 )
178
179
180
181 dist = 'S'
182 mode = 3
183
184 IF(
lsamen( 2, c2,
'QR' ) .OR.
lsamen( 2, c2,
'LQ' ) .OR.
185 $
lsamen( 2, c2,
'QL' ) .OR.
lsamen( 2, c2,
'RQ' ) )
THEN
186
187
188
189
190
191
192 TYPE = 'N'
193
194
195
196 IF( imat.EQ.1 ) THEN
197 kl = 0
198 ku = 0
199 ELSE IF( imat.EQ.2 ) THEN
200 kl = 0
201 ku = max( n-1, 0 )
202 ELSE IF( imat.EQ.3 ) THEN
203 kl = max( m-1, 0 )
204 ku = 0
205 ELSE
206 kl = max( m-1, 0 )
207 ku = max( n-1, 0 )
208 END IF
209
210
211
212 IF( imat.EQ.5 ) THEN
213 cndnum = badc1
214 ELSE IF( imat.EQ.6 ) THEN
215 cndnum = badc2
216 ELSE
217 cndnum = two
218 END IF
219
220 IF( imat.EQ.7 ) THEN
221 anorm = small
222 ELSE IF( imat.EQ.8 ) THEN
223 anorm = large
224 ELSE
225 anorm = one
226 END IF
227
228 ELSE IF(
lsamen( 2, c2,
'QK' ) )
THEN
229
230
231
232
233
234
235
236 TYPE = 'N'
237
238
239
240
241 dist = 'S'
242
243
244
245 IF( imat.EQ.2 ) THEN
246
247
248
249 kl = 0
250 ku = 0
251 cndnum = two
252 anorm = one
253 mode = 3
254 ELSE IF( imat.EQ.3 ) THEN
255
256
257
258 kl = 0
259 ku = max( n-1, 0 )
260 cndnum = two
261 anorm = one
262 mode = 3
263 ELSE IF( imat.EQ.4 ) THEN
264
265
266
267 kl = max( m-1, 0 )
268 ku = 0
269 cndnum = two
270 anorm = one
271 mode = 3
272 ELSE
273
274
275
276 kl = max( m-1, 0 )
277 ku = max( n-1, 0 )
278
279 IF( imat.GE.5 .AND. imat.LE.14 ) THEN
280
281
282
283 cndnum = two
284 anorm = one
285 mode = 3
286
287 ELSE IF( imat.EQ.15 ) THEN
288
289
290
291 cndnum = badc1
292 anorm = one
293 mode = 3
294
295 ELSE IF( imat.EQ.16 ) THEN
296
297
298
299 cndnum = badc2
300 anorm = one
301 mode = 3
302
303 ELSE IF( imat.EQ.17 ) THEN
304
305
306
307
308 cndnum = badc2
309 anorm = one
310 mode = 2
311
312 ELSE IF( imat.EQ.18 ) THEN
313
314
315
316 cndnum = two
317 anorm = small
318 mode = 3
319
320 ELSE IF( imat.EQ.19 ) THEN
321
322
323
324 cndnum = two
325 anorm = large
326 mode = 3
327
328 END IF
329
330 END IF
331
332 ELSE IF(
lsamen( 2, c2,
'GE' ) )
THEN
333
334
335
336
337
338 TYPE = 'N'
339
340
341
342 IF( imat.EQ.1 ) THEN
343 kl = 0
344 ku = 0
345 ELSE IF( imat.EQ.2 ) THEN
346 kl = 0
347 ku = max( n-1, 0 )
348 ELSE IF( imat.EQ.3 ) THEN
349 kl = max( m-1, 0 )
350 ku = 0
351 ELSE
352 kl = max( m-1, 0 )
353 ku = max( n-1, 0 )
354 END IF
355
356
357
358 IF( imat.EQ.8 ) THEN
359 cndnum = badc1
360 ELSE IF( imat.EQ.9 ) THEN
361 cndnum = badc2
362 ELSE
363 cndnum = two
364 END IF
365
366 IF( imat.EQ.10 ) THEN
367 anorm = small
368 ELSE IF( imat.EQ.11 ) THEN
369 anorm = large
370 ELSE
371 anorm = one
372 END IF
373
374 ELSE IF(
lsamen( 2, c2,
'GB' ) )
THEN
375
376
377
378
379
380 TYPE = 'N'
381
382
383
384 IF( imat.EQ.5 ) THEN
385 cndnum = badc1
386 ELSE IF( imat.EQ.6 ) THEN
387 cndnum = tenth*badc2
388 ELSE
389 cndnum = two
390 END IF
391
392 IF( imat.EQ.7 ) THEN
393 anorm = small
394 ELSE IF( imat.EQ.8 ) THEN
395 anorm = large
396 ELSE
397 anorm = one
398 END IF
399
400 ELSE IF(
lsamen( 2, c2,
'GT' ) )
THEN
401
402
403
404
405
406 TYPE = 'N'
407
408
409
410 IF( imat.EQ.1 ) THEN
411 kl = 0
412 ELSE
413 kl = 1
414 END IF
415 ku = kl
416
417
418
419 IF( imat.EQ.3 ) THEN
420 cndnum = badc1
421 ELSE IF( imat.EQ.4 ) THEN
422 cndnum = badc2
423 ELSE
424 cndnum = two
425 END IF
426
427 IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
428 anorm = small
429 ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
430 anorm = large
431 ELSE
432 anorm = one
433 END IF
434
435 ELSE IF(
lsamen( 2, c2,
'PO' ) .OR.
lsamen( 2, c2,
'PP' ) )
THEN
436
437
438
439
440
441
442 TYPE = c2( 1: 1 )
443
444
445
446 IF( imat.EQ.1 ) THEN
447 kl = 0
448 ELSE
449 kl = max( n-1, 0 )
450 END IF
451 ku = kl
452
453
454
455 IF( imat.EQ.6 ) THEN
456 cndnum = badc1
457 ELSE IF( imat.EQ.7 ) THEN
458 cndnum = badc2
459 ELSE
460 cndnum = two
461 END IF
462
463 IF( imat.EQ.8 ) THEN
464 anorm = small
465 ELSE IF( imat.EQ.9 ) THEN
466 anorm = large
467 ELSE
468 anorm = one
469 END IF
470
471
472 ELSE IF(
lsamen( 2, c2,
'SY' ) .OR.
lsamen( 2, c2,
'SP' ) )
THEN
473
474
475
476
477
478
479 TYPE = c2( 1: 1 )
480
481
482
483 IF( imat.EQ.1 ) THEN
484 kl = 0
485 ELSE
486 kl = max( n-1, 0 )
487 END IF
488 ku = kl
489
490
491
492 IF( imat.EQ.7 ) THEN
493 cndnum = badc1
494 ELSE IF( imat.EQ.8 ) THEN
495 cndnum = badc2
496 ELSE
497 cndnum = two
498 END IF
499
500 IF( imat.EQ.9 ) THEN
501 anorm = small
502 ELSE IF( imat.EQ.10 ) THEN
503 anorm = large
504 ELSE
505 anorm = one
506 END IF
507
508 ELSE IF(
lsamen( 2, c2,
'PB' ) )
THEN
509
510
511
512
513
514 TYPE = 'P'
515
516
517
518 IF( imat.EQ.5 ) THEN
519 cndnum = badc1
520 ELSE IF( imat.EQ.6 ) THEN
521 cndnum = badc2
522 ELSE
523 cndnum = two
524 END IF
525
526 IF( imat.EQ.7 ) THEN
527 anorm = small
528 ELSE IF( imat.EQ.8 ) THEN
529 anorm = large
530 ELSE
531 anorm = one
532 END IF
533
534 ELSE IF(
lsamen( 2, c2,
'PT' ) )
THEN
535
536
537
538
539 TYPE = 'P'
540 IF( imat.EQ.1 ) THEN
541 kl = 0
542 ELSE
543 kl = 1
544 END IF
545 ku = kl
546
547
548
549 IF( imat.EQ.3 ) THEN
550 cndnum = badc1
551 ELSE IF( imat.EQ.4 ) THEN
552 cndnum = badc2
553 ELSE
554 cndnum = two
555 END IF
556
557 IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
558 anorm = small
559 ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
560 anorm = large
561 ELSE
562 anorm = one
563 END IF
564
565 ELSE IF(
lsamen( 2, c2,
'TR' ) .OR.
lsamen( 2, c2,
'TP' ) )
THEN
566
567
568
569
570
571 TYPE = 'N'
572
573
574
575 mat = abs( imat )
576 IF( mat.EQ.1 .OR. mat.EQ.7 ) THEN
577 kl = 0
578 ku = 0
579 ELSE IF( imat.LT.0 ) THEN
580 kl = max( n-1, 0 )
581 ku = 0
582 ELSE
583 kl = 0
584 ku = max( n-1, 0 )
585 END IF
586
587
588
589 IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
590 cndnum = badc1
591 ELSE IF( mat.EQ.4 ) THEN
592 cndnum = badc2
593 ELSE IF( mat.EQ.10 ) THEN
594 cndnum = badc2
595 ELSE
596 cndnum = two
597 END IF
598
599 IF( mat.EQ.5 ) THEN
600 anorm = small
601 ELSE IF( mat.EQ.6 ) THEN
602 anorm = large
603 ELSE
604 anorm = one
605 END IF
606
607 ELSE IF(
lsamen( 2, c2,
'TB' ) )
THEN
608
609
610
611
612
613 TYPE = 'N'
614
615
616
617 mat = abs( imat )
618 IF( mat.EQ.2 .OR. mat.EQ.8 ) THEN
619 cndnum = badc1
620 ELSE IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
621 cndnum = badc2
622 ELSE
623 cndnum = two
624 END IF
625
626 IF( mat.EQ.4 ) THEN
627 anorm = small
628 ELSE IF( mat.EQ.5 ) THEN
629 anorm = large
630 ELSE
631 anorm = one
632 END IF
633 END IF
634 IF( n.LE.1 )
635 $ cndnum = one
636
637 RETURN
638
639
640
real function slamch(cmach)
SLAMCH
logical function lsamen(n, ca, cb)
LSAMEN