C      ALGORITHM 463, COLLECTED ALGORITHMS FROM ACM.
C      THIS WORK PUBLISHED IN COMMUNICATIONS OF THE ACM
C      VOL. 16, NO. 10, October, 1973, PP.639--640.
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	Fortran/
#	Fortran/Sp/
#	Fortran/Sp/Drivers/
#	Fortran/Sp/Drivers/Makefile
#	Fortran/Sp/Drivers/driver.f
#	Fortran/Sp/Drivers/res
#	Fortran/Sp/Src/
#	Fortran/Sp/Src/src.f
# This archive created: Thu Dec 15 13:28:04 2005
export PATH; PATH=/bin:$PATH
if test ! -d 'Fortran'
then
	mkdir 'Fortran'
fi
cd 'Fortran'
if test ! -d 'Sp'
then
	mkdir 'Sp'
fi
cd 'Sp'
if test ! -d 'Drivers'
then
	mkdir 'Drivers'
fi
cd 'Drivers'
if test -f 'Makefile'
then
	echo shar: will not over-write existing file "'Makefile'"
else
cat << "SHAR_EOF" > 'Makefile'
all: Res

src.o: src.f
	$(F77) $(F77OPTS) -c src.f

driver.o: driver.f
	$(F77) $(F77OPTS) -c driver.f

DRIVERS= driver
RESULTS= Res

Objs1= driver.o src.o
driver: $(Objs1)
	$(F77) $(F77OPTS) -o driver $(Objs1) $(SRCLIBS)
Res: driver 
	./driver >Res

diffres:Res res
	echo "Differences in results from driver"
	$(DIFF) Res res

clean: 
	rm -rf *.o $(DRIVERS) $(CLEANUP) $(RESULTS)
SHAR_EOF
fi # end of overwriting check
if test -f 'driver.f'
then
	echo shar: will not over-write existing file "'driver.f'"
else
cat << "SHAR_EOF" > 'driver.f'
      program main

c***********************************************************************
c
cc TOMS463_PRB tests algorithm 463.
c
      implicit none

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TOMS463_PRB'
      write ( *, '(a)' ) '  Test TOMS algorithm 463,'
      write ( *, '(a)' ) '  computation of plotting scales.'

      call test01
      call test02
      call test03

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TOMS463_PRB'
      write ( *, '(a)' ) '  Normal end of execution.'

      stop
      end
      subroutine test01

c***********************************************************************
c
cc TEST01 tests SCALE1.
c
      implicit none

      integer test_num

      parameter ( test_num = 3 )

      real dist
      integer n
      integer n_actual
      integer n_test(test_num)
      integer test
      real xmax
      real xmax_test(test_num)
      real xmaxp
      real xmin
      real xmin_test(test_num)
      real xminp

      save n_test
      save xmax_test
      save xmin_test

      data n_test / 5, 5, 9 /
      data xmax_test / 11.1, 10.1, -100.0 /
      data xmin_test / -3.1, 5.2, -12000.0 /
      
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST01'
      write ( *, '(a)' ) '  SCALE1 chooses a scale for a plot.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,a)' ) 
     &  '       XMIN       XMAX   N      XMINP',
     &  '      XMAXP       DIST Nactual'
      write ( *, '(a)' ) ' '

      do test = 1, test_num

        n = n_test(test)
        xmin = xmin_test(test)
        xmax = xmax_test(test)

        call scale1 ( xmin, xmax, n, xminp, xmaxp, dist )

        n_actual = nint ( ( xmaxp - xminp ) / dist )

        write ( *, 
     &    '(2x,f9.1,2x,f9.1,2x,i2,2x,f9.1,2x,f9.1,2x,f9.1,2x,i6)' ) 
     &    xmin, xmax, n, xminp, xmaxp, dist, n_actual

      end do

      return
      end
      subroutine test02

c***********************************************************************
c
cc TEST02 tests SCALE2.
c
      implicit none

      integer test_num

      parameter ( test_num = 3 )

      real dist
      integer n
      integer n_actual
      integer n_test(test_num)
      integer test
      real xmax
      real xmax_test(test_num)
      real xmaxp
      real xmin
      real xmin_test(test_num)
      real xminp

      save n_test
      save xmax_test
      save xmin_test

      data n_test / 5, 5, 9 /
      data xmax_test / 11.1, 10.1, -100.0 /
      data xmin_test / -3.1, 5.2, -12000.0 /
      
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST02'
      write ( *, '(a)' ) '  SCALE2 chooses a scale for a plot.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,a)' ) 
     &  '       XMIN       XMAX   N      XMINP',
     &  '      XMAXP       DIST Nactual'
      write ( *, '(a)' ) ' '

      do test = 1, test_num

        n = n_test(test)
        xmin = xmin_test(test)
        xmax = xmax_test(test)

        call scale2 ( xmin, xmax, n, xminp, xmaxp, dist )

        n_actual = nint ( ( xmaxp - xminp ) / dist )

        write ( *, 
     &    '(2x,f9.1,2x,f9.1,2x,i2,2x,f9.1,2x,f9.1,2x,f9.1,2x,i6)' ) 
     &    xmin, xmax, n, xminp, xmaxp, dist, n_actual

      end do

      return
      end
      subroutine test03

c***********************************************************************
c
cc TEST03 tests SCALE3.
c
      implicit none

      integer test_num

      parameter ( test_num = 3 )

      real dist
      integer n
      integer n_test(test_num)
      integer test
      real xmax
      real xmax_test(test_num)
      real xmaxp
      real xmin
      real xmin_test(test_num)
      real xminp

      save n_test
      save xmax_test
      save xmin_test

      data n_test / 10, 2, 4 /
      data xmax_test / 125.0, 10.0, 1500.0 /
      data xmin_test / 1.8, 0.1, 0.1 /
      
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST03'
      write ( *, '(a)' ) '  SCALE3 chooses a logarithmic scale'
      write ( *, '(a)' ) '  for a plot.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,a)' ) 
     &  '       XMIN       XMAX   N      XMINP',
     &  '      XMAXP       DIST'
      write ( *, '(a)' ) ' '

      do test = 1, test_num

        n = n_test(test)
        xmin = xmin_test(test)
        xmax = xmax_test(test)

        call scale3 ( xmin, xmax, n, xminp, xmaxp, dist )

        write ( *, 
     &    '(2x,f9.1,2x,f9.1,2x,i2,2x,f11.3,2x,f11.3,2x,f11.3)' ) 
     &    xmin, xmax, n, xminp, xmaxp, dist

      end do

      return
      end
SHAR_EOF
fi # end of overwriting check
if test -f 'res'
then
	echo shar: will not over-write existing file "'res'"
else
cat << "SHAR_EOF" > 'res'
 
TOMS463_PRB
  Test TOMS algorithm 463,
  computation of plotting scales.
 
TEST01
  SCALE1 chooses a scale for a plot.
 
       XMIN       XMAX   N      XMINP      XMAXP       DIST Nactual
 
       -3.1       11.1   5       -4.0       12.0        2.0       8
        5.2       10.1   5        5.0       11.0        1.0       6
   -12000.0     -100.0   9   -12000.0        0.0     1000.0      12
 
TEST02
  SCALE2 chooses a scale for a plot.
 
       XMIN       XMAX   N      XMINP      XMAXP       DIST Nactual
 
       -3.1       11.1   5       -5.0       20.0        5.0       5
        5.2       10.1   5        4.0       14.0        2.0       5
   -12000.0     -100.0   9   -14000.0     4000.0     2000.0       9
 
TEST03
  SCALE3 chooses a logarithmic scale
  for a plot.
 
       XMIN       XMAX   N      XMINP      XMAXP       DIST
 
        1.8      125.0  10        1.585      158.489        1.585
        0.1       10.0   2        0.100       10.000       10.000
        0.1     1500.0   4        0.077     2154.436       12.915
 
TOMS463_PRB
  Normal end of execution.
SHAR_EOF
fi # end of overwriting check
cd ..
if test ! -d 'Src'
then
	mkdir 'Src'
