C      ALGORITHM 763, COLLECTED ALGORITHMS FROM ACM.
C      THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE,
C      VOL. 22, NO. 4, December, 1996, P.  385--392
C

#! /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:
#	Doc
#	Libs
#	Src
#	Drivers
# This archive created: Wed Feb 19 19:33:13 1997
export PATH; PATH=/bin:$PATH
if test ! -d 'Doc'
then
	mkdir 'Doc'
fi
cd 'Doc'
if test -f 'makefile'
then
	echo shar: will not over-write existing file "'makefile'"
else
cat << \SHAR_EOF > 'makefile'
f90= frt -Am -Hasu -fi -v9
f90= f90
f90= xlf90 
f90= epcf90 -d20 -C 

INT=f90d1mach.o ivl_def.o intaritb.o testsys.o intlib.o
TEST=f90d1mach.o ivl_def.o intaritb.o intlib.o test_f90_intarith.o
 
HSL12= /rutherford/num-arcu/hsl12/source/
HSL12t= /rutherford/num-arcu/hsl12/tests/

all:	test int
 
test:	$(TEST)
	$(f90)  $(TEST)
	a.out 
	diff TEST_F90_INTARITH.OUT tinysmpl.out

int:	$(INT)
	$(f90)  $(INT)
	a.out 
	diff INTARITH.OUT sample.out

f90d1mach.o:	f90d1mach.f90
	$(f90) -c f90d1mach.f90 

ivl_def.o:	ivl_def.f90
	$(f90) -c ivl_def.f90 

intaritb.o:	intaritb.f90
	$(f90) -c intaritb.f90 

testsys.o:	testsys.f90
	$(f90) -c -o testsys.o testsys.f90 

intlib.o:	intlib.f90
	$(f90) -c intlib.f90 

test_f90_intarith.o:	test_f90_intarith.f90
	$(f90) -c test_f90_intarith.f90 

SHAR_EOF
fi # end of overwriting check
cd ..
if test ! -d 'Libs'
then
	mkdir 'Libs'
fi
cd 'Libs'
if test -f 'i1mach.f90'
then
	echo shar: will not over-write existing file "'i1mach.f90'"
else
cat << \SHAR_EOF > 'i1mach.f90'
!***********************************************************************
!***********************************************************************
      INTEGER FUNCTION I1MACH(I)
      INTEGER I
!
!  I/O UNIT NUMBERS.
!
!    I1MACH( 1) = THE STANDARD INPUT UNIT.
!
!    I1MACH( 2) = THE STANDARD OUTPUT UNIT.
!
!    I1MACH( 3) = THE STANDARD PUNCH UNIT.
!
!    I1MACH( 4) = THE STANDARD ERROR MESSAGE UNIT.
!
!  WORDS.
!
!    I1MACH( 5) = THE NUMBER OF BITS PER INTEGER STORAGE UNIT.
!
!    I1MACH( 6) = THE NUMBER OF CHARACTERS PER INTEGER STORAGE UNIT.
!
!  INTEGERS.
!
!    ASSUME INTEGERS ARE REPRESENTED IN THE S-DIGIT, BASE-A FORM
!
!               SIGN ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
!
!               WHERE 0 .LE. X(I) .LT. A FOR I=0,...,S-1.
!
!    I1MACH( 7) = A, THE BASE.
!
!    I1MACH( 8) = S, THE NUMBER OF BASE-A DIGITS.
!
!    I1MACH( 9) = A**S - 1, THE LARGEST MAGNITUDE.
!
!  FLOATING-POINT NUMBERS.
!
!    ASSUME FLOATING-POINT NUMBERS ARE REPRESENTED IN THE T-DIGIT,
!    BASE-B FORM
!
!               SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
!
!               WHERE 0 .LE. X(I) .LT. B FOR I=1,...,T,
!               0 .LT. X(1), AND EMIN .LE. E .LE. EMAX.
!
!    I1MACH(10) = B, THE BASE.
!
!  SINGLE-PRECISION
!
!    I1MACH(11) = T, THE NUMBER OF BASE-B DIGITS.
!
!    I1MACH(12) = EMIN, THE SMALLEST EXPONENT E.
!
!    I1MACH(13) = EMAX, THE LARGEST EXPONENT E.
!
!  DOUBLE-PRECISION
!
!    I1MACH(14) = T, THE NUMBER OF BASE-B DIGITS.
!
!    I1MACH(15) = EMIN, THE SMALLEST EXPONENT E.
!
!    I1MACH(16) = EMAX, THE LARGEST EXPONENT E.
!
!  TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT,
!  THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY
!  REMOVING THE C FROM COLUMN 1.  ALSO, THE VALUES OF
!  I1MACH(1) - I1MACH(4) SHOULD BE CHECKED FOR CONSISTENCY
!  WITH THE LOCAL OPERATING SYSTEM.  FOR FORTRAN 77, YOU MAY WISH
!  TO ADJUST THE DATA STATEMENT SO IMACH(6) IS SET TO 1, AND
!  THEN TO COMMENT OUT THE EXECUTABLE TEST ON I .EQ. 6 BELOW.
!  ON RARE MACHINES A STATIC STATEMENT MAY NEED TO BE ADDED.
!  (BUT PROBABLY MORE SYSTEMS PROHIBIT IT THAN REQUIRE IT.)
!
!  FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), THE FIRST
!  SET OF CONSTANTS BELOW SHOULD BE APPROPRIATE, EXCEPT PERHAPS
!  FOR IMACH(1) - IMACH(4).
!
      INTEGER IMACH(16),OUTPUT
!
      EQUIVALENCE (IMACH(4),OUTPUT)
!
!     MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T
!     3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T
!     PC 7300), AND 8087 BASED MICROS (E.G. IBM PC AND AT&T 6300).
!
       DATA IMACH( 1) /    5 /
       DATA IMACH( 2) /    6 /
       DATA IMACH( 3) /    7 /
       DATA IMACH( 4) /    6 /
       DATA IMACH( 5) /   32 /
       DATA IMACH( 6) /    4 /
       DATA IMACH( 7) /    2 /
       DATA IMACH( 8) /   31 /
       DATA IMACH( 9) / 2147483647 /
       DATA IMACH(10) /    2 /
       DATA IMACH(11) /   24 /
       DATA IMACH(12) / -125 /
       DATA IMACH(13) /  128 /
       DATA IMACH(14) /   53 /
       DATA IMACH(15) / -1021 /
!
!     MACHINE CONSTANTS FOR AMDAHL MACHINES.
!
!      DATA IMACH( 1) /   5 /
!      DATA IMACH( 2) /   6 /
!      DATA IMACH( 3) /   7 /
!      DATA IMACH( 4) /   6 /
!      DATA IMACH( 5) /  32 /
!      DATA IMACH( 6) /   4 /
!      DATA IMACH( 7) /   2 /
!      DATA IMACH( 8) /  31 /
!      DATA IMACH( 9) / 2147483647 /
!      DATA IMACH(10) /  16 /
!      DATA IMACH(11) /   6 /
!      DATA IMACH(12) / -64 /
!      DATA IMACH(13) /  63 /
!      DATA IMACH(14) /  14 /
!      DATA IMACH(15) / -64 /
!      DATA IMACH(16) /  63 /
!
!     MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM.
!
!      DATA IMACH( 1) /    7 /
!      DATA IMACH( 2) /    2 /
!      DATA IMACH( 3) /    2 /
!      DATA IMACH( 4) /    2 /
!      DATA IMACH( 5) /   36 /
!      DATA IMACH( 6) /    4 /
!      DATA IMACH( 7) /    2 /
!      DATA IMACH( 8) /   33 /
!      DATA IMACH( 9) / Z1FFFFFFFF /
!      DATA IMACH(10) /    2 /
!      DATA IMACH(11) /   24 /
!      DATA IMACH(12) / -256 /
!      DATA IMACH(13) /  255 /
!      DATA IMACH(14) /   60 /
!      DATA IMACH(15) / -256 /
!      DATA IMACH(16) /  255 /
!
!     MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM.
!
!      DATA IMACH( 1) /   5 /
!      DATA IMACH( 2) /   6 /
!      DATA IMACH( 3) /   7 /
!      DATA IMACH( 4) /   6 /
!      DATA IMACH( 5) /  48 /
!      DATA IMACH( 6) /   6 /
!      DATA IMACH( 7) /   2 /
!      DATA IMACH( 8) /  39 /
!      DATA IMACH( 9) / O0007777777777777 /
!      DATA IMACH(10) /   8 /
!      DATA IMACH(11) /  13 /
!      DATA IMACH(12) / -50 /
!      DATA IMACH(13) /  76 /
!      DATA IMACH(14) /  26 /
!      DATA IMACH(15) / -50 /
!      DATA IMACH(16) /  76 /
!
!     MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS.
!
!      DATA IMACH( 1) /   5 /
!      DATA IMACH( 2) /   6 /
!      DATA IMACH( 3) /   7 /
!      DATA IMACH( 4) /   6 /
!      DATA IMACH( 5) /  48 /
!      DATA IMACH( 6) /   6 /
!      DATA IMACH( 7) /   2 /
!      DATA IMACH( 8) /  39 /
!      DATA IMACH( 9) / O0007777777777777 /
!      DATA IMACH(10) /   8 /
!      DATA IMACH(11) /  13 /
!      DATA IMACH(12) / -50 /
!      DATA IMACH(13) /  76 /
!      DATA IMACH(14) /  26 /
!      DATA IMACH(15) / -32754 /
!      DATA IMACH(16) /  32780 /
!
!     MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES.
!
!      DATA IMACH( 1) /    5 /
!      DATA IMACH( 2) /    6 /
!      DATA IMACH( 3) /    7 /
!      DATA IMACH( 4) /    6 /
!      DATA IMACH( 5) /   60 /
!      DATA IMACH( 6) /   10 /
!      DATA IMACH( 7) /    2 /
!      DATA IMACH( 8) /   48 /
!      DATA IMACH( 9) / 00007777777777777777B /
!      DATA IMACH(10) /    2 /
!      DATA IMACH(11) /   48 /
!      DATA IMACH(12) / -974 /
!      DATA IMACH(13) / 1070 /
!      DATA IMACH(14) /   96 /
!      DATA IMACH(15) / -927 /
!      DATA IMACH(16) / 1070 /
!
!     MACHINE CONSTANTS FOR CONVEX C-1.
!
!      DATA IMACH( 1) /    5 /
!      DATA IMACH( 2) /    6 /
!      DATA IMACH( 3) /    7 /
!      DATA IMACH( 4) /    6 /
!      DATA IMACH( 5) /   32 /
!      DATA IMACH( 6) /    4 /
!      DATA IMACH( 7) /    2 /
!      DATA IMACH( 8) /   31 /
!      DATA IMACH( 9) / 2147483647 /
!      DATA IMACH(10) /    2 /
!      DATA IMACH(11) /   24 /
!      DATA IMACH(12) / -128 /
!      DATA IMACH(13) /  127 /
!      DATA IMACH(14) /   53 /
!      DATA IMACH(15) /-1024 /
!      DATA IMACH(16) / 1023 /
!
!     MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3.
!
!      DATA IMACH( 1) /     5 /
!      DATA IMACH( 2) /     6 /
!      DATA IMACH( 3) /   102 /
!      DATA IMACH( 4) /     6 /
!      DATA IMACH( 5) /    64 /
!      DATA IMACH( 6) /     8 /
!      DATA IMACH( 7) /     2 /
!      DATA IMACH( 8) /    63 /
!      DATA IMACH( 9) /  777777777777777777777B /
!      DATA IMACH(10) /     2 /
!      DATA IMACH(11) /    47 /
!      DATA IMACH(12) / -8189 /
!      DATA IMACH(13) /  8190 /
!      DATA IMACH(14) /    94 /
!      DATA IMACH(15) / -8099 /
!      DATA IMACH(16) /  8190 /
!
!     MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200.
!
!      DATA IMACH( 1) /   11 /
!      DATA IMACH( 2) /   12 /
!      DATA IMACH( 3) /    8 /
!      DATA IMACH( 4) /   10 /
!      DATA IMACH( 5) /   16 /
!      DATA IMACH( 6) /    2 /
!      DATA IMACH( 7) /    2 /
!      DATA IMACH( 8) /   15 /
!      DATA IMACH( 9) /32767 /
!      DATA IMACH(10) /   16 /
!      DATA IMACH(11) /    6 /
!      DATA IMACH(12) /  -64 /
!      DATA IMACH(13) /   63 /
!      DATA IMACH(14) /   14 /
!      DATA IMACH(15) /  -64 /
!      DATA IMACH(16) /   63 /
!
!     MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7.
!
!      DATA IMACH( 1) /       5 /
!      DATA IMACH( 2) /       6 /
!      DATA IMACH( 3) /       0 /
!      DATA IMACH( 4) /       6 /
!      DATA IMACH( 5) /      24 /
!      DATA IMACH( 6) /       3 /
!      DATA IMACH( 7) /       2 /
!      DATA IMACH( 8) /      23 /
!      DATA IMACH( 9) / 8388607 /
!      DATA IMACH(10) /       2 /
!      DATA IMACH(11) /      23 /
!      DATA IMACH(12) /    -127 /
!      DATA IMACH(13) /     127 /
!      DATA IMACH(14) /      38 /
!      DATA IMACH(15) /    -127 /
!      DATA IMACH(16) /     127 /
!
!     MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES.
!
!      DATA IMACH( 1) /    5 /
!      DATA IMACH( 2) /    6 /
!      DATA IMACH( 3) /   43 /
!      DATA IMACH( 4) /    6 /
!      DATA IMACH( 5) /   36 /
!      DATA IMACH( 6) /    4 /
!      DATA IMACH( 7) /    2 /
!      DATA IMACH( 8) /   35 /
!      DATA IMACH( 9) / O377777777777 /
!      DATA IMACH(10) /    2 /
!      DATA IMACH(11) /   27 /
!      DATA IMACH(12) / -127 /
!      DATA IMACH(13) /  127 /
!      DATA IMACH(14) /   63 /
!      DATA IMACH(15) / -127 /
!      DATA IMACH(16) /  127 /
!
!     MACHINE CONSTANTS FOR THE IBM 360/370 SERIES,
!     THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86.
!
!      DATA IMACH( 1) /   5 /
!      DATA IMACH( 2) /   6 /
!      DATA IMACH( 3) /   7 /
!      DATA IMACH( 4) /   6 /
!      DATA IMACH( 5) /  32 /
!      DATA IMACH( 6) /   4 /
!      DATA IMACH( 7) /   2 /
       DATA IMACH(16) /  1024 /
!      DATA IMACH( 8) /  31 /
!      DATA IMACH( 9) / Z7FFFFFFF /
!      DATA IMACH(10) /  16 /
!      DATA IMACH(11) /   6 /
!      DATA IMACH(12) / -64 /
!      DATA IMACH(13) /  63 /
!      DATA IMACH(14) /  14 /
!      DATA IMACH(15) / -64 /
!      DATA IMACH(16) /  63 /
!
!     MACHINE CONSTANTS FOR THE INTERDATA 8/32
!     WITH THE UNIX SYSTEM FORTRAN 77 COMPILER.
!
!     FOR THE INTERDATA FORTRAN VII COMPILER REPLACE
!     THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S.
!
!      DATA IMACH( 1) /   5 /
!      DATA IMACH( 2) /   6 /
!      DATA IMACH( 3) /   6 /
!      DATA IMACH( 4) /   6 /
!      DATA IMACH( 5) /  32 /
!      DATA IMACH( 6) /   4 /
!      DATA IMACH( 7) /   2 /
!      DATA IMACH( 8) /  31 /
!      DATA IMACH( 9) / Z'7FFFFFFF' /
!      DATA IMACH(10) /  16 /
!      DATA IMACH(11) /   6 /
!      DATA IMACH(12) / -64 /
!      DATA IMACH(13) /  62 /
!      DATA IMACH(14) /  14 /
!      DATA IMACH(15) / -64 /
!      DATA IMACH(16) /  62 /
!
!     MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR).
!
!      DATA IMACH( 1) /    5 /
!      DATA IMACH( 2) /    6 /
!      DATA IMACH( 3) /    7 /
!      DATA IMACH( 4) /    6 /
!      DATA IMACH( 5) /   36 /
!      DATA IMACH( 6) /    5 /
!      DATA IMACH( 7) /    2 /
!      DATA IMACH( 8) /   35 /
!      DATA IMACH( 9) / "377777777777 /
!      DATA IMACH(10) /    2 /
!      DATA IMACH(11) /   27 /
!      DATA IMACH(12) / -128 /
!      DATA IMACH(13) /  127 /
!      DATA IMACH(14) /   54 /
!      DATA IMACH(15) / -101 /
!      DATA IMACH(16) /  127 /
!
!     MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR).
!
!      DATA IMACH( 1) /    5 /
!      DATA IMACH( 2) /    6 /
!      DATA IMACH( 3) /    7 /
!      DATA IMACH( 4) /    6 /
!      DATA IMACH( 5) /   36 /
!      DATA IMACH( 6) /    5 /
!      DATA IMACH( 7) /    2 /
!      DATA IMACH( 8) /   35 /
!      DATA IMACH( 9) / "377777777777 /
!      DATA IMACH(10) /    2 /
!      DATA IMACH(11) /   27 /
!      DATA IMACH(12) / -128 /
!      DATA IMACH(13) /  127 /
!      DATA IMACH(14) /   62 /
!      DATA IMACH(15) / -128 /
!      DATA IMACH(16) /  127 /
!
!     MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING
!     32-BIT INTEGER ARITHMETIC.
!
!      DATA IMACH( 1) /    5 /
!      DATA IMACH( 2) /    6 /
!      DATA IMACH( 3) /    7 /
!      DATA IMACH( 4) /    6 /
!      DATA IMACH( 5) /   32 /
!      DATA IMACH( 6) /    4 /
!      DATA IMACH( 7) /    2 /
!      DATA IMACH( 8) /   31 /
!      DATA IMACH( 9) / 2147483647 /
!      DATA IMACH(10) /    2 /
!      DATA IMACH(11) /   24 /
!      DATA IMACH(12) / -127 /
!      DATA IMACH(13) /  127 /
!      DATA IMACH(14) /   56 /
!      DATA IMACH(15) / -127 /
!      DATA IMACH(16) /  127 /
!
!     MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING
!     16-BIT INTEGER ARITHMETIC.
!
!      DATA IMACH( 1) /    5 /
!      DATA IMACH( 2) /    6 /
!      DATA IMACH( 3) /    7 /
!      DATA IMACH( 4) /    6 /
!      DATA IMACH( 5) /   16 /
!      DATA IMACH( 6) /    2 /
!      DATA IMACH( 7) /    2 /
!      DATA IMACH( 8) /   15 /
!      DATA IMACH( 9) / 32767 /
!      DATA IMACH(10) /    2 /
!      DATA IMACH(11) /   24 /
!      DATA IMACH(12) / -127 /
!      DATA IMACH(13) /  127 /
!      DATA IMACH(14) /   56 /
!      DATA IMACH(15) / -127 /
!      DATA IMACH(16) /  127 /
!
!     MACHINE CONSTANTS FOR THE PRIME 50 SERIES SYSTEMS
!     WTIH 32-BIT INTEGERS AND 64V MODE INSTRUCTIONS,
!     SUPPLIED BY IGOR BRAY.
!
!      DATA IMACH( 1) /            1 /
!      DATA IMACH( 2) /            1 /
!      DATA IMACH( 3) /            2 /
!      DATA IMACH( 4) /            1 /
!      DATA IMACH( 5) /           32 /
!      DATA IMACH( 6) /            4 /
!      DATA IMACH( 7) /            2 /
!      DATA IMACH( 8) /           31 /
!      DATA IMACH( 9) / :17777777777 /
!      DATA IMACH(10) /            2 /
!      DATA IMACH(11) /           23 /
!      DATA IMACH(12) /         -127 /
!      DATA IMACH(13) /         +127 /
!      DATA IMACH(14) /           47 /
!      DATA IMACH(15) /       -32895 /
!      DATA IMACH(16) /       +32637 /
!
!     MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000.
!
!      DATA IMACH( 1) /     0 /
!      DATA IMACH( 2) /     0 /
!      DATA IMACH( 3) /     7 /
!      DATA IMACH( 4) /     0 /
!      DATA IMACH( 5) /    32 /
!      DATA IMACH( 6) /     1 /
!      DATA IMACH( 7) /     2 /
!      DATA IMACH( 8) /    31 /
!      DATA IMACH( 9) /  2147483647 /
!      DATA IMACH(10) /     2 /
!      DATA IMACH(11) /    24 /
!      DATA IMACH(12) /  -125 /
!      DATA IMACH(13) /   128 /
!      DATA IMACH(14) /    53 /
!      DATA IMACH(15) / -1021 /
!      DATA IMACH(16) /  1024 /
!
!     MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES.
!
!     NOTE THAT THE PUNCH UNIT, I1MACH(3), HAS BEEN SET TO 7
!     WHICH IS APPROPRIATE FOR THE UNIVAC-FOR SYSTEM.
!     IF YOU HAVE THE UNIVAC-FTN SYSTEM, SET IT TO 1.
!
!      DATA IMACH( 1) /    5 /
!      DATA IMACH( 2) /    6 /
!      DATA IMACH( 3) /    7 /
!      DATA IMACH( 4) /    6 /
!      DATA IMACH( 5) /   36 /
!      DATA IMACH( 6) /    6 /
!      DATA IMACH( 7) /    2 /
!      DATA IMACH( 8) /   35 /
!      DATA IMACH( 9) / O377777777777 /
!      DATA IMACH(10) /    2 /
!      DATA IMACH(11) /   27 /
!      DATA IMACH(12) / -128 /
!      DATA IMACH(13) /  127 /
!      DATA IMACH(14) /   60 /
!      DATA IMACH(15) /-1024 /
!      DATA IMACH(16) / 1023 /
!
!     MACHINE CONSTANTS FOR VAX.
!
!      DATA IMACH( 1) /    5 /
!      DATA IMACH( 2) /    6 /
!      DATA IMACH( 3) /    7 /
!      DATA IMACH( 4) /    6 /
!      DATA IMACH( 5) /   32 /
!      DATA IMACH( 6) /    4 /
!      DATA IMACH( 7) /    2 /
!      DATA IMACH( 8) /   31 /
!      DATA IMACH( 9) / 2147483647 /
!      DATA IMACH(10) /    2 /
!      DATA IMACH(11) /   24 /
!      DATA IMACH(12) / -127 /
!      DATA IMACH(13) /  127 /
!      DATA IMACH(14) /   56 /
!      DATA IMACH(15) / -127 /
!      DATA IMACH(16) /  127 /
      IF (I .LT. 1  .OR.  I .GT. 16) GO TO 999
      I1MACH=IMACH(I)
!/6S
!/7S
      IF(I.EQ.6) I1MACH=1
!/
      RETURN
  999 WRITE(OUTPUT,1999) I
 1999 FORMAT(' I1MACH - I OUT OF BOUNDS',I10)
      STOP
      END

SHAR_EOF
fi # end of overwriting check
if test -f 'f90d1mach.f90'
then
	echo shar: will not over-write existing file "'f90d1mach.f90'"
else
cat << \SHAR_EOF > 'f90d1mach.f90'
! This is a portable version of D1MACH that should work for any compiler
! that complies with the Fortran 90 specifications for the intrinsic
! EPSILON.

      DOUBLE PRECISION FUNCTION D1MACH(I) 
      INTEGER I, I1MACH
!                                                                       
!  DOUBLE-PRECISION MACHINE CONSTANTS                                   
!                                                                       
!  D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE.           
!                                                                       
!  D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE.           
!                                                                       
!  D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING.                 
!                                                                       
!  D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING.                 
!                                                                       
!  D1MACH( 5) = LOG10(B)                                                
!                                                                       
      SELECT CASE (I) 
        CASE (1) 
           D1MACH = TINY(1D0) 
        CASE (2) 
           D1MACH = HUGE(1D0) 
        CASE (3) 
           D1MACH = EPSILON(1D0)/RADIX(1D0) 
        CASE (4) 
           D1MACH = EPSILON(1D0) 
        CASE (5) 
           D1MACH = RADIX(1D0) 
           D1MACH = LOG10(D1MACH) 
        CASE DEFAULT 
        WRITE(I1MACH(2),'(A,I10)') ' D1MACH - I OUT OF BOUNDS', I 
        STOP 
      END SELECT 
      END                                           

SHAR_EOF
fi # end of overwriting check
cd ..
if test ! -d 'Src'
then
	mkdir 'Src'
fi
cd 'Src'
if test ! -d 'Sp'
then
	mkdir 'Sp'
fi
cd 'Sp'
if test -f 'intaritb.f90'
then
	echo shar: will not over-write existing file "'intaritb.f90'"
else
cat << \SHAR_EOF > 'intaritb.f90'
! This Fortran 90 module provides support for overloading operators
! using INTLIB.

MODULE INTERVAL_ARITHMETIC

   USE IVL_DEF
   IMPLICIT NONE

      TYPE(INTERVAL), PARAMETER:: REAL_LINE=INTERVAL(-HUGE(1D0),HUGE(1D0))
      DOUBLE PRECISION, PARAMETER :: ZERO = 0D0, ONE=1D0

 !Interface to the basic operations

      INTERFACE OPERATOR(+)
         MODULE PROCEDURE ADD_F90,&
                          REAL_PLUS_IVL_F90,&
                          IVL_PLUS_REAL_F90,&
                          IVL_PLUS_INTEGER_F90,&
                          INTEGER_PLUS_IVL_F90
      END INTERFACE

      INTERFACE OPERATOR(-)
         MODULE PROCEDURE SUB_F90,&
                          REAL_MINUS_IVL_F90,&
                          IVL_MINUS_REAL_F90,&
                          INTEGER_MINUS_IVL_F90,&
                          IVL_MINUS_INTEGER_F90
      END INTERFACE

      INTERFACE OPERATOR(-)
         MODULE PROCEDURE INEG_F90
      END INTERFACE

      INTERFACE OPERATOR(*)
         MODULE PROCEDURE MULT_F90,&
                          REAL_TIMES_IVL_F90,&
                          IVL_TIMES_REAL_F90,&
                          INTEGER_TIMES_IVL_F90,&
                          IVL_TIMES_INTEGER_F90
      END INTERFACE

      INTERFACE OPERATOR(/)
         MODULE PROCEDURE DIV_F90,&
                          REAL_OVER_IVL_F90,&
                          IVL_OVER_REAL_F90,&
                          INTEGER_OVER_IVL_F90,&
                          IVL_OVER_INTEGER_F90
      END INTERFACE

 !Interface to the elementary functions

      INTERFACE OPERATOR(**)
         MODULE PROCEDURE POWER_F90, IIPOWR_F90,&
                          REAL_TO_IVL_F90, IVL_TO_REAL_F90, &
                          IGR_TO_IVL_F90
      END INTERFACE

      INTERFACE ACOS
         MODULE PROCEDURE IACOS_F90
      END INTERFACE

      INTERFACE ACOT
         MODULE PROCEDURE IACOT_F90
      END INTERFACE

      INTERFACE ASIN
         MODULE PROCEDURE IASIN_F90
      END INTERFACE

      INTERFACE ATAN
         MODULE PROCEDURE IATAN_F90
      END INTERFACE

      INTERFACE COS
         MODULE PROCEDURE ICOS_F90
      END INTERFACE

      INTERFACE COT
         MODULE PROCEDURE ICOT_F90
      END INTERFACE

      INTERFACE EXP
         MODULE PROCEDURE IEXP_F90
      END INTERFACE

      INTERFACE LOG
         MODULE PROCEDURE ILOG_F90
      END INTERFACE

      INTERFACE SIN
         MODULE PROCEDURE ISIN_F90
      END INTERFACE

      INTERFACE SINH
         MODULE PROCEDURE ISINH_F90
      END INTERFACE

      INTERFACE SQRT
         MODULE PROCEDURE ISQRT_F90
      END INTERFACE

       INTERFACE TAN
         MODULE PROCEDURE ITAN_F90
      END INTERFACE

!Interface to utility operations

      INTERFACE OPERATOR(.IS.)
         MODULE PROCEDURE ICAP_F90
      END INTERFACE

      INTERFACE OPERATOR(.CH.)
         MODULE PROCEDURE IHULL_F90, IHULL_R_I, IHULL_I_R, IHULL_R_R, &
                          IHULL_N_N, IHULL_I_N, IHULL_N_I, &
                          IHULL_N_R, IHULL_R_N
      END INTERFACE

      INTERFACE OPERATOR(.SB.)
         MODULE PROCEDURE IILEI_F90
      END INTERFACE

      INTERFACE OPERATOR(.SP.)
         MODULE PROCEDURE IIGEI_F90
      END INTERFACE

      INTERFACE OPERATOR(.DJ.)
         MODULE PROCEDURE IDISJ_F90
      END INTERFACE

      INTERFACE OPERATOR(.IN.)
         MODULE PROCEDURE IRLEI_F90, IRILEI, IIILEI
      END INTERFACE

      INTERFACE OPERATOR(.LT.)
         MODULE PROCEDURE INTINTLT_F90, REALINTLT_F90, INTREALLT_F90,&
                                        IGRINTLT_F90,  INTIGRLT_F90
      END INTERFACE

      INTERFACE OPERATOR(.GT.)
         MODULE PROCEDURE INTINTGT_F90, REALINTGT_F90, INTREALGT_F90,&
                                        IGRINTGT_F90,  INTIGRGT_F90
      END INTERFACE

      INTERFACE OPERATOR(.LE.)
         MODULE PROCEDURE INTINTLE_F90, REALINTLE_F90, INTREALLE_F90,&
                                        IGRINTLE_F90,  INTIGRLE_F90
      END INTERFACE

      INTERFACE OPERATOR(.GE.)
         MODULE PROCEDURE INTINTGE_F90, REALINTGE_F90, INTREALGE_F90,&
                                        IGRINTGE_F90,  INTIGRGE_F90
      END INTERFACE

      INTERFACE OPERATOR(.NE.)
         MODULE PROCEDURE INTINTNE, REALINTNE, INTREALNE, IGRINTNE, &
                          INTIGRNE
      END INTERFACE
      
      INTERFACE OPERATOR(.EQ.)
         MODULE PROCEDURE INTINTEQ, REALINTEQ, INTREALEQ, IGRINTEQ, &
                          INTIGREQ
      END INTERFACE

      INTERFACE ABS
         MODULE PROCEDURE IVLABS_F90
      END INTERFACE

      INTERFACE IWID
         MODULE PROCEDURE IWID_F90
      END INTERFACE

      INTERFACE WID
         MODULE PROCEDURE IWID_F90
      END INTERFACE

      INTERFACE MAG
         MODULE PROCEDURE INTABS_F90
      END INTERFACE

      INTERFACE MAX
         MODULE PROCEDURE IVLMAX_F90, IVRMAX, RIVMAX, IVIMAX, IIVMAX
      END INTERFACE

      INTERFACE MIN
         MODULE PROCEDURE IVLMIN_F90, IVRMIN, RIVMIN, IVIMIN, IIVMIN
      END INTERFACE

      INTERFACE MIG
         MODULE PROCEDURE IMIG_F90
      END INTERFACE

      INTERFACE IMID
         MODULE PROCEDURE IMID_F90
      END INTERFACE

      INTERFACE MID
         MODULE PROCEDURE IMID_F90
      END INTERFACE

 ! Overloading assignment

      INTERFACE ASSIGNMENT (=)
         MODULE PROCEDURE INTEGER_TO_INTERVAL,&
                          DOUBLE_TO_INTERVAL
      END INTERFACE

 ! Type conversions

      INTERFACE IVL
         MODULE PROCEDURE IVL1_F90, IVL2_F90, IVL1I_F90, IVL2I_F90,&
                          IVL2DI_F90, IVL2ID_F90, IVL_IVL
      END INTERFACE

   ! Explicit conversion functions (mostly used internally for
   ! conversion to and from INTLIB argument lists).

   ! Double prec. array to interval     IDBLA
   ! Interval to double prec. array     DBLA
   ! Double to double array             DBLAD
   ! Integer to double array            DBLAN

 ! Additional functions, compatible with Fortran-SC

      INTERFACE SUP
         MODULE PROCEDURE SUP_F90
      END INTERFACE

      INTERFACE INF
         MODULE PROCEDURE INF_F90
      END INTERFACE

