160
161
162
163
164
165
166 CHARACTER*( * ) NAME, OPTS
167 INTEGER ISPEC, N1, N2, N3, N4
168
169
170
171
172
173 INTEGER I, IC, IZ, NB, NBMIN, NX
174 LOGICAL CNAME, SNAME, TWOSTAGE
175 CHARACTER C1*1, C2*2, C4*2, C3*3, SUBNAM*16
176
177
178 INTRINSIC char, ichar, int, min, real
179
180
181 INTEGER IEEECK, IPARMQ, IPARAM2STAGE
183
184
185
186 GO TO ( 10, 10, 10, 80, 90, 100, 110, 120,
187 $ 130, 140, 150, 160, 160, 160, 160, 160, 160)ispec
188
189
190
192 RETURN
193
194 10 CONTINUE
195
196
197
199 subnam = name
200 ic = ichar( subnam( 1: 1 ) )
201 iz = ichar( 'Z' )
202 IF( iz.EQ.90 .OR. iz.EQ.122 ) THEN
203
204
205
206 IF( ic.GE.97 .AND. ic.LE.122 ) THEN
207 subnam( 1: 1 ) = char( ic-32 )
208 DO 20 i = 2, 6
209 ic = ichar( subnam( i: i ) )
210 IF( ic.GE.97 .AND. ic.LE.122 )
211 $ subnam( i: i ) = char( ic-32 )
212 20 CONTINUE
213 END IF
214
215 ELSE IF( iz.EQ.233 .OR. iz.EQ.169 ) THEN
216
217
218
219 IF( ( ic.GE.129 .AND. ic.LE.137 ) .OR.
220 $ ( ic.GE.145 .AND. ic.LE.153 ) .OR.
221 $ ( ic.GE.162 .AND. ic.LE.169 ) ) THEN
222 subnam( 1: 1 ) = char( ic+64 )
223 DO 30 i = 2, 6
224 ic = ichar( subnam( i: i ) )
225 IF( ( ic.GE.129 .AND. ic.LE.137 ) .OR.
226 $ ( ic.GE.145 .AND. ic.LE.153 ) .OR.
227 $ ( ic.GE.162 .AND. ic.LE.169 ) )subnam( i:
228 $ i ) = char( ic+64 )
229 30 CONTINUE
230 END IF
231
232 ELSE IF( iz.EQ.218 .OR. iz.EQ.250 ) THEN
233
234
235
236 IF( ic.GE.225 .AND. ic.LE.250 ) THEN
237 subnam( 1: 1 ) = char( ic-32 )
238 DO 40 i = 2, 6
239 ic = ichar( subnam( i: i ) )
240 IF( ic.GE.225 .AND. ic.LE.250 )
241 $ subnam( i: i ) = char( ic-32 )
242 40 CONTINUE
243 END IF
244 END IF
245
246 c1 = subnam( 1: 1 )
247 sname = c1.EQ.'S' .OR. c1.EQ.'D'
248 cname = c1.EQ.'C' .OR. c1.EQ.'Z'
249 IF( .NOT.( cname .OR. sname ) )
250 $ RETURN
251 c2 = subnam( 2: 3 )
252 c3 = subnam( 4: 6 )
253 c4 = c3( 2: 3 )
254 twostage = len( subnam ).GE.11
255 $ .AND. subnam( 11: 11 ).EQ.'2'
256
257 GO TO ( 50, 60, 70 )ispec
258
259 50 CONTINUE
260
261
262
263
264
265
266
267 nb = 1
268
269 IF( subnam(2:6).EQ.'LAORH' ) THEN
270
271
272
273 IF( sname ) THEN
274 nb = 32
275 ELSE
276 nb = 32
277 END IF
278 ELSE IF( c2.EQ.'GE' ) THEN
279 IF( c3.EQ.'TRF' ) THEN
280 IF( sname ) THEN
281 nb = 64
282 ELSE
283 nb = 64
284 END IF
285 ELSE IF( c3.EQ.'QRF' .OR. c3.EQ.'RQF' .OR. c3.EQ.'LQF' .OR.
286 $ c3.EQ.'QLF' ) THEN
287 IF( sname ) THEN
288 nb = 32
289 ELSE
290 nb = 32
291 END IF
292 ELSE IF( c3.EQ.'QR ') THEN
293 IF( n3 .EQ. 1) THEN
294 IF( sname ) THEN
295
296 IF ((n1*n2.LE.131072).OR.(n1.LE.8192)) THEN
297 nb = n1
298 ELSE
299 nb = 32768/n2
300 END IF
301 ELSE
302 IF ((n1*n2.LE.131072).OR.(n1.LE.8192)) THEN
303 nb = n1
304 ELSE
305 nb = 32768/n2
306 END IF
307 END IF
308 ELSE
309 IF( sname ) THEN
310 nb = 1
311 ELSE
312 nb = 1
313 END IF
314 END IF
315 ELSE IF( c3.EQ.'LQ ') THEN
316 IF( n3 .EQ. 2) THEN
317 IF( sname ) THEN
318
319 IF ((n1*n2.LE.131072).OR.(n1.LE.8192)) THEN
320 nb = n1
321 ELSE
322 nb = 32768/n2
323 END IF
324 ELSE
325 IF ((n1*n2.LE.131072).OR.(n1.LE.8192)) THEN
326 nb = n1
327 ELSE
328 nb = 32768/n2
329 END IF
330 END IF
331 ELSE
332 IF( sname ) THEN
333 nb = 1
334 ELSE
335 nb = 1
336 END IF
337 END IF
338 ELSE IF( c3.EQ.'HRD' ) THEN
339 IF( sname ) THEN
340 nb = 32
341 ELSE
342 nb = 32
343 END IF
344 ELSE IF( c3.EQ.'BRD' ) THEN
345 IF( sname ) THEN
346 nb = 32
347 ELSE
348 nb = 32
349 END IF
350 ELSE IF( c3.EQ.'TRI' ) THEN
351 IF( sname ) THEN
352 nb = 64
353 ELSE
354 nb = 64
355 END IF
356 ELSE IF( subnam( 4: 7 ).EQ.'QP3RK' ) THEN
357 IF( sname ) THEN
358 nb = 32
359 ELSE
360 nb = 32
361 END IF
362 END IF
363 ELSE IF( c2.EQ.'PO' ) THEN
364 IF( c3.EQ.'TRF' ) THEN
365 IF( sname ) THEN
366 nb = 64
367 ELSE
368 nb = 64
369 END IF
370 END IF
371 ELSE IF( c2.EQ.'SY' ) THEN
372 IF( c3.EQ.'TRF' ) THEN
373 IF( sname ) THEN
374 IF( twostage ) THEN
375 nb = 192
376 ELSE
377 nb = 64
378 END IF
379 ELSE
380 IF( twostage ) THEN
381 nb = 192
382 ELSE
383 nb = 64
384 END IF
385 END IF
386 ELSE IF( sname .AND. c3.EQ.'TRD' ) THEN
387 nb = 32
388 ELSE IF( sname .AND. c3.EQ.'GST' ) THEN
389 nb = 64
390 END IF
391 ELSE IF( cname .AND. c2.EQ.'HE' ) THEN
392 IF( c3.EQ.'TRF' ) THEN
393 IF( twostage ) THEN
394 nb = 192
395 ELSE
396 nb = 64
397 END IF
398 ELSE IF( c3.EQ.'TRD' ) THEN
399 nb = 32
400 ELSE IF( c3.EQ.'GST' ) THEN
401 nb = 64
402 END IF
403 ELSE IF( sname .AND. c2.EQ.'OR' ) THEN
404 IF( c3( 1: 1 ).EQ.'G' ) THEN
405 IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
406 $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
407 $ THEN
408 nb = 32
409 END IF
410 ELSE IF( c3( 1: 1 ).EQ.'M' ) THEN
411 IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
412 $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
413 $ THEN
414 nb = 32
415 END IF
416 END IF
417 ELSE IF( cname .AND. c2.EQ.'UN' ) THEN
418 IF( c3( 1: 1 ).EQ.'G' ) THEN
419 IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
420 $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
421 $ THEN
422 nb = 32
423 END IF
424 ELSE IF( c3( 1: 1 ).EQ.'M' ) THEN
425 IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
426 $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
427 $ THEN
428 nb = 32
429 END IF
430 END IF
431 ELSE IF( c2.EQ.'GB' ) THEN
432 IF( c3.EQ.'TRF' ) THEN
433 IF( sname ) THEN
434 IF( n4.LE.64 ) THEN
435 nb = 1
436 ELSE
437 nb = 32
438 END IF
439 ELSE
440 IF( n4.LE.64 ) THEN
441 nb = 1
442 ELSE
443 nb = 32
444 END IF
445 END IF
446 END IF
447 ELSE IF( c2.EQ.'PB' ) THEN
448 IF( c3.EQ.'TRF' ) THEN
449 IF( sname ) THEN
450 IF( n2.LE.64 ) THEN
451 nb = 1
452 ELSE
453 nb = 32
454 END IF
455 ELSE
456 IF( n2.LE.64 ) THEN
457 nb = 1
458 ELSE
459 nb = 32
460 END IF
461 END IF
462 END IF
463 ELSE IF( c2.EQ.'TR' ) THEN
464 IF( c3.EQ.'TRI' ) THEN
465 IF( sname ) THEN
466 nb = 64
467 ELSE
468 nb = 64
469 END IF
470 ELSE IF ( c3.EQ.'EVC' ) THEN
471 IF( sname ) THEN
472 nb = 64
473 ELSE
474 nb = 64
475 END IF
476 ELSE IF( c3.EQ.'SYL' ) THEN
477
478 IF( sname ) THEN
479 nb = min( max( 48, int( ( min( n1, n2 ) * 16 ) / 100) ),
480 $ 240 )
481 ELSE
482 nb = min( max( 24, int( ( min( n1, n2 ) * 8 ) / 100) ),
483 $ 80 )
484 END IF
485 END IF
486 ELSE IF( c2.EQ.'LA' ) THEN
487 IF( c3.EQ.'UUM' ) THEN
488 IF( sname ) THEN
489 nb = 64
490 ELSE
491 nb = 64
492 END IF
493 ELSE IF( c3.EQ.'TRS' ) THEN
494 IF( sname ) THEN
495 nb = 32
496 ELSE
497 nb = 32
498 END IF
499 END IF
500 ELSE IF( sname .AND. c2.EQ.'ST' ) THEN
501 IF( c3.EQ.'EBZ' ) THEN
502 nb = 1
503 END IF
504 ELSE IF( c2.EQ.'GG' ) THEN
505 nb = 32
506 IF( c3.EQ.'HD3' ) THEN
507 IF( sname ) THEN
508 nb = 32
509 ELSE
510 nb = 32
511 END IF
512 END IF
513 END IF
515 RETURN
516
517 60 CONTINUE
518
519
520
521 nbmin = 2
522 IF( c2.EQ.'GE' ) THEN
523 IF( c3.EQ.'QRF' .OR. c3.EQ.'RQF' .OR. c3.EQ.'LQF' .OR. c3.EQ.
524 $ 'QLF' ) THEN
525 IF( sname ) THEN
526 nbmin = 2
527 ELSE
528 nbmin = 2
529 END IF
530 ELSE IF( c3.EQ.'HRD' ) THEN
531 IF( sname ) THEN
532 nbmin = 2
533 ELSE
534 nbmin = 2
535 END IF
536 ELSE IF( c3.EQ.'BRD' ) THEN
537 IF( sname ) THEN
538 nbmin = 2
539 ELSE
540 nbmin = 2
541 END IF
542 ELSE IF( c3.EQ.'TRI' ) THEN
543 IF( sname ) THEN
544 nbmin = 2
545 ELSE
546 nbmin = 2
547 END IF
548 ELSE IF( subnam( 4: 7 ).EQ.'QP3RK' ) THEN
549 IF( sname ) THEN
550 nbmin = 2
551 ELSE
552 nbmin = 2
553 END IF
554 END IF
555
556 ELSE IF( c2.EQ.'SY' ) THEN
557 IF( c3.EQ.'TRF' ) THEN
558 IF( sname ) THEN
559 nbmin = 8
560 ELSE
561 nbmin = 8
562 END IF
563 ELSE IF( sname .AND. c3.EQ.'TRD' ) THEN
564 nbmin = 2
565 END IF
566 ELSE IF( cname .AND. c2.EQ.'HE' ) THEN
567 IF( c3.EQ.'TRD' ) THEN
568 nbmin = 2
569 END IF
570 ELSE IF( sname .AND. c2.EQ.'OR' ) THEN
571 IF( c3( 1: 1 ).EQ.'G' ) THEN
572 IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
573 $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
574 $ THEN
575 nbmin = 2
576 END IF
577 ELSE IF( c3( 1: 1 ).EQ.'M' ) THEN
578 IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
579 $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
580 $ THEN
581 nbmin = 2
582 END IF
583 END IF
584 ELSE IF( cname .AND. c2.EQ.'UN' ) THEN
585 IF( c3( 1: 1 ).EQ.'G' ) THEN
586 IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
587 $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
588 $ THEN
589 nbmin = 2
590 END IF
591 ELSE IF( c3( 1: 1 ).EQ.'M' ) THEN
592 IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
593 $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
594 $ THEN
595 nbmin = 2
596 END IF
597 END IF
598 ELSE IF( c2.EQ.'GG' ) THEN
599 nbmin = 2
600 IF( c3.EQ.'HD3' ) THEN
601 nbmin = 2
602 END IF
603 END IF
605 RETURN
606
607 70 CONTINUE
608
609
610
611 nx = 0
612 IF( c2.EQ.'GE' ) THEN
613 IF( c3.EQ.'QRF' .OR. c3.EQ.'RQF' .OR. c3.EQ.'LQF' .OR. c3.EQ.
614 $ 'QLF' ) THEN
615 IF( sname ) THEN
616 nx = 128
617 ELSE
618 nx = 128
619 END IF
620 ELSE IF( c3.EQ.'HRD' ) THEN
621 IF( sname ) THEN
622 nx = 128
623 ELSE
624 nx = 128
625 END IF
626 ELSE IF( c3.EQ.'BRD' ) THEN
627 IF( sname ) THEN
628 nx = 128
629 ELSE
630 nx = 128
631 END IF
632 ELSE IF( subnam( 4: 7 ).EQ.'QP3RK' ) THEN
633 IF( sname ) THEN
634 nx = 128
635 ELSE
636 nx = 128
637 END IF
638 END IF
639 ELSE IF( c2.EQ.'SY' ) THEN
640 IF( sname .AND. c3.EQ.'TRD' ) THEN
641 nx = 32
642 END IF
643 ELSE IF( cname .AND. c2.EQ.'HE' ) THEN
644 IF( c3.EQ.'TRD' ) THEN
645 nx = 32
646 END IF
647 ELSE IF( sname .AND. c2.EQ.'OR' ) THEN
648 IF( c3( 1: 1 ).EQ.'G' ) THEN
649 IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
650 $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
651 $ THEN
652 nx = 128
653 END IF
654 END IF
655 ELSE IF( cname .AND. c2.EQ.'UN' ) THEN
656 IF( c3( 1: 1 ).EQ.'G' ) THEN
657 IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
658 $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
659 $ THEN
660 nx = 128
661 END IF
662 END IF
663 ELSE IF( c2.EQ.'GG' ) THEN
664 nx = 128
665 IF( c3.EQ.'HD3' ) THEN
666 nx = 128
667 END IF
668 END IF
670 RETURN
671
672 80 CONTINUE
673
674
675
677 RETURN
678
679 90 CONTINUE
680
681
682
684 RETURN
685
686 100 CONTINUE
687
688
689
690 ilaenv = int( real( min( n1, n2 ) )*1.6e0 )
691 RETURN
692
693 110 CONTINUE
694
695
696
698 RETURN
699
700 120 CONTINUE
701
702
703
705 RETURN
706
707 130 CONTINUE
708
709
710
711
712
714 RETURN
715
716 140 CONTINUE
717
718
719
720
724 END IF
725 RETURN
726
727 150 CONTINUE
728
729
730
731
735 END IF
736 RETURN
737
738 160 CONTINUE
739
740
741
743 RETURN
744
745
746
integer function ieeeck(ispec, zero, one)
IEEECK
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
integer function iparam2stage(ispec, name, opts, ni, nbi, ibi, nxi)
IPARAM2STAGE
integer function iparmq(ispec, name, opts, n, ilo, ihi, lwork)
IPARMQ