fi
cd 'Src'
if test -f 'src.f'
then
	echo shar: will not over-write existing file "'src.f'"
else
cat << "SHAR_EOF" > 'src.f'
      SUBROUTINE SCALE1 ( XMIN, XMAX, N, XMINP, XMAXP, DIST )
C  ANSI FORTRAN
C  GIVEN XMIN, XMAX AND N, SCALE1 FINDS A NEW RANGE XMINP AND
C  XMAXP DIVISIBLE INTO APPROXIMATELY N LINEAR INTERVALS
C  OF SIZE DIST.
C  VINT IS AN ARRAY OF ACCEPTABLE VALUES FOR DIST (TIMES
C  AN INTEGER POWER OF 10).
C  SQR IS AN ARRAY OF GEOMETRIC MEANS OF ADJACENT VALUES
C  OF VINT.  IT IS USED AS BREAK POINTS TO DETERMINE
C  WHICH VINT VALUE TO ASSIGN TO DIST.
C     .. Scalar Arguments ..
      REAL DIST,XMAX,XMAXP,XMIN,XMINP
      INTEGER N
C     ..
C     .. Local Scalars ..
      REAL A,AL,B,DEL,FM1,FM2,FN
      INTEGER I,M1,M2,NAL
C     ..
C     .. Local Arrays ..
      REAL SQR(3),VINT(4)
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,LOG10,REAL
      DATA VINT(1), VINT(2), VINT(3), VINT(4) / 1., 2., 5., 10. /
      DATA SQR(1), SQR(2), SQR(3) / 1.414214, 3.162278, 7.071068 /
C  CHECK WHETHER PROPER INPUT VALUES WERE SUPPLIED.
      IF ( XMIN .LT. XMAX .AND. N .GT. 0 ) GO TO 10
      WRITE ( 6, 99999 )
99999 FORMAT ( " IMPROPER INPUT SUPPLIED TO SCALE1" )
      RETURN
C  DEL ACCOUNTS FOR COMPUTER ROUND-OFF.
C  DEL SHOULD BE GREATER THAN THE ROUND-OFF EXPECTED FROM
C  A DIVISION AND REAL OPERATION.  IT SHOULD BE LESS THAN
C  THE MINIMUM INCREMENT OF THE PLOTTING DEVICE USED BY
C  THE MAIN PROGRAM (IN.) DIVIDED BY THE PLOT SIZE (IN.)
C  TIMES NUMBER OF INTERVALS N.
10    DEL = .00002
      FN = N
C  FIND APPROXIMATE INTERVAL SIZE A.
      A = ( XMAX - XMIN ) / FN
      AL = LOG10 ( A )
      NAL = AL
      IF ( A .LT. 1. ) NAL = NAL - 1
C  A IS SCALED INTO VARIABLE NAMED B BETWEEN 1 AND 10.
      B = A / 10.**NAL
C  THE CLOSEST PERMISSIBLE VALUE FOR B IS FOUND.
      DO 20 I = 1, 3
        IF ( B .LT. SQR ( I ) ) GO TO 30
20    CONTINUE
      I = 4
C  THE INTERVAL SIZE IS COMPUTED.
30    DIST = VINT(I) * 10.**NAL
      FM1 = XMIN / DIST
      M1 = FM1
      IF ( FM1 .LT. 0. ) M1 = M1 - 1
      IF ( ABS ( REAL ( M1 ) + 1. - FM1 ) .LT. DEL ) M1 = M1 + 1
C  THE NEW MINIMUM AND MAXIMUM LIMITS ARE FOUND.
      XMINP = DIST * REAL ( M1 )
      FM2 = XMAX / DIST
      M2 = FM2 + 1.
      IF ( FM2 .LT. ( -1. ) ) M2 = M2 - 1
      IF ( ABS ( FM2 + 1. - REAL ( M2 ) ) .LT. DEL ) M2 = M2 - 1
      XMAXP = DIST * REAL ( M2 )