CONTAINS

 ! Fortran 90 version of the INTLIB routine RNDOUT, for efficiency
 ! (The elementary operations in INTLIB are redefined here, too,
 ! for efficiency.)
 
      SUBROUTINE RNDOUT_F90(X,RNDDWN,RNDUP) 
         IMPLICIT NONE
         TYPE(INTERVAL) :: X
         LOGICAL RNDDWN, RNDUP
         
         DOUBLE PRECISION MXULP, TTINY2, TOL0
         COMMON /MACH1/ MXULP, TTINY2, TOL0
 
         DOUBLE PRECISION TINY, TEST
         COMMON /MACH2/ TINY, TEST
         
         IF (RNDDWN) THEN
            IF (X%LOWER.GE.TEST) THEN
               X%LOWER = (1.D0 - MXULP ) * X%LOWER
            ELSE IF (X%LOWER.LE.-TEST) THEN
               X%LOWER = (1D0 + MXULP ) * X%LOWER
            ELSE IF (X%LOWER.LE.0.D0) THEN
               X%LOWER = -TEST
            ELSE
               X%LOWER = 0.D0
            END IF
         END IF

         IF (RNDUP) THEN
            IF (X%UPPER.GE.TEST) THEN
               X%UPPER = (1.D0 + MXULP )* X%UPPER
            ELSE IF (X%UPPER.LE.-TEST) THEN
               X%UPPER = (1.D0 - MXULP ) * X%UPPER
            ELSE IF(X%UPPER.GE.0D0) THEN
               X%UPPER = TEST
            ELSE
               X%UPPER = 0.D0
            ENDIF
        END IF
     END SUBROUTINE RNDOUT_F90
        
 ! Basic operation Fortran 77 calls

      FUNCTION ADD_F90(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) :: ADD_F90
         TYPE(INTERVAL), INTENT(IN) :: A, B
         
         ADD_F90%LOWER = A%LOWER + B%LOWER
         ADD_F90%UPPER = A%UPPER + B%UPPER

         CALL RNDOUT_F90(ADD_F90, &
                         (A%LOWER.NE.0D0).AND.(B%LOWER.NE.0D0), &
                         (A%UPPER.NE.0D0).AND.(B%UPPER.NE.0D0) )
      END FUNCTION ADD_F90

      FUNCTION REAL_PLUS_IVL_F90(A, B)
         IMPLICIT NONE
         DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         TYPE(INTERVAL) :: REAL_PLUS_IVL_F90
 
         REAL_PLUS_IVL_F90%LOWER = A + B%LOWER
         REAL_PLUS_IVL_F90%UPPER = A + B%UPPER

         CALL RNDOUT_F90(REAL_PLUS_IVL_F90, &
                         (A.NE.0D0).AND.(B%LOWER.NE.0D0), &
                         (A.NE.0D0).AND.(B%UPPER.NE.0D0) )
      END FUNCTION REAL_PLUS_IVL_F90

      FUNCTION IVL_PLUS_REAL_F90(A, B)
         IMPLICIT NONE
         DOUBLE PRECISION, INTENT(IN) :: B
         TYPE(INTERVAL), INTENT(IN) :: A
         TYPE(INTERVAL) :: IVL_PLUS_REAL_F90
         
         IVL_PLUS_REAL_F90%LOWER = B + A%LOWER
         IVL_PLUS_REAL_F90%UPPER = B + A%UPPER

         CALL RNDOUT_F90(IVL_PLUS_REAL_F90, &
                         (B.NE.0D0).AND.(A%LOWER.NE.0D0), &
                         (B.NE.0D0).AND.(A%UPPER.NE.0D0) )       
      END FUNCTION IVL_PLUS_REAL_F90

      FUNCTION INTEGER_PLUS_IVL_F90(A, B)
         IMPLICIT NONE
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         TYPE(INTERVAL) :: INTEGER_PLUS_IVL_F90
         DOUBLE PRECISION T
         
         T = DBLE(A)
         INTEGER_PLUS_IVL_F90%LOWER = T + B%LOWER
         INTEGER_PLUS_IVL_F90%UPPER = T + B%UPPER

         CALL RNDOUT_F90(INTEGER_PLUS_IVL_F90, &
                         (T.NE.0D0).AND.(B%LOWER.NE.0D0), &
                         (T.NE.0D0).AND.(B%UPPER.NE.0D0) )
      END FUNCTION INTEGER_PLUS_IVL_F90

      FUNCTION IVL_PLUS_INTEGER_F90(A, B)
         IMPLICIT NONE
         INTEGER, INTENT(IN) :: B
         TYPE(INTERVAL), INTENT(IN) :: A
         TYPE(INTERVAL) :: IVL_PLUS_INTEGER_F90
         DOUBLE PRECISION T

         T = DBLE(B)
         IVL_PLUS_INTEGER_F90%LOWER = T + A%LOWER
         IVL_PLUS_INTEGER_F90%UPPER = T + A%UPPER
          
         CALL RNDOUT_F90(IVL_PLUS_INTEGER_F90, &
                         (T.NE.0D0).AND.(A%LOWER.NE.0D0), &
                         (T.NE.0D0).AND.(A%UPPER.NE.0D0) )           
      END FUNCTION IVL_PLUS_INTEGER_F90

      FUNCTION SUB_F90(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) :: SUB_F90
         TYPE(INTERVAL), INTENT(IN) :: A, B
         DOUBLE PRECISION TA1, TA2, TB1, TB2
         
         TA1 = A%LOWER;  TA2 = A%UPPER
         TB1 = B%LOWER;  TB2 = B%UPPER

         SUB_F90%LOWER = TA1 - TB2
         SUB_F90%UPPER = TA2 - TB1

         CALL RNDOUT_F90(SUB_F90, (TB2.NE.0D0), (TB1.NE.0D0) )
      END FUNCTION SUB_F90

      FUNCTION REAL_MINUS_IVL_F90(A,B)
         IMPLICIT NONE
         DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         TYPE(INTERVAL):: REAL_MINUS_IVL_F90
         REAL_MINUS_IVL_F90 = SUB_F90(INTERVAL(A,A),B)
      END FUNCTION REAL_MINUS_IVL_F90

      FUNCTION IVL_MINUS_REAL_F90(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         TYPE(INTERVAL):: IVL_MINUS_REAL_F90
         IVL_MINUS_REAL_F90 = SUB_F90(A,INTERVAL(B,B))
      END FUNCTION IVL_MINUS_REAL_F90

      FUNCTION INTEGER_MINUS_IVL_F90(A,B)
         IMPLICIT NONE
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         TYPE(INTERVAL):: INTEGER_MINUS_IVL_F90
         INTEGER_MINUS_IVL_F90 = SUB_F90(INTERVAL(A,A),B)
      END FUNCTION INTEGER_MINUS_IVL_F90

      FUNCTION IVL_MINUS_INTEGER_F90(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN) :: A
         INTEGER, INTENT(IN) :: B
         TYPE(INTERVAL):: IVL_MINUS_INTEGER_F90
         IVL_MINUS_INTEGER_F90 = SUB_F90(A,INTERVAL(B,B))
      END FUNCTION IVL_MINUS_INTEGER_F90

      FUNCTION INEG_F90(A)
         IMPLICIT NONE
         TYPE(INTERVAL) INEG_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         TYPE(INTERVAL) :: T

         T%LOWER = A%LOWER
         T%UPPER = A%UPPER
         INEG_F90%LOWER = -T%UPPER
         INEG_F90%UPPER = -T%LOWER
         CALL RNDOUT_F90 (INEG_F90, .TRUE.,.TRUE.)
      END FUNCTION INEG_F90

      FUNCTION MULT_F90(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) MULT_F90
         TYPE(INTERVAL), INTENT(IN) :: A, B
         DOUBLE PRECISION TEMP, A1, B1
         TYPE(INTERVAL) :: AA, BB
        !  Pictures for cases.
         IF ((ZERO .LE. A%LOWER) .AND. (ZERO .LE. B%LOWER)) THEN
        !  Case 1   ---------------- 0 -----------------
        !        A:                    [==========]
        !        B:                         [===========]
            MULT_F90%LOWER = A%LOWER * B%LOWER
            MULT_F90%UPPER = A%UPPER * B%UPPER
         ELSE IF ((A%LOWER .LT. ZERO) .AND. (ZERO .LT. A%UPPER) &
                                .AND. (ZERO .LE. B%LOWER)) THEN
        !  Case 2   ---------------- 0 -----------------
        !        A:            [==================]
        !        B:                         [===========]
            MULT_F90%LOWER = A%LOWER * B%UPPER
            MULT_F90%UPPER = A%UPPER * B%UPPER
         ELSE IF ((A%UPPER .LE. ZERO) .AND. (ZERO .LE. B%LOWER)) THEN
        !  Case 3   ---------------- 0 -----------------
        !        A:    [==========]
        !        B:                         [===========]
            B1 = B%LOWER
            MULT_F90%LOWER = A%LOWER * B%UPPER
            MULT_F90%UPPER = A%UPPER * B1
         ELSE IF ((ZERO .LE. A%LOWER) .AND. (B%LOWER .LT. ZERO) &
                                .AND. (ZERO .LT. B%UPPER)) THEN
        !  Case 4   ---------------- 0 -----------------
        !        A:                     [==========]
        !        B:               [===========]
            MULT_F90%LOWER = A%UPPER * B%LOWER
            MULT_F90%UPPER = A%UPPER * B%UPPER
         ELSE IF ((A%UPPER .LE. ZERO) .AND. (B%LOWER .LT. ZERO) &
                                .AND. (ZERO .LT. B%UPPER)) THEN
        !  Case 5   ---------------- 0 -----------------
        !        A:    [==========]
        !        B           [===========]
            A1 = A%LOWER
            B1 = B%LOWER
            MULT_F90%LOWER = A%LOWER * B%UPPER
            MULT_F90%UPPER = A1 * B1
         ELSE IF ((ZERO .LE. A%LOWER) .AND. (B%UPPER .LE. ZERO)) THEN
        !  Case 6   ---------------- 0 -----------------
        !        A:                    [==========]
        !        B:  [===========]
            A1 = A%LOWER
            MULT_F90%LOWER = A%UPPER * B%LOWER
            MULT_F90%UPPER = A1 * B%UPPER
         ELSE IF ((A%LOWER .LT. ZERO) .AND. (ZERO .LT. A%UPPER) &
                                .AND. (B%UPPER .LE. ZERO)) THEN
        !  Case 7   ---------------- 0 -----------------
        !        A:              [==========]
        !        B:  [===========]
            A1 = A%LOWER
            B1 = B%LOWER
            MULT_F90%LOWER = A%UPPER * B%LOWER
            MULT_F90%UPPER = A1 * B1
         ELSE IF ((A%UPPER .LE. ZERO) .AND. (B%UPPER .LE. ZERO)) THEN
        !  Case 8   ---------------- 0 -----------------
        !        A:    [==========]
        !        B:   [===========]
            A1 = A%LOWER
            B1 = B%LOWER
            MULT_F90%LOWER = A%UPPER * B%UPPER
            MULT_F90%UPPER = A1 * B1
         ELSE
        !  Case 9   ---------------- 0 -----------------
        !        A:              [==========]
        !        B:              [===========]
        !  Must check two cases.
            AA%LOWER = A%LOWER
            AA%UPPER = A%UPPER
            BB%LOWER = B%LOWER
            BB%UPPER = B%UPPER
            MULT_F90%LOWER = AA%LOWER * BB%UPPER
            TEMP = AA%UPPER * BB%LOWER
            IF (TEMP .LT. MULT_F90%LOWER) THEN
               MULT_F90%LOWER = TEMP
            ELSE
            END IF
            MULT_F90%UPPER = AA%LOWER * BB%LOWER
            TEMP = AA%UPPER * BB%UPPER
            IF (TEMP .GT. MULT_F90%UPPER) THEN
              MULT_F90%UPPER = TEMP
            ELSE
            END IF
         END IF
         CALL RNDOUT_F90(MULT_F90,.TRUE.,.TRUE.)  
      END FUNCTION MULT_F90

      FUNCTION REAL_TIMES_IVL_F90(R, B)
         IMPLICIT NONE
         DOUBLE PRECISION, INTENT(IN) :: R
         TYPE(INTERVAL), INTENT(IN) :: B
         TYPE(INTERVAL) :: REAL_TIMES_IVL_F90
         DOUBLE PRECISION T1, T2
         LOGICAL RNDDWN, RNDUP
         IF ((R.EQ.0D0).OR.((B%LOWER.EQ.0D0).AND.& 
                            (B%UPPER.EQ.0D0))) THEN
            REAL_TIMES_IVL_F90%LOWER = 0D0
            REAL_TIMES_IVL_F90%UPPER = 0D0
            RETURN
         END IF
         T1 = B%LOWER
         T2 = B%UPPER
         RNDDWN = .TRUE.
         RNDUP = .TRUE.
         IF (T1.EQ.0D0) THEN
            IF (R.LT.0D0) THEN
               REAL_TIMES_IVL_F90%LOWER = R * T2
               REAL_TIMES_IVL_F90%UPPER = 0D0
               RNDUP = .FALSE.
            ELSE
               REAL_TIMES_IVL_F90%LOWER = 0D0
               REAL_TIMES_IVL_F90%UPPER = R * T2
               RNDDWN = .FALSE.
            END IF
         ELSE IF (T2.EQ.0D0) THEN
            IF (R.LT.0D0) THEN
               REAL_TIMES_IVL_F90%LOWER = 0D0
               REAL_TIMES_IVL_F90%UPPER = R * T1
               RNDDWN = .FALSE.
            ELSE
               REAL_TIMES_IVL_F90%LOWER = R * T1
               REAL_TIMES_IVL_F90%UPPER = 0D0
               RNDUP = .FALSE.
            END IF
         ELSE IF (R.GT.0D0) THEN
            REAL_TIMES_IVL_F90%LOWER = R * T1
            REAL_TIMES_IVL_F90%UPPER = R * T2
         ELSE
            REAL_TIMES_IVL_F90%LOWER = R * T2
            REAL_TIMES_IVL_F90%UPPER = R * T1
         END IF
         CALL RNDOUT_F90(REAL_TIMES_IVL_F90,RNDDWN,RNDUP)
      END FUNCTION REAL_TIMES_IVL_F90

      FUNCTION IVL_TIMES_REAL_F90(A, B)
         IMPLICIT NONE
         DOUBLE PRECISION, INTENT(IN) :: B
         TYPE(INTERVAL), INTENT(IN) :: A
         TYPE(INTERVAL) :: IVL_TIMES_REAL_F90
         IVL_TIMES_REAL_F90 = REAL_TIMES_IVL_F90(B,A)
      END FUNCTION IVL_TIMES_REAL_F90

      FUNCTION INTEGER_TIMES_IVL_F90(A, B)
         IMPLICIT NONE
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         TYPE(INTERVAL) :: INTEGER_TIMES_IVL_F90
         INTEGER_TIMES_IVL_F90 = REAL_TIMES_IVL_F90(DBLE(A),B)
      END FUNCTION INTEGER_TIMES_IVL_F90

      FUNCTION IVL_TIMES_INTEGER_F90(A, B)
         IMPLICIT NONE
         INTEGER, INTENT(IN) ::  B
         TYPE(INTERVAL), INTENT(IN) :: A
         TYPE(INTERVAL) :: IVL_TIMES_INTEGER_F90
         IVL_TIMES_INTEGER_F90 = REAL_TIMES_IVL_F90(DBLE(B),A)
      END FUNCTION IVL_TIMES_INTEGER_F90

      FUNCTION DIV_F90(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) :: DIV_F90
         TYPE(INTERVAL), INTENT(IN) :: A, B
         DOUBLE PRECISION, DIMENSION(2) :: X
         INTERFACE
            SUBROUTINE ERRTST(X)
               DOUBLE PRECISION, DIMENSION(2) :: X
            END SUBROUTINE ERRTST
         END INTERFACE
         TYPE(INTERVAL) :: C

         INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
         COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
       
       ! Identifying code for this routine --
         IROUT = 3
         IERR = 0
         
       ! Do usual interval division if zero is not in the denominator
         IF (B%LOWER.GT.ZERO) THEN
            C%LOWER = ONE/B%UPPER
            C%UPPER = ONE/B%LOWER
            CALL RNDOUT_F90(C,.TRUE.,.TRUE.)
            DIV_F90 =  MULT_F90(A,C)
         ELSE IF (B%UPPER.LT.ZERO) THEN
            C%LOWER = ONE/B%UPPER
            C%UPPER = ONE/B%LOWER
            CALL RNDOUT_F90(C,.TRUE.,.TRUE.)
            DIV_F90 = MULT_F90(A,C)
         ELSE
            IERR = 6
            X = DBLAI(B)
            CALL ERRTST(X)
            DIV_F90 = REAL_LINE
         END IF
      END FUNCTION DIV_F90

      FUNCTION REAL_OVER_IVL_F90(A,B)
         IMPLICIT NONE
         DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         TYPE(INTERVAL) :: REAL_OVER_IVL_F90
         REAL_OVER_IVL_F90 = DIV_F90(INTERVAL(A,A),B)
      END FUNCTION REAL_OVER_IVL_F90

      FUNCTION IVL_OVER_REAL_F90(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         TYPE(INTERVAL) :: IVL_OVER_REAL_F90
         IVL_OVER_REAL_F90 = DIV_F90(A,INTERVAL(B,B))
      END FUNCTION IVL_OVER_REAL_F90

      FUNCTION INTEGER_OVER_IVL_F90(A,B)
         IMPLICIT NONE
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         TYPE(INTERVAL) :: INTEGER_OVER_IVL_F90
         INTEGER_OVER_IVL_F90 = DIV_F90(INTERVAL(A,A),B)
      END FUNCTION INTEGER_OVER_IVL_F90

      FUNCTION IVL_OVER_INTEGER_F90(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN) :: A
         INTEGER, INTENT(IN) :: B
         TYPE(INTERVAL):: IVL_OVER_INTEGER_F90
         IVL_OVER_INTEGER_F90 = DIV_F90(A,INTERVAL(B,B))
      END FUNCTION IVL_OVER_INTEGER_F90

 ! Elementary function Fortran 77 calls (interfaces to INTLIB)

      FUNCTION POWER_F90(A,N)
         IMPLICIT NONE
         TYPE(INTERVAL) POWER_F90
         TYPE(INTERVAL), INTENT(IN):: A
         INTEGER, INTENT(IN):: N
         INTERFACE
            SUBROUTINE POWER(A,N,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A
               INTEGER N
               DOUBLE PRECISION, DIMENSION(2) :: VALUE
            END SUBROUTINE POWER
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL POWER (DBLAI(A),N,TMP)
         POWER_F90 = IDBLA(TMP)
      END FUNCTION POWER_F90

      FUNCTION IIPOWR_F90(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) IIPOWR_F90
         TYPE(INTERVAL), INTENT(IN) :: A, B
         INTERFACE
            SUBROUTINE IIPOWR(A,B,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, B, VALUE
            END SUBROUTINE IIPOWR
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL IIPOWR (DBLAI(A),DBLAI(B),TMP)
         IIPOWR_F90 = IDBLA(TMP)
      END FUNCTION IIPOWR_F90

      FUNCTION REAL_TO_IVL_F90(A,B)
         IMPLICIT NONE
         DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         INTERFACE
            SUBROUTINE IIPOWR(A,B,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, B, VALUE
            END SUBROUTINE IIPOWR
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         TYPE(INTERVAL):: REAL_TO_IVL_F90
         CALL IIPOWR(DBLAD(A),DBLAI(B),TMP)
         REAL_TO_IVL_F90 = IDBLA(TMP)
      END FUNCTION REAL_TO_IVL_F90

      FUNCTION IVL_TO_REAL_F90(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         TYPE(INTERVAL):: IVL_TO_REAL_F90
         INTERFACE
            SUBROUTINE IIPOWR(A,B,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, B, VALUE
            END SUBROUTINE IIPOWR
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL IIPOWR(DBLAI(A),DBLAD(B),TMP)
         IVL_TO_REAL_F90 = IDBLA(TMP)
      END FUNCTION IVL_TO_REAL_F90

      FUNCTION IGR_TO_IVL_F90(A,B)
         IMPLICIT NONE
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         TYPE(INTERVAL):: IGR_TO_IVL_F90
         INTERFACE
            SUBROUTINE IIPOWR(A,B,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, B, VALUE
            END SUBROUTINE IIPOWR
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL IIPOWR(DBLAN(A),DBLAI(B),TMP)
         IGR_TO_IVL_F90 = IDBLA(TMP)
      END FUNCTION IGR_TO_IVL_F90

      FUNCTION ICOS_F90(A)
         IMPLICIT NONE
         TYPE(INTERVAL) ICOS_F90
         TYPE(INTERVAL), INTENT(IN):: A
         INTERFACE
            SUBROUTINE ICOS(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE ICOS
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL ICOS (DBLAI(A),TMP)
         ICOS_F90 = IDBLA(TMP)
      END FUNCTION ICOS_F90

      FUNCTION IEXP_F90(A)
        IMPLICIT NONE
        TYPE(INTERVAL) IEXP_F90
         TYPE(INTERVAL), INTENT(IN):: A
         INTERFACE
            SUBROUTINE IEXP(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE IEXP
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL IEXP (DBLAI(A),TMP)
         IEXP_F90 = IDBLA(TMP)
      END FUNCTION IEXP_F90

      FUNCTION ILOG_F90(A)
         IMPLICIT NONE
         TYPE(INTERVAL) ILOG_F90
         TYPE(INTERVAL), INTENT(IN):: A
         INTERFACE
            SUBROUTINE ILOG(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE ILOG
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL ILOG (DBLAI(A),TMP)
         ILOG_F90 = IDBLA(TMP)
      END FUNCTION ILOG_F90

      FUNCTION ISIN_F90(A)
         IMPLICIT NONE
         TYPE(INTERVAL) ISIN_F90
         TYPE(INTERVAL), INTENT(IN):: A
         INTERFACE
            SUBROUTINE ISIN(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE ISIN
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL ISIN (DBLAI(A),TMP)
         ISIN_F90 = IDBLA(TMP)
      END FUNCTION ISIN_F90

      FUNCTION ITAN_F90(A)
         IMPLICIT NONE
         TYPE(INTERVAL) ITAN_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         INTERFACE
            SUBROUTINE ISIN(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE ISIN
            SUBROUTINE ICOS(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE ICOS
            SUBROUTINE IDIV(A,B,C)
               DOUBLE PRECISION, DIMENSION(2) :: A, B, C
            END SUBROUTINE IDIV
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP1, TMP2
         TMP2 = DBLAI(A)
         CALL ISIN (TMP2, TMP1)
         CALL ICOS (TMP2, TMP2)
         CALL IDIV (TMP1, TMP2, TMP1)
         ITAN_F90 = IDBLA(TMP1)
      END FUNCTION ITAN_F90

      FUNCTION ICOT_F90(A)
         IMPLICIT NONE
         TYPE(INTERVAL) ICOT_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         INTERFACE
            SUBROUTINE ISIN(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE ISIN
            SUBROUTINE ICOS(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE ICOS
            SUBROUTINE IDIV(A,B,C)
               DOUBLE PRECISION, DIMENSION(2) :: A, B, C
            END SUBROUTINE IDIV
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP1, TMP2
         TMP2 = DBLAI(A)
         CALL ISIN (TMP2, TMP1)
         CALL ICOS (TMP2, TMP2)
         CALL IDIV (TMP2, TMP1, TMP1)
         ICOT_F90 = IDBLA(TMP1)
      END FUNCTION ICOT_F90

      FUNCTION ISQRT_F90(A)
         IMPLICIT NONE
         TYPE(INTERVAL) ISQRT_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         INTERFACE
            SUBROUTINE ISQRT(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE ISQRT
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL ISQRT (DBLAI(A),TMP)
         ISQRT_F90 = IDBLA(TMP)
      END FUNCTION ISQRT_F90

      FUNCTION IATAN_F90(A)
         IMPLICIT NONE
         TYPE(INTERVAL) IATAN_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         INTERFACE
            SUBROUTINE IATAN(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE IATAN
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL IATAN (DBLAI(A),TMP)
         IATAN_F90 = IDBLA(TMP)
      END FUNCTION IATAN_F90

      FUNCTION IACOT_F90(A)
         IMPLICIT NONE
         TYPE(INTERVAL) IACOT_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         INTERFACE
            SUBROUTINE IACOT(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE IACOT
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL IACOT (DBLAI(A),TMP)
         IACOT_F90 = IDBLA(TMP)
      END FUNCTION IACOT_F90

      FUNCTION IASIN_F90(A)
         IMPLICIT NONE
         TYPE(INTERVAL) IASIN_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         INTERFACE
            SUBROUTINE IASIN(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE IASIN
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL IASIN (DBLAI(A),TMP)
         IASIN_F90 = IDBLA(TMP)
      END FUNCTION IASIN_F90

      FUNCTION IACOS_F90(A)
         IMPLICIT NONE
         TYPE(INTERVAL) IACOS_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         INTERFACE
            SUBROUTINE IACOS(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE IACOS
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL IACOS (DBLAI(A),TMP)
         IACOS_F90 = IDBLA(TMP)
      END FUNCTION IACOS_F90

      FUNCTION ISINH_F90(A)
         IMPLICIT NONE
         TYPE(INTERVAL) ISINH_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         INTERFACE
            SUBROUTINE ISINH(A,VALUE)
               DOUBLE PRECISION, DIMENSION(2) :: A, VALUE
            END SUBROUTINE ISINH
         END INTERFACE
         DOUBLE PRECISION, DIMENSION(2) :: TMP
         CALL ISINH (DBLAI(A),TMP)
         ISINH_F90 = IDBLA(TMP)
      END FUNCTION ISINH_F90

 ! Utility function Fortran 77 calls

      FUNCTION ICAP_F90(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) ICAP_F90
         TYPE(INTERVAL), INTENT(IN) :: A, B
         TYPE(INTERVAL) :: T
         DOUBLE PRECISION, DIMENSION(2) :: X
         INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
         COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
         IROUT = 13
         IERR = 0
         T%LOWER = MAX (A%LOWER, B%LOWER)
         T%UPPER = MIN (A%UPPER, B%UPPER)
         ICAP_F90 = T
         IF (ICAP_F90%LOWER.GT.ICAP_F90%UPPER) THEN
            IERR=13
            X = DBLAI(ICAP_F90)
            CALL ERRTST(X)
            ICAP_F90 = IDBLA(X)
         END IF
      END FUNCTION ICAP_F90

      FUNCTION IHULL_F90(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) IHULL_F90
         TYPE(INTERVAL), INTENT(IN) :: A, B
         TYPE(INTERVAL) :: T
         IF ( A%LOWER.GT.A%UPPER ) THEN
            IF (B%LOWER.GT.B%UPPER) THEN
               T=INTERVAL(MAX(A%UPPER,B%UPPER),MIN(A%LOWER,B%UPPER))
            ELSE
               T = B
            END IF
         ELSE IF ( B%LOWER.GT.B%UPPER ) THEN
            T = A
         ELSE
            T=INTERVAL(MIN(A%LOWER,B%LOWER),MAX(A%UPPER,B%UPPER))
         END IF
         IHULL_F90 = T
      END FUNCTION IHULL_F90

      FUNCTION IHULL_R_I(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) IHULL_R_I
         DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         IHULL_R_I = IHULL_F90(INTERVAL(A,A),B)
      END FUNCTION IHULL_R_I

      FUNCTION IHULL_I_R(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) IHULL_I_R
         TYPE(INTERVAL), INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         IHULL_I_R = IHULL_F90(A,INTERVAL(B,B))
      END FUNCTION IHULL_I_R

      FUNCTION IHULL_R_R(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) IHULL_R_R
         DOUBLE PRECISION, INTENT(IN) :: A, B
         IHULL_R_R = IHULL_F90(INTERVAL(A,A),INTERVAL(B,B))
      END FUNCTION IHULL_R_R

      FUNCTION IHULL_N_I(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) IHULL_N_I
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         IHULL_N_I = IHULL_F90(INTERVAL(A,A),B)
      END FUNCTION IHULL_N_I

      FUNCTION IHULL_I_N(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) IHULL_I_N
         TYPE(INTERVAL), INTENT(IN) :: A
         INTEGER, INTENT(IN) :: B
         IHULL_I_N = IHULL_F90(A,INTERVAL(B,B))
      END FUNCTION IHULL_I_N

      FUNCTION IHULL_N_N(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) IHULL_N_N
         INTEGER, INTENT(IN) :: A, B
         IHULL_N_N = IHULL_F90(INTERVAL(A,A),INTERVAL(B,B))
      END FUNCTION IHULL_N_N

      FUNCTION IHULL_N_R(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) IHULL_N_R
         INTEGER, INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         IHULL_N_R = IHULL_F90(INTERVAL(A,A),INTERVAL(B,B))
      END FUNCTION IHULL_N_R

      FUNCTION IHULL_R_N(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL) IHULL_R_N
         DOUBLE PRECISION, INTENT(IN) :: A
         INTEGER, INTENT(IN) :: B
         IHULL_R_N = IHULL_F90(INTERVAL(A,A),INTERVAL(B,B))
      END FUNCTION IHULL_R_N

      FUNCTION IILEI_F90(A,B) RESULT(L)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN):: A, B
         LOGICAL:: L
         L = (A%LOWER.GE.B%LOWER) .AND. (A%UPPER.LE.B%UPPER)
      END FUNCTION IILEI_F90

      FUNCTION IIGEI_F90(A,B)
         IMPLICIT NONE
         LOGICAL IIGEI_F90
         TYPE(INTERVAL), INTENT(IN) :: A, B
         IIGEI_F90 = IILEI_F90(B,A)
      END FUNCTION IIGEI_F90

      LOGICAL FUNCTION IRILEI(A,B)
         IMPLICIT NONE
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         IRILEI = IILEI_F90(INTERVAL(A,A),B)
      END FUNCTION IRILEI

      LOGICAL FUNCTION IIILEI(A,B)
         TYPE(INTERVAL), INTENT(IN) :: A, B
         IIILEI = A%LOWER.GT.B%LOWER .AND. A%UPPER.LT.B%UPPER
      END FUNCTION IIILEI

      FUNCTION IRLEI_F90(A,B) RESULT(L)
         IMPLICIT NONE
         DOUBLE PRECISION, INTENT(IN):: A
         TYPE(INTERVAL), INTENT(IN):: B
         LOGICAL:: L
         L = (A .GE. B%LOWER) .AND. (A .LE. B%UPPER)
      END FUNCTION IRLEI_F90

      FUNCTION IDISJ_F90(A,B) RESULT(L)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN):: A, B
         LOGICAL:: L
         L = (A%UPPER .LT. B%LOWER) .OR. (B%UPPER .LT. A%LOWER)
      END FUNCTION IDISJ_F90
      
 ! Interval-valued absolute value
 
      FUNCTION IVLABS_F90(A) RESULT(R)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN) :: A
         TYPE(INTERVAL) :: R
         TYPE(INTERVAL) :: TA, TMP
         TA = A
         TMP%LOWER = ABS(TA%LOWER)
         TMP%UPPER = ABS(TA%UPPER)
         IF (TMP%LOWER.LE.TMP%UPPER) THEN
            R = TMP
         ELSE
            R%LOWER = TMP%UPPER
            R%UPPER = TMP%LOWER
         END IF
         CALL RNDOUT_F90(R,.TRUE.,.TRUE.)
         IF ( ( TA%LOWER.LE.ZERO .AND. TA%UPPER.GE.ZERO ) .OR. &
                R%LOWER.LT. ZERO)  R%LOWER = ZERO
      END FUNCTION IVLABS_F90

 ! Not in INTLIB

      FUNCTION IVLMAX_F90(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN) :: A, B
         TYPE(INTERVAL) :: IVLMAX_F90
         IVLMAX_F90%LOWER = MAX(A%LOWER,B%LOWER)
         IVLMAX_F90%UPPER = MAX(A%UPPER,B%UPPER)
      END FUNCTION IVLMAX_F90

      FUNCTION IVRMAX(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         TYPE(INTERVAL) :: IVRMAX
         IVRMAX%LOWER = MAX(A%LOWER,B)
         IVRMAX%UPPER = MAX(A%UPPER,B)
      END FUNCTION IVRMAX

      FUNCTION RIVMAX(A,B)
         IMPLICIT NONE
         DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         TYPE(INTERVAL) :: RIVMAX
         RIVMAX%LOWER = MAX(B%LOWER,A)
         RIVMAX%UPPER = MAX(B%UPPER,A)
      END FUNCTION RIVMAX

      FUNCTION IVIMAX(A,B)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN) :: A
         INTEGER, INTENT(IN) :: B
         TYPE(INTERVAL) :: IVIMAX
         IVIMAX%LOWER = MAX(A%LOWER,DBLE(B))
         IVIMAX%UPPER = MAX(A%UPPER,DBLE(B))
      END FUNCTION IVIMAX

      FUNCTION IIVMAX(A,B)
         IMPLICIT NONE
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         TYPE(INTERVAL) :: IIVMAX
         IIVMAX%LOWER = MAX(B%LOWER,DBLE(A))
         IIVMAX%UPPER = MAX(B%UPPER,DBLE(A))
      END FUNCTION IIVMAX

  ! .LT.

      FUNCTION INTINTLT_F90(A,B)
         IMPLICIT NONE
         LOGICAL INTINTLT_F90
         TYPE(INTERVAL), INTENT(IN) :: A, B
         INTINTLT_F90 = A%UPPER.LT.B%LOWER
      END FUNCTION INTINTLT_F90

      FUNCTION REALINTLT_F90(A,B)
         IMPLICIT NONE
         LOGICAL REALINTLT_F90
         DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         REALINTLT_F90 = A.LT.B%LOWER
      END FUNCTION REALINTLT_F90

      FUNCTION INTREALLT_F90(A,B)
         IMPLICIT NONE
         LOGICAL INTREALLT_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         INTREALLT_F90 = A%UPPER.LT.B
      END FUNCTION INTREALLT_F90

      FUNCTION IGRINTLT_F90(A,B)
         IMPLICIT NONE
         LOGICAL IGRINTLT_F90
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         IGRINTLT_F90 = A.LT.B%LOWER
      END FUNCTION IGRINTLT_F90

      FUNCTION INTIGRLT_F90(A,B)
         IMPLICIT NONE
         LOGICAL INTIGRLT_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         INTEGER, INTENT(IN) :: B
         INTIGRLT_F90 = A%UPPER.LT.B
      END FUNCTION INTIGRLT_F90

      FUNCTION IVLMIN_F90(A,B)
         TYPE(INTERVAL), INTENT(IN) :: A, B
         TYPE(INTERVAL) :: IVLMIN_F90
         IVLMIN_F90%LOWER = MIN(A%LOWER,B%LOWER)
         IVLMIN_F90%UPPER = MIN(A%UPPER,B%UPPER)
      END FUNCTION IVLMIN_F90

      FUNCTION IVRMIN(A,B)
         TYPE(INTERVAL), INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         TYPE(INTERVAL) :: IVRMIN
         IVRMIN%LOWER = MIN(A%LOWER,B)
         IVRMIN%UPPER = MIN(A%UPPER,B)
      END FUNCTION IVRMIN

      FUNCTION RIVMIN(A,B)
         DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         TYPE(INTERVAL) :: RIVMIN
         RIVMIN%LOWER = MIN(B%LOWER,A)
         RIVMIN%UPPER = MIN(B%UPPER,A)
      END FUNCTION RIVMIN

      FUNCTION IVIMIN(A,B)
         TYPE(INTERVAL), INTENT(IN) :: A
         INTEGER, INTENT(IN) :: B
         TYPE(INTERVAL) :: IVIMIN
         IVIMIN%LOWER = MIN(A%LOWER,DBLE(B))
         IVIMIN%UPPER = MIN(A%UPPER,DBLE(B))
      END FUNCTION IVIMIN

      FUNCTION IIVMIN(A,B)
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         TYPE(INTERVAL) :: IIVMIN
         IIVMIN%LOWER = MIN(B%LOWER,DBLE(A))
         IIVMIN%UPPER = MIN(B%UPPER,DBLE(A))
      END FUNCTION IIVMIN

  ! .GT.

      FUNCTION INTINTGT_F90(A,B)
         IMPLICIT NONE
         LOGICAL INTINTGT_F90
         TYPE(INTERVAL), INTENT(IN) :: A, B
         INTINTGT_F90 = A%LOWER.GT.B%UPPER
      END FUNCTION INTINTGT_F90

      FUNCTION REALINTGT_F90(A,B)
         IMPLICIT NONE
         LOGICAL REALINTGT_F90
         DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         REALINTGT_F90 = A.GT.B%UPPER
      END FUNCTION REALINTGT_F90

      FUNCTION INTREALGT_F90(A,B)
         IMPLICIT NONE
         LOGICAL INTREALGT_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         INTREALGT_F90 = A%LOWER.GT.B
      END FUNCTION INTREALGT_F90

      FUNCTION IGRINTGT_F90(A,B)
         IMPLICIT NONE
         LOGICAL IGRINTGT_F90
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         IGRINTGT_F90 = A.GT.B%UPPER
      END FUNCTION IGRINTGT_F90

      FUNCTION INTIGRGT_F90(A,B)
         IMPLICIT NONE
         LOGICAL INTIGRGT_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         INTEGER, INTENT(IN) :: B
         INTIGRGT_F90 = A%LOWER.GT.B
      END FUNCTION INTIGRGT_F90

  ! .LE.

      FUNCTION INTINTLE_F90(A,B)
         IMPLICIT NONE
         LOGICAL INTINTLE_F90
         TYPE(INTERVAL), INTENT(IN) :: A, B
         INTINTLE_F90 = A%UPPER.LE.B%LOWER
      END FUNCTION INTINTLE_F90

      FUNCTION REALINTLE_F90(A,B)
         IMPLICIT NONE
         LOGICAL REALINTLE_F90
         DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         REALINTLE_F90 = A.LE.B%LOWER
      END FUNCTION REALINTLE_F90

      FUNCTION INTREALLE_F90(A,B)
         IMPLICIT NONE
         LOGICAL INTREALLE_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         INTREALLE_F90 = A%UPPER.LE.B
      END FUNCTION INTREALLE_F90

      FUNCTION IGRINTLE_F90(A,B)
         IMPLICIT NONE
         LOGICAL IGRINTLE_F90
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         IGRINTLE_F90 = A.LE.B%LOWER
      END FUNCTION IGRINTLE_F90

      FUNCTION INTIGRLE_F90(A,B)
         IMPLICIT NONE
         LOGICAL INTIGRLE_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         INTEGER, INTENT(IN) :: B
         INTIGRLE_F90 = A%UPPER.LE.B
      END FUNCTION INTIGRLE_F90

  ! .GE.

      FUNCTION INTINTGE_F90(A,B)
         IMPLICIT NONE
         LOGICAL INTINTGE_F90
         TYPE(INTERVAL), INTENT(IN) :: A, B
         INTINTGE_F90 = A%LOWER.GE.B%UPPER
      END FUNCTION INTINTGE_F90

      FUNCTION REALINTGE_F90(A,B)
         IMPLICIT NONE
         LOGICAL REALINTGE_F90
         DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         REALINTGE_F90 = A.GE.B%UPPER
      END FUNCTION REALINTGE_F90

      FUNCTION INTREALGE_F90(A,B)
         IMPLICIT NONE
         LOGICAL INTREALGE_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         INTREALGE_F90 = A%LOWER.GE.B
      END FUNCTION INTREALGE_F90

      FUNCTION IGRINTGE_F90(A,B)
         IMPLICIT NONE
         LOGICAL IGRINTGE_F90
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         IGRINTGE_F90 = A.GE.B%UPPER
      END FUNCTION IGRINTGE_F90

      FUNCTION INTIGRGE_F90(A,B)
         IMPLICIT NONE
         LOGICAL INTIGRGE_F90
         TYPE(INTERVAL), INTENT(IN) :: A
         INTEGER, INTENT(IN) :: B
         INTIGRGE_F90 = A%LOWER.GE.B
      END FUNCTION INTIGRGE_F90

  ! .NE.

      FUNCTION INTINTNE(A,B)
         IMPLICIT NONE
         LOGICAL INTINTNE
         TYPE(INTERVAL), INTENT(IN) :: A, B
         INTINTNE = (A%LOWER.NE.B%LOWER) .OR. (A%UPPER.NE.B%UPPER)
      END FUNCTION INTINTNE

      FUNCTION REALINTNE(A,B)
         IMPLICIT NONE
         LOGICAL REALINTNE
         DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         REALINTNE = (A.NE.B%LOWER) .OR. (A.NE.B%UPPER)
      END FUNCTION REALINTNE

      FUNCTION INTREALNE(A,B)
         IMPLICIT NONE
         LOGICAL INTREALNE
         TYPE(INTERVAL), INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         INTREALNE = (A%LOWER.NE.B) .OR. (A%UPPER.NE.B)
      END FUNCTION INTREALNE

      FUNCTION IGRINTNE(A,B)
         IMPLICIT NONE
         LOGICAL IGRINTNE
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         IGRINTNE = (DBLE(A).NE.B%LOWER) .OR. (DBLE(A).NE.B%UPPER)
      END FUNCTION IGRINTNE

      FUNCTION INTIGRNE(A,B)
         IMPLICIT NONE
         LOGICAL INTIGRNE
         TYPE(INTERVAL), INTENT(IN) :: A
         INTEGER, INTENT(IN) :: B
         INTIGRNE = (A%LOWER.NE.DBLE(B)) .OR. (A%UPPER.NE.DBLE(B))
      END FUNCTION INTIGRNE

  ! .EQ.

      FUNCTION INTINTEQ(A,B)
         IMPLICIT NONE
         LOGICAL INTINTEQ
         TYPE(INTERVAL), INTENT(IN) :: A, B
         INTINTEQ = (A%LOWER.EQ.B%LOWER) .AND. (A%UPPER.EQ.B%UPPER)
      END FUNCTION INTINTEQ

      FUNCTION REALINTEQ(A,B)
         IMPLICIT NONE
         LOGICAL REALINTEQ
         DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         REALINTEQ = (A.EQ.B%LOWER) .AND. (A.EQ.B%UPPER)
      END FUNCTION REALINTEQ

      FUNCTION INTREALEQ(A,B)
         IMPLICIT NONE
         LOGICAL INTREALEQ
         TYPE(INTERVAL), INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         INTREALEQ = (A%LOWER.EQ.B) .AND. (A%UPPER.EQ.B)
      END FUNCTION INTREALEQ

      FUNCTION IGRINTEQ(A,B)
         IMPLICIT NONE
         LOGICAL IGRINTEQ
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         IGRINTEQ = (DBLE(A).EQ.B%LOWER) .AND. (DBLE(A).EQ.B%UPPER)
      END FUNCTION IGRINTEQ

      FUNCTION INTIGREQ(A,B)
         IMPLICIT NONE
         LOGICAL INTIGREQ
         TYPE(INTERVAL), INTENT(IN) :: A
         INTEGER, INTENT(IN) :: B
         INTIGREQ = (A%LOWER.EQ.DBLE(B)) .AND. (A%UPPER.EQ.DBLE(B))
      END FUNCTION INTIGREQ

 ! Assignment of other data types to interval

      SUBROUTINE INTEGER_TO_INTERVAL (A,B)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(OUT) :: A
         INTEGER, INTENT(IN) :: B
         A = INTERVAL(B,B)
         IF (B.NE.0) CALL RNDOUT_F90(A,.TRUE.,.TRUE.)
       END SUBROUTINE INTEGER_TO_INTERVAL

      SUBROUTINE DOUBLE_TO_INTERVAL (A,B)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(OUT) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         A = INTERVAL(B,B)
         IF (B.NE.0) CALL RNDOUT_F90(A,.TRUE.,.TRUE.)
      END SUBROUTINE DOUBLE_TO_INTERVAL

   ! Internal data conversion routines for interfacing with INTLIB

      FUNCTION IDBLA(B) RESULT(A)
         IMPLICIT NONE
         TYPE(INTERVAL) :: A
         DOUBLE PRECISION, DIMENSION(2) :: B
         A%LOWER = B(1)
         A%UPPER = B(2)
      END FUNCTION IDBLA

      FUNCTION DBLAI(B) RESULT(A)
         IMPLICIT NONE
         DOUBLE PRECISION, DIMENSION(2) :: A
         TYPE(INTERVAL), INTENT(IN) :: B
         A(1) = B%LOWER
         A(2) = B%UPPER
      END FUNCTION DBLAI

      FUNCTION DBLAD(B) RESULT(A)
         IMPLICIT NONE
         DOUBLE PRECISION, DIMENSION(2) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         A(1) = B
         A(2) = B
      END FUNCTION DBLAD

      FUNCTION DBLAN(B) RESULT(A)
         IMPLICIT NONE
         DOUBLE PRECISION, DIMENSION(2) :: A
         INTEGER, INTENT(IN) :: B
         A(1) = DBLE(B)
         A(2) = DBLE(B)
      END FUNCTION DBLAN

      FUNCTION IVL1_F90(A) RESULT(R)
         IMPLICIT NONE
        DOUBLE PRECISION, INTENT(IN) :: A
         TYPE(INTERVAL) :: R
         R = INTERVAL(A,A)
         CALL RNDOUT_F90(R,.TRUE.,.TRUE.)
         END FUNCTION IVL1_F90

      FUNCTION IVL2_F90(A,B) RESULT(R)
         IMPLICIT NONE
         DOUBLE PRECISION, INTENT(IN) :: A, B
         TYPE(INTERVAL):: R
         R = INTERVAL(A,B)
         CALL RNDOUT_F90(R,.TRUE.,.TRUE.)
      END FUNCTION IVL2_F90

      FUNCTION IVL1I_F90(A) RESULT(R)
         IMPLICIT NONE
         INTEGER, INTENT(IN) :: A
         TYPE(INTERVAL) :: R
         R = INTERVAL(A,A)
         CALL RNDOUT_F90(R,.TRUE.,.TRUE.)
      END FUNCTION IVL1I_F90

      FUNCTION IVL2I_F90(A,B) RESULT(R)
         IMPLICIT NONE
         INTEGER, INTENT(IN) :: A, B
         TYPE(INTERVAL):: R
         R = INTERVAL(A,B)
         CALL RNDOUT_F90(R,.TRUE.,.TRUE.)
      END FUNCTION IVL2I_F90

      FUNCTION IVL2DI_F90(A,B) RESULT(R)
         IMPLICIT NONE
         DOUBLE PRECISION, INTENT(IN) :: A
         INTEGER, INTENT(IN) :: B
         TYPE(INTERVAL):: R
         R = INTERVAL(A,B)
         CALL RNDOUT_F90(R,.TRUE.,.TRUE.)
      END FUNCTION IVL2DI_F90

      FUNCTION IVL2ID_F90(A,B) RESULT(R)
         IMPLICIT NONE
         INTEGER, INTENT(IN) :: A
         DOUBLE PRECISION, INTENT(IN) :: B
         TYPE(INTERVAL):: R
         R = INTERVAL(A,B)
         CALL RNDOUT_F90(R,.TRUE.,.TRUE.)
      END FUNCTION IVL2ID_F90

      FUNCTION IVL_IVL(A) RESULT(R)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN) :: A
         TYPE(INTERVAL) :: R
         R = A
      END FUNCTION IVL_IVL

 ! mag, abs, max, iwid, mig, imid --

      FUNCTION INTABS_F90(A) RESULT(D)
         IMPLICIT NONE
         TYPE(INTERVAL) :: A
         DOUBLE PRECISION D
         
         TYPE(INTERVAL) :: T
         
         T%UPPER = ABS(A%LOWER)
         CALL RNDOUT_F90(T,.FALSE.,.TRUE.)
         T%LOWER=T%UPPER
         T%UPPER = ABS(A%UPPER)
         CALL RNDOUT_F90(T,.FALSE.,.TRUE.)
         D = MAX (T%LOWER, T%UPPER)
      END FUNCTION INTABS_F90

      FUNCTION IWID_F90(A) RESULT(B)
         IMPLICIT NONE
         TYPE(INTERVAL) :: A
         DOUBLE PRECISION B
         TYPE(INTERVAL) :: T
         B = A%UPPER - A%LOWER
         T = INTERVAL(B,B)
         CALL RNDOUT_F90(T,.FALSE.,.TRUE.)
         B = T%UPPER
      END FUNCTION IWID_F90

      FUNCTION IMIG_F90(A) RESULT(B)
         IMPLICIT NONE
         TYPE(INTERVAL) :: A
         DOUBLE PRECISION B
         TYPE(INTERVAL) :: T   
         IF ( ((A%LOWER.GT.0D0) .AND. (A%UPPER.GT.0D0)) &
           .OR.((A%LOWER.LT.0D0) .AND. (A%UPPER.LT.0D0)) ) THEN
            T%LOWER = ABS(A%UPPER)
            CALL RNDOUT_F90(T,.TRUE.,.FALSE.)
            T%UPPER=T%LOWER
            T%LOWER = ABS(A%LOWER)
            CALL RNDOUT_F90(T,.TRUE.,.FALSE.)
            B = MIN (T%LOWER, T%UPPER)
         ELSE
            B = 0D0
         END IF
      END FUNCTION IMIG_F90

      FUNCTION IMID_F90(B)
         IMPLICIT NONE
         TYPE(INTERVAL):: B
         DOUBLE PRECISION IMID_F90      
         IMID_F90 = B%LOWER + (B%UPPER - B%LOWER) / 2D0
      END FUNCTION IMID_F90

 ! Additional routines for compatibility with Fortran-SC syntax
 
      FUNCTION SUP_F90(X) RESULT(R)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN) :: X
         DOUBLE PRECISION R
         R = X%UPPER
      END FUNCTION SUP_F90

      FUNCTION INF_F90(X) RESULT(R)
         IMPLICIT NONE
         TYPE(INTERVAL), INTENT(IN) :: X
         DOUBLE PRECISION R
         R = X%LOWER
      END FUNCTION INF_F90

END MODULE INTERVAL_ARITHMETIC
SHAR_EOF
fi # end of overwriting check
if test -f 'intlib.f90'
then
	echo shar: will not over-write existing file "'intlib.f90'"
else
cat << \SHAR_EOF > 'intlib.f90'
!*** basicops.f
      SUBROUTINE ADD (A,B,RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Manuel Novoa III
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   September 29, 1987
!
! Part of the generalized bisection package
! (interval arithmetic subpackage).
!
!***********************************************************************
!
! Called by --
!
!  any routine requiring interval addition.
!
!***********************************************************************
!
! Function --
!
!  This routine adds the interval A and the interval B.  It
!  simulates directed roundings with the routine RNDOUT;  the interval
!  result should contain the interval which would have been obtained
!  with exact interval arithmetic.  However, in general it will not
!  be the smallest possible machine-representable such containing
!  interval.  See the documentation in subroutine RNDOUT for more
!  detailed information.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2), B(2), RESULT(2)
!
!***********************************************************************
!
! Argument descriptions -- (INPUT  = set on entry and not alterable)
!                          (OUTPUT = to be set by the routine)
!                          (I/O    = set on entry but alterable)
!
!  A        is the first operand to the addition.
!           (INPUT)
!
!  B        is the second operand to the addition.
!           (INPUT)
!
!  RESULT   is the interval-arithmetic sum of A and B.
!           (OUTPUT)
!
!***********************************************************************
!
! Internal variable declarations --
!
      LOGICAL RNDDWN, RNDUP
!
!***********************************************************************
!
! Internal variable descriptions --
!
! RNDDWN    is set to .TRUE. if RNDOUT has to round down, and is set
!           to .FALSE. otherwise.
!
! RNDUP     is set to .TRUE. if RNDOUT has to round up, and is set
!           to .FALSE. otherwise.
!
!***********************************************************************
!
! Common block declarations -- none
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines -- none
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
! RNDOUT
!
!***********************************************************************
!
! User-supplied functions and subroutines -- none
!
!***********************************************************************
!
! I/O functions --  none
!
!***********************************************************************
!
! Internal constant declarations -- none
!
!***********************************************************************
!
! Beginning of executable statements --
!
      RNDDWN = (A(1).NE.0D0).AND.(B(1).NE.0D0)
      RNDUP = (A(2).NE.0D0).AND.(B(2).NE.0D0)
!
      RESULT(1) = A(1) + B(1)
      RESULT(2) = A(2) + B(2)
!
      CALL RNDOUT(RESULT,RNDDWN,RNDUP)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE CANCEL (A,B,RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   Manuel Novoa III
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   March 13, 1990
!
! Part of the generalized bisection package
! (interval arithmetic subpackage).
!
!***********************************************************************
!
! Called by --
!
!  Any routine requiring an interval addend to be canceled (removed)
!  from a previously accumulated interval sum.
!
!***********************************************************************
!
! Function --
!
!  Given an interval B, and a previously accumulated interval sum A
!  for which B was an addend, this routine returns an interval which
!  contains, and is hopefully close to, the sum of the other addends
!  for A.  Directed roundings are simulated with the routine RNDOUT;
!  the interval result should contain the interval which would have
!  been obtained with exact interval arithmetic.  However, in general
!  it will not be the smallest possible machine-representable such
!  containing interval.  See the documentation in subroutine RNDOUT for
!  more detailed information.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2), B(2), RESULT(2)
!
!***********************************************************************
!
! Argument descriptions -- (INPUT  = set on entry and not alterable)
!                          (OUTPUT = to be set by the routine)
!                          (I/O    = set on entry but alterable)
!
!  A        is the first operand to the subtraction.
!           (INPUT)
!
!  B        is the second operand to the subtraction
!           (INPUT)
!
!  RESULT   is the interval-arithmetic value of A - B.
!           (OUTPUT)
!
!***********************************************************************
!
! Internal variable declarations --
!
      LOGICAL RNDDWN, RNDUP
!
!***********************************************************************
!
! Internal variable descriptions --
!
!
! RNDDWN    is set to .TRUE. if RNDOUT has to round down, and is set
!           to .FALSE. otherwise.
!
! RNDUP     is set to .TRUE. if RNDOUT has to round up, and is set
!           to .FALSE. otherwise.
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
! RNDOUT
!
!***********************************************************************
!
! Beginning of executable statements --
!
      RNDDWN = (B(1).NE.0D0)
      RNDUP = (B(2).NE.0D0)
!
      RESULT(1) = A(1) - B(1)
      RESULT(2) = A(2) - B(2)
!
      CALL RNDOUT(RESULT,RNDDWN,RNDUP)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE IDIV (AA,BB,RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   May 21, 1992
!
! Part of the interval arithmetic elementary function package.
!
!***********************************************************************
!
! Function --
!
!  This routine performs interval division.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION AA(2), BB(2), RESULT(2)
!
!***********************************************************************
!
! Internal variable declarations --

      DOUBLE PRECISION C(2)
!
!***********************************************************************
!
!  Common block declarations --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  ERRTST, MULT, RNDOUT
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 3
      IERR = 0
!
!  Do usual interval division if zero is not in the denominator --
!
      IF (BB(1).GT.ZERO(2)) THEN
         C(1) = ONE(1)/BB(2)
         C(2) = ONE(2)/BB(1)
         CALL RNDOUT(C,.TRUE.,.TRUE.)
         CALL MULT(AA,C,RESULT)
      ELSE IF (BB(2).LT.ZERO(1)) THEN
         C(1) = ONE(2)/BB(2)
         C(2) = ONE(1)/BB(1)
         CALL RNDOUT(C,.TRUE.,.TRUE.)
         CALL MULT(AA,C,RESULT)
      ELSE
         IERR = 6
         CALL ERRTST(BB)
         RESULT(1) = NEGINF
         RESULT(2) = POSINF
      END IF
!
      RETURN
!
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE MULT (A, B, RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!         and
!
!   Manuel Novoa III
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   November 17, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  MULT multiplies the interval A and the interval B.  It
!  puts the result into output parameter RESULT.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2), B(2), RESULT(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TEMP, A1, B1
      DOUBLE PRECISION AA(2), BB(2)
!
!***********************************************************************
!
! Internal Constant Declarations --
!
      DOUBLE PRECISION ZERO
      PARAMETER (ZERO = 0.0D0)
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Pictures for cases.
!
      IF ((ZERO .LE. A(1)) .AND. (ZERO .LE. B(1))) THEN
!  Case 1   ---------------- 0 -----------------
!        A:                    [==========]
!        B:                         [===========]
          RESULT(1) = A(1) * B(1)
          RESULT(2) = A(2) * B(2)
      ELSE IF ((A(1) .LT. ZERO) .AND. (ZERO .LT. A(2))                  &
     &                          .AND. (ZERO .LE. B(1))) THEN
!  Case 2   ---------------- 0 -----------------
!        A:            [==================]
!        B:                         [===========]
          RESULT(1) = A(1) * B(2)
          RESULT(2) = A(2) * B(2)
      ELSE IF ((A(2) .LE. ZERO) .AND. (ZERO .LE. B(1))) THEN
!  Case 3   ---------------- 0 -----------------
!        A:    [==========]
!        B:                         [===========]
          B1 = B(1)
          RESULT(1) = A(1) * B(2)
          RESULT(2) = A(2) * B1
      ELSE IF ((ZERO .LE. A(1)) .AND. (B(1) .LT. ZERO)                  &
     &                          .AND. (ZERO .LT. B(2))) THEN
!  Case 4   ---------------- 0 -----------------
!        A:                     [==========]
!        B:               [===========]
          RESULT(1) = A(2) * B(1)
          RESULT(2) = A(2) * B(2)
      ELSE IF ((A(2) .LE. ZERO) .AND. (B(1) .LT. ZERO)                  &
     &                          .AND. (ZERO .LT. B(2))) THEN
!  Case 5   ---------------- 0 -----------------
!        A:    [==========]
!        B           [===========]
          A1 = A(1)
          B1 = B(1)
          RESULT(1) = A(1) * B(2)
          RESULT(2) = A1 * B1
      ELSE IF ((ZERO .LE. A(1)) .AND. (B(2) .LE. ZERO)) THEN
!  Case 6   ---------------- 0 -----------------
!        A:                    [==========]
!        B:  [===========]
          A1 = A(1)
          RESULT(1) = A(2) * B(1)
          RESULT(2) = A1 * B(2)
      ELSE IF ((A(1) .LT. ZERO) .AND. (ZERO .LT. A(2))                  &
     &                          .AND. (B(2) .LE. ZERO)) THEN
!  Case 7   ---------------- 0 -----------------
!        A:              [==========]
!        B:  [===========]
          A1 = A(1)
          B1 = B(1)
          RESULT(1) = A(2) * B(1)
          RESULT(2) = A1 * B1
      ELSE IF ((A(2) .LE. ZERO) .AND. (B(2) .LE. ZERO)) THEN
!  Case 8   ---------------- 0 -----------------
!        A:    [==========]
!        B:   [===========]
          A1 = A(1)
          B1 = B(1)
          RESULT(1) = A(2) * B(2)
          RESULT(2) = A1 * B1
      ELSE
!  Case 9   ---------------- 0 -----------------
!        A:              [==========]
!        B:              [===========]
!  Must check two cases.
          AA(1) = A(1)
          AA(2) = A(2)
          BB(1) = B(1)
          BB(2) = B(2)
          RESULT(1) = AA(1) * BB(2)
          TEMP = AA(2) * BB(1)
          IF (TEMP .LT. RESULT(1)) THEN
              RESULT(1) = TEMP
          ELSE
          END IF
              RESULT(2) = AA(1) * BB(1)
          TEMP = AA(2) * BB(2)
          IF (TEMP .GT. RESULT(2)) THEN
              RESULT(2) = TEMP
          ELSE
          END IF
      END IF
!
      CALL RNDOUT(RESULT,.TRUE.,.TRUE.)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE RNDOUT (X,RNDDWN,RNDUP)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Manuel Novoa III
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   September 29, 1987
!
!   Modified August, 1991 and April, 1992 by Kaisheng Du and
!   R. Baker Kearfott to be more accurate near the underflow
!   threshold.
!
! Part of the generalized bisection package
! (interval arithmetic subpackage)
!
!***********************************************************************
!
! Function --
!
!  This routine is intended to simulate directed roundings in a
!  reasonably transportable way.  It is called for each elementary
!  operation involving intervals.  The endpoints of the result interval
!  are first computed with the machine's usual floating point
!  arithmetic.
!
!  If RNDDWN = .TRUE., then this routine decreases the left
!  endpoint of that approximate result by the absolute value of
!  that endpoint times a rigorous estimate for the maximum relative
!  error in an elementary operation.
!
!  If RNDUP = .TRUE., then this routine increases the right
!  endpoint of that approximate result by the absolute value of
!  that endpoint times a rigorous estimate for the maximum relative
!  error in an elementary operation.
!
!  For this routine to work properly, a machine-dependent parameter
!  must be installed in the routine SIMINI.  See the documentation in
!  that routine for details.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2)
      LOGICAL RNDDWN, RNDUP
!
!***********************************************************************
!
! Argument descriptions -- (INPUT  = set on entry and not alterable)
!                          (OUTPUT = to be set by the routine)
!                          (I/O    = set on entry but alterable)
!
! X         is the interval to be adjusted.
!           (I/O)
!
! RNDDWN    is set to .TRUE. if the left endpoint is to be adjusted, and
!           is set to .FALSE. otherwise.
!           (INPUT)
!
! RNDUP     is set to .TRUE. if the right endpoint is to be adjusted,
!           and is set to .FALSE. otherwise.
!           (INPUT)
!
!***********************************************************************
!
! Common block declarations --
!
      DOUBLE PRECISION MXULP, TTINY2, TOL0
      COMMON /MACH1/ MXULP, TTINY2, TOL0
!
!  This common block holds machine parameters which are set in
!  SIMINI and used here.
!
!  Variable descriptions
!
!  MXULP       (machine epsilon)
!                * (maximum error in ULP's of the floating pt. op's)
!
!  TTINY2      2 * (smallest representable positive machine number)
!                * (maximum error in ULP's of the floating pt. op's)
!
!  TOL0        TTINY2 / MXULP
!
      DOUBLE PRECISION TINY, TEST
      COMMON /MACH2/ TINY, TEST
!
!  See SIMINI for an explanation of the common block MACH2.
!
!***********************************************************************
!
! Beginning of executable statements --
!
      IF (RNDDWN) THEN
         IF (X(1).GE.TEST) THEN
            X(1) = (1.D0 - MXULP ) * X(1)
         ELSE IF (X(1).LE.-TEST) THEN
            X(1) = (1D0 + MXULP ) * X(1)
         ELSE IF (X(1).LE.0.D0) THEN
            X(1) = -TEST
         ELSE
            X(1) = 0.D0
         END IF
      END IF
!
      IF (RNDUP) THEN
         IF (X(2).GE.TEST) THEN
            X(2) = (1.D0 + MXULP )* X(2)
         ELSE IF (X(2).LE.-TEST) THEN
            X(2) = (1.D0 - MXULP ) * X(2)
         ELSE IF(X(2).GE.0D0) THEN
            X(2) = TEST
         ELSE
            X(2) = 0.D0
         ENDIF
      END IF
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE SCLADD (R,A,RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Manuel Novoa III
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   September 29, 1987
!
! Part of the generalized bisection package
! (interval arithmetic subpackage).
!
!***********************************************************************
!
! Called by --
!
!  Any routine requiring addition of a point value to an interval.
!
!***********************************************************************
!
! FUNCTION --
!
!  This routine adds the interval A to the point R.  It simulates
!  directed roundings with the routine RNDOUT;  the interval
!  result should contain the interval which would have been obtained
!  with exact interval arithmetic.  However, in general it will not
!  be the smallest possible machine-representable such containing
!  interval.  See the documentation in subroutine RNDOUT for more
!  detailed information.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION R, A(2), RESULT(2)
!
!***********************************************************************
!
! Argument descriptions -- (INPUT  = set on entry and not alterable)
!                          (OUTPUT = to be set by the routine)
!                          (I/O    = set on entry but alterable)
!
!  R        is the point to be added to the interval.
!           (INPUT)
!
!  A        is the interval to be added to the point.
!           (INPUT)
!
!  RESULT   is the interval-arithmetic sum of R and B.
!           (OUTPUT)
!
!***********************************************************************
!
! Internal variable declarations --
!
      LOGICAL RNDDWN, RNDUP
!
!***********************************************************************
!
! Internal variable descriptions --
!
! RNDDWN    is set to .TRUE. if RNDOUT has to round down, and is set
!           to .FALSE. otherwise.
!
! RNDUP     is set to .TRUE. if RNDOUT has to round up, and is set
!           to .FALSE. otherwise.
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  RNDOUT
!
!***********************************************************************
!
! Beginning of executable statements --
!
      RNDDWN = (R.NE.0D0).AND.(A(1).NE.0D0)
      RNDUP = (R.NE.0D0).AND.(A(2).NE.0D0)
!
      RESULT(1) = R + A(1)
      RESULT(2) = R + A(2)
!
      CALL RNDOUT(RESULT,RNDDWN,RNDUP)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE SCLMLT (R,A,RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Manuel Novoa III
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   September 29, 1987
!
! Part of the generalized bisection package
! (interval arithmetic subpackage).
!
! Modified by Manuel Novoa III on March 13, 1990 to clean the code
!   slightly, and to remove the need for MAX and MIN.
!
!***********************************************************************
!
! Called by --
!
!  Any routine requiring multiplication of an interval and a point
!  value.
!
!***********************************************************************
!
! Function --
!
!  This routine multiplies the interval A and the point R.  It
!  simulates directed roundings with the routine RNDOUT;  the interval
!  result should contain the interval which would have been obtained
!  with exact interval arithmetic.  However, in general it will not
!  be the smallest possible machine-representable such containing
!  interval.  See the documentation in subroutine RNDOUT for more
!  detailed information.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION R, A(2), RESULT(2)
!
!***********************************************************************
!
! Argument descriptions -- (INPUT  = set on entry and not alterable)
!                          (OUTPUT = to be set by the routine)
!                          (I/O    = set on entry but alterable)
!
!  R        is the point to be multiplied to the interval.
!           (INPUT)
!
!  A        is the interval to be multiplied to the point.
!           (INPUT)
!
!  RESULT   is the interval-arithmetic product R * B.
!           (OUTPUT)
!
!***********************************************************************
!
! Internal variable declarations --
!
      LOGICAL RNDDWN, RNDUP
      DOUBLE PRECISION T1, T2
!
!***********************************************************************
!
! Internal variable descriptions --
!
! RNDDWN    is set to .TRUE. if RNDOUT is to round down, and is set
!           to .FALSE. otherwise.
!
! RNDUP     is set to .TRUE. if RNDOUT is to round up, and is set
!           to .FALSE. otherwise.
!
! T1 and T2 are temporary variables.
!
!***********************************************************************
!
! Common block declarations -- none
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --  none
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  RNDOUT
!
!***********************************************************************
!
! User-supplied functions and subroutines -- none
!
!***********************************************************************
!
! I/O functions --  none
!
!***********************************************************************
!
! Internal constant declarations -- none
!
!***********************************************************************
!
! Beginning of executable statements --
!
      IF ((R.EQ.0D0).OR.((A(1).EQ.0D0).AND.(A(2).EQ.0D0))) THEN
         RESULT(1) = 0D0
         RESULT(2) = 0D0
         RETURN
      END IF
!
      T1 = A(1)
      T2 = A(2)
      RNDDWN = .TRUE.
      RNDUP = .TRUE.
!
      IF (T1.EQ.0D0) THEN
         IF (R.LT.0D0) THEN
            RESULT(1) = R * T2
            RESULT(2) = 0D0
            RNDUP = .FALSE.
         ELSE
            RESULT(1) = 0D0
            RESULT(2) = R * T2
            RNDDWN = .FALSE.
         END IF
      ELSE IF (T2.EQ.0D0) THEN
         IF (R.LT.0D0) THEN
            RESULT(1) = 0D0
            RESULT(2) = R * T1
            RNDDWN = .FALSE.
         ELSE
            RESULT(1) = R * T1
            RESULT(2) = 0D0
            RNDUP = .FALSE.
         END IF
      ELSE IF (R.GT.0D0) THEN
         RESULT(1) = R * T1
         RESULT(2) = R * T2
      ELSE
         RESULT(1) = R * T2
         RESULT(2) = R * T1
      END IF
!
      CALL RNDOUT(RESULT,RNDDWN,RNDUP)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE SUB (A,B,RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Manuel Novoa III
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   September 29, 1987
!
! Part of the generalized bisection package
! (interval arithmetic subpackage).
!
!***********************************************************************
!
! Called by --
!
!  Any routine requiring interval subtraction.
!
!***********************************************************************
!
! Function --
!
!  This routine subtracts the interval B from the interval A.  It
!  simulates directed roundings with the routine RNDOUT;  the interval
!  result should contain the interval which would have been obtained
!  with exact interval arithmetic.  However, in general it will not
!  be the smallest possible machine-representable such containing
!  interval.  See the documentation in subroutine RNDOUT for more
!  detailed information.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2), B(2), RESULT(2)
!
!***********************************************************************
!
! Argument descriptions -- (INPUT  = set on entry and not alterable)
!                          (OUTPUT = to be set by the routine)
!                          (I/O    = set on entry but alterable)
!
!  A        is the first operand to the subtraction.
!           (INPUT)
!
!  B        is the second operand to the subtraction
!           (INPUT)
!
!  RESULT   is the interval-arithmetic value of A - B.
!           (OUTPUT)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TA1, TA2, TB1, TB2
      LOGICAL RNDDWN, RNDUP
!
!***********************************************************************
!
! Internal variable descriptions --
!
! TA1, TA2, TB1, and TB2 are temporaries.
!
! RNDDWN    is set to .TRUE. if RNDOUT has to round down, and is set
!           to .FALSE. otherwise.
!
! RNDUP     is set to .TRUE. if RNDOUT has to round up, and is set
!           to .FALSE. otherwise.
!
!***********************************************************************
!
! Common block declarations -- none
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines -- none
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
! RNDOUT
!
!***********************************************************************
!
! User-supplied functions and subroutines -- none
!
!***********************************************************************
!
! I/O functions --  none
!
!***********************************************************************
!
! Internal constant declarations -- none
!
!***********************************************************************
!
! Beginning of executable statements --
!
      TA1 = A(1)
      TA2 = A(2)
      TB1 = B(1)
      TB2 = B(2)
!
      RNDDWN = (TB2.NE.0D0)
      RNDUP = (TB1.NE.0D0)
!
      RESULT(1) = TA1 - TB2
      RESULT(2) = TA2 - TB1
!
      CALL RNDOUT(RESULT,RNDDWN,RNDUP)
!
      RETURN
      END

!*** utilfuns.f
      SUBROUTINE ICAP (A, B, RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  DICAP computes the intersection of the two intervals A and B, and
!  places  the result in RESULT.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2), B(2), RESULT(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
!
!***********************************************************************
!
! Common block declarations --
!
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --
!
!   MIN, MAX
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!   ERRTST
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION T(2)
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 13
      IERR = 0
!
      T(1) = MAX (A(1), B(1))
      T(2) = MIN (A(2), B(2))
      RESULT(1) = T(1)
      RESULT(2) = T(2)
      IF (RESULT(1).GT.RESULT(2)) THEN
         IERR=13
         CALL ERRTST(RESULT)
      END IF
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      LOGICAL FUNCTION IDISJ (A, B)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  This function returns .TRUE. if the intervals A and B are disjoint,
!  and .FALSE. otherwise.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2), B(2)
!
!***********************************************************************
!
! Beginning of executable statements --
!
      IDISJ = (A(2) .LT. B(1)) .OR. (B(2) .LT. A(1))
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE IHULL (A, B, RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IHULL returns the convex-hull of the interval A and the interval B
!  in RESULT.  If one of the intervals is empty (lower bound is greater
!  than upper bound), then just the upper interval is returned.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2), B(2), RESULT(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION T(2)
!
!***********************************************************************
!
! Beginning of executable statements --
!
      IF ( A(1).GT.A(2) ) THEN
         IF (B(1).GT.B(2)) THEN
            T(1) = MAX(A(2),B(2))
            T(2) = MIN(A(1),B(2))
         ELSE
            T(1) = B(1)
            T(2) = B(2)
         END IF
      ELSE IF ( B(1).GT.B(2) ) THEN
         T(1) = A(1)
         T(2) = A(2)
      ELSE
         T(1) = MIN (A(1), B(1))
         T(2) = MAX (A(2), B(2))
         RESULT(1) = T(1)
         RESULT(2) = T(2)
      END IF
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      LOGICAL FUNCTION IILEI (A, B)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IILEI sets its value to .TRUE. if interval A is in the closure of
!  interval B.  The value of IILEI is .FALSE. otherwise.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2), B(2)
!
!***********************************************************************
!
! Beginning of executable statements --
!
      IILEI = (A(1) .GE. B(1)) .AND. (A(2) .LE. B(2))
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      LOGICAL FUNCTION IILTI (A, B)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IILE sets its value to .TRUE. if interval A is in the interior of
!  interval B.  The value of IILE is .FALSE. otherwise.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2), B(2)
!
!***********************************************************************
!
! Beginning of executable statements --
!
      IILTI = (A(1) .GT. B(1)) .AND. (A(2) .LT. B(2))
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      DOUBLE PRECISION FUNCTION IINF (A)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IINF returns the lower endpoint of the interval A.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2)
!
!***********************************************************************
!
! Beginning of executable statements --
!
      IINF = A(1)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      DOUBLE PRECISION FUNCTION IMID (X)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IMID returns a floating point approximation to the midpoint
!  of the interval A, using available floating point arithmetic.  The
!  value returned by this routine can be considered to DEFINE the
!  midpoint.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2)
!
!***********************************************************************
!
! Common block declarations --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
!***********************************************************************
!
! Beginning of executable statements --
!
      IMID = X(1) + (X(2) - X(1)) / TWO(1)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      DOUBLE PRECISION FUNCTION IMIG (A)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IMIG returns the mignitude of the interval A. Since ABS is not
!  assumed to give an exact result, the result is rounded down.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TMP(2)
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --
!
!  ABS, MIN
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  RNDOUT
!
!***********************************************************************
!
! Beginning of executable statements --
!
      IF ( ((A(1).GT.0D0) .AND. (A(2).GT.0D0))                          &
     & .OR.((A(1).LT.0D0) .AND. (A(2).LT.0D0)) ) THEN
         TMP(1) = ABS(A(2))
         CALL RNDOUT(TMP,.TRUE.,.FALSE.)
         TMP(2)=TMP(1)
         TMP(1) = ABS(A(1))
         CALL RNDOUT(TMP,.TRUE.,.FALSE.)
         IMIG = MIN (TMP(1), TMP(2))
      ELSE
         IMIG = 0D0
      END IF
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE INEG (A, RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  INEG performs interval unary negation.  The result is rounded out in
!  case the negatives of the endpoints are not representable.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2), RESULT(2)
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  RNDOUT
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION T(2)
!
!***********************************************************************
!
! Beginning of executable statements --
!
      T(1) = A(1)
      T(2) = A(2)
      RESULT(1) = -T(2)
      RESULT(2) = -T(1)
      CALL RNDOUT (RESULT, .TRUE.,.TRUE.)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      DOUBLE PRECISION FUNCTION INTABS (A)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  INTABS returns the maximum absolute value of the interval A.
!  Since ABS is not assumed to give an exact result, the result is
!  rounded up.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TMP(2)
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --
!
!  ABS, MAX
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  RNDOUT
!
!***********************************************************************
!
! Beginning of executable statements --
!
      TMP(2) = ABS(A(1))
      CALL RNDOUT(TMP,.FALSE.,.TRUE.)
      TMP(1)=TMP(2)
      TMP(2) = ABS(A(2))
      CALL RNDOUT(TMP,.FALSE.,.TRUE.)
!
      INTABS = MAX (TMP(1), TMP(2))
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      LOGICAL FUNCTION IRLEI (A, B)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IRLEI sets its value to .TRUE. if double precision value A is in the
!  closure of the interval B. The value of IRLEI is set to .FALSE.
!  otherwise.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A, B(2)
!
!***********************************************************************
!
! Beginning of executable statements --
!
      IRLEI = (A .GE. B(1)) .AND. (A .LE. B(2))
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      LOGICAL FUNCTION IRLTI (A, B)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IRLEI sets its value to .TRUE. if double precision value A is in the
!  interior of the interval B. The value of IRLEI is set to .FALSE.
!  otherwise.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A, B(2)
!
!***********************************************************************
!
! Beginning of executable statements --
!
      IRLTI = (A .GT. B(1)) .AND. (A .LT. B(2))
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      DOUBLE PRECISION FUNCTION ISUP (A)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IINF returns the upper endpoint of the interval A.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2)
!
!***********************************************************************
!
! Beginning of executable statements --
!
      ISUP = A(2)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE IVL1 (R, RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IVL1 constructs an interval RESULT from the double precision variable
!  R.  This is done by using simulated directed roundings with RNDOUT.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION R, RESULT(2)
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  RNDOUT
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION T
!
!***********************************************************************
!
! Beginning of executable statements --
!
      T = R
      RESULT(1) = T
      RESULT(2) = T
      IF (T.NE.0D0) CALL RNDOUT (RESULT, .TRUE.,.TRUE.)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE IVL2 (R1, R2, RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!
!   Hong Jiang
!   Dept. of Math., Stat. and Computer Science
!   Marquette University
!   Milwaukee, WI 53233
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IVL2 constructs an interval RESULT, roughly equal to [R1,R2], from
!  the double precision variables R1 and R2.  This is done by using
!  simulated directed roundings with RNDOUT.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION R1, R2, RESULT(2)
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  RNDOUT
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION T(2)
      LOGICAL RNDUP, RNDDWN
!
!***********************************************************************
!
! Common block declarations --
!
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 15
      IERR = 0
!
      T(1) = R1
      T(2) = R2
      RESULT(1) = T(1)
      RESULT(2) = T(2)
!
      IF (RESULT(2).LT.RESULT(1)) THEN
         IERR = 1
         CALL ERRTST(RESULT)
      END IF
!
      RNDDWN = T(1).NE.0D0
      RNDUP = T(2).NE.0D0
      CALL RNDOUT (RESULT, RNDDWN, RNDUP)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE IVLABS (A, RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IVLABS returns a rigorous bound on the range of the absolute value
!  of the interval A.  The intrinsic function ABS is assumed to be
!  accurate to the same accuracy as the elementary operations.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2), RESULT(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TMP(2), TA(2)
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --
!
!  ABS
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  RNDOUT
!
!***********************************************************************
!
! Beginning of executable statements --
!
      TA(1) = A(1)
      TA(2) = A(2)

      TMP(1) = ABS(TA(1))
      TMP(2) = ABS(TA(2))

      IF (TMP(1).LE.TMP(2)) THEN
         RESULT(1) = TMP(1)
         RESULT(2) = TMP(2)
      ELSE
         RESULT(1) = TMP(2)
         RESULT(2) = TMP(1)
      END IF

      CALL RNDOUT(RESULT,.TRUE.,.TRUE.)

      IF ( ( TA(1).LE.0 .AND. TA(2).GE.0 ) .OR. RESULT(1).LT. 0)        &
     &   RESULT(1) = 0D0

      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE IVLI (A, RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   January 8, 1993
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IVLI places the contents of interval A in RESULT.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2), RESULT(2)
!
!***********************************************************************
!
! Beginning of executable statements --
!
      RESULT(1) = A(1)
      RESULT(2) = A(2)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      DOUBLE PRECISION FUNCTION IWID (A)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
! (Utility function)
!
!***********************************************************************
!
! Function --
!
!  IWID returns the width of the interval A, rounded up.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION A(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TMP(2)
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  RNDOUT
!
!***********************************************************************
!
! Beginning of executable statements --
!
      TMP(2) = A(2)-A(1)
      CALL RNDOUT(TMP,.FALSE.,.TRUE.)
!
      IWID = TMP(2)
!
      RETURN
      END

!*** elemfuns.f
      SUBROUTINE IACOS (X,IRCCOS)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
!   By Chenyi Hu
!       and
!   Abdulhamid Awad
!
!   Computer and Mathematical Sciences Department
!   University of Houston-Downtown
!   Houston, TX 77002
!
!       and
!
!   R. Baker Kearfott
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   July 12, 1992
!
! Part of the interval elementary function library
!
!
!***********************************************************************
!
! Function --
!
!  This routine computes an interval enclosure for the arccos over
!  the interval X and returns the result in the interval IRCCOS.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2), IRCCOS(2)
!
!***********************************************************************
!
! Common blocks --
!
        DOUBLE PRECISION MXULP, TTINY2, TOL0
        COMMON /MACH1/MXULP, TTINY2, TOL0
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  ERRTST, IASIN, SUB
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 8
      IERR = 0
!
      IF (X(2).LT.X(1)) THEN
         IERR = 1
         CALL ERRTST(X)
      END IF
!
      IF (X(2).GT.ONE(1)) THEN
         IERR = 9
         CALL ERRTST(X)
         IRCCOS(1) = NEGINF
         IRCCOS(2) = POSINF
         RETURN
      ELSE IF (X(1).LT.-ONE(1)+MXULP) THEN
         IERR = 10
         CALL ERRTST(X)
         IRCCOS(1) = NEGINF
         IRCCOS(2) = POSINF
         RETURN
      END IF
!
      CALL IASIN(X, IRCCOS)
!
      CALL SUB(PI2,IRCCOS,IRCCOS)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE IACOT(X,IRCCOT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   By Chenyi Hu
!       and
!   Abdulhamid Awad
!
!   Computer and Mathematical Sciences Department
!   University of Houston-Downtown
!   Houston, TX 77002
!
!       and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   June 16, 1992
!
! Part of the interval elementary function library
!
!***********************************************************************
!
! Function --
!
!   This program finds bounds on the value of ARCCOT(X) as X
!   ranges of the interval XX, and places the resulting interval
!   in IRCCOT.
!
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2), IRCCOT(2)
!
!***********************************************************************
!
! Common blocks--
!
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  IATAN, SUB
!
!***********************************************************************
!
! Beginning of executable statements --
!

      CALL IATAN(X, IRCCOT)
      CALL SUB(PI2,IRCCOT,IRCCOT)

      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE IASIN(XX,IRCSIN)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
!   By Chenyi Hu
!       and
!   Abdulhamid Awad
!
!   Computer and Mathematical Sciences Department
!   University of Houston-Downtown
!   Houston, TX 77002
!
!       and
!
!   R. Baker Kearfott
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   July 7, 1992
!
! Part of the interval elementary function library
!
!
!***********************************************************************
!
! Function --
!
!  This routine computes an interval enclosure for the arcsin over
!  the interval XX and returns the result in the interval IRCSIN.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION XX(2), IRCSIN(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION LB, UB
      DOUBLE PRECISION X(2), RSLT(2), TMP(2)
      LOGICAL OVER, NEGATV, FLIP
!
!***********************************************************************
!
! Common blocks --
!
        DOUBLE PRECISION MXULP, TTINY2, TOL0
        COMMON /MACH1/MXULP, TTINY2, TOL0
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --  none
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  ASNSER, ERRTST, ISQRT, MULT, RNDOUT, SUB
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 9
      IERR = 0
!
      IF (XX(2).LT.XX(1)) THEN
         IERR = 1
         CALL ERRTST(XX)
      END IF
!
      IF (XX(2).GT.ONE(1)) THEN
         IERR = 9
         CALL ERRTST(XX)
         RETURN
      ELSE IF (XX(1).LT.-ONE(1)+MXULP) THEN
         IERR = 10
         CALL ERRTST(XX)
         RETURN
      END IF
!
      LB = XX(1)
      UB = XX(2)
!
! For the lower end point ---
!----------------------------------------------------------------------
!
!  If LB < 0, convert it to positive --

      IF (LB .LT. ZERO(1)) THEN
         OVER = .TRUE.
         NEGATV = .TRUE.
         TMP(2) = -LB
         CALL RNDOUT(TMP,.FALSE.,.TRUE.)
         LB = TMP(2)
      ELSE
         OVER = .FALSE.
         NEGATV =.FALSE.
      ENDIF
!
!  Transform LB to a small interval X such that 0 <= X <= 0.5 --
!
      X(1) = LB
      X(2) = LB
      IF (NEGATV) CALL RNDOUT(X,.TRUE.,.TRUE.)
!
      IF (LB .LE. OD2F(2) ) THEN
         FLIP = .FALSE.
      ELSE
         FLIP = .TRUE.
!
!   X <-- SQRT( (1 - X)/2 )
!
         CALL SUB(ONE,X,X)
         CALL MULT(OD2F,X,X)
         IF(X(1).LT.0D0) THEN
            X(1)=0D0
         END IF
         CALL ISQRT(X,X)
      ENDIF
!
!  Find a bound on the arcsin at the lower end point --
!
        CALL ASNSER (X, OVER, RSLT)
!
!  Undo the argument transformation, if it was applied --
!
      IF (FLIP) THEN
         CALL MULT(TWO,RSLT,RSLT)
         CALL SUB(PI2,RSLT,RSLT)
      END IF

      IF (NEGATV) THEN
         IRCSIN(1) = -RSLT(2)
         CALL RNDOUT(IRCSIN,.TRUE.,.FALSE.)
      ELSE
         IRCSIN(1) = RSLT(1)
      ENDIF
!
! For the upper end point ---
!----------------------------------------------------------------------
!
      IF (UB .LT. 0D0) THEN
         OVER =.FALSE.
         NEGATV = .TRUE.
         TMP(2) = -UB
         CALL RNDOUT(TMP,.FALSE.,.TRUE.)
         UB = TMP(2)
      ELSE
         OVER = .TRUE.
         NEGATV = .FALSE.
      ENDIF
!
      X(1) = UB
      X(2) = UB
      IF (NEGATV) CALL RNDOUT(X,.TRUE.,.TRUE.)
!
      IF (UB .LE. OD2F(2) ) THEN
         FLIP = .FALSE.
      ELSE
         FLIP = .TRUE.
!
!   X <-- SQRT( (1 - X)/2 )
!
         CALL SUB(ONE,X,X)
         CALL MULT(OD2F,X,X)
         IF(X(1).LT.0D0) THEN
            X(1)=0D0
         END IF
         CALL ISQRT(X,X)
      ENDIF
!
      CALL ASNSER(X, OVER, RSLT)
!
      IF (FLIP) THEN
         CALL MULT(TWO,RSLT,RSLT)
         CALL SUB(PI2,RSLT,RSLT)
      END IF

      IF (NEGATV) THEN
         IRCSIN(2) = -RSLT(1)
         CALL RNDOUT(IRCSIN,.FALSE.,.TRUE.)
      ELSE
         IRCSIN(2) = RSLT(2)
      ENDIF
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
!
      SUBROUTINE ASNSER (X, OVER, RSLT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
!   By Chenyi Hu
!       and
!   Abdulhamid Awad
!
!   Computer and Mathematical Sciences Department
!   University of Houston-Downtown
!   Houston, TX 77002
!
!       and
!
!   R. Baker Kearfott
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   July 7, 1992
!
! Part of the interval elementary function library
!
!
!***********************************************************************
!
! Function --
!
!  This routine computes an interval enclosure for the arcsin over
!  the interval X and returns the result in the interval RSLT.  It is
!  assumed that X is nearly a point, between 0 and .5.  This routine is
!  normally called from IASIN.  The argument OVER indicates whether
!  the upper end point or lower end point is important.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2)
      LOGICAL OVER
      DOUBLE PRECISION RSLT(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TEMP1(2), TEMP2(2), TEMP3(2), SUM(2)
      DOUBLE PRECISION T
      INTEGER I
      DOUBLE PRECISION D2IM1(2), D2I(2), D2IP1(2)
!
!***********************************************************************
!
! Common blocks --
!
      DOUBLE PRECISION MXULP, TTINY2, TOL0
      COMMON /MACH1/MXULP, TTINY2, TOL0
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --
!
!  ABS, DBLE, MAX
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  ADD, ERRTST, IDIV, MULT, RNDOUT
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 10
      IERR = 0
!
      SUM(1) = X(1)
      SUM(2) = X(2)
!
      TEMP1(1) = X(1) * X(1)
      TEMP1(2) = X(2) * X(2)
      CALL RNDOUT(TEMP1, .TRUE., .TRUE.)
!
      TEMP2(1) = X(1)
      TEMP2(2) = X(2)
!
      DO 10 I = 1,100
!
         D2IM1(1) = DBLE(2*I-1)
         D2IM1(2) = D2IM1(1)
         CALL RNDOUT(D2IM1,.TRUE.,.TRUE.)
         D2I(1) = DBLE(2*I)
         D2I(2) = D2I(1)
         CALL RNDOUT(D2I,.TRUE.,.TRUE.)
         D2IP1(1) = DBLE(2*I+1)
         D2IP1(2) = D2IP1(1)
         CALL RNDOUT(D2IP1,.TRUE.,.TRUE.)
!
!  TEMP2 <-- (2i-1)TEMP1 TEMP2 / (2i)
!
         CALL MULT(D2IM1,TEMP2,TEMP2)
         CALL MULT(TEMP2,TEMP1,TEMP2)
         CALL IDIV(TEMP2,D2I,TEMP2)
!
         CALL IDIV(TEMP2,D2IP1,TEMP3)
!
         SUM(1) = SUM(1) + TEMP3(1)
         SUM(2) = SUM(2) + TEMP3(2)
         CALL RNDOUT(SUM,.TRUE.,.TRUE.)
         T = MAX( ABS(SUM(1)), TOL0 )
         IF (TEMP3(2)/T .LT. MXULP) GOTO 20
   10 END DO
         IERR=11
         CALL ERRTST(TEMP3)
         RETURN
   20 CONTINUE
!
      IF (OVER) THEN
         CALL MULT(TWO,TEMP3,TEMP3)
         CALL ADD(SUM,TEMP3,RSLT)
      ELSE
         RSLT(1) = SUM(1)
         RSLT(2) = SUM(2)
      ENDIF
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE IATAN(XX,IRCTAN)

!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   By Chenyi Hu
!       and
!   Abdulhamid Awad
!
!   Computer and Mathematical Sciences Department
!   University of Houston-Downtown
!   Houston, TX 77002
!
!       and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   June 16, 1992
!
! Part of the interval elementary function library
!
!***********************************************************************
!
! Function --
!
!   This program finds bounds on the value of ARCTAN(X) as X
!   ranges over the interval XX, and places the resulting interval
!   in IRCTAN.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION XX(2), IRCTAN(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION LB, UB, X(2), RSLT(2), TMP(2)
      INTEGER CODE
      LOGICAL EVEN, NEGATV, RLB, RUB
!
!***********************************************************************
!
! Common blocks--
!
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
      DOUBLE PRECISION MXULP, TTINY2, TOL0
      COMMON /MACH1/MXULP, TTINY2, TOL0
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  ADD, ATNRED, ATNSER, RNDOUT, SUB
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 11
      IERR = 0
!
      IF (XX(2).LT.XX(1)) THEN
         IERR = 1
         CALL ERRTST(XX)
      END IF
!
      LB = XX(1)
      UB = XX(2)
!
!  Find the logical value EVEN, used in subroutine ATNSER to determine
!  the number of terms to be computed in the series --
!
      IF (LB .GT. 1.0D0) THEN
         EVEN = .TRUE.
      ELSE IF (LB .GE. 0D0) THEN
         EVEN = .FALSE.
      ELSE IF (LB .GT. -1D0) THEN
         EVEN = .FALSE.
      ELSE
         EVEN = .TRUE.
      ENDIF
!
!  If LB < 0, convert it to positive and update even --

      IF (LB .LT. 0D0) THEN
         EVEN = .NOT. EVEN
         NEGATV = .TRUE.
         TMP(2) = -LB
         CALL RNDOUT(TMP,.FALSE.,.TRUE.)
         LB = TMP(2)
      ELSE
         NEGATV =.FALSE.
      ENDIF
!
!  Transform LB to an interval X such that 0 <= X < 1/sqrt(3).  Here, X
!  is a small interval containing the lower bound of the the interval
!  [LB,UB] after transformation --
!
      CALL ATNRED(LB, CODE, X)
!
!  Find the value of the arctangent for the interval X --
!
      CALL ATNSER(X, EVEN, RSLT)
!
!  Undo the transformation and store the result --
!
      IF (CODE .EQ. 11) THEN
      ELSE IF (CODE .EQ. 12 ) THEN
         CALL ADD(PI6,RSLT,RSLT)
      ELSE IF (CODE .EQ. 21 ) THEN
         CALL SUB(PI2,RSLT,RSLT)
      ELSE IF (CODE .EQ. 22 ) THEN
         CALL SUB(PI3,RSLT,RSLT)
      END IF
!
      IF (NEGATV) THEN
         IRCTAN(1) = -RSLT(2)
         RLB = .TRUE.
      ELSE
         IRCTAN(1) = RSLT(1)
         RLB = .FALSE.
      ENDIF
!
!  Similarly obtain an enclosure for the arctangent at the upper
!  end point --
!
      IF (UB .GT. 1.0D0) THEN
         EVEN = .FALSE.
      ELSE IF (UB .GE. 0D0) THEN
         EVEN = .TRUE.
      ELSE IF (UB .GT. -1D0) THEN
         EVEN = .TRUE.
      ELSE
         EVEN = .FALSE.
      ENDIF
!
      IF (UB .LT. 0D0) THEN
         EVEN = .NOT. EVEN
         NEGATV = .TRUE.
         TMP(2) = -UB
         CALL RNDOUT(TMP,.FALSE.,.TRUE.)
         UB = TMP(2)
      ELSE
         NEGATV = .FALSE.
      ENDIF
!
      CALL ATNRED(UB, CODE, X)
      CALL ATNSER(X, EVEN, RSLT)
!
      IF (CODE .EQ. 11) THEN
      ELSE IF (CODE .EQ. 12 ) THEN
         CALL ADD(PI6,RSLT,RSLT)
      ELSE IF (CODE .EQ. 21 ) THEN
         CALL SUB(PI2,RSLT,RSLT)
      ELSE IF (CODE .EQ. 22 ) THEN
         CALL SUB(PI3,RSLT,RSLT)
      END IF
!
      IF (NEGATV) THEN
         IRCTAN(2) = -RSLT(1)
         RUB = .TRUE.
      ELSE
         IRCTAN(2) = RSLT(2)
         RUB = .FALSE.
      ENDIF
!
      CALL RNDOUT(IRCTAN,RLB,RUB)
!
      RETURN
      END
!**********************************************************************
!**********************************************************************
      SUBROUTINE ATNRED(PP,CODE,X)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   By Chenyi Hu
!       and
!   Abdulhamid Awad
!
!   Computer and Mathematical Sciences Department
!   University of Houston-Downtown
!   Houston, TX 77002
!
!       and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   June 16, 1992
!
! Part of the interval elementary function library
!
!***********************************************************************
!
! Function --
!
!  This is an auxiliary routine for IATAN.  It performs an argument
!  reduction in preparation for computing a series approximation to the
!  arctangent function.
!
!  The subroutine transforms a given nonnegative number P to a
!  nonnegative number less than the reciprocal of the square root of 3,
!  then converts it to an interval.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION PP, X(2)
      INTEGER CODE
!
!***********************************************************************
!
! Argument descriptions -- (INPUT  = set on entry and not alterable)
!                          (OUTPUT = to be set by the routine)
!                          (I/O    = set on entry but alterable)
!
! PP     A floating point representation of an endpoint, to be reduced.
!        (INPUT)
!
! X      A small interval enclosure for the reduced quantity
!        corresponding to PP.
!        (OUTPUT)
!
! CODE   A flag indicating how the argument was reduced, as follows:
!
!          CODE = 11      no transformation
!          CODE = 12      1 / sqrt(3) < P < = 1
!          CODE = 21      P > 1 and 0 < 1/P < 1 / sqrt(3)
!          CODE = 22      P > 1 and 1/P >= 1 / sqrt(3)
!
!        (OUTPUT)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION P(2), TMP(2)
!
!***********************************************************************
!
! Common blocks --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  ADD, IDIV, MULT, SUB
!
!***********************************************************************
!
! Beginning of executable statements --
!
      P(1) = PP
      P(2) = PP
!
      IF (P(1) .LE. ODSQT3(1)) THEN
         CODE = 11
      ELSE IF (P(1) .LE. ONE(2)) THEN
!
!  P <-- (sqrt(3)P - 1)/(sqrt(3)+P):
!
         CALL MULT(P,SQT3,TMP)
         CALL SUB(TMP,ONE,TMP)
         CALL ADD(SQT3,P,P)
         CALL IDIV(TMP,P,P)
         CODE = 12
      ELSE
!
!  P <-- 1/P:
!
         CALL IDIV(ONE,P,P)
         IF (P(1) .LE. ODSQT3(1)) THEN
            CODE = 21
         ELSE
            CALL MULT(P,SQT3,TMP)
            CALL SUB(TMP,ONE,TMP)
            CALL ADD(SQT3,P,P)
            CALL IDIV(TMP,P,P)
            CODE = 22
         ENDIF
      ENDIF
!
      X(1) = P(1)
      X(2) = P(2)
!
      RETURN
      END
!**********************************************************************
!**********************************************************************
      SUBROUTINE ATNSER (X,EVEN,RSLT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   By Chenyi Hu
!       and
!   Abdulhamid Awad
!
!   Computer and Mathematical Sciences Department
!   University of Houston-Downtown
!   Houston, TX 77002
!
!       and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   June 16, 1992
!
! Part of the interval elementary function library
!
!***********************************************************************
!
! Function --
!
!  This subroutine computes an enclosure for arctan X and puts the
!  result in RSLT.  It is assumed that X is an interval of small width
!  between 0 and 1 / sqrt(3).  The argument EVEN is used to determine
!  whether an even or odd number of terms should be taken.  This routine
!  is normally called from IATAN.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2), RSLT(2)
      LOGICAL EVEN
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TEMP1(2), TEMP2(2), TEMP3(2), SUM(2), XS(2)
      DOUBLE PRECISION DI(2), T
      INTEGER I, SIGN
!
!***********************************************************************
!
! Common blocks --
!
      DOUBLE PRECISION MXULP, TTINY2, TOL0
      COMMON /MACH1/ MXULP, TTINY2, TOL0
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --
!
!  DBLE
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  ADD, IDIV, MULT, POWER, RNDOUT
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 12
      IERR = 0
!
      IF (X(1).LT.0D0) THEN
         IERR=12
         CALL ERRTST(X)
         RETURN
      END IF
!
      CALL POWER(X,2,XS)
!
      IF ((X(1) .EQ. 0D0) .AND. (X(2) .EQ. 0D0)) THEN
         RSLT(1) = ZERO(1)
         RSLT(2) = ZERO(2)
         RETURN
      ENDIF
!
      SUM(1) = X(1)
      SUM(2) = X(2)
!
      SIGN = -1
      CALL POWER(X,3,TEMP1)
!
      DO 10 I = 1,10000
         SIGN = -SIGN
         CALL MULT(TWO,TEMP1,TEMP2)
         DI(1) = DBLE (4*I*I - 1)
         DI(2) = DI(1)
         CALL RNDOUT(DI,.TRUE.,.TRUE.)
         CALL IDIV(TEMP2,DI,TEMP2)
!
         IF (SIGN .GT. 0) THEN
            SUM(1) = SUM(1) + TEMP2(1)
            SUM(2) = SUM(2) + TEMP2(2)
         ELSE
            SUM(1) = SUM(1) - TEMP2(2)
            SUM(2) = SUM(2) - TEMP2(1)
         ENDIF
         CALL RNDOUT(SUM,.TRUE.,.TRUE.)
!
         TEMP1(1) = TEMP1(1) * XS(1)
         TEMP1(2) = TEMP1(2) * XS(2)
         CALL RNDOUT(TEMP1, .TRUE., .TRUE.)
!
         T = MAX( ABS(SUM(1)),2D0*TOL0 )
         IF (TEMP1(2)/T .GT. MXULP) GOTO 10
         IF (EVEN .AND. (SIGN .LT. 0)) GOTO 10
         IF (EVEN .OR. (SIGN .LE. 0)) GOTO 20
   10 END DO
         IERR=11
         CALL ERRTST(TEMP2)
         RETURN
   20 CONTINUE
!
      CALL ADD(XS,ONE,TEMP3)
      CALL IDIV(SUM,TEMP3,RSLT)
!
        RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE ICOS(X,RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Kaisheng Du
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
!
!
!***********************************************************************
!
! Function --
!
!  This routine returns the interval value of the cosine function
!  (evaluated over the interval X) in the interval variable
!  RESULT.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2), RESULT(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION V1(2), V2(2)
      DOUBLE PRECISION VAL1(2),VAL2(2)
      DOUBLE PRECISION TMP(2), T1, T2
!
      INTEGER N1, N2
!
      LOGICAL EVEN
!
!***********************************************************************
!
! Common blocks --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --
!
!     ABS, ERRTST, IDINT, MAX, MIN, MOD
!
!***********************************************************************
!
! Package-supplied functions and subroutines -- none
!
!     EXTERNAL ERRTST, MULT, RCOS, RNDOUT
!
!***********************************************************************
!
! User-supplied functions and subroutines -- none
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 2
      IERR = 0
!
      IF (X(2).LT.X(1)) THEN
         IERR = 1
         CALL ERRTST(X)
      END IF
!
!  Compute the value at the left endpoint using interval arithmetic --
!
      V1(1) = X(1)
      V1(2) = X(1)
!
!  If X1/PI is out of range, return the interval [-1,1] --
!
      CALL MULT(V1,A,TMP)
      T1 =ABS(TMP(1))
      IF(T1.GE.MAXX) THEN
         IERR = 5
         CALL ERRTST(X)
         RESULT(1) = -1D0
         RESULT(2) =  1D0
         RETURN
      ENDIF
!
!  Compute the value at the right endpoint using interval arithmetic --
!
      V2(1) = X(2)
      V2(2) = X(2)
      CALL RNDOUT(V2,.TRUE.,.TRUE.)
!
!  If X2/pi is out of range, return the interval [-1,1] --
!
      CALL MULT(V2,A,TMP)
      T2 = ABS(TMP(2))
      IF(T2.GE.MAXX) THEN
         IERR = 5
         CALL ERRTST(X)
         RESULT(1) = -1D0
         RESULT(2) =  1D0
         RETURN
      ENDIF
!
!  If both X1/pi and X2/pi are within range, calculate the function
!  values at the left and right endpoints using interval arithmetic --
!
      CALL RCOS(V1,VAL1)
!
      CALL RCOS(V2,VAL2)
!
!  Calculate the number of half-periods from zero for the left
!  and right endpoints in order to normalize to [-pi/2,pi/2] --
!
      N1 = IDINT(T1)
      N2 = IDINT(T2)
      IF(V1(1).LT.0D0) N1 = -N1-1
      IF(V2(2).LT.0D0) N2 = -N2-1
!
!   In even half periods, the function is decreasing --
!
      EVEN = MOD(N1,2).EQ.0
!
!   If X1 and X2 are in the same half period, then the lower bound
!   and upper bound on the range occur at the endpoints --
!
      IF(N1.EQ.N2) THEN
         RESULT(1) = MIN(VAL1(1),VAL2(1))
         RESULT(2) = MAX(VAL1(2),VAL2(2))
         RETURN
      ENDIF
!
!   Consider the case X2 is in the half period adjacent to X1 --
!
      IF(N2.EQ.N1+1) THEN
!
!    If X1 is in the increasing half period, then the upper bound should
!    equal 1;  otherwise, the lower bound should be -1 --
!
         IF(EVEN) THEN
            RESULT(1) = -1.D0
            RESULT(2) = MAX(VAL1(2),VAL2(2))
         ELSE
           RESULT(1) = MIN(VAL1(1),VAL2(1))
           RESULT(2) = 1.D0
         ENDIF
!
!   If X1 and X2 are not in adjecent half periods, then the lower
!   bound should be -1 and the upper bound should be 1 --
!
      ELSE
         RESULT(1) = -1.D0
         RESULT(2) =  1.D0
      ENDIF
!
      CALL RNDOUT(RESULT,.TRUE.,.TRUE.)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE IEXP(X,RESULT)
!
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Kaisheng Du
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
!
!***********************************************************************
!
! Function --
!
!  This routine returns the interval exp(X) in RESULT.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2), RESULT(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TEMP(2), TVAL(2), T
!
!***********************************************************************
!
! Common block declarations --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Fortran-supplied functions --
!
!     ABS
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
      EXTERNAL ERRTST, REXP
      DOUBLE PRECISION D1MACH
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 1
      IERR = 0
!
      IF (X(2).LT.X(1)) THEN
         IERR = 1
         CALL ERRTST(X)
      END IF
!
      IF (X(1).EQ.ZERO(1)) THEN
         RESULT(1) =ONE(1)
      ELSE
         T = ABS(X(1))
         IF (T.GT.MXLGM1) THEN
            IF(X(1).GT.ZERO(1))THEN
               IERR = 3
            ELSE
               IERR = 2
            END IF
            CALL ERRTST(X)
         END IF
         IF (IERR.EQ.2) THEN
            RESULT(1) = ZERO(1)
         ELSE IF (IERR.EQ.3) THEN
            RESULT(1) = POSINF
            RESULT(2) = POSINF
            RETURN
         ELSE
            TEMP(1) = X(1)
            TEMP(2) = X(1)
            CALL REXP(TEMP,TVAL)
            RESULT(1) = TVAL(1)
         END IF
      END IF
!
      IF (X(2).EQ.ZERO(2)) THEN
         RESULT(2) =ONE(2)
      ELSE
         IF (X(2).GT.MXLGM1) THEN
            IERR = 4
            CALL ERRTST(X)
         END IF
         IF (IERR.EQ.4) THEN
            RESULT(2) = D1MACH(2)
            RETURN
         ELSE
            TEMP(1) = X(2)
            TEMP(2) = X(2)
            CALL REXP(TEMP,TVAL)
            RESULT(2) = TVAL(2)
         END IF
      END IF
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE IIPOWR(XX, YY, RESULT)
!
!  Kaisheng Du and R. B. Kearfott, Summer, 1991
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Kaisheng Du
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
!
!**********************************************************************
!
! Function --
!
!  This routine returns the interval X**Y, provided that X is a
!  positive interval.
!  RESULT.
!
!**********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION XX(2), YY(2), RESULT(2)
!
!**********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION X(2), Y(2)
      LOGICAL LBZERO

!**********************************************************************
!
! Common blocks --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!***********************************************************************
!
! Fortran-supplied functions and subroutines --
!
!   ABS, MAX
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!   ERRTST, IEXP, ILOG, MULT
!
!**********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 14
      IERR = 0
!
      X(1) = XX(1)
      X(2) = XX(2)
      Y(1) = YY(1)
      Y(2) = YY(2)
!
      IF (X(2).LT.X(1)) THEN
         IERR = 1
         CALL ERRTST(X)
      END IF
!
      LBZERO = .FALSE.
      IF (X(1).EQ.0D0) THEN
         IF (Y(1).LT.0D0) THEN
            IF(Y(2).GE.0D0) THEN
               IERR = 14
               RESULT(1) = NEGINF
               RESULT(2) = POSINF
               RETURN
            END IF
         END IF
         LBZERO = .TRUE.
         X(1) = X(2)
      END IF

      IF (X(1).LE.ZERO(2)) THEN
         IERR = 7
         CALL ERRTST(X)
         RETURN
      END IF
!
      CALL ILOG(X,RESULT)
!
      CALL MULT(RESULT,Y,RESULT)
!
      IF (ABS(RESULT(1)).GT.MXLGM1) THEN
         IF(RESULT(1).GT.ZERO(1)) THEN
            IERR = 3
         ELSE
            IERR = 2
         END IF
         CALL ERRTST(RESULT)
      END IF
      IF (RESULT(2).GT.MXLGM1) THEN
         IERR = 4
         CALL ERRTST(RESULT)
      END IF
!
      CALL IEXP(RESULT,RESULT)
      IF(LBZERO) THEN
         IF (Y(1).LT.0D0) THEN
            RESULT(2) = POSINF
            IERR = 15
         ELSE
            RESULT(1) = 0D0
         END IF
      END IF
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE ILOG(X,RESULT)
!
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Kaisheng Du
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
!
!***********************************************************************
!
! Function --
!
!  This routine returns the interval log(X) in RESULT.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2), RESULT(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TEMP(2), TVAL(2)
!
!***********************************************************************
!
! Common block declarations --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!     ERRTST, RLOG
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 4
      IERR = 0
!
      IF (X(2).LT.X(1)) THEN
         IERR = 1
         CALL ERRTST(X)
      END IF
!
      IF (X(1).LE.ZERO(2)) THEN
         IERR = 7
         CALL ERRTST(X)
         RETURN
      END IF
!
      TEMP(1) = X(1)
      TEMP(2) = X(1)
      CALL RLOG(TEMP,TVAL)
      RESULT(1) = TVAL(1)
!
      TEMP(1) = X(2)
      TEMP(2) = X(2)
      CALL RLOG(TEMP,TVAL)
      RESULT(2) = TVAL(2)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE ISIN(X,RESULT)
!
!  Kaisheng Du and R. B. Kearfott, Summer, 1991
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Kaisheng Du
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
!
!**********************************************************************
!
! Function --
!
!  This routine returns the interval value of the sine function
!  (evaluated over the interval X) in the interval variable
!  RESULT.
!
!**********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2), RESULT(2)
!
!**********************************************************************
!
! Common blocks --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
!***********************************************************************
!
! Fortran supplied functions and subroutines --
!
!      ABS, MAX
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!      ICOS, MULT, POWER, SUB
!
!**********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TMP1(2), TMP2(2), TMP3(2)
      LOGICAL SMALL1, SMALL2
!
!**********************************************************************
!
!
! Beginning of executable statements --
!
!  Assure good relative accuracy near zero by the case separately;
!  otherwise, shift the argument and use the interval cosine function --
!
      SMALL1=.FALSE.
      SMALL2=.FALSE.
      IF ( MAX( ABS(X(1)), ABS(X(2)) ) .LT. PI2(1) ) THEN
         IF(ABS(X(1)).LT.CBTEP) THEN
            SMALL1 = .TRUE.
            TMP1(1) = X(1)
            TMP1(2) = X(1)
            IF (X(1).GT.ZERO(2)) THEN
               CALL POWER(TMP1,3,TMP2)
               CALL MULT(TMP2,OD3F,TMP2)
               CALL SUB(TMP1,TMP2,TMP1)
            END IF
         END IF
         IF(ABS(X(2)).LT.CBTEP) THEN
            SMALL2 = .TRUE.
            TMP3(1) = X(2)
            TMP3(2) = X(2)
            IF (X(2).LT.ZERO(1)) THEN
               CALL POWER(TMP3,3,TMP2)
               CALL MULT(TMP2,OD3F,TMP2)
               CALL SUB(TMP3,TMP2,TMP3)
            END IF
         END IF
      END IF
!
      IF (SMALL1 .AND. SMALL2) THEN
         RESULT(1) = TMP1(1)
         RESULT(2) = TMP3(2)
         RETURN
      ELSE
         CALL SUB(X,PI2,RESULT)
         CALL ICOS(RESULT,RESULT)
      END IF
!
      IF (SMALL1) RESULT(1) = MAX(TMP1(1),RESULT(1))
      IF (SMALL2) RESULT(2) = MIN(TMP3(2),RESULT(2))
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE ISINH(XX,RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   Chenyi Hu
!
!   Computer and Mathematical Sciences Department
!   University of Houston-Downtown
!   Houston, TX 77002
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   October 20, 1992
!
! Part of the interval elementary function library
!
!***********************************************************************
!
! Function --
!
!  This routine returns an interval inclusion for the hyperbolic sine
!  over the interval XX in RESULT.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION XX(2), RESULT(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION AA, BB, X(2), RSLT(2)
      DOUBLE PRECISION TMP(2), TMP2(2)
      INTEGER CODE
      LOGICAL OVER, NEGATV
!
!***********************************************************************
!
! Common blocks --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
      DOUBLE PRECISION MXULP, TTINY2, TOL0
      COMMON /MACH1/MXULP, TTINY2, TOL0
!
!***********************************************************************
!
! Package-supplied functions and subroutines --

!  ERRTST, IDIV, IEXP, ISHSER, ISNRED, ISNVAL, MULT, RNDOUT, SUB
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 6
      IERR = 0
!
      IF (XX(2).LT.XX(1)) THEN
         IERR = 1
         CALL ERRTST(XX)
      END IF
!
      AA = XX(1)
      BB = XX(2)
!
!-------------------------------------------------------------------
!  Compute the value of the hyperbolic sine at the lower endpoint A.
!-------------------------------------------------------------------
!
      IF (AA .LT. ZERO(1)) THEN
         OVER = .TRUE.
         NEGATV = .TRUE.
         TMP(2) = -AA
         CALL RNDOUT(TMP,.FALSE.,.TRUE.)
         AA = TMP(2)
      ELSE
         OVER = .FALSE.
         NEGATV =.FALSE.
      ENDIF
!
!  Transform AA to an interval X such that 0 <= X <= 1 --
!
      CALL ISNRED(AA, CODE, X)
!
      IF (CODE .EQ. 20) THEN
!
!  Use the exponential function for arguments larger than 27 --
!
         CALL IEXP(X, TMP)
         CALL IDIV(ONE,TMP,TMP2)
         CALL SUB(TMP,TMP2,TMP)
         CALL MULT(OD2F,TMP,RSLT)
      ELSE
!
!  Evaluate the series X + X^3/3! + X^5/5! + ... for 0 <= X <= 1 --
!
         CALL ISHSER(X, OVER, RSLT)
         CALL ISNVAL(CODE, RSLT)
       END IF
!
!  Undo the possible argument reduction from ISNRED --
!
      IF (NEGATV) THEN
         RESULT(1) = - RSLT(2)
         CALL RNDOUT(RESULT,.TRUE.,.FALSE.)
      ELSE
         RESULT(1) = RSLT(1)
      ENDIF
!
!-------------------------------------------------------------------
!  Compute the value of the hyperbolic sine at the upper endpoint B
!  (completely analogous to computation for the lower endpoint A).
!-------------------------------------------------------------------
!
      IF (BB .LT. ZERO(1)) THEN
         OVER =.FALSE.
         NEGATV = .TRUE.
         TMP(2) = -BB
         CALL RNDOUT(TMP,.FALSE.,.TRUE.)
         BB = TMP(2)
      ELSE
         OVER = .TRUE.
         NEGATV = .FALSE.
      ENDIF
!
      CALL ISNRED(BB, CODE, X)
!
      IF (CODE .EQ. 20) THEN
         CALL IEXP(X, TMP)
         CALL IDIV(ONE,TMP,TMP2)
         CALL SUB(TMP,TMP2,TMP)
         CALL MULT(OD2F,TMP,RSLT)
      ELSE
         CALL ISHSER(X, OVER, RSLT)
         CALL ISNVAL(CODE, RSLT)
      END IF
!
      IF (NEGATV) THEN
         RESULT(2) = - RSLT(1)
         CALL RNDOUT(RESULT,.FALSE.,.TRUE.)
      ELSE
         RESULT(2) = RSLT(2)
      ENDIF
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE ISNRED(P,CODE,X)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   Chenyi Hu
!
!   Computer and Mathematical Sciences Department
!   University of Houston-Downtown
!   Houston, TX 77002
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   October 20, 1992
!
! Part of the interval elementary function library
!
!***********************************************************************
!
! Function --
!
!  This subroutine transforms the nonnegative number P to a nonnegative
!  number which less than 1, and then converts the result to an
!  interval.  The following code numbers are set to record how the
!  transformation was done:
!
!     CODE = 11      0 < P < =  1
!     CODE = 12      1 < P < =  3
!     CODE = 13      3 < P < =  9
!     CODE = 14      9 < P < = 27
!     CODE = 20          P >   27
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION P
      INTEGER CODE
      DOUBLE PRECISION X(2)
!
!***********************************************************************
!
! Common blocks --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
!***********************************************************************
!
! Beginning of executable statements --
!
      X(1) = P
      X(2) = P
!
      IF (P .LE. ONE(1) ) THEN
         CODE = 11
         GO TO 10
      ELSE IF (P .LE. THREE(1)) THEN
         CALL MULT(X,THIRD,X)
         CODE = 12
         GO TO 10
      ELSE IF (P .LE. NINE(1)) THEN
         CALL MULT(X,NINTH,X)
         CODE = 13
         GO TO 10
      ELSE IF (P .LE. TWOT7(1)) THEN
         CALL MULT(X,TT7TH,X)
         CODE = 14
         GO TO 10
      ELSE
         CODE = 20
         GO TO 10
      ENDIF
!
   10 CALL RNDOUT(X, .TRUE., .TRUE.)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
        SUBROUTINE ISHSER (X, OVER, RSLT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   Chenyi Hu
!
!   Computer and Mathematical Sciences Department
!   University of Houston-Downtown
!   Houston, TX 77002
!
!         and
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   October 20, 1992
!
! Part of the interval elementary function library
!
!***********************************************************************
!
! Function --
!
!   This subroutine uses a series to bound the value of the hyperbolic
!   sine function over the nonnegative interval X of small width.  The
!   result is returned in RSLT.  The logical variable OVER indicates
!   whether negation was applied during the argument reduction.  This
!   routine is not meant to be called by the user.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2)
      LOGICAL OVER
      DOUBLE PRECISION RSLT(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TEMP1(2), TEMP2(2), SUM(2), ERR(2), T
      INTEGER I
!
!***********************************************************************
!
! Common blocks --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      DOUBLE PRECISION MXULP, TTINY2, TOL0
      COMMON /MACH1/ MXULP, TTINY2, TOL0
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --
!
!  ABS, DBLE, FLOAT, MAX
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  MULT, POWER, RNDOUT
!
!***********************************************************************
!
! Beginning of executable statements --
!
      SUM(1) = X(1)
      SUM(2) = X(2)

      I = 1
!
!  Use temp1 to hold X^2 --
!
      CALL POWER(X,2,TEMP1)

      TEMP2(1) = X(1)
      TEMP2(2) = X(2)
!
   10 CONTINUE
      I = I + 2
         TEMP2(1) = TEMP1(1) * TEMP2(1)
         TEMP2(2) = TEMP1(2) * TEMP2(2)
         CALL RNDOUT(TEMP2, .TRUE., .TRUE.)
!
         TEMP2(1) = TEMP2(1)/DBLE(FLOAT(I))
         TEMP2(2) = TEMP2(2)/DBLE(FLOAT(I))
         CALL RNDOUT(TEMP2, .TRUE., .TRUE.)
!
         TEMP2(1) = TEMP2(1)/DBLE(FLOAT(I-1))
         TEMP2(2) = TEMP2(2)/DBLE(FLOAT(I-1))
         CALL RNDOUT(TEMP2, .TRUE., .TRUE.)
!
         SUM(1) = SUM(1) + TEMP2(1)
         SUM(2) = SUM(2) + TEMP2(2)
         CALL RNDOUT(SUM,.TRUE.,.TRUE.)
!
         CALL MULT(TWO,TEMP2,ERR)
         T = MAX(ABS(SUM(1)),ABS(SUM(2)),2D0*TOL0)
         IF ((ERR(1)/T) .GT. MXULP) GOTO 10
!
      IF (OVER) THEN
         RSLT(1) = SUM(1) + ERR(1)
         RSLT(2) = SUM(2) + ERR(2)
         CALL RNDOUT(RSLT, .TRUE., .TRUE.)
      ELSE
         RSLT(1) = SUM(1)
         RSLT(2) = SUM(2)
      ENDIF
!
      RETURN
      END

! **********************************************************
      SUBROUTINE ISNVAL (CODE,RSLT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Chenyi Hu
!
!   Computer and Mathematical Sciences Department
!   University of Houston-Downtown
!   Houston, TX 77002
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   October 20, 1992
!
! Part of the interval elementary function library
!
!***********************************************************************
!
! Function --
!
!   This routine transforms the result from the reduced argument
!   computation for the arcsine function back to the value corresponding
!   to the original argument.  The type of argument reduction which was
!   applied is given in the integer variable CODE.  Both the reduced
!   value input to this routine and the final value output from this
!   routine are stored in RSLT.
!
!***********************************************************************
!
! Argument declarations --
!
      INTEGER CODE
      DOUBLE PRECISION RSLT(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TEMP(2)
!
!***********************************************************************
!
! Common blocks --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  ADD, MULT, RNDOUT
!
!
!***********************************************************************
!
! Beginning of executable statements --
!
      IF (CODE .EQ. 11) RETURN
!
   20 CONTINUE
      TEMP(1) = RSLT(1) * RSLT(1)
      TEMP(2) = RSLT(2) * RSLT(2)
      CALL RNDOUT(TEMP, .TRUE., .TRUE.)
!
!  rslt <-- rslt * (3 + 4 rslt^2)
!
      CALL MULT(FOUR,TEMP,TEMP)
      CALL ADD(THREE,TEMP,TEMP)
      CALL MULT(RSLT,TEMP,RSLT)
!
      IF (CODE .EQ. 12) THEN
         RETURN
      ELSE IF (CODE .EQ. 13) THEN
         CODE = 12
         GO TO 20
      ELSE IF (CODE .EQ. 14) THEN
         CODE = 13
         GO TO 20
      ENDIF
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE ISQRT(X,RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Kaisheng Du
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
!
!***********************************************************************
!
! Function --
!
!  This subroutine returns the interval value of the square root of X
!  in RESULT.  It uses the routine RSQRT to get rigorous values at the
!  endpoints.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2), RESULT(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION V(2), RL(2), RR(2)
!
!***********************************************************************
!
!  Common block declarations --
!
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Package-supplied functions and subroutines --

!     ERRTST, RSQRT
!
!***********************************************************************
!
! Beginning of executable statements --
!
!  Identifying code for this routine --
!
      IROUT = 5
      IERR = 0
!
      IF (X(2).LT.X(1)) THEN
         IERR = 1
         CALL ERRTST(X)
      END IF
!
      IF (X(1).LT.0D0) THEN
         IERR = 7
         CALL ERRTST(X)
         RETURN
      ELSE IF (X(1).EQ.0D0) THEN
         RL(1) = 0D0
         RL(2) = 0D0
      ELSE
         V(1) = X(1)
         V(2) = X(1)
         CALL RSQRT(V,RL)
      END IF
!
      IF (X(2).EQ.0D0) THEN
         RR(1) = 0D0
         RR(2) = 0D0
      ELSE
         V(1) = X(2)
         V(2) = X(2)
         CALL RSQRT(V,RR)
      END IF
!
      RESULT(1) = RL(1)
      RESULT(2) = RR(2)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE POWER(AA,NDUM,RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Manuel Novoa III
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   September 29, 1987
!
! Part of the generalized bisection package
! (interval arithmetic subpackage).
!
!   Modified by Manuel Novoa III on March 13, 1990 to fix a bug which
!   caused overestimation for N odd and zero in the interval's interior.
!
!   Modified August, 1991 and April, 1992 by Kaisheng Du and
!   R. Baker Kearfott to allow computation of negative integer powers.
!
!***********************************************************************
!
! Called by --
!
!  Any routine requiring computation of a positive integer power of
!  an interval.
!
!***********************************************************************
!
! Function --
!
!  This routine computes the NDUM-th power, of the interval A, where
!  NDUM is an integer.  It simulates directed roundings with the routine
!  RNDOUT; the interval result should contain the interval which would
!  have been obtained with exact interval arithmetic.  However, in
!  general it will not be the smallest possible machine-representable
!  such containing interval.  See the documentation in subroutine RNDOUT
!  for more detailed information.
!
!  This routine can clearly be made more efficient and more readable on
!  Fortran systems for which the intrinsic represented by A**N is
!  optimally accurate.  See the documentation in the subsidiary routine
!  RRPOWR for more information.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION AA(2), RESULT(2)
      INTEGER NDUM
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION B(2), TMP(2)
      LOGICAL EVEN ,L
      DOUBLE PRECISION TEMP
      INTEGER N
!
!***********************************************************************
!
! Common block declarations --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --
!
!    MAX, MOD
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!    ERRTST, MULT, RNDOUT, RRPOWR
!
!***********************************************************************
!
! Beginning of executable statements --
!
!
!  Identifying code for this routine --
!
      IROUT = 7
      IERR = 0
!
      IF (AA(2).LT.AA(1)) THEN
         IERR = 1
         CALL ERRTST(AA)
      END IF
!
!  If N is equal to 0 then return the point interval [1,1] --
!
      N = NDUM
!
      IF (N.EQ.0) THEN
         RESULT(1) = ONE(1)
         RESULT(2) = ONE(2)
         RETURN
      END IF
!
!     If N = 1 then return AA.
!
      IF (N.EQ.1) THEN
         RESULT(1) = AA(1)
         RESULT(2) = AA(2)
         RETURN
      END IF
!
!  If N < 0, let N = -N.
!
      L = (N.LT.0)
      IF(L) THEN
         IF (AA(1).LT.ZERO(1) .AND. AA(2).GT.ZERO(2)) THEN
            IERR=8
            CALL ERRTST(AA)
            RESULT(1) = NEGINF
            RESULT(2) = POSINF
            RETURN
         END IF
         N = -N
      END IF
!
!  If N > 1, check cases for 0 in or not in the interval --
!
      EVEN = (MOD(N,2).EQ.0)
!
      IF (AA(1).GT.ZERO(2)) THEN
         CALL RRPOWR(AA(1),N,TMP)
         B(1) = TMP(1)
         CALL RRPOWR(AA(2),N,TMP)
         B(2) = TMP(2)
      ELSE IF (AA(2).LT.ZERO(1)) THEN
         IF (EVEN) THEN
            CALL RRPOWR(AA(2),N,TMP)
            B(1) = TMP(1)
            CALL RRPOWR(AA(1),N,TMP)
            B(2) = TMP(2)
         ELSE
            CALL RRPOWR(AA(1),N,TMP)
            B(1) = TMP(1)
            CALL RRPOWR(AA(2),N,TMP)
            B(2) = TMP(2)
         END IF
      ELSE IF (EVEN) THEN
         B(1) = ZERO(1)
         TMP(2) = -AA(1)
         CALL RNDOUT(TMP,.FALSE.,.TRUE.)
         TEMP = MAX(TMP(2),AA(2))
         CALL RRPOWR(TEMP,N,TMP)
         B(2) = TMP(2)
      ELSE
         CALL RRPOWR(AA(1),N,TMP)
         B(1) = TMP(1)
         CALL RRPOWR(AA(2),N,TMP)
         B(2) = TMP(2)
      END IF
!
      IF (L) THEN
         IF(B(1).GT.0D0)  THEN
            TEMP = B(1)
            B(1) = ONE(1)/B(2)
            B(2) = ONE(2)/TEMP
            CALL RNDOUT(B,.TRUE.,.TRUE.)
         ELSE
            TEMP = B(1)
            B(1) = ONE(2)/B(2)
            B(2) = ONE(1)/TEMP
            CALL RNDOUT(B,.TRUE.,.TRUE.)
         END IF
      END IF
!
      RESULT(1) = B(1)
      RESULT(2) = B(2)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE RRPOWR(AA,NDUM,RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   November 14, 1992
!
! Part of the generalized bisection package
! (interval arithmetic subpackage).
!
!***********************************************************************
!
! Called by --
!
!  POWER
!
!***********************************************************************
!
! Function --
!
!  This routine computes the NDUM-th power, of the interval point AA,
!  using simulated directed roundings to rigorously bound the roundoff
!  error.  The results is placed in RESULT.  The reason for this routine
!  is to allow rigor on machines on which exponentiation by an integer
!  is not accurate to within one digit in the last place.  The POWER
!  routine can certainly be made more efficient without this routine
!  if the Fortran intrinsic A**NDUM is optimally accurate.  This routine
!  can also be made more efficient by rewriting it in Fortran 90, and
!  making good use of recursion.  (See ``Programmer's Guide to Fortran
!  90, W. S. Brainerd, C. H. Goldberg, J. C. Adams, McGraw Hill, 1990
!  p. 222 ff.)
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION AA, RESULT(2)
      INTEGER NDUM
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION X(2)
      INTEGER I
!
!***********************************************************************
!
! Beginning of executable statements --
!
      X(1) = AA
      X(2) = AA
!
      RESULT(1) = X(1)
      RESULT(2) = X(2)
      IF (NDUM.EQ.1) RETURN
!
      DO 10 I = 2,NDUM,1
         CALL MULT(RESULT,X,RESULT)
   10 END DO
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE RCOS(XA,VAL)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Kaisheng Du
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
!
!***********************************************************************
!
! Function --
!
!  This routine is used to compute one of the endpoints of the
!  cosine of the interval X.  It is assumed that X is an interval of
!  very small width.  In particular, it is assumed that the length of
!  the interval is at most pi/16.  It is also assumed that the
!  absolute value of the argument is no greater than MAXX / pi,
!  where MAXX is the largest representable integer in the machine.
!  Since this routine doesn't check these conditions, it is assumed
!  that the calling routine has done so.
!
!  This routine is usually called by ISIN, which returns interval
!  values of the sin for general interval arguments.
!
!  This routine translates the interval to [0,pi/8], and possibly
!  uses a double angle formula twice.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION XA(2), VAL(2)
!
!***********************************************************************
!
! Argument descriptions -- (INPUT  = set on entry and not alterable)
!                          (OUTPUT = to be set by the routine)
!                          (I/O    = set on entry but alterable)
!
!  XA    is the interval argument
!       (INPUT)
!
!  VAL   is the resulting interval cosine value
!        (OUTPUT)
!
!***********************************************************************
!
! Internal variable declarations --
!
      LOGICAL L2
      INTEGER N
      DOUBLE PRECISION  DN, ERTRM(2), TEM(2), TMP, V(2), VALT(2),       &
     &                  VSQ(2), X(2)
!
!***********************************************************************
!
! Common blocks --
!
      DOUBLE PRECISION MXULP, TOL0, TTINY2
      COMMON /MACH1/ MXULP, TTINY2, TOL0
!
!  The above common block holds machine parameters which are set in
!  SIMINI and used here.
!
!  Variable descriptions
!
!  MXULP       (machine epsilon)
!                * (maximum error in ULP's of the floating pt. op's)
!
!  TTINY2      2 * (smallest representable positive machine number)
!                * (maximum error in ULP's of the floating pt. op's)
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines
!
!     DBLE, MOD, NINT
!
!***********************************************************************
!
! Package-supplied functions and subroutines
!
!     ADD, MULT, POWER, RNDOUT, SCLMLT, SUB
!
!***********************************************************************
!
! Beginning of executable statements --
!
      X(1) = XA(1)
      X(2) = XA(2)
      IF (X(2).LT.0D0) THEN
         TMP = X(2)
         X(2) = -X(1)
         X(1) = -TMP
      END IF
!
!  Reduce the angle to between 0 and pi using translation by a
!  multiple of pi/2, making sure that the resulting interval is either
!  entirely positive or entirely negative.
!
      CALL MULT (X,A,TEM)
      N = NINT((TEM(1)+TEM(2))/2D0)
      DN = DBLE(N)
!
      CALL SCLMLT (DN,PI,V)
      CALL SUB (X,V,V)
!
      IF (V(2).LT.0D0) THEN
         TMP = V(2)
         V(2) = -V(1)
         V(1) = -TMP
         CALL RNDOUT(V,.TRUE.,.TRUE.)
      END IF
!
!  Further reduce the angle to between 0 and pi/8, using angle halving.
!
      L2 = V(2) .GE. PI8(1)
      IF (L2) THEN
         V(1) = V(1)/4D0
         V(2) = V(2)/4D0
         CALL RNDOUT(V,.TRUE.,.TRUE.)
      END IF
!
!  Compute value of the cosine of the reduced angle.
!
      CALL POWER(V,2,VSQ)
!
!  val  = one + vsq * (-od2f + vsq * (od4f + vsq * (-od6f
!        + vsq * (od8f + vsq * (-od10f + vsq * od12f)))))
!
      CALL MULT (VSQ, OD12F, VAL)
      CALL SUB (VAL, OD10F, VAL)
      CALL MULT (VSQ, VAL, VAL)
      CALL ADD (OD8F, VAL, VAL)
      CALL MULT (VSQ, VAL, VAL)
      CALL SUB (VAL, OD6F, VAL)
      CALL MULT (VSQ,VAL, VAL)
      CALL ADD (OD4F, VAL, VAL)
      CALL MULT (VSQ, VAL, VAL)
      CALL SUB (VAL, OD2F, VAL)
      CALL MULT (VSQ, VAL, VAL)
      CALL ADD (ONE, VAL, VAL)
!
!  valt = - v **14 * od14f
!
      CALL POWER (V, 14, VALT)
      CALL MULT (VALT, OD14F, VALT)
      TMP = VALT(2)
      VALT(2) = -VALT(1)
      VALT(1) = -TMP
      CALL RNDOUT(VALT,.TRUE.,.FALSE.)

      ERTRM(1) = VALT(1)
      ERTRM(2) = 0D0
!
      CALL ADD (VAL,ERTRM,VAL)
!
!  Use double angle formulas to get back to original angle in
!  [0, pi/2]. ( val <-- 8val^4 - 8val^2 + 1 )
!
      IF (L2) THEN
         CALL POWER(VAL, 2, TEM)
         CALL SUB  (TEM, ONE, VAL)
         CALL MULT (VAL, TEM, VAL)
         CALL MULT (VAL, EIGHT, VAL)
         CALL ADD  (ONE, VAL, VAL)
      END IF
!
!  Change the sign of the result if the shift was by an odd multiple of
!  pi --
!
      IF (MOD(N,2).NE.0) THEN
         TMP = VAL(1)
         VAL(1) = -VAL(2)
         VAL(2) = -TMP
      END IF
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE REXP(X,VAL)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Kaisheng Du
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
!
!***********************************************************************
!
! Function --
!
!  This routine is used to compute the interval value exp(X).
!  It is assumed that the width of the interval X is small.
!
!  This routine is usually called by the routine IEXP,
!  to compute interval values of endpoints.
!
!  This routine translates the midpoint to [0,1/16], by first making
!  it positive,  then subtracting the integer part,  and finally
!  possibly dividing by 2 a number of times (To translate
!  back to the original interval, it then squares the result a number of
!  times, multiplies by e**N for some N, and possibly takes a
!  reciprocal.)
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2), VAL(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TMP(2)
      INTEGER N
      DOUBLE PRECISION ERTRM(2), G(2), VALT(2)
!
!***********************************************************************
!
! Common block declarations --
!
!
!  This common block holds machine parameters which are set in
!  SIMINI and used here.
!
!  Variable descriptions
!
!  MXULP       (machine epsilon)
!                * (maximum error in ULP's of the floating pt. op's)
!
!  TTINY2      2 * (smallest representable positive machine number)
!                * (maximum error in ULP's of the floating pt. op's)
!
!  TOL0        TTINY2 / MXULP
!
      DOUBLE PRECISION MXULP, TOL0, TTINY2
      COMMON /MACH1/ MXULP, TTINY2, TOL0
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --
!
!     DBLE, DMAX1, DMIN1, NINT
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!     ADD, MULT, POWER, RNDOUT, SCLMLT
!
!***********************************************************************
!
! Beginning of executable statements --
!
!   Reduce the arguments with the formula X = G + N /4, where G is
!   between -.25 and .25 --
!
      CALL MULT (FOUR,X,TMP(1))
      N=NINT(TMP(1))
      TMP(1) = DBLE(N)
      TMP(2) = DBLE(N)
      CALL RNDOUT(TMP,.TRUE.,.TRUE.)
      CALL IDIV(TMP,FOUR,TMP)
      CALL SUB(X, TMP, G)
!
!  Compute Taylor series approximation --
!
!     val = one + g*(one + g*(od2f + g*(od3f + g*(od4f + g*(od5f +
!    *     g*(od6f + g*(od7f + g*(od8f +g*(od9f +g*(od10f +g*od11f
!    *     )))))))))) --
!
      CALL MULT (G,OD11F,TMP)
      CALL ADD (OD10F,TMP,TMP)
      CALL MULT (G,TMP,TMP)
      CALL ADD (OD9F,TMP,TMP)
      CALL MULT (G,TMP,TMP)
      CALL ADD (OD8F,TMP,TMP)
      CALL MULT (G,TMP,TMP)
      CALL ADD (OD7F,TMP,TMP)
      CALL MULT (G,TMP,TMP)
      CALL ADD (OD6F,TMP,TMP)
      CALL MULT (G,TMP,TMP)
      CALL ADD (OD5F,TMP,TMP)
      CALL MULT (G,TMP,TMP)
      CALL ADD (OD4F,TMP,TMP)
      CALL MULT (G,TMP,TMP)
      CALL ADD (OD3F,TMP,TMP)
      CALL MULT (G,TMP,TMP)
      CALL ADD (OD2F,TMP,TMP)
      CALL MULT (G,TMP,TMP)
      CALL ADD (ONE,TMP,TMP)
      CALL MULT (G,TMP,TMP)
      CALL ADD (ONE,TMP,VAL)
!
!  Compute the error term and add to the approximation --
!
!     VALT = G**12 * OD12F * A3
!
      CALL POWER (G,12,TMP)
      CALL MULT (TMP,OD12F,TMP)
      CALL MULT (TMP,A3,VALT)
!
      ERTRM(1) = DMIN1(0D0,VALT(1))
      ERTRM(2) = DMAX1(0D0,VALT(2))
!
      CALL ADD (VAL,ERTRM,VAL)
!
!  Translate back to original interval -- val=val*e14**n --
!
      CALL POWER (E14,N,TMP)
      CALL MULT (VAL,TMP,VAL)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE RLOG(XX,RESULT)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Rebecca Yun
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
!
!
!***********************************************************************
!
! Function --
!
!  This subroutine returns the interval value of the logarithm over the
!  interval XX in RESULT.  It is assumed that XX is relatively small,
!  and that it is possible.  The usual use of this routine is from the
!  routine ILOG, which checks the argument values and calls this routine
!  to get rigorous bounds on values at the end points.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION XX(2), RESULT(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      INTEGER K
      DOUBLE PRECISION ERRTRM(2), VAL(2), X(2), XI(2), Y(2)
!
!
!***********************************************************************
!
! Common blocks --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --
!
!     DBLE, INT, LOG
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!   ADD, IDIV, MULT, POWER, RNDOUT, SUB
!
!***********************************************************************
!
! Beginning of executable statements --
!
      X(1) = XX(1)
      X(2) = XX(2)
!
!  Argument reduction: rewrite X <-- R^K * X
!               where  1/R <= X <= R = EXP(1/16)  ---
!
!   It is O.K. to use the Fortran LOG function here, since it it not
!   critical that X be exactly between 1/R and R ---
!
      IF (X(1).GE.ONE(1)) THEN
         K=INT(LOG((X(1)+X(2))/TWO(1))*SXTEEN(1))
      ELSE
         K = INT(LOG((X(1)+X(2))/TWO(1))*SXTEEN(1))-1
      END IF
!
      IF (K.LT.JTINY2) K=JTINY2
!
!    X <-- X/(R^K) ---
!
      CALL POWER(ESXTNT,K,VAL)
      CALL IDIV(X,VAL,X)
!
!  Initialize the values ---
!
      CALL SUB (X,ONE,Y)
!
      RESULT(1) = ZERO(1)
      RESULT(2) = ZERO(2)
!
!  Use Horner's scheme to evaluate the thirteenth degree Taylor
!  polynomial centered at one --
!
      CALL MULT(Y,THRTTH,RESULT)
      CALL SUB(RESULT,TWLVTH,RESULT)
      CALL MULT(Y,RESULT,RESULT)
      CALL ADD(ELEVTH,RESULT,RESULT)
      CALL MULT(Y,RESULT,RESULT)
      CALL SUB(RESULT,TENTH,RESULT)
      CALL MULT(Y,RESULT,RESULT)
      CALL ADD(NINTH,RESULT,RESULT)
      CALL MULT(Y,RESULT,RESULT)
      CALL SUB(RESULT,EIGHTH,RESULT)
      CALL MULT(Y,RESULT,RESULT)
      CALL ADD(SEVNTH,RESULT,RESULT)
      CALL MULT(Y,RESULT,RESULT)
      CALL SUB(RESULT,SIXTH,RESULT)
      CALL MULT(Y,RESULT,RESULT)
      CALL ADD(FIFTH,RESULT,RESULT)
      CALL MULT(Y,RESULT,RESULT)
      CALL SUB(RESULT,FOURTH,RESULT)
      CALL MULT(Y,RESULT,RESULT)
      CALL ADD(THIRD,RESULT,RESULT)
      CALL MULT(Y,RESULT,RESULT)
      CALL SUB(RESULT,OD2F,RESULT)
      CALL MULT(Y,RESULT,RESULT)
      CALL ADD(ONE,RESULT,RESULT)
      CALL MULT(Y,RESULT,RESULT)
!
!  Compute the error term ---
!
      IF (X(1).LT.ONE(1)) THEN
         XI(1) = X(1)
      ELSE
         XI(1) = ONE(1)
      END IF
!
!
      IF(X(2).GT.ONE(2)) THEN
         XI(2) = X(2)
      ELSE
         XI(2) = ONE(2)
      END IF
!
!    ERRTRM <-- Y^14 / [14*XI^14]
!
      CALL IDIV(Y,XI,ERRTRM)
      CALL POWER(ERRTRM,14,ERRTRM)
      CALL MULT(ERRTRM,FORTTH,ERRTRM)
!
!    RESULT <-- RESULT - ERRTRM
!
      CALL SUB (RESULT,ERRTRM,RESULT)
!
!  Undo the argument reduction: RESULT <-- RESULT+ K/16 --
!
      Y(1) = DBLE(K)
      Y(2) = Y(1)
      CALL RNDOUT(Y,.TRUE.,.TRUE.)
      CALL MULT(Y,SXTNTH,Y)
      CALL ADD (RESULT,Y,RESULT)
!
      RETURN
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE RSQRT(X,VAL)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Kaisheng Du
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
!
!
!***********************************************************************
!
! Function --
!
!  This routine returns the square root of the interval X in VAL.  It is
!  assumed that the interval X has relatively small width, and that its
!  lower bound is positive.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2), VAL(2)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION AM1(2), TMP1(2), TMP2(2), ERRTRM(2)
      DOUBLE PRECISION XTMP(2), XMID(2), XOLD(2)
      DOUBLE PRECISION CMIN, CMAX, T
      LOGICAL L, LSMALL
      INTEGER ITER, N
!
!***********************************************************************
!
! Common blocks --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines --
!
!   LOG10, MAX, MIN, NINT
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!   ADD, IDIV, MULT, POWER, RNDOUT, SUB
!
!***********************************************************************
!
! Beginning of executable statements --
!
      XTMP(1) = X(1)
      XTMP(2) = X(2)
!
!  Reduce to between 1/5 and 5 by dividing by the appropriate power
!  of 10.  Use the Fortran logarithm function to get the power.  This is
!  O.K., provided the argument to this function is within range,
!  since it is not crucial that the argument be exactly in [1/5,5] --
!
      N = NINT( LOG10( (XTMP(1)+XTMP(2))/2D0 ) )
!
!  Treat values between the smallest number which can be reciprocated
!  and the smallest representable number (if these two values are
!  different) as a special case --
!
      IF (N.LT.ITINY2) THEN
         N=ITINY2
         XTMP(1) = TINY2
         XTMP(2) = TINY2
         LSMALL = .TRUE.
      ELSE
         LSMALL = .FALSE.
      END IF
      CALL POWER(TEN,-N,TMP1)
      CALL MULT(XTMP,TMP1,XTMP)
!
      L = .FALSE.
!
      IF (XTMP(2).LT.ONE(1)) L = .TRUE.
!
!  Take the reciprocal if initial value is greater than one, in
!  order to have stable behavior in the interval Newton method --
!
      IF (L .AND. .NOT.LSMALL) THEN
         T = ONE(1)/XTMP(2)
         XTMP(2) = ONE(2)/XTMP(1)
         XTMP(1) = T
         CALL RNDOUT(XTMP,.TRUE.,.TRUE.)
      END IF
!
!  The reduced argument can be less than zero, depending on the
!  rounding properties and size of the original argument --
!
      IF (XTMP(1).LE.ZERO(2)) THEN
         WRITE(6,*) 'IN RSQRT, ARGUMENT WAS DETERMINED TO BE TOO'
         WRITE(6,*) 'LARGE OR TOO SMALL.'
         STOP
      END IF
!
!  Make an initial estimate for the result using a degree two
!  Taylor series with remainder term, provided the interval is
!  sufficiently bounded away from zero
!  (i.e. V <-- 1 + 1/2 (c-1) - 1/8 (c-1)^2 + 1/32 I (c-1)^3 )
!
         VAL(1) = ONE(1)
         VAL(2) = ONE(2)
         CALL SUB(XTMP,ONE,AM1)
         CALL MULT(AM1,OD2F,TMP1)
         CALL ADD(VAL,TMP1,VAL)
         CALL POWER(AM1,2,TMP1)
         CALL MULT(TMP1,EIGHTH,TMP1)
         CALL SUB(VAL,TMP1,VAL)
!
         CMIN = MIN(XTMP(1),ONE(1))
         CMAX = MAX(XTMP(2),ONE(2))
         TMP1(1) = ONE(1)/CMAX
         TMP1(2) = ONE(2)/CMIN
         CALL RNDOUT(TMP1,.TRUE.,.TRUE.)
         CALL POWER(TMP1,2,TMP2)
         CALL POWER(TMP1,3,TMP1)
         ERRTRM(1) = MIN(TMP1(1),TMP2(1))
         ERRTRM(2) = MAX(TMP1(2),TMP2(2))
         CALL MULT(ERRTRM,SXTNTH,ERRTRM)
         CALL POWER(AM1,3,TMP1)
         CALL MULT(ERRTRM,TMP1,ERRTRM)
!
         CALL ADD(ERRTRM,VAL,VAL)
         VAL(1) = MAX(VAL(1),TINY2)
!
!  Do an interval Newton iteration until it becomes stationary --
!
      DO 10    ITER = 1,100
!
         XOLD(1) = VAL(1)
         XOLD(2) = VAL(2)
         XMID(1) = (VAL(1)+VAL(2))/2D0
         XMID(2) = XMID(1)
!
!       VAL <-- MID(VAL) - (MID(VAL)^2-A) / (TWO*VAL) --
!
         CALL POWER (XMID,2,TMP1)
         CALL SUB (TMP1,XTMP,TMP1)
         CALL MULT (TWO,VAL,TMP2)
         CALL IDIV(TMP1,TMP2,TMP2)
         CALL SUB (XMID,TMP2,VAL)
!
         VAL(1) = MAX(VAL(1),XOLD(1))
         VAL(2) = MIN(VAL(2),XOLD(2))
!
         IF (VAL(1).EQ.XOLD(1) .AND. VAL(2).EQ.XOLD(2)) GO TO 20
!
   10 END DO
   20 CONTINUE
!
!  Take the reciprocal of the result, if the argument was
!  reciprocated --
!
      IF (L.AND. .NOT. LSMALL) THEN
         T = VAL(1)
         VAL(1) = ONE(1)/VAL(2)
         VAL(2) = ONE(2)/T
         CALL RNDOUT(VAL,.TRUE.,.TRUE.)
      END IF
!
!  Transform back to the original position by multiplying by the
!  appropriate power of the square root of 10 --
!
      CALL POWER(SQT10,N,TMP1)
      CALL MULT(TMP1,VAL,VAL)
!
      IF (LSMALL) VAL(1)=ZERO(1)
!
      RETURN
      END

!*** miscmach.f
      SUBROUTINE ERRTST(X)
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Kaisheng Du
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
!
!
!***********************************************************************
!
! Function --
!
!  This routine prints error conditions which have been signalled
!  in other routines.  It halts execution, changes X, or returns,
!  depending on the particular error and on the way the error handling
!  control flags are set.
!
!***********************************************************************
!
! Argument declarations --
!
      DOUBLE PRECISION X(2)
!
!***********************************************************************
!
! Argument descriptions -- (INPUT  = set on entry and not alterable)
!                          (OUTPUT = to be set by the routine)
!                          (I/O    = set on entry but alterable)
!
!  X  is an interval which depends on the error set (I/O)
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION T
!
!***********************************************************************
!
! Common block declarations --
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Beginning of executable statements --
!
      ISIG = 0
!
      IF (IERR.EQ.1) THEN
         ISIG = 2
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &    'SEVERITY 2 ERROR:  LOWER BOUND ON INTERVAL IS GREATER',      &
     &    ' THAN UPPER BOUND'
            WRITE(IERPUN,100) 'X:',X
         END IF
         T = X(1)
         X(1) = X(2)
         X(2) = T
      ELSE IF (IERR.EQ.2) THEN
         ISIG = 1
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &    'SEVERITY 1 ERROR: LOWER BOUND ON X FOR IEXP WOULD UNDERFLOW'
         END IF
      ELSE IF (IERR.EQ.3) THEN
         ISIG = 2
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &    'SEVERITY 2 ERROR: LOWER BOUND ON X FOR IEXP WOULD OVERFLOW'
         END IF
      ELSE IF (IERR.EQ.4) THEN
         ISIG = 2
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &    'SEVERITY 2 ERROR: UPPER BOUND ON X FOR IEXP WOULD OVERFLOW'
         END IF
      ELSE IF (IERR.EQ.5) THEN
         ISIG = 0
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &    'WARNING: Loss of accuracy in trig function due to the',      &
     &    ' argument range.'
            WRITE(IERPUN,*) 'X:',X
         END IF
      ELSE IF (IERR.EQ.6) THEN
         ISIG = 2
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &    'SEVERITY 2 ERROR: ZERO IN DENOMINATOR IN ORDINARY INTERVAL', &
     &    ' DIVISION.'
            WRITE(IERPUN,*) 'DENOMINATOR:',X
         END IF
      ELSE IF (IERR.EQ.7) THEN
         ISIG = 3
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &    'SEVERITY 3 ERROR: ARGUMENT CONTAINS ZERO IN ELEMENTARY',     &
     &    ' FUNCTION.'
            WRITE(IERPUN,*) 'ARGUMENT:',X
         END IF
      ELSE IF (IERR.EQ.8) THEN
         ISIG = 2
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &    'SEVERITY 2 ERROR: NEGATIVE POWER OF A ZERO-CONTAINING'
            WRITE(IERPUN,*)                                             &
     &    'INTERVAL IS UNDEFINED IN ORDINARY INTERVAL ARITHMETIC.'
            WRITE(IERPUN,*) 'ARGUMENT:',X
         END IF
      ELSE IF (IERR.EQ.9) THEN
         ISIG = 3
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &    'SEVERITY 3 ERROR: ARGUMENT TO INVERSE TRIG FUNCTION'
            WRITE(IERPUN,*)                                             &
     &    'MAY CONTAIN NUMBERS WHICH ARE GREATER THAN 1.'
            WRITE(IERPUN,*) 'ARGUMENT:',X
         END IF
      ELSE IF (IERR.EQ.10) THEN
         ISIG = 3
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &    'SEVERITY 3 ERROR: ARGUMENT TO INVERSE TRIG FUNCTION'
            WRITE(IERPUN,*)                                             &
     &    'MAY CONTAIN NUMBERS WHICH ARE LESS THAN -1.'
            WRITE(IERPUN,*) 'ARGUMENT:',X
         END IF
      ELSE IF (IERR.EQ.11) THEN
         ISIG = 3
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &    'SEVERITY 3 ERROR: APPROXIMATING SERIES FOR REDUCED ARGUMENT',&
     &    ' DID NOT CONVERGE.'
            WRITE(IERPUN,*) 'CURRENT TERM IN SERIES:',X
         END IF
      ELSE IF (IERR.EQ.12) THEN
         ISIG = 3
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*) 'INTERNAL ERROR;  NEGATIVE ARGUMENT:'
            WRITE(IERPUN,*) X
            WRITE(IERPUN,*) 'POSSIBLY, AN ARRAY WAS DIMENSIONED',       &
     &                   ' INCORRECTLY OR MEMORY WAS NOT PROPERLY'
            WRITE(IERPUN,*) 'ALLOCATED.  IF THE ERROR PERSISTS, THEN:'
            WRITE(IERPUN,*) 'Contact R. Baker Kearfott, Dept. Math.,'
            WRITE(IERPUN,*) 'USL Box 4-1010, Lafayette, LA 70504-1010.'
            WRITE(IERPUN,*) 'email: rbk@usl.edu'
         END IF
      ELSE IF (IERR.EQ.13) THEN
         ISIG = 0
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &        'Warning:  Disjoint intervals in intersection.'
            X(1) = POSINF
            X(2) = NEGINF
         END IF
      ELSE IF (IERR.EQ.14) THEN
         ISIG = 1
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &        'Power function with operands containing 0^0 occured.'
            WRITE(IERPUN,*)                                             &
     &        'Result is sent to [NEGINF,POSINF].'
         END IF
      ELSE IF (IERR.EQ.15) THEN
         ISIG = 1
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*)                                             &
     &        'Power function with operands of the form'
            WRITE(IERPUN,*)                                             &
     &        '[0,pos]^[pos,pos] occurred. Result is set to'
            WRITE(IERPUN,*)                                             &
     &        '[pos,POSINF].'
         END IF
      ELSE
         ISIG=3
         IF (IPRTCL.LE.ISIG) THEN
            WRITE(IERPUN,*) 'INTERNAL ERROR;  UNKNOWN ERROR TYPE,',IERR,&
     &                      ' IN ERRTST.'
            WRITE(IERPUN,*) 'POSSIBLY, AN ARRAY WAS DIMENSIONED',       &
     &                   ' INCORRECTLY OR MEMORY WAS NOT PROPERLY'
            WRITE(IERPUN,*) 'ALLOCATED.  IF THE ERROR PERSISTS, THEN:'
            WRITE(IERPUN,*) 'Contact R. Baker Kearfott, Dept. Math.,'
            WRITE(IERPUN,*) 'USL Box 4-1010, Lafayette, LA 70504-1010.'
            WRITE(IERPUN,*) 'email: rbk@usl.edu'
         END IF
      END IF

!
      IF (IPRTCL.LE.ISIG) THEN
         IF (IROUT.EQ.1) THEN
            WRITE(IERPUN,*) 'Error occurred in routine IEXP.'
         ELSE IF (IROUT.EQ.2) THEN
            WRITE(IERPUN,*) 'Error occurred in routine ICOS.'
         ELSE IF (IROUT.EQ.3) THEN
            WRITE(IERPUN,*) 'Error occurred in routine IDIV.'
         ELSE IF (IROUT.EQ.4) THEN
            WRITE(IERPUN,*) 'Error occurred in routine ILOG.'
         ELSE IF (IROUT.EQ.5) THEN
            WRITE(IERPUN,*) 'Error occurred in routine ISQRT.'
         ELSE IF (IROUT.EQ.6) THEN
            WRITE(IERPUN,*) 'Error occurred in routine ISINH.'
         ELSE IF (IROUT.EQ.7) THEN
            WRITE(IERPUN,*) 'Error occurred in routine POWER.'
         ELSE IF (IROUT.EQ.8) THEN
            WRITE(IERPUN,*) 'Error occurred in routine IACOS.'
         ELSE IF (IROUT.EQ.9) THEN
            WRITE(IERPUN,*) 'Error occurred in routine IASIN.'
         ELSE IF (IROUT.EQ.10) THEN
            WRITE(IERPUN,*) 'Error occurred in routine ASNSER, ',       &
     &                      'an auxiliary routine called by IASIN.'
         ELSE IF (IROUT.EQ.11) THEN
            WRITE(IERPUN,*) 'Error occurred in routine IATAN.'
         ELSE IF (IROUT.EQ.12) THEN
            WRITE(IERPUN,*) 'Error occurred in routine ATNSER, ',       &
     &                      'an auxiliary routine called by IATAN.'
         ELSE IF (IROUT.EQ.13) THEN
            WRITE(IERPUN,*) 'Error occurred in routine ICAP, ',         &
     &                      'a utility function routine.'
         ELSE IF (IROUT.EQ.14) THEN
            WRITE(IERPUN,*) 'Error occurred in routine IIPOWR.'
         ELSE IF (IROUT.EQ.15) THEN
            WRITE(IERPUN,*) 'Error occurred in routine IVL2, ',         &
     &                      'a utility function routine.'
         ELSE
            ISIG = 3
            WRITE(IERPUN,*) 'INTERNAL ERROR;  UNKNOWN ROUTINE NUMBER,', &
     &                      IROUT, ' IN ERRTST.'
            WRITE(IERPUN,*) 'POSSIBLY, AN ARRAY WAS DIMENSIONED',       &
     &                   ' INCORRECTLY OR MEMORY WAS NOT PROPERLY'
            WRITE(IERPUN,*) 'ALLOCATED.  IF THE ERROR PERSISTS, THEN:'
            WRITE(IERPUN,*) 'Contact R. Baker Kearfott, Dept. Math.,'
            WRITE(IERPUN,*) 'USL Box 4-1010, Lafayette, LA 70504-1010.'
            WRITE(IERPUN,*) 'email: rbk@usl.edu'
         END IF
      END IF
!
      IF (ISIG.GE.ISEVER) STOP
!
      RETURN
!
  100 FORMAT(1X,A,3X,D23.15,2X,D23.15)
      END
!***********************************************************************
!***********************************************************************
      SUBROUTINE SIMINI
!
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
!
! Written by:
!
!   R. Baker Kearfott
!
!         and
!
!   Kaisheng Du
!
!   Department of Mathematics
!   U.S.L. Box 4-1010
!   Lafayette, LA 70504
!
!   April 11, 1992
!
! Part of the interval elementary function library
!
!
!***********************************************************************
!
! Called by -- GENBIS
!
!***********************************************************************
!
! Function --
!
!  This routine sets certain machine parameters used to simulate
!  directed roundings in a reasonably transportable way.  In
!  particular, it sets the amount by which to decrease the left endpoint
!  and increase the right endpoint of an interval computed using usual
!  floating point arithmetic to guarantee that the resulting interval
!  will contain the result which would have been obtained with true
!  interval arithmetic.
!
!
!  In addition to setting certain parameters, certain constants, such as
!  pi and the natural logarithm base e, are set here.  The data
!  for the representation for these constants which appears here
!  should be accurate at least to the number of significant figures
!  present in the machine.  If it is possible to input a binary form
!  for the double precision representation of this data, then that
!  form should be given to be correct to all representable digits.
!
!  This routine assumes that the four elementary floating point
!  operations, and unary negation, will give results with a maximum
!  error of one ULP (unit in the last place).  If this is not so, change
!  the value of MAXERR in the data statement below to the maximum number
!  of ULP's by which a floating point result can differ from the true
!  result (for '+', '-', '*', '/' and conversion from integer
!  to double precision).
!
!  An additional assumption is that the standard routines MIN and MAX
!  return exact values corresponding to one of their arguments.
!
!  When determining the maximum error of the result A op B, where
!  A and B are floating point numbers, we assume that A and B are
!  represented exactly.  For example, if A and B are almost equal,
!  then it is not unreasonable to assume that A - B, where the
!  subtraction is a floating point subtraction, is within a few
!  units of the last place of the true result.
!
!  Throughout the elementary function routines, it is assumed that
!  storing the double precision expressions 0D0 leads to an exact
!  floating point representation of 0. It is also assumed that a
!  floating point assignment statement (such as A=B) causes exactly the
!  same value to be in A as in B.
!
!  Note:  On some machines, an underflow naturally occurs when this
!         routine is executed.  (It would happen in the computation of
!         TINY2.)  This is not a problem.
!
!  If SIMINI is installed correctly, then the conclusions this
!  package prints out will have mathematical rigor.
!
!***********************************************************************
!
! Common block declarations --
!
      DOUBLE PRECISION MXULP, TTINY2, TOL0
      COMMON /MACH1/ MXULP, TTINY2, TOL0
!
!  This common block holds machine parameters which are set here
!  and used in RNDOUT.
!
!  Variable descriptions
!
!  MXULP       (machine epsilon)
!                * (maximum error in ULP's of the floating pt. op's)
!
!  TTINY2      2 * (smallest representable positive machine number)
!                * (maximum error in ULP's of the floating pt. op's)
!
!  TOL0        TTINY2 / MXULP
!
      DOUBLE PRECISION TINY, TEST
      COMMON /MACH2/ TINY, TEST
!
!  Common block MACH2 stores machine constants used in RNDOUT.  TINY
!  is the smallest representable machine number, while TEST is the
!  smallest number which can be safely rounded to something other than
!  zero.
!
      DOUBLE PRECISION MAXX, MXLGM1, NEGINF, POSINF, A(2), PI(2), E(2), &
     &   PI2(2), PI3(2), PI4(2), PI6(2), PI8(2), E14(2), A3(2), ONE(2), &
     &   OD2F(2), OD3F(2), OD4F(2), OD5F(2), OD6F(2), OD7F(2), OD8F(2), &
     &   OD9F(2), OD10F(2), OD11F(2), OD12F(2), OD14F(2), EIGHT(2),     &
     &   ZERO(2), TWO(2), THREE(2), FOUR(2), SXTNTH(2), NINE(2), TEN(2),&
     &   TWOT7(2), SQT10(2), ESXTNT(2), SXTEEN(2), THIRD(2), FOURTH(2), &
     &   FIFTH(2), SIXTH(2), SEVNTH(2), EIGHTH(2), NINTH(2), TENTH(2),  &
     &   ELEVTH(2), TWLVTH(2), THRTTH(2), FORTTH(2), TT7TH(2), TINY2,   &
     &   CBTEP, SQT3(2), ODSQT3(2)
!
      COMMON /MTHCNS/  MAXX, MXLGM1, NEGINF, POSINF, A, PI, E, PI2, PI3,&
     &   PI4, PI6, PI8, ONE, OD2F, OD3F, E14, A3, OD4F, OD5F, OD6F,     &
     &   OD7F, OD8F, OD9F, OD10F, OD11F, OD12F, OD14F, EIGHT, ZERO, TWO,&
     &   THREE, FOUR, SXTNTH, NINE, TEN, TWOT7, SQT10, ESXTNT, SXTEEN,  &
     &   THIRD, FOURTH, FIFTH, SIXTH, SEVNTH, EIGHTH, NINTH, TENTH,     &
     &   ELEVTH, TWLVTH, THRTTH, FORTTH, TT7TH, TINY2, CBTEP, SQT3,     &
     &   ODSQT3
!
      INTEGER ITINY2, JTINY2
!
      COMMON /IMATH/   ITINY2, JTINY2
!
!
!  The above common blocks hold mathematical constants which are used in
!  the elementary function routines.
!
!  Variable descriptions
!
!  MAXX        a double precision representation of the largest
!              representable integer
!
!  MXLGM1      an approximation to the logarithm of .25 times the
!              largest representable machine number, minus 1. This
!              should be a rigorous lower bound on the logarithm of the
!              largest representable machine number.  Its default
!              computation in SIMINI is to use the Fortran LOG function.
!              This should be changed if the Fortran LOG function is not
!              sufficiently accurate.
!
!
!  A           an interval enclosure for 1/pi
!
!  PI          an interval enclosure for pi
!
!  PI2         an interval enclosure for pi/2
!
!  PI3         an interval enclosure for pi/3
!
!  PI4         an interval enclosure for pi/4
!
!  PI6         an interval enclosure for pi/6
!
!  PI8         an interval enclosure for pi/8
!
!  E           an interval enclosure for E
!
!  E14         an interval enclosure for e^{1/4}
!
!  ESXTNT      an interval enclosure for e^{1/16}
!
!  SQT10       an interval enclosure for SQRT(10)
!
!  TINY2       the maximum of the smallest machine number and the
!              reciprocal of the largest machine number.  This quantity
!              is checked to avoid overflow in certain places.
!
!  CBTEP       an approximation to the cube root of six times the
!              largest distance between numbers.
!
!  SQT3        an interval enclosure for the square root of 3.
!
!  ODSQT3      the reciprocal of the square root of 3 times
!              1+ 100*MXULP, used in argument reduction in the
!              arctangent routine.
!
!  ITINY2      the logarithm base 10 of TINY2 truncated to an integer.
!
!  JTINY2      sixteen times the logarithm base e of TINY2 truncated to
!              an integer.
!
!  See the statements in the routine SIMINI for the definitions of
!  the other constants.
!
      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
!
! The above common block stores signalling information for error
! conditions.  In particular,
!
! ISIG   is set to 0 at the beginning of SIMINI, and is reset
!        to the severity level of the error (1, 2, or 3) when an error
!        condition occurs.  The user may reset the flag to zero after an
!        error condition, depending on the error, if ISEVER is set to
!        allow execution after an error of its severity.
!
! IERR   is the number of the error condition, if an error occurred in
!        the last routine in INTLIB with error checking.  If no errors
!        occurred in the last such routine called, then IERR is zero.
!        The specific error conditions associated with particular error
!        numbers is defined in the routine ERRTST.
!
! IROUT  is the code number of the package routine in which the error
!        occurred
!
! IPRTCL controls the level of error which is printed.  IPRCTL=0 prints
!        all levels, while IPRCTL=1 prints only errors of level 1 or
!        greater.  If IPRTCL=4, then no error information is printed.
!
! ISEVER gives the error level which will stop execution.  ISEVER=0
!        causes any error to stop execution, while ISEVER>=3 causes only
!        errors of severity 3 to stop execution.  Generally, severity 3
!        errors correspond to when it is impossible to assign a result
!        with any meaningful interpretation.
!
! IERPUN is the Fortran unit number to which errors should be printed.
!
!***********************************************************************
!
! Fortran-supplied functions and subroutines -- DBLE, INT, MAX
!
!***********************************************************************
!
! Package-supplied functions and subroutines --
!
!  D1MACH, I1MACH (the SLATEC routines for machine constants)
!
!  RNDOUT
!
      DOUBLE PRECISION D1MACH
      INTEGER I1MACH
!
!***********************************************************************
!
! User-supplied functions and subroutines -- none
!
!***********************************************************************
!
! I/O functions -- none
!
!***********************************************************************
!
! Internal variable declarations --
!
      DOUBLE PRECISION TMP(2)
!
!***********************************************************************
!
! Internal constant declarations --
!
      INTEGER MAXERR
      DATA MAXERR/1/
!
!***********************************************************************
!
! Internal constant descriptions --
!
!  MAXERR      is the maximum number of ULP's (units in the last
!              place) by which a result of one of the floating point
!              operations (+, -, *, /, ** N) can differ from the
!              true result.  (See explanation above.)
!
!********** WARNING: The value of MAXERR is machine dependent and
!                    must be manually set.
!
!***********************************************************************
!
! Beginning of executable statements --
!
      TINY = D1MACH(1)
      MXULP = DBLE(MAXERR) * D1MACH(4)
      TEST = TINY/(1D0-3D0*MXULP)
      TTINY2 = 2D0 * DBLE(MAXERR) * TINY
      TOL0 = TTINY2 / MXULP
!
      TMP(1) = 1D0/D1MACH(2)
      TMP(2) = TMP(1)
      CALL RNDOUT (TMP,.TRUE.,.TRUE.)
      TINY2 = MAX(TINY,TMP(2))
      CBTEP = (6D0*D1MACH(4))**(1D0/3D0)
      ITINY2 = INT(LOG10(TINY2))
      JTINY2 = 16*INT(LOG(TINY2))
!
      MAXX = DBLE(I1MACH(9))
!
      MXLGM1 = LOG(D1MACH(2)) -LOG(4D0) - 1D0
      NEGINF = -D1MACH(2)
      POSINF =  D1MACH(2)
!
      A(1) = 0.31830988618379067153776752674502864D+00
      A(2) = 0.31830988618379067153776752674502864D+00
      CALL RNDOUT(A,.TRUE.,.TRUE.)
!
      PI(1) = 0.31415926535897932384626433832795028D+01
      PI(2) = 0.31415926535897932384626433832795028D+01
      CALL RNDOUT(PI,.TRUE.,.TRUE.)

      E(1) =  0.27182818284590452353602874713526625D+01
      E(2) =  0.27182818284590452353602874713526625D+01
      CALL RNDOUT(E,.TRUE.,.TRUE.)
!
      PI2(1) = 0.15707963267948966192313216916397499D+01
      PI2(2) = 0.15707963267948966192313216916397499D+01
      CALL RNDOUT(PI2,.TRUE.,.TRUE.)
!
      PI3(1) = 1.0471975511965977461542144610931676D0
      PI3(2) = 1.0471975511965977461542144610931676D0
      CALL RNDOUT(PI3,.TRUE.,.TRUE.)
!
      PI4(1) = 0.7853981633974483096156608458198757D0
      PI4(2) = 0.7853981633974483096156608458198757D0
      CALL RNDOUT(PI4,.TRUE.,.TRUE.)
!
      PI6(1) = 0.5235987755982988730771072305465838D0
      PI6(2) = 0.5235987755982988730771072305465838D0
      CALL RNDOUT(PI6,.TRUE.,.TRUE.)
!
      PI8(1) = 0.39269908169872415480783042290993785D+00
      PI8(2) = 0.39269908169872415480783042290993785D+00
      CALL RNDOUT(PI8,.TRUE.,.TRUE.)
!
      E14(1) = 0.12840254166877414840734205680624368D+01
      E14(2) = 0.12840254166877414840734205680624368D+01
      CALL RNDOUT(E14,.TRUE.,.TRUE.)
!
      A3(1) = 0.11331484530668263168290072278117947D+01
      A3(2) = 0.11331484530668263168290072278117947D+01
      CALL RNDOUT(A3,.TRUE.,.TRUE.)
!
      ONE  (1) = 1D0
      OD2F (1) = 1D0 /           2D0
      OD3F (1) = 1D0 /           6D0
      OD4F (1) = 1D0 /          24D0
      OD5F (1) = 1D0 /         120D0
      OD6F (1) = 1D0 /         720D0
      OD7F (1) = 1D0 /        5040D0
      OD8F (1) = 1D0 /       40320D0
      OD9F (1) = 1D0 /      362880D0
      OD10F(1) = 1D0 /     3628800D0
      OD11F(1) = 1D0 /    39916800D0
      OD12F(1) = 1D0 /   479001600D0
      OD14F(1) = 1D0 / 87178291200D0
!
      ONE  (2) = ONE  (1)
      OD2F (2) = OD2F (1)
      OD3F (2) = OD3F (1)
      OD4F (2) = OD4F (1)
      OD5F (2) = OD5F (1)
      OD6F (2) = OD6F (1)
      OD7F (2) = OD7F (1)
      OD8F (2) = OD8F (1)
      OD9F (2) = OD9F (1)
      OD10F(2) = OD10F(1)
      OD11F(2) = OD11F(1)
      OD12F(2) = OD12F(1)
      OD14F(2) = OD14F(1)
!
      CALL RNDOUT(  ONE,.TRUE.,.TRUE.)
      CALL RNDOUT( OD2F,.TRUE.,.TRUE.)
      CALL RNDOUT( OD4F,.TRUE.,.TRUE.)
      CALL RNDOUT( OD6F,.TRUE.,.TRUE.)
      CALL RNDOUT( OD8F,.TRUE.,.TRUE.)
      CALL RNDOUT(OD10F,.TRUE.,.TRUE.)
      CALL RNDOUT(OD12F,.TRUE.,.TRUE.)
      CALL RNDOUT(OD14F,.TRUE.,.TRUE.)
!
      EIGHT(1) = 8D0
      EIGHT(2) = 8D0
      CALL RNDOUT(EIGHT,.TRUE.,.TRUE.)
!
      ZERO(1) = 0D0
      ZERO(2) = 0D0
!
      TWO(1) = 2D0
      TWO(2) = 2D0
      CALL RNDOUT(TWO,.TRUE.,.TRUE.)
!
      THREE(1) = 3D0
      THREE(2) = 3D0
      CALL RNDOUT(THREE,.TRUE.,.TRUE.)
!
      FOUR(1) = 4D0
      FOUR(2) = 4D0
      CALL RNDOUT(FOUR,.TRUE.,.TRUE.)
!
      NINE(1) = 9D0
      NINE(2) = 9D0
      CALL RNDOUT(NINE,.TRUE.,.TRUE.)
!
      SXTNTH(1) = 1D0/16D0
      SXTNTH(2) = SXTNTH(1)
      CALL RNDOUT(SXTNTH,.TRUE.,.TRUE.)
!
      TEN(1) = 10D0
      TEN(2) = 10D0
      CALL RNDOUT(TEN,.TRUE.,.TRUE.)
!
      TWOT7(1) = 27D0
      TWOT7(2) = 27D0
      CALL RNDOUT(TWOT7,.TRUE.,.TRUE.)
!
      SQT10(1) = 3.1622776601683793319988935444327185D0
      SQT10(2) = 3.1622776601683793319988935444327185D0
      CALL RNDOUT(SQT10,.TRUE.,.TRUE.)
!
      ESXTNT(1) = 1.0644944589178594295633905946428909D0
      ESXTNT(2) = 1.0644944589178594295633905946428909D0
      CALL RNDOUT(ESXTNT,.TRUE.,.TRUE.)
!
      SXTEEN(1) = 16D0
      SXTEEN(2) = 16D0
      CALL RNDOUT(SXTEEN, .TRUE.,.TRUE.)
!
      THIRD(1) = 1D0/3D0
      THIRD(2) = 1D0/3D0
      CALL RNDOUT(THIRD,.TRUE.,.TRUE.)
!
      FOURTH(1) = .25D0
      FOURTH(2) = .25D0
      CALL RNDOUT(FOURTH,.TRUE.,.TRUE.)
!
      FIFTH(1) = .2D0
      FIFTH(2) = .2D0
      CALL RNDOUT(FIFTH,.TRUE.,.TRUE.)
!
      SIXTH(1) = 1D0/6D0
      SIXTH(2) = 1D0/6D0
      CALL RNDOUT(SIXTH,.TRUE.,.TRUE.)
!
      SEVNTH(1) = 1D0/7D0
      SEVNTH(2) = 1D0/7D0
      CALL RNDOUT(SEVNTH,.TRUE.,.TRUE.)
!
      EIGHTH(1) = .125D0
      EIGHTH(2) = .125D0
      CALL RNDOUT(EIGHTH,.TRUE.,.TRUE.)
!
      NINTH(1) = 1D0/9D0
      NINTH(2) = 1D0/9D0
      CALL RNDOUT(NINTH,.TRUE.,.TRUE.)
!
      TENTH(1) = .1D0
      TENTH(2) = .1D0
      CALL RNDOUT(TENTH,.TRUE.,.TRUE.)
!
      ELEVTH(1) = 1D0/11D0
      ELEVTH(2) = 1D0/11D0
      CALL RNDOUT(ELEVTH,.TRUE.,.TRUE.)
!
      TWLVTH(1) = 1D0/12D0
      TWLVTH(2) = 1D0/12D0
      CALL RNDOUT(TWLVTH,.TRUE.,.TRUE.)
!
      THRTTH(1) = 1D0/13D0
      THRTTH(2) = 1D0/13D0
      CALL RNDOUT(THRTTH,.TRUE.,.TRUE.)
!
      FORTTH(1) = 1D0/14D0
      FORTTH(2) = 1D0/14D0
      CALL RNDOUT(FORTTH,.TRUE.,.TRUE.)
!
      TT7TH(1) = 1D0/27D0
      TT7TH(2) = 1D0/27D0
      CALL RNDOUT(TT7TH,.TRUE.,.TRUE.)
!
      SQT3(1) = 1.7320508075688772935274463415058724D0
      SQT3(2) = 1.7320508075688772935274463415058724D0
      CALL RNDOUT(SQT3,.TRUE.,.TRUE.)
!
      ODSQT3(1) = 0.57735026918962576450914878050195746D0
      ODSQT3(2) = 0.57735026918962576450914878050195746D0
      CALL RNDOUT(ODSQT3,.TRUE.,.TRUE.)
      CALL SCLMLT(1D0+100D0*MXULP,ODSQT3,ODSQT3)
!
!  Set default values for the error checking routine --
!
      ISIG = 0
      IERR = 0
      IPRTCL = 0
      ISEVER = 3
      IERPUN = 6
!
      RETURN
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'ivl_def.f90'
then
	echo shar: will not over-write existing file "'ivl_def.f90'"
else
cat << \SHAR_EOF > 'ivl_def.f90'
MODULE IVL_DEF
      TYPE INTERVAL
         SEQUENCE
         DOUBLE PRECISION LOWER, UPPER
      END TYPE INTERVAL
END MODULE IVL_DEF
SHAR_EOF
fi # end of overwriting check
cd ..
cd ..
if test ! -d 'Drivers'
then
	mkdir 'Drivers'
fi
cd 'Drivers'
if test ! -d 'Sp'
then
	mkdir 'Sp'
fi
cd 'Sp'
if test -f 'sample.out'
then
	echo shar: will not over-write existing file "'sample.out'"
else
cat << \SHAR_EOF > 'sample.out'
 Output from TEST_INTERVAL_SYSTEM on  05/02/1996  at  01:52:38.

 X, Y, Z, W:
   1.00000000000000000000E+00   3.00000000000000000000E+00
  -4.00000000000000000000E+00  -2.00000000000000000000E+00
  -3.00000000000000000000E+00   2.00000000000000000000E+00
   0.00000000000000000000E+00   5.00000000000000000000E-01
 R:
   2.00000000000000000000E+00
 I:
          3

 Testing the four elementary operations and exponentiation ---
 Testing X <-- X op X ---
 Testing all cases of multiplication ---
 Additional testing of X<--X*X ---
 Testing double*interval ---
 Testing additional cases of division ---
 Testing MAG, WID, MID, MIG, ABS ---
 Testing MAX, MIN ---
 Testing ACOS, ACOT, ASIN, ATAN ---
 Testing COS, COT, EXP, LOG, SIN, SQRT, TAN, SINH ---
 Testing .IS. and .CH. ---
 Testing .SB., .SP., .DJ., and .IN. ---
 Testing .LT., .GT., .LE., .GE., .EQ., and .NE. ---
 Testing INF and SUP ---
 Additional testing of .CH. dealing with empty intervals ---
 Testing some implicit conversions ---
 Additional testing of mixed mode multiplication ---

 Check the conversion function:

 IVL(.3D0):
   2.99999999999999900000E-01   3.00000000000000000000E-01
 IVL(.3D0,.6D0):
   2.99999999999999900000E-01   6.00000000000000100000E-01
 IVL(1,2):
   9.99999999999999800000E-01   2.00000000000000000000E+00
 IVL(1):
   9.99999999999999800000E-01   1.00000000000000000000E+00
 IVL(.3D0,1):
   2.99999999999999900000E-01   1.00000000000000000000E+00
 IVL(1,3.1D0):
   9.99999999999999800000E-01   3.10000000000000100000E+00
 IVL(X):
   1.00000000000000000000E+00   3.00000000000000000000E+00


 Check RNDOUT near underflow and overflow thresholds:

 [TINY,1]/[5,6]:
   0.00000000000000000000E+00   2.00000000000000100000E-01

 [-1,-TINY]/[5,6]:
  -2.00000000000000100000E-01   0.00000000000000000000E+00

 Precipitate a division error by trying [1,2]/[-1,1]:
 SEVERITY 2 ERROR: ZERO IN DENOMINATOR IN ORDINARY INTERVAL DIVISION.
 DENOMINATOR:      -1.000000000000000        1.000000000000000
 Error occurred in routine IDIV.

 Precipitate an error by trying [1,2].IS.[3,4]:
 Warning:  Disjoint intervals in intersection.
 Error occurred in routine ICAP, a utility function routine.

 All tests completed satisfactorily.  Module
 INTERVAL_ARITHMETIC appears to be installed correctly.
SHAR_EOF
fi # end of overwriting check
if test -f 'test_f90_intarith.f90'
then
	echo shar: will not over-write existing file "'test_f90_intarith.f90'"
else
cat << \SHAR_EOF > 'test_f90_intarith.f90'
PROGRAM TEST_INTERVAL_ARITHMETIC

!  This routine tests the Fortran 90 interface to the elementary
!  interval arithmetic portion of INTLIB.

USE INTERVAL_ARITHMETIC

      TYPE(INTERVAL) A, B, C
      DOUBLE PRECISION D
      INTEGER N

      CALL SIMINI

      A = INTERVAL(1,2)
      B = INTERVAL(3,4)
      N = 3

      OPEN(6,FILE='TEST_F90_INTARITH.OUT')

      C = A+B;          WRITE(6,'(2(1X,ES12.3E2))') C
      C = A**N;         WRITE(6,'(2(1X,ES12.3E2))') C
      C = A**B;         WRITE(6,'(2(1X,ES12.3E2))') C
      C = COS(A);       WRITE(6,'(2(1X,ES12.3E2))') C
      C = A.CH.B;       WRITE(6,'(2(1X,ES12.3E2))') C
      D = COS(A%LOWER); WRITE(6,'((1X,ES12.3E2))') D
      D = COS(A%UPPER); WRITE(6,'((1X,ES12.3E2))') D

      WRITE(6,'(2(1X,L1))') A.SB.C, A.SB.B

      STOP

END PROGRAM TEST_INTERVAL_ARITHMETIC
SHAR_EOF
fi # end of overwriting check
if test -f 'testsys.f90'
then
	echo shar: will not over-write existing file "'testsys.f90'"
else
cat << \SHAR_EOF > 'testsys.f90'
! This program tests many cases that arise with the module
! INTERVAL_ARITHMETIC. Each of the possible combinations of mixed-mode
! operations is tested.
!
! This version assumes that small integers are stored exactly into
! floating point numbers.
!
PROGRAM TEST_INTERVAL_SYSTEM

   USE INTERVAL_ARITHMETIC
   IMPLICIT NONE

      INTEGER :: OUTPUT_UNIT = 6
      CHARACTER(LEN=12) :: OUTPUT_FILE_NAME = 'INTARITH.OUT'

      CHARACTER(LEN=10) CURRENT_DATE, CURRENT_TIME

      TYPE(INTERVAL) :: X, Y, Z, W, XX
      DOUBLE PRECISION R, RR
      INTEGER I
      LOGICAL ALL_TESTS_OK
      DOUBLE PRECISION TOL

      DOUBLE PRECISION TINY, TEST
      COMMON /MACH2/ TINY, TEST

      INTEGER ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN
      COMMON /ERFLGS/ ISIG, IERR, IROUT, IPRTCL, ISEVER, IERPUN

      CALL SIMINI
      ISEVER = 4
      IERPUN = OUTPUT_UNIT
      IPRTCL = 0

      CALL DATE_AND_TIME(DATE=CURRENT_DATE)
      CALL DATE_AND_TIME(TIME=CURRENT_TIME)

      OPEN(UNIT=OUTPUT_UNIT, FILE=OUTPUT_FILE_NAME)

      WRITE(OUTPUT_UNIT,'(4(1x,a))') &
                           'Output from TEST_INTERVAL_SYSTEM on ', &
                           CURRENT_DATE(5:6)// &
                           "/"//CURRENT_DATE(7:8)// &
                           "/"//CURRENT_DATE(1:4), ' at ', &
                           CURRENT_TIME(1:2)// &
                           ":"//CURRENT_TIME(3:4)// &
                           ":"//CURRENT_TIME(5:6)//"."
      WRITE(OUTPUT_UNIT,'(I1)')

      X = INTERVAL(1,3)
      Y = INTERVAL(-4,-2)
      Z = INTERVAL(-3,2)
      W = INTERVAL(0,.5D0)
      R = 2D0
      I = 3
      ALL_TESTS_OK = .TRUE.
      TOL = 100D0*EPSILON(1D0)

      WRITE(OUTPUT_UNIT,'(1X,A)') 'X, Y, Z, W:'
      WRITE(OUTPUT_UNIT, '(2(1X,ES28.20E2))')  X
      WRITE(OUTPUT_UNIT, '(2(1X,ES28.20E2))')  Y
      WRITE(OUTPUT_UNIT, '(2(1X,ES28.20E2))')  Z
      WRITE(OUTPUT_UNIT, '(2(1X,ES28.20E2))')  W
      WRITE(OUTPUT_UNIT,'(1X,A)') 'R:'
      WRITE(OUTPUT_UNIT, '(1X,ES28.20E2)')  R
      WRITE(OUTPUT_UNIT,'(1X,A)') 'I:'
      WRITE(OUTPUT_UNIT, '(1X,I10)')  I
      WRITE(OUTPUT_UNIT,'(1X)')

      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Testing the four elementary operations and exponentiation ---'
      CALL CHECK_RESULT(X+Y,INTERVAL(-3,-1),'X+Y')
      CALL CHECK_RESULT(X-Y,INTERVAL(3,7),'X-Y')
      CALL CHECK_RESULT(X*Y,INTERVAL(-12,-2),'X*Y')
      CALL CHECK_RESULT(X/Y,INTERVAL(-1.5D0,-.25D0),'X/Y')

      CALL CHECK_RESULT(X+R,INTERVAL(3,5),'X+R')
      CALL CHECK_RESULT(R+X,INTERVAL(3,5),'R+X')
      CALL CHECK_RESULT(X-R,INTERVAL(-1,1),'X-R')
      CALL CHECK_RESULT(R-X,INTERVAL(-1,1),'R-X')
      CALL CHECK_RESULT(X*R,INTERVAL(2,6),'X*R')
      CALL CHECK_RESULT(R*X,INTERVAL(2,6),'R*X')
      CALL CHECK_RESULT(X/R,INTERVAL(0.5D0,1.5D0),'X/R')
      CALL CHECK_RESULT(R/X,&
       INTERVAL(0.666666666666666666666666666667D0,2),'R/X')

      CALL CHECK_RESULT(X+I,INTERVAL(4,6),'X+I')
      CALL CHECK_RESULT(I+X,INTERVAL(4,6),'I+X')
      CALL CHECK_RESULT(X-I,INTERVAL(-2,0),'X-I')
      CALL CHECK_RESULT(I-X,INTERVAL(0,2),'I-X')
      CALL CHECK_RESULT(X*I,INTERVAL(3,9),'X*I')
      CALL CHECK_RESULT(I*X,INTERVAL(3,9),'I*X')
      CALL CHECK_RESULT(X/I,&
       INTERVAL(0.333333333333333333333333333333D0,1),'X/I')
      CALL CHECK_RESULT(I/X,INTERVAL(1,3),'I/X')

      CALL CHECK_RESULT(X**Y,&
       INTERVAL(0.123456790123456790123456790123D0,1),'X**Y')
      CALL CHECK_RESULT(X**I,INTERVAL(1,27),'X**I')
      CALL CHECK_RESULT(I**X,INTERVAL(3,27),'I**X')
      CALL CHECK_RESULT(X**R,INTERVAL(1,9),'X**R')
      CALL CHECK_RESULT(R**X,INTERVAL(2,8),'R**X')


      WRITE(OUTPUT_UNIT,'(1X,A)') 'Testing X <-- X op X ---'
      XX = X;  XX = XX + XX
      CALL CHECK_RESULT(XX,INTERVAL(2,6),'X=X+X')
      XX = X;  XX = XX - XX
      CALL CHECK_RESULT(XX,INTERVAL(-2,2),'X=X-X')
      XX = X;  XX = XX * XX
      CALL CHECK_RESULT(XX,INTERVAL(1,9),'X=X*X')
      XX = X;  XX = XX / XX
      CALL CHECK_RESULT(XX,&
       INTERVAL(0.333333333333333333333333333333D0,3D0),'X=X/X')

      WRITE(OUTPUT_UNIT,'(1x,a)') &
          'Testing all cases of multiplication ---'
      CALL CHECK_RESULT(INTERVAL(1,3)*INTERVAL(2,4),&
       INTERVAL(2,12), 'Multiplication case 1--- [1,3]*[2,4]')
      CALL CHECK_RESULT(INTERVAL(-1,3)*INTERVAL(2,4),&
       INTERVAL(-4,12), 'Multiplication case 2--- [-1,3]*[2,4]')
      CALL CHECK_RESULT(INTERVAL(-2,-1)*INTERVAL(3,4),&
       INTERVAL(-8,-3), 'Multiplication case 3--- [-2,-1]*[3,4]')
      CALL CHECK_RESULT(INTERVAL(1,2)*INTERVAL(-1,1),&
       INTERVAL(-2,2), 'Multiplication case 4--- [1,2]*[-1,1]')
      CALL CHECK_RESULT(INTERVAL(-2,2)*INTERVAL(-1,1),&
       INTERVAL(-2,2), 'Multiplication case 5--- [-2,2]*[-1,1]')
      CALL CHECK_RESULT(INTERVAL(-2,-1)*INTERVAL(1,2),&
       INTERVAL(-4,-1), 'Multiplication case 6--- [-2,-1]*[1,2]')
      CALL CHECK_RESULT(INTERVAL(-1,1)*INTERVAL(-2,-1),&
       INTERVAL(-2,2), 'Multiplication case 7--- [-1,1]*[-2,-1]')
      CALL CHECK_RESULT(INTERVAL(-2,-1)*INTERVAL(-4,-3),&
       INTERVAL(3,8), 'Multiplication case 8--- [-2,-1]*[-4,-3]')
      CALL CHECK_RESULT(INTERVAL(-3,1)*INTERVAL(-2,3),&
       INTERVAL(-9,6), 'Multiplication case 9--- [-3,1]*[-2,3]')

      CALL CHECK_RESULT(INTERVAL(-1,5)*INTERVAL(-1,1),&
       INTERVAL(-5,5), '[-1,5]*[-1,1]')

      WRITE(OUTPUT_UNIT,'(1X,A)') 'Additional testing of X<--X*X ---'
      XX = INTERVAL(-3,-1); XX = XX*XX
      CALL CHECK_RESULT(XX,INTERVAL(1,9),&
       'Case 8 of multiplication, U=U*U with U=[-3,-1]')
      XX = INTERVAL(-3,1); XX = XX*XX
      CALL CHECK_RESULT(XX,INTERVAL(-3,9),&
       'Case 9 of multiplication, U=U*U with U=[-3,1]')

      WRITE(OUTPUT_UNIT,'(1X,A)') 'Testing double*interval ---'
      CALL CHECK_RESULT(2.0D0*INTERVAL(0,3),INTERVAL(0,6),&
       '2*[0,3]')
      CALL CHECK_RESULT(-2.0D0*INTERVAL(0,3),INTERVAL(-6,0), &
       '-2*[0,3]')
      CALL CHECK_RESULT(2.0D0*INTERVAL(-3,0),INTERVAL(-6,0), &
       '2*[-3,0]')
      CALL CHECK_RESULT(-2.0D0*INTERVAL(-3,0),INTERVAL(0,6), &
       '-2*[-3,0]')
      CALL CHECK_RESULT(2.0D0*INTERVAL(1,3),INTERVAL(2,6), &
       '2*[1,3]')
      CALL CHECK_RESULT(-2.0D0*INTERVAL(1,3),INTERVAL(-6,-2), &
       '-2*[1,3]')

      WRITE(OUTPUT_UNIT,'(1X,A)') &
         'Testing additional cases of division ---'
        CALL CHECK_RESULT(Y/X, &
       INTERVAL(-4,-0.666666666666666666666666666667D0),'Y/X')
      XX = Y; XX = XX/XX
      CALL CHECK_RESULT(XX,INTERVAL(0.5D0,2D0),'Y<--Y/Y')

      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Testing MAG, WID, MID, MIG, ABS ---'
      CALL CHECK_REAL_RESULT(MAG(X),3D0,'MAG(X)')
      CALL CHECK_REAL_RESULT(MAG(Y),4D0,'MAG(Y)')
      CALL CHECK_REAL_RESULT(MAG(Z),3D0,'MAG(Z)')
      CALL CHECK_REAL_RESULT(WID(X),2D0,'WID(X)')
      CALL CHECK_REAL_RESULT(MID(X),2D0,'MID(X)')
      CALL CHECK_REAL_RESULT(MIG(X),1D0,'MIG(X)')
      CALL CHECK_REAL_RESULT(MIG(Y),2D0,'MIG(Y)')
      CALL CHECK_REAL_RESULT(MIG(Z),0D0,'MIG(Z)')
      CALL CHECK_RESULT(ABS(X),INTERVAL(1,3),'ABS(X)')
      CALL CHECK_RESULT(ABS(Y),INTERVAL(2,4),'ABS(Y)')
      CALL CHECK_RESULT(ABS(Z),INTERVAL(0,3),'ABS(Z)')

      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Testing MAX, MIN ---'
      CALL CHECK_RESULT(MAX(X,Z),INTERVAL(1,3),'MAX(X,Z)')
      CALL CHECK_RESULT(MAX(X,R),INTERVAL(2,3),'MAX(X,R)')

      CALL CHECK_RESULT(MAX(R,X),INTERVAL(2,3),'MAX(R,X)')
      CALL CHECK_RESULT(MAX(X,I),INTERVAL(3,3),'MAX(X,I)')
      CALL CHECK_RESULT(MAX(I,X),INTERVAL(3,3),'MAX(I,X)')

      CALL CHECK_RESULT(MIN(X,Z),INTERVAL(-3,2),'MIN(X,Z)')
      CALL CHECK_RESULT(MIN(X,R),INTERVAL(1,2),'MIN(X,R)')

      CALL CHECK_RESULT(MIN(R,X),INTERVAL(1,2),'MIN(R,X)')
      CALL CHECK_RESULT(MIN(X,I),INTERVAL(1,3),'MIN(X,I)')
      CALL CHECK_RESULT(MIN(I,X),INTERVAL(1,3),'MIN(I,X)')

      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Testing ACOS, ACOT, ASIN, ATAN ---'
      CALL CHECK_RESULT(ACOS(W), &
       INTERVAL(1.04719755119659774615421446109D0, &
                1.57079632679489661923132169164D0),'ACOS(W)')
      CALL CHECK_RESULT(ACOT(W), &
       INTERVAL(1.10714871779409050301706546018D0, &
                1.57079632679489661923132169164D0),'ACOT(W)')
      CALL CHECK_RESULT(ASIN(W), &
       INTERVAL(0, &
                0.523598775598298873077107230547D0),'ASIN(W)')
      CALL CHECK_RESULT(ATAN(W), &
       INTERVAL(0, &
                0.463647609000806116214256231461D0),'ATAN(W)')

      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Testing COS, COT, EXP, LOG, SIN, SQRT, TAN, SINH ---'
      CALL CHECK_RESULT(COS(ACOS(W)),W,'COS(ACOS(W))')
      CALL CHECK_RESULT(COT(ACOT(W)),W,'COT(ACOT(W))')
      CALL CHECK_RESULT(EXP(X), &
       INTERVAL(2.71828182845904523536028747135D0, &
                20.0855369231876677409285296546D0),'EXP(X)')
      CALL CHECK_RESULT(LOG(EXP(X)),X,'LOG(EXP(X))')
      CALL CHECK_RESULT(SIN(ASIN(W)),W,'SIN(ASIN(W))')
      CALL CHECK_RESULT(SQRT(X**2),X,'SQRT(X**2)')
      CALL CHECK_RESULT(TAN(ATAN(W)),W,'TAN(ATAN(W))')
      CALL CHECK_RESULT(SINH(X), &
       INTERVAL(1.17520119364380145688238185060D0, &
                10.0178749274099018989745936195D0),'SINH(X)')

      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Testing .IS. and .CH. ---'
      CALL CHECK_RESULT(X.IS.Z,INTERVAL(1,2),'X.IS.Z')
      CALL CHECK_RESULT(X.CH.Y,INTERVAL(-4,3),'X.CH.Y')
      CALL CHECK_RESULT(Y.CH.R,INTERVAL(-4,2),'Y.CH.R')
      CALL CHECK_RESULT(R.CH.Y,INTERVAL(-4,2),'R.CH.Y')
      CALL CHECK_RESULT(Y.CH.I,INTERVAL(-4,3),'Y.CH.I')
      CALL CHECK_RESULT(I.CH.Y,INTERVAL(-4,3),'I.CH.Y')
      CALL CHECK_RESULT(1D0.CH.2D0,INTERVAL(1,2),'1D0.CH.2D0')
      CALL CHECK_RESULT(3.CH.4,INTERVAL(3,4),'3.CH.4')
      CALL CHECK_RESULT(1.CH.2D0,INTERVAL(1,2),'1.CH.2D0')
      CALL CHECK_RESULT(3D0.CH.4,INTERVAL(3,4),'3D0,.CH.4')

      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Testing .SB., .SP., .DJ., and .IN. ---'
      CALL CHECK_LOGICAL_RESULT(W.SB.Z,.TRUE.,'W.SB.Z')
      CALL CHECK_LOGICAL_RESULT(X.SB.Z,.FALSE.,'X.SB.Z')
      CALL CHECK_LOGICAL_RESULT(Z.SP.W,.TRUE.,'Z.SP.W')
      CALL CHECK_LOGICAL_RESULT(X.DJ.Y,.TRUE.,'X.DJ.Y')
      CALL CHECK_LOGICAL_RESULT(X.DJ.Z,.FALSE.,'X.DJ.Z')
      CALL CHECK_LOGICAL_RESULT(R.IN.X,.TRUE.,'R.IN.X')
      CALL CHECK_LOGICAL_RESULT(I.IN.X,.TRUE.,'I.IN.X')

      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Testing .LT., .GT., .LE., .GE., .EQ., and .NE. ---'
      CALL CHECK_LOGICAL_RESULT(Y.LT.X,.TRUE.,'Y.LT.X')
      CALL CHECK_LOGICAL_RESULT(Y.LT.R,.TRUE.,'Y.LT.R')
      CALL CHECK_LOGICAL_RESULT(R.LT.Y,.FALSE.,'R.LT.Y')
      CALL CHECK_LOGICAL_RESULT(I.LT.X,.FALSE.,'I.LT.X')
      CALL CHECK_LOGICAL_RESULT(X.LT.I,.FALSE.,'X.LT.I')

      CALL CHECK_LOGICAL_RESULT(Z.GT.X,.FALSE.,'Z.GT.X')
      CALL CHECK_LOGICAL_RESULT(Y.GT.R,.FALSE.,'Y.GT.R')
      CALL CHECK_LOGICAL_RESULT(R.GT.Y,.TRUE.,'R.GT.Y')
      CALL CHECK_LOGICAL_RESULT(I.GT.Y,.TRUE.,'I.GT.Y')
      CALL CHECK_LOGICAL_RESULT(Y.GT.I,.FALSE.,'Y.GT.I')

      CALL CHECK_LOGICAL_RESULT(Y.LE.X,.TRUE.,'Y.LE.X')
      CALL CHECK_LOGICAL_RESULT(Y.LE.R,.TRUE.,'Y.LE.R')
      CALL CHECK_LOGICAL_RESULT(R.LE.Y,.FALSE.,'R.LE.Y')
      CALL CHECK_LOGICAL_RESULT(I.LE.X,.FALSE.,'I.LE.X')
      CALL CHECK_LOGICAL_RESULT(X.LE.I,.TRUE.,'X.LE.I')

      CALL CHECK_LOGICAL_RESULT(Z.GE.X,.FALSE.,'Z.GE.X')
      CALL CHECK_LOGICAL_RESULT(Y.GE.R,.FALSE.,'Y.GE.R')
      CALL CHECK_LOGICAL_RESULT(R.GE.Y,.TRUE.,'R.GE.Y')
      CALL CHECK_LOGICAL_RESULT(I.GE.Y,.TRUE.,'I.GE.Y')
      CALL CHECK_LOGICAL_RESULT(Y.GE.I,.FALSE.,'Y.GE.I')

      CALL CHECK_LOGICAL_RESULT(X.EQ.X,.TRUE.,'X.EQ.X')
      CALL CHECK_LOGICAL_RESULT(Y.EQ.X,.FALSE.,'Y.EQ.X')
      CALL CHECK_LOGICAL_RESULT(Y.EQ.R,.FALSE.,'Y.EQ.R')
      CALL CHECK_LOGICAL_RESULT(R.EQ.Y,.FALSE.,'R.EQ.Y')
      CALL CHECK_LOGICAL_RESULT(I.EQ.X,.FALSE.,'I.EQ.X')
      CALL CHECK_LOGICAL_RESULT(X.EQ.I,.FALSE.,'X.EQ.I')

      CALL CHECK_LOGICAL_RESULT(X.NE.X,.FALSE.,'X.NE.X')
      CALL CHECK_LOGICAL_RESULT(Y.NE.X,.TRUE.,'Y.NE.X')
      CALL CHECK_LOGICAL_RESULT(Y.NE.R,.TRUE.,'Y.NE.R')
      CALL CHECK_LOGICAL_RESULT(R.NE.Y,.TRUE.,'R.NE.Y')
      CALL CHECK_LOGICAL_RESULT(I.NE.X,.TRUE.,'I.NE.X')
      CALL CHECK_LOGICAL_RESULT(X.NE.I,.TRUE.,'X.NE.I')

      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Testing INF and SUP ---'
      CALL CHECK_REAL_RESULT(INF(X),1D0,'INF(X)')
      CALL CHECK_REAL_RESULT(SUP(X),3D0,'SUP(X)')

      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Additional testing of .CH. dealing with empty intervals ---'
      CALL CHECK_RESULT(INTERVAL(2,1).CH.INTERVAL(1,-1), &
       INTERVAL(1,-1),'[2,1].CH.[1,-1]')
      CALL CHECK_RESULT(INTERVAL(2,1).CH.INTERVAL(-1,1), &
       INTERVAL(-1,1),'[2,1].CH.[-1,1]')
      CALL CHECK_RESULT(INTERVAL(1,2).CH.INTERVAL(1,-1), &
       INTERVAL(1,2),'[1,2].CH.[1,-1]')

      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Testing some implicit conversions ---'
      XX = 1
      CALL CHECK_RESULT(XX,INTERVAL(1,1),'[1,1]<-- 1')
      XX = 1D0
      CALL CHECK_RESULT(XX,INTERVAL(1,1), '[1,1]<-- 1D0')

      WRITE(OUTPUT_UNIT,'(1X,A)') &
         'Additional testing of mixed mode multiplication ---'
      XX = INTERVAL(-1,1)
      RR = 0D0
      CALL CHECK_RESULT(RR*XX,INTERVAL(0,0),'0*[-1,1]')
      XX = INTERVAL(0,1)
      RR = -1D0
      CALL CHECK_RESULT(RR*XX,INTERVAL(-1,0),'-1*[0,1]')
      RR = 1D0
      CALL CHECK_RESULT(RR*XX,INTERVAL(0,1),'1*[0,1]')
      XX = INTERVAL(-1,0)
      RR = -1D0
      CALL CHECK_RESULT(RR*XX,INTERVAL(0,1),'-1*[-1,0]')
      RR = 1D0
      CALL CHECK_RESULT(RR*XX,INTERVAL(-1,0),'1*[-1,0]')
      XX = INTERVAL(2,3); RR = -1D0
      CALL CHECK_RESULT(RR*XX,INTERVAL(-3,-2),'-1*[2,3]')

      WRITE(OUTPUT_UNIT,'(I1)')
      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Check the conversion function:'
      WRITE(OUTPUT_UNIT,'(I1)')
      WRITE(OUTPUT_UNIT,'(1X,A)') 'IVL(.3D0):'
      WRITE(OUTPUT_UNIT, '(2(1X,ES28.20E2))')  IVL(.3D0)
      CALL CHECK_RESULT(IVL(.3D0),INTERVAL(.3D0,.3D0),'IVL(.3D0)')
      WRITE(OUTPUT_UNIT,'(1X,A)') 'IVL(.3D0,.6D0):'
      WRITE(OUTPUT_UNIT, '(2(1X,ES28.20E2))')  IVL(.3D0,.6D0)
      CALL CHECK_RESULT(IVL(.3D0,.6D0),INTERVAL(.3D0,.6D0), &
       'IVL(.3D0,.6D0)')
      WRITE(OUTPUT_UNIT,'(1X,A)') 'IVL(1,2):'
      WRITE(OUTPUT_UNIT, '(2(1X,ES28.20E2))')  IVL(1,2)
      CALL CHECK_RESULT(IVL(1,2),INTERVAL(1,2),'IVL(1,2)')
      WRITE(OUTPUT_UNIT,'(1X,A)') 'IVL(1):'
      WRITE(OUTPUT_UNIT, '(2(1X,ES28.20E2))')  IVL(1)
      CALL CHECK_RESULT(IVL(1),INTERVAL(1,1),'IVL(1)')
      WRITE(OUTPUT_UNIT,'(1X,A)') 'IVL(.3D0,1):'
      WRITE(OUTPUT_UNIT, '(2(1X,ES28.20E2))')  IVL(.3D0,1)
      CALL CHECK_RESULT(IVL(.3D0,1),INTERVAL(.3D0,1),'IVL(.3D0,1)')
      WRITE(OUTPUT_UNIT,'(1X,A)') 'IVL(1,3.1D0):'
      WRITE(OUTPUT_UNIT, '(2(1X,ES28.20E2))')  IVL(1,3.1D0)
      CALL CHECK_RESULT(IVL(1,3.1D0),INTERVAL(1,3.1D0),&
       'IVL(1,3.1D0)')
      WRITE(OUTPUT_UNIT,'(1X,A)') 'IVL(X):'
      WRITE(OUTPUT_UNIT, '(2(1X,ES28.20E2))')  IVL(X)
      CALL CHECK_RESULT(IVL(X),X,'IVL(X)')
      WRITE(OUTPUT_UNIT,'(I1)')

      WRITE(OUTPUT_UNIT,'(I1)')
      WRITE(OUTPUT_UNIT,'(1x,A)') &
         'Check RNDOUT near underflow and overflow thresholds:'
      WRITE(OUTPUT_UNIT,'(I1)')
      WRITE(OUTPUT_UNIT,'(1x,A)') '[TINY,1]/[5,6]:'
      WRITE(OUTPUT_UNIT, '(2(1X,ES28.20E2))') &
             INTERVAL(TINY,1)/INTERVAL(5,6)
      WRITE(OUTPUT_UNIT,'(I1)')
      WRITE(OUTPUT_UNIT,'(1x,A)') '[-1,-TINY]/[5,6]:'
      WRITE(OUTPUT_UNIT, '(2(1X,ES28.20E2))') &
             INTERVAL(-1,-TINY)/INTERVAL(5,6)

      WRITE(OUTPUT_UNIT,'(I1)')
      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Precipitate a division error by trying [1,2]/[-1,1]:'
      XX = INTERVAL(1,2)/INTERVAL(-1,1)

      WRITE(OUTPUT_UNIT,'(I1)')
      WRITE(OUTPUT_UNIT,'(1X,A)') &
       'Precipitate an error by trying [1,2].IS.[3,4]:'
      XX = INTERVAL(1,2).IS.INTERVAL(3,4)

      WRITE(OUTPUT_UNIT,'(I1)')

      IF(ALL_TESTS_OK) THEN
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         'All tests completed satisfactorily.  Module'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         'INTERVAL_ARITHMETIC appears to be installed correctly.'
      ELSE
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         'Some of the tests failed.  This could be due to one'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         'or more of the following:'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '1. The machine constant routine D1MACH is not installed'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '   properly in the Fortran 77 package INTLIB.  See the'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '   Fortran 90 version with this package.'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '2. The arithmetic is not IEEE arithmetic, and the value'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '   MAXERR in INTLIB routine SIMINI should be some number'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '   other than 1.'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '3. The "exact result" in the testing routine is'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '   represented as as two double precision numbers.'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '   Conversion to the internal representation may not'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '   be as exact as the interval operations.'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '4. Some "exact results" are irrational numbers, and are'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '   represented to only 30 digits.  If double precision'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '   contains more than 30 digits, then the "exact result"'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '   may not be sufficiently precise.  In this case, the'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '   constants in the testing routine "testsys.f90" should'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '   be made more precise.  (In this case, the INTLIB'
         WRITE(OUTPUT_UNIT,'(1X,A)') &
         '   constants in SIMINI should also be made more precise.)'
      END IF

      CLOSE(OUTPUT_UNIT)

CONTAINS

   SUBROUTINE CHECK_RESULT(A,B,STRING)
      TYPE(INTERVAL) :: A, B
      CHARACTER(LEN=*) STRING
      LOGICAL CHECKS_OUT

      CHECKS_OUT = A%LOWER.LE.B%LOWER .AND. A%UPPER.GE.B%UPPER

      IF(.NOT.CHECKS_OUT) THEN
         ALL_TESTS_OK = .FALSE.
         WRITE(OUTPUT_UNIT,'(2(1X,A))') STRING, &
            'did not contain the exact result.'
         WRITE(OUTPUT_UNIT,'(5X,A)') 'COMPUTED RESULT:'
         WRITE(OUTPUT_UNIT, '(5X,2(1X,ES28.20E2))') A
         WRITE(OUTPUT_UNIT,'(5X,A)') 'EXACT_RESULT:'
         WRITE(OUTPUT_UNIT, '(5X,2(1X,ES28.20E2))') B
      END IF

   END SUBROUTINE CHECK_RESULT

   SUBROUTINE CHECK_REAL_RESULT(A,B,STRING)
      DOUBLE PRECISION :: A, B
      CHARACTER(LEN=*) STRING
      LOGICAL CHECKS_OUT

      CHECKS_OUT = ABS(B-A).LT.TOL*MAX(ABS(A),1D0)

      IF(.NOT.CHECKS_OUT) THEN
         ALL_TESTS_OK = .FALSE.
         WRITE(OUTPUT_UNIT,'(2(1X,A))') STRING, &
            'was not approximately equal to the exact result.'
         WRITE(OUTPUT_UNIT,'(5X,A,1X,ES28.20E2)') 'COMPUTED RESULT:', A
         WRITE(OUTPUT_UNIT,'(5X,A,1X,ES28.20E2)') '   EXACT_RESULT:', B
      END IF

   END SUBROUTINE CHECK_REAL_RESULT

   SUBROUTINE CHECK_LOGICAL_RESULT(A,B,STRING)
      LOGICAL :: A, B
      CHARACTER(LEN=*) STRING
      LOGICAL CHECKS_OUT

      CHECKS_OUT = A .EQV. B

      IF(.NOT.CHECKS_OUT) THEN
         ALL_TESTS_OK = .FALSE.
         WRITE(OUTPUT_UNIT,'(2(1X,A))') STRING, &
            'was not correct.'
         WRITE(OUTPUT_UNIT,'(5X,A,1X,L1)') 'COMPUTED RESULT:', A
         WRITE(OUTPUT_UNIT,'(5X,A,1X,L1)') '   EXACT_RESULT:', B
      END IF

   END SUBROUTINE CHECK_LOGICAL_RESULT


END PROGRAM TEST_INTERVAL_SYSTEM
SHAR_EOF
fi # end of overwriting check
if test -f 'tinysmpl.out'
then
	echo shar: will not over-write existing file "'tinysmpl.out'"
else
cat << \SHAR_EOF > 'tinysmpl.out'
    4.000E+00    6.000E+00
    1.000E+00    8.000E+00
    1.000E+00    1.600E+01
   -4.161E-01    5.403E-01
    1.000E+00    4.000E+00
    5.403E-01
   -4.161E-01
 T F
SHAR_EOF
fi # end of overwriting check
cd ..
cd ..
#	End of shell archive
exit 0