624
625
626
627
628
629
630
631 INTEGER BASE, EMIN
632 DOUBLE PRECISION START
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657 INTEGER I
658 DOUBLE PRECISION A, B1, B2, C1, C2, D1, D2, ONE, RBASE, ZERO
659
660
661 DOUBLE PRECISION DLAMC3
663
664
665
666 a = start
667 one = 1
668 rbase = one / base
669 zero = 0
670 emin = 1
671 b1 =
dlamc3( a*rbase, zero )
672 c1 = a
673 c2 = a
674 d1 = a
675 d2 = a
676
677
678 10 CONTINUE
679 IF( ( c1.EQ.a ) .AND. ( c2.EQ.a ) .AND. ( d1.EQ.a ) .AND.
680 $ ( d2.EQ.a ) ) THEN
681 emin = emin - 1
682 a = b1
683 b1 =
dlamc3( a / base, zero )
684 c1 =
dlamc3( b1*base, zero )
685 d1 = zero
686 DO 20 i = 1, base
687 d1 = d1 + b1
688 20 CONTINUE
689 b2 =
dlamc3( a*rbase, zero )
690 c2 =
dlamc3( b2 / rbase, zero )
691 d2 = zero
692 DO 30 i = 1, base
693 d2 = d2 + b2
694 30 CONTINUE
695 GO TO 10
696 END IF
697
698
699 RETURN
700
701
702