C  ADJUST LIMITS TO ACCOUNT FOR ROUND-OFF IF NECESSARY.
      IF ( XMINP .GT. XMIN ) XMINP = XMIN
      IF ( XMAXP .LT. XMAX ) XMAXP = XMAX
      RETURN
      END
      SUBROUTINE SCALE2 ( XMIN, XMAX, N, XMINP, XMAXP, DIST )
C  ANSI FORTRAN
C  GIVEN XMIN, XMAX AND N, SCALE2 FINDS A NEW RANGE XMINP AND
C  XMAXP DIVISIBLE INTO EXACTLY N LINEAR INTERVALS OF SIZE
C  DIST, WHERE N IS GREATER THAN 1.
C     .. Scalar Arguments ..
      REAL DIST,XMAX,XMAXP,XMIN,XMINP
      INTEGER N
C     ..
C     .. Local Scalars ..
      REAL A,AL,B,DEL,FM1,FM2,FN
      INTEGER I,M1,M2,NAL,NP,NX
C     ..
C     .. Local Arrays ..
      REAL VINT(5)
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,LOG10,REAL
      DATA VINT(1), VINT(2), VINT(3), VINT(4), VINT(5) / 1., 2.,
     &  5., 10., 20. /
C  CHECK WHETHER PROPER INPUT VALUES WERE SUPPLIED.
      IF ( XMIN .LT. XMAX .AND. N .GT. 0 ) GO TO 10
      WRITE ( 6, 99999 )
99999 FORMAT ( " IMPROPER INPUT SUPPLIED TO SCALE2" )
      RETURN  
10    DEL = .00002
      FN = N
C  FIND APPROXIMATE INTERVAL SIZE A.
      A = ( XMAX - XMIN ) / FN
      AL = LOG10 ( A )
      NAL = AL
      IF ( A .LT. 1. ) NAL = NAL - 1
C  A IS SCALED INTO VARIABLE NAMED B BETWEEN 1 AND 10.
      B = A / 10.**NAL
C  THE CLOSEST PERMISSIBLE VALUE FOR B IS FOUND.
      DO 20 I = 1, 3
        IF ( B .LT. ( VINT(I) + DEL ) ) GO TO 30
20    CONTINUE
      I = 4
C  THE INTERVAL SIZE IS COMPUTED.
30    DIST = VINT(I) * 10.**NAL
      FM1 = XMIN / DIST
      M1 = FM1
      IF ( FM1 .LT. 0. ) M1 = M1 - 1
      IF ( ABS ( REAL ( M1 ) + 1. - FM1 ) .LT. DEL ) M1 = M1 + 1
C  THE NEW MINIMUM AND MAXIMUM LIMITS ARE FOUND.
      XMINP = DIST * REAL ( M1 )
      FM2 = XMAX / DIST
      M2 = FM2 + 1.
      IF ( FM2 .LT. ( -1. ) ) M2 = M2 - 1
      IF ( ABS ( FM2 + 1. - REAL ( M2 ) ) .LT. DEL ) M2 = M2 - 1
      XMAXP = DIST * REAL ( M2 )
C  CHECK WHETHER A SECOND PASS IS REQUIRED.
      NP = M2 - M1
      IF ( NP .LE. N ) GO TO 40
      I = I + 1
      GO TO 30
40    NX = ( N - NP ) / 2
      XMINP = XMINP - REAL ( NX ) * DIST
      XMAXP = XMINP + REAL ( N ) * DIST
C  ADJUST LIMITS TO ACCOUNT FOR ROUND-OFF IF NECESSARY.
      IF ( XMINP .GT. XMIN ) XMINP = XMIN
      IF ( XMAXP .LT. XMAX ) XMAXP = XMAX
      RETURN
      END
      SUBROUTINE SCALE3 ( XMIN, XMAX, N, XMINP, XMAXP, DIST )
