700
  701
  702
  703
  704
  705
  706
  707      LOGICAL            IEEE
  708      INTEGER            BETA, EMAX, EMIN, P
  709      REAL               RMAX
  710
  711
  712
  713
  714
  715
  716
  717
  718
  719
  720
  721
  722
  723
  724
  725
  726
  727
  728
  729
  730
  731
  732
  733
  734
  735
  736
  737
  738
  739
  740
  741
  742
  743
  744
  745
  746
  747
  748      REAL               ZERO, ONE
  749      parameter( zero = 0.0e0, one = 1.0e0 )
  750
  751
  752      INTEGER            EXBITS, EXPSUM, I, LEXP, NBITS, TRY, UEXP
  753      REAL               OLDY, RECBAS, Y, Z
  754
  755
  756      REAL               SLAMC3
  758
  759
  760      INTRINSIC          mod
  761
  762
  763
  764
  765
  766
  767
  768
  769      lexp = 1
  770      exbits = 1
  771   10 CONTINUE
  772      try = lexp*2
  773      IF( try.LE.( -emin ) ) THEN
  774         lexp = try
  775         exbits = exbits + 1
  776         GO TO 10
  777      END IF
  778      IF( lexp.EQ.-emin ) THEN
  779         uexp = lexp
  780      ELSE
  781         uexp = try
  782         exbits = exbits + 1
  783      END IF
  784
  785
  786
  787
  788
  789      IF( ( uexp+emin ).GT.( -lexp-emin ) ) THEN
  790         expsum = 2*lexp
  791      ELSE
  792         expsum = 2*uexp
  793      END IF
  794
  795
  796
  797
  798      emax = expsum + emin - 1
  799      nbits = 1 + exbits + p
  800
  801
  802
  803
  804      IF( ( mod( nbits, 2 ).EQ.1 ) .AND. ( beta.EQ.2 ) ) THEN
  805
  806
  807
  808
  809
  810
  811
  812
  813
  814
  815
  816
  817         emax = emax - 1
  818      END IF
  819
  820      IF( ieee ) THEN
  821
  822
  823
  824
  825         emax = emax - 1
  826      END IF
  827
  828
  829
  830
  831
  832
  833
  834      recbas = one / beta
  835      z = beta - one
  836      y = zero
  837      DO 20 i = 1, p
  838         z = z*recbas
  839         IF( y.LT.one )
  840     $      oldy = y
  842   20 CONTINUE
  843      IF( y.GE.one )
  844     $   y = oldy
  845
  846
  847
  848      DO 30 i = 1, emax
  849         y = 
slamc3( y*beta, zero )
 
  850   30 CONTINUE
  851
  852      rmax = y
  853      RETURN
  854
  855
  856