C  ANSI FORTRAN
C  GIVEN XMIN, XMAX AND N, WHERE N IS GREATER THAN 1, SCALE3
C  FINDS A NEW RANGE XMINP AND XMAXP DIVISIBLE INTO EXACTLY 
C  N LOGARITHMIC INTERVALS, WHERE THE RATIO OF ADJACENT
C  UNIFORMLY SPACED SCALE VALUES IS DIST.
C     .. Scalar Arguments ..
      REAL DIST,XMAX,XMAXP,XMIN,XMINP
      INTEGER N
C     ..
C     .. Local Scalars ..
      REAL A,AL,B,DEL,DISTL,FM1,FM2,FN,XMAXL,XMINL
      INTEGER I,M1,M2,NAL,NP,NX
C     ..
C     .. Local Arrays ..
      REAL VINT(11)
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,LOG10,REAL
      DATA VINT(1), VINT(2), VINT(3), VINT(4), VINT(5), VINT(6),
     &  VINT(7), VINT(8), VINT(9), VINT(10), VINT(11) / 10., 9.,
     &  8., 7., 6., 5., 4., 3., 2., 1., .5 /
C  CHECK WHETHER PROPER INPUT VALUES WERE SUPPLIED.
      IF ( XMIN .LT. XMAX .AND. N .GT. 1 .AND. XMIN .GT. 0. ) GO TO 10
      WRITE ( 6, 99999 )
99999 FORMAT ( " IMPROPER INPUT SUPPLIED TO SCALE3" )
      RETURN  
10    DEL = .00002
C  VALUES ARE TRANSLATED FROM THE LINEAR INTO LOGARITHMIC
C  REGION.
      XMINL = LOG10 ( XMIN )
      XMAXL = LOG10 ( XMAX )
      FN = N
C  FIND APPROXIMATE INTERVAL SIZE A.
      A = ( XMAXL - XMINL ) / FN
      AL = LOG10 ( A )
      NAL = AL
      IF ( A .LT. 1. ) NAL = NAL - 1
C  A IS SCALED INTO VARIABLE NAMED B BETWEEN 1 AND 10.
      B = A / 10.**NAL
C  THE CLOSEST PERMISSIBLE VALUE FOR B IS FOUND.
      DO 20 I = 1, 9
        IF ( B .LT. ( 10. / VINT(I) + DEL ) ) GO TO 30
20    CONTINUE
      I = 10
C  THE INTERVAL SIZE IS COMPUTED.
30    DISTL = 10.**( NAL + 1 ) / VINT(I)
      FM1 = XMINL / DISTL
      M1 = FM1
      IF ( FM1 .LT. 0. ) M1 = M1 - 1
      IF ( ABS ( REAL ( M1 ) + 1. - FM1 ) .LT. DEL ) M1 = M1 + 1
C  THE NEW MINIMUM AND MAXIMUM LIMITS ARE FOUND.
      XMINP = DISTL * REAL ( M1 )
      FM2 = XMAXL / DISTL
      M2 = FM2 + 1.
      IF ( FM2 .LT. ( -1. ) ) M2 = M2 - 1
      IF ( ABS ( FM2 + 1. - REAL ( M2 ) ) .LT. DEL ) M2 = M2 - 1
      XMAXP = DISTL + REAL ( M2 )
      NP = M2 - M1
C  CHECK WHETHER ANOTHER PASS IS NECESSARY.
      IF ( NP .LE. N ) GO TO 40
      I = I + 1
      GO TO 30
40    NX = ( N - NP ) / 2
      XMINP = XMINP - REAL ( NX ) * DISTL
      XMAXP = XMINP + REAL ( N  ) * DISTL
C  VALUES ARE TRANSLATED FROM THE LOGARITHMIC INTO THE LINEAR
C  REGION.
      DIST = 10.**DISTL
      XMINP = 10.**XMINP
      XMAXP = 10.**XMAXP
C  ADJUST LIMITS TO ACCOUNT FOR ROUND-OFF IF NECESSARY.
      IF ( XMINP .GT. XMIN ) XMINP = XMIN
      IF ( XMAXP .LT. XMAX ) XMAXP = XMAX
      RETURN
      END
SHAR_EOF
fi # end of overwriting check
cd ..
cd ..
cd ..
#       End of shell archive
exit 0