C      ALGORITHM 705, COLLECTED ALGORITHMS FROM ACM.
C      THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE,
C      VOL. 18, NO. 2, PP. 232-238.
C      Remark: VOL. 28, NO. 3. PP. 372-375
#! /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/
#	Doc/Makefile
#	Doc/Makefile.Dp
#	Doc/PackingList
#	Doc/doc
#	Fortran77/
#	Fortran77/Dp/
#	Fortran77/Dp/Drivers/
#	Fortran77/Dp/Drivers/data4
#	Fortran77/Dp/Drivers/data5
#	Fortran77/Dp/Drivers/data6
#	Fortran77/Dp/Drivers/dr_subs.f
#	Fortran77/Dp/Drivers/driver1.f
#	Fortran77/Dp/Drivers/driver2.f
#	Fortran77/Dp/Drivers/driver3.f
#	Fortran77/Dp/Drivers/driver4.f
#	Fortran77/Dp/Drivers/driver5.f
#	Fortran77/Dp/Drivers/driver6.f
#	Fortran77/Dp/Drivers/driver7.f
#	Fortran77/Dp/Drivers/driver8.f
#	Fortran77/Dp/Drivers/driver9.f
#	Fortran77/Dp/Drivers/portrand.f
#	Fortran77/Dp/Drivers/res1
#	Fortran77/Dp/Drivers/res2
#	Fortran77/Dp/Drivers/res3
#	Fortran77/Dp/Drivers/res4
#	Fortran77/Dp/Drivers/res5
#	Fortran77/Dp/Drivers/res6
#	Fortran77/Dp/Drivers/res7
#	Fortran77/Dp/Drivers/res8
#	Fortran77/Dp/Drivers/res9
#	Fortran77/Dp/Src/
#	Fortran77/Dp/Src/blas1.f
#	Fortran77/Dp/Src/linpack.f
#	Fortran77/Dp/Src/port.f
#	Fortran77/Dp/Src/src.f
# This archive created: Wed Oct 16 14:43:51 2002
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'

# Fortran compiler and linker
F77         = epcf90
F77OPTS     = -sloppy -C -d5 -g -temp=/tmp -u
F77LINK     = $(F77)
F77LINKOPTS = $(F77OPTS)

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

all: res1 res2 res3 res4 res5 res6 res7 res8 res9

Objs1= driver1.o dr_subs.o src.o port.o portrand.o linpack.o blas1.o

src.o:  ../Src/src.f
	$(F77) $(F77OPTS) -c $?
port.o: ../Src/port.f
	$(F77) $(F77OPTS) -c $?
blas1.o: ../Src/blas1.f
	$(F77) $(F77OPTS) -c $?
linpack.o: ../Src/linpack.f
	$(F77) $(F77OPTS) -c $?

driver1: $(Objs1)
	$(F77LINK) $(F77LINKOPTS) -o driver1 $(Objs1) $(SRCLIBS) $(Libs1)
res1: driver1  
	driver1  >temp 
	diff temp res1


Libs2= $(RANDOM)
Objs2= driver2.o dr_subs.o src.o port.o portrand.o linpack.o blas1.o

driver2: $(Objs2)
	$(F77LINK) $(F77LINKOPTS) -o driver2 $(Objs2) $(SRCLIBS) $(Libs2)
res2: driver2  
	driver2  >temp 
	diff temp res2


Libs3= $(RANDOM)
Objs3= driver3.o dr_subs.o src.o port.o portrand.o linpack.o blas1.o

driver3: $(Objs3)
	$(F77LINK) $(F77LINKOPTS) -o driver3 $(Objs3) $(SRCLIBS) $(Libs3)
res3: driver3  
	driver3  >temp 
	diff temp res3


Libs4= $(RANDOM)
Objs4= driver4.o dr_subs.o src.o port.o portrand.o linpack.o blas1.o

driver4: $(Objs4)
	$(F77LINK) $(F77LINKOPTS) -o driver4 $(Objs4) $(SRCLIBS) $(Libs4)
res4: driver4 data4 
	driver4 <data4 >temp 
	diff temp res4


Libs5= $(RANDOM)
Objs5= driver5.o dr_subs.o src.o port.o portrand.o linpack.o blas1.o

driver5: $(Objs5)
	$(F77LINK) $(F77LINKOPTS) -o driver5 $(Objs5) $(SRCLIBS) $(Libs5)
res5: driver5 data5 
	driver5 <data5 >temp 
	diff temp res5


Libs6= $(RANDOM)
Objs6= driver6.o dr_subs.o src.o port.o portrand.o linpack.o blas1.o

driver6: $(Objs6)
	$(F77LINK) $(F77LINKOPTS) -o driver6 $(Objs6) $(SRCLIBS) $(Libs6)
res6: driver6 data6 
	driver6 <data6 >temp 
	diff temp res6


Libs7= $(RANDOM)
Objs7= driver7.o dr_subs.o src.o port.o portrand.o linpack.o blas1.o

driver7: $(Objs7)
	$(F77LINK) $(F77LINKOPTS) -o driver7 $(Objs7) $(SRCLIBS) $(Libs7)
res7: driver7  
	driver7  >temp 
	diff temp res7


Libs8= $(RANDOM)
Objs8= driver8.o dr_subs.o src.o port.o portrand.o linpack.o blas1.o

driver8: $(Objs8)
	$(F77LINK) $(F77LINKOPTS) -o driver8 $(Objs8) $(SRCLIBS) $(Libs8)
res8: driver8  
	driver8  >temp 
	diff temp res8


Libs9= $(RANDOM)
Objs9= driver9.o dr_subs.o src.o port.o portrand.o linpack.o blas1.o

driver9: $(Objs9)
	$(F77LINK) $(F77LINKOPTS) -o driver9 $(Objs9) $(SRCLIBS) $(Libs9)
res9: driver9  
	driver9  >temp 
	diff temp res9

clean:
	rm *.o driver? temp

SHAR_EOF
fi # end of overwriting check
if test -f 'Makefile.Dp'
then
	echo shar: will not over-write existing file "'Makefile.Dp'"
else
cat << "SHAR_EOF" > 'Makefile.Dp'
include makefile.inc
all: res1 res2 res3 res4 res5 res6 res7 res8 res9
SRCLIBS= $(LINPACK) $(BLAS) $(PORT)
Libs1= $(RANDOM)
Objs1= driver1.o dr_subs.o src.o

driver1: $(Objs1)
	$(F77LINK) $(F77LINKOPTS) -o driver1 $(Objs1) $(SRCLIBS) $(Libs1)
res1: driver1  
	driver1  >res1


Libs2= $(RANDOM)
Objs2= driver2.o dr_subs.o src.o

driver2: $(Objs2)
	$(F77LINK) $(F77LINKOPTS) -o driver2 $(Objs2) $(SRCLIBS) $(Libs2)
res2: driver2  
	driver2  >res2


Libs3= $(RANDOM)
Objs3= driver3.o dr_subs.o src.o

driver3: $(Objs3)
	$(F77LINK) $(F77LINKOPTS) -o driver3 $(Objs3) $(SRCLIBS) $(Libs3)
res3: driver3  
	driver3  >res3


Libs4= $(RANDOM)
Objs4= driver4.o dr_subs.o src.o

driver4: $(Objs4)
	$(F77LINK) $(F77LINKOPTS) -o driver4 $(Objs4) $(SRCLIBS) $(Libs4)
res4: driver4 data4 
	driver4 <data4 >res4


Libs5= $(RANDOM)
Objs5= driver5.o dr_subs.o src.o

driver5: $(Objs5)
	$(F77LINK) $(F77LINKOPTS) -o driver5 $(Objs5) $(SRCLIBS) $(Libs5)
res5: driver5 data5 
	driver5 <data5 >res5


Libs6= $(RANDOM)
Objs6= driver6.o dr_subs.o src.o

driver6: $(Objs6)
	$(F77LINK) $(F77LINKOPTS) -o driver6 $(Objs6) $(SRCLIBS) $(Libs6)
res6: driver6 data6 
	driver6 <data6 >res6


Libs7= $(RANDOM)
Objs7= driver7.o dr_subs.o src.o

driver7: $(Objs7)
	$(F77LINK) $(F77LINKOPTS) -o driver7 $(Objs7) $(SRCLIBS) $(Libs7)
res7: driver7  
	driver7  >res7


Libs8= $(RANDOM)
Objs8= driver8.o dr_subs.o src.o

driver8: $(Objs8)
	$(F77LINK) $(F77LINKOPTS) -o driver8 $(Objs8) $(SRCLIBS) $(Libs8)
res8: driver8  
	driver8  >res8


Libs9= $(RANDOM)
Objs9= driver9.o dr_subs.o src.o

driver9: $(Objs9)
	$(F77LINK) $(F77LINKOPTS) -o driver9 $(Objs9) $(SRCLIBS) $(Libs9)
res9: driver9  
	driver9  >res9

clean:
	 rm *.o driver? temp
SHAR_EOF
fi # end of overwriting check
if test -f 'PackingList'
then
	echo shar: will not over-write existing file "'PackingList'"
else
cat << "SHAR_EOF" > 'PackingList'
Algorithm:705
Language:Fortran77
Precision:Dp
Src:src.f
SrcLibs:linpack blas port
Driver_0:driver1.f dr_subs.f @Src
DriverLib_0:random
Res_0:stdout=res1
Driver_1:driver2.f dr_subs.f @Src
DriverLib_1:random
Res_1:stdout=res2
Driver_2:driver3.f dr_subs.f @Src
DriverLib_2:random
Res_2:stdout=res3
Driver_3:driver4.f dr_subs.f @Src
DriverLib_3:random
Data_3:stdin=data4
Res_3:stdout=res4
Driver_4:driver5.f dr_subs.f @Src
DriverLib_4:random
Data_4:stdin=data5
Res_4:stdout=res5
Driver_5:driver6.f dr_subs.f @Src
DriverLib_5:random
Data_5:stdin=data6
Res_5:stdout=res6
Driver_6:driver7.f dr_subs.f @Src
DriverLib_6:random
Res_6:stdout=res7
Driver_7:driver8.f dr_subs.f @Src
DriverLib_7:random
Res_7:stdout=res8
Driver_8:driver9.f dr_subs.f @Src
DriverLib_8:random
Res_8:stdout=res9
SHAR_EOF
fi # end of overwriting check
if test -f 'doc'
then
	echo shar: will not over-write existing file "'doc'"
else
cat << "SHAR_EOF" > 'doc'
C      ALGORITHM 705, COLLECTED ALGORITHMS FROM ACM.
C      THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE,
C      VOL. 18, NO. 2, PP. 232-238.
README - software for solving Sylvester equations - double precision version
 
    sylg    solves   A*X*B' + C*X*D' = E
    sylgc   solves   A*X*E' + E*X*A' + Q = 0
    sylgd   solves   A*X*A' - E*X*E' + Q = 0
 
For the sylgx routines, we got (NRM RESID)/(NRM Q) to be about 1.0d-14 in
double precision (acc. = about 17 digits).  On a UNIX(tm) system one can
testa routine by "make"ing  the test routines (e.g. "make tsylgc").
 
Installation:  The programs driver1.f, driver2.f, driver3.f are
recommended as simple installation tests.  They are set up to run a
small number of example problems. 

Further testing:  The programs driver1.f, driver2.f, driver3.f will run
a larger set of tests if two lines are commented out and two others
uncommented, as noted in the code.  Programs driver4.f .. driver9.f are
also provided for those who wish to do more extensive testing. 

17Apr90  J. Gardiner, OSU CIS, Columbus, OH 43210  (614)881-4135
13Dec90  J. Gardiner, OSU CIS, Columbus, OH 43210  (614)881-4135
12Jan01  Tim Hopkins

------------------------------------------------------------------------

driver1.f         test the subroutine sylg using predefined problems
		Calls: sylg msave d1nrm msub mulc trnata; (linpack)
		dsvdc

driver2.f        test the subroutine sylgc using predefined problems
		Calls: sylgc madd mulc trnata d1nrm msave; (linpack)
		dsvdc

driver3.f        test the subroutine sylgd using predefined problems
		Calls: sylgd madd mulc trnata d1nrm msave; (linpack)
		dsvdc

driver4.f        test the subroutine sylg using matrices from a file
(data4)		Calls: sylg msave d1nrm msub mulc trnata; (linpack)
		dsvdc

driver5.f       test the subroutine sylgc using matrices from a file
(data5)		Calls: sylgc madd mulc trnata d1nrm msave; (linpack)
		dsvdc

driver6.f       test the subroutine sylgd using matrices from a file
(data6)		Calls: sylgd madd mulc trnata d1nrm msave; (linpack)
		dsvdc

driver7.f       test the subroutine sylg using randomly generated problems
		Calls: sylg msave d1nrm msub mulc trnata; (linpack)
		dsvdc

driver8.f       test the subroutine sylgc using randomly generated problems
		Calls: sylgc madd mulc trnata d1nrm msave; (linpack)
		dsvdc

driver9.f       test the subroutine sylgd using randomly generated problems
		Calls: sylgd madd mulc trnata d1nrm msave; (linpack)
		dsvdc

res1..res9	Sample output from each of the above drivers.
 

Routine descriptions
====================

bkcon           solve  S*Y*T' + T*Y*S' + R = 0
                Calls: (linpack) dgeco dgesl
 
bkdis           solve  S*Y*S' - T*Y*T' + R = 0
                Calls: (linpack) dgeco dgesl
 
bkhs2           solve P*Y*R' + S*Y*T' = F where P=up-Hess, R=up-tri, S=up-tri,
                T=quasi-up-tri
                Calls: hsco hsfa hssl; (linpack) ddot
 
d1nrm           compute 1-norm of a matrix
                Calls: -
 
hsco            Hessenberg version of Linpack dgeco
                Calls: hsfa; (linpack) daxpy ddot dscal dasum
 
hsfa            Hessenberg version of Linpack dgefa
                Calls: (linpack) daxpy dscal idamax
 
hssl            Hessenberg version of Linpack dgesl
                Calls: (linpack) daxpy ddot
 
ktran           transform an upper-Hessenberg to a matrix orthogonally
                similar to its transpose which is also upper-Hessenberg
                Calls: -
 
madd            adds two matrices
                Calls: -
 
mqfwo           computes the symmetric product x'sx
                Calls: mula
 
msave           copies a matrix
                Calls: -
 
mscale          scales a matrix by a scalar
                Calls: -
 
msub            subtracts two matrices
                Calls: -
 
mula            multiplies two matrices, product overwrites first
                Calls: -
 
mulb            multiplies two matrices, product overwrites second
                Calls: -
 
mulc            multiplies two matrices
                Calls: -
 
qzhesg          transform A to upper-Hessenberg, B to upper-triangular
                Calls: -
 
qzitg           transform A to quasi-upper-triangular keeping B upper-triangular
                Calls: (eispack) epslon
 
qzvalg          order off-diagonal elements of A to correspond to conjugate
                generalized eigenvalues
                Calls: -
 
sepg            computes approximately inf(1-norm(P*Y*R'+S*Y*T')/1-norm(Y))
                Calls: bkhs2 mscale ktran d1nrm
 
sepgc           computes approximately inf(1-norm(S*Y*T'+T*Y*S')/1-norm(Y))
                Calls: bkcon mscale ktran d1nrm
 
sepgd           computes approximately inf(1-norm(S*Y*S'-T*Y*T')/1-norm(Y))
                Calls: bkdis mscale ktran d1nrm
 
sylg            solve  A*X*B' + C*X*D' = E where A,B,C,D are square
                Calls: qzhesg qzitg qzvalg sepg bkhs2 mula mulb trnata
 
sylgc           solve  A*X*E' + E*X*A' + Q = 0  where Q is symmetric
                Calls: qzhesg qzitg qzvalg sepgc bkcon mqfwo mulb
 
sylgd           solve  A*X*A' - E*X*E' + Q = 0  where Q is symmetric
                Calls: qzhesg qzitg qzvalg sepgd bkdis mqfwo mulb

--- last line of README ---
SHAR_EOF
fi # end of overwriting check
cd ..
if test ! -d 'Fortran77'
then
	mkdir 'Fortran77'
fi
cd 'Fortran77'
if test ! -d 'Dp'
then
	mkdir 'Dp'
fi
cd 'Dp'
if test ! -d 'Drivers'
then
	mkdir 'Drivers'
fi
cd 'Drivers'
if test -f 'data4'
then
	echo shar: will not over-write existing file "'data4'"
else
cat << "SHAR_EOF" > 'data4'
2 1
 
0. 1.
0. 2.
 
2.
 
3. 4.
0. 0.
 
1.
 
-9.
-4.
y

SHAR_EOF
fi # end of overwriting check
if test -f 'data5'
then
	echo shar: will not over-write existing file "'data5'"
else
cat << "SHAR_EOF" > 'data5'
3
 
1. 2. 3.
6. -5. 4.
7. 8. 9.
 
-10. 20. -30.
41. -42. 43.
19. 18. 17.
 
18. 9. 7.
9. 17. 8.
7. 8. 16.
y
SHAR_EOF
fi # end of overwriting check
if test -f 'data6'
then
	echo shar: will not over-write existing file "'data6'"
else
cat << "SHAR_EOF" > 'data6'
5 3
 
1. 2. 3. 4. 5.
6. 7. 8. 9. 10.
11. 12. 13. 14. 15.
16. 17. 18. 19. 20.
21. 22. 23. 24. 25.
 
26. -27. 28.
-29. 30. -31.
32. -33. 34.
 
1. 0. 0. 0. 0.
1. 2. 1. 1. 1.
1. 1. 2. 1. 1.
1. 1. 1. 2. 1.
1. 1. 1. 1. 2.
 
199. 98. 97.
41. 142. 43.
59. 55. 151.
 
-80. 79. -78.
77. -76. 75.
-74. 73. -72.
71. -70. 69.
-68. 67. -66.
y
SHAR_EOF
fi # end of overwriting check
if test -f 'dr_subs.f'
then
	echo shar: will not over-write existing file "'dr_subs.f'"
else
cat << "SHAR_EOF" > 'dr_subs.f'
C--**--CH2894--705--A:1--28:10:1999
C--**--CH2879--705--P:R--28:10:1999
      DOUBLE PRECISION FUNCTION DGAUS(MEAN, STDDEV)
C
      DOUBLE PRECISION MEAN, STDDEV
C
C     THIS ROUTINE GENERATES NORMALLY DISTRIBUTED PSEUDORANDOM NUMBERS
C     WITH GIVEN MEAN AND STANDARD DEVIATION.
C     YOU MUST INITIALIZE DXRAND() WITH "X = DXRAND(I)" WHERE I>0.
C
C     WRITTEN -
C       14NOV86 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-3616
C     MODIFIED -
C       28NOV88 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
      EXTERNAL DXRAND
      DOUBLE PRECISION RBUF, V1, V2, S, DXRAND
      LOGICAL RBGOOD
      SAVE RBUF, RBGOOD
      DATA RBGOOD/.FALSE./
C
C     CHECK FOR RANDOM NUMBER LEFT OVER IN BUFFER
      IF (RBGOOD) THEN
         DGAUS = STDDEV*RBUF + MEAN
         RBGOOD = .FALSE.
         RETURN
      ENDIF
C
C     GET RANDOM VECTOR IN UNIT CIRCLE
   20 CONTINUE
         V1 = 2.0D0*DXRAND(0) - 1.0D0
         V2 = 2.0D0*DXRAND(0) - 1.0D0
         S = V1*V1 + V2*V2
      IF (S .GE. 1.0D0) GOTO 20
C
      S = SQRT(-2.0D0*LOG(S)/S)
      RBUF = V1*S
      RBGOOD = .TRUE.
      DGAUS = STDDEV*V2*S + MEAN
      RETURN
C --- LAST LINE OF DGAUS ---
      END
      SUBROUTINE MADD (NA,NB,NC,M,N,A,B,C)
C
C     *****PARAMETERS:
      INTEGER NA,NB,NC,M,N
      DOUBLE PRECISION A(NA,N),B(NB,N),C(NC,N)
C
C     *****LOCAL VARIABLES:
      INTEGER I,J
C
C     *****SUBROUTINES CALLED:
C     NONE
C
C     ------------------------------------------------------------------
C
C     *****PURPOSE:
C     THIS SUBROUTINE COMPUTES THE MATRIX SUM A+B AND STORES THE
C     RESULT IN THE ARRAY C.  ALL MATRICES ARE M X N.  THE SUM
C     MAY BE OVERWRITTEN INTO A (B) BY DESIGNATING THE ARRAY C
C     TO BE A (B).
C
C     *****PARAMETER DESCRIPTION:
C
C     ON INPUT:
C
C        NA,NB,NC         ROW DIMENSIONS OF THE ARRAYS CONTAINING A,B,
C                         AND C,RESPECTIVELY, AS DECLARED IN THE CALLING
C                         PROGRAM DIMENSION STATEMENT;
C
C        M                NUMBER OF ROWS OF THE MATRICES A, B, AND C;
C
C        N                NUMBER OF COLUMNS OF THE MATRICES A, B, AND C;
C
C        A                AN M X N MATRIX;
C
C        B                AN M X N MATRIX.
C
C     ON OUTPUT:
C
C        C                AN M X N ARRAY CONTAINING A+B.
C
C     *****HISTORY:
C     WRITTEN BY ALAN J. LAUB (ELEC. SYS. LAB., M.I.T., RM. 35-331,
C     CAMBRIDGE, MA 02139,  PH.: (617)-253-2125), SEPTEMBER 1977.
C     MOST RECENT VERSION: SEP. 21, 1977.
C
C     ------------------------------------------------------------------
C
      DO 20 J=1,N
         DO 10 I=1,M
            C(I,J)=A(I,J)+B(I,J)
10       CONTINUE
20    CONTINUE
      RETURN
C
C     LAST LINE OF MADD
C
      END
      SUBROUTINE MSAVE (NA,NAS,M,N,A,ASAVE)
C
C     *****PARAMETERS:
      INTEGER NA,NAS,M,N
      DOUBLE PRECISION A(NA,N),ASAVE(NAS,N)
C
C     *****LOCAL VARIABLES:
      INTEGER I,J
C
C     *****SUBROUTINES CALLED:
C     NONE
C
C     ------------------------------------------------------------------
C
C     *****PURPOSE:
C     THIS SUBROUTINE COPIES THE CONTENTS OF THE M X N ARRAY A INTO
C     THE M X N ARRAY ASAVE.
C
C     *****PARAMETER DESCRIPTION:
C
C     ON INPUT:
C
C        NA,NAS           ROW DIMENSIONS OF THE ARRAYS CONTAINING A AND
C                         AS, RESPECTIVELY, AS DECLARED IN THE CALLING
C                         PROGRAM DIMENSION STATEMENT;
C
C        M                NUMBER OF ROWS OF THE MATRICES A AND ASAVE;
C
C        N                NUMBER OF COLUMNS OF THE MATRICES A AND ASAVE;
C
C        A                AN M X N MATRIX.
C
C     ON OUTPUT:
C
C        ASAVE            AN M X N ARRAY CONTAINING THE ARRAY A.
C
C     *****HISTORY:
C     WRITTEN BY ALAN J. LAUB (ELEC. SYS. LAB., M.I.T., RM. 35-331,
C     CAMBRIDGE, MA 02139,  PH.: (617)-253-2125), SEPTEMBER 1977.
C     MOST RECENT VERSION: SEP. 21, 1977.
C
C     ------------------------------------------------------------------
C
      DO 20 J=1,N
         DO 10 I=1,M
            ASAVE(I,J)=A(I,J)
10       CONTINUE
20    CONTINUE
      RETURN
C
C     LAST LINE OF MSAVE
C
      END
      SUBROUTINE MSUB (NA,NB,NC,M,N,A,B,C)
C
C     *****PARAMETERS:
      INTEGER NA,NB,NC,M,N
      DOUBLE PRECISION A(NA,N),B(NB,N),C(NC,N)
C
C     *****LOCAL VARIABLES:
      INTEGER I,J
C
C     *****SUBROUTINES CALLED:
C     NONE
C
C     ------------------------------------------------------------------
C
C     *****PURPOSE:
C     THIS SUBROUTINE COMPUTES THE MATRIX DIFFERENCE A-B AND STORES
C     THE RESULT IN THE ARRAY C.  ALL MATRICES ARE M X N.  THE
C     DIFFERENCE MAY BE OVERWRITTEN INTO A BY DESIGNATING THE
C     ARRAY C TO BE A.
C
C     *****PARAMETER DESCRIPTION:
C
C     ON INPUT:
C
C        NA,NB,NC         ROW DIMENSIONS OF THE ARRAYS CONTAINING A,B,
C                         AND C, RESPECTIVELY, AS DECLARED IN THE
C                         CALLING PROGRAM DIMENSION STATEMENT;
C
C        M                NUMBER OF ROWS OF THE MATRICES A,B, AND C;
C
C        N                NUMBER OF COLUMNS OF THE MATRICES A,B, AND C;
C
C        A                AN M X N MATRIX;
C
C        B                AN M X N MATRIX.
C
C     ON OUTPUT:
C
C        C                AN M X N ARRAY CONTAINING A-B.
C
C     *****HISTORY:
C     WRITTEN BY ALAN J. LAUB (ELEC. SYS. LAB., M.I.T., RM. 35-331,
C     CAMBRIDGE, MA 02139,  PH.: (617)-253-2125), SEPTEMBER 1977.
C     MOST RECENT VERSION: SEP. 21, 1977.
C
C     ------------------------------------------------------------------
C
      DO 20 J=1,N
         DO 10 I=1,M
            C(I,J)=A(I,J)-B(I,J)
10       CONTINUE
20    CONTINUE
      RETURN
C
C     LAST LINE OF MSUB
C
      END
      SUBROUTINE MULC (NA,NB,NC,M,N,L,A,B,C)
C
C     *****PARAMETERS:
      INTEGER NA,NB,NC,L,M,N
      DOUBLE PRECISION A(NA,N),B(NB,L),C(NC,L)
C
C     *****LOCAL VARIABLES:
      INTEGER I,J,K
C
C     *****SUBROUTINES CALLED:
C     NONE
C
C     ------------------------------------------------------------------
C
C     *****PURPOSE:
C     THIS SUBROUTINE COMPUTES THE MATRIX PRODUCT A*B AND STORES THE
C        RESULT IN THE ARRAY C.  A IS M X N, B IS N X L, AND C IS
C        M X L.  THE ARRAY C MUST BE DISTINCT FROM BOTH A AND B.
C
C     *****PARAMETER DESCRIPTION:
C
C     ON INPUT:
C
C        NA    ROW DIMENSION OF THE ARRAY CONTAINING A AS DECLARED
C              IN THE CALLING PROGRAM DIMENSION STATEMENT;
C
C        NB    ROW DIMENSION OF THE ARRAY CONTAINING B AS DECLARED
C              IN THE CALLING PROGRAM DIMENSION STATEMENT;
C
C        NC    ROW DIMENSION OF THE ARRAY CONTAINING C AS DECLARED
C              IN THE CALLING PROGRAM DIMENSION STATEMENT;
C
C        L     NUMBER OF COLUMNS OF THE MATRICES B AND C;
C
C        M     NUMBER OF ROWS OF THE MATRICES A AND C;
C
C        N     NUMBER OF COLUMNS OF THE MATRIX A AND NUMBER OF ROWS
C              OF THE MATRIX B;
C
C        A     AN M X N MATRIX;
C
C        B     AN N X L MATRIX.
C
C     ON OUTPUT:
C
C        C     AN M X L ARRAY CONTAINING A*B.
C
C     *****HISTORY:
C     ORIGINAL BY ALAN J. LAUB
C     MODIFIED AND RENAMED BY JUDITH D. GARDINER
C
C     ------------------------------------------------------------------
C
      DO 40 J=1,L
         DO 10 I=1,M
            C(I,J)=0.0D0
10       CONTINUE
         DO 30 K=1,N
            DO 20 I=1,M
               C(I,J)=C(I,J)+A(I,K)*B(K,J)
20          CONTINUE
30       CONTINUE
40    CONTINUE
      RETURN
C
C     LAST CARD OF MULC
C
      END
      SUBROUTINE RANDM(A, LDA, M, N, DPAR, JOB)
C
      INTEGER LDA,N,M,JOB
      DOUBLE PRECISION A(LDA,N),DPAR(3)
C
C     THIS SUBROUTINE IS A GENERAL FACILITY FOR PRODUCING RANDOM MATRI-
C     CES.  SEE JOB PARAMETER FOR OPTIONS.  TO USE THIS ROUTINE DXRAND
C     -MUST- BE INITIALIZED BY THE USER.
C
C     ON ENTRY -
C       LDA     INTEGER
C               LEADING DECLARED DIMENSION OF  A.
C
C       M,N     INTEGER
C               ROW AND COLUMN DIMENSION OF  A , RESPECTIVELY.
C
C       DPAR    DOUBLE PRECISION (3)
C               AN ARRAY OF PARAMETERS (SEE JOB BELOW).
C
C       JOB     INTEGER
C               INTEGER IN DECIMAL FORM  ABCDE  INDICATING THE FOLLOWING
C                  A,B,C      (NOT USED, SHOULD BE SET TO ZERO)
C                  D .EQ. 0   MAKE RANDOM DENSE MATRICES
C                  D .EQ. 1   MAKE RANDOM SPARSE MATRICES WITH EACH
C                             ELEMENT HAVING PROBABILITY DPAR(3) OF
C                             BEING  ZERO.
C                  E .EQ. 0   USE UNIFORMLY DISTRIBUTED NUMBERS ON THE
C                             INTERVAL  [ DPAR(1), DPAR(2) ) .
C                  E .EQ. 1   USE GAUSSIAN RANDOMS WITH MEAN  DPAR(1),
C                             AND VARIANCE  DPAR(2).
C                  E .EQ. 2   USE EXPONENTIALLY DISTRIBUTED VARIABLES
C                             IN THE RANGE [ DPAR(1), DPAR(2) ).
C
C     ON RETURN -
C       A       DOUBLE PRECISION(LDA,N)
C               M BY N MATRIX OF RANDOMS
C
C     SUBROUTINES AND FUNCTIONS USED -
C       (MATU) DGAUS; (FORTRAN) MOD IDINT DXRAND;
C
C     WRITTEN -
C       18FEB87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-4691
C
      INTEGER I,J,ITYPE
      DOUBLE PRECISION DIFF,DM,DS,DA,DB,THRESH
      LOGICAL SPARSE
C
      EXTERNAL DXRAND
      DOUBLE PRECISION DXRAND,DGAUS
C
      ITYPE = MOD(JOB,10)
      THRESH = 0.0D0
      SPARSE = (MOD(JOB/10,10) .NE. 0)
C
      IF (ITYPE .NE. 0) GOTO 60
C        --- UNIFORM RANDOM ---
         DIFF = DPAR(2) - DPAR(1)
         DA = DPAR(1)
         IF (SPARSE) GOTO 30
            DO 20 J = 1,N
               DO 10 I = 1,M
                  A(I,J) = DIFF*DXRAND(0) + DA
   10          CONTINUE
   20       CONTINUE
         RETURN
   30    CONTINUE
            DO 50 J = 1,N
               DO 40 I = 1,M
                  A(I,J) = 0.0D0
                  IF (DXRAND(0) .GT. DPAR(3))
     *                A(I,J) = DIFF*DXRAND(0) + DA
   40          CONTINUE
   50       CONTINUE
         RETURN
   60 CONTINUE
      IF (ITYPE .NE. 1) GOTO 120
C        --- GAUSSIAN RANDOMS ---
         DM = DPAR(1)
         DS = DPAR(2)
         IF (SPARSE) GOTO 90
            DO 80 J = 1,N
               DO 70 I = 1,M
                     A(I,J) = DGAUS(DM,DS)
   70          CONTINUE
   80       CONTINUE
            RETURN
   90    CONTINUE
            DO 110 J = 1,N
               DO 100 I = 1,M
                  IF (DXRAND(0) .GT. DPAR(3))
     *               A(I,J) = DGAUS(DM,DS)
  100          CONTINUE
  110       CONTINUE
            RETURN
  120 CONTINUE
      IF (ITYPE .NE. 2) GOTO 180
C        --- EXPONENTIAL ---
         DA = DPAR(1)
         DB = LOG(DPAR(2)/DA)
         IF (SPARSE) GOTO 150
            DO 140 J = 1,N
               DO 130 I = 1,M
                  A(I,J) = DA*EXP(DB)
  130          CONTINUE
  140       CONTINUE
            RETURN
  150    CONTINUE
            DO 170 J = 1,N
               DO 160 I = 1,M
                  IF (DXRAND(0) .GT. THRESH)
     *               A(I,J) = DA*EXP(DB)
  160          CONTINUE
  170       CONTINUE
            RETURN
  180 CONTINUE
      RETURN
C
C --- LAST LINE OF RANDM ---
      END
      DOUBLE PRECISION FUNCTION DXRAND(I)
      INTEGER I
      REAL RAND
      IF (I .GT. 0) THEN
        CALL SEED(I)
        DXRAND = 0.0D0
      ELSE
        DXRAND = DBLE(RAND())
      ENDIF
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'driver1.f'
then
	echo shar: will not over-write existing file "'driver1.f'"
else
cat << "SHAR_EOF" > 'driver1.f'
C--**--CH2907--705--P:LAP--28:10:1999
C--**--CH2876--705--B:MA--28:10:1999
C--**--CH2862--705--A:H--28:10:1999
C     -- PROGRAM TSYLG --
C
C     THIS PROGRAM TESTS THE SOFTWARE FOR SOLVING THE GENERAL
C     SYLVESTER EQUATION
C
C        A * X * B' +  C * X * D' =  E    (' DENOTES TRANSPOSE)
C
C     USING A SET OF ILL-CONDITIONED EQUATIONS.  SEE "SOLUTION OF THE
C     SYLVESTER MATRIX EQUATION AXB'+CXD'=E" BY GARDINER, LAUB, AMATO,
C     AND MOLER FOR A DESCRIPTION OF THE TEST PROBLEMS.
C
C     THE SOLUTION IS CHECKED BY COMPUTING THE RESIDUAL AND ITS RELATIVE
C     1-NORM.  THE CONDITION ESTIMATE IS CHECKED FOR SMALL SYSTEMS ONLY
C     (M*N <= 40) BY FORMING THE KRONECKER PRODUCT MATRIX AND COMPUTING
C     ITS SINGULAR VALUE DECOMPOSITION.
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       SYLG; (LINPACK) DSVDC;
C       (MATU) MSAVE, D1NRM, MSUB, MULC, TRNATA
C
C     WRITTEN -
C       28NOV88 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C     REVISED -
C       17DEC90 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     -- MAXIMUM M IS 9, MAXIMUM N IS 8 --
      INTEGER NAC, NBD, NE, NW1, NW2, NW3, M, N, IERR
      INTEGER MMAX, NMAX, MNMAX, WRKLEN, MAXSVD
      PARAMETER (MMAX=9, NMAX=8, MNMAX=9, MAXSVD=40,
     +  WRKLEN = 2*MMAX*MMAX+NMAX*NMAX+NMAX*MMAX+7*MMAX+MNMAX*MNMAX)
      DOUBLE PRECISION A0(MMAX,MMAX), B0(NMAX,NMAX), C0(MMAX,MMAX),
     +                 D0(NMAX,NMAX), E0(MMAX,NMAX)
      DOUBLE PRECISION A1(MMAX,MMAX), B1(NMAX,NMAX), C1(MMAX,MMAX),
     +                 D1(NMAX,NMAX), E1(MMAX,NMAX)
      DOUBLE PRECISION WKM1(MMAX,NMAX), WKM2(MMAX,NMAX), 
     +                 WKM3(MAXSVD,MAXSVD), WKV(WRKLEN)
      INTEGER IWKV(2*MMAX)
C
      INTEGER I, J, II, JJ, INDX, JNDX, MXN
      INTEGER IDMY, KT
      DOUBLE PRECISION TMP, NRMR, NRME, WORST, RCOND, RCDSVD
      DOUBLE PRECISION DUMY(1), WORSTL, WORSTH, RATIO, S
      DOUBLE PRECISION D1NRM
C     --- OUTPUT UNIT FOR WRITE ---
      NAC = MMAX
      NBD = NMAX
      NE = MMAX
      NW1 = MMAX
      NW2 = MMAX
      NW3 = MAXSVD
C
C     -- INITIALIZE --
      WORST = 0.0D0
      WORSTL = 1.0D100
      WORSTH = 0.0D0
C
      WRITE(*,90000)
      WRITE(*,90001)
90000 FORMAT("             T        T")
90001 FORMAT(" SOLVE  A*X*B  + C*X*D  = E  USING SYLG")
C
C     USE THESE TWO LINES TO RUN A COMPLETE TEST
C
       DO 320 M = 2,NAC
       DO 310 N = 2,NBD
C
C     USE THESE TWO LINES TO RUN A MINIMAL INSTALLATION TEST
C
C     DO 320 M = 3,3
C     DO 310 N = 2,2
C
      WRITE(*,90005) M, N
C
90005 FORMAT(/ " M =", I3, "   N =", I3)
      DO 230 KT = 0,40,10
         S = (2.0D0)**(-KT)
C
C GENERATE COEFFICIENT MATRICES  --  TRUE SOLUTION IS MATRIX OF ALL ONES
C
         DO 120 I=1,M
            DO 110 J=1,I
               A0(I,J) = 1.0D0
               A0(J,I) = 0.0D0
               C0(J,I) = S
               C0(I,J) = 0.0D0
  110       CONTINUE
            A0(I,I) = I
            C0(I,I) = 1.0D0
  120    CONTINUE
C
         DO 140 I=1,N
            DO 130 J=1,I
               B0(J,I) = S
               B0(I,J) = 0.0D0
               D0(I,J) = 1.0D0
               D0(J,I) = 0.0D0
  130       CONTINUE
            B0(I,I) = 1.0D0
            D0(I,I) = S - (N-I+1)
  140    CONTINUE
C
         DO 160 I=1,M
            WKV(I) = 0.0D0
            WKV(M+I) = 0.0D0
            DO 150 J=1,M
               WKV(I) = WKV(I) + A0(I,J)
               WKV(M+I) = WKV(M+I) + C0(I,J)
  150       CONTINUE
  160    CONTINUE
         DO 190 I=1,N
            TMP = 0.0D0
            DUMY(1) = 0.0D0
            DO 170 J=1,N
               TMP = TMP + B0(I,J)
               DUMY(1) = DUMY(1) + D0(I,J)
  170       CONTINUE
            DO 180 J=1,M
               E0(J,I) = TMP * WKV(J) + DUMY(1) * WKV(M+J)
  180       CONTINUE
  190    CONTINUE
C
C        -- SAVE A COPY --
         CALL MSAVE(NAC, NAC, M, M, A0, A1)
         CALL MSAVE(NAC, NAC, M, M, C0, C1)
         CALL MSAVE(NBD, NBD, N, N, B0, B1)
         CALL MSAVE(NBD, NBD, N, N, D0, D1)
         CALL MSAVE(NE, NE, M, N, E0, E1)
C
C        -- COMPUTE NORM OF E --
         NRME = D1NRM(NE, M, N, E0)
C
C        -- COMPUTE SOLUTION, ESTIMATE CONDITION IF SVD COMPUTABLE --
         MXN = M*N
         IF (MXN .LE. MAXSVD) THEN
            IERR = 1
         ELSE
            IERR = 0
         ENDIF
         CALL SYLG(NAC, NBD, NE, M, N, A0, B0, C0, D0, E0, WKV, IWKV,
     *             IERR, RCOND)
         IF (IERR .NE. 0) THEN
            WRITE(*,90003) KT, IERR
90003       FORMAT(" AT ITERATION", I2, " ERROR IN SYLG, IERR=", I2)
         ENDIF
C
C        -- COMPUTE RESIDUAL --
         CALL MULC(NAC, NE, NW1, M, M, N, A1, E0, WKM1)
         CALL TRNATA(NBD, N, B1)
         CALL MULC(NW1, NBD, NW2, M, N, N, WKM1, B1, WKM2)
         CALL TRNATA(NBD, N, B1)
         CALL MSUB(NE, NW2, NE, M, N, E1, WKM2, E1)
         CALL MULC(NAC, NE, NW1, M, M, N, C1, E0, WKM1)
         CALL TRNATA(NBD, N, D1)
         CALL MULC(NW1, NBD, NW2, M, N, N, WKM1, D1, WKM2)
         CALL TRNATA(NBD, N, D1)
         CALL MSUB(NE, NW2, NE, M, N, E1, WKM2, E1)
C
C        -- COMPUTE NORM OF RESIDUAL --
         NRMR = D1NRM(NE, M, N, E1)
         TMP = NRMR/NRME
         IF (TMP .GT. WORST) WORST = TMP
C
C        -- COMPUTE REAL CONDITION NUMBER --
         IF (MXN .LE. MAXSVD) THEN
            DO 40 J = 1,N
               DO 30 JJ = 1,M
                  DO 20 I = 1,N
                     DO 10 II = 1,M
                        INDX = M*(I-1) + II
                        JNDX = M*(J-1) + JJ
                        WKM3(INDX,JNDX) = A1(II,JJ)*B1(I,J)
     &                                    + C1(II,JJ)*D1(I,J)
   10                CONTINUE
   20             CONTINUE
   30          CONTINUE
   40       CONTINUE
            IDMY = 1
            CALL DSVDC(WKM3, NW3, MXN, MXN, WKV, WKV(MXN+1), DUMY, IDMY,
     *                 DUMY, IDMY, WKM1, 00, IERR)
            IF (IERR .NE. 0) THEN
               WRITE(*,90006) KT
90006          FORMAT(" ITERATION", I2, " SVD FAILED")
               RCDSVD = 0.0D0
            ELSE
               RCDSVD = WKV(MXN) / WKV(1)
            ENDIF
            RATIO = RCOND / RCDSVD
            IF (RATIO .LT. WORSTL) WORSTL = RATIO
            IF (RATIO .GT. WORSTH) WORSTH = RATIO
         ENDIF
C
C        -- PRINT RESULTS --
         IF (MXN .LE. MAXSVD) THEN
            WRITE(*,90002) KT, TMP, RCOND, RATIO
         ELSE
            WRITE(*,90007) KT, TMP
         ENDIF
90002    FORMAT(1X, I2, '  (NRM RESID)/(NRM E)=', E10.3,          '  RCO
     +ND(EST)=', E10.3, ' EST/TRUE=', E10.3)
C
90007    FORMAT(1X, I2, '  (NRM RESID)/(NRM E)=', E10.3)
  230 CONTINUE
C
  310 CONTINUE
  320 CONTINUE
C
      WRITE(*,90004) WORST
90004 FORMAT(/ " WORST CASE RESIDUAL IS", E10.3)
      WRITE(*,90008) WORSTL, WORSTH
C
90008 FORMAT(' WORST CASE RCOND RATIOS (EST/TRUE) ARE', E10.3,       ' (
     +LOW) AND', E10.3, ' (HIGH)')
      WRITE(*,90010)
90010 FORMAT(// ' THE RESIDUAL SHOULD BE ON THE ORDER OF 1E-14',        
     +  ' OR SMALLER ON MOST MACHINES.')
      WRITE(*,90011)
C
90011 FORMAT(' THE RCOND RATIOS SHOULD BE ON THE ORDER OF 1,',       ' I
     +.E., BETWEEN .1 AND 10.')
      STOP
C --- LAST LINE OF TSYLG ---
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'driver2.f'
then
	echo shar: will not over-write existing file "'driver2.f'"
else
cat << "SHAR_EOF" > 'driver2.f'
C--**--CH2908--705--P:LAP--28:10:1999
C--**--CH2885--705--C:SU--28:10:1999
C--**--CH2881--705--B:MA--28:10:1999
C--**--CH2863--705--A:H--28:10:1999
C     -- PROGRAM TSYLGC --
C
C     THIS PROGRAM TESTS THE SOFTWARE FOR SOLVING THE SYMMETRIC
C     SYLVESTER EQUATION
C
C        A*X*E' + E*X*A' + Q = 0    (' DENOTES TRANSPOSE)
C
C     USING A SET OF ILL-CONDITIONED EQUATIONS.  SEE "SOLUTION OF THE
C     SYLVESTER MATRIX EQUATION AXB'+CXD'=E" BY GARDINER, LAUB, AMATO,
C     AND MOLER FOR A DESCRIPTION OF THE TEST PROBLEMS.
C
C     THE SOLUTION IS CHECKED BY COMPUTING THE RESIDUAL AND ITS RELATIVE
C     1-NORM.  THE CONDITION ESTIMATE IS CHECKED FOR SMALL SYSTEMS ONLY
C     (N*N <= 40) BY FORMING THE KRONECKER PRODUCT MATRIX AND COMPUTING
C     ITS SINGULAR VALUE DECOMPOSITION.
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       SYLGC; (LINPACK) DSVDC; (MATU) MADD MULC TRNATA D1NRM MSAVE
C
C     WRITTEN -
C       27JAN89 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C     REVISED -
C       12DEC90 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     -- MAXIMUM N IS 8 --
      INTEGER NAE, NQ, NW, N, IERR, NWX, IDMY, KT
      INTEGER NMAX, WRKLEN, MAXSVD
      PARAMETER (NMAX=8, WRKLEN=2*NMAX*NMAX+3*NMAX,
     +           MAXSVD=40)
      DOUBLE PRECISION A(NMAX,NMAX), E(NMAX,NMAX), Q(NMAX,NMAX)
      DOUBLE PRECISION WKM1(NMAX,NMAX), WKM2(NMAX,NMAX),
     +                 WKV(WRKLEN)
C
      INTEGER I, J, NXN, II, JJ, INDX, JNDX
      DOUBLE PRECISION A1(NMAX,NMAX), E1(NMAX,NMAX), Q1(NMAX,NMAX), 
     +                 WKMX(MAXSVD,MAXSVD)
      DOUBLE PRECISION TMP, NRMR, NRMQ, WORST, RCOND, RCDSVD
      DOUBLE PRECISION WORSTL, WORSTH, RATIO, DUMY(1), ST
      DOUBLE PRECISION D1NRM
C     --- OUTPUT UNIT FOR WRITE ---
      NAE = NMAX
      NQ = NMAX
      NW = NMAX
      NWX = MAXSVD
C
C     -- INITIALIZE --
      WORST = 0.0D0
      WORSTL = 1.0D100
      WORSTH = 0.0D0
C
      WRITE(*,90000)
      WRITE(*,90001)
90000 FORMAT("             T        T")
90001 FORMAT(" SOLVE  A*X*E  + E*X*A  + Q = 0  USING SYLGC")
C
C     USE THIS LINE TO RUN A COMPLETE TEST
C
       DO 300 N = 1,NMAX
C
C     USE THIS LINE TO RUN A MINIMAL INSTALLATION TEST
C
C     DO 300 N = 5,5
C
      WRITE(*,90005) N
C
90005 FORMAT(/ " N =", I3)
      DO 230 KT = 0,40,10
         ST = (2.0D0)**(-KT)
C
C GENERATE COEFFICIENT MATRICES  --  TRUE SOLUTION IS MATRIX OF ALL ONES
C
         DO 80 I=1,N
            DO 70 J=1,I
               A(I,J) = 1.0D0
               A(J,I) = 0.0D0
               E(J,I) = ST
               E(I,J) = 0.0D0
   70       CONTINUE
            A(I,I) = ST + (I-1)
            E(I,I) = 1.0D0
   80    CONTINUE
C
         DO 160 I=1,N
            WKV(I) = 0.0D0
            DO 150 J=1,N
               WKV(I) = WKV(I) + A(I,J)
  150       CONTINUE
  160    CONTINUE
         DO 190 I=1,N
            TMP = 0.0D0
            DO 170 J=1,N
               TMP = TMP + E(I,J)
  170       CONTINUE
            DO 180 J=1,N
               Q(J,I) = TMP * WKV(J)
  180       CONTINUE
  190    CONTINUE
         DO 210 I=1,N
            DO 200 J=1,I
               Q(I,J) = -(Q(I,J) + Q(J,I))
               Q(J,I) = Q(I,J)
  200       CONTINUE
  210    CONTINUE
C
C        -- SAVE A COPY --
         CALL MSAVE(NAE, NAE, N, N, A, A1)
         CALL MSAVE(NAE, NAE, N, N, E, E1)
         CALL MSAVE(NQ, NQ, N, N, Q, Q1)
C
C        -- COMPUTE NORM OF Q --
         NRMQ = D1NRM(NQ, N, N, Q)
C
C        -- COMPUTE SOLUTION, ESTIMATE CONDITION IF SVD COMPUTABLE --
         NXN = N*N
         IF (NXN .LE. MAXSVD) THEN
            IERR = 1
         ELSE
            IERR = 0
         ENDIF
         CALL SYLGC(NAE, NQ, N, A, E, Q, WKV, IERR, RCOND)
         IF (IERR .NE. 0) THEN
            WRITE(*,90003) KT, IERR
90003       FORMAT(" AT ITERATION", I2, " ERROR IN SYLGC, IERR=", I2)
         ENDIF
C
C        -- COMPUTE RESIDUAL --
         CALL MULC(NAE, NQ, NW, N, N, N, A1, Q, WKM1)
         CALL TRNATA(NAE, N, E1)
         CALL MULC(NW, NAE, NW, N, N, N, WKM1, E1, WKM2)
         CALL TRNATA(NAE, N, E1)
         CALL MADD(NQ, NW, NQ, N, N, Q1, WKM2, Q1)
         CALL MULC(NAE, NQ, NW, N, N, N, E1, Q, WKM1)
         CALL TRNATA(NAE, N, A1)
         CALL MULC(NW, NAE, NW, N, N, N, WKM1, A1, WKM2)
         CALL TRNATA(NAE, N, A1)
         CALL MADD(NQ, NW, NQ, N, N, Q1, WKM2, Q1)
C
C        -- COMPUTE NORM OF RESIDUAL --
         NRMR = D1NRM(NQ, N, N, Q1)
         TMP = NRMR/NRMQ
         IF (TMP .GT. WORST) WORST = TMP
C
C        -- COMPUTE REAL CONDITION NUMBER
         IF (NXN .LE. MAXSVD) THEN
            DO 140 J = 1,N
               DO 130 JJ = 1,N
                  DO 120 I = 1,N
                     DO 110 II = 1,N
                        INDX = N*(I-1) + II
                        JNDX = N*(J-1) + JJ
                        WKMX(INDX,JNDX) = A1(II,JJ)*E1(I,J)
     *                                    + E1(II,JJ)*A1(I,J)
  110                CONTINUE
  120             CONTINUE
  130          CONTINUE
  140       CONTINUE
            IDMY = 1
            CALL DSVDC(WKMX, NWX, NXN, NXN, WKV, WKV(NXN+1), DUMY, IDMY,
     *                 DUMY, IDMY, WKM1, 00, IERR)
            IF (IERR .NE. 0) THEN
               WRITE(*,90006) KT
90006          FORMAT(" ITERATION", I2, " SVD FAILED")
               RCDSVD = 0.0D0
            ELSE
               RCDSVD = WKV(NXN) / WKV(1)
            ENDIF
            RATIO = RCOND / RCDSVD
            IF (RATIO .LT. WORSTL) WORSTL = RATIO
            IF (RATIO .GT. WORSTH) WORSTH = RATIO
         ENDIF
C
C        -- PRINT RESULTS --
         IF (NXN .LE. MAXSVD) THEN
            WRITE(*,90002) KT, TMP, RCOND, RATIO
         ELSE
            WRITE(*,90007) KT, TMP
         ENDIF
90002    FORMAT(1X, I2, '  (NRM RESID)/(NRM Q)=', E10.3,          '  RCO
     +ND(EST)=', E10.3, ' EST/TRUE=', E10.3)
C
C
90007    FORMAT(1X, I2, '  (NRM RESID)/(NRM Q)=', E10.3)
  230 CONTINUE
  300 CONTINUE
C
      WRITE(*,90004) WORST
90004 FORMAT(/ " WORST CASE RESIDUAL IS", E10.3)
      WRITE(*,90008) WORSTL, WORSTH
C
90008 FORMAT(' WORST CASE RCOND RATIOS (EST/TRUE) ARE', E10.3,       ' (
     +LOW) AND', E10.3, ' (HIGH)')
      WRITE(*,90010)
90010 FORMAT(// ' THE RESIDUAL SHOULD BE ON THE ORDER OF 1E-14',        
     +  ' OR SMALLER ON MOST MACHINES.')
      WRITE(*,90011)
C
90011 FORMAT(' THE RCOND RATIOS SHOULD BE ON THE ORDER OF 1,',       ' I
     +.E., BETWEEN .1 AND 10.')
      STOP
C --- LAST LINE OF TSYLGC ---
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'driver3.f'
then
	echo shar: will not over-write existing file "'driver3.f'"
else
cat << "SHAR_EOF" > 'driver3.f'
C--**--CH3665--705--C:SU--8:6:2000
C--**--CH2912--705--P:FIX--28:10:1999
C--**--CH2909--705--P:LAP--28:10:1999
C--**--CH2903--705--P:RW--28:10:1999
C--**--CH2895--705--B:FIX--28:10:1999
C--**--CH2886--705--B:MA--28:10:1999
C--**--CH2864--705--A:H--28:10:1999
C     -- PROGRAM TSYLGD --
C
C
C     THIS PROGRAM TESTS THE SOFTWARE FOR SOLVING THE SYMMETRIC
C     SYLVESTER EQUATION
C
C        A*X*A' - E*X*E' + Q = 0    (' DENOTES TRANSPOSE)
C
C     USING A SET OF ILL-CONDITIONED EQUATIONS.  SEE "SOLUTION OF THE
C     SYLVESTER MATRIX EQUATION AXB'+CXD'=E" BY GARDINER, LAUB, AMATO,
C     AND MOLER FOR A DESCRIPTION OF THE TEST PROBLEMS.
C
C     THE SOLUTION IS CHECKED BY COMPUTING THE RESIDUAL AND ITS RELATIVE
C     1-NORM.  THE CONDITION ESTIMATE IS CHECKED FOR SMALL SYSTEMS ONLY
C     (N*N <= 40) BY FORMING THE KRONECKER PRODUCT MATRIX AND COMPUTING
C     ITS SINGULAR VALUE DECOMPOSITION.
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       SYLGD; (LINPACK) DSVDC; (MATU) MADD MULC TRNATA D1NRM MSAVE MSUB
C
C     WRITTEN -
C       27JAN89 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C     REVISED -
C       14DEC90 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     -- MAXIMUM N IS 8 --
      INTEGER NAE, NQ, NW, N, IERR, NWX, IDMY, KT
C     INTEGER MAXN
      INTEGER NMAX, WRKLEN, MAXSVD
      PARAMETER (NMAX=8, WRKLEN=2*NMAX*NMAX+3*NMAX,MAXSVD=40)
      DOUBLE PRECISION A(NMAX,NMAX), E(NMAX,NMAX), Q(NMAX,NMAX)
      DOUBLE PRECISION WKM1(NMAX,NMAX), WKM2(NMAX,NMAX),
     +                 WKV(WRKLEN)
C
      INTEGER I, J, NXN, II, JJ, INDX, JNDX
      DOUBLE PRECISION A1(NMAX,NMAX), E1(NMAX,NMAX), Q1(NMAX,NMAX), 
     +                 WKMX(MAXSVD,MAXSVD)
      DOUBLE PRECISION TMP, NRMR, NRMQ, WORST, RCOND, RCDSVD
      DOUBLE PRECISION WORSTL, WORSTH, RATIO, DUMY(1), ST
      DOUBLE PRECISION D1NRM
      NAE = NMAX
      NQ = NMAX
      NW = NMAX
      NWX = MAXSVD
C
C     -- INITIALIZE --
      WORST = 0.0D0
      WORSTL = 1.0D100
      WORSTH = 0.0D0
C     NTEST = 5
C
      WRITE(*,90000)
      WRITE(*,90001)
90000 FORMAT("             T        T")
90001 FORMAT(" SOLVE  A*X*A  - E*X*E  + Q = 0  USING SYLGD")
C
C     USE THIS LINE TO RUN A COMPLETE TEST
C
       DO 300 N = 2,NMAX
C
C     USE THIS LINE TO RUN A MINIMAL INSTALLATION TEST
C
C     DO 300 N = 5,5
C
      WRITE(*,90005) N
C
90005 FORMAT(/ " N =", I3)
      DO 230 KT = 0,40,10
         ST = (2.0D0)**(-KT)
C
C GENERATE COEFFICIENT MATRICES  --  TRUE SOLUTION IS MATRIX OF ALL ONES
C
         DO 80 I=1,N
            DO 70 J=1,I
               A(I,J) = 1.0D0
               A(J,I) = 0.0D0
               E(J,I) = ST
               E(I,J) = 0.0D0
   70       CONTINUE
            A(I,I) = ST + I
            E(I,I) = 1.0D0
   80    CONTINUE
C
         DO 160 I=1,N
            WKV(I) = 0.0D0
            WKV(I+N) = 0.0D0
            DO 150 J=1,N
               WKV(I) = WKV(I) + A(I,J)
               WKV(I+N) = WKV(I+N) + E(I,J)
  150       CONTINUE
  160    CONTINUE
         DO 190 I=1,N
            TMP = 0.0D0
            DUMY(1) = 0.0D0
            DO 170 J=1,N
               TMP = TMP + A(I,J)
               DUMY(1) = DUMY(1) + E(I,J)
  170       CONTINUE
            DO 180 J=1,N
               Q(J,I) = -( TMP * WKV(J) - DUMY(1) * WKV(J+N) )
  180       CONTINUE
  190    CONTINUE
C
C        -- SAVE A COPY --
         CALL MSAVE(NAE, NAE, N, N, A, A1)
         CALL MSAVE(NAE, NAE, N, N, E, E1)
         CALL MSAVE(NQ, NQ, N, N, Q, Q1)
C
C        -- COMPUTE NORM OF Q --
         NRMQ = D1NRM(NQ, N, N, Q)
C
C        -- COMPUTE SOLUTION, ESTIMATE CONDITION IF SVD COMPUTABLE --
         NXN = N*N
         IF (NXN .LE. MAXSVD) THEN
            IERR = 1
         ELSE
            IERR = 0
         ENDIF
         CALL SYLGD(NAE, NQ, N, A, E, Q, WKV, IERR, RCOND)
         IF (IERR .NE. 0) THEN
            WRITE(*,90003) KT, IERR
90003       FORMAT(" AT ITERATION", I2, " ERROR IN SYLGD, IERR=", I2)
         ENDIF
C
C        -- COMPUTE RESIDUAL --
         CALL MULC(NAE, NQ, NW, N, N, N, A1, Q, WKM1)
         CALL TRNATA(NAE, N, A1)
         CALL MULC(NW, NAE, NW, N, N, N, WKM1, A1, WKM2)
         CALL TRNATA(NAE, N, A1)
         CALL MADD(NQ, NW, NQ, N, N, Q1, WKM2, Q1)
         CALL MULC(NAE, NQ, NW, N, N, N, E1, Q, WKM1)
         CALL TRNATA(NAE, N, E1)
         CALL MULC(NW, NAE, NW, N, N, N, WKM1, E1, WKM2)
         CALL TRNATA(NAE, N, E1)
         CALL MSUB(NQ, NW, NQ, N, N, Q1, WKM2, Q1)
C
C        -- COMPUTE NORM OF RESIDUAL --
         NRMR = D1NRM(NQ, N, N, Q1)
         TMP = NRMR/NRMQ
         IF (TMP .GT. WORST) WORST = TMP
C
C        -- COMPUTE REAL CONDITION NUMBER
         IF (NXN .LE. MAXSVD) THEN
            DO 140 J = 1,N
               DO 130 JJ = 1,N
                  DO 120 I = 1,N
                     DO 110 II = 1,N
                        INDX = N*(I-1) + II
                        JNDX = N*(J-1) + JJ
                        WKMX(INDX,JNDX) = A1(II,JJ)*A1(I,J)
     *                                    - E1(II,JJ)*E1(I,J)
  110                CONTINUE
  120             CONTINUE
  130          CONTINUE
  140       CONTINUE
            IDMY = 1
            CALL DSVDC(WKMX, NWX, NXN, NXN, WKV, WKV(NXN+1), DUMY, IDMY,
     *                 DUMY, IDMY, WKM1, 00, IERR)
            IF (IERR .NE. 0) THEN
               WRITE(*,90006) KT
90006          FORMAT(" ITERATION", I2, " SVD FAILED")
               RCDSVD = 0.0D0
            ELSE
               RCDSVD = WKV(NXN) / WKV(1)
            ENDIF
            RATIO = RCOND / RCDSVD
            IF (RATIO .LT. WORSTL) WORSTL = RATIO
            IF (RATIO .GT. WORSTH) WORSTH = RATIO
         ENDIF
C
C        -- PRINT RESULTS --
         IF (NXN .LE. MAXSVD) THEN
            WRITE(*,90002) KT, TMP, RCOND, RATIO
         ELSE
            WRITE(*,90007) KT, TMP
         ENDIF
90002    FORMAT(1X, I2, '  (NRM RESID)/(NRM Q)=', E10.3,          '  RCO
     +ND(EST)=', E10.3, ' EST/TRUE=', E10.3)
C
C
90007    FORMAT(1X, I2, '  (NRM RESID)/(NRM Q)=', E10.3)
  230 CONTINUE
  300 CONTINUE
C
      WRITE(*,90004) WORST
90004 FORMAT(/ " WORST CASE RESIDUAL IS", E10.3)
      WRITE(*,90008) WORSTL, WORSTH
C
90008 FORMAT(' WORST CASE RCOND RATIOS (EST/TRUE) ARE', E10.3,       ' (
     +LOW) AND', E10.3, ' (HIGH)')
      WRITE(*,90010)
90010 FORMAT(// ' THE RESIDUAL SHOULD BE ON THE ORDER OF 1E-14',        
     +  ' OR SMALLER ON MOST MACHINES.')
      WRITE(*,90011)
C
90011 FORMAT(' THE RCOND RATIOS SHOULD BE ON THE ORDER OF 1,',       ' I
     +.E., BETWEEN .1 AND 10.')
      STOP
C --- LAST LINE OF TSYLGD ---
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'driver4.f'
then
	echo shar: will not over-write existing file "'driver4.f'"
else
cat << "SHAR_EOF" > 'driver4.f'
C--**--CH2919--705--P:FIX--28:10:1999
C--**--CH2910--705--P:LAP--28:10:1999
C--**--CH2896--705--B:FIX--28:10:1999
C--**--CH2887--705--B:MA--28:10:1999
C--**--CH2865--705--A:H--28:10:1999
C--**--CH2859--705--P:RW--28:10:1999
C     -- PROGRAM TSYLGF --
C
C     THIS PROGRAM TESTS THE SOFTWARE FOR SOLVING THE GENERAL
C     SYLVESTER EQUATION
C
C        A * X * B' +  C * X * D' =  E    (' DENOTES TRANSPOSE)
C
C     READING THE COEFFICIENT MATRICES FROM A FILE.
C
C     THE SOLUTION IS CHECKED BY COMPUTING THE RESIDUAL AND ITS RELATIVE
C     1-NORM.  THE CONDITION ESTIMATE IS CHECKED FOR SMALL SYSTEMS ONLY
C     (M*N <= 40) BY FORMING THE KRONECKER PRODUCT MATRIX AND COMPUTING
C     ITS SINGULAR VALUE DECOMPOSITION.
C
C     INPUT FILE FORMAT (SEE EXAMPLE FILE TEST1.IN):
C       INPUT IS FREE FORMAT; MATRICES ARE READ BY ROWS.
C       DIMENSIONS M AND N (INTEGER)
C       A; EACH ROW MUST BEGIN ON A NEW LINE AND MAY TAKE AS MANY LINES
C       AS NECESSARY.
C       B; C; D; E; SAME COMMENT.
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       SYLG; (LINPACK) DSVDC;
C       (MATU) MSAVE, D1NRM, MSUB, MULC, TRNATA
C
C     WRITTEN -
C       12DEC90 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     -- MAXIMUM M IS 9, MAXIMUM N IS 8 --
      INTEGER NAC, NBD, NE, NW, M, N, IERR
      INTEGER MMAX, NMAX, MNMAX, WRKLEN, MAXSVD
      PARAMETER (MMAX=9, NMAX=8, MNMAX=9, MAXSVD=40,
     +  WRKLEN = 2*MMAX*MMAX+NMAX*NMAX+NMAX*MMAX+7*MMAX+MNMAX*MNMAX)
      DOUBLE PRECISION A0(MMAX,MMAX), B0(NMAX,NMAX), C0(MMAX,MMAX),
     +                 D0(NMAX,NMAX), E0(MMAX,NMAX)
      DOUBLE PRECISION A1(MMAX,MMAX), B1(NMAX,NMAX), C1(MMAX,MMAX),
     +                 D1(NMAX,NMAX), E1(MMAX,NMAX)
      DOUBLE PRECISION WKM1(MMAX,MMAX), WKM2(NMAX,NMAX), 
     +                 WRKSVD(MAXSVD,MAXSVD), WKV(WRKLEN)
      INTEGER IWKV(2*MMAX)
C
      INTEGER I, J, II, JJ, INDX, JNDX, MXN
      INTEGER IDMY
      DOUBLE PRECISION NRMR, NRME, RCOND, RCDSVD
      DOUBLE PRECISION DUMY(1), RATIO
      DOUBLE PRECISION D1NRM
C     CHARACTER*20 INNAME, OUTNAM
      CHARACTER YESNO
C
      NAC = MMAX
      NBD = NMAX
      NE = MMAX
      NW = NMAX
C
C     -- INITIALIZE --
      WRITE(*,90000)
      WRITE(*,90001)
90000 FORMAT("             T        T")
C
C      WRITE(*,91002)
C91002 FORMAT(/' ENTER NAME OF FILE CONTAINING COEFFICIENT MATRICES ')
C      READ(5,91003) INNAME
C91003 FORMAT(A)
C      OPEN(2,FILE=INNAME)
C      WRITE(*,91004)
C91004 FORMAT(/' ENTER NAME OF FILE FOR OUTPUT OF SOLUTION MATRIX')
C      READ(5,91003) OUTNAM
C      OPEN(3,FILE=OUTNAM)
C
C     -- READ COEFFICIENT MATRICES --
90001 FORMAT(" SOLVE  A*X*B  + C*X*D  = E  USING SYLG")
      READ(*,*) M, N
      IF (M .GT. NAC  .OR.  N .GT. NBD) THEN
         WRITE(*,91005) M, N, NAC, NBD
91005    FORMAT(/' DIMENSION OF PROBLEM IS TOO LARGE:  M =',I2,', N =', 
     +         I2 / ' MAXIMUM:  M =',I2,', N =',I2)
         STOP
      ENDIF
      WRITE(*,91008) M, N
C
91008 FORMAT(/' M =',I2,', N =',I2)
      DO 201 I=1,M
         READ(*,*)(A0(I,J),J=1,M)
 201  CONTINUE
      DO 202 I=1,N
         READ(*,*)(B0(I,J),J=1,N)
 202  CONTINUE
      DO 203 I=1,M
         READ(*,*)(C0(I,J),J=1,M)
 203  CONTINUE
      DO 204 I=1,N
         READ(*,*)(D0(I,J),J=1,N)
 204  CONTINUE
      DO 205 I=1,M
         READ(*,*)(E0(I,J),J=1,N)
 205  CONTINUE
C
C        -- SAVE A COPY --
         CALL MSAVE(NAC, NAC, M, M, A0, A1)
         CALL MSAVE(NAC, NAC, M, M, C0, C1)
         CALL MSAVE(NBD, NBD, N, N, B0, B1)
         CALL MSAVE(NBD, NBD, N, N, D0, D1)
         CALL MSAVE(NE, NE, M, N, E0, E1)
C
C        -- COMPUTE NORM OF E --
         NRME = D1NRM(NE, M, N, E0)
C
C        -- COMPUTE SOLUTION AND ESTIMATE CONDITION
         IERR = 1
         CALL SYLG(NAC, NBD, NE, M, N, A0, B0, C0, D0, E0, WKV, IWKV,
     *             IERR, RCOND)
         IF (IERR .NE. 0) THEN
            WRITE(*,90003) IERR
90003       FORMAT(" ERROR FROM SYLG, IERR=", I2)
         ENDIF
C
C        -- SAVE SOLUTION --
         DO 301 I=1,M
            WRITE(*,92001) (E0(I,J),J=1,N)
92001       FORMAT(1X,6E12.4)
 301     CONTINUE
C
C        -- COMPUTE RESIDUAL --
         CALL MULC(NAC, NE, NW, M, M, N, A1, E0, WKM1)
         CALL TRNATA(NBD, N, B1)
         CALL MULC(NW, NBD, NW, M, N, N, WKM1, B1, WKM2)
         CALL TRNATA(NBD, N, B1)
         CALL MSUB(NE, NW, NE, M, N, E1, WKM2, E1)
         CALL MULC(NAC, NE, NW, M, M, N, C1, E0, WKM1)
         CALL TRNATA(NBD, N, D1)
         CALL MULC(NW, NBD, NW, M, N, N, WKM1, D1, WKM2)
         CALL TRNATA(NBD, N, D1)
         CALL MSUB(NE, NW, NE, M, N, E1, WKM2, E1)
C
C        -- COMPUTE NORM OF RESIDUAL --
         NRMR = D1NRM(NE, M, N, E1) / NRME
C
C        -- PRINT RESULTS --
         WRITE(*,90002) NRMR, RCOND
C
C     -- COMPUTE REAL CONDITION NUMBER IF REQUESTED --
90002    FORMAT(1X, '  (NRM RESID)/(NRM E)=', E10.3,          '  RCOND(E
     +ST)=', E10.3)
      MXN = M*N
      IF (MXN .LE. MAXSVD) THEN
         WRITE(*,91006)
91006    FORMAT(/' DO YOU WISH TO HAVE THE ACTUAL CONDITION NUMBER',    
     +      ' COMPUTED? (Y OR N) ')
         READ(5,*)YESNO
         IF (YESNO .EQ. 'y'  .OR.  YESNO .EQ. 'Y') THEN
            DO 40 J = 1,N
               DO 30 JJ = 1,M
                  DO 20 I = 1,N
                     DO 10 II = 1,M
                        INDX = M*(I-1) + II
                        JNDX = M*(J-1) + JJ
                        WRKSVD(INDX,JNDX) = A1(II,JJ)*B1(I,J)
     *                                    + C1(II,JJ)*D1(I,J)
   10                CONTINUE
   20             CONTINUE
   30          CONTINUE
   40       CONTINUE
            IDMY = 1
            CALL DSVDC(WRKSVD, MAXSVD, MXN, MXN, WKV, WKV(MXN+1), DUMY,
     *                 IDMY, DUMY, IDMY, WKM1, 00, IERR)
            IF (IERR .NE. 0) THEN
               WRITE(*,90006)
90006          FORMAT(" SVD FAILED")
               RCDSVD = 0.0D0
            ELSE
               RCDSVD = WKV(MXN) / WKV(1)
            ENDIF
            RATIO = RCOND / RCDSVD
C
            WRITE(*,90007) RCDSVD, RATIO
90007       FORMAT(1X, '  RCOND(TRUE)=', E10.3, ' EST/TRUE=', E10.3)
         ENDIF
      ENDIF
C
      CLOSE(2)
      CLOSE(3)
      STOP
C --- LAST LINE OF TSYLGF ---
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'driver5.f'
then
	echo shar: will not over-write existing file "'driver5.f'"
else
cat << "SHAR_EOF" > 'driver5.f'
C--**--CH2913--705--P:LAP--28:10:1999
C--**--CH2897--705--C:SU--28:10:1999
C--**--CH2888--705--B:MA--28:10:1999
C--**--CH2866--705--A:H--28:10:1999
C--**--CH2860--705--P:RW--28:10:1999
C     -- PROGRAM TSYLGCF --
C
C     THIS PROGRAM TESTS THE SOFTWARE FOR SOLVING THE SYMMETRIC
C     SYLVESTER EQUATION
C
C        A*X*E' + E*X*A' + Q = 0    (' DENOTES TRANSPOSE)
C
C     READING THE COEFFICIENT MATRICES FROM A FILE.
C
C     THE SOLUTION IS CHECKED BY COMPUTING THE RESIDUAL AND ITS RELATIVE
C     1-NORM.  THE CONDITION ESTIMATE IS CHECKED FOR SMALL SYSTEMS ONLY
C     (N*N <= 40) BY FORMING THE KRONECKER PRODUCT MATRIX AND COMPUTING
C     ITS SINGULAR VALUE DECOMPOSITION.
C
C     INPUT FILE FORMAT (SEE EXAMPLE FILE TESTCD.IN):
C       INPUT IS FREE FORMAT; MATRICES ARE READ BY ROWS.
C       DIMENSION N (INTEGER)
C       A; EACH ROW MUST BEGIN ON A NEW LINE AND MAY TAKE AS MANY LINES
C       AS NECESSARY.
C       E; Q; SAME COMMENT.
C
C     SOLUTION MATRIX X IS WRITTEN TO AN OUTPUT FILE (SEE EXAMPLE FILE
C       TESTC.OUT).
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       SYLGC; (LINPACK) DSVDC; (MATU) MADD MULC TRNATA D1NRM MSAVE
C
C     WRITTEN -
C       14DEC90 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     -- MAXIMUM N IS 8 --
      INTEGER NAE, NQ, NW, N, IERR, NWX, IDMY
      INTEGER NMAX, WRKLEN, MAXSVD
      PARAMETER (NMAX=8, WRKLEN=2*NMAX*NMAX+3*NMAX,
     +           MAXSVD=40)
      DOUBLE PRECISION A(NMAX,NMAX), E(NMAX,NMAX), Q(NMAX,NMAX)
      DOUBLE PRECISION WKM1(NMAX,NMAX), WKM2(NMAX,NMAX),
     +                 WKV(WRKLEN)
C
      INTEGER I, J, NXN, II, JJ, INDX, JNDX
      DOUBLE PRECISION A1(NMAX,NMAX), E1(NMAX,NMAX), Q1(NMAX,NMAX), 
     +                 WKMX(MAXSVD,MAXSVD)

      DOUBLE PRECISION NRMR, NRMQ, RCOND, RCDSVD
      DOUBLE PRECISION RATIO, DUMY(1)
      DOUBLE PRECISION D1NRM
C     CHARACTER*20 INNAME, OUTNAM
      CHARACTER YESNO
C
      NAE = NMAX
      NQ = NMAX
      NW = NMAX
      NWX = MAXSVD
C
C     -- INITIALIZE --
      WRITE(*,90000)
      WRITE(*,90001)
90000 FORMAT("             T        T")
C
C
C      WRITE(*,91002)
C91002 FORMAT(/' ENTER NAME OF FILE CONTAINING COEFFICIENT MATRICES ')
C      READ(5,91003) INNAME
C91003 FORMAT(A)
C      OPEN(2,FILE=INNAME)
C      WRITE(*,91004)
C91004 FORMAT(/' ENTER NAME OF FILE FOR OUTPUT OF SOLUTION MATRIX')
C      READ(5,91003) OUTNAM
C      OPEN(3,FILE=OUTNAM)
C
C     -- READ COEFFICIENT MATRICES --
90001 FORMAT(" SOLVE  A*X*E  + E*X*A  + Q = 0  USING SYLGC")
      READ(*,*) N
      IF (N .GT. NAE) THEN
         WRITE(*,91005) N, NAE
91005    FORMAT(/' DIMENSION OF PROBLEM IS TOO LARGE:  N =',I2,         
     + '  MAXIMUM IS ',I2)
         STOP
      ENDIF
      WRITE(*,91008) N
C
91008 FORMAT(/' N =',I2)
      DO 201 I=1,N
         READ(*,*)(A(I,J),J=1,N)
 201  CONTINUE
      DO 202 I=1,N
         READ(*,*)(E(I,J),J=1,N)
 202  CONTINUE
      DO 203 I=1,N
         READ(*,*)(Q(I,J),J=1,N)
 203  CONTINUE
C
C        -- SAVE A COPY --
         CALL MSAVE(NAE, NAE, N, N, A, A1)
         CALL MSAVE(NAE, NAE, N, N, E, E1)
         CALL MSAVE(NQ, NQ, N, N, Q, Q1)
C
C        -- COMPUTE NORM OF Q --
         NRMQ = D1NRM(NQ, N, N, Q)
C
C        -- COMPUTE SOLUTION AND ESTIMATE CONDITION --
         IERR = 1
         CALL SYLGC(NAE, NQ, N, A, E, Q, WKV, IERR, RCOND)
         IF (IERR .NE. 0) THEN
            WRITE(*,90003) IERR
90003       FORMAT(" ERROR FROM SYLGC, IERR=", I2)
         ENDIF
C
C        -- SAVE SOLUTION --
         DO 301 I=1,N
            WRITE(*,92001) (Q(I,J),J=1,N)
92001       FORMAT(1X,6E12.4)
 301     CONTINUE
C
C        -- COMPUTE RESIDUAL --
         CALL MULC(NAE, NQ, NW, N, N, N, A1, Q, WKM1)
         CALL TRNATA(NAE, N, E1)
         CALL MULC(NW, NAE, NW, N, N, N, WKM1, E1, WKM2)
         CALL TRNATA(NAE, N, E1)
         CALL MADD(NQ, NW, NQ, N, N, Q1, WKM2, Q1)
         CALL MULC(NAE, NQ, NW, N, N, N, E1, Q, WKM1)
         CALL TRNATA(NAE, N, A1)
         CALL MULC(NW, NAE, NW, N, N, N, WKM1, A1, WKM2)
         CALL TRNATA(NAE, N, A1)
         CALL MADD(NQ, NW, NQ, N, N, Q1, WKM2, Q1)
C
C        -- COMPUTE NORM OF RESIDUAL --
         NRMR = D1NRM(NQ, N, N, Q1) / NRMQ
C
C        -- PRINT RESULTS --
         WRITE(*,90002) NRMR, RCOND
C
C     -- COMPUTE REAL CONDITION NUMBER IF REQUESTED --
90002    FORMAT(1X, '  (NRM RESID)/(NRM Q)=', E10.3,          '  RCOND(E
     +ST)=', E10.3)
      NXN = N*N
      IF (NXN .LE. MAXSVD) THEN
         WRITE(*,91006)
91006    FORMAT(/' DO YOU WISH TO HAVE THE ACTUAL CONDITION NUMBER',    
     +      ' COMPUTED? (Y OR N) ')
         READ(5,*)YESNO
         IF (YESNO .EQ. 'y'  .OR.  YESNO .EQ. 'Y') THEN
            DO 140 J = 1,N
               DO 130 JJ = 1,N
                  DO 120 I = 1,N
                     DO 110 II = 1,N
                        INDX = N*(I-1) + II
                        JNDX = N*(J-1) + JJ
                        WKMX(INDX,JNDX) = A1(II,JJ)*E1(I,J)
     *                                    + E1(II,JJ)*A1(I,J)
  110                CONTINUE
  120             CONTINUE
  130          CONTINUE
  140       CONTINUE
            IDMY = 1
            CALL DSVDC(WKMX, NWX, NXN, NXN, WKV, WKV(NXN+1), DUMY, IDMY,
     *                 DUMY, IDMY, WKM1, 00, IERR)
            IF (IERR .NE. 0) THEN
               WRITE(*,90006)
90006          FORMAT(" SVD FAILED")
               RCDSVD = 0.0D0
            ELSE
               RCDSVD = WKV(NXN) / WKV(1)
            ENDIF
            RATIO = RCOND / RCDSVD
C
            WRITE(*,90007) RCDSVD, RATIO
90007       FORMAT(1X, '  RCOND(TRUE)=', E10.3, ' EST/TRUE=', E10.3)
         ENDIF
      ENDIF
C
      CLOSE(2)
      CLOSE(3)
      STOP
C --- LAST LINE OF TSYLGCF ---
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'driver6.f'
then
	echo shar: will not over-write existing file "'driver6.f'"
else
cat << "SHAR_EOF" > 'driver6.f'
C--**--CH2914--705--P:LAP--28:10:1999
C--**--CH2898--705--C:SU--28:10:1999
C--**--CH2889--705--B:MA--28:10:1999
C--**--CH2867--705--A:H--28:10:1999
C--**--CH2861--705--P:RW--28:10:1999
C     -- PROGRAM TSYLGDF --
C
C     THIS PROGRAM TESTS THE SOFTWARE FOR SOLVING THE SYMMETRIC
C     SYLVESTER EQUATION
C
C        A*X*A' - E*X*E' + Q = 0    (' DENOTES TRANSPOSE)
C
C     READING THE COEFFICIENT MATRICES FROM A FILE.
C
C     THE SOLUTION IS CHECKED BY COMPUTING THE RESIDUAL AND ITS RELATIVE
C     1-NORM.  THE CONDITION ESTIMATE IS CHECKED FOR SMALL SYSTEMS ONLY
C     (N*N <= 40) BY FORMING THE KRONECKER PRODUCT MATRIX AND COMPUTING
C     ITS SINGULAR VALUE DECOMPOSITION.
C
C     INPUT FILE FORMAT (SEE EXAMPLE FILE TESTCD.IN):
C       INPUT IS FREE FORMAT; MATRICES ARE READ BY ROWS.
C       DIMENSION N (INTEGER)
C       A; EACH ROW MUST BEGIN ON A NEW LINE AND MAY TAKE AS MANY LINES
C       AS NECESSARY.
C       E; Q; SAME COMMENT.
C
C     SOLUTION MATRIX X IS WRITTEN TO AN OUTPUT FILE (SEE EXAMPLE FILE
C       TESTD.OUT).
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       SYLGD; (LINPACK) DSVDC; (MATU) MADD MULC TRNATA D1NRM MSAVE MSUB
C
C     WRITTEN -
C       14DEC90 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     -- MAXIMUM N IS 8 --
      INTEGER NAE, NQ, NW, N, IERR, NWX, IDMY
      INTEGER NMAX, WRKLEN, MAXSVD
      PARAMETER (NMAX=8, WRKLEN=2*NMAX*NMAX+3*NMAX,MAXSVD=40)
      DOUBLE PRECISION A(NMAX,NMAX), E(NMAX,NMAX), Q(NMAX,NMAX)
      DOUBLE PRECISION WKM1(NMAX,NMAX), WKM2(NMAX,NMAX),
     +                 WKV(WRKLEN)
C
      INTEGER I, J, NXN, II, JJ, INDX, JNDX
      DOUBLE PRECISION A1(NMAX,NMAX), E1(NMAX,NMAX), Q1(NMAX,NMAX), 
     +                 WKMX(MAXSVD,MAXSVD)
      DOUBLE PRECISION NRMR, NRMQ, RCOND, RCDSVD
      DOUBLE PRECISION RATIO, DUMY(1)
      DOUBLE PRECISION D1NRM
C     CHARACTER*20 INNAME, OUTNAM
      CHARACTER YESNO
C
C
C     -- INITIALIZE --
      NAE = NMAX
      NQ = NMAX
      NW = NMAX
      NWX = MAXSVD

      WRITE(*,90000)
      WRITE(*,90001)
90000 FORMAT("             T        T")
C
C
C      WRITE(*,91002)
C91002 FORMAT(/' ENTER NAME OF FILE CONTAINING COEFFICIENT MATRICES ')
C      READ(5,91003) INNAME
C91003 FORMAT(A)
C      OPEN(2,FILE=INNAME)
C      WRITE(*,91004)
C91004 FORMAT(/' ENTER NAME OF FILE FOR OUTPUT OF SOLUTION MATRIX')
C      READ(5,91003) OUTNAM
C      OPEN(3,FILE=OUTNAM)
C
C     -- READ COEFFICIENT MATRICES --
90001 FORMAT(" SOLVE  A*X*A  - E*X*E  + Q = 0  USING SYLGD")
      READ(*,*) N
      IF (N .GT. NAE) THEN
         WRITE(*,91005) N, NAE
91005    FORMAT(/' DIMENSION OF PROBLEM IS TOO LARGE:  N =',I2,         
     + '  MAXIMUM IS ',I2)
         STOP
      ENDIF
      WRITE(*,91008) N
C
91008 FORMAT(/' N =',I2)
      DO 201 I=1,N
         READ(*,*)(A(I,J),J=1,N)
 201  CONTINUE
      DO 202 I=1,N
         READ(*,*)(E(I,J),J=1,N)
 202  CONTINUE
      DO 203 I=1,N
         READ(*,*)(Q(I,J),J=1,N)
 203  CONTINUE
C
C        -- SAVE A COPY --
         CALL MSAVE(NAE, NAE, N, N, A, A1)
         CALL MSAVE(NAE, NAE, N, N, E, E1)
         CALL MSAVE(NQ, NQ, N, N, Q, Q1)
C
C        -- COMPUTE NORM OF Q --
         NRMQ = D1NRM(NQ, N, N, Q)
C
C        -- COMPUTE SOLUTION AND ESTIMATE CONDITION --
         IERR = 1
         CALL SYLGD(NAE, NQ, N, A, E, Q, WKV, IERR, RCOND)
         IF (IERR .NE. 0) THEN
            WRITE(*,90003) IERR
90003       FORMAT(" ERROR FROM SYLGD, IERR=", I2)
         ENDIF
C
C        -- SAVE SOLUTION --
         DO 301 I=1,N
            WRITE(*,92001) (Q(I,J),J=1,N)
92001       FORMAT(1X,6E12.4)
 301     CONTINUE
C
C        -- COMPUTE RESIDUAL --
         CALL MULC(NAE, NQ, NW, N, N, N, A1, Q, WKM1)
         CALL TRNATA(NAE, N, A1)
         CALL MULC(NW, NAE, NW, N, N, N, WKM1, A1, WKM2)
         CALL TRNATA(NAE, N, A1)
         CALL MADD(NQ, NW, NQ, N, N, Q1, WKM2, Q1)
         CALL MULC(NAE, NQ, NW, N, N, N, E1, Q, WKM1)
         CALL TRNATA(NAE, N, E1)
         CALL MULC(NW, NAE, NW, N, N, N, WKM1, E1, WKM2)
         CALL TRNATA(NAE, N, E1)
         CALL MSUB(NQ, NW, NQ, N, N, Q1, WKM2, Q1)
C
C        -- COMPUTE NORM OF RESIDUAL --
         NRMR = D1NRM(NQ, N, N, Q1) / NRMQ
C
C        -- PRINT RESULTS --
         WRITE(*,90002) NRMR, RCOND
C
C     -- COMPUTE REAL CONDITION NUMBER IF REQUESTED --
90002    FORMAT(1X, '  (NRM RESID)/(NRM Q)=', E10.3,          '  RCOND(E
     +ST)=', E10.3)
      NXN = N*N
      IF (NXN .LE. MAXSVD) THEN
         WRITE(*,91006)
91006    FORMAT(/' DO YOU WISH TO HAVE THE ACTUAL CONDITION NUMBER',    
     +      ' COMPUTED? (Y OR N) ')
         READ(5,*)YESNO
         IF (YESNO .EQ. 'y'  .OR.  YESNO .EQ. 'Y') THEN
            DO 140 J = 1,N
               DO 130 JJ = 1,N
                  DO 120 I = 1,N
                     DO 110 II = 1,N
                        INDX = N*(I-1) + II
                        JNDX = N*(J-1) + JJ
                        WKMX(INDX,JNDX) = A1(II,JJ)*A1(I,J)
     *                                    - E1(II,JJ)*E1(I,J)
  110                CONTINUE
  120             CONTINUE
  130          CONTINUE
  140       CONTINUE
            IDMY = 1
            CALL DSVDC(WKMX, NWX, NXN, NXN, WKV, WKV(NXN+1), DUMY, IDMY,
     *                 DUMY, IDMY, WKM1, 00, IERR)
            IF (IERR .NE. 0) THEN
               WRITE(*,90006)
90006          FORMAT(" SVD FAILED")
               RCDSVD = 0.0D0
            ELSE
               RCDSVD = WKV(NXN) / WKV(1)
            ENDIF
            RATIO = RCOND / RCDSVD
C
            WRITE(*,90007) RCDSVD, RATIO
90007       FORMAT(1X, '  RCOND(TRUE)=', E10.3, ' EST/TRUE=', E10.3)
         ENDIF
      ENDIF
C
      CLOSE(2)
      CLOSE(3)
      STOP
C --- LAST LINE OF TSYLGDF ---
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'driver7.f'
then
	echo shar: will not over-write existing file "'driver7.f'"
else
cat << "SHAR_EOF" > 'driver7.f'
C--**--CH3666--705--C:GEN--8:6:2000
C--**--CH2915--705--P:LAP--28:10:1999
C--**--CH2904--705--P:RW--28:10:1999
C--**--CH2899--705--P:R--28:10:1999
C--**--CH2890--705--B:MA--28:10:1999
C--**--CH2868--705--A:H--28:10:1999
C     -- PROGRAM TSYLGR --
C
C     THIS PROGRAM TESTS THE SOFTWARE FOR SOLVING THE GENERAL
C     SYLVESTER EQUATION
C
C        A * X * B' +  C * X * D' =  E    (' DENOTES TRANSPOSE)
C
C     USING RANDOMLY GENERATED COEFFICIENT MATRICES.  MATRIX ELEMENTS
C     HAVE A GAUSSIAN DISTRIBUTION WITH MEAN 0 AND STANDARD DEVIATION 1.
C
C     TSYLGR MAY NOT BE PORTABLE. THE FUNCTION DXRAND MUST BE PROVIDED B
C     THE USER ON SYSTEMS OTHER THAN UNIX.  DXRAND IS A DOUBLE PRECISION
C     PSEUDORANDOM NUMBER GENERATOR WHICH GIVES A UNIFORM DISTRIBUTION I
C     THE INTERVAL [0,1].  DXRAND IS INITIALIZED WITH T=DXRAND(K), K AN
C     INTEGER, K>0.  SUBSEQUENT CALLS ARE T=DXRAND(0).
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       SYLG; (LINPACK) DSVDC;
C       RANDM; (MATU) MSAVE, D1NRM, MSUB, MULC, TRNATA; DXRAND
C
C     WRITTEN -
C       18FEB87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-4691
C     MODIFIED -
C       28NOV88 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C       12DEC90 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     -- MAXIMUM M IS 9, MAXIMUM N IS 8 --
      INTEGER NAC, NBD, NE, NW, M, N, IERR
      INTEGER MMAX, NMAX, MNMAX, WRKLEN, MAXSVD
      PARAMETER (MMAX=9, NMAX=8, MNMAX=9, MAXSVD=40,
     +  WRKLEN = 2*MMAX*MMAX+NMAX*NMAX+NMAX*MMAX+7*MMAX+MNMAX*MNMAX)
      DOUBLE PRECISION A0(MMAX,MMAX), B0(NMAX,NMAX), C0(MMAX,MMAX),
     +                 D0(NMAX,NMAX), E0(MMAX,NMAX)
      DOUBLE PRECISION A1(MMAX,MMAX), B1(NMAX,NMAX), C1(MMAX,MMAX),
     +                 D1(NMAX,NMAX), E1(MMAX,NMAX)
      DOUBLE PRECISION WKM1(MMAX,NMAX), WKM2(MMAX,NMAX), 
     +                 WRKSVD(MAXSVD,MAXSVD), WKV(WRKLEN)
      INTEGER IWKV(2*MMAX)
C
      INTEGER I, J, LL, II, JJ, INDX, JNDX, MXN, NTEST
      INTEGER IDMY
      DOUBLE PRECISION TMP, NRMR, NRME, DPAR(3), WORST, RCOND, RCDSVD
      DOUBLE PRECISION DUMY(1), WORSTL, WORSTH, RATIO
      DOUBLE PRECISION DXRAND, D1NRM
C
C     -- INITIALIZE --
      NAC = MMAX
      NBD = NMAX
      NE = MMAX
      NW=MMAX
      WORST = 0.0D0
      WORSTL = 1.0D100
      WORSTH = 0.0D0
      NTEST = 5
      TMP = DXRAND(13)
      DPAR(1) = 0.0D0
      DPAR(2) = 1.0D2
C
      WRITE(*,90000)
      WRITE(*,90001)
90000 FORMAT("             T        T")
C
90001 FORMAT(" SOLVE  A*X*B  + C*X*D  = E  USING SYLG")
      DO 320 M = 1,NAC
      DO 310 N = 1,NBD
C
      WRITE(*,90005) M, N
C
90005 FORMAT(/ " M =", I3, "   N =", I3)
      DO 230 LL = 1,NTEST
C
C        -- GENERATE NORMALLY DIST. RANDOM DATA --
         CALL RANDM(A0, NAC, M, M, DPAR, 01)
         CALL RANDM(B0, NBD, N, N, DPAR, 01)
         CALL RANDM(C0, NAC, M, M, DPAR, 01)
         CALL RANDM(D0, NBD, N, N, DPAR, 01)
         CALL RANDM(E0, NE, M, N, DPAR, 01)
C
C        -- SAVE A COPY --
         CALL MSAVE(NAC, NAC, M, M, A0, A1)
         CALL MSAVE(NAC, NAC, M, M, C0, C1)
         CALL MSAVE(NBD, NBD, N, N, B0, B1)
         CALL MSAVE(NBD, NBD, N, N, D0, D1)
         CALL MSAVE(NE, NE, M, N, E0, E1)
C
C        -- COMPUTE NORM OF E --
         NRME = D1NRM(NE, M, N, E0)
C
C        -- COMPUTE SOLUTION, ESTIMATE CONDITION IF SVD COMPUTABLE --
         MXN = M*N
         IF (MXN .LE. MAXSVD) THEN
            IERR = 1
         ELSE
            IERR = 0
         ENDIF
         CALL SYLG(NAC, NBD, NE, M, N, A0, B0, C0, D0, E0, WKV, IWKV,
     *             IERR, RCOND)
         IF (IERR .NE. 0) THEN
            WRITE(*,90003) LL, IERR
90003       FORMAT(" AT ITERATION", I2, " ERROR IN SYLG, IERR=", I2)
         ENDIF
C
C        -- COMPUTE RESIDUAL --
         CALL MULC(NAC, NE, NW, M, M, N, A1, E0, WKM1)
         CALL TRNATA(NBD, N, B1)
         CALL MULC(NW, NBD, NE, M, N, N, WKM1, B1, WKM2)
         CALL TRNATA(NBD, N, B1)
         CALL MSUB(NE, NE, NE, M, N, E1, WKM2, E1)
         CALL MULC(NAC, NE, NW, M, M, N, C1, E0, WKM1)
         CALL TRNATA(NBD, N, D1)
         CALL MULC(NW, NBD, NE, M, N, N, WKM1, D1, WKM2)
         CALL TRNATA(NBD, N, D1)
         CALL MSUB(NE, NE, NE, M, N, E1, WKM2, E1)
C
C        -- COMPUTE NORM OF RESIDUAL --
         NRMR = D1NRM(NE, M, N, E1)
         TMP = NRMR/NRME
         IF (TMP .GT. WORST) WORST = TMP
C
C        -- COMPUTE REAL CONDITION NUMBER --
         IF (MXN .LE. MAXSVD) THEN
            DO 40 J = 1,N
               DO 30 JJ = 1,M
                  DO 20 I = 1,N
                     DO 10 II = 1,M
                        INDX = M*(I-1) + II
                        JNDX = M*(J-1) + JJ
                        WRKSVD(INDX,JNDX) = A1(II,JJ)*B1(I,J)
     &                                    + C1(II,JJ)*D1(I,J)
   10                CONTINUE
   20             CONTINUE
   30          CONTINUE
   40       CONTINUE
            IDMY = 1
            CALL DSVDC(WRKSVD, MAXSVD, MXN, MXN, WKV, WKV(MXN+1), DUMY,
     *                 IDMY, DUMY, IDMY, WKM1, 00, IERR)
            IF (IERR .NE. 0) THEN
               WRITE(*,90006) LL
90006          FORMAT(" ITERATION", I2, " SVD FAILED")
               RCDSVD = 0.0D0
            ELSE
               RCDSVD = WKV(MXN) / WKV(1)
            ENDIF
            RATIO = RCOND / RCDSVD
            IF (RATIO .LT. WORSTL) WORSTL = RATIO
            IF (RATIO .GT. WORSTH) WORSTH = RATIO
         ENDIF
C
C        -- PRINT RESULTS --
         IF (MXN .LE. MAXSVD) THEN
            WRITE(*,90002) LL, TMP, RCOND, RATIO
         ELSE
            WRITE(*,90007) LL, TMP
         ENDIF
90002    FORMAT(1X, I2, '  (NRM RESID)/(NRM E)=', E10.3,          '  RCO
     +ND(EST)=', E10.3, ' EST/TRUE=', E10.3)
C
90007    FORMAT(1X, I2, '  (NRM RESID)/(NRM E)=', E10.3)
  230 CONTINUE
C
  310 CONTINUE
  320 CONTINUE
C
      WRITE(*,90004) WORST
90004 FORMAT(/ " WORST CASE RESIDUAL IS", E10.3)
      WRITE(*,90008) WORSTL, WORSTH
C
90008 FORMAT(' WORST CASE RCOND RATIOS (EST/TRUE) ARE', E10.3,       ' (
     +LOW) AND', E10.3, ' (HIGH)')
      STOP
C --- LAST LINE OF TSYLGR ---
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'driver8.f'
then
	echo shar: will not over-write existing file "'driver8.f'"
else
cat << "SHAR_EOF" > 'driver8.f'
C--**--CH2916--705--P:LAP--28:10:1999
C--**--CH2905--705--P:RW--28:10:1999
C--**--CH2900--705--P:R--28:10:1999
C--**--CH2891--705--B:MA--28:10:1999
C--**--CH2869--705--A:H--28:10:1999
C     -- PROGRAM TSYLGCR --
C
C     THIS PROGRAM TESTS THE SOFTWARE FOR SOLVING THE SYMMETRIC
C     SYLVESTER EQUATION
C
C        A*X*E' + E*X*A' + Q = 0    (' DENOTES TRANSPOSE)
C
C     USING RANDOMLY GENERATED COEFFICIENT MATRICES.  MATRIX ELEMENTS
C     HAVE A GAUSSIAN DISTRIBUTION WITH MEAN 0 AND STANDARD DEVIATION 1.
C     Q IS TAKEN TO BE THE SYMMETRIC PART OF A RANDOM MATRIX.
C
C     TSYLGCR MAY NOT BE PORTABLE.  THE FUNCTION DXRAND MUST BE PROVIDED
C     THE USER ON SYSTEMS OTHER THAN UNIX.  DXRAND IS A DOUBLE PRECISION
C     PSEUDORANDOM NUMBER GENERATOR WHICH GIVES A UNIFORM DISTRIBUTION I
C     THE INTERVAL [0,1].  DXRAND IS INITIALIZED WITH T=DXRAND(K), K AN
C     INTEGER, K>0.  SUBSEQUENT CALLS ARE T=DXRAND(0).
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       SYLGC; (LINPACK) DSVDC;
C       RANDM; (MATU) MADD MSUB MULC MSAVE D1NRM; DXRAND
C
C     WRITTEN -
C       26FEB87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-4691
C     REVISED -
C       27JAN89 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C       14DEC90 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     -- MAXIMUM N IS 8 --
      INTEGER NAE, NQ, NW, N, IERR, MAXN, NWX, IDMY
      INTEGER NMAX, WRKLEN, MAXSVD
      PARAMETER (NMAX=8, WRKLEN=2*NMAX*NMAX+3*NMAX,
     +           MAXSVD=40)
      DOUBLE PRECISION A(NMAX,NMAX), E(NMAX,NMAX), Q(NMAX,NMAX)
      DOUBLE PRECISION WKM1(NMAX,NMAX), WKM2(NMAX,NMAX),
     +                 WKV(WRKLEN)
C
      INTEGER I, J, LL, NTEST, NXN, II, JJ, INDX, JNDX
      DOUBLE PRECISION A1(NMAX,NMAX), E1(NMAX,NMAX), Q1(NMAX,NMAX), 
     +                 WKMX(MAXSVD,MAXSVD)
      DOUBLE PRECISION TMP, NRMR, NRMQ, DPAR(3), WORST, RCOND, RCDSVD
      DOUBLE PRECISION WORSTL, WORSTH, RATIO, DUMY(1)
      DOUBLE PRECISION DXRAND, D1NRM
C
C     -- INITIALIZE --
      MAXN = NMAX
      NAE = NMAX
      NQ = NMAX
      NW = NMAX
      NWX = MAXSVD
      WORST = 0.0D0
      WORSTL = 1.0D100
      WORSTH = 0.0D0
      NTEST = 5
      TMP = DXRAND(13)
      DPAR(1) = 0.0D0
      DPAR(2) = 1.0D2
C
      WRITE(*,90000)
      WRITE(*,90001)
90000 FORMAT("             T        T")
C
90001 FORMAT(" SOLVE  A*X*E  + E*X*A  + Q = 0  USING SYLGC")
      DO 300 N = 1,MAXN
C
      WRITE(*,90005) N
C
90005 FORMAT(/ " N =", I3)
      DO 230 LL = 1,NTEST
C
C        -- GENERATE NORMALLY DIST. RANDOM DATA --
         CALL RANDM(A, NAE, N, N, DPAR, 01)
         CALL RANDM(E, NAE, N, N, DPAR, 01)
         CALL RANDM(Q, NQ, N, N, DPAR, 01)
         DO 20 J = 1,N
            DO 10 I = J,N
               Q(I,J) = (Q(I,J) + Q(J,I)) / 2.0D0
               Q(J,I) = Q(I,J)
   10       CONTINUE
   20    CONTINUE
C
C        -- SAVE A COPY --
         CALL MSAVE(NAE, NAE, N, N, A, A1)
         CALL MSAVE(NAE, NAE, N, N, E, E1)
         CALL MSAVE(NQ, NQ, N, N, Q, Q1)
C
C        -- COMPUTE NORM OF Q --
         NRMQ = D1NRM(NQ, N, N, Q)
C
C        -- COMPUTE SOLUTION, ESTIMATE CONDITION IF SVD COMPUTABLE --
         NXN = N*N
         IF (NXN .LE. MAXSVD) THEN
            IERR = 1
         ELSE
            IERR = 0
         ENDIF
         CALL SYLGC(NAE, NQ, N, A, E, Q, WKV, IERR, RCOND)
         IF (IERR .NE. 0) THEN
            WRITE(*,90003) LL, IERR
90003       FORMAT(" AT ITERATION", I2, " ERROR IN SYLGC, IERR=", I2)
         ENDIF
C
C        -- COMPUTE RESIDUAL --
         CALL MULC(NAE, NQ, NW, N, N, N, A1, Q, WKM1)
         CALL TRNATA(NAE, N, E1)
         CALL MULC(NW, NAE, NW, N, N, N, WKM1, E1, WKM2)
         CALL TRNATA(NAE, N, E1)
         CALL MADD(NQ, NW, NQ, N, N, Q1, WKM2, Q1)
         CALL MULC(NAE, NQ, NW, N, N, N, E1, Q, WKM1)
         CALL TRNATA(NAE, N, A1)
         CALL MULC(NW, NAE, NW, N, N, N, WKM1, A1, WKM2)
         CALL TRNATA(NAE, N, A1)
         CALL MADD(NQ, NW, NQ, N, N, Q1, WKM2, Q1)
C
C        -- COMPUTE NORM OF RESIDUAL --
         NRMR = D1NRM(NQ, N, N, Q1)
         TMP = NRMR/NRMQ
         IF (TMP .GT. WORST) WORST = TMP
C
C        -- COMPUTE REAL CONDITION NUMBER
         IF (NXN .LE. MAXSVD) THEN
            DO 140 J = 1,N
               DO 130 JJ = 1,N
                  DO 120 I = 1,N
                     DO 110 II = 1,N
                        INDX = N*(I-1) + II
                        JNDX = N*(J-1) + JJ
                        WKMX(INDX,JNDX) = A1(II,JJ)*E1(I,J)
     *                                    + E1(II,JJ)*A1(I,J)
  110                CONTINUE
  120             CONTINUE
  130          CONTINUE
  140       CONTINUE
            IDMY = 1
            CALL DSVDC(WKMX, NWX, NXN, NXN, WKV, WKV(NXN+1), DUMY, IDMY,
     *                 DUMY, IDMY, WKM1, 00, IERR)
            IF (IERR .NE. 0) THEN
               WRITE(*,90006) LL
90006          FORMAT(" ITERATION", I2, " SVD FAILED")
               RCDSVD = 0.0D0
            ELSE
               RCDSVD = WKV(NXN) / WKV(1)
            ENDIF
            RATIO = RCOND / RCDSVD
            IF (RATIO .LT. WORSTL) WORSTL = RATIO
            IF (RATIO .GT. WORSTH) WORSTH = RATIO
         ENDIF
C
C        -- PRINT RESULTS --
         IF (NXN .LE. MAXSVD) THEN
            WRITE(*,90002) LL, TMP, RCOND, RATIO
         ELSE
            WRITE(*,90007) LL, TMP
         ENDIF
90002    FORMAT(1X, I2, '  (NRM RESID)/(NRM Q)=', E10.3,          '  RCO
     +ND(EST)=', E10.3, ' EST/TRUE=', E10.3)
C
C
90007    FORMAT(1X, I2, '  (NRM RESID)/(NRM Q)=', E10.3)
  230 CONTINUE
  300 CONTINUE
C
      WRITE(*,90004) WORST
90004 FORMAT(/ " WORST CASE RESIDUAL IS", E10.3)
      WRITE(*,90008) WORSTL, WORSTH
C
90008 FORMAT(' WORST CASE RCOND RATIOS (EST/TRUE) ARE', E10.3,       ' (
     +LOW) AND', E10.3, ' (HIGH)')
      STOP
C --- LAST LINE OF TSYLGCR ---
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'driver9.f'
then
	echo shar: will not over-write existing file "'driver9.f'"
else
cat << "SHAR_EOF" > 'driver9.f'
C--**--CH2917--705--P:LAP--28:10:1999
C--**--CH2906--705--P:RW--28:10:1999
C--**--CH2901--705--P:R--28:10:1999
C--**--CH2892--705--B:MA--28:10:1999
C--**--CH2870--705--A:H--28:10:1999
C     -- PROGRAM TSYLGDR --
C
C     THIS PROGRAM TESTS THE SOFTWARE FOR SOLVING THE SYMMETRIC
C     SYLVESTER EQUATION
C
C        A*X*A' - E*X*E' + Q = 0    (' DENOTES TRANSPOSE)
C
C     USING RANDOMLY GENERATED COEFFICIENT MATRICES.  MATRIX ELEMENTS
C     HAVE A GAUSSIAN DISTRIBUTION WITH MEAN 0 AND STANDARD DEVIATION 1.
C     Q IS TAKEN TO BE THE SYMMETRIC PART OF A RANDOM MATRIX.
C
C     TSYLGDR MAY NOT BE PORTABLE.  THE FUNCTION DXRAND MUST BE PROVIDED
C     THE USER ON SYSTEMS OTHER THAN UNIX.  DXRAND IS A DOUBLE PRECISION
C     PSEUDORANDOM NUMBER GENERATOR WHICH GIVES A UNIFORM DISTRIBUTION I
C     THE INTERVAL [0,1].  DXRAND IS INITIALIZED WITH T=DXRAND(K), K AN
C     INTEGER, K>0.  SUBSEQUENT CALLS ARE T=DXRAND(0).
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       SYLGD; (LINPACK) DSVDC;
C       RANDM; (MATU) MADD MSUB MULC MSAVE D1NRM; DXRAND
C
C     WRITTEN -
C       26FEB87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-4691
C     REVISED -
C       27JAN89 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C       14DEC90 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     -- MAXIMUM N IS 8 --
      INTEGER NAE, NQ, NW, N, IERR, MAXN, NWX, IDMY
      INTEGER NMAX, WRKLEN, MAXSVD
      PARAMETER (NMAX=8, WRKLEN=2*NMAX*NMAX+3*NMAX,MAXSVD=40)
      DOUBLE PRECISION A(NMAX,NMAX), E(NMAX,NMAX), Q(NMAX,NMAX)
      DOUBLE PRECISION WKM1(NMAX,NMAX), WKM2(NMAX,NMAX),
     +                 WKV(WRKLEN)
C
      INTEGER I, J, LL, NTEST, NXN, II, JJ, INDX, JNDX
      DOUBLE PRECISION A1(NMAX,NMAX), E1(NMAX,NMAX), Q1(NMAX,NMAX), 
     +                 WKMX(MAXSVD,MAXSVD)
      DOUBLE PRECISION TMP, NRMR, NRMQ, DPAR(3), WORST, RCOND, RCDSVD
      DOUBLE PRECISION WORSTL, WORSTH, RATIO, DUMY(1)
      DOUBLE PRECISION DXRAND, D1NRM
C
C     -- INITIALIZE --
      MAXN = NMAX
      NAE = NMAX
      NQ = NMAX
      NW = NMAX
      NWX = MAXSVD
      WORST = 0.0D0
      WORSTL = 1.0D100
      WORSTH = 0.0D0
      NTEST = 5
      TMP = DXRAND(13)
      DPAR(1) = 0.0D0
      DPAR(2) = 1.0D2
C
      WRITE(*,90000)
      WRITE(*,90001)
90000 FORMAT("             T        T")
C
90001 FORMAT(" SOLVE  A*X*E  + E*X*A  + Q = 0  USING SYLGD")
      DO 300 N = 1,MAXN
C
      WRITE(*,90005) N
C
90005 FORMAT(/ " N =", I3)
      DO 230 LL = 1,NTEST
C
C        -- GENERATE NORMALLY DIST. RANDOM DATA --
         CALL RANDM(A, NAE, N, N, DPAR, 01)
         CALL RANDM(E, NAE, N, N, DPAR, 01)
         CALL RANDM(Q, NQ, N, N, DPAR, 01)
         DO 20 J = 1,N
            DO 10 I = J,N
               Q(I,J) = (Q(I,J) + Q(J,I)) / 2.0D0
               Q(J,I) = Q(I,J)
   10       CONTINUE
   20    CONTINUE
C
C        -- SAVE A COPY --
         CALL MSAVE(NAE, NAE, N, N, A, A1)
         CALL MSAVE(NAE, NAE, N, N, E, E1)
         CALL MSAVE(NQ, NQ, N, N, Q, Q1)
C
C        -- COMPUTE NORM OF Q --
         NRMQ = D1NRM(NQ, N, N, Q)
C
C        -- COMPUTE SOLUTION, ESTIMATE CONDITION IF SVD COMPUTABLE --
         NXN = N*N
         IF (NXN .LE. MAXSVD) THEN
            IERR = 1
         ELSE
            IERR = 0
         ENDIF
         CALL SYLGD(NAE, NQ, N, A, E, Q, WKV, IERR, RCOND)
         IF (IERR .NE. 0) THEN
            WRITE(*,90003) LL, IERR
90003       FORMAT(" AT ITERATION", I2, " ERROR IN SYLGD, IERR=", I2)
         ENDIF
C
C        -- COMPUTE RESIDUAL --
         CALL MULC(NAE, NQ, NW, N, N, N, A1, Q, WKM1)
         CALL TRNATA(NAE, N, A1)
         CALL MULC(NW, NAE, NW, N, N, N, WKM1, A1, WKM2)
         CALL TRNATA(NAE, N, A1)
         CALL MADD(NQ, NW, NQ, N, N, Q1, WKM2, Q1)
         CALL MULC(NAE, NQ, NW, N, N, N, E1, Q, WKM1)
         CALL TRNATA(NAE, N, E1)
         CALL MULC(NW, NAE, NW, N, N, N, WKM1, E1, WKM2)
         CALL TRNATA(NAE, N, E1)
         CALL MSUB(NQ, NW, NQ, N, N, Q1, WKM2, Q1)
C
C        -- COMPUTE NORM OF RESIDUAL --
         NRMR = D1NRM(NQ, N, N, Q1)
         TMP = NRMR/NRMQ
         IF (TMP .GT. WORST) WORST = TMP
C
C        -- COMPUTE REAL CONDITION NUMBER
         IF (NXN .LE. MAXSVD) THEN
            DO 140 J = 1,N
               DO 130 JJ = 1,N
                  DO 120 I = 1,N
                     DO 110 II = 1,N
                        INDX = N*(I-1) + II
                        JNDX = N*(J-1) + JJ
                        WKMX(INDX,JNDX) = A1(II,JJ)*A1(I,J)
     *                                    - E1(II,JJ)*E1(I,J)
  110                CONTINUE
  120             CONTINUE
  130          CONTINUE
  140       CONTINUE
            IDMY = 1
            CALL DSVDC(WKMX, NWX, NXN, NXN, WKV, WKV(NXN+1), DUMY, IDMY,
     *                 DUMY, IDMY, WKM1, 00, IERR)
            IF (IERR .NE. 0) THEN
               WRITE(*,90006) LL
90006          FORMAT(" ITERATION", I2, " SVD FAILED")
               RCDSVD = 0.0D0
            ELSE
               RCDSVD = WKV(NXN) / WKV(1)
            ENDIF
            RATIO = RCOND / RCDSVD
            IF (RATIO .LT. WORSTL) WORSTL = RATIO
            IF (RATIO .GT. WORSTH) WORSTH = RATIO
         ENDIF
C
C        -- PRINT RESULTS --
         IF (NXN .LE. MAXSVD) THEN
            WRITE(*,90002) LL, TMP, RCOND, RATIO
         ELSE
            WRITE(*,90007) LL, TMP
         ENDIF
90002    FORMAT(1X, I2, '  (NRM RESID)/(NRM Q)=', E10.3,          '  RCO
     +ND(EST)=', E10.3, ' EST/TRUE=', E10.3)
C
C
90007    FORMAT(1X, I2, '  (NRM RESID)/(NRM Q)=', E10.3)
  230 CONTINUE
  300 CONTINUE
C
      WRITE(*,90004) WORST
90004 FORMAT(/ " WORST CASE RESIDUAL IS", E10.3)
      WRITE(*,90008) WORSTL, WORSTH
C
90008 FORMAT(' WORST CASE RCOND RATIOS (EST/TRUE) ARE', E10.3,       ' (
     +LOW) AND', E10.3, ' (HIGH)')
      STOP
C --- LAST LINE OF TSYLGDR ---
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'portrand.f'
then
	echo shar: will not over-write existing file "'portrand.f'"
else
cat << "SHAR_EOF" > 'portrand.f'
      REAL FUNCTION RAND()
C..PORTABLE RANDOM NUMBER GENERATOR
C..USING THE RECURSION -
C..
C..       IX=IX*A MOD P
      INTEGER A,P,IX,B15,B16,XHI,XALO,LEFTLO,FHI,K
C..7**5, 2**15,  2**16, 2**31-1
      PARAMETER (A=16807, B15=32768, B16=65536,
     +           P=2147483647)
      COMMON /RANCOM/ IX
      SAVE /RANCOM/
C
C..GET 15 HIGH ORDER BITS OF IX
      XHI=IX/B16
C..GET 16 LO BITS OF IX AND FORM LO PRODUCT
      XALO=(IX-XHI*B16)*A
C..GET 15 HI ORDER BITS OF LO PRODUCT
      LEFTLO=XALO/B16
C..FORM THE 31 HIGHEST BITS OF FULL PRODUCT
      FHI=XHI*A + LEFTLO
C..GET OVERFLOW PAST 31ST BIT OF FULL PRODUCT
      K=FHI/B15
C..ASSEMBLE ALL THE PARTS AND PRESUBTRACT P
C..THE PARENTHESES ARE ESSENTIAL
      IX=(((XALO-LEFTLO*B16)-P)+(FHI-K*B15)*B16)+K
C..ADD P BACK IN IF NECESSARY
      IF(IX.LT.0)IX=IX+P
C..MULTIPLY BY 1/(2**31-1)
      RAND=FLOAT(IX)*4.656612875E-10
      RETURN
      END

      subroutine seed(iseed)
c
c seed the portable random number generator
c
      integer iseed, ix
      common /rancom/ ix
      SAVE /RANCOM/
      ix = iseed
      end
SHAR_EOF
fi # end of overwriting check
if test -f 'res1'
then
	echo shar: will not over-write existing file "'res1'"
else
cat << "SHAR_EOF" > 'res1'
             T        T
 SOLVE  A*X*B  + C*X*D  = E  USING SYLG

 M =  2   N =  2
  0  (NRM RESID)/(NRM E)= 0.508E-15  RCOND(EST)= 0.909E-01 EST/TRUE= 0.623E+00
 10  (NRM RESID)/(NRM E)= 0.610E-15  RCOND(EST)= 0.351E-03 EST/TRUE= 0.360E+00
 20  (NRM RESID)/(NRM E)= 0.722E-15  RCOND(EST)= 0.343E-06 EST/TRUE= 0.360E+00
 30  (NRM RESID)/(NRM E)= 0.611E-15  RCOND(EST)= 0.335E-09 EST/TRUE= 0.360E+00
 40  (NRM RESID)/(NRM E)= 0.389E-15  RCOND(EST)= 0.327E-12 EST/TRUE= 0.360E+00

 M =  2   N =  3
  0  (NRM RESID)/(NRM E)= 0.888E-16  RCOND(EST)= 0.410E-01 EST/TRUE= 0.430E+00
 10  (NRM RESID)/(NRM E)= 0.518E-15  RCOND(EST)= 0.138E-03 EST/TRUE= 0.317E+00
 20  (NRM RESID)/(NRM E)= 0.444E-15  RCOND(EST)= 0.135E-06 EST/TRUE= 0.317E+00
 30  (NRM RESID)/(NRM E)= 0.407E-15  RCOND(EST)= 0.132E-09 EST/TRUE= 0.317E+00
 40  (NRM RESID)/(NRM E)= 0.444E-15  RCOND(EST)= 0.129E-12 EST/TRUE= 0.317E+00

 M =  2   N =  4
  0  (NRM RESID)/(NRM E)= 0.256E-15  RCOND(EST)= 0.322E-01 EST/TRUE= 0.458E+00
 10  (NRM RESID)/(NRM E)= 0.105E-14  RCOND(EST)= 0.102E-03 EST/TRUE= 0.398E+00
 20  (NRM RESID)/(NRM E)= 0.833E-15  RCOND(EST)= 0.992E-07 EST/TRUE= 0.397E+00
 30  (NRM RESID)/(NRM E)= 0.611E-15  RCOND(EST)= 0.809E-10 EST/TRUE= 0.331E+00
 40  (NRM RESID)/(NRM E)= 0.611E-15  RCOND(EST)= 0.946E-13 EST/TRUE= 0.397E+00

 M =  2   N =  5
  0  (NRM RESID)/(NRM E)= 0.444E-15  RCOND(EST)= 0.273E-01 EST/TRUE= 0.495E+00
 10  (NRM RESID)/(NRM E)= 0.799E-15  RCOND(EST)= 0.107E-03 EST/TRUE= 0.621E+00
 20  (NRM RESID)/(NRM E)= 0.888E-15  RCOND(EST)= 0.104E-06 EST/TRUE= 0.618E+00
 30  (NRM RESID)/(NRM E)= 0.115E-14  RCOND(EST)= 0.101E-09 EST/TRUE= 0.618E+00
 40  (NRM RESID)/(NRM E)= 0.977E-15  RCOND(EST)= 0.990E-13 EST/TRUE= 0.617E+00

 M =  2   N =  6
  0  (NRM RESID)/(NRM E)= 0.608E-15  RCOND(EST)= 0.245E-01 EST/TRUE= 0.540E+00
 10  (NRM RESID)/(NRM E)= 0.925E-15  RCOND(EST)= 0.701E-04 EST/TRUE= 0.555E+00
 20  (NRM RESID)/(NRM E)= 0.163E-14  RCOND(EST)= 0.677E-07 EST/TRUE= 0.552E+00
 30  (NRM RESID)/(NRM E)= 0.592E-15  RCOND(EST)= 0.661E-10 EST/TRUE= 0.552E+00
 40  (NRM RESID)/(NRM E)= 0.814E-15  RCOND(EST)= 0.646E-13 EST/TRUE= 0.552E+00

 M =  2   N =  7
  0  (NRM RESID)/(NRM E)= 0.525E-15  RCOND(EST)= 0.213E-01 EST/TRUE= 0.555E+00
 10  (NRM RESID)/(NRM E)= 0.114E-14  RCOND(EST)= 0.713E-04 EST/TRUE= 0.733E+00
 20  (NRM RESID)/(NRM E)= 0.888E-15  RCOND(EST)= 0.688E-07 EST/TRUE= 0.729E+00
 30  (NRM RESID)/(NRM E)= 0.397E-15  RCOND(EST)= 0.672E-10 EST/TRUE= 0.729E+00
 40  (NRM RESID)/(NRM E)= 0.476E-15  RCOND(EST)= 0.656E-13 EST/TRUE= 0.729E+00

 M =  2   N =  8
  0  (NRM RESID)/(NRM E)= 0.135E-14  RCOND(EST)= 0.185E-01 EST/TRUE= 0.559E+00
 10  (NRM RESID)/(NRM E)= 0.153E-14  RCOND(EST)= 0.538E-04 EST/TRUE= 0.690E+00
 20  (NRM RESID)/(NRM E)= 0.500E-15  RCOND(EST)= 0.519E-07 EST/TRUE= 0.687E+00
 30  (NRM RESID)/(NRM E)= 0.999E-15  RCOND(EST)= 0.507E-10 EST/TRUE= 0.687E+00
 40  (NRM RESID)/(NRM E)= 0.122E-14  RCOND(EST)= 0.495E-13 EST/TRUE= 0.689E+00

 M =  3   N =  2
  0  (NRM RESID)/(NRM E)= 0.740E-15  RCOND(EST)= 0.146E-01 EST/TRUE= 0.468E+00
 10  (NRM RESID)/(NRM E)= 0.740E-15  RCOND(EST)= 0.456E-04 EST/TRUE= 0.395E+00
 20  (NRM RESID)/(NRM E)= 0.432E-15  RCOND(EST)= 0.441E-07 EST/TRUE= 0.394E+00
 30  (NRM RESID)/(NRM E)= 0.678E-15  RCOND(EST)= 0.430E-10 EST/TRUE= 0.394E+00
 40  (NRM RESID)/(NRM E)= 0.173E-15  RCOND(EST)= 0.421E-13 EST/TRUE= 0.394E+00

 M =  3   N =  3
  0  (NRM RESID)/(NRM E)= 0.285E-15  RCOND(EST)= 0.358E-02 EST/TRUE= 0.511E+00
 10  (NRM RESID)/(NRM E)= 0.490E-15  RCOND(EST)= 0.222E-04 EST/TRUE= 0.288E+00
 20  (NRM RESID)/(NRM E)= 0.444E-15  RCOND(EST)= 0.214E-07 EST/TRUE= 0.288E+00
 30  (NRM RESID)/(NRM E)= 0.407E-15  RCOND(EST)= 0.209E-10 EST/TRUE= 0.288E+00
 40  (NRM RESID)/(NRM E)= 0.333E-15  RCOND(EST)= 0.204E-13 EST/TRUE= 0.288E+00

 M =  3   N =  4
  0  (NRM RESID)/(NRM E)= 0.293E-15  RCOND(EST)= 0.145E-02 EST/TRUE= 0.459E+00
 10  (NRM RESID)/(NRM E)= 0.109E-14  RCOND(EST)= 0.165E-04 EST/TRUE= 0.310E+00
 20  (NRM RESID)/(NRM E)= 0.918E-15  RCOND(EST)= 0.157E-07 EST/TRUE= 0.309E+00
 30  (NRM RESID)/(NRM E)= 0.503E-15  RCOND(EST)= 0.136E-10 EST/TRUE= 0.274E+00
 40  (NRM RESID)/(NRM E)= 0.533E-15  RCOND(EST)= 0.150E-13 EST/TRUE= 0.309E+00

 M =  3   N =  5
  0  (NRM RESID)/(NRM E)= 0.431E-15  RCOND(EST)= 0.726E-03 EST/TRUE= 0.411E+00
 10  (NRM RESID)/(NRM E)= 0.641E-15  RCOND(EST)= 0.123E-04 EST/TRUE= 0.332E+00
 20  (NRM RESID)/(NRM E)= 0.777E-15  RCOND(EST)= 0.117E-07 EST/TRUE= 0.332E+00
 30  (NRM RESID)/(NRM E)= 0.106E-14  RCOND(EST)= 0.114E-10 EST/TRUE= 0.332E+00
 40  (NRM RESID)/(NRM E)= 0.765E-15  RCOND(EST)= 0.112E-13 EST/TRUE= 0.333E+00

 M =  3   N =  6
  0  (NRM RESID)/(NRM E)= 0.539E-15  RCOND(EST)= 0.413E-03 EST/TRUE= 0.372E+00
 10  (NRM RESID)/(NRM E)= 0.740E-15  RCOND(EST)= 0.875E-05 EST/TRUE= 0.315E+00
 20  (NRM RESID)/(NRM E)= 0.133E-14  RCOND(EST)= 0.825E-08 EST/TRUE= 0.314E+00
 30  (NRM RESID)/(NRM E)= 0.634E-15  RCOND(EST)= 0.806E-11 EST/TRUE= 0.314E+00
 40  (NRM RESID)/(NRM E)= 0.825E-15  RCOND(EST)= 0.787E-14 EST/TRUE= 0.315E+00

 M =  3   N =  7
  0  (NRM RESID)/(NRM E)= 0.743E-15  RCOND(EST)= 0.264E-03 EST/TRUE= 0.351E+00
 10  (NRM RESID)/(NRM E)= 0.925E-15  RCOND(EST)= 0.849E-05 EST/TRUE= 0.389E+00
 20  (NRM RESID)/(NRM E)= 0.481E-15  RCOND(EST)= 0.795E-08 EST/TRUE= 0.388E+00
 30  (NRM RESID)/(NRM E)= 0.481E-15  RCOND(EST)= 0.777E-11 EST/TRUE= 0.388E+00
 40  (NRM RESID)/(NRM E)= 0.555E-15  RCOND(EST)= 0.759E-14 EST/TRUE= 0.389E+00

 M =  3   N =  8
  0  (NRM RESID)/(NRM E)= 0.108E-14  RCOND(EST)= 0.210E-03 EST/TRUE= 0.389E+00
 10  (NRM RESID)/(NRM E)= 0.145E-14  RCOND(EST)= 0.677E-05 EST/TRUE= 0.380E+00
 20  (NRM RESID)/(NRM E)= 0.724E-15  RCOND(EST)= 0.630E-08 EST/TRUE= 0.380E+00
 30  (NRM RESID)/(NRM E)= 0.987E-15  RCOND(EST)= 0.615E-11 EST/TRUE= 0.380E+00
 40  (NRM RESID)/(NRM E)= 0.921E-15  RCOND(EST)= 0.599E-14 EST/TRUE= 0.380E+00

 M =  4   N =  2
  0  (NRM RESID)/(NRM E)= 0.752E-15  RCOND(EST)= 0.118E-01 EST/TRUE= 0.432E+00
 10  (NRM RESID)/(NRM E)= 0.631E-15  RCOND(EST)= 0.437E-04 EST/TRUE= 0.536E+00
 20  (NRM RESID)/(NRM E)= 0.965E-15  RCOND(EST)= 0.424E-07 EST/TRUE= 0.535E+00
 30  (NRM RESID)/(NRM E)= 0.888E-15  RCOND(EST)= 0.414E-10 EST/TRUE= 0.535E+00
 40  (NRM RESID)/(NRM E)= 0.382E-15  RCOND(EST)= 0.404E-13 EST/TRUE= 0.535E+00

 M =  4   N =  3
  0  (NRM RESID)/(NRM E)= 0.205E-15  RCOND(EST)= 0.424E-02 EST/TRUE= 0.640E+00
 10  (NRM RESID)/(NRM E)= 0.438E-15  RCOND(EST)= 0.135E-04 EST/TRUE= 0.312E+00
 20  (NRM RESID)/(NRM E)= 0.411E-15  RCOND(EST)= 0.130E-07 EST/TRUE= 0.312E+00
 30  (NRM RESID)/(NRM E)= 0.488E-15  RCOND(EST)= 0.127E-10 EST/TRUE= 0.312E+00
 40  (NRM RESID)/(NRM E)= 0.222E-15  RCOND(EST)= 0.124E-13 EST/TRUE= 0.312E+00

 M =  4   N =  4
  0  (NRM RESID)/(NRM E)= 0.315E-15  RCOND(EST)= 0.167E-02 EST/TRUE= 0.563E+00
 10  (NRM RESID)/(NRM E)= 0.980E-15  RCOND(EST)= 0.944E-05 EST/TRUE= 0.307E+00
 20  (NRM RESID)/(NRM E)= 0.981E-15  RCOND(EST)= 0.902E-08 EST/TRUE= 0.307E+00
 30  (NRM RESID)/(NRM E)= 0.629E-15  RCOND(EST)= 0.702E-11 EST/TRUE= 0.244E+00
 40  (NRM RESID)/(NRM E)= 0.463E-15  RCOND(EST)= 0.860E-14 EST/TRUE= 0.307E+00

 M =  4   N =  5
  0  (NRM RESID)/(NRM E)= 0.258E-15  RCOND(EST)= 0.745E-03 EST/TRUE= 0.429E+00
 10  (NRM RESID)/(NRM E)= 0.507E-15  RCOND(EST)= 0.683E-05 EST/TRUE= 0.284E+00
 20  (NRM RESID)/(NRM E)= 0.539E-15  RCOND(EST)= 0.646E-08 EST/TRUE= 0.284E+00
 30  (NRM RESID)/(NRM E)= 0.983E-15  RCOND(EST)= 0.631E-11 EST/TRUE= 0.284E+00
 40  (NRM RESID)/(NRM E)= 0.476E-15  RCOND(EST)= 0.616E-14 EST/TRUE= 0.284E+00

 M =  4   N =  6
  0  (NRM RESID)/(NRM E)= 0.432E-15  RCOND(EST)= 0.409E-03 EST/TRUE= 0.354E+00
 10  (NRM RESID)/(NRM E)= 0.915E-15  RCOND(EST)= 0.502E-05 EST/TRUE= 0.281E+00
 20  (NRM RESID)/(NRM E)= 0.129E-14  RCOND(EST)= 0.472E-08 EST/TRUE= 0.281E+00
 30  (NRM RESID)/(NRM E)= 0.874E-15  RCOND(EST)= 0.461E-11 EST/TRUE= 0.281E+00
 40  (NRM RESID)/(NRM E)= 0.680E-15  RCOND(EST)= 0.450E-14 EST/TRUE= 0.282E+00

 M =  4   N =  7
  0  (NRM RESID)/(NRM E)= 0.645E-15  RCOND(EST)= 0.284E-03 EST/TRUE= 0.340E+00
 10  (NRM RESID)/(NRM E)= 0.690E-15  RCOND(EST)= 0.488E-05 EST/TRUE= 0.353E+00
 20  (NRM RESID)/(NRM E)= 0.518E-15  RCOND(EST)= 0.455E-08 EST/TRUE= 0.352E+00
 30  (NRM RESID)/(NRM E)= 0.475E-15  RCOND(EST)= 0.445E-11 EST/TRUE= 0.352E+00
 40  (NRM RESID)/(NRM E)= 0.765E-15  RCOND(EST)= 0.434E-14 EST/TRUE= 0.352E+00

 M =  4   N =  8
  0  (NRM RESID)/(NRM E)= 0.111E-14  RCOND(EST)= 0.452E-03 EST/TRUE= 0.719E+00
 10  (NRM RESID)/(NRM E)= 0.118E-14  RCOND(EST)= 0.395E-05 EST/TRUE= 0.355E+00
 20  (NRM RESID)/(NRM E)= 0.511E-15  RCOND(EST)= 0.366E-08 EST/TRUE= 0.354E+00
 30  (NRM RESID)/(NRM E)= 0.933E-15  RCOND(EST)= 0.357E-11 EST/TRUE= 0.354E+00
 40  (NRM RESID)/(NRM E)= 0.644E-15  RCOND(EST)= 0.349E-14 EST/TRUE= 0.353E+00

 M =  5   N =  2
  0  (NRM RESID)/(NRM E)= 0.607E-15  RCOND(EST)= 0.100E-01 EST/TRUE= 0.423E+00
 10  (NRM RESID)/(NRM E)= 0.773E-15  RCOND(EST)= 0.408E-04 EST/TRUE= 0.648E+00
 20  (NRM RESID)/(NRM E)= 0.759E-15  RCOND(EST)= 0.396E-07 EST/TRUE= 0.647E+00
 30  (NRM RESID)/(NRM E)= 0.746E-15  RCOND(EST)= 0.387E-10 EST/TRUE= 0.647E+00
 40  (NRM RESID)/(NRM E)= 0.289E-15  RCOND(EST)= 0.377E-13 EST/TRUE= 0.647E+00

 M =  5   N =  3
  0  (NRM RESID)/(NRM E)= 0.233E-15  RCOND(EST)= 0.366E-02 EST/TRUE= 0.586E+00
 10  (NRM RESID)/(NRM E)= 0.473E-15  RCOND(EST)= 0.122E-04 EST/TRUE= 0.360E+00
 20  (NRM RESID)/(NRM E)= 0.681E-15  RCOND(EST)= 0.118E-07 EST/TRUE= 0.361E+00
 30  (NRM RESID)/(NRM E)= 0.563E-15  RCOND(EST)= 0.115E-10 EST/TRUE= 0.361E+00
 40  (NRM RESID)/(NRM E)= 0.178E-15  RCOND(EST)= 0.112E-13 EST/TRUE= 0.361E+00

 M =  5   N =  4
  0  (NRM RESID)/(NRM E)= 0.288E-15  RCOND(EST)= 0.124E-02 EST/TRUE= 0.861E+00
 10  (NRM RESID)/(NRM E)= 0.101E-14  RCOND(EST)= 0.665E-05 EST/TRUE= 0.302E+00
 20  (NRM RESID)/(NRM E)= 0.124E-14  RCOND(EST)= 0.635E-08 EST/TRUE= 0.302E+00
 30  (NRM RESID)/(NRM E)= 0.450E-15  RCOND(EST)= 0.562E-11 EST/TRUE= 0.274E+00
 40  (NRM RESID)/(NRM E)= 0.406E-15  RCOND(EST)= 0.605E-14 EST/TRUE= 0.302E+00

 M =  5   N =  5
  0  (NRM RESID)/(NRM E)= 0.499E-15  RCOND(EST)= 0.210E-03 EST/TRUE= 0.954E+00
 10  (NRM RESID)/(NRM E)= 0.471E-15  RCOND(EST)= 0.518E-05 EST/TRUE= 0.311E+00
 20  (NRM RESID)/(NRM E)= 0.450E-15  RCOND(EST)= 0.492E-08 EST/TRUE= 0.313E+00
 30  (NRM RESID)/(NRM E)= 0.977E-15  RCOND(EST)= 0.480E-11 EST/TRUE= 0.313E+00
 40  (NRM RESID)/(NRM E)= 0.422E-15  RCOND(EST)= 0.468E-14 EST/TRUE= 0.312E+00

 M =  5   N =  6
  0  (NRM RESID)/(NRM E)= 0.547E-15  RCOND(EST)= 0.627E-04 EST/TRUE= 0.926E+00
 10  (NRM RESID)/(NRM E)= 0.907E-15  RCOND(EST)= 0.358E-05 EST/TRUE= 0.265E+00
 20  (NRM RESID)/(NRM E)= 0.116E-14  RCOND(EST)= 0.337E-08 EST/TRUE= 0.266E+00
 30  (NRM RESID)/(NRM E)= 0.888E-15  RCOND(EST)= 0.329E-11 EST/TRUE= 0.266E+00
 40  (NRM RESID)/(NRM E)= 0.701E-15  RCOND(EST)= 0.322E-14 EST/TRUE= 0.265E+00

 M =  5   N =  7
  0  (NRM RESID)/(NRM E)= 0.820E-15  RCOND(EST)= 0.248E-04 EST/TRUE= 0.889E+00
 10  (NRM RESID)/(NRM E)= 0.985E-15  RCOND(EST)= 0.348E-05 EST/TRUE= 0.318E+00
 20  (NRM RESID)/(NRM E)= 0.497E-15  RCOND(EST)= 0.325E-08 EST/TRUE= 0.319E+00
 30  (NRM RESID)/(NRM E)= 0.506E-15  RCOND(EST)= 0.318E-11 EST/TRUE= 0.319E+00
 40  (NRM RESID)/(NRM E)= 0.853E-15  RCOND(EST)= 0.310E-14 EST/TRUE= 0.317E+00

 M =  5   N =  8
  0  (NRM RESID)/(NRM E)= 0.984E-15  RCOND(EST)= 0.114E-04 EST/TRUE= 0.841E+00
 10  (NRM RESID)/(NRM E)= 0.131E-14  RCOND(EST)= 0.287E-05 EST/TRUE= 0.328E+00
 20  (NRM RESID)/(NRM E)= 0.565E-15  RCOND(EST)= 0.266E-08 EST/TRUE= 0.330E+00
 30  (NRM RESID)/(NRM E)= 0.120E-14  RCOND(EST)= 0.260E-11 EST/TRUE= 0.330E+00
 40  (NRM RESID)/(NRM E)= 0.646E-15  RCOND(EST)= 0.254E-14 EST/TRUE= 0.328E+00

 M =  6   N =  2
  0  (NRM RESID)/(NRM E)= 0.911E-15  RCOND(EST)= 0.900E-02 EST/TRUE= 0.432E+00
 10  (NRM RESID)/(NRM E)= 0.555E-15  RCOND(EST)= 0.377E-04 EST/TRUE= 0.736E+00
 20  (NRM RESID)/(NRM E)= 0.904E-15  RCOND(EST)= 0.366E-07 EST/TRUE= 0.735E+00
 30  (NRM RESID)/(NRM E)= 0.802E-15  RCOND(EST)= 0.357E-10 EST/TRUE= 0.735E+00
 40  (NRM RESID)/(NRM E)= 0.549E-15  RCOND(EST)= 0.349E-13 EST/TRUE= 0.735E+00

 M =  6   N =  3
  0  (NRM RESID)/(NRM E)= 0.434E-15  RCOND(EST)= 0.317E-02 EST/TRUE= 0.546E+00
 10  (NRM RESID)/(NRM E)= 0.518E-15  RCOND(EST)= 0.115E-04 EST/TRUE= 0.417E+00
 20  (NRM RESID)/(NRM E)= 0.455E-15  RCOND(EST)= 0.112E-07 EST/TRUE= 0.418E+00
 30  (NRM RESID)/(NRM E)= 0.391E-15  RCOND(EST)= 0.109E-10 EST/TRUE= 0.418E+00
 40  (NRM RESID)/(NRM E)= 0.222E-15  RCOND(EST)= 0.107E-13 EST/TRUE= 0.418E+00

 M =  6   N =  4
  0  (NRM RESID)/(NRM E)= 0.645E-15  RCOND(EST)= 0.115E-02 EST/TRUE= 0.812E+00
 10  (NRM RESID)/(NRM E)= 0.869E-15  RCOND(EST)= 0.651E-05 EST/TRUE= 0.359E+00
 20  (NRM RESID)/(NRM E)= 0.114E-14  RCOND(EST)= 0.626E-08 EST/TRUE= 0.359E+00
 30  (NRM RESID)/(NRM E)= 0.282E-15  RCOND(EST)= 0.515E-11 EST/TRUE= 0.303E+00
 40  (NRM RESID)/(NRM E)= 0.463E-15  RCOND(EST)= 0.598E-14 EST/TRUE= 0.360E+00

 M =  6   N =  5
  0  (NRM RESID)/(NRM E)= 0.558E-15  RCOND(EST)= 0.387E-03 EST/TRUE= 0.114E+01
 10  (NRM RESID)/(NRM E)= 0.649E-15  RCOND(EST)= 0.430E-05 EST/TRUE= 0.328E+00
 20  (NRM RESID)/(NRM E)= 0.321E-15  RCOND(EST)= 0.407E-08 EST/TRUE= 0.328E+00
 30  (NRM RESID)/(NRM E)= 0.872E-15  RCOND(EST)= 0.397E-11 EST/TRUE= 0.328E+00
 40  (NRM RESID)/(NRM E)= 0.650E-15  RCOND(EST)= 0.389E-14 EST/TRUE= 0.328E+00

 M =  6   N =  6
  0  (NRM RESID)/(NRM E)= 0.631E-15  RCOND(EST)= 0.757E-04 EST/TRUE= 0.119E+01
 10  (NRM RESID)/(NRM E)= 0.821E-15  RCOND(EST)= 0.279E-05 EST/TRUE= 0.269E+00
 20  (NRM RESID)/(NRM E)= 0.117E-14  RCOND(EST)= 0.261E-08 EST/TRUE= 0.269E+00
 30  (NRM RESID)/(NRM E)= 0.866E-15  RCOND(EST)= 0.255E-11 EST/TRUE= 0.269E+00
 40  (NRM RESID)/(NRM E)= 0.703E-15  RCOND(EST)= 0.250E-14 EST/TRUE= 0.270E+00

 M =  6   N =  7
  0  (NRM RESID)/(NRM E)= 0.572E-15
 10  (NRM RESID)/(NRM E)= 0.974E-15
 20  (NRM RESID)/(NRM E)= 0.404E-15
 30  (NRM RESID)/(NRM E)= 0.481E-15
 40  (NRM RESID)/(NRM E)= 0.915E-15

 M =  6   N =  8
  0  (NRM RESID)/(NRM E)= 0.117E-14
 10  (NRM RESID)/(NRM E)= 0.142E-14
 20  (NRM RESID)/(NRM E)= 0.506E-15
 30  (NRM RESID)/(NRM E)= 0.102E-14
 40  (NRM RESID)/(NRM E)= 0.901E-15

 M =  7   N =  2
  0  (NRM RESID)/(NRM E)= 0.722E-15  RCOND(EST)= 0.802E-02 EST/TRUE= 0.433E+00
 10  (NRM RESID)/(NRM E)= 0.779E-15  RCOND(EST)= 0.348E-04 EST/TRUE= 0.806E+00
 20  (NRM RESID)/(NRM E)= 0.666E-15  RCOND(EST)= 0.338E-07 EST/TRUE= 0.805E+00
 30  (NRM RESID)/(NRM E)= 0.911E-15  RCOND(EST)= 0.330E-10 EST/TRUE= 0.805E+00
 40  (NRM RESID)/(NRM E)= 0.800E-15  RCOND(EST)= 0.322E-13 EST/TRUE= 0.805E+00

 M =  7   N =  3
  0  (NRM RESID)/(NRM E)= 0.336E-15  RCOND(EST)= 0.283E-02 EST/TRUE= 0.525E+00
 10  (NRM RESID)/(NRM E)= 0.333E-15  RCOND(EST)= 0.107E-04 EST/TRUE= 0.457E+00
 20  (NRM RESID)/(NRM E)= 0.539E-15  RCOND(EST)= 0.104E-07 EST/TRUE= 0.458E+00
 30  (NRM RESID)/(NRM E)= 0.591E-15  RCOND(EST)= 0.102E-10 EST/TRUE= 0.458E+00
 40  (NRM RESID)/(NRM E)= 0.151E-15  RCOND(EST)= 0.993E-14 EST/TRUE= 0.458E+00

 M =  7   N =  4
  0  (NRM RESID)/(NRM E)= 0.408E-15  RCOND(EST)= 0.105E-02 EST/TRUE= 0.772E+00
 10  (NRM RESID)/(NRM E)= 0.873E-15  RCOND(EST)= 0.598E-05 EST/TRUE= 0.387E+00
 20  (NRM RESID)/(NRM E)= 0.846E-15  RCOND(EST)= 0.577E-08 EST/TRUE= 0.388E+00
 30  (NRM RESID)/(NRM E)= 0.338E-15  RCOND(EST)= 0.474E-11 EST/TRUE= 0.327E+00
 40  (NRM RESID)/(NRM E)= 0.486E-15  RCOND(EST)= 0.550E-14 EST/TRUE= 0.390E+00

 M =  7   N =  5
  0  (NRM RESID)/(NRM E)= 0.543E-15  RCOND(EST)= 0.393E-03 EST/TRUE= 0.116E+01
 10  (NRM RESID)/(NRM E)= 0.615E-15  RCOND(EST)= 0.377E-05 EST/TRUE= 0.337E+00
 20  (NRM RESID)/(NRM E)= 0.634E-15  RCOND(EST)= 0.358E-08 EST/TRUE= 0.336E+00
 30  (NRM RESID)/(NRM E)= 0.110E-14  RCOND(EST)= 0.350E-11 EST/TRUE= 0.336E+00
 40  (NRM RESID)/(NRM E)= 0.723E-15  RCOND(EST)= 0.342E-14 EST/TRUE= 0.337E+00

 M =  7   N =  6
  0  (NRM RESID)/(NRM E)= 0.696E-15
 10  (NRM RESID)/(NRM E)= 0.858E-15
 20  (NRM RESID)/(NRM E)= 0.946E-15
 30  (NRM RESID)/(NRM E)= 0.105E-14
 40  (NRM RESID)/(NRM E)= 0.721E-15

 M =  7   N =  7
  0  (NRM RESID)/(NRM E)= 0.630E-15
 10  (NRM RESID)/(NRM E)= 0.898E-15
 20  (NRM RESID)/(NRM E)= 0.434E-15
 30  (NRM RESID)/(NRM E)= 0.486E-15
 40  (NRM RESID)/(NRM E)= 0.108E-14

 M =  7   N =  8
  0  (NRM RESID)/(NRM E)= 0.114E-14
 10  (NRM RESID)/(NRM E)= 0.106E-14
 20  (NRM RESID)/(NRM E)= 0.590E-15
 30  (NRM RESID)/(NRM E)= 0.937E-15
 40  (NRM RESID)/(NRM E)= 0.810E-15

 M =  8   N =  2
  0  (NRM RESID)/(NRM E)= 0.496E-15  RCOND(EST)= 0.701E-02 EST/TRUE= 0.420E+00
 10  (NRM RESID)/(NRM E)= 0.666E-15  RCOND(EST)= 0.321E-04 EST/TRUE= 0.861E+00
 20  (NRM RESID)/(NRM E)= 0.914E-15  RCOND(EST)= 0.312E-07 EST/TRUE= 0.860E+00
 30  (NRM RESID)/(NRM E)= 0.770E-15  RCOND(EST)= 0.305E-10 EST/TRUE= 0.860E+00
 40  (NRM RESID)/(NRM E)= 0.670E-15  RCOND(EST)= 0.298E-13 EST/TRUE= 0.860E+00

 M =  8   N =  3
  0  (NRM RESID)/(NRM E)= 0.407E-15  RCOND(EST)= 0.256E-02 EST/TRUE= 0.509E+00
 10  (NRM RESID)/(NRM E)= 0.401E-15  RCOND(EST)= 0.985E-05 EST/TRUE= 0.483E+00
 20  (NRM RESID)/(NRM E)= 0.540E-15  RCOND(EST)= 0.955E-08 EST/TRUE= 0.485E+00
 30  (NRM RESID)/(NRM E)= 0.629E-15  RCOND(EST)= 0.933E-11 EST/TRUE= 0.485E+00
 40  (NRM RESID)/(NRM E)= 0.281E-15  RCOND(EST)= 0.911E-14 EST/TRUE= 0.484E+00

 M =  8   N =  4
  0  (NRM RESID)/(NRM E)= 0.388E-15  RCOND(EST)= 0.950E-03 EST/TRUE= 0.734E+00
 10  (NRM RESID)/(NRM E)= 0.887E-15  RCOND(EST)= 0.562E-05 EST/TRUE= 0.418E+00
 20  (NRM RESID)/(NRM E)= 0.118E-14  RCOND(EST)= 0.542E-08 EST/TRUE= 0.419E+00
 30  (NRM RESID)/(NRM E)= 0.416E-15  RCOND(EST)= 0.465E-11 EST/TRUE= 0.368E+00
 40  (NRM RESID)/(NRM E)= 0.444E-15  RCOND(EST)= 0.518E-14 EST/TRUE= 0.420E+00

 M =  8   N =  5
  0  (NRM RESID)/(NRM E)= 0.479E-15  RCOND(EST)= 0.362E-03 EST/TRUE= 0.109E+01
 10  (NRM RESID)/(NRM E)= 0.640E-15  RCOND(EST)= 0.385E-05 EST/TRUE= 0.395E+00
 20  (NRM RESID)/(NRM E)= 0.585E-15  RCOND(EST)= 0.368E-08 EST/TRUE= 0.394E+00
 30  (NRM RESID)/(NRM E)= 0.118E-14  RCOND(EST)= 0.359E-11 EST/TRUE= 0.394E+00
 40  (NRM RESID)/(NRM E)= 0.707E-15  RCOND(EST)= 0.351E-14 EST/TRUE= 0.394E+00

 M =  8   N =  6
  0  (NRM RESID)/(NRM E)= 0.923E-15
 10  (NRM RESID)/(NRM E)= 0.832E-15
 20  (NRM RESID)/(NRM E)= 0.851E-15
 30  (NRM RESID)/(NRM E)= 0.860E-15
 40  (NRM RESID)/(NRM E)= 0.465E-15

 M =  8   N =  7
  0  (NRM RESID)/(NRM E)= 0.536E-15
 10  (NRM RESID)/(NRM E)= 0.109E-14
 20  (NRM RESID)/(NRM E)= 0.564E-15
 30  (NRM RESID)/(NRM E)= 0.623E-15
 40  (NRM RESID)/(NRM E)= 0.114E-14

 M =  8   N =  8
  0  (NRM RESID)/(NRM E)= 0.864E-15
 10  (NRM RESID)/(NRM E)= 0.132E-14
 20  (NRM RESID)/(NRM E)= 0.674E-15
 30  (NRM RESID)/(NRM E)= 0.108E-14
 40  (NRM RESID)/(NRM E)= 0.948E-15

 M =  9   N =  2
  0  (NRM RESID)/(NRM E)= 0.722E-15  RCOND(EST)= 0.637E-02 EST/TRUE= 0.420E+00
 10  (NRM RESID)/(NRM E)= 0.618E-15  RCOND(EST)= 0.298E-04 EST/TRUE= 0.906E+00
 20  (NRM RESID)/(NRM E)= 0.119E-14  RCOND(EST)= 0.289E-07 EST/TRUE= 0.905E+00
 30  (NRM RESID)/(NRM E)= 0.358E-15  RCOND(EST)= 0.282E-10 EST/TRUE= 0.905E+00
 40  (NRM RESID)/(NRM E)= 0.615E-15  RCOND(EST)= 0.276E-13 EST/TRUE= 0.907E+00

 M =  9   N =  3
  0  (NRM RESID)/(NRM E)= 0.358E-15  RCOND(EST)= 0.232E-02 EST/TRUE= 0.495E+00
 10  (NRM RESID)/(NRM E)= 0.493E-15  RCOND(EST)= 0.928E-05 EST/TRUE= 0.516E+00
 20  (NRM RESID)/(NRM E)= 0.770E-15  RCOND(EST)= 0.901E-08 EST/TRUE= 0.517E+00
 30  (NRM RESID)/(NRM E)= 0.348E-15  RCOND(EST)= 0.880E-11 EST/TRUE= 0.517E+00
 40  (NRM RESID)/(NRM E)= 0.348E-15  RCOND(EST)= 0.859E-14 EST/TRUE= 0.517E+00

 M =  9   N =  4
  0  (NRM RESID)/(NRM E)= 0.449E-15  RCOND(EST)= 0.872E-03 EST/TRUE= 0.706E+00
 10  (NRM RESID)/(NRM E)= 0.968E-15  RCOND(EST)= 0.533E-05 EST/TRUE= 0.448E+00
 20  (NRM RESID)/(NRM E)= 0.938E-15  RCOND(EST)= 0.515E-08 EST/TRUE= 0.450E+00
 30  (NRM RESID)/(NRM E)= 0.318E-15  RCOND(EST)= 0.449E-11 EST/TRUE= 0.401E+00
 40  (NRM RESID)/(NRM E)= 0.507E-15  RCOND(EST)= 0.492E-14 EST/TRUE= 0.449E+00

 M =  9   N =  5
  0  (NRM RESID)/(NRM E)= 0.359E-15
 10  (NRM RESID)/(NRM E)= 0.528E-15
 20  (NRM RESID)/(NRM E)= 0.401E-15
 30  (NRM RESID)/(NRM E)= 0.954E-15
 40  (NRM RESID)/(NRM E)= 0.718E-15

 M =  9   N =  6
  0  (NRM RESID)/(NRM E)= 0.698E-15
 10  (NRM RESID)/(NRM E)= 0.872E-15
 20  (NRM RESID)/(NRM E)= 0.820E-15
 30  (NRM RESID)/(NRM E)= 0.660E-15
 40  (NRM RESID)/(NRM E)= 0.501E-15

 M =  9   N =  7
  0  (NRM RESID)/(NRM E)= 0.592E-15
 10  (NRM RESID)/(NRM E)= 0.982E-15
 20  (NRM RESID)/(NRM E)= 0.458E-15
 30  (NRM RESID)/(NRM E)= 0.712E-15
 40  (NRM RESID)/(NRM E)= 0.130E-14

 M =  9   N =  8
  0  (NRM RESID)/(NRM E)= 0.113E-14
 10  (NRM RESID)/(NRM E)= 0.179E-14
 20  (NRM RESID)/(NRM E)= 0.809E-15
 30  (NRM RESID)/(NRM E)= 0.954E-15
 40  (NRM RESID)/(NRM E)= 0.822E-15

 WORST CASE RESIDUAL IS 0.179E-14
 WORST CASE RCOND RATIOS (EST/TRUE) ARE 0.244E+00 (LOW) AND 0.119E+01 (HIGH)


 THE RESIDUAL SHOULD BE ON THE ORDER OF 1E-14 OR SMALLER ON MOST MACHINES.
 THE RCOND RATIOS SHOULD BE ON THE ORDER OF 1, I.E., BETWEEN .1 AND 10.
SHAR_EOF
fi # end of overwriting check
if test -f 'res2'
then
	echo shar: will not over-write existing file "'res2'"
else
cat << "SHAR_EOF" > 'res2'
             T        T
 SOLVE  A*X*E  + E*X*A  + Q = 0  USING SYLGC

 N =  1
  0  (NRM RESID)/(NRM Q)= 0.000E+00  RCOND(EST)= 0.100E+01 EST/TRUE= 0.100E+01
 10  (NRM RESID)/(NRM Q)= 0.000E+00  RCOND(EST)= 0.100E+01 EST/TRUE= 0.100E+01
 20  (NRM RESID)/(NRM Q)= 0.000E+00  RCOND(EST)= 0.100E+01 EST/TRUE= 0.100E+01
 30  (NRM RESID)/(NRM Q)= 0.000E+00  RCOND(EST)= 0.100E+01 EST/TRUE= 0.100E+01
 40  (NRM RESID)/(NRM Q)= 0.000E+00  RCOND(EST)= 0.100E+01 EST/TRUE= 0.100E+01

 N =  2
  0  (NRM RESID)/(NRM Q)= 0.000E+00  RCOND(EST)= 0.117E+00 EST/TRUE= 0.852E+00
 10  (NRM RESID)/(NRM Q)= 0.296E-15  RCOND(EST)= 0.487E-03 EST/TRUE= 0.128E+01
 20  (NRM RESID)/(NRM Q)= 0.296E-15  RCOND(EST)= 0.477E-06 EST/TRUE= 0.128E+01
 30  (NRM RESID)/(NRM Q)= 0.296E-15  RCOND(EST)= 0.466E-09 EST/TRUE= 0.128E+01
 40  (NRM RESID)/(NRM Q)= 0.296E-15  RCOND(EST)= 0.455E-12 EST/TRUE= 0.128E+01

 N =  3
  0  (NRM RESID)/(NRM Q)= 0.763E-15  RCOND(EST)= 0.286E-01 EST/TRUE= 0.508E+00
 10  (NRM RESID)/(NRM Q)= 0.148E-15  RCOND(EST)= 0.143E-03 EST/TRUE= 0.723E+00
 20  (NRM RESID)/(NRM Q)= 0.493E-15  RCOND(EST)= 0.140E-06 EST/TRUE= 0.725E+00
 30  (NRM RESID)/(NRM Q)= 0.209E-15  RCOND(EST)= 0.136E-09 EST/TRUE= 0.725E+00
 40  (NRM RESID)/(NRM Q)= 0.299E-15  RCOND(EST)= 0.133E-12 EST/TRUE= 0.725E+00

 N =  4
  0  (NRM RESID)/(NRM Q)= 0.136E-14  RCOND(EST)= 0.127E-01 EST/TRUE= 0.460E+00
 10  (NRM RESID)/(NRM Q)= 0.789E-15  RCOND(EST)= 0.682E-04 EST/TRUE= 0.512E+00
 20  (NRM RESID)/(NRM Q)= 0.666E-15  RCOND(EST)= 0.668E-07 EST/TRUE= 0.513E+00
 30  (NRM RESID)/(NRM Q)= 0.641E-15  RCOND(EST)= 0.964E-10 EST/TRUE= 0.758E+00
 40  (NRM RESID)/(NRM Q)= 0.148E-14  RCOND(EST)= 0.942E-13 EST/TRUE= 0.759E+00

 N =  5
  0  (NRM RESID)/(NRM Q)= 0.102E-14  RCOND(EST)= 0.520E-02 EST/TRUE= 0.379E+00
 10  (NRM RESID)/(NRM Q)= 0.120E-14  RCOND(EST)= 0.778E-04 EST/TRUE= 0.772E+00
 20  (NRM RESID)/(NRM Q)= 0.933E-15  RCOND(EST)= 0.764E-07 EST/TRUE= 0.776E+00
 30  (NRM RESID)/(NRM Q)= 0.629E-15  RCOND(EST)= 0.746E-10 EST/TRUE= 0.776E+00
 40  (NRM RESID)/(NRM Q)= 0.355E-15  RCOND(EST)= 0.728E-13 EST/TRUE= 0.775E+00

 N =  6
  0  (NRM RESID)/(NRM Q)= 0.164E-14  RCOND(EST)= 0.221E-02 EST/TRUE= 0.372E+00
 10  (NRM RESID)/(NRM Q)= 0.203E-14  RCOND(EST)= 0.429E-04 EST/TRUE= 0.530E+00
 20  (NRM RESID)/(NRM Q)= 0.533E-15  RCOND(EST)= 0.423E-07 EST/TRUE= 0.534E+00
 30  (NRM RESID)/(NRM Q)= 0.612E-15  RCOND(EST)= 0.413E-10 EST/TRUE= 0.534E+00
 40  (NRM RESID)/(NRM Q)= 0.829E-15  RCOND(EST)= 0.403E-13 EST/TRUE= 0.534E+00

 N =  7
  0  (NRM RESID)/(NRM Q)= 0.220E-14
 10  (NRM RESID)/(NRM Q)= 0.128E-14
 20  (NRM RESID)/(NRM Q)= 0.126E-14
 30  (NRM RESID)/(NRM Q)= 0.525E-15
 40  (NRM RESID)/(NRM Q)= 0.846E-15

 N =  8
  0  (NRM RESID)/(NRM Q)= 0.135E-14
 10  (NRM RESID)/(NRM Q)= 0.178E-14
 20  (NRM RESID)/(NRM Q)= 0.825E-15
 30  (NRM RESID)/(NRM Q)= 0.994E-15
 40  (NRM RESID)/(NRM Q)= 0.166E-14

 WORST CASE RESIDUAL IS 0.220E-14
 WORST CASE RCOND RATIOS (EST/TRUE) ARE 0.372E+00 (LOW) AND 0.128E+01 (HIGH)


 THE RESIDUAL SHOULD BE ON THE ORDER OF 1E-14 OR SMALLER ON MOST MACHINES.
 THE RCOND RATIOS SHOULD BE ON THE ORDER OF 1, I.E., BETWEEN .1 AND 10.
SHAR_EOF
fi # end of overwriting check
if test -f 'res3'
then
	echo shar: will not over-write existing file "'res3'"
else
cat << "SHAR_EOF" > 'res3'
             T        T
 SOLVE  A*X*A  - E*X*E  + Q = 0  USING SYLGD

 N =  2
  0  (NRM RESID)/(NRM Q)= 0.000E+00  RCOND(EST)= 0.236E+00 EST/TRUE= 0.720E+00
 10  (NRM RESID)/(NRM Q)= 0.311E-15  RCOND(EST)= 0.390E-03 EST/TRUE= 0.872E+00
 20  (NRM RESID)/(NRM Q)= 0.111E-15  RCOND(EST)= 0.381E-06 EST/TRUE= 0.874E+00
 30  (NRM RESID)/(NRM Q)= 0.222E-15  RCOND(EST)= 0.373E-09 EST/TRUE= 0.874E+00
 40  (NRM RESID)/(NRM Q)= 0.222E-15  RCOND(EST)= 0.364E-12 EST/TRUE= 0.874E+00

 N =  3
  0  (NRM RESID)/(NRM Q)= 0.760E-15  RCOND(EST)= 0.665E-01 EST/TRUE= 0.395E+00
 10  (NRM RESID)/(NRM Q)= 0.523E-15  RCOND(EST)= 0.952E-04 EST/TRUE= 0.561E+00
 20  (NRM RESID)/(NRM Q)= 0.708E-15  RCOND(EST)= 0.931E-07 EST/TRUE= 0.562E+00
 30  (NRM RESID)/(NRM Q)= 0.605E-15  RCOND(EST)= 0.909E-10 EST/TRUE= 0.562E+00
 40  (NRM RESID)/(NRM Q)= 0.272E-15  RCOND(EST)= 0.888E-13 EST/TRUE= 0.562E+00

 N =  4
  0  (NRM RESID)/(NRM Q)= 0.563E-15  RCOND(EST)= 0.656E-01 EST/TRUE= 0.635E+00
 10  (NRM RESID)/(NRM Q)= 0.351E-15  RCOND(EST)= 0.329E-04 EST/TRUE= 0.363E+00
 20  (NRM RESID)/(NRM Q)= 0.442E-15  RCOND(EST)= 0.322E-07 EST/TRUE= 0.364E+00
 30  (NRM RESID)/(NRM Q)= 0.489E-15  RCOND(EST)= 0.315E-10 EST/TRUE= 0.364E+00
 40  (NRM RESID)/(NRM Q)= 0.854E-15  RCOND(EST)= 0.307E-13 EST/TRUE= 0.364E+00

 N =  5
  0  (NRM RESID)/(NRM Q)= 0.164E-14  RCOND(EST)= 0.278E-01 EST/TRUE= 0.398E+00
 10  (NRM RESID)/(NRM Q)= 0.461E-15  RCOND(EST)= 0.364E-04 EST/TRUE= 0.642E+00
 20  (NRM RESID)/(NRM Q)= 0.691E-15  RCOND(EST)= 0.357E-07 EST/TRUE= 0.645E+00
 30  (NRM RESID)/(NRM Q)= 0.751E-15  RCOND(EST)= 0.348E-10 EST/TRUE= 0.645E+00
 40  (NRM RESID)/(NRM Q)= 0.544E-15  RCOND(EST)= 0.340E-13 EST/TRUE= 0.645E+00

 N =  6
  0  (NRM RESID)/(NRM Q)= 0.203E-14  RCOND(EST)= 0.225E-01 EST/TRUE= 0.445E+00
 10  (NRM RESID)/(NRM Q)= 0.162E-14  RCOND(EST)= 0.148E-04 EST/TRUE= 0.381E+00
 20  (NRM RESID)/(NRM Q)= 0.102E-14  RCOND(EST)= 0.145E-07 EST/TRUE= 0.383E+00
 30  (NRM RESID)/(NRM Q)= 0.682E-15  RCOND(EST)= 0.142E-10 EST/TRUE= 0.383E+00
 40  (NRM RESID)/(NRM Q)= 0.170E-14  RCOND(EST)= 0.139E-13 EST/TRUE= 0.383E+00

 N =  7
  0  (NRM RESID)/(NRM Q)= 0.173E-14
 10  (NRM RESID)/(NRM Q)= 0.149E-14
 20  (NRM RESID)/(NRM Q)= 0.643E-15
 30  (NRM RESID)/(NRM Q)= 0.845E-15
 40  (NRM RESID)/(NRM Q)= 0.887E-15

 N =  8
  0  (NRM RESID)/(NRM Q)= 0.990E-15
 10  (NRM RESID)/(NRM Q)= 0.140E-14
 20  (NRM RESID)/(NRM Q)= 0.151E-14
 30  (NRM RESID)/(NRM Q)= 0.135E-14
 40  (NRM RESID)/(NRM Q)= 0.973E-15

 WORST CASE RESIDUAL IS 0.203E-14
 WORST CASE RCOND RATIOS (EST/TRUE) ARE 0.363E+00 (LOW) AND 0.874E+00 (HIGH)


 THE RESIDUAL SHOULD BE ON THE ORDER OF 1E-14 OR SMALLER ON MOST MACHINES.
 THE RCOND RATIOS SHOULD BE ON THE ORDER OF 1, I.E., BETWEEN .1 AND 10.
SHAR_EOF
fi # end of overwriting check
if test -f 'res4'
then
	echo shar: will not over-write existing file "'res4'"
else
cat << "SHAR_EOF" > 'res4'
             T        T
 SOLVE  A*X*B  + C*X*D  = E  USING SYLG

 M = 2, N = 1
  -0.1000E+01
  -0.1000E+01
   (NRM RESID)/(NRM E)= 0.000E+00  RCOND(EST)= 0.149E+00

 DO YOU WISH TO HAVE THE ACTUAL CONDITION NUMBER COMPUTED? (Y OR N) 
   RCOND(TRUE)= 0.205E+00 EST/TRUE= 0.727E+00
SHAR_EOF
fi # end of overwriting check
if test -f 'res5'
then
	echo shar: will not over-write existing file "'res5'"
else
cat << "SHAR_EOF" > 'res5'
             T        T
 SOLVE  A*X*E  + E*X*A  + Q = 0  USING SYLGC

 N = 3
  -0.2828E+00  0.1207E+00  0.7553E-01
   0.1207E+00  0.3802E-01 -0.1554E+00
   0.7553E-01 -0.1554E+00  0.9797E-01
   (NRM RESID)/(NRM Q)= 0.246E-14  RCOND(EST)= 0.847E-02

 DO YOU WISH TO HAVE THE ACTUAL CONDITION NUMBER COMPUTED? (Y OR N) 
   RCOND(TRUE)= 0.203E-01 EST/TRUE= 0.418E+00
SHAR_EOF
fi # end of overwriting check
if test -f 'res6'
then
	echo shar: will not over-write existing file "'res6'"
else
cat << "SHAR_EOF" > 'res6'
             T        T
 SOLVE  A*X*A  - E*X*E  + Q = 0  USING SYLGD

 N = 5
   0.9957E+01 -0.2289E+02 -0.3361E+02  0.2581E+02  0.1963E+02
  -0.2289E+02 -0.4787E+02 -0.2944E+02  0.4595E+02  0.4209E+02
  -0.3361E+02 -0.2944E+02  0.1919E+00  0.2509E+02  0.2677E+02
   0.2581E+02  0.4595E+02  0.2509E+02 -0.4278E+02 -0.4072E+02
   0.1963E+02  0.4209E+02  0.2677E+02 -0.4072E+02 -0.3895E+02
   (NRM RESID)/(NRM Q)= 0.141E+01  RCOND(EST)= 0.506E-04

 DO YOU WISH TO HAVE THE ACTUAL CONDITION NUMBER COMPUTED? (Y OR N) 
   RCOND(TRUE)= 0.424E-04 EST/TRUE= 0.119E+01
SHAR_EOF
fi # end of overwriting check
if test -f 'res7'
then
	echo shar: will not over-write existing file "'res7'"
else
cat << "SHAR_EOF" > 'res7'
             T        T
 SOLVE  A*X*B  + C*X*D  = E  USING SYLG

 M =  1   N =  1
  1  (NRM RESID)/(NRM E)= 0.385E-16  RCOND(EST)= 0.710E+00 EST/TRUE= 0.710E+00
  2  (NRM RESID)/(NRM E)= 0.155E-15  RCOND(EST)= 0.685E+00 EST/TRUE= 0.685E+00
  3  (NRM RESID)/(NRM E)= 0.127E-15  RCOND(EST)= 0.100E+01 EST/TRUE= 0.100E+01
  4  (NRM RESID)/(NRM E)= 0.267E-15  RCOND(EST)= 0.538E+00 EST/TRUE= 0.538E+00
  5  (NRM RESID)/(NRM E)= 0.000E+00  RCOND(EST)= 0.100E+01 EST/TRUE= 0.100E+01

 M =  1   N =  2
  1  (NRM RESID)/(NRM E)= 0.333E-14  RCOND(EST)= 0.686E-01 EST/TRUE= 0.502E+00
  2  (NRM RESID)/(NRM E)= 0.141E-14  RCOND(EST)= 0.241E+00 EST/TRUE= 0.514E+00
  3  (NRM RESID)/(NRM E)= 0.327E-14  RCOND(EST)= 0.234E-01 EST/TRUE= 0.909E+00
  4  (NRM RESID)/(NRM E)= 0.441E-15  RCOND(EST)= 0.638E+00 EST/TRUE= 0.162E+01
  5  (NRM RESID)/(NRM E)= 0.207E-15  RCOND(EST)= 0.197E+00 EST/TRUE= 0.570E+00

 M =  1   N =  3
  1  (NRM RESID)/(NRM E)= 0.109E-14  RCOND(EST)= 0.578E+00 EST/TRUE= 0.902E+00
  2  (NRM RESID)/(NRM E)= 0.600E-15  RCOND(EST)= 0.408E+00 EST/TRUE= 0.108E+01
  3  (NRM RESID)/(NRM E)= 0.588E-15  RCOND(EST)= 0.480E-01 EST/TRUE= 0.179E+01
  4  (NRM RESID)/(NRM E)= 0.704E-15  RCOND(EST)= 0.179E+00 EST/TRUE= 0.134E+01
  5  (NRM RESID)/(NRM E)= 0.647E-14  RCOND(EST)= 0.688E-01 EST/TRUE= 0.739E+00

 M =  1   N =  4
  1  (NRM RESID)/(NRM E)= 0.471E-15  RCOND(EST)= 0.855E-01 EST/TRUE= 0.613E+00
  2  (NRM RESID)/(NRM E)= 0.292E-15  RCOND(EST)= 0.267E+00 EST/TRUE= 0.902E+00
  3  (NRM RESID)/(NRM E)= 0.583E-15  RCOND(EST)= 0.343E+00 EST/TRUE= 0.145E+01
  4  (NRM RESID)/(NRM E)= 0.267E-14  RCOND(EST)= 0.605E-01 EST/TRUE= 0.879E+00
  5  (NRM RESID)/(NRM E)= 0.371E-15  RCOND(EST)= 0.113E+00 EST/TRUE= 0.111E+01

 M =  1   N =  5
  1  (NRM RESID)/(NRM E)= 0.411E-14  RCOND(EST)= 0.624E-01 EST/TRUE= 0.865E+00
  2  (NRM RESID)/(NRM E)= 0.121E-14  RCOND(EST)= 0.166E-01 EST/TRUE= 0.854E+00
  3  (NRM RESID)/(NRM E)= 0.697E-14  RCOND(EST)= 0.286E-01 EST/TRUE= 0.182E+01
  4  (NRM RESID)/(NRM E)= 0.379E-14  RCOND(EST)= 0.331E-01 EST/TRUE= 0.792E+00
  5  (NRM RESID)/(NRM E)= 0.149E-14  RCOND(EST)= 0.160E-01 EST/TRUE= 0.540E+00

 M =  1   N =  6
  1  (NRM RESID)/(NRM E)= 0.455E-15  RCOND(EST)= 0.171E+00 EST/TRUE= 0.118E+01
  2  (NRM RESID)/(NRM E)= 0.865E-15  RCOND(EST)= 0.135E+00 EST/TRUE= 0.994E+00
  3  (NRM RESID)/(NRM E)= 0.296E-14  RCOND(EST)= 0.545E-01 EST/TRUE= 0.101E+01
  4  (NRM RESID)/(NRM E)= 0.202E-13  RCOND(EST)= 0.527E-02 EST/TRUE= 0.772E+00
  5  (NRM RESID)/(NRM E)= 0.129E-13  RCOND(EST)= 0.820E-02 EST/TRUE= 0.125E+01

 M =  1   N =  7
  1  (NRM RESID)/(NRM E)= 0.149E-13  RCOND(EST)= 0.137E-01 EST/TRUE= 0.133E+01
  2  (NRM RESID)/(NRM E)= 0.259E-14  RCOND(EST)= 0.348E-01 EST/TRUE= 0.831E+00
  3  (NRM RESID)/(NRM E)= 0.453E-14  RCOND(EST)= 0.380E-01 EST/TRUE= 0.183E+01
  4  (NRM RESID)/(NRM E)= 0.208E-14  RCOND(EST)= 0.441E-01 EST/TRUE= 0.103E+01
  5  (NRM RESID)/(NRM E)= 0.104E-13  RCOND(EST)= 0.251E-01 EST/TRUE= 0.135E+01

 M =  1   N =  8
  1  (NRM RESID)/(NRM E)= 0.281E-14  RCOND(EST)= 0.721E-01 EST/TRUE= 0.841E+00
  2  (NRM RESID)/(NRM E)= 0.215E-13  RCOND(EST)= 0.540E-01 EST/TRUE= 0.298E+01
  3  (NRM RESID)/(NRM E)= 0.227E-14  RCOND(EST)= 0.159E+00 EST/TRUE= 0.119E+01
  4  (NRM RESID)/(NRM E)= 0.130E-14  RCOND(EST)= 0.401E-01 EST/TRUE= 0.146E+01
  5  (NRM RESID)/(NRM E)= 0.124E-13  RCOND(EST)= 0.635E-01 EST/TRUE= 0.137E+01

 M =  2   N =  1
  1  (NRM RESID)/(NRM E)= 0.160E-15  RCOND(EST)= 0.494E+00 EST/TRUE= 0.596E+00
  2  (NRM RESID)/(NRM E)= 0.530E-15  RCOND(EST)= 0.402E+00 EST/TRUE= 0.548E+00
  3  (NRM RESID)/(NRM E)= 0.151E-15  RCOND(EST)= 0.446E+00 EST/TRUE= 0.543E+00
  4  (NRM RESID)/(NRM E)= 0.501E-15  RCOND(EST)= 0.113E+00 EST/TRUE= 0.506E+00
  5  (NRM RESID)/(NRM E)= 0.110E-14  RCOND(EST)= 0.104E+00 EST/TRUE= 0.947E+00

 M =  2   N =  2
  1  (NRM RESID)/(NRM E)= 0.153E-14  RCOND(EST)= 0.195E-01 EST/TRUE= 0.748E+00
  2  (NRM RESID)/(NRM E)= 0.977E-15  RCOND(EST)= 0.302E-01 EST/TRUE= 0.113E+01
  3  (NRM RESID)/(NRM E)= 0.604E-15  RCOND(EST)= 0.766E-01 EST/TRUE= 0.876E+00
  4  (NRM RESID)/(NRM E)= 0.918E-15  RCOND(EST)= 0.186E-01 EST/TRUE= 0.721E+00
  5  (NRM RESID)/(NRM E)= 0.900E-15  RCOND(EST)= 0.702E-01 EST/TRUE= 0.727E+00

 M =  2   N =  3
  1  (NRM RESID)/(NRM E)= 0.149E-14  RCOND(EST)= 0.284E-01 EST/TRUE= 0.844E+00
  2  (NRM RESID)/(NRM E)= 0.406E-14  RCOND(EST)= 0.198E-01 EST/TRUE= 0.763E+00
  3  (NRM RESID)/(NRM E)= 0.693E-15  RCOND(EST)= 0.763E-01 EST/TRUE= 0.909E+00
  4  (NRM RESID)/(NRM E)= 0.178E-14  RCOND(EST)= 0.207E-01 EST/TRUE= 0.149E+01
  5  (NRM RESID)/(NRM E)= 0.174E-14  RCOND(EST)= 0.112E-01 EST/TRUE= 0.938E+00

 M =  2   N =  4
  1  (NRM RESID)/(NRM E)= 0.446E-14  RCOND(EST)= 0.209E-01 EST/TRUE= 0.620E+00
  2  (NRM RESID)/(NRM E)= 0.282E-14  RCOND(EST)= 0.437E-01 EST/TRUE= 0.129E+01
  3  (NRM RESID)/(NRM E)= 0.189E-13  RCOND(EST)= 0.596E-02 EST/TRUE= 0.481E+00
  4  (NRM RESID)/(NRM E)= 0.648E-14  RCOND(EST)= 0.199E-01 EST/TRUE= 0.110E+01
  5  (NRM RESID)/(NRM E)= 0.288E-14  RCOND(EST)= 0.171E-01 EST/TRUE= 0.412E+00

 M =  2   N =  5
  1  (NRM RESID)/(NRM E)= 0.235E-14  RCOND(EST)= 0.271E-01 EST/TRUE= 0.854E+00
  2  (NRM RESID)/(NRM E)= 0.312E-14  RCOND(EST)= 0.153E-01 EST/TRUE= 0.107E+01
  3  (NRM RESID)/(NRM E)= 0.134E-14  RCOND(EST)= 0.145E-01 EST/TRUE= 0.535E+00
  4  (NRM RESID)/(NRM E)= 0.128E-14  RCOND(EST)= 0.499E-01 EST/TRUE= 0.849E+00
  5  (NRM RESID)/(NRM E)= 0.229E-13  RCOND(EST)= 0.650E-02 EST/TRUE= 0.762E+00

 M =  2   N =  6
  1  (NRM RESID)/(NRM E)= 0.164E-14  RCOND(EST)= 0.361E-01 EST/TRUE= 0.862E+00
  2  (NRM RESID)/(NRM E)= 0.592E-14  RCOND(EST)= 0.234E-01 EST/TRUE= 0.618E+00
  3  (NRM RESID)/(NRM E)= 0.245E-13  RCOND(EST)= 0.347E-02 EST/TRUE= 0.986E+00
  4  (NRM RESID)/(NRM E)= 0.392E-14  RCOND(EST)= 0.421E-01 EST/TRUE= 0.114E+01
  5  (NRM RESID)/(NRM E)= 0.714E-14  RCOND(EST)= 0.219E-01 EST/TRUE= 0.174E+01

 M =  2   N =  7
  1  (NRM RESID)/(NRM E)= 0.374E-14  RCOND(EST)= 0.169E-01 EST/TRUE= 0.863E+00
  2  (NRM RESID)/(NRM E)= 0.378E-14  RCOND(EST)= 0.279E-01 EST/TRUE= 0.828E+00
  3  (NRM RESID)/(NRM E)= 0.381E-14  RCOND(EST)= 0.649E-01 EST/TRUE= 0.194E+01
  4  (NRM RESID)/(NRM E)= 0.738E-14  RCOND(EST)= 0.580E-02 EST/TRUE= 0.126E+01
  5  (NRM RESID)/(NRM E)= 0.184E-13  RCOND(EST)= 0.380E-02 EST/TRUE= 0.373E+00

 M =  2   N =  8
  1  (NRM RESID)/(NRM E)= 0.402E-14  RCOND(EST)= 0.241E-01 EST/TRUE= 0.809E+00
  2  (NRM RESID)/(NRM E)= 0.209E-14  RCOND(EST)= 0.219E-01 EST/TRUE= 0.834E+00
  3  (NRM RESID)/(NRM E)= 0.108E-13  RCOND(EST)= 0.208E-02 EST/TRUE= 0.721E+00
  4  (NRM RESID)/(NRM E)= 0.222E-13  RCOND(EST)= 0.244E-02 EST/TRUE= 0.680E+00
  5  (NRM RESID)/(NRM E)= 0.436E-14  RCOND(EST)= 0.274E-01 EST/TRUE= 0.129E+01

 M =  3   N =  1
  1  (NRM RESID)/(NRM E)= 0.223E-14  RCOND(EST)= 0.568E-01 EST/TRUE= 0.998E+00
  2  (NRM RESID)/(NRM E)= 0.161E-15  RCOND(EST)= 0.200E+00 EST/TRUE= 0.532E+00
  3  (NRM RESID)/(NRM E)= 0.140E-15  RCOND(EST)= 0.158E+00 EST/TRUE= 0.556E+00
  4  (NRM RESID)/(NRM E)= 0.278E-15  RCOND(EST)= 0.631E-01 EST/TRUE= 0.663E+00
  5  (NRM RESID)/(NRM E)= 0.533E-15  RCOND(EST)= 0.147E+00 EST/TRUE= 0.672E+00

 M =  3   N =  2
  1  (NRM RESID)/(NRM E)= 0.698E-15  RCOND(EST)= 0.316E-01 EST/TRUE= 0.596E+00
  2  (NRM RESID)/(NRM E)= 0.151E-14  RCOND(EST)= 0.344E-01 EST/TRUE= 0.569E+00
  3  (NRM RESID)/(NRM E)= 0.121E-14  RCOND(EST)= 0.453E-01 EST/TRUE= 0.403E+00
  4  (NRM RESID)/(NRM E)= 0.685E-15  RCOND(EST)= 0.425E-01 EST/TRUE= 0.590E+00
  5  (NRM RESID)/(NRM E)= 0.724E-15  RCOND(EST)= 0.507E-01 EST/TRUE= 0.725E+00

 M =  3   N =  3
  1  (NRM RESID)/(NRM E)= 0.227E-14  RCOND(EST)= 0.129E-01 EST/TRUE= 0.678E+00
  2  (NRM RESID)/(NRM E)= 0.302E-14  RCOND(EST)= 0.150E-01 EST/TRUE= 0.759E+00
  3  (NRM RESID)/(NRM E)= 0.266E-14  RCOND(EST)= 0.405E-02 EST/TRUE= 0.544E+00
  4  (NRM RESID)/(NRM E)= 0.102E-14  RCOND(EST)= 0.475E-01 EST/TRUE= 0.694E+00
  5  (NRM RESID)/(NRM E)= 0.283E-14  RCOND(EST)= 0.634E-02 EST/TRUE= 0.347E+00

 M =  3   N =  4
  1  (NRM RESID)/(NRM E)= 0.160E-14  RCOND(EST)= 0.432E-01 EST/TRUE= 0.110E+01
  2  (NRM RESID)/(NRM E)= 0.239E-14  RCOND(EST)= 0.116E-01 EST/TRUE= 0.993E+00
  3  (NRM RESID)/(NRM E)= 0.265E-14  RCOND(EST)= 0.653E-02 EST/TRUE= 0.421E+00
  4  (NRM RESID)/(NRM E)= 0.420E-14  RCOND(EST)= 0.547E-01 EST/TRUE= 0.150E+01
  5  (NRM RESID)/(NRM E)= 0.715E-14  RCOND(EST)= 0.787E-02 EST/TRUE= 0.873E+00

 M =  3   N =  5
  1  (NRM RESID)/(NRM E)= 0.967E-14  RCOND(EST)= 0.634E-02 EST/TRUE= 0.604E+00
  2  (NRM RESID)/(NRM E)= 0.316E-14  RCOND(EST)= 0.981E-02 EST/TRUE= 0.539E+00
  3  (NRM RESID)/(NRM E)= 0.399E-14  RCOND(EST)= 0.367E-02 EST/TRUE= 0.512E+00
  4  (NRM RESID)/(NRM E)= 0.817E-14  RCOND(EST)= 0.832E-02 EST/TRUE= 0.431E+00
  5  (NRM RESID)/(NRM E)= 0.621E-14  RCOND(EST)= 0.119E-01 EST/TRUE= 0.187E+01

 M =  3   N =  6
  1  (NRM RESID)/(NRM E)= 0.117E-13  RCOND(EST)= 0.301E-02 EST/TRUE= 0.790E+00
  2  (NRM RESID)/(NRM E)= 0.142E-14  RCOND(EST)= 0.259E-01 EST/TRUE= 0.581E+00
  3  (NRM RESID)/(NRM E)= 0.225E-14  RCOND(EST)= 0.486E-01 EST/TRUE= 0.112E+01
  4  (NRM RESID)/(NRM E)= 0.701E-14  RCOND(EST)= 0.156E-01 EST/TRUE= 0.150E+01
  5  (NRM RESID)/(NRM E)= 0.190E-14  RCOND(EST)= 0.501E-01 EST/TRUE= 0.922E+00

 M =  3   N =  7
  1  (NRM RESID)/(NRM E)= 0.605E-14  RCOND(EST)= 0.453E-02 EST/TRUE= 0.816E+00
  2  (NRM RESID)/(NRM E)= 0.235E-14  RCOND(EST)= 0.192E-01 EST/TRUE= 0.103E+01
  3  (NRM RESID)/(NRM E)= 0.108E-13  RCOND(EST)= 0.245E-02 EST/TRUE= 0.632E+00
  4  (NRM RESID)/(NRM E)= 0.187E-13  RCOND(EST)= 0.139E-02 EST/TRUE= 0.639E+00
  5  (NRM RESID)/(NRM E)= 0.161E-14  RCOND(EST)= 0.804E-02 EST/TRUE= 0.623E+00

 M =  3   N =  8
  1  (NRM RESID)/(NRM E)= 0.241E-14  RCOND(EST)= 0.821E-02 EST/TRUE= 0.514E+00
  2  (NRM RESID)/(NRM E)= 0.156E-13  RCOND(EST)= 0.314E-02 EST/TRUE= 0.795E+00
  3  (NRM RESID)/(NRM E)= 0.613E-14  RCOND(EST)= 0.277E-02 EST/TRUE= 0.550E+00
  4  (NRM RESID)/(NRM E)= 0.132E-13  RCOND(EST)= 0.216E-02 EST/TRUE= 0.376E+00
  5  (NRM RESID)/(NRM E)= 0.311E-14  RCOND(EST)= 0.183E-01 EST/TRUE= 0.110E+01

 M =  4   N =  1
  1  (NRM RESID)/(NRM E)= 0.645E-15  RCOND(EST)= 0.385E-01 EST/TRUE= 0.474E+00
  2  (NRM RESID)/(NRM E)= 0.311E-14  RCOND(EST)= 0.111E-01 EST/TRUE= 0.126E+01
  3  (NRM RESID)/(NRM E)= 0.105E-14  RCOND(EST)= 0.815E-01 EST/TRUE= 0.632E+00
  4  (NRM RESID)/(NRM E)= 0.769E-15  RCOND(EST)= 0.131E+00 EST/TRUE= 0.808E+00
  5  (NRM RESID)/(NRM E)= 0.138E-13  RCOND(EST)= 0.391E-02 EST/TRUE= 0.682E+00

 M =  4   N =  2
  1  (NRM RESID)/(NRM E)= 0.393E-13  RCOND(EST)= 0.521E-03 EST/TRUE= 0.349E+00
  2  (NRM RESID)/(NRM E)= 0.896E-15  RCOND(EST)= 0.461E-01 EST/TRUE= 0.483E+00
  3  (NRM RESID)/(NRM E)= 0.769E-15  RCOND(EST)= 0.443E-01 EST/TRUE= 0.515E+00
  4  (NRM RESID)/(NRM E)= 0.443E-15  RCOND(EST)= 0.460E-01 EST/TRUE= 0.643E+00
  5  (NRM RESID)/(NRM E)= 0.194E-13  RCOND(EST)= 0.119E-02 EST/TRUE= 0.430E+00

 M =  4   N =  3
  1  (NRM RESID)/(NRM E)= 0.668E-14  RCOND(EST)= 0.127E-02 EST/TRUE= 0.105E+01
  2  (NRM RESID)/(NRM E)= 0.103E-13  RCOND(EST)= 0.129E-02 EST/TRUE= 0.288E+00
  3  (NRM RESID)/(NRM E)= 0.113E-14  RCOND(EST)= 0.239E-01 EST/TRUE= 0.406E+00
  4  (NRM RESID)/(NRM E)= 0.784E-15  RCOND(EST)= 0.261E-01 EST/TRUE= 0.938E+00
  5  (NRM RESID)/(NRM E)= 0.248E-14  RCOND(EST)= 0.116E-01 EST/TRUE= 0.430E+00

 M =  4   N =  4
  1  (NRM RESID)/(NRM E)= 0.812E-14  RCOND(EST)= 0.290E-02 EST/TRUE= 0.338E+00
  2  (NRM RESID)/(NRM E)= 0.304E-14  RCOND(EST)= 0.295E-02 EST/TRUE= 0.770E+00
  3  (NRM RESID)/(NRM E)= 0.578E-14  RCOND(EST)= 0.181E-01 EST/TRUE= 0.990E+00
  4  (NRM RESID)/(NRM E)= 0.163E-14  RCOND(EST)= 0.249E-01 EST/TRUE= 0.482E+00
  5  (NRM RESID)/(NRM E)= 0.621E-14  RCOND(EST)= 0.138E-02 EST/TRUE= 0.604E+00

 M =  4   N =  5
  1  (NRM RESID)/(NRM E)= 0.523E-14  RCOND(EST)= 0.141E-02 EST/TRUE= 0.328E+00
  2  (NRM RESID)/(NRM E)= 0.206E-14  RCOND(EST)= 0.569E-02 EST/TRUE= 0.421E+00
  3  (NRM RESID)/(NRM E)= 0.212E-14  RCOND(EST)= 0.230E-01 EST/TRUE= 0.842E+00
  4  (NRM RESID)/(NRM E)= 0.194E-14  RCOND(EST)= 0.233E-01 EST/TRUE= 0.108E+01
  5  (NRM RESID)/(NRM E)= 0.392E-14  RCOND(EST)= 0.117E-01 EST/TRUE= 0.114E+01

 M =  4   N =  6
  1  (NRM RESID)/(NRM E)= 0.146E-12  RCOND(EST)= 0.108E-03 EST/TRUE= 0.686E+00
  2  (NRM RESID)/(NRM E)= 0.365E-14  RCOND(EST)= 0.144E-01 EST/TRUE= 0.100E+01
  3  (NRM RESID)/(NRM E)= 0.564E-13  RCOND(EST)= 0.764E-04 EST/TRUE= 0.274E+00
  4  (NRM RESID)/(NRM E)= 0.403E-14  RCOND(EST)= 0.111E-01 EST/TRUE= 0.111E+01
  5  (NRM RESID)/(NRM E)= 0.496E-14  RCOND(EST)= 0.260E-01 EST/TRUE= 0.590E+00

 M =  4   N =  7
  1  (NRM RESID)/(NRM E)= 0.420E-13  RCOND(EST)= 0.988E-03 EST/TRUE= 0.496E+00
  2  (NRM RESID)/(NRM E)= 0.134E-13  RCOND(EST)= 0.220E-02 EST/TRUE= 0.102E+01
  3  (NRM RESID)/(NRM E)= 0.550E-14  RCOND(EST)= 0.343E-02 EST/TRUE= 0.564E+00
  4  (NRM RESID)/(NRM E)= 0.122E-13  RCOND(EST)= 0.141E-02 EST/TRUE= 0.327E+00
  5  (NRM RESID)/(NRM E)= 0.618E-14  RCOND(EST)= 0.710E-02 EST/TRUE= 0.875E+00

 M =  4   N =  8
  1  (NRM RESID)/(NRM E)= 0.500E-13  RCOND(EST)= 0.164E-02 EST/TRUE= 0.876E+00
  2  (NRM RESID)/(NRM E)= 0.569E-14  RCOND(EST)= 0.298E-02 EST/TRUE= 0.607E+00
  3  (NRM RESID)/(NRM E)= 0.474E-13  RCOND(EST)= 0.266E-03 EST/TRUE= 0.625E+00
  4  (NRM RESID)/(NRM E)= 0.520E-12  RCOND(EST)= 0.185E-03 EST/TRUE= 0.158E+01
  5  (NRM RESID)/(NRM E)= 0.364E-13  RCOND(EST)= 0.541E-03 EST/TRUE= 0.599E+00

 M =  5   N =  1
  1  (NRM RESID)/(NRM E)= 0.133E-14  RCOND(EST)= 0.769E-01 EST/TRUE= 0.996E+00
  2  (NRM RESID)/(NRM E)= 0.569E-15  RCOND(EST)= 0.186E+00 EST/TRUE= 0.635E+00
  3  (NRM RESID)/(NRM E)= 0.668E-15  RCOND(EST)= 0.616E-01 EST/TRUE= 0.663E+00
  4  (NRM RESID)/(NRM E)= 0.137E-14  RCOND(EST)= 0.372E-01 EST/TRUE= 0.634E+00
  5  (NRM RESID)/(NRM E)= 0.382E-15  RCOND(EST)= 0.153E+00 EST/TRUE= 0.561E+00

 M =  5   N =  2
  1  (NRM RESID)/(NRM E)= 0.123E-14  RCOND(EST)= 0.247E-02 EST/TRUE= 0.167E+01
  2  (NRM RESID)/(NRM E)= 0.482E-14  RCOND(EST)= 0.125E-01 EST/TRUE= 0.522E+00
  3  (NRM RESID)/(NRM E)= 0.657E-14  RCOND(EST)= 0.414E-02 EST/TRUE= 0.557E+00
  4  (NRM RESID)/(NRM E)= 0.204E-14  RCOND(EST)= 0.587E-02 EST/TRUE= 0.619E+00
  5  (NRM RESID)/(NRM E)= 0.523E-14  RCOND(EST)= 0.690E-02 EST/TRUE= 0.308E+00

 M =  5   N =  3
  1  (NRM RESID)/(NRM E)= 0.422E-14  RCOND(EST)= 0.469E-02 EST/TRUE= 0.563E+00
  2  (NRM RESID)/(NRM E)= 0.114E-13  RCOND(EST)= 0.473E-03 EST/TRUE= 0.820E+00
  3  (NRM RESID)/(NRM E)= 0.578E-14  RCOND(EST)= 0.452E-02 EST/TRUE= 0.409E+00
  4  (NRM RESID)/(NRM E)= 0.352E-14  RCOND(EST)= 0.131E-01 EST/TRUE= 0.619E+00
  5  (NRM RESID)/(NRM E)= 0.242E-13  RCOND(EST)= 0.111E-02 EST/TRUE= 0.949E+00

 M =  5   N =  4
  1  (NRM RESID)/(NRM E)= 0.283E-14  RCOND(EST)= 0.122E-01 EST/TRUE= 0.806E+00
  2  (NRM RESID)/(NRM E)= 0.280E-14  RCOND(EST)= 0.578E-02 EST/TRUE= 0.921E+00
  3  (NRM RESID)/(NRM E)= 0.634E-14  RCOND(EST)= 0.417E-02 EST/TRUE= 0.554E+00
  4  (NRM RESID)/(NRM E)= 0.445E-12  RCOND(EST)= 0.605E-04 EST/TRUE= 0.582E+00
  5  (NRM RESID)/(NRM E)= 0.125E-13  RCOND(EST)= 0.263E-02 EST/TRUE= 0.643E+00

 M =  5   N =  5
  1  (NRM RESID)/(NRM E)= 0.416E-14  RCOND(EST)= 0.651E-02 EST/TRUE= 0.561E+00
  2  (NRM RESID)/(NRM E)= 0.359E-14  RCOND(EST)= 0.167E-01 EST/TRUE= 0.760E+00
  3  (NRM RESID)/(NRM E)= 0.102E-13  RCOND(EST)= 0.739E-02 EST/TRUE= 0.492E+00
  4  (NRM RESID)/(NRM E)= 0.978E-14  RCOND(EST)= 0.978E-02 EST/TRUE= 0.788E+00
  5  (NRM RESID)/(NRM E)= 0.569E-14  RCOND(EST)= 0.141E-01 EST/TRUE= 0.110E+01

 M =  5   N =  6
  1  (NRM RESID)/(NRM E)= 0.298E-14  RCOND(EST)= 0.736E-02 EST/TRUE= 0.602E+00
  2  (NRM RESID)/(NRM E)= 0.307E-14  RCOND(EST)= 0.185E-02 EST/TRUE= 0.306E+00
  3  (NRM RESID)/(NRM E)= 0.293E-14  RCOND(EST)= 0.413E-02 EST/TRUE= 0.327E+00
  4  (NRM RESID)/(NRM E)= 0.294E-13  RCOND(EST)= 0.890E-03 EST/TRUE= 0.102E+01
  5  (NRM RESID)/(NRM E)= 0.552E-14  RCOND(EST)= 0.433E-02 EST/TRUE= 0.480E+00

 M =  5   N =  7
  1  (NRM RESID)/(NRM E)= 0.144E-13  RCOND(EST)= 0.933E-03 EST/TRUE= 0.519E+00
  2  (NRM RESID)/(NRM E)= 0.681E-14  RCOND(EST)= 0.809E-03 EST/TRUE= 0.131E+01
  3  (NRM RESID)/(NRM E)= 0.470E-13  RCOND(EST)= 0.938E-03 EST/TRUE= 0.737E+00
  4  (NRM RESID)/(NRM E)= 0.242E-13  RCOND(EST)= 0.299E-02 EST/TRUE= 0.489E+00
  5  (NRM RESID)/(NRM E)= 0.128E-13  RCOND(EST)= 0.809E-03 EST/TRUE= 0.124E+01

 M =  5   N =  8
  1  (NRM RESID)/(NRM E)= 0.111E-13  RCOND(EST)= 0.235E-02 EST/TRUE= 0.387E+00
  2  (NRM RESID)/(NRM E)= 0.714E-14  RCOND(EST)= 0.359E-02 EST/TRUE= 0.583E+00
  3  (NRM RESID)/(NRM E)= 0.371E-13  RCOND(EST)= 0.151E-02 EST/TRUE= 0.681E+00
  4  (NRM RESID)/(NRM E)= 0.418E-13  RCOND(EST)= 0.835E-03 EST/TRUE= 0.360E+00
  5  (NRM RESID)/(NRM E)= 0.831E-14  RCOND(EST)= 0.138E-01 EST/TRUE= 0.556E+00

 M =  6   N =  1
  1  (NRM RESID)/(NRM E)= 0.855E-15  RCOND(EST)= 0.406E-01 EST/TRUE= 0.623E+00
  2  (NRM RESID)/(NRM E)= 0.314E-14  RCOND(EST)= 0.175E-01 EST/TRUE= 0.786E+00
  3  (NRM RESID)/(NRM E)= 0.881E-15  RCOND(EST)= 0.610E-01 EST/TRUE= 0.521E+00
  4  (NRM RESID)/(NRM E)= 0.191E-13  RCOND(EST)= 0.380E-02 EST/TRUE= 0.942E+00
  5  (NRM RESID)/(NRM E)= 0.786E-14  RCOND(EST)= 0.101E-01 EST/TRUE= 0.599E+00

 M =  6   N =  2
  1  (NRM RESID)/(NRM E)= 0.910E-14  RCOND(EST)= 0.227E-02 EST/TRUE= 0.510E+00
  2  (NRM RESID)/(NRM E)= 0.145E-14  RCOND(EST)= 0.185E-01 EST/TRUE= 0.380E+00
  3  (NRM RESID)/(NRM E)= 0.273E-14  RCOND(EST)= 0.210E-02 EST/TRUE= 0.426E+00
  4  (NRM RESID)/(NRM E)= 0.162E-14  RCOND(EST)= 0.460E-02 EST/TRUE= 0.490E+00
  5  (NRM RESID)/(NRM E)= 0.217E-13  RCOND(EST)= 0.107E-02 EST/TRUE= 0.304E+00

 M =  6   N =  3
  1  (NRM RESID)/(NRM E)= 0.144E-13  RCOND(EST)= 0.101E-02 EST/TRUE= 0.402E+00
  2  (NRM RESID)/(NRM E)= 0.285E-14  RCOND(EST)= 0.986E-02 EST/TRUE= 0.626E+00
  3  (NRM RESID)/(NRM E)= 0.159E-14  RCOND(EST)= 0.540E-02 EST/TRUE= 0.347E+00
  4  (NRM RESID)/(NRM E)= 0.397E-13  RCOND(EST)= 0.861E-03 EST/TRUE= 0.359E+00
  5  (NRM RESID)/(NRM E)= 0.812E-14  RCOND(EST)= 0.127E-01 EST/TRUE= 0.567E+00

 M =  6   N =  4
  1  (NRM RESID)/(NRM E)= 0.295E-13  RCOND(EST)= 0.303E-03 EST/TRUE= 0.532E+00
  2  (NRM RESID)/(NRM E)= 0.148E-13  RCOND(EST)= 0.320E-02 EST/TRUE= 0.454E+00
  3  (NRM RESID)/(NRM E)= 0.803E-14  RCOND(EST)= 0.207E-02 EST/TRUE= 0.540E+00
  4  (NRM RESID)/(NRM E)= 0.224E-14  RCOND(EST)= 0.135E-01 EST/TRUE= 0.584E+00
  5  (NRM RESID)/(NRM E)= 0.659E-14  RCOND(EST)= 0.154E-02 EST/TRUE= 0.812E+00

 M =  6   N =  5
  1  (NRM RESID)/(NRM E)= 0.116E-13  RCOND(EST)= 0.374E-02 EST/TRUE= 0.994E+00
  2  (NRM RESID)/(NRM E)= 0.105E-13  RCOND(EST)= 0.308E-02 EST/TRUE= 0.544E+00
  3  (NRM RESID)/(NRM E)= 0.890E-13  RCOND(EST)= 0.246E-03 EST/TRUE= 0.426E+00
  4  (NRM RESID)/(NRM E)= 0.637E-14  RCOND(EST)= 0.105E-01 EST/TRUE= 0.784E+00
  5  (NRM RESID)/(NRM E)= 0.203E-13  RCOND(EST)= 0.156E-02 EST/TRUE= 0.864E+00

 M =  6   N =  6
  1  (NRM RESID)/(NRM E)= 0.602E-14  RCOND(EST)= 0.998E-02 EST/TRUE= 0.618E+00
  2  (NRM RESID)/(NRM E)= 0.466E-14  RCOND(EST)= 0.510E-02 EST/TRUE= 0.815E+00
  3  (NRM RESID)/(NRM E)= 0.164E-13  RCOND(EST)= 0.488E-02 EST/TRUE= 0.359E+00
  4  (NRM RESID)/(NRM E)= 0.100E-13  RCOND(EST)= 0.380E-02 EST/TRUE= 0.763E+00
  5  (NRM RESID)/(NRM E)= 0.120E-13  RCOND(EST)= 0.643E-03 EST/TRUE= 0.383E+00

 M =  6   N =  7
  1  (NRM RESID)/(NRM E)= 0.358E-14
  2  (NRM RESID)/(NRM E)= 0.971E-14
  3  (NRM RESID)/(NRM E)= 0.958E-14
  4  (NRM RESID)/(NRM E)= 0.592E-14
  5  (NRM RESID)/(NRM E)= 0.228E-13

 M =  6   N =  8
  1  (NRM RESID)/(NRM E)= 0.994E-14
  2  (NRM RESID)/(NRM E)= 0.447E-13
  3  (NRM RESID)/(NRM E)= 0.612E-14
  4  (NRM RESID)/(NRM E)= 0.199E-13
  5  (NRM RESID)/(NRM E)= 0.174E-13

 M =  7   N =  1
  1  (NRM RESID)/(NRM E)= 0.133E-13  RCOND(EST)= 0.596E-02 EST/TRUE= 0.645E+00
  2  (NRM RESID)/(NRM E)= 0.106E-14  RCOND(EST)= 0.591E-01 EST/TRUE= 0.503E+00
  3  (NRM RESID)/(NRM E)= 0.124E-14  RCOND(EST)= 0.419E-01 EST/TRUE= 0.998E+00
  4  (NRM RESID)/(NRM E)= 0.139E-13  RCOND(EST)= 0.382E-03 EST/TRUE= 0.567E+00
  5  (NRM RESID)/(NRM E)= 0.219E-14  RCOND(EST)= 0.394E-01 EST/TRUE= 0.606E+00

 M =  7   N =  2
  1  (NRM RESID)/(NRM E)= 0.598E-14  RCOND(EST)= 0.582E-02 EST/TRUE= 0.436E+00
  2  (NRM RESID)/(NRM E)= 0.120E-12  RCOND(EST)= 0.340E-03 EST/TRUE= 0.376E+00
  3  (NRM RESID)/(NRM E)= 0.115E-14  RCOND(EST)= 0.179E-01 EST/TRUE= 0.313E+00
  4  (NRM RESID)/(NRM E)= 0.146E-14  RCOND(EST)= 0.201E-01 EST/TRUE= 0.588E+00
  5  (NRM RESID)/(NRM E)= 0.128E-14  RCOND(EST)= 0.238E-01 EST/TRUE= 0.638E+00

 M =  7   N =  3
  1  (NRM RESID)/(NRM E)= 0.744E-13  RCOND(EST)= 0.291E-03 EST/TRUE= 0.407E+00
  2  (NRM RESID)/(NRM E)= 0.141E-14  RCOND(EST)= 0.532E-02 EST/TRUE= 0.432E+00
  3  (NRM RESID)/(NRM E)= 0.423E-14  RCOND(EST)= 0.871E-02 EST/TRUE= 0.467E+00
  4  (NRM RESID)/(NRM E)= 0.414E-14  RCOND(EST)= 0.523E-02 EST/TRUE= 0.583E+00
  5  (NRM RESID)/(NRM E)= 0.267E-14  RCOND(EST)= 0.133E-01 EST/TRUE= 0.673E+00

 M =  7   N =  4
  1  (NRM RESID)/(NRM E)= 0.592E-14  RCOND(EST)= 0.463E-02 EST/TRUE= 0.477E+00
  2  (NRM RESID)/(NRM E)= 0.115E-13  RCOND(EST)= 0.249E-02 EST/TRUE= 0.554E+00
  3  (NRM RESID)/(NRM E)= 0.369E-14  RCOND(EST)= 0.358E-02 EST/TRUE= 0.584E+00
  4  (NRM RESID)/(NRM E)= 0.947E-13  RCOND(EST)= 0.179E-03 EST/TRUE= 0.777E+00
  5  (NRM RESID)/(NRM E)= 0.212E-13  RCOND(EST)= 0.928E-03 EST/TRUE= 0.551E+00

 M =  7   N =  5
  1  (NRM RESID)/(NRM E)= 0.324E-14  RCOND(EST)= 0.215E-02 EST/TRUE= 0.348E+00
  2  (NRM RESID)/(NRM E)= 0.318E-14  RCOND(EST)= 0.381E-02 EST/TRUE= 0.274E+00
  3  (NRM RESID)/(NRM E)= 0.945E-14  RCOND(EST)= 0.130E-02 EST/TRUE= 0.351E+00
  4  (NRM RESID)/(NRM E)= 0.587E-14  RCOND(EST)= 0.165E-01 EST/TRUE= 0.731E+00
  5  (NRM RESID)/(NRM E)= 0.909E-14  RCOND(EST)= 0.491E-03 EST/TRUE= 0.463E+00

 M =  7   N =  6
  1  (NRM RESID)/(NRM E)= 0.725E-13
  2  (NRM RESID)/(NRM E)= 0.489E-14
  3  (NRM RESID)/(NRM E)= 0.271E-13
  4  (NRM RESID)/(NRM E)= 0.182E-13
  5  (NRM RESID)/(NRM E)= 0.664E-13

 M =  7   N =  7
  1  (NRM RESID)/(NRM E)= 0.537E-13
  2  (NRM RESID)/(NRM E)= 0.299E-13
  3  (NRM RESID)/(NRM E)= 0.265E-14
  4  (NRM RESID)/(NRM E)= 0.958E-14
  5  (NRM RESID)/(NRM E)= 0.154E-13

 M =  7   N =  8
  1  (NRM RESID)/(NRM E)= 0.313E-13
  2  (NRM RESID)/(NRM E)= 0.550E-14
  3  (NRM RESID)/(NRM E)= 0.212E-13
  4  (NRM RESID)/(NRM E)= 0.176E-13
  5  (NRM RESID)/(NRM E)= 0.244E-12

 M =  8   N =  1
  1  (NRM RESID)/(NRM E)= 0.323E-14  RCOND(EST)= 0.105E-01 EST/TRUE= 0.440E+00
  2  (NRM RESID)/(NRM E)= 0.227E-14  RCOND(EST)= 0.104E-01 EST/TRUE= 0.362E+00
  3  (NRM RESID)/(NRM E)= 0.107E-14  RCOND(EST)= 0.277E-01 EST/TRUE= 0.460E+00
  4  (NRM RESID)/(NRM E)= 0.937E-15  RCOND(EST)= 0.368E-01 EST/TRUE= 0.729E+00
  5  (NRM RESID)/(NRM E)= 0.341E-14  RCOND(EST)= 0.501E-01 EST/TRUE= 0.777E+00

 M =  8   N =  2
  1  (NRM RESID)/(NRM E)= 0.450E-14  RCOND(EST)= 0.847E-02 EST/TRUE= 0.445E+00
  2  (NRM RESID)/(NRM E)= 0.183E-14  RCOND(EST)= 0.200E-01 EST/TRUE= 0.390E+00
  3  (NRM RESID)/(NRM E)= 0.206E-14  RCOND(EST)= 0.825E-02 EST/TRUE= 0.360E+00
  4  (NRM RESID)/(NRM E)= 0.519E-15  RCOND(EST)= 0.572E-02 EST/TRUE= 0.330E+00
  5  (NRM RESID)/(NRM E)= 0.897E-14  RCOND(EST)= 0.176E-02 EST/TRUE= 0.371E+00

 M =  8   N =  3
  1  (NRM RESID)/(NRM E)= 0.160E-13  RCOND(EST)= 0.675E-02 EST/TRUE= 0.448E+00
  2  (NRM RESID)/(NRM E)= 0.114E-13  RCOND(EST)= 0.911E-03 EST/TRUE= 0.411E+00
  3  (NRM RESID)/(NRM E)= 0.534E-13  RCOND(EST)= 0.293E-03 EST/TRUE= 0.348E+00
  4  (NRM RESID)/(NRM E)= 0.364E-13  RCOND(EST)= 0.385E-03 EST/TRUE= 0.476E+00
  5  (NRM RESID)/(NRM E)= 0.133E-13  RCOND(EST)= 0.833E-03 EST/TRUE= 0.488E+00

 M =  8   N =  4
  1  (NRM RESID)/(NRM E)= 0.286E-13  RCOND(EST)= 0.994E-03 EST/TRUE= 0.555E+00
  2  (NRM RESID)/(NRM E)= 0.412E-12  RCOND(EST)= 0.209E-04 EST/TRUE= 0.397E+00
  3  (NRM RESID)/(NRM E)= 0.120E-12  RCOND(EST)= 0.128E-03 EST/TRUE= 0.413E+00
  4  (NRM RESID)/(NRM E)= 0.198E-13  RCOND(EST)= 0.162E-02 EST/TRUE= 0.452E+00
  5  (NRM RESID)/(NRM E)= 0.380E-12  RCOND(EST)= 0.222E-03 EST/TRUE= 0.317E+00

 M =  8   N =  5
  1  (NRM RESID)/(NRM E)= 0.157E-13  RCOND(EST)= 0.129E-02 EST/TRUE= 0.598E+00
  2  (NRM RESID)/(NRM E)= 0.473E-14  RCOND(EST)= 0.689E-02 EST/TRUE= 0.634E+00
  3  (NRM RESID)/(NRM E)= 0.307E-13  RCOND(EST)= 0.167E-02 EST/TRUE= 0.418E+00
  4  (NRM RESID)/(NRM E)= 0.114E-13  RCOND(EST)= 0.130E-02 EST/TRUE= 0.939E+00
  5  (NRM RESID)/(NRM E)= 0.118E-13  RCOND(EST)= 0.227E-02 EST/TRUE= 0.481E+00

 M =  8   N =  6
  1  (NRM RESID)/(NRM E)= 0.117E-13
  2  (NRM RESID)/(NRM E)= 0.415E-13
  3  (NRM RESID)/(NRM E)= 0.101E-13
  4  (NRM RESID)/(NRM E)= 0.398E-13
  5  (NRM RESID)/(NRM E)= 0.369E-13

 M =  8   N =  7
  1  (NRM RESID)/(NRM E)= 0.116E-13
  2  (NRM RESID)/(NRM E)= 0.338E-13
  3  (NRM RESID)/(NRM E)= 0.254E-13
  4  (NRM RESID)/(NRM E)= 0.109E-13
  5  (NRM RESID)/(NRM E)= 0.214E-13

 M =  8   N =  8
  1  (NRM RESID)/(NRM E)= 0.656E-13
  2  (NRM RESID)/(NRM E)= 0.102E-13
  3  (NRM RESID)/(NRM E)= 0.507E-13
  4  (NRM RESID)/(NRM E)= 0.714E-13
  5  (NRM RESID)/(NRM E)= 0.206E-12

 M =  9   N =  1
  1  (NRM RESID)/(NRM E)= 0.734E-14  RCOND(EST)= 0.128E-01 EST/TRUE= 0.488E+00
  2  (NRM RESID)/(NRM E)= 0.467E-14  RCOND(EST)= 0.899E-02 EST/TRUE= 0.466E+00
  3  (NRM RESID)/(NRM E)= 0.398E-14  RCOND(EST)= 0.260E-02 EST/TRUE= 0.302E+00
  4  (NRM RESID)/(NRM E)= 0.350E-14  RCOND(EST)= 0.782E-02 EST/TRUE= 0.324E+00
  5  (NRM RESID)/(NRM E)= 0.168E-14  RCOND(EST)= 0.399E-01 EST/TRUE= 0.578E+00

 M =  9   N =  2
  1  (NRM RESID)/(NRM E)= 0.200E-14  RCOND(EST)= 0.292E-02 EST/TRUE= 0.322E+00
  2  (NRM RESID)/(NRM E)= 0.320E-14  RCOND(EST)= 0.105E-02 EST/TRUE= 0.318E+00
  3  (NRM RESID)/(NRM E)= 0.187E-14  RCOND(EST)= 0.740E-02 EST/TRUE= 0.300E+00
  4  (NRM RESID)/(NRM E)= 0.564E-14  RCOND(EST)= 0.451E-02 EST/TRUE= 0.375E+00
  5  (NRM RESID)/(NRM E)= 0.205E-14  RCOND(EST)= 0.160E-01 EST/TRUE= 0.407E+00

 M =  9   N =  3
  1  (NRM RESID)/(NRM E)= 0.170E-14  RCOND(EST)= 0.800E-02 EST/TRUE= 0.285E+00
  2  (NRM RESID)/(NRM E)= 0.116E-13  RCOND(EST)= 0.497E-02 EST/TRUE= 0.547E+00
  3  (NRM RESID)/(NRM E)= 0.216E-14  RCOND(EST)= 0.566E-02 EST/TRUE= 0.493E+00
  4  (NRM RESID)/(NRM E)= 0.525E-14  RCOND(EST)= 0.279E-02 EST/TRUE= 0.519E+00
  5  (NRM RESID)/(NRM E)= 0.216E-13  RCOND(EST)= 0.840E-03 EST/TRUE= 0.309E+00

 M =  9   N =  4
  1  (NRM RESID)/(NRM E)= 0.173E-13  RCOND(EST)= 0.154E-02 EST/TRUE= 0.422E+00
  2  (NRM RESID)/(NRM E)= 0.635E-14  RCOND(EST)= 0.326E-02 EST/TRUE= 0.286E+00
  3  (NRM RESID)/(NRM E)= 0.183E-13  RCOND(EST)= 0.127E-02 EST/TRUE= 0.473E+00
  4  (NRM RESID)/(NRM E)= 0.725E-14  RCOND(EST)= 0.122E-02 EST/TRUE= 0.560E+00
  5  (NRM RESID)/(NRM E)= 0.106E-13  RCOND(EST)= 0.964E-03 EST/TRUE= 0.395E+00

 M =  9   N =  5
  1  (NRM RESID)/(NRM E)= 0.816E-14
  2  (NRM RESID)/(NRM E)= 0.765E-14
  3  (NRM RESID)/(NRM E)= 0.685E-14
  4  (NRM RESID)/(NRM E)= 0.803E-14
  5  (NRM RESID)/(NRM E)= 0.109E-13

 M =  9   N =  6
  1  (NRM RESID)/(NRM E)= 0.238E-13
  2  (NRM RESID)/(NRM E)= 0.429E-13
  3  (NRM RESID)/(NRM E)= 0.175E-13
  4  (NRM RESID)/(NRM E)= 0.589E-14
  5  (NRM RESID)/(NRM E)= 0.521E-13

 M =  9   N =  7
  1  (NRM RESID)/(NRM E)= 0.619E-14
  2  (NRM RESID)/(NRM E)= 0.892E-13
  3  (NRM RESID)/(NRM E)= 0.151E-13
  4  (NRM RESID)/(NRM E)= 0.591E-13
  5  (NRM RESID)/(NRM E)= 0.158E-13

 M =  9   N =  8
  1  (NRM RESID)/(NRM E)= 0.720E-14
  2  (NRM RESID)/(NRM E)= 0.539E-13
  3  (NRM RESID)/(NRM E)= 0.122E-13
  4  (NRM RESID)/(NRM E)= 0.273E-12
  5  (NRM RESID)/(NRM E)= 0.141E-13

 WORST CASE RESIDUAL IS 0.520E-12
 WORST CASE RCOND RATIOS (EST/TRUE) ARE 0.274E+00 (LOW) AND 0.298E+01 (HIGH)
SHAR_EOF
fi # end of overwriting check
if test -f 'res8'
then
	echo shar: will not over-write existing file "'res8'"
else
cat << "SHAR_EOF" > 'res8'
             T        T
 SOLVE  A*X*E  + E*X*A  + Q = 0  USING SYLGC

 N =  1
  1  (NRM RESID)/(NRM Q)= 0.620E-16  RCOND(EST)= 0.100E+01 EST/TRUE= 0.100E+01
  2  (NRM RESID)/(NRM Q)= 0.103E-15  RCOND(EST)= 0.100E+01 EST/TRUE= 0.100E+01
  3  (NRM RESID)/(NRM Q)= 0.000E+00  RCOND(EST)= 0.100E+01 EST/TRUE= 0.100E+01
  4  (NRM RESID)/(NRM Q)= 0.706E-16  RCOND(EST)= 0.100E+01 EST/TRUE= 0.100E+01
  5  (NRM RESID)/(NRM Q)= 0.127E-15  RCOND(EST)= 0.100E+01 EST/TRUE= 0.100E+01

 N =  2
  1  (NRM RESID)/(NRM Q)= 0.112E-12  RCOND(EST)= 0.337E-03 EST/TRUE= 0.494E+00
  2  (NRM RESID)/(NRM Q)= 0.436E-13  RCOND(EST)= 0.189E-02 EST/TRUE= 0.850E+00
  3  (NRM RESID)/(NRM Q)= 0.559E-15  RCOND(EST)= 0.232E+00 EST/TRUE= 0.898E+00
  4  (NRM RESID)/(NRM Q)= 0.123E-14  RCOND(EST)= 0.168E-01 EST/TRUE= 0.100E+01
  5  (NRM RESID)/(NRM Q)= 0.101E-14  RCOND(EST)= 0.179E+00 EST/TRUE= 0.712E+00

 N =  3
  1  (NRM RESID)/(NRM Q)= 0.169E-13  RCOND(EST)= 0.229E-02 EST/TRUE= 0.519E+00
  2  (NRM RESID)/(NRM Q)= 0.121E-13  RCOND(EST)= 0.461E-02 EST/TRUE= 0.500E+00
  3  (NRM RESID)/(NRM Q)= 0.214E-13  RCOND(EST)= 0.597E-02 EST/TRUE= 0.720E+00
  4  (NRM RESID)/(NRM Q)= 0.288E-14  RCOND(EST)= 0.420E-02 EST/TRUE= 0.450E+00
  5  (NRM RESID)/(NRM Q)= 0.395E-13  RCOND(EST)= 0.612E-03 EST/TRUE= 0.576E+00

 N =  4
  1  (NRM RESID)/(NRM Q)= 0.124E-13  RCOND(EST)= 0.779E-02 EST/TRUE= 0.486E+00
  2  (NRM RESID)/(NRM Q)= 0.778E-14  RCOND(EST)= 0.105E-01 EST/TRUE= 0.324E+00
  3  (NRM RESID)/(NRM Q)= 0.122E-12  RCOND(EST)= 0.120E-03 EST/TRUE= 0.634E+00
  4  (NRM RESID)/(NRM Q)= 0.383E-14  RCOND(EST)= 0.282E-01 EST/TRUE= 0.786E+00
  5  (NRM RESID)/(NRM Q)= 0.486E-13  RCOND(EST)= 0.486E-04 EST/TRUE= 0.225E+00

 N =  5
  1  (NRM RESID)/(NRM Q)= 0.244E-14  RCOND(EST)= 0.136E-01 EST/TRUE= 0.520E+00
  2  (NRM RESID)/(NRM Q)= 0.512E-14  RCOND(EST)= 0.217E-02 EST/TRUE= 0.450E+00
  3  (NRM RESID)/(NRM Q)= 0.790E-13  RCOND(EST)= 0.369E-03 EST/TRUE= 0.677E+00
  4  (NRM RESID)/(NRM Q)= 0.152E-12  RCOND(EST)= 0.378E-02 EST/TRUE= 0.158E+01
  5  (NRM RESID)/(NRM Q)= 0.816E-14  RCOND(EST)= 0.451E-02 EST/TRUE= 0.911E+00

 N =  6
  1  (NRM RESID)/(NRM Q)= 0.182E-13  RCOND(EST)= 0.251E-02 EST/TRUE= 0.371E+00
  2  (NRM RESID)/(NRM Q)= 0.142E-12  RCOND(EST)= 0.114E-03 EST/TRUE= 0.318E+00
  3  (NRM RESID)/(NRM Q)= 0.813E-14  RCOND(EST)= 0.229E-02 EST/TRUE= 0.313E+00
  4  (NRM RESID)/(NRM Q)= 0.125E-12  RCOND(EST)= 0.524E-03 EST/TRUE= 0.382E+00
  5  (NRM RESID)/(NRM Q)= 0.392E-13  RCOND(EST)= 0.316E-02 EST/TRUE= 0.656E+00

 N =  7
  1  (NRM RESID)/(NRM Q)= 0.239E-13
  2  (NRM RESID)/(NRM Q)= 0.444E-13
  3  (NRM RESID)/(NRM Q)= 0.109E-12
  4  (NRM RESID)/(NRM Q)= 0.106E-13
  5  (NRM RESID)/(NRM Q)= 0.398E-13

 N =  8
  1  (NRM RESID)/(NRM Q)= 0.116E-13
  2  (NRM RESID)/(NRM Q)= 0.245E-13
  3  (NRM RESID)/(NRM Q)= 0.737E-14
  4  (NRM RESID)/(NRM Q)= 0.182E-12
  5  (NRM RESID)/(NRM Q)= 0.163E-13

 WORST CASE RESIDUAL IS 0.182E-12
 WORST CASE RCOND RATIOS (EST/TRUE) ARE 0.225E+00 (LOW) AND 0.158E+01 (HIGH)
SHAR_EOF
fi # end of overwriting check
if test -f 'res9'
then
	echo shar: will not over-write existing file "'res9'"
else
cat << "SHAR_EOF" > 'res9'
             T        T
 SOLVE  A*X*E  + E*X*A  + Q = 0  USING SYLGD

 N =  1
  1  (NRM RESID)/(NRM Q)= 0.000E+00  RCOND(EST)= 0.789E+00 EST/TRUE= 0.789E+00
  2  (NRM RESID)/(NRM Q)= 0.000E+00  RCOND(EST)= 0.163E+00 EST/TRUE= 0.163E+00
  3  (NRM RESID)/(NRM Q)= 0.348E-15  RCOND(EST)= 0.594E+00 EST/TRUE= 0.594E+00
  4  (NRM RESID)/(NRM Q)= 0.282E-15  RCOND(EST)= 0.738E+00 EST/TRUE= 0.738E+00
  5  (NRM RESID)/(NRM Q)= 0.634E-16  RCOND(EST)= 0.739E+00 EST/TRUE= 0.739E+00

 N =  2
  1  (NRM RESID)/(NRM Q)= 0.143E-14  RCOND(EST)= 0.631E-01 EST/TRUE= 0.230E+00
  2  (NRM RESID)/(NRM Q)= 0.169E-13  RCOND(EST)= 0.204E-02 EST/TRUE= 0.671E+00
  3  (NRM RESID)/(NRM Q)= 0.559E-15  RCOND(EST)= 0.228E+00 EST/TRUE= 0.533E+00
  4  (NRM RESID)/(NRM Q)= 0.239E-14  RCOND(EST)= 0.373E-01 EST/TRUE= 0.122E+01
  5  (NRM RESID)/(NRM Q)= 0.133E-14  RCOND(EST)= 0.618E-01 EST/TRUE= 0.519E+00

 N =  3
  1  (NRM RESID)/(NRM Q)= 0.307E-14  RCOND(EST)= 0.113E-01 EST/TRUE= 0.908E+00
  2  (NRM RESID)/(NRM Q)= 0.112E-13  RCOND(EST)= 0.297E-02 EST/TRUE= 0.463E+00
  3  (NRM RESID)/(NRM Q)= 0.202E-13  RCOND(EST)= 0.612E-02 EST/TRUE= 0.677E+00
  4  (NRM RESID)/(NRM Q)= 0.438E-14  RCOND(EST)= 0.738E-03 EST/TRUE= 0.420E+00
  5  (NRM RESID)/(NRM Q)= 0.284E-14  RCOND(EST)= 0.164E-02 EST/TRUE= 0.489E+00

 N =  4
  1  (NRM RESID)/(NRM Q)= 0.376E-13  RCOND(EST)= 0.360E-02 EST/TRUE= 0.399E+00
  2  (NRM RESID)/(NRM Q)= 0.167E-13  RCOND(EST)= 0.274E-02 EST/TRUE= 0.607E+00
  3  (NRM RESID)/(NRM Q)= 0.571E-14  RCOND(EST)= 0.481E-02 EST/TRUE= 0.570E+00
  4  (NRM RESID)/(NRM Q)= 0.806E-15  RCOND(EST)= 0.491E-01 EST/TRUE= 0.519E+00
  5  (NRM RESID)/(NRM Q)= 0.165E-14  RCOND(EST)= 0.155E-02 EST/TRUE= 0.303E+00

 N =  5
  1  (NRM RESID)/(NRM Q)= 0.258E-14  RCOND(EST)= 0.127E-01 EST/TRUE= 0.330E+00
  2  (NRM RESID)/(NRM Q)= 0.110E-13  RCOND(EST)= 0.151E-02 EST/TRUE= 0.274E+00
  3  (NRM RESID)/(NRM Q)= 0.657E-13  RCOND(EST)= 0.309E-02 EST/TRUE= 0.826E+01
  4  (NRM RESID)/(NRM Q)= 0.588E-13  RCOND(EST)= 0.170E-02 EST/TRUE= 0.439E+00
  5  (NRM RESID)/(NRM Q)= 0.147E-13  RCOND(EST)= 0.131E-02 EST/TRUE= 0.225E+00

 N =  6
  1  (NRM RESID)/(NRM Q)= 0.546E-13  RCOND(EST)= 0.201E-02 EST/TRUE= 0.247E+01
  2  (NRM RESID)/(NRM Q)= 0.349E-14  RCOND(EST)= 0.882E-02 EST/TRUE= 0.704E+00
  3  (NRM RESID)/(NRM Q)= 0.454E-14  RCOND(EST)= 0.433E-02 EST/TRUE= 0.409E+00
  4  (NRM RESID)/(NRM Q)= 0.105E-13  RCOND(EST)= 0.507E-02 EST/TRUE= 0.793E+00
  5  (NRM RESID)/(NRM Q)= 0.363E-13  RCOND(EST)= 0.169E-02 EST/TRUE= 0.920E+00

 N =  7
  1  (NRM RESID)/(NRM Q)= 0.150E-13
  2  (NRM RESID)/(NRM Q)= 0.193E-12
  3  (NRM RESID)/(NRM Q)= 0.446E-13
  4  (NRM RESID)/(NRM Q)= 0.597E-13
  5  (NRM RESID)/(NRM Q)= 0.196E-13

 N =  8
  1  (NRM RESID)/(NRM Q)= 0.441E-13
  2  (NRM RESID)/(NRM Q)= 0.159E-12
  3  (NRM RESID)/(NRM Q)= 0.901E-14
  4  (NRM RESID)/(NRM Q)= 0.530E-13
  5  (NRM RESID)/(NRM Q)= 0.369E-13

 WORST CASE RESIDUAL IS 0.193E-12
 WORST CASE RCOND RATIOS (EST/TRUE) ARE 0.163E+00 (LOW) AND 0.826E+01 (HIGH)
SHAR_EOF
fi # end of overwriting check
cd ..
if test ! -d 'Src'
then
	mkdir 'Src'
fi
cd 'Src'
if test -f 'blas1.f'
then
	echo shar: will not over-write existing file "'blas1.f'"
else
cat << "SHAR_EOF" > 'blas1.f'
      DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY)
*
*  Purpose
*  =======
*
*  DDOT returns the REAL dot product of the elements of two
*       double precision vectors,
*           i.e., w = sum(x(j)*y(k))
*  where j = 1 + (i-1)*incx and k = 1 + (i-1)*incy for i = 1 to n.
*
*  Uses unrolled loops.
*
*  Parameters
*  ==========
*
*  N    - INTEGER
*         On entry, N specifies the number of elements in the sum.
*         Unchanged on exit.
*  DX   - DOUBLE PRECISION
*         On entry, DX specifies the vector x above.
*         Unchanged on exit.
*  INCX - INTEGER
*         On entry, INCX specifies the increment parameter used to step
*         through the array DX.
*         Unchanged on exit.
*  DY   - DOUBLE PRECISION
*         On entry, DY specifies the vector y above.
*         Unchanged on exit.
*  INCY - INTEGER
*         On entry, INCY specifies the increment parameter used to step
*         through the array DY.
*         Unchanged on exit.
*
*
*  Level 1 Blas routine
*
*  Toms algorithm 539 -- Lawson et al, 1979
*  Fortran 77 version -- Tim Hopkins, 1994
*
*     .. Scalar Arguments ..
      INTEGER          INCX,INCY,N
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION DX(*),DY(*)
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION DTEMP
      INTEGER          I,IX,IY,M,MP1
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        MOD
*     ..
      DDOT = 0.0d0
      DTEMP = 0.0d0
      IF (N.LE.0) RETURN
      IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20
*
*        code for unequal increments or equal increments
*          not equal to 1
*
      IX = 1
      IY = 1
      IF (INCX.LT.0) IX = (-N+1)*INCX + 1
      IF (INCY.LT.0) IY = (-N+1)*INCY + 1
      DO 10 I = 1,N
          DTEMP = DTEMP + DX(IX)*DY(IY)
          IX = IX + INCX
          IY = IY + INCY
   10 CONTINUE
      DDOT = DTEMP
      RETURN
*
*        code for both increments equal to 1
*
*
*        clean-up loop
*
   20 M = MOD(N,5)
      IF (M.EQ.0) GO TO 40
      DO 30 I = 1,M
          DTEMP = DTEMP + DX(I)*DY(I)
   30 CONTINUE
      IF (N.LT.5) GO TO 60
   40 MP1 = M + 1
      DO 50 I = MP1,N,5
          DTEMP = DTEMP + DX(I)*DY(I) + DX(I+1)*DY(I+1) +
     +            DX(I+2)*DY(I+2) + DX(I+3)*DY(I+3) + DX(I+4)*DY(I+4)
   50 CONTINUE
   60 DDOT = DTEMP
      RETURN

      END
      SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
*
*  Purpose
*  =======
*
*  DAXPY computes y = a * x + y where x and y are double precision
*        vectors and a is a double precision scalar.
*
*  The elements of the x-vector used are
*
*     1 + (i-1)*incx,   if incx >= 0,
*     1 + (n-i)*|incx|, if incx < 0.
*
*  and similarly for y and incy.
*
*  Uses unrolled loops.
*
*  Parameters
*  ==========
*
*  N    - INTEGER
*         On entry, N specifies the number of elements to be computed.
*         Unchanged on exit.
*  DA   - DOUBLE PRECISION
*         On entry, DA specifies the value of the scalar a above.
*         Unchanged on exit.
*  DX   - DOUBLE PRECISION
*         On entry, DX specifies the vector x above.
*         Unchanged on exit.
*  INCX - INTEGER
*         On entry, INCX specifies the increment parameter used to step
*         through the array DX.
*         Unchanged on exit.
*  DY   - DOUBLE PRECISION
*         On entry, DY specifies the vector y above.
*         On exit, DY contains DA * DX + DY.
*  INCY - INTEGER
*         On entry, INCY specifies the increment parameter used to step
*         through the array DY.
*         Unchanged on exit.
*
*
*  Level 1 Blas routine
*
*  Toms algorithm 539 -- Lawson et al, 1979
*  Fortran 77 version -- Tim Hopkins, 1994
*
*     .. Scalar Arguments ..
      DOUBLE PRECISION DA
      INTEGER          INCX,INCY,N
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION DX(*),DY(*)
*     ..
*     .. Local Scalars ..
      INTEGER          I,IX,IY,M,MP1
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        MOD
*     ..
      IF (N.LE.0) RETURN
      IF (DA.EQ.0.0d0) RETURN
      IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20
*
*        code for unequal increments or equal increments
*          not equal to 1
*
      IX = 1
      IY = 1
      IF (INCX.LT.0) IX = (-N+1)*INCX + 1
      IF (INCY.LT.0) IY = (-N+1)*INCY + 1
      DO 10 I = 1,N
          DY(IY) = DY(IY) + DA*DX(IX)
          IX = IX + INCX
          IY = IY + INCY
   10 CONTINUE
      RETURN
*
*        code for both increments equal to 1
*
*
*        clean-up loop
*
   20 M = MOD(N,4)
      IF (M.EQ.0) GO TO 40
      DO 30 I = 1,M
          DY(I) = DY(I) + DA*DX(I)
   30 CONTINUE
      IF (N.LT.4) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,4
          DY(I) = DY(I) + DA*DX(I)
          DY(I+1) = DY(I+1) + DA*DX(I+1)
          DY(I+2) = DY(I+2) + DA*DX(I+2)
          DY(I+3) = DY(I+3) + DA*DX(I+3)
   50 CONTINUE
      RETURN

      END
      SUBROUTINE DSCAL(N,DA,DX,INCX)
*
*  Purpose
*  =======
*
*  DSCAL computes x = a*x for a double precision scalar a and
*        elements of a double precision vector x.
*
*  The elements of the x-vector used are
*
*     1 + (i-1)*incx,   if incx >= 0.
*
*  Uses unrolled loops.
*
*  Parameters
*  ==========
*
*  N    - INTEGER
*         On entry, N specifies the number of elements to be scaled.
*         Unchanged on exit.
*  DA   - DOUBLE PRECISION
*         On entry, DA specifies the value of the scalar a above.
*         Unchanged on exit.
*  DX   - DOUBLE PRECISION
*         On entry, DX specifies the vector x above.
*         On exit, DX contains the scaled data.
*  INCX - INTEGER
*         On entry, INCX specifies the increment parameter used to step
*         through the array DX.
*         Unchanged on exit.
*
*
*  Level 1 Blas routine
*
*  Toms algorithm 539 -- Lawson et al, 1979
*  Fortran 77 version -- Tim Hopkins, 1994
*
*     .. Scalar Arguments ..
      DOUBLE PRECISION DA
      INTEGER          INCX,N
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION DX(*)
*     ..
*     .. Local Scalars ..
      INTEGER          I,M,MP1,NINCX
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        MOD
*     ..
      IF (N.LE.0 .OR. INCX.LE.0) RETURN
      IF (INCX.EQ.1) GO TO 20
*
*        code for increment not equal to 1
*
      NINCX = N*INCX
      DO 10 I = 1,NINCX,INCX
          DX(I) = DA*DX(I)
   10 CONTINUE
      RETURN
*
*        code for increment equal to 1
*
*
*        clean-up loop
*
   20 M = MOD(N,5)
      IF (M.EQ.0) GO TO 40
      DO 30 I = 1,M
          DX(I) = DA*DX(I)
   30 CONTINUE
      IF (N.LT.5) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,5
          DX(I) = DA*DX(I)
          DX(I+1) = DA*DX(I+1)
          DX(I+2) = DA*DX(I+2)
          DX(I+3) = DA*DX(I+3)
          DX(I+4) = DA*DX(I+4)
   50 CONTINUE
      RETURN

      END
      INTEGER FUNCTION IDAMAX(N,DX,INCX)
*
*  Purpose
*  =======
*
*  IDAMAX determines, for the double precision vector, x the smallest
*         index i such that
*
*     |x_i| = max{ |x_k| }
*
*  where k = 1 + (j-1)*incx, j = 1 to n.
*
*  Parameters
*  ==========
*
*  N    - INTEGER
*         On entry, N specifies the number of elements to be tested.
*         Unchanged on exit.
*  DX   - DOUBLE PRECISION
*         On entry, DX specifies the vector x above.
*         Unchanged on exit.
*  INCX - INTEGER
*         On entry, INCX specifies the increment parameter used to step
*         through the array DX.
*         Unchanged on exit.
*
*
*  Level 1 Blas routine
*
*  Toms algorithm 539 -- Lawson et al, 1979
*  Fortran 77 version -- Tim Hopkins, 1994
*
*     .. Scalar Arguments ..
      INTEGER          INCX,N
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION DX(*)
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION DMAX
      INTEGER          I,IX
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        DABS
*     ..
      IDAMAX = 0
      IF (N.LT.1 .OR. INCX.LE.0) RETURN
      IDAMAX = 1
      IF (N.EQ.1) RETURN
      IF (INCX.EQ.1) GO TO 30
*
*        code for increment not equal to 1
*
      IX = 1
      DMAX = DABS(DX(1))
      IX = IX + INCX
      DO 20 I = 2,N
          IF (DABS(DX(IX)).LE.DMAX) GO TO 10
          IDAMAX = I
          DMAX = DABS(DX(IX))
   10     IX = IX + INCX
   20 CONTINUE
      RETURN
*
*        code for increment equal to 1
*
   30 DMAX = DABS(DX(1))
      DO 40 I = 2,N
          IF (DABS(DX(I)).LE.DMAX) GO TO 40
          IDAMAX = I
          DMAX = DABS(DX(I))
   40 CONTINUE
      RETURN

      END
      SUBROUTINE DSWAP(N,DX,INCX,DY,INCY)
*
*  Purpose
*  =======
*
*  DSWAP exchanges elements of the double precision vectors x and y.
*
*  The elements of the x-vector used are
*
*     1 + (i-1)*incx,   if incx >= 0,
*     1 + (n-i)*|incx|, if incx < 0.
*
*  and similarly for y and incy.
*
*  Uses unrolled loops.
*
*  Parameters
*  ==========
*
*  N    - INTEGER
*         On entry, N specifies the number of elements to be swapped.
*         Unchanged on exit.
*  DX   - DOUBLE PRECISION
*         On entry, DX specifies the vector x above.
*         On exit, DX contains the data originally in DY.
*  INCX - INTEGER
*         On entry, INCX specifies the increment parameter used to step
*         through the array DX.
*         Unchanged on exit.
*  DY   - DOUBLE PRECISION
*         On entry, DY specifies the vector y above.
*         On exit, DY contains the data originally in DX.
*  INCY - INTEGER
*         On entry, INCY specifies the increment parameter used to step
*         through the array DY.
*         Unchanged on exit.
*
*
*  Level 1 Blas routine
*
*  Toms algorithm 539 -- Lawson et al, 1979
*  Fortran 77 version -- Tim Hopkins, 1994
*
*     .. Scalar Arguments ..
      INTEGER          INCX,INCY,N
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION DX(*),DY(*)
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION DTEMP
      INTEGER          I,IX,IY,M,MP1
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        MOD
*     ..
      IF (N.LE.0) RETURN
      IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20
*
*       code for unequal increments or equal increments not equal
*         to 1
*
      IX = 1
      IY = 1
      IF (INCX.LT.0) IX = (-N+1)*INCX + 1
      IF (INCY.LT.0) IY = (-N+1)*INCY + 1
      DO 10 I = 1,N
          DTEMP = DX(IX)
          DX(IX) = DY(IY)
          DY(IY) = DTEMP
          IX = IX + INCX
          IY = IY + INCY
   10 CONTINUE
      RETURN
*
*       code for both increments equal to 1
*
*
*       clean-up loop
*
   20 M = MOD(N,3)
      IF (M.EQ.0) GO TO 40
      DO 30 I = 1,M
          DTEMP = DX(I)
          DX(I) = DY(I)
          DY(I) = DTEMP
   30 CONTINUE
      IF (N.LT.3) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,3
          DTEMP = DX(I)
          DX(I) = DY(I)
          DY(I) = DTEMP
          DTEMP = DX(I+1)
          DX(I+1) = DY(I+1)
          DY(I+1) = DTEMP
          DTEMP = DX(I+2)
          DX(I+2) = DY(I+2)
          DY(I+2) = DTEMP
   50 CONTINUE
      RETURN

      END
      SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S)
*
*  Purpose
*  =======
*
*  DROT applies a plane rotation of the form
*
*         ( x_i )     ( c  s) ( x_i )
*         (     )  =  (     ) (     )
*         ( y_i )     (-s  c) ( y_i )
*
*  where the ith element of the double precision vector x is
*
*     1 + (i-1)*incx,   if incx >= 0,
*     1 + (n-i)*|incx|, if incx < 0.
*
*  and similarly for y and incy.
*
*  Parameters
*  ==========
*
*  N    - INTEGER
*         On entry, N specifies the number of columns.
*         Unchanged on exit.
*  DX   - DOUBLE PRECISION
*         On entry, DX specifies the vector x above.
*         On exit, DX specified the transformed data.
*  INCX - INTEGER
*         On entry, INCX specifies the increment parameter used to step
*         through the array DX.
*         Unchanged on exit.
*  DY   - DOUBLE PRECISION
*         On entry, DY specifies the vector y above.
*         On exit, DY specified the transformed data.
*  INCY - INTEGER
*         On entry, INCY specifies the increment parameter used to step
*         through the array DY.
*         Unchanged on exit.
*  C    - DOUBLE PRECISION
*         On entry, C specifies the value of c above.
*         Unchanged on exit.
*  S    - DOUBLE PRECISION
*         On entry, S specifies the value of s above.
*         Unchanged on exit.
*
*
*  Level 1 Blas routine
*
*  Toms algorithm 539 -- Lawson et al, 1979
*  Fortran 77 version -- Tim Hopkins, 1994
*
*     .. Scalar Arguments ..
      DOUBLE PRECISION C,S
      INTEGER          INCX,INCY,N
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION DX(*),DY(*)
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION DTEMP
      INTEGER          I,IX,IY
*     ..
      IF (N.LE.0) RETURN
      IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20
*
*       code for unequal increments or equal increments not equal
*         to 1
*
      IX = 1
      IY = 1
      IF (INCX.LT.0) IX = (-N+1)*INCX + 1
      IF (INCY.LT.0) IY = (-N+1)*INCY + 1
      DO 10 I = 1,N
          DTEMP = C*DX(IX) + S*DY(IY)
          DY(IY) = C*DY(IY) - S*DX(IX)
          DX(IX) = DTEMP
          IX = IX + INCX
          IY = IY + INCY
   10 CONTINUE
      RETURN
*
*       code for both increments equal to 1
*
   20 DO 30 I = 1,N
          DTEMP = C*DX(I) + S*DY(I)
          DY(I) = C*DY(I) - S*DX(I)
          DX(I) = DTEMP
   30 CONTINUE
      RETURN

      END
      DOUBLE PRECISION FUNCTION DNRM2(N,DX,INCX)
*
*  Purpose
*  =======
*
*  DNRM2 returns the DOUBLE PRECISION value of the Euclidean norm of
*  elements of the double precision vector x. It thus returns
*
*     ||x|| = sqrt(sum(x_i*x_i)) for i = 1 to n
*
*  where the elements of the x-vector used are
*
*     1 + (i-1)*incx
*
*
*  Parameters
*  ==========
*
*  N    - INTEGER
*         On entry, N specifies the number of elements to be used.
*         Unchanged on exit.
*  DX   - DOUBLE PRECISION
*         On entry, DX specifies the vector whose Euclidean norm is
*         to be computed.
*         Unchanged on exit.
*  INCX - INTEGER
*         On entry, INCX specifies the increment parameter used to step
*         through the array DX.
*         Unchanged on exit.
*
*
*  Level 1 Blas routine
*
*  Toms algorithm 539 -- Lawson et al, 1979
*  Fortran 77 version -- Tim Hopkins, 1994
*
*     .. Scalar Arguments ..
      INTEGER          INCX,N
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION DX(*)
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION CUTHI,CUTLO,HITEST,ONE,SUM,XMAX,ZERO
      INTEGER          I,IX,J,NEXT
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        DABS,DSQRT,FLOAT
*     ..
*     .. Data statements ..
      DATA             ZERO,ONE/0.0d0,1.0d0/
      DATA             CUTLO,CUTHI/8.232d-11,1.304d19/
*
*     four phase method     using two built-in constants that are
*     hopefully applicable to all machines.
*         cutlo = maximum of  dsqrt(u/eps)  over all known machines.
*         cuthi = minimum of  dsqrt(v)      over all known machines.
*     where
*         eps = smallest no. such that eps + 1. .gt. 1.
*         u   = smallest positive no.   (underflow limit)
*         v   = largest  no.            (overflow  limit)
*
*     brief outline of algorithm..
*
*     phase 1    scans zero components.
*     move to phase 2 when a component is nonzero and .le. cutlo
*     move to phase 3 when a component is .gt. cutlo
*     move to phase 4 when a component is .ge. cuthi/m
*     where m = n for x() real and m = 2*n for complex.
*
*     values for cutlo and cuthi..
*     from the environmental parameters listed in the imsl converter
*     document the limiting values are as follows..
*     cutlo, s.p.   u/eps = 2**(-102) for  honeywell.  close seconds are
*                   univac and dec at 2**(-103)
*                   thus cutlo = 2**(-51) = 4.44089e-16
*     cuthi, s.p.   v = 2**127 for univac, honeywell, and dec.
*                   thus cuthi = 2**(63.5) = 1.30438e19
*     cutlo, d.p.   u/eps = 2**(-67) for honeywell and dec.
*                   thus cutlo = 2**(-33.5) = 8.23181d-11
*     cuthi, d.p.   same as s.p.  cuthi = 1.30438d19
*     data cutlo, cuthi / 8.232d-11,  1.304d19 /
*     data cutlo, cuthi / 4.441e-16,  1.304e19 /
*     ..
*
      IF (N.GT.0 .AND. INCX.GT.0) GO TO 10
      DNRM2 = ZERO
      GO TO 140
*
   10 ASSIGN 30 TO NEXT
      SUM = ZERO
      I = 1
      IX = 1
*                                                 begin main loop
   20 GO TO NEXT(30,40,70,80)

   30 IF (DABS(DX(I)).GT.CUTLO) GO TO 110
      ASSIGN 40 TO NEXT
      XMAX = ZERO
*
*                        phase 1.  sum is zero
*
   40 IF (DX(I).EQ.ZERO) GO TO 130
      IF (DABS(DX(I)).GT.CUTLO) GO TO 110
*
*                                prepare for phase 2.
      ASSIGN 70 TO NEXT
      GO TO 60
*
*                                prepare for phase 4.
*
   50 CONTINUE
      IX = J
      ASSIGN 80 TO NEXT
      SUM = (SUM/DX(I))/DX(I)
   60 XMAX = DABS(DX(I))
      GO TO 90
*
*                   phase 2.  sum is small.
*                             scale to avoid destructive underflow.
*
   70 IF (DABS(DX(I)).GT.CUTLO) GO TO 100
*
*                     common code for phases 2 and 4.
*                     in phase 4 sum is large.  scale to avoid overflow.
*
   80 IF (DABS(DX(I)).LE.XMAX) GO TO 90
      SUM = ONE + SUM* (XMAX/DX(I))**2
      XMAX = DABS(DX(I))
      GO TO 130
*
   90 SUM = SUM + (DX(I)/XMAX)**2
      GO TO 130
*
*
*                  prepare for phase 3.
*
  100 SUM = (SUM*XMAX)*XMAX
*
*
*     for real or d.p. set hitest = cuthi/n
*     for complex      set hitest = cuthi/(2*n)
*
  110 HITEST = CUTHI/FLOAT(N)
*
*                   phase 3.  sum is mid-range.  no scaling.
*
      DO 120 J = IX,N
          IF (DABS(DX(I)).GE.HITEST) GO TO 50
          SUM = SUM + DX(I)**2
          I = I + INCX
  120 CONTINUE
      DNRM2 = DSQRT(SUM)
      GO TO 140
*
  130 CONTINUE
      IX = IX + 1
      I = I + INCX
      IF (IX.LE.N) GO TO 20
*
*              end of main loop.
*
*              compute square root and adjust for scaling.
*
      DNRM2 = XMAX*DSQRT(SUM)
  140 CONTINUE
      RETURN

      END
      SUBROUTINE DROTG(DA,DB,C,S)
*
*  Purpose
*  =======
*
*  DROTG constructs a Givens transformation, i.e, it computes
*        c = cos(theta) and s = sin(theta) such that
*
*         ( c  s) ( a )   ( r )
*         (     ) (   ) = (   )
*         (-s  c) ( b )   ( 0 )
*  It also computes the value z defined as
*
*         ( s   if |s| < c or c = 0,
*     z = (
*         ( 1/c if 0 < |c| <= s.
*
*  If the user later wishes to reconstruct c and s from z,
*  it can be done as follows:
*
*      If z = 1    set c = 0 and s = 1,
*      If |z| < 1  set c = sqrt(1-z^2) and s = z,
*      If |z| >= 1 set c = 1/z and s = sqrt(1-c^2).
*
*  Parameters
*  ==========
*
*  DA  - DOUBLE PRECISION
*        On entry, DA is the first element of the 2-vector.
*        On exit, DA is overwritten by the value of r (see above).
*  DB  - DOUBLE PRECISION
*        On entry, DB is the second element of the 2-vector.
*        On exit, DB is overwritten by the value of z (see above).
*  C   - DOUBLE PRECISION
*        On exit, contains the value of c (see above).
*  S   - DOUBLE PRECISION
*        On exit, contains the value of s (see above).
*
*
*  Level 1 Blas routine
*
*  Toms algorithm 539 -- Lawson et al, 1979
*  Fortran 77 version -- Tim Hopkins, 1994
*
*     .. Scalar Arguments ..
      DOUBLE PRECISION C,DA,DB,S
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION R,ROE,SCALE,Z
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        DABS,DSIGN,DSQRT
*     ..
      ROE = DB
      IF (DABS(DA).GT.DABS(DB)) ROE = DA
      SCALE = DABS(DA) + DABS(DB)
      IF (SCALE.NE.0.0d0) GO TO 10
      C = 1.0d0
      S = 0.0d0
      R = 0.0d0
      Z = 0.0d0
      GO TO 20

   10 R = SCALE*DSQRT((DA/SCALE)**2+ (DB/SCALE)**2)
      R = DSIGN(1.0d0,ROE)*R
      C = DA/R
      S = DB/R
      Z = 1.0d0
      IF (DABS(DA).GT.DABS(DB)) Z = S
      IF (DABS(DB).GE.DABS(DA) .AND. C.NE.0.0d0) Z = 1.0d0/C
   20 DA = R
      DB = Z
      RETURN

      END
      DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
*
*  Purpose
*  =======
*
*  DASUM returns the DOUBLE PRECISION sum of the absolute values
*        of elements of a double precision vector x.
*
*  The elements of the x-vector used are
*
*     1 + (i-1)*incx,   if incx >= 0.
*
*  Uses unrolled loops.
*
*  Parameters
*  ==========
*
*  N    - INTEGER
*         On entry, N specifies the number of elements to be summed.
*         Unchanged on exit.
*  DX   - DOUBLE PRECISION
*         On entry, DX specifies the vector x above.
*         Unchanged on exit.
*  INCX - INTEGER
*         On entry, INCX specifies the increment parameter used to step
*         through the array DX.
*         Unchanged on exit.
*
*
*  Level 1 Blas routine
*
*  Toms algorithm 539 -- Lawson et al, 1979
*  Fortran 77 version -- Tim Hopkins, 1994
*
*     .. Scalar Arguments ..
      INTEGER          INCX,N
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION DX(*)
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION DTEMP
      INTEGER          I,M,MP1,NINCX
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        DABS,MOD
*     ..
      DASUM = 0.0d0
      DTEMP = 0.0d0
      IF (N.LE.0 .OR. INCX.LE.0) RETURN
      IF (INCX.EQ.1) GO TO 20
*
*        code for increment not equal to 1
*
      NINCX = N*INCX
      DO 10 I = 1,NINCX,INCX
          DTEMP = DTEMP + DABS(DX(I))
   10 CONTINUE
      DASUM = DTEMP
      RETURN
*
*        code for increment equal to 1
*
*
*        clean-up loop
*
   20 M = MOD(N,6)
      IF (M.EQ.0) GO TO 40
      DO 30 I = 1,M
          DTEMP = DTEMP + DABS(DX(I))
   30 CONTINUE
      IF (N.LT.6) GO TO 60
   40 MP1 = M + 1
      DO 50 I = MP1,N,6
          DTEMP = DTEMP + DABS(DX(I)) + DABS(DX(I+1)) + DABS(DX(I+2)) +
     +            DABS(DX(I+3)) + DABS(DX(I+4)) + DABS(DX(I+5))
   50 CONTINUE
   60 DASUM = DTEMP
      RETURN

      END
SHAR_EOF
fi # end of overwriting check
if test -f 'linpack.f'
then
	echo shar: will not over-write existing file "'linpack.f'"
else
cat << "SHAR_EOF" > 'linpack.f'
      subroutine dgeco(a,lda,n,ipvt,rcond,z)
      integer lda,n,ipvt(n)
      double precision a(lda,n),z(n)
      double precision rcond
c
c     dgeco factors a double precision matrix by gaussian elimination
c     and estimates the condition of the matrix.
c
c     if  rcond  is not needed, dgefa is slightly faster.
c     to solve  a*x = b , follow dgeco by dgesl.
c     to compute  inverse(a)*c , follow dgeco by dgesl.
c     to compute  determinant(a) , follow dgeco by dgedi.
c     to compute  inverse(a) , follow dgeco by dgedi.
c
c     on entry
c
c        a       double precision(lda, n)
c                the matrix to be factored.
c
c        lda     integer
c                the leading dimension of the array  a .
c
c        n       integer
c                the order of the matrix  a .
c
c     on return
c
c        a       an upper triangular matrix and the multipliers
c                which were used to obtain it.
c                the factorization can be written  a = l*u  where
c                l  is a product of permutation and unit lower
c                triangular matrices and  u  is upper triangular.
c
c        ipvt    integer(n)
c                an integer vector of pivot indices.
c
c        rcond   double precision
c                an estimate of the reciprocal condition of  a .
c                for the system  a*x = b , relative perturbations
c                in  a  and  b  of size  epsilon  may cause
c                relative perturbations in  x  of size  epsilon/rcond .
c                if  rcond  is so small that the logical expression
c                           1.0 + rcond .eq. 1.0
c                is true, then  a  may be singular to working
c                precision.  in particular,  rcond  is zero  if
c                exact singularity is detected or the estimate
c                underflows.
c
c        z       double precision(n)
c                a work vector whose contents are usually unimportant.
c                if  a  is close to a singular matrix, then  z  is
c                an approximate null vector in the sense that
c                norm(a*z) = rcond*norm(a)*norm(z) .
c
c     linpack. this version dated 08/14/78 .
c     cleve moler, university of new mexico, argonne national lab.
c
c     subroutines and functions
c
c     linpack dgefa
c     blas daxpy,ddot,dscal,dasum
c     fortran dabs,dmax1,dsign
c
c     internal variables
c
      double precision ddot,ek,t,wk,wkm
      double precision anorm,s,dasum,sm,ynorm
      integer info,j,k,kb,kp1,l
c
c
c     compute 1-norm of a
c
      anorm = 0.0d0
      do 10 j = 1, n
         anorm = dmax1(anorm,dasum(n,a(1,j),1))
   10 continue
c
c     factor
c
      call dgefa(a,lda,n,ipvt,info)
c
c     rcond = 1/(norm(a)*(estimate of norm(inverse(a)))) .
c     estimate = norm(z)/norm(y) where  a*z = y  and  trans(a)*y = e .
c     trans(a)  is the transpose of a .  the components of  e  are
c     chosen to cause maximum local growth in the elements of w  where
c     trans(u)*w = e .  the vectors are frequently rescaled to avoid
c     overflow.
c
c     solve trans(u)*w = e
c
      ek = 1.0d0
      do 20 j = 1, n
         z(j) = 0.0d0
   20 continue
      do 100 k = 1, n
         if (z(k) .ne. 0.0d0) ek = dsign(ek,-z(k))
         if (dabs(ek-z(k)) .le. dabs(a(k,k))) go to 30
            s = dabs(a(k,k))/dabs(ek-z(k))
            call dscal(n,s,z,1)
            ek = s*ek
   30    continue
         wk = ek - z(k)
         wkm = -ek - z(k)
         s = dabs(wk)
         sm = dabs(wkm)
         if (a(k,k) .eq. 0.0d0) go to 40
            wk = wk/a(k,k)
            wkm = wkm/a(k,k)
         go to 50
   40    continue
            wk = 1.0d0
            wkm = 1.0d0
   50    continue
         kp1 = k + 1
         if (kp1 .gt. n) go to 90
            do 60 j = kp1, n
               sm = sm + dabs(z(j)+wkm*a(k,j))
               z(j) = z(j) + wk*a(k,j)
               s = s + dabs(z(j))
   60       continue
            if (s .ge. sm) go to 80
               t = wkm - wk
               wk = wkm
               do 70 j = kp1, n
                  z(j) = z(j) + t*a(k,j)
   70          continue
   80       continue
   90    continue
         z(k) = wk
  100 continue
      s = 1.0d0/dasum(n,z,1)
      call dscal(n,s,z,1)
c
c     solve trans(l)*y = w
c
      do 120 kb = 1, n
         k = n + 1 - kb
         if (k .lt. n) z(k) = z(k) + ddot(n-k,a(k+1,k),1,z(k+1),1)
         if (dabs(z(k)) .le. 1.0d0) go to 110
            s = 1.0d0/dabs(z(k))
            call dscal(n,s,z,1)
  110    continue
         l = ipvt(k)
         t = z(l)
         z(l) = z(k)
         z(k) = t
  120 continue
      s = 1.0d0/dasum(n,z,1)
      call dscal(n,s,z,1)
c
      ynorm = 1.0d0
c
c     solve l*v = y
c
      do 140 k = 1, n
         l = ipvt(k)
         t = z(l)
         z(l) = z(k)
         z(k) = t
         if (k .lt. n) call daxpy(n-k,t,a(k+1,k),1,z(k+1),1)
         if (dabs(z(k)) .le. 1.0d0) go to 130
            s = 1.0d0/dabs(z(k))
            call dscal(n,s,z,1)
            ynorm = s*ynorm
  130    continue
  140 continue
      s = 1.0d0/dasum(n,z,1)
      call dscal(n,s,z,1)
      ynorm = s*ynorm
c
c     solve  u*z = v
c
      do 160 kb = 1, n
         k = n + 1 - kb
         if (dabs(z(k)) .le. dabs(a(k,k))) go to 150
            s = dabs(a(k,k))/dabs(z(k))
            call dscal(n,s,z,1)
            ynorm = s*ynorm
  150    continue
         if (a(k,k) .ne. 0.0d0) z(k) = z(k)/a(k,k)
         if (a(k,k) .eq. 0.0d0) z(k) = 1.0d0
         t = -z(k)
         call daxpy(k-1,t,a(1,k),1,z(1),1)
  160 continue
c     make znorm = 1.0
      s = 1.0d0/dasum(n,z,1)
      call dscal(n,s,z,1)
      ynorm = s*ynorm
c
      if (anorm .ne. 0.0d0) rcond = ynorm/anorm
      if (anorm .eq. 0.0d0) rcond = 0.0d0
      return
      end
      subroutine dgefa(a,lda,n,ipvt,info)
      integer lda,n,ipvt(n),info
      double precision a(lda,n)
c
c     dgefa factors a double precision matrix by gaussian elimination.
c
c     dgefa is usually called by dgeco, but it can be called
c     directly with a saving in time if  rcond  is not needed.
c     (time for dgeco) = (1 + 9/n)*(time for dgefa) .
c
c     on entry
c
c        a       double precision(lda, n)
c                the matrix to be factored.
c
c        lda     integer
c                the leading dimension of the array  a .
c
c        n       integer
c                the order of the matrix  a .
c
c     on return
c
c        a       an upper triangular matrix and the multipliers
c                which were used to obtain it.
c                the factorization can be written  a = l*u  where
c                l  is a product of permutation and unit lower
c                triangular matrices and  u  is upper triangular.
c
c        ipvt    integer(n)
c                an integer vector of pivot indices.
c
c        info    integer
c                = 0  normal value.
c                = k  if  u(k,k) .eq. 0.0 .  this is not an error
c                     condition for this subroutine, but it does
c                     indicate that dgesl or dgedi will divide by zero
c                     if called.  use  rcond  in dgeco for a reliable
c                     indication of singularity.
c
c     linpack. this version dated 08/14/78 .
c     cleve moler, university of new mexico, argonne national lab.
c
c     subroutines and functions
c
c     blas daxpy,dscal,idamax
c
c     internal variables
c
      double precision t
      integer idamax,j,k,kp1,l,nm1
c
c
c     gaussian elimination with partial pivoting
c
      info = 0
      nm1 = n - 1
      if (nm1 .lt. 1) go to 70
      do 60 k = 1, nm1
         kp1 = k + 1
c
c        find l = pivot index
c
         l = idamax(n-k+1,a(k,k),1) + k - 1
         ipvt(k) = l
c
c        zero pivot implies this column already triangularized
c
         if (a(l,k) .eq. 0.0d0) go to 40
c
c           interchange if necessary
c
            if (l .eq. k) go to 10
               t = a(l,k)
               a(l,k) = a(k,k)
               a(k,k) = t
   10       continue
c
c           compute multipliers
c
            t = -1.0d0/a(k,k)
            call dscal(n-k,t,a(k+1,k),1)
c
c           row elimination with column indexing
c
            do 30 j = kp1, n
               t = a(l,j)
               if (l .eq. k) go to 20
                  a(l,j) = a(k,j)
                  a(k,j) = t
   20          continue
               call daxpy(n-k,t,a(k+1,k),1,a(k+1,j),1)
   30       continue
         go to 50
   40    continue
            info = k
   50    continue
   60 continue
   70 continue
      ipvt(n) = n
      if (a(n,n) .eq. 0.0d0) info = n
      return
      end
      subroutine dgesl(a,lda,n,ipvt,b,job)
      integer lda,n,ipvt(n),job
      double precision a(lda,n),b(n)
c
c     dgesl solves the double precision system
c     a * x = b  or  trans(a) * x = b
c     using the factors computed by dgeco or dgefa.
c
c     on entry
c
c        a       double precision(lda, n)
c                the output from dgeco or dgefa.
c
c        lda     integer
c                the leading dimension of the array  a .
c
c        n       integer
c                the order of the matrix  a .
c
c        ipvt    integer(n)
c                the pivot vector from dgeco or dgefa.
c
c        b       double precision(n)
c                the right hand side vector.
c
c        job     integer
c                = 0         to solve  a*x = b ,
c                = nonzero   to solve  trans(a)*x = b  where
c                            trans(a)  is the transpose.
c
c     on return
c
c        b       the solution vector  x .
c
c     error condition
c
c        a division by zero will occur if the input factor contains a
c        zero on the diagonal.  technically this indicates singularity
c        but it is often caused by improper arguments or improper
c        setting of lda .  it will not occur if the subroutines are
c        called correctly and if dgeco has set rcond .gt. 0.0
c        or dgefa has set info .eq. 0 .
c
c     to compute  inverse(a) * c  where  c  is a matrix
c     with  p  columns
c           call dgeco(a,lda,n,ipvt,rcond,z)
c           if (rcond is too small) go to ...
c           do 10 j = 1, p
c              call dgesl(a,lda,n,ipvt,c(1,j),0)
c        10 continue
c
c     linpack. this version dated 08/14/78 .
c     cleve moler, university of new mexico, argonne national lab.
c
c     subroutines and functions
c
c     blas daxpy,ddot
c
c     internal variables
c
      double precision ddot,t
      integer k,kb,l,nm1
c
      nm1 = n - 1
      if (job .ne. 0) go to 50
c
c        job = 0 , solve  a * x = b
c        first solve  l*y = b
c
         if (nm1 .lt. 1) go to 30
         do 20 k = 1, nm1
            l = ipvt(k)
            t = b(l)
            if (l .eq. k) go to 10
               b(l) = b(k)
               b(k) = t
   10       continue
            call daxpy(n-k,t,a(k+1,k),1,b(k+1),1)
   20    continue
   30    continue
c
c        now solve  u*x = y
c
         do 40 kb = 1, n
            k = n + 1 - kb
            b(k) = b(k)/a(k,k)
            t = -b(k)
            call daxpy(k-1,t,a(1,k),1,b(1),1)
   40    continue
      go to 100
   50 continue
c
c        job = nonzero, solve  trans(a) * x = b
c        first solve  trans(u)*y = b
c
         do 60 k = 1, n
            t = ddot(k-1,a(1,k),1,b(1),1)
            b(k) = (b(k) - t)/a(k,k)
   60    continue
c
c        now solve trans(l)*x = y
c
         if (nm1 .lt. 1) go to 90
         do 80 kb = 1, nm1
            k = n - kb
            b(k) = b(k) + ddot(n-k,a(k+1,k),1,b(k+1),1)
            l = ipvt(k)
            if (l .eq. k) go to 70
               t = b(l)
               b(l) = b(k)
               b(k) = t
   70       continue
   80    continue
   90    continue
  100 continue
      return
      end
      subroutine dsvdc(x,ldx,n,p,s,e,u,ldu,v,ldv,work,job,info)
      integer ldx,n,p,ldu,ldv,job,info
      double precision x(ldx,p),s(*),e(p),u(ldu,*),v(ldv,*),work(n)
c
c
c     dsvdc is a subroutine to reduce a double precision nxp matrix x
c     by orthogonal transformations u and v to diagonal form.  the
c     diagonal elements s(i) are the singular values of x.  the
c     columns of u are the corresponding left singular vectors,
c     and the columns of v the right singular vectors.
c
c     on entry
c
c         x         double precision(ldx,p), where ldx.ge.n.
c                   x contains the matrix whose singular value
c                   decomposition is to be computed.  x is
c                   destroyed by dsvdc.
c
c         ldx       integer.
c                   ldx is the leading dimension of the array x.
c
c         n         integer.
c                   n is the number of rows of the matrix x.
c
c         p         integer.
c                   p is the number of columns of the matrix x.
c
c         ldu       integer.
c                   ldu is the leading dimension of the array u.
c                   (see below).
c
c         ldv       integer.
c                   ldv is the leading dimension of the array v.
c                   (see below).
c
c         work      double precision(n).
c                   work is a scratch array.
c
c         job       integer.
c                   job controls the computation of the singular
c                   vectors.  it has the decimal expansion ab
c                   with the following meaning
c
c                        a.eq.0    do not compute the left singular
c                                  vectors.
c                        a.eq.1    return the n left singular vectors
c                                  in u.
c                        a.ge.2    return the first min(n,p) singular
c                                  vectors in u.
c                        b.eq.0    do not compute the right singular
c                                  vectors.
c                        b.eq.1    return the right singular vectors
c                                  in v.
c
c     on return
c
c         s         double precision(mm), where mm=min(n+1,p).
c                   the first min(n,p) entries of s contain the
c                   singular values of x arranged in descending
c                   order of magnitude.
c
c         e         double precision(p), 
c                   e ordinarily contains zeros.  however see the
c                   discussion of info for exceptions.
c
c         u         double precision(ldu,k), where ldu.ge.n.  if
c                                   joba.eq.1 then k.eq.n, if joba.ge.2
c                                   then k.eq.min(n,p).
c                   u contains the matrix of left singular vectors.
c                   u is not referenced if joba.eq.0.  if n.le.p
c                   or if joba.eq.2, then u may be identified with x
c                   in the subroutine call.
c
c         v         double precision(ldv,p), where ldv.ge.p.
c                   v contains the matrix of right singular vectors.
c                   v is not referenced if job.eq.0.  if p.le.n,
c                   then v may be identified with x in the
c                   subroutine call.
c
c         info      integer.
c                   the singular values (and their corresponding
c                   singular vectors) s(info+1),s(info+2),...,s(m)
c                   are correct (here m=min(n,p)).  thus if
c                   info.eq.0, all the singular values and their
c                   vectors are correct.  in any event, the matrix
c                   b = trans(u)*x*v is the bidiagonal matrix
c                   with the elements of s on its diagonal and the
c                   elements of e on its super-diagonal (trans(u)
c                   is the transpose of u).  thus the singular
c                   values of x and b are the same.
c
c     linpack. this version dated 08/14/78 .
c              correction made to shift 2/84.
c     g.w. stewart, university of maryland, argonne national lab.
c
c     dsvdc uses the following functions and subprograms.
c
c     external drot
c     blas daxpy,ddot,dscal,dswap,dnrm2,drotg
c     fortran dabs,dmax1,max0,min0,mod,dsqrt
c
c     internal variables
c
      integer i,iter,j,jobu,k,kase,kk,l,ll,lls,lm1,lp1,ls,lu,m,maxit,
     *        mm,mm1,mp1,nct,nctp1,ncu,nrt,nrtp1
      double precision ddot,t,r
      double precision b,c,cs,el,emm1,f,g,dnrm2,scale,shift,sl,sm,sn,
     *                 smm1,t1,test,ztest
      logical wantu,wantv
c
c
c     set the maximum number of iterations.
c
      maxit = 30
c
c     determine what is to be computed.
c
      wantu = .false.
      wantv = .false.
      jobu = mod(job,100)/10
      ncu = n
      if (jobu .gt. 1) ncu = min0(n,p)
      if (jobu .ne. 0) wantu = .true.
      if (mod(job,10) .ne. 0) wantv = .true.
c
c     reduce x to bidiagonal form, storing the diagonal elements
c     in s and the super-diagonal elements in e.
c
      info = 0
      nct = min0(n-1,p)
      nrt = max0(0,min0(p-2,n))
      lu = max0(nct,nrt)
      if (lu .lt. 1) go to 170
      do 160 l = 1, lu
         lp1 = l + 1
         if (l .gt. nct) go to 20
c
c           compute the transformation for the l-th column and
c           place the l-th diagonal in s(l).
c
            s(l) = dnrm2(n-l+1,x(l,l),1)
            if (s(l) .eq. 0.0d0) go to 10
               if (x(l,l) .ne. 0.0d0) s(l) = dsign(s(l),x(l,l))
               call dscal(n-l+1,1.0d0/s(l),x(l,l),1)
               x(l,l) = 1.0d0 + x(l,l)
   10       continue
            s(l) = -s(l)
   20    continue
         if (p .lt. lp1) go to 50
         do 40 j = lp1, p
            if (l .gt. nct) go to 30
            if (s(l) .eq. 0.0d0) go to 30
c
c              apply the transformation.
c
               t = -ddot(n-l+1,x(l,l),1,x(l,j),1)/x(l,l)
               call daxpy(n-l+1,t,x(l,l),1,x(l,j),1)
   30       continue
c
c           place the l-th row of x into  e for the
c           subsequent calculation of the row transformation.
c
            e(j) = x(l,j)
   40    continue
   50    continue
         if (.not.wantu .or. l .gt. nct) go to 70
c
c           place the transformation in u for subsequent back
c           multiplication.
c
            do 60 i = l, n
               u(i,l) = x(i,l)
   60       continue
   70    continue
         if (l .gt. nrt) go to 150
c
c           compute the l-th row transformation and place the
c           l-th super-diagonal in e(l).
c
            e(l) = dnrm2(p-l,e(lp1),1)
            if (e(l) .eq. 0.0d0) go to 80
               if (e(lp1) .ne. 0.0d0) e(l) = dsign(e(l),e(lp1))
               call dscal(p-l,1.0d0/e(l),e(lp1),1)
               e(lp1) = 1.0d0 + e(lp1)
   80       continue
            e(l) = -e(l)
            if (lp1 .gt. n .or. e(l) .eq. 0.0d0) go to 120
c
c              apply the transformation.
c
               do 90 i = lp1, n
                  work(i) = 0.0d0
   90          continue
               do 100 j = lp1, p
                  call daxpy(n-l,e(j),x(lp1,j),1,work(lp1),1)
  100          continue
               do 110 j = lp1, p
                  call daxpy(n-l,-e(j)/e(lp1),work(lp1),1,x(lp1,j),1)
  110          continue
  120       continue
            if (.not.wantv) go to 140
c
c              place the transformation in v for subsequent
c              back multiplication.
c
               do 130 i = lp1, p
                  v(i,l) = e(i)
  130          continue
  140       continue
  150    continue
  160 continue
  170 continue
c
c     set up the final bidiagonal matrix or order m.
c
      m = min0(p,n+1)
      nctp1 = nct + 1
      nrtp1 = nrt + 1
      if (nct .lt. p) s(nctp1) = x(nctp1,nctp1)
      if (n .lt. m) s(m) = 0.0d0
      if (nrtp1 .lt. m) e(nrtp1) = x(nrtp1,m)
      e(m) = 0.0d0
c
c     if required, generate u.
c
      if (.not.wantu) go to 300
         if (ncu .lt. nctp1) go to 200
         do 190 j = nctp1, ncu
            do 180 i = 1, n
               u(i,j) = 0.0d0
  180       continue
            u(j,j) = 1.0d0
  190    continue
  200    continue
         if (nct .lt. 1) go to 290
         do 280 ll = 1, nct
            l = nct - ll + 1
            if (s(l) .eq. 0.0d0) go to 250
               lp1 = l + 1
               if (ncu .lt. lp1) go to 220
               do 210 j = lp1, ncu
                  t = -ddot(n-l+1,u(l,l),1,u(l,j),1)/u(l,l)
                  call daxpy(n-l+1,t,u(l,l),1,u(l,j),1)
  210          continue
  220          continue
               call dscal(n-l+1,-1.0d0,u(l,l),1)
               u(l,l) = 1.0d0 + u(l,l)
               lm1 = l - 1
               if (lm1 .lt. 1) go to 240
               do 230 i = 1, lm1
                  u(i,l) = 0.0d0
  230          continue
  240          continue
            go to 270
  250       continue
               do 260 i = 1, n
                  u(i,l) = 0.0d0
  260          continue
               u(l,l) = 1.0d0
  270       continue
  280    continue
  290    continue
  300 continue
c
c     if it is required, generate v.
c
      if (.not.wantv) go to 350
         do 340 ll = 1, p
            l = p - ll + 1
            lp1 = l + 1
            if (l .gt. nrt) go to 320
            if (e(l) .eq. 0.0d0) go to 320
               do 310 j = lp1, p
                  t = -ddot(p-l,v(lp1,l),1,v(lp1,j),1)/v(lp1,l)
                  call daxpy(p-l,t,v(lp1,l),1,v(lp1,j),1)
  310          continue
  320       continue
            do 330 i = 1, p
               v(i,l) = 0.0d0
  330       continue
            v(l,l) = 1.0d0
  340    continue
  350 continue
c
c     main iteration loop for the singular values.
c
      mm = m
      iter = 0
  360 continue
c
c        quit if all the singular values have been found.
c
c     ...exit
         if (m .eq. 0) go to 620
c
c        if too many iterations have been performed, set
c        flag and return.
c
         if (iter .lt. maxit) go to 370
            info = m
c     ......exit
            go to 620
  370    continue
c
c        this section of the program inspects for
c        negligible elements in the s and e arrays.  on
c        completion the variables kase and l are set as follows.
c
c           kase = 1     if s(m) and e(l-1) are negligible and l.lt.m
c           kase = 2     if s(l) is negligible and l.lt.m
c           kase = 3     if e(l-1) is negligible, l.lt.m, and
c                        s(l), ..., s(m) are not negligible (qr step).
c           kase = 4     if e(m-1) is negligible (convergence).
c
         do 390 ll = 1, m
            l = m - ll
c        ...exit
            if (l .eq. 0) go to 400
            test = dabs(s(l)) + dabs(s(l+1))
            ztest = test + dabs(e(l))
            if (ztest .ne. test) go to 380
               e(l) = 0.0d0
c        ......exit
               go to 400
  380       continue
  390    continue
  400    continue
         if (l .ne. m - 1) go to 410
            kase = 4
         go to 480
  410    continue
            lp1 = l + 1
            mp1 = m + 1
            do 430 lls = lp1, mp1
               ls = m - lls + lp1
c           ...exit
               if (ls .eq. l) go to 440
               test = 0.0d0
               if (ls .ne. m) test = test + dabs(e(ls))
               if (ls .ne. l + 1) test = test + dabs(e(ls-1))
               ztest = test + dabs(s(ls))
               if (ztest .ne. test) go to 420
                  s(ls) = 0.0d0
c           ......exit
                  go to 440
  420          continue
  430       continue
  440       continue
            if (ls .ne. l) go to 450
               kase = 3
            go to 470
  450       continue
            if (ls .ne. m) go to 460
               kase = 1
            go to 470
  460       continue
               kase = 2
               l = ls
  470       continue
  480    continue
         l = l + 1
c
c        perform the task indicated by kase.
c
         go to (490,520,540,570), kase
c
c        deflate negligible s(m).
c
  490    continue
            mm1 = m - 1
            f = e(m-1)
            e(m-1) = 0.0d0
            do 510 kk = l, mm1
               k = mm1 - kk + l
               t1 = s(k)
               call drotg(t1,f,cs,sn)
               s(k) = t1
               if (k .eq. l) go to 500
                  f = -sn*e(k-1)
                  e(k-1) = cs*e(k-1)
  500          continue
               if (wantv) call drot(p,v(1,k),1,v(1,m),1,cs,sn)
  510       continue
         go to 610
c
c        split at negligible s(l).
c
  520    continue
            f = e(l-1)
            e(l-1) = 0.0d0
            do 530 k = l, m
               t1 = s(k)
               call drotg(t1,f,cs,sn)
               s(k) = t1
               f = -sn*e(k)
               e(k) = cs*e(k)
               if (wantu) call drot(n,u(1,k),1,u(1,l-1),1,cs,sn)
  530       continue
         go to 610
c
c        perform one qr step.
c
  540    continue
c
c           calculate the shift.
c
            scale = dmax1(dabs(s(m)),dabs(s(m-1)),dabs(e(m-1)),
     *                    dabs(s(l)),dabs(e(l)))
            sm = s(m)/scale
            smm1 = s(m-1)/scale
            emm1 = e(m-1)/scale
            sl = s(l)/scale
            el = e(l)/scale
            b = ((smm1 + sm)*(smm1 - sm) + emm1**2)/2.0d0
            c = (sm*emm1)**2
            shift = 0.0d0
            if (b .eq. 0.0d0 .and. c .eq. 0.0d0) go to 550
               shift = dsqrt(b**2+c)
               if (b .lt. 0.0d0) shift = -shift
               shift = c/(b + shift)
  550       continue
            f = (sl + sm)*(sl - sm) + shift
            g = sl*el
c
c           chase zeros.
c
            mm1 = m - 1
            do 560 k = l, mm1
               call drotg(f,g,cs,sn)
               if (k .ne. l) e(k-1) = f
               f = cs*s(k) + sn*e(k)
               e(k) = cs*e(k) - sn*s(k)
               g = sn*s(k+1)
               s(k+1) = cs*s(k+1)
               if (wantv) call drot(p,v(1,k),1,v(1,k+1),1,cs,sn)
               call drotg(f,g,cs,sn)
               s(k) = f
               f = cs*e(k) + sn*s(k+1)
               s(k+1) = -sn*e(k) + cs*s(k+1)
               g = sn*e(k+1)
               e(k+1) = cs*e(k+1)
               if (wantu .and. k .lt. n)
     *            call drot(n,u(1,k),1,u(1,k+1),1,cs,sn)
  560       continue
            e(m-1) = f
            iter = iter + 1
         go to 610
c
c        convergence.
c
  570    continue
c
c           make the singular value  positive.
c
            if (s(l) .ge. 0.0d0) go to 580
               s(l) = -s(l)
               if (wantv) call dscal(p,-1.0d0,v(1,l),1)
  580       continue
c
c           order the singular value.
c
  590       if (l .eq. mm) go to 600
c           ...exit
               if (s(l) .ge. s(l+1)) go to 600
               t = s(l)
               s(l) = s(l+1)
               s(l+1) = t
               if (wantv .and. l .lt. p)
     *            call dswap(p,v(1,l),1,v(1,l+1),1)
               if (wantu .and. l .lt. n)
     *            call dswap(n,u(1,l),1,u(1,l+1),1)
               l = l + 1
            go to 590
  600       continue
            iter = 0
            m = m - 1
  610    continue
      go to 360
  620 continue
      return
      end
SHAR_EOF
fi # end of overwriting check
if test -f 'port.f'
then
	echo shar: will not over-write existing file "'port.f'"
else
cat << "SHAR_EOF" > 'port.f'
      DOUBLE PRECISION FUNCTION D1MACH(I)
      INTEGER I
C***PURPOSE  RETURNS DOUBLE PRECISION MACHINE DEPENDENT CONSTANTS
C***DESCRIPTION
C
C     D1MACH CAN BE USED TO OBTAIN MACHINE-DEPENDENT PARAMETERS
C     FOR THE LOCAL MACHINE ENVIRONMENT.  IT IS A FUNCTION
C     SUBPROGRAM WITH ONE (INPUT) ARGUMENT, AND CAN BE CALLED
C     AS FOLLOWS, FOR EXAMPLE
C
C          D = D1MACH(I)
C
C     WHERE I=1,...,5.  THE (OUTPUT) VALUE OF D ABOVE IS
C     DETERMINED BY THE (INPUT) VALUE OF I.  THE RESULTS FOR
C     VARIOUS VALUES OF I ARE DISCUSSED BELOW.
C
C  DOUBLE-PRECISION MACHINE CONSTANTS
C  D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE.
C  D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE.
C  D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING.
C  D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING.
C  D1MACH( 5) = LOG10(B)
C***REFERENCES  FOX P.A., HALL A.D., SCHRYER N.L.,*FRAMEWORK FOR A
C                 PORTABLE LIBRARY*, ACM TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOL. 4, NO. 2, JUNE 1978, PP. 177-188.
C***ROUTINES CALLED  XERROR
C***END PROLOGUE  D1MACH
C
C***FIRST EXECUTABLE STATEMENT  D1MACH
      REAL(KIND=KIND(0.0d0)), PARAMETER:: ZERO = 0.0d0, BASE = 2.0d0
      SELECT CASE (I)
      CASE(1)
        D1MACH = TINY(ZERO)
      CASE(2)
        D1MACH = HUGE(ZERO)
      CASE(3)
        D1MACH = EPSILON(ZERO)
      CASE(4)
        D1MACH = BASE * EPSILON(ZERO)
      CASE(5)
        D1MACH = LOG10(BASE)
      END SELECT
C
      END
      REAL FUNCTION R1MACH(I)
      INTEGER I
C***PURPOSE  RETURNS SINGLE PRECISION MACHINE DEPENDENT CONSTANTS
C***DESCRIPTION
C
C     R1MACH CAN BE USED TO OBTAIN MACHINE-DEPENDENT PARAMETERS
C     FOR THE LOCAL MACHINE ENVIRONMENT.  IT IS A FUNCTION
C     SUBROUTINE WITH ONE (INPUT) ARGUMENT, AND CAN BE CALLED
C     AS FOLLOWS, FOR EXAMPLE
C
C          A = R1MACH(I)
C
C     WHERE I=1,...,5.  THE (OUTPUT) VALUE OF A ABOVE IS
C     DETERMINED BY THE (INPUT) VALUE OF I.  THE RESULTS FOR
C     VARIOUS VALUES OF I ARE DISCUSSED BELOW.
C
C  SINGLE-PRECISION MACHINE CONSTANTS
C  R1MACH(1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE.
C  R1MACH(2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE.
C  R1MACH(3) = B**(-T), THE SMALLEST RELATIVE SPACING.
C  R1MACH(4) = B**(1-T), THE LARGEST RELATIVE SPACING.
C  R1MACH(5) = LOG10(B)
C***REFERENCES  FOX, P.A., HALL, A.D., SCHRYER, N.L, *FRAMEWORK FOR
C                 A PORTABLE LIBRARY*, ACM TRANSACTIONS ON MATHE-
C                 MATICAL SOFTWARE, VOL. 4, NO. 2, JUNE 1978,
C                 PP. 177-188.
C***ROUTINES CALLED  XERROR
C***END PROLOGUE  R1MACH
C***FIRST EXECUTABLE STATEMENT  R1MACH
      REAL, PARAMETER:: ZERO = 0.0e0, BASE = 2.0e0
      SELECT CASE (I)
      CASE(1)
        R1MACH = TINY(ZERO)
      CASE(2)
        R1MACH = HUGE(ZERO)
      CASE(3)
        R1MACH = EPSILON(ZERO)
      CASE(4)
        R1MACH = BASE * EPSILON(ZERO)
      CASE(5)
        R1MACH = LOG10(BASE)
      END SELECT
C
      END
      INTEGER FUNCTION I1MACH(I)
C***PURPOSE  RETURN INTEGER MACHINE DEPENDENT CONSTANTS.
C***DESCRIPTION
C
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C   THESE MACHINE CONSTANT ROUTINES MUST BE ACTIVATED FOR
C   A PARTICULAR ENVIRONMENT.
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
C     I1MACH CAN BE USED TO OBTAIN MACHINE-DEPENDENT PARAMETERS
C     FOR THE LOCAL MACHINE ENVIRONMENT.  IT IS A FUNCTION
C     SUBROUTINE WITH ONE (INPUT) ARGUMENT, AND CAN BE CALLED
C     AS FOLLOWS, FOR EXAMPLE
C
C          K = I1MACH(I)
C
C     WHERE I=1,...,16.  THE (OUTPUT) VALUE OF K ABOVE IS
C     DETERMINED BY THE (INPUT) VALUE OF I.  THE RESULTS FOR
C     VARIOUS VALUES OF I ARE DISCUSSED BELOW.
C
C  I/O UNIT NUMBERS.
C    I1MACH( 1) = THE STANDARD INPUT UNIT.
C    I1MACH( 2) = THE STANDARD OUTPUT UNIT.
C    I1MACH( 3) = THE STANDARD PUNCH UNIT.
C    I1MACH( 4) = THE STANDARD ERROR MESSAGE UNIT.
C
C  WORDS.
C    I1MACH( 5) = THE NUMBER OF BITS PER INTEGER STORAGE UNIT.
C    I1MACH( 6) = THE NUMBER OF CHARACTERS PER INTEGER STORAGE UNIT.
C
C  INTEGERS.
C    ASSUME INTEGERS ARE REPRESENTED IN THE S-DIGIT, BASE-A FORM
C
C               SIGN ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
C
C               WHERE 0 .LE. X(I) .LT. A FOR I=0,...,S-1.
C    I1MACH( 7) = A, THE BASE.
C    I1MACH( 8) = S, THE NUMBER OF BASE-A DIGITS.
C    I1MACH( 9) = A**S - 1, THE LARGEST MAGNITUDE.
C
C  FLOATING-POINT NUMBERS.
C    ASSUME FLOATING-POINT NUMBERS ARE REPRESENTED IN THE T-DIGIT,
C    BASE-B FORM
C               SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
C
C               WHERE 0 .LE. X(I) .LT. B FOR I=1,...,T,
C               0 .LT. X(1), AND EMIN .LE. E .LE. EMAX.
C    I1MACH(10) = B, THE BASE.
C
C  SINGLE-PRECISION
C    I1MACH(11) = T, THE NUMBER OF BASE-B DIGITS.
C    I1MACH(12) = EMIN, THE SMALLEST EXPONENT E.
C    I1MACH(13) = EMAX, THE LARGEST EXPONENT E.
C
C  DOUBLE-PRECISION
C    I1MACH(14) = T, THE NUMBER OF BASE-B DIGITS.
C    I1MACH(15) = EMIN, THE SMALLEST EXPONENT E.
C    I1MACH(16) = EMAX, THE LARGEST EXPONENT E.
       INTEGER I
       REAL R
       DOUBLE PRECISION D

       SELECT CASE (I)
       CASE(1)
         I1MACH = 5  ! Standard input
       CASE(2)
         I1MACH = 6  ! Standard output
       CASE(3)
         I1MACH = 6  ! Standard punch :-)
       CASE(4)
         I1MACH = 6  ! Standard error
       CASE(5)
         I1MACH = DIGITS(I) + 1 !  Number of bits /integer (+1 for the sign)
       CASE(6)
         I1MACH = 4  ! Number of characters / integer :-)
       CASE(7)
         I1MACH = RADIX(I) ! base of integers
       CASE(8)
         I1MACH = DIGITS(I) ! number of base radix digits in integer
       CASE(9)
         I1MACH = HUGE(I) ! Maximum integer
       CASE(10)
         I1MACH = RADIX(R) ! base of floating point
       CASE(11)
         I1MACH = DIGITS(R) ! number of base radix digits in sp
       CASE(12)
         I1MACH = MINEXPONENT(R) ! minimun sp exponent
       CASE(13)
         I1MACH = MAXEXPONENT(R) ! maximum sp exponent
       CASE(14)
         I1MACH = DIGITS(D) ! number of base radix digits in dp
       CASE(15)
         I1MACH = MINEXPONENT(D) ! minimun dp exponent
       CASE(16)
         I1MACH = MAXEXPONENT(D) ! maximum dp exponent
       END SELECT
       END
SHAR_EOF
fi # end of overwriting check
if test -f 'src.f'
then
	echo shar: will not over-write existing file "'src.f'"
else
cat << "SHAR_EOF" > 'src.f'
C--**--CH2918--705--P:MC--28:10:1999
C--**--CH2902--705--B:UV--28:10:1999
C--**--CH2883--705--B:Fix--28:10:1999
C--**--CH2880--705--C:SU--28:10:1999
C--**--CH2878--705--C:ID--28:10:1999
C--**--CH2877--705--C:L--28:10:1999
C--**--CH2875--705--A:1--28:10:1999
C--**--CH2874--705--A:1--28:10:1999
      SUBROUTINE BKCON(NST, NR, N, S, T, R, JOB, IERR)
C
      INTEGER NST, NR, N, JOB, IERR
      DOUBLE PRECISION S(NST,N), T(NST,N), R(NR,N)
C
C     THIS SUBROUTINES PERFORMS BACK SUBSTITUTION FOR THE CONTINUOUS-
C     TIME SYMMETRIC SYLVESTER'S EQUATION.  THE EQUATION IS ASSUMED TO
C     BE IN THE FORM
C
C        S*Y*T' + T*Y*S' +  R  =  0   (' DENOTES TRANSPOSE)
C
C     WHERE  S  IS QUASI-UPPER-TRIANGULAR,  T  IS UPPER-TRIANGULAR,  C
C     IS SYMMETRIC AND  Y  IS TO BE COMPUTED.  BKCON IS MEANT TO BE
C     CALLED FROM SYLGC, WHICH SOLVES THE CASE WHERE S AND T ARE DENSE.
C     THIS ROUTINE IS ALSO CALLED BY SEPGC, WHICH IS USED FOR CONDITION
C     ESTIMATION.
C
C     ------------------------------------------------------------------
C     ON ENTRY -
C       NST     INTEGER
C               ROW DIMENSION OF THE ARRAYS S AND T AS DECLARED IN THE
C               CALLING PROGRAM
C
C       NR      INTEGER
C               ROW DIMENSION OF THE ARRAY  R  AS DECLARED IN THE
C               CALLING PROGRAM
C
C       N       INTEGER
C               ACTUAL DIMENSION OF THE MATRICES
C
C       S       DOUBLE PRECISION (NST,N)
C               N BY N QUASI-UPPER-TRIANGULAR MATRIX. THE ELEMENTS BELOW
C               THE FIRST SUBDIAGONAL ARE NOT REFERENCED.
C
C       T       DOUBLE PRECISION (NST,N)
C               N BY N UPPER-TRIANGULAR MATRIX.  THE ELEMENTS BELOW THE
C               DIAGONAL ARE NOT REFERENCED.
C
C       R       DOUBLE PRECISION (NR,N)
C               N BY N SYMMETRIC MATRIX.  MUST BE ZERO IF JOB .EQ. 1.
C
C       JOB     INTEGER
C               JOB = 0 SOLVE EQUATION AS GIVEN
C               JOB = 1 FIND Y SUCH THAT 1-NORM(S*Y*T'+T*Y*S')/1-NORM(Y)
C                       IS APPROXIMATELY MINIMIZED.  (USED IN SEPGC)
C                       IN THIS CASE R MUST BE ZERO ON INPUT.
C
C     ON RETURN -
C       R       DOUBLE PRECISION (NR,N)
C               N BY N SOLUTION MATRIX
C
C       IERR    INTEGER
C               0  == NORMAL RETURN
C               >0 == EQUATION SINGULAR
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       (LINPACK) DGECO DGESL
C
C     WRITTEN -
C       J. GARDINER, 1985.
C     REVISED -
C       05MAR87 M. WETTE (ADDED JOB PARAMETER AND STUFF FOR SEPGC)
C       26JAN89 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     ------------------------------------------------------------------
C
      INTEGER NA, NSYS, IPVT(4), I, J, K
      DOUBLE PRECISION V(8), P(4), A(4,4), E(4), RCOND, TMP
      LOGICAL DOSEP
C
C     ------------------------------------------------------------------
C
      IERR = 0
      NA = 4
      DOSEP = (MOD(JOB,10) .EQ. 1)
C
C     MAIN LOOP FOR BACK SUBSTITUTION -- COMPUTE SOLUTION BY COLUMNS
C
      K = N
   10 CONTINUE
      IF (K .EQ. 0) RETURN
      IF (K .EQ. 1) GO TO 20
      IF (S(K,K-1) .NE. 0.0D0) GO TO 130
C
C     ------------------------------------------------------------------
C
C      SUB-DIAGONAL ELEMENT OF A IS 0.  COMPUTE COLUMN K ONLY.
C
   20 CONTINUE
C
C     COPY ELEMENTS OF SOLUTION ALREADY KNOWN BY SYMMETRY
C
      DO 30 I = K+1,N
         R(I,K) = R(K,I)
   30 CONTINUE
C
C     COMPUTE ELEMENTS 1 THROUGH K OF COLUMN K OF SOLUTION
C
      I = K
   40 CONTINUE
         IF (I .GT. 1 ) THEN
           IF (S(I,I-1) .NE. 0.0D0) GO TO 80
         ENDIF
C
C           COMPUTE ELEMENT I ONLY
C
            V(1) = 0.0D0
            V(2) = 0.0D0
            DO 50 J = I+1,N
               V(1) = V(1) + S(I,J) * R(J,K)
               V(2) = V(2) + T(I,J) * R(J,K)
   50       CONTINUE
            DO 60 J = I,K
               R(I,J) = R(I,J) + T(J,K)*V(1) + S(J,K)*V(2)
   60       CONTINUE
            A(1,1) = T(K,K)*S(I,I) + S(K,K)*T(I,I)
            R(I,K) = -R(I,K) / A(1,1)
            IF (DOSEP) THEN
               R(I,K) = R(I,K) + SIGN(1.0D0/A(1,1), R(I,K))
            ENDIF
C
            V(1) = S(I,I) * R(I,K)
            V(2) = T(I,I) * R(I,K)
            DO 70 J = I,K-1
               R(I,J) = R(I,J) + T(J,K)*V(1) + S(J,K)*V(2)
   70       CONTINUE
C
         I = I-1
         GO TO 120
C
C           COMPUTE ELEMENTS I AND I-1
C
   80    CONTINUE
            V(1) = 0.0D0
            V(2) = 0.0D0
            V(3) = 0.0D0
            V(4) = 0.0D0
            DO 90 J = I+1,N
               V(1) = V(1) + S(I,J) * R(J,K)
               V(2) = V(2) + T(I,J) * R(J,K)
               V(3) = V(3) + S(I-1,J) * R(J,K)
               V(4) = V(4) + T(I-1,J) * R(J,K)
   90       CONTINUE
            DO 100 J = I,K
               R(I,J) = R(I,J) + T(J,K) * V(1) + S(J,K) * V(2)
               R(I-1,J) = R(I-1,J) + T(J,K) * V(3) + S(J,K) * V(4)
  100       CONTINUE
            R(I-1,I-1) = R(I-1,I-1) + T(I-1,K)*V(3) + S(I-1,K)*V(4)
            A(1,1) = T(K,K)*S(I,I) + S(K,K)*T(I,I)
            A(1,2) = T(K,K)*S(I,I-1)
            A(2,1) = T(K,K)*S(I-1,I) + S(K,K)*T(I-1,I)
            A(2,2) = T(K,K)*S(I-1,I-1) + S(K,K)*T(I-1,I-1)
            P(1) = R(I,K)
            P(2) = R(I-1,K)
            NSYS = 2
            CALL DGECO (A, NA, NSYS, IPVT, RCOND, E)
            IF ((1.0D0+RCOND) .EQ. 1.0) THEN
               IERR = I
               RETURN
            ENDIF
            CALL DGESL (A, NA, NSYS, IPVT, P, 0)
            R(I,K) = -P(1)
            R(I-1,K) = -P(2)
            IF (DOSEP) THEN
               TMP = R(I,K)*E(1) + R(I-1,K)*E(2)
               TMP = SIGN(1.0D0, TMP)
               R(I,K) = R(I,K) + TMP*E(1)
               R(I-1,K) = R(I-1,K) + TMP*E(2)
            ENDIF
C
            V(1) = S(I,I) * R(I,K) + S(I,I-1) * R(I-1,K)
            V(2) = T(I,I) * R(I,K) + T(I,I-1) * R(I-1,K)
            V(3) = S(I-1,I) * R(I,K) + S(I-1,I-1) * R(I-1,K)
            V(4) = T(I-1,I) * R(I,K) + T(I-1,I-1) * R(I-1,K)
            DO 110 J = I,K-1
               R(I,J) = R(I,J) + T(J,K) * V(1) + S(J,K) * V(2)
               R(I-1,J) = R(I-1,J) + T(J,K) * V(3) + S(J,K) * V(4)
  110       CONTINUE
            R(I-1,I-1) = R(I-1,I-1) + T(I-1,K)*V(3) + S(I-1,K)*V(4)
C
         I = I - 2
C
  120    CONTINUE
         IF (I .GT. 0) GO TO 40
         K = K - 1
         GO TO 10
C
C     ------------------------------------------------------------------
C
C     SUB-DIAGONAL ELEMENT OF A IS NOT 0.  COMPUTE COLUMNS K AND K-1.
C
  130 CONTINUE
C
C     COPY ELEMENTS OF SOLUTION ALREADY KNOWN BY SYMMETRY
C
      DO 140 I = K+1,N
         R(I,K) = R(K,I)
         R(I,K-1) = R(K-1,I)
  140 CONTINUE
C
C     COMPUTE ELEMENTS 1 THROUGH K OF COLUMNS K AND K-1 OF SOLUTION
C
      I = K
  150 CONTINUE
         IF (I .GT. 1) THEN
           IF( S(I,I-1) .NE. 0.0D0) GO TO 190
         ENDIF
C
C           COMPUTE ELEMENT I ONLY (FOR BOTH COLUMNS)
C
            V(1) = 0.0D0
            V(2) = 0.0D0
            V(3) = 0.0D0
            V(4) = 0.0D0
            DO 160 J = I+1,N
               V(1) = V(1) + S(I,J) * R(J,K)
               V(2) = V(2) + T(I,J) * R(J,K)
               V(3) = V(3) + S(I,J) * R(J,K-1)
               V(4) = V(4) + T(I,J) * R(J,K-1)
  160       CONTINUE
            DO 170 J = I,K-1
               R(I,J) = R(I,J) + T(J,K)*V(1) + S(J,K)*V(2)
     *                         + T(J,K-1)*V(3) + S(J,K-1)*V(4)
  170       CONTINUE
            R(I,K) = R(I,K) + T(K,K)*V(1) + S(K,K)*V(2) + S(K,K-1)*V(4)
            A(1,1) = T(K,K)*S(I,I) + S(K,K)*T(I,I)
            A(1,2) = S(K,K-1)*T(I,I)
            A(2,1) = T(K-1,K)*S(I,I) + S(K-1,K)*T(I,I)
            A(2,2) = T(K-1,K-1)*S(I,I) + S(K-1,K-1)*T(I,I)
            P(1) = R(I,K)
            P(2) = R(I,K-1)
            NSYS = 2
            CALL DGECO (A, NA, NSYS, IPVT, RCOND, E)
            IF ((1.0D0+RCOND) .EQ. 1.0D0) THEN
               IERR = I
               RETURN
            ENDIF
            CALL DGESL (A, NA, NSYS, IPVT, P, 0)
            R(I,K) = -P(1)
            R(I,K-1) = -P(2)
            IF (DOSEP) THEN
               TMP = R(I,K)*E(1) + R(I,K-1)*E(2)
               TMP = SIGN(1.0D0, TMP)
               R(I,K) = R(I,K) + TMP*E(1)
               R(I,K-1) = R(I,K-1) + TMP*E(2)
            ENDIF
C
            V(1) = S(I,I) * R(I,K)
            V(2) = T(I,I) * R(I,K)
            V(3) = S(I,I) * R(I,K-1)
            V(4) = T(I,I) * R(I,K-1)
            DO 180 J = I,K-2
               R(I,J) = R(I,J) + T(J,K)*V(1) + S(J,K)*V(2)
     *                         + T(J,K-1)*V(3) + S(J,K-1)*V(4)
  180       CONTINUE
C
         I = I - 1
         GO TO 230
C
  190    CONTINUE
C
C           COMPUTE ELEMENTS I AND I-1 (FOR BOTH COLUMNS)
C
         V(1) = 0.0D0
         V(2) = 0.0D0
         V(3) = 0.0D0
         V(4) = 0.0D0
         V(5) = 0.0D0
         V(6) = 0.0D0
         V(7) = 0.0D0
         V(8) = 0.0D0
         DO 200 J = I+1,N
            V(1) = V(1) + S(I,J) * R(J,K)
            V(2) = V(2) + T(I,J) * R(J,K)
            V(3) = V(3) + S(I,J) * R(J,K-1)
            V(4) = V(4) + T(I,J) * R(J,K-1)
            V(5) = V(5) + S(I-1,J) * R(J,K)
            V(6) = V(6) + T(I-1,J) * R(J,K)
            V(7) = V(7) + S(I-1,J) * R(J,K-1)
            V(8) = V(8) + T(I-1,J) * R(J,K-1)
  200    CONTINUE
         R(I,K) = R(I,K) + T(K,K)*V(1) + S(K,K)*V(2)
     *                       + S(K,K-1)*V(4)
         R(I-1,K) = R(I-1,K) + T(K,K)*V(5) + S(K,K)*V(6)
     *                       + S(K,K-1)*V(8)
         DO 210 J = I,K-1
            R(I,J) = R(I,J) + T(J,K)*V(1) + S(J,K)*V(2)
     *                      + T(J,K-1)*V(3) + S(J,K-1)*V(4)
            R(I-1,J) = R(I-1,J) + T(J,K)*V(5) + S(J,K)*V(6)
     *                          + T(J,K-1)*V(7) + S(J,K-1)*V(8)
  210    CONTINUE
         R(I-1,I-1) = R(I-1,I-1) + T(I-1,K)*V(5) + S(I-1,K)*V(6)
     *                           + T(I-1,K-1)*V(7) + S(I-1,K-1)*V(8)
         IF (I .NE. K) THEN
            A(1,1) = T(K,K)*S(I,I) + S(K,K)*T(I,I)
            A(1,2) = T(K,K)*S(I,I-1)
            A(1,3) = S(K,K-1)*T(I,I)
            A(1,4) = 0.0D0
            A(2,1) = T(K,K)*S(I-1,I) + S(K,K)*T(I-1,I)
            A(2,2) = T(K,K)*S(I-1,I-1) + S(K,K)*T(I-1,I-1)
            A(2,3) = S(K,K-1)*T(I-1,I)
            A(2,4) = S(K,K-1)*T(I-1,I-1)
            A(3,1) = T(K-1,K)*S(I,I) + S(K-1,K)*T(I,I)
            A(3,2) = T(K-1,K)*S(I,I-1)
            A(3,3) = T(K-1,K-1)*S(I,I) + S(K-1,K-1)*T(I,I)
            A(3,4) = T(K-1,K-1)*S(I,I-1)
            A(4,1) = T(K-1,K)*S(I-1,I) + S(K-1,K)*T(I-1,I)
            A(4,2) = T(K-1,K)*S(I-1,I-1) + S(K-1,K)*T(I-1,I-1)
            A(4,3) = T(K-1,K-1)*S(I-1,I) + S(K-1,K-1)*T(I-1,I)
            A(4,4) = T(K-1,K-1)*S(I-1,I-1) + S(K-1,K-1)*T(I-1,I-1)
            P(1) = R(I,K)
            P(2) = R(I-1,K)
            P(3) = R(I,K-1)
            P(4) = R(I-1,K-1)
            NSYS = 4
            CALL DGECO (A, NA, NSYS, IPVT, RCOND, E)
            IF ((1.0D0+RCOND) .EQ. 1.0D0) THEN
               IERR = I
               RETURN
            ENDIF
            CALL DGESL (A, NA, NSYS, IPVT, P, 0)
            R(I,K) = -P(1)
            R(I-1,K) = -P(2)
            R(I,K-1) = -P(3)
            R(I-1,K-1) = -P(4)
            IF (DOSEP) THEN
               TMP = R(I,K)*E(1) + R(I-1,K)*E(2)
     *             + R(I,K-1)*E(3) + R(I-1,K-1)*E(4)
               TMP = SIGN(1.0D0, TMP)
               R(I,K) = R(I,K) + TMP*E(1)
               R(I-1,K) = R(I-1,K) + TMP*E(2)
               R(I,K-1) = R(I,K-1) + TMP*E(3)
               R(I-1,K-1) = R(I-1,K-1) + TMP*E(4)
            ENDIF
C
         ELSE
            A(1,1) = 2.0D0 * T(K,K)*S(K,K)
            A(1,2) = 2.0D0 * T(K,K)*S(K,K-1)
            A(1,3) = 0.0D0
            A(2,1) = T(K,K)*S(K-1,K) + S(K,K)*T(K-1,K)
            A(2,2) = T(K,K)*S(K-1,K-1) + S(K,K)*T(K-1,K-1)
     *                  + S(K,K-1)*T(K-1,K)
            A(2,3) = S(K,K-1)*T(K-1,K-1)
            A(3,1) = 2.0D0 * T(K-1,K)*S(K-1,K)
            A(3,2) = 2.0D0 * (T(K-1,K)*S(K-1,K-1) + S(K-1,K)*T(K-1,K-1))
            A(3,3) = 2.0D0 * T(K-1,K-1)*S(K-1,K-1)
            P(1) = R(K,K)
            P(2) = R(K-1,K)
            P(3) = R(K-1,K-1)
            NSYS = 3
            CALL DGECO (A, NA, NSYS, IPVT, RCOND, E)
            IF ((1.0D0+RCOND) .EQ. 1.0D0) THEN
               IERR = I
               RETURN
            ENDIF
            CALL DGESL (A, NA, NSYS, IPVT, P, 0)
            R(K,K) = -P(1)
            R(K,K-1) = -P(2)
            R(K-1,K) = -P(2)
            R(K-1,K-1) = -P(3)
            IF (DOSEP) THEN
               TMP = R(K,K)*E(1) + R(K,K-1)*E(2)
     *             + R(K-1,K)*E(2) + R(K-1,K-1)*E(3)
               TMP = SIGN(1.0D0, TMP)
               R(K,K) = R(K,K) + TMP*E(1)
               R(K,K-1) = R(K,K-1) + TMP*E(2)
               R(K-1,K) = R(K-1,K) + TMP*E(2)
               R(K-1,K-1) = R(K-1,K-1) + TMP*E(3)
            ENDIF
C
         ENDIF
C
         V(1) = S(I,I) * R(I,K) + S(I,I-1) * R(I-1,K)
         V(2) = T(I,I) * R(I,K) + T(I,I-1) * R(I-1,K)
         V(3) = S(I,I) * R(I,K-1) + S(I,I-1) * R(I-1,K-1)
         V(4) = T(I,I) * R(I,K-1) + T(I,I-1) * R(I-1,K-1)
         V(5) = S(I-1,I) * R(I,K) + S(I-1,I-1) * R(I-1,K)
         V(6) = T(I-1,I) * R(I,K) + T(I-1,I-1) * R(I-1,K)
         V(7) = S(I-1,I) * R(I,K-1) + S(I-1,I-1) * R(I-1,K-1)
         V(8) = T(I-1,I) * R(I,K-1) + T(I-1,I-1) * R(I-1,K-1)
         DO 220 J = I,K-2
            R(I,J) = R(I,J) + T(J,K)*V(1) + S(J,K)*V(2)
     *                      + T(J,K-1)*V(3) + S(J,K-1)*V(4)
            R(I-1,J) = R(I-1,J) + T(J,K)*V(5) + S(J,K)*V(6)
     *                          + T(J,K-1)*V(7) + S(J,K-1)*V(8)
  220    CONTINUE
         IF (I .NE. K) THEN
            R(I-1,I-1) = R(I-1,I-1) + T(I-1,K)*V(5) + S(I-1,K)*V(6)
     *                              + T(I-1,K-1)*V(7) + S(I-1,K-1)*V(8)
         ENDIF
C
      I = I - 2
C
  230 CONTINUE
      IF (I .GT. 0) GO TO 150
      K = K - 2
      GO TO 10
C
C --- LAST LINE OF BKCON ---
      END
      SUBROUTINE BKDIS(NST, NR, N, S, T, R, JOB, IERR)
C
      INTEGER NST, NR, N, JOB, IERR
      DOUBLE PRECISION S(NST,N), T(NST,N), R(NR,N)
C
C     SOLVES THE DISCRETE-TIME SYLVESTER SQUARE MATRIX EQUATION
C
C          S*X*S' - T*X*T' + R = 0      (' DENOTES TRANSPOSE)
C
C     WHERE  S  IS QUASI-UPPER-TRIANGULAR,  T  IS UPPER-TRIANGULAR,  Q
C     IS SYMMETRIC, AND  X  IS THE SYMMETRIC MATRIX TO BE COMPUTED.
C     BKDIS  IS CALLED BY  SYLGD  WHICH IS USED TO SOLVE THE EQUATION
C     FOR GENERAL  S  AND  T.  BKDIS IS ALSO CALLED BY SEPGD, WHICH IS
C     USED FOR CONDITION ESTIMATION.
C
C     ------------------------------------------------------------------
C     ON INPUT -
C       NST     INTEGER
C               ROW DIMENSION OF  S  AND  T  AS DECLARED IN THE MAIN
C               CALLING PROGRAM
C
C       NR      INTEGER
C               ROW DIMENSION OF  R  AS DECLARED IN THE MAIN CALLING
C               PROGRAM
C
C       N       INTEGER
C               THE ORDER OF THE PROBLEM
C
C       S       DOUBLE PRECISION (NST,N)
C               N BY N QUASI-UPPER-TRIANGULAR MATRIX.  ELEMENTS BELOW
C               THE FIRST SUBDIAGONAL ARE NOT REFERENCED.
C
C       T       DOUBLE PRECISION (NST,N)
C               N BY N UPPER-TRIANGULAR MATRIX.  ELEMENTS BELOW THE
C               DIAGONAL ARE NOT REFERENCED.
C
C       R       DOUBLE PRECISION (NR,N)
C               N BY N SYMMETRIC MATRIX.  MUST BE ZERO IF JOB = 1
C
C       JOB     INTEGER
C               JOB = 0 INDICATES THE GIVEN EQUATION SHOULD BE SOLVED
C               JOB = 1 USED BY SEPGD.  Y WILL BE FOUND SUCH THAT
C                       1-NORM(S*Y*T'+T*Y*S')/1-NORM(Y) IS MINIMIZED.
C                       FOR THIS CASE R MUST BE ZERO ON INPUT.
C
C     ON RETURN -
C       R       DOUBLE PRECISION (NR,N)
C               N BY N SYMMETRIC SOLUTION MATRIX
C
C       IERR    INTEGER
C               ERROR IF NOT EQUAL TO ZERO
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       (LINPACK) DGECO DGESL
C
C     WRITTEN -
C       J. GARDINER, JUNE 1985.
C     REVISED -
C       05MAR87 M.WETTE (ADDED JOB PARAMETER AND MODIFIED FOR SEPGD)
C       26JAN89 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     ------------------------------------------------------------------
C
      INTEGER NSYS, NA, IPVT(4), I, J, K
      DOUBLE PRECISION V(8), P(4), A(4,4), E(4), TMP, RCOND
      LOGICAL DOSEP
C
      IERR = 0
      NA = 4
      DOSEP = (MOD(JOB,10) .EQ. 1)
C
C     MAIN LOOP FOR BACK SUBSTITUTION -- COMPUTE SOLUTION BY COLUMNS
C
      K = N
   10 CONTINUE
      IF (K .EQ. 0) RETURN
      IF (K .EQ. 1) GO TO 20
      IF (S(K,K-1) .NE. 0.0D0) GO TO 130
C
C     ------------------------------------------------------------------
C
C     SUB-DIAGONAL ELEMENT OF A IS 0.  COMPUTE COLUMN K ONLY.
C
   20 CONTINUE
C
C     COPY ELEMENTS OF SOLUTION ALREADY KNOWN BY SYMMETRY
C
      DO 30 I = K+1,N
         R(I,K) = R(K,I)
   30 CONTINUE
C
C     COMPUTE ELEMENTS 1 THROUGH K OF COLUMN K OF SOLUTION
C
      I = K
   40 CONTINUE
         IF (I .GT. 1) THEN
           IF(S(I,I-1) .NE. 0.0D0) GO TO 80
         ENDIF
C
C           COMPUTE ELEMENT I ONLY
C
            V(1) = 0.0D0
            V(2) = 0.0D0
            DO 50 J = I+1,N
               V(1) = V(1) + S(I,J) * R(J,K)
               V(2) = V(2) + T(I,J) * R(J,K)
   50       CONTINUE
            DO 60 J=I,K
               R(I,J) = R(I,J) - T(J,K)*V(2) + S(J,K)*V(1)
   60       CONTINUE
            A(1,1) = -S(K,K)*S(I,I) + T(K,K)*T(I,I)
            R(I,K) = R(I,K) / A(1,1)
            IF (DOSEP) THEN
               R(I,K) = R(I,K) + SIGN(1.0D0/A(1,1), R(I,K))
            ENDIF
C
            V(1) = S(I,I) * R(I,K)
            V(2) = T(I,I) * R(I,K)
            DO 70 J = I,K-1
               R(I,J) = R(I,J) - T(J,K)*V(2) + S(J,K)*V(1)
   70       CONTINUE
C
         I = I-1
         GO TO 120
C
C           COMPUTE ELEMENTS I AND I-1
C
   80    CONTINUE
            V(1) = 0.0D0
            V(2) = 0.0D0
            V(3) = 0.0D0
            V(4) = 0.0D0
            DO 90 J = I+1,N
               V(1) = V(1) + S(I,J) * R(J,K)
               V(2) = V(2) + T(I,J) * R(J,K)
               V(3) = V(3) + S(I-1,J) * R(J,K)
               V(4) = V(4) + T(I-1,J) * R(J,K)
   90       CONTINUE
            DO 100 J=I,K
               R(I,J) = R(I,J) - T(J,K) * V(2) + S(J,K) * V(1)
               R(I-1,J) = R(I-1,J) - T(J,K) * V(4) + S(J,K) * V(3)
  100       CONTINUE
            R(I-1,I-1) = R(I-1,I-1) - T(I-1,K)*V(4) + S(I-1,K)*V(3)
            A(1,1) = -S(K,K)*S(I,I) + T(K,K)*T(I,I)
            A(1,2) = -S(K,K)*S(I,I-1)
            A(2,1) = -S(K,K)*S(I-1,I) + T(K,K)*T(I-1,I)
            A(2,2) = -S(K,K)*S(I-1,I-1) + T(K,K)*T(I-1,I-1)
            P(1) = R(I,K)
            P(2) = R(I-1,K)
            NSYS = 2
            CALL DGECO(A, NA, NSYS, IPVT, RCOND, E)
            IF ((1.0D0+RCOND) .EQ. 1.0D0) THEN
               IERR = I
               RETURN
            ENDIF
            CALL DGESL (A, NA, NSYS, IPVT, P, 0)
            R(I,K) = P(1)
            R(I-1,K) = P(2)
            IF (DOSEP) THEN
               TMP = R(I,K)*E(1) + R(I-1,K)*E(2)
               TMP = SIGN(1.0D0, TMP)
               R(I,K) = R(I,K) + TMP*E(1)
               R(I-1,K) = R(I-1,K) + TMP*E(2)
            ENDIF
C
            V(1) = S(I,I) * R(I,K) + S(I,I-1) * R(I-1,K)
            V(2) = T(I,I) * R(I,K)
            V(3) = S(I-1,I) * R(I,K) + S(I-1,I-1) * R(I-1,K)
            V(4) = T(I-1,I) * R(I,K) + T(I-1,I-1) * R(I-1,K)
            DO 110 J = I,K-1
               R(I,J) = R(I,J) - T(J,K) * V(2) + S(J,K) * V(1)
               R(I-1,J) = R(I-1,J) - T(J,K) * V(4) + S(J,K) * V(3)
  110       CONTINUE
            R(I-1,I-1) = R(I-1,I-1) - T(I-1,K)*V(4) + S(I-1,K)*V(3)
C
         I = I - 2
C
  120    CONTINUE
         IF (I .GT. 0) GO TO 40
         K = K - 1
         GO TO 10
C
C     ------------------------------------------------------------------
C
C     SUB-DIAGONAL ELEMENT OF A IS NOT 0.  COMPUTE COLUMNS K AND K-1.
C
  130 CONTINUE
C
C     COPY ELEMENTS OF SOLUTION ALREADY KNOWN BY SYMMETRY
C
      DO 140 I = K+1,N
         R(I,K) = R(K,I)
         R(I,K-1) = R(K-1,I)
  140 CONTINUE
C
C     COMPUTE ELEMENTS 1 THROUGH K OF COLUMNS K AND K-1 OF SOLUTION
C
      I = K
  150 CONTINUE
         IF (I .GT. 1) THEN
           IF(S(I,I-1) .NE. 0.0D0) GO TO 190
         ENDIF
C
C           COMPUTE ELEMENT I ONLY (FOR BOTH COLUMNS)
C
            V(1) = 0.0D0
            V(2) = 0.0D0
            V(3) = 0.0D0
            V(4) = 0.0D0
            DO 160 J = I+1,N
               V(1) = V(1) + S(I,J) * R(J,K)
               V(2) = V(2) + T(I,J) * R(J,K)
               V(3) = V(3) + S(I,J) * R(J,K-1)
               V(4) = V(4) + T(I,J) * R(J,K-1)
  160       CONTINUE
            DO 170 J=I,K-1
               R(I,J) = R(I,J) - T(J,K)*V(2) + S(J,K)*V(1)
     *                         - T(J,K-1)*V(4) + S(J,K-1)*V(3)
  170       CONTINUE
            R(I,K) = R(I,K) - T(K,K)*V(2) + S(K,K)*V(1) + S(K,K-1)*V(3)
            A(1,1) = -S(K,K)*S(I,I) + T(K,K)*T(I,I)
            A(1,2) = -S(K,K-1)*S(I,I)
            A(2,1) = -S(K-1,K)*S(I,I) + T(K-1,K)*T(I,I)
            A(2,2) = -S(K-1,K-1)*S(I,I) + T(K-1,K-1)*T(I,I)
            P(1) = R(I,K)
            P(2) = R(I,K-1)
            NSYS = 2
            CALL DGECO(A, NA, NSYS, IPVT, RCOND, E)
            IF ((1.0D0+RCOND) .EQ. 1.0D0) THEN
               IERR = I
               RETURN
            ENDIF
            CALL DGESL (A, NA, NSYS, IPVT, P, 0)
            R(I,K) = P(1)
            R(I,K-1) = P(2)
            IF (DOSEP) THEN
               TMP = R(I,K)*E(1) + R(I,K-1)*E(2)
               TMP = SIGN(1.0D0, TMP)
               R(I,K) = R(I,K) + TMP*E(1)
               R(I,K-1) = R(I,K-1) + TMP*E(2)
            ENDIF
C
            V(1) = S(I,I) * R(I,K)
            V(2) = T(I,I) * R(I,K)
            V(3) = S(I,I) * R(I,K-1)
            V(4) = T(I,I) * R(I,K-1)
            DO 180 J = I,K-2
               R(I,J) = R(I,J) - T(J,K)*V(2) + S(J,K)*V(1)
     *                         - T(J,K-1)*V(4) + S(J,K-1)*V(3)
  180       CONTINUE
C
         I = I - 1
         GO TO 230
C
  190    CONTINUE
C
C           COMPUTE ELEMENTS I AND I-1 (FOR BOTH COLUMNS)
C
         V(1) = 0.0D0
         V(2) = 0.0D0
         V(3) = 0.0D0
         V(4) = 0.0D0
         V(5) = 0.0D0
         V(6) = 0.0D0
         V(7) = 0.0D0
         V(8) = 0.0D0
         DO 200 J = I+1,N
            V(1) = V(1) + S(I,J) * R(J,K)
            V(2) = V(2) + T(I,J) * R(J,K)
            V(3) = V(3) + S(I,J) * R(J,K-1)
            V(4) = V(4) + T(I,J) * R(J,K-1)
            V(5) = V(5) + S(I-1,J) * R(J,K)
            V(6) = V(6) + T(I-1,J) * R(J,K)
            V(7) = V(7) + S(I-1,J) * R(J,K-1)
            V(8) = V(8) + T(I-1,J) * R(J,K-1)
  200    CONTINUE
         R(I,K) = R(I,K) - T(K,K)*V(2) + S(K,K)*V(1)
     *                       + S(K,K-1)*V(3)
         R(I-1,K) = R(I-1,K) - T(K,K)*V(6) + S(K,K)*V(5)
     *                       + S(K,K-1)*V(7)
         DO 210 J = I,K-1
            R(I,J) = R(I,J) - T(J,K)*V(2) + S(J,K)*V(1)
     *                      - T(J,K-1)*V(4) + S(J,K-1)*V(3)
            R(I-1,J) = R(I-1,J) - T(J,K)*V(6) + S(J,K)*V(5)
     *                          - T(J,K-1)*V(8) + S(J,K-1)*V(7)
  210    CONTINUE
         R(I-1,I-1) = R(I-1,I-1) - T(I-1,K)*V(6) + S(I-1,K)*V(5)
     *                           - T(I-1,K-1)*V(8) + S(I-1,K-1)*V(7)
         IF (I .NE. K) THEN
            A(1,1) = -S(K,K)*S(I,I) + T(K,K)*T(I,I)
            A(1,2) = -S(K,K)*S(I,I-1)
            A(1,3) = -S(K,K-1)*S(I,I)
            A(1,4) = -S(K,K-1)*S(I,I-1)
            A(2,1) = -S(K,K)*S(I-1,I) + T(K,K)*T(I-1,I)
            A(2,2) = -S(K,K)*S(I-1,I-1) + T(K,K)*T(I-1,I-1)
            A(2,3) = -S(K,K-1)*S(I-1,I)
            A(2,4) = -S(K,K-1)*S(I-1,I-1)
            A(3,1) = -S(K-1,K)*S(I,I) + T(K-1,K)*T(I,I)
            A(3,2) = -S(K-1,K)*S(I,I-1)
            A(3,3) = -S(K-1,K-1)*S(I,I) + T(K-1,K-1)*T(I,I)
            A(3,4) = -S(K-1,K-1)*S(I,I-1)
            A(4,1) = -S(K-1,K)*S(I-1,I) + T(K-1,K)*T(I-1,I)
            A(4,2) = -S(K-1,K)*S(I-1,I-1) + T(K-1,K)*T(I-1,I-1)
            A(4,3) = -S(K-1,K-1)*S(I-1,I) + T(K-1,K-1)*T(I-1,I)
            A(4,4) = -S(K-1,K-1)*S(I-1,I-1) + T(K-1,K-1)*T(I-1,I-1)
            P(1) = R(I,K)
            P(2) = R(I-1,K)
            P(3) = R(I,K-1)
            P(4) = R(I-1,K-1)
            NSYS = 4
            CALL DGECO(A, NA, NSYS, IPVT, RCOND, E)
            IF ((1.0D0+RCOND) .EQ. 1.0D0) THEN
               IERR = I
               RETURN
            ENDIF
            CALL DGESL (A, NA, NSYS, IPVT, P, 0)
            R(I,K) = P(1)
            R(I-1,K) = P(2)
            R(I,K-1) = P(3)
            R(I-1,K-1) = P(4)
            IF (DOSEP) THEN
               TMP = R(I,K)*E(1) + R(I-1,K)*E(2)
     *             + R(I,K-1)*E(3) + R(I-1,K-1)*E(4)
               TMP = SIGN(1.0D0, TMP)
               R(I,K) = R(I,K) + TMP*E(1)
               R(I-1,K) = R(I-1,K) + TMP*E(2)
               R(I,K-1) = R(I,K-1) + TMP*E(3)
               R(I-1,K-1) = R(I-1,K-1) + TMP*E(4)
            ENDIF
C
         ELSE
            A(1,1) = -S(K,K)*S(K,K) + T(K,K)*T(K,K)
            A(1,2) = -2.0D0 * S(K,K)*S(K,K-1)
            A(1,3) = -S(K,K-1)*S(K,K-1)
            A(2,1) = -S(K,K)*S(K-1,K) + T(K,K)*T(K-1,K)
            A(2,2) = -S(K,K)*S(K-1,K-1) + T(K,K)*T(K-1,K-1)
     *                  - S(K,K-1)*S(K-1,K)
            A(2,3) = -S(K,K-1)*S(K-1,K-1)
            A(3,1) = -S(K-1,K)*S(K-1,K) + T(K-1,K)*T(K-1,K)
            A(3,2) = 2.0D0 * (-S(K-1,K)*S(K-1,K-1) +
     *                         T(K-1,K)*T(K-1,K-1))
            A(3,3) = -S(K-1,K-1)*S(K-1,K-1) + T(K-1,K-1)*T(K-1,K-1)
            P(1) = R(K,K)
            P(2) = R(K-1,K)
            P(3) = R(K-1,K-1)
            NSYS = 3
            CALL DGECO(A, NA, NSYS, IPVT, RCOND, E)
            IF ((1.0D0+RCOND) .EQ. 1.0D0) THEN
               IERR = I
               RETURN
            ENDIF
            CALL DGESL (A, NA, NSYS, IPVT, P, 0)
            R(K,K) = P(1)
            R(K,K-1) = P(2)
            R(K-1,K) = P(2)
            R(K-1,K-1) = P(3)
            IF (DOSEP) THEN
               TMP = R(K,K)*E(1) + R(I,K-1)*E(2)
     *             + R(K-1,K)*E(2) +R(K-1,K-1)*E(3)
               TMP = SIGN(1.0D0, TMP)
               R(K,K) = R(K,K) + TMP*E(1)
               R(K,K-1) = R(K,K-1) + TMP*E(2)
               R(K-1,K) = R(K-1,K) + TMP*E(2)
               R(K-1,K-1) = R(K-1,K-1) + TMP*E(3)
            ENDIF
         ENDIF
C
         V(1) = S(I,I) * R(I,K) + S(I,I-1) * R(I-1,K)
         V(2) = T(I,I) * R(I,K)
         V(3) = S(I,I) * R(I,K-1) + S(I,I-1) * R(I-1,K-1)
         V(4) = T(I,I) * R(I,K-1)
         V(5) = S(I-1,I) * R(I,K) + S(I-1,I-1) * R(I-1,K)
         V(6) = T(I-1,I) * R(I,K) + T(I-1,I-1) * R(I-1,K)
         V(7) = S(I-1,I) * R(I,K-1) + S(I-1,I-1) * R(I-1,K-1)
         V(8) = T(I-1,I) * R(I,K-1) + T(I-1,I-1) * R(I-1,K-1)
         DO 220 J = I,K-2
            R(I,J) = R(I,J) - T(J,K)*V(2) + S(J,K)*V(1)
     *                      - T(J,K-1)*V(4) + S(J,K-1)*V(3)
            R(I-1,J) = R(I-1,J) - T(J,K)*V(6) + S(J,K)*V(5)
     *                          - T(J,K-1)*V(8) + S(J,K-1)*V(7)
  220    CONTINUE
         IF (I .NE. K) THEN
            R(I-1,I-1) = R(I-1,I-1) - T(I-1,K)*V(6) + S(I-1,K)*V(5)
     *                              - T(I-1,K-1)*V(8) + S(I-1,K-1)*V(7)
         ENDIF
C
      I = I - 2
C
  230 CONTINUE
      IF (I .GT. 0) GO TO 150
      K = K - 2
      GO TO 10
C
C --- LAST LINE OF BKDIS ---
      END
      SUBROUTINE BKHS2(NPS,NRT,NF,M,N,P,R,S,T,F,WKV,IWKV,JOB,IERR)
C
      INTEGER NPS,NRT,NF,N,M,IWKV(2*M),JOB,IERR
      DOUBLE PRECISION P(NPS,M),R(NRT,N),S(NPS,M),T(NRT,N)
      DOUBLE PRECISION F(NF,N),WKV(2*M*M + 7*M)
C
C     THIS ROUTINE SOLVES THE LINEAR SYSTEM
C
C                         T              T
C                P * Y * R   +  S * Y * T   =  F
C
C     WHERE P,R,S AND T HAVE THE STRUCTURE  INDICATED BELOW AND Y IS THE
C     UNKNOWN.  THIS ROUTINE  MAY ALSO BE  USED TO COMPUTE A Y SUCH THAT
C     L1-NORM(F)/L1-NORM(Y) IS CLOSE TO THE MINIMUM (FOR ESTIMATING
C     CONDITION NUMBER).  NOTE THAT IT CANNOT PERFORM BOTH FUNCTIONS AT
C     THE SAME TIME.
C
C     BKHS2 IS MEANT TO BE CALLED BY SYLG OR SEPG, EITHER OF WHICH FIRST
C     TRANSFORMS THE COEFFICIENT MATRICES TO THE REQUIRED FORM.
C
C     ON ENTRY -
C       NPS     INTEGER
C               LEADING DIMENSION IN CALLING PROGRAM'S DECLARATION OF P
C               AND S
C
C       NRT     INTEGER
C               LEADING DIMENSION IN CALLING PROGRAM'S DECLARATION OF R
C               AND T
C
C       NF      INTEGER
C               LEADING DIMENSION IN CALLING PROGRAM'S DECLARATION OF F
C
C       M,N     INTEGER
C               ACTUAL DIMENSIONS AS INDICATED BELOW
C
C       P       DOUBLE PRECISION(NPS,M)
C               M BY M UPPER-HESSENBERG MATRIX
C
C       R       DOUBLE PRECISION(NRT,N)
C               N BY N UPPER-TRIANGULAR MATRIX
C
C       S       DOUBLE PRECISION(NPS,M)
C               M BY M UPPER-TRIANGULAR MATRIX
C
C       T       DOUBLE PRECISION(NRT,N)
C               N BY N QUASI-UPPER-TRIANGULAR MATRIX
C
C       F       DOUBLE PRECISION(NF,N)
C               M BY N DATA MATRIX
C
C       JOB     INTEGER
C               DECIMAL INTEGER IN THE FORM  ABCDE  WHICH INDICATES THE
C               FOLLOWING
C                  A,B,C,D   (CURRENTLY NOT USED, SHOULD BE SET TO 0)
C                  E .EQ. 0  SOLVE THE EQUATION FOR Y
C                  E .GT. 0  COMPUTE Y SUCH THAT L1-NORM(F)/L1-NORM(Y)
C                            IS APPROXIMATELY MINIMIZED.  IN THIS CASE F
C                            MUST BE EQUAL TO THE ZERO MATRIX ON ENTRY.
C
C     ON RETURN -
C       F       DOUBLE PRECISION(NF,N)
C               M X N SOLUTION MATRIX
C
C       IERR    INTEGER
C               0  == NORMAL RETURN
C               >0 == EQUATION SINGULAR, SOLUTION UNDEFINED
C
C     WORKSPACE -
C       WKV     DOUBLE PRECISION(2*M*M + 7*M)
C               WORK VECTOR
C
C       IWKV    INTEGER(2*M)
C               WORK VECTOR OF PIVOT INDICES
C
C     NOTE -
C       ELEMENTS OF R AND S BELOW THE  DIAGONAL AND  ELEMENTS OF P AND T
C       BELOW  THE FIRST SUB-DIAGONAL ARE NOT  ACCESSED AND  MAY BE USED
C       FOR OTHER STORAGE.
C
C     WRITTEN -
C       J. AMATO, APRIL 1984.
C     REVISED -
C       J. GARDINER, JUNE 1985.
C       17FEB87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-4691
C       28NOV88 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     SUBROUTINES CALLED -
C       HSCO, HSSL - FACTOR AND SOLVE  ROUTINES FOR A HESSENBERG  MATRIX
C                    WITH POSSIBLY SOME EXTRA  SUBDIAGONALS, STORED IN A
C                    SINGLE DIMENSIONAL ARRAY
C
C       (LINPACK) DDOT
C
C     INTERNAL VARIABLES
C
      INTEGER I,J,K,II,IJ,JJ,OFFSET,SD
      DOUBLE PRECISION COND, TMP
      LOGICAL DOSEP
      DOUBLE PRECISION DDOT
C
C-----------------------------------------------------------------------
C
C                         T              T
C                P * Y * R   +  S * Y * T   =  F
C
C     LET THE K'TH COLUMN OF MATRIX A BE REPRESENTED BY A(:,K) .
C     THEN IF WE TAKE THE K'TH COLUMN OF EACH SIDE ABOVE WE GET
C
C          (R(K,K)*P + T(K,K)*S)*Y(:,K)  +  T(K,K-1)*S*Y(:,K-1)  =
C
C             F(:,K)  -  SUM   ((R(K,J)*P + T(K,J)*S)*Y(:,J))
C                      J=K+1,N
C
      DOSEP = (MOD(JOB,10) .GT. 0)
      IERR = 0
      OFFSET = 2*M*M + 5*M
C
      K = N
C
C     WHILE K .GT. 0 DO
C
   10 IF (K .EQ. 0) RETURN
      IF (K .EQ. 1) GO TO 20
      IF (T(K,K-1) .NE. 0.0D0) GO TO 100
C
C     CASE I.   OFF-DIAGONAL ELEMENT T(K,K-1) = 0 .
C
C     DO K'TH COLUMN ALONE.
C     M BY M UPPER HESSENBERG LINEAR SYSTEM.
C
C     (R(K,K)*P + T(K,K)*S)*Y(:,K) = F(:,K) -
C
C             SUM   ((R(K,J)*P + T(K,J)*S)*Y(:,J))
C           J=K+1,N
C
C     DEFINE  A = R(K,K)*P + T(K,K)*S .
C     IN ORDER TO TAKE ADVANTAGE OF STRUCTURE AND SAVE SPACE THE
C     TWO-DIMENSIONAL COEFFICIENT MATRIX A IS REPRESENTED AS A
C     ONE-DIMENSIONAL ARRAY W WHICH STORES SUCCESSIVELY THE NON-ZERO
C     ELEMENTS OF EACH COLUMN OF A.  THE J'TH COLUMN IS ALLOTTED
C     J+SD POSITIONS, WHERE SD IS THE NUMBER OF NON-ZERO SUBDIAGONALS.
C     A GIVEN ELEMENT A(I,J) OF THE MATRIX IS REPRESENTED AS
C     WKV(I + SD*(J-1) + (J*(J-1))/2) , PROVIDED I-J > SD .
C
C     UPPER HESSENBERG SYSTEM:  SD=1
C
   20 CONTINUE
C
C     FORM W
C
         IJ = 0
         DO 40 J=1,M
            DO 30 I=1,J
               IJ = IJ + 1
               WKV(IJ) = R(K,K)*P(I,J) + T(K,K)*S(I,J)
   30       CONTINUE
            IJ = IJ + 1
            IF (J .NE. M) WKV(IJ) = R(K,K)*P(J+1,J)
   40    CONTINUE
C
C     SOLVE FOR Y(:,K).  RETURN IF A IS SINGULAR.
C
         SD = 1
         IF (M .EQ. 1) SD = 0
         CALL HSCO(WKV,M,IWKV,COND,WKV(OFFSET+1),SD)
         COND = 1.0D0 + COND
         IF (COND .EQ. 1.0D0) THEN
            IERR = K
            RETURN
         ENDIF
         CALL HSSL(WKV,M,IWKV,F(1,K),SD)
         IF (DOSEP) THEN
            TMP = DDOT(M, WKV(OFFSET+1), 1, F(1,K), 1)
            TMP = SIGN(1.0D0, TMP)
            DO 50 I = 1,M
               F(I,K) = TMP*WKV(I+OFFSET) + F(I,K)
   50       CONTINUE
         ENDIF
C
C     FORM P*Y(:,K) AND S*Y(:,K)
C
         DO 70 J=1,M
            WKV(J) = 0.0D0
            IF (J .NE. 1) WKV(J) = P(J,J-1)*F(J-1,K)
            WKV(J+M) = 0.0D0
            DO 60 I=J,M
               WKV(J) = WKV(J) + P(J,I)*F(I,K)
               WKV(J+M) = WKV(J+M) + S(J,I)*F(I,K)
   60       CONTINUE
   70    CONTINUE
C
C     SUBTRACT WEIGHTED COMBINATION OF P*Y(:,K) AND S*Y(:,K)
C     FROM COLUMNS OF F
C
         DO 90 I=1,K-1
            DO 80 J=1,M
               F(J,I) = F(J,I) - R(I,K)*WKV(J) - T(I,K)*WKV(J+M)
   80       CONTINUE
   90    CONTINUE
C
         K = K - 1
C
C     GO BACK TO TOP OF LOOP
C
      GO TO 10
C
C     PROCESS CASE II
C
  100 CONTINUE
C
C     CASE II.   OFF-DIAGONAL ELEMENT T(K,K-1) <> 0 .
C
C     DO COLUMNS K AND K-1 SIMULTANEOUSLY.
C     2M BY 2M LINEAR SYSTEM.
C     THE COEFFICIENT MATRIX IS STRUCTURED SO THAT THE
C     SOUTHWEST QUADRANT IS UPPER TRIANGULAR AND THE
C     OTHER THREE QUADRANTS ARE UPPER HESSENBERG.
C
C        /                 \   /          \       /      \
C        | A(1,1)   A(1,2) |   | Y(:,K-1) |       | G(1) |
C        |                 |   |          |   =   |      |
C        | A(2,1)   A(2,2) |   | Y(:,K)   |       | G(2) |
C        \                 /   \          /       \      /
C
C     WHERE A AND G ARE DEFINED BY:
C
C     A(1,1)  =  R(K-1,K-1)*P + T(K-1,K-1)*S
C     A(1,2)  =  R(K-1,K)*P + T(K-1,K)*S
C     A(2,1)  =  T(K,K-1)*S
C     A(2,2)  =  R(K,K)*P + T(K,K)*S
C
C     G(1)  =  F(:,K-1) -  SUM  ((R(K-1,J)*P + T(K-1,J)*S)*Y(:,J))
C                        J=K+1,N
C
C     G(2)  =  F(:,K) -  SUM  ((R(K,J)*P + T(K,J)*S)*Y(:,J))
C                      J=K+1,N
C
C     WE FIRST DO BOTH A ROW AND A COLUMN SWAP SO THAT IN EACH
C     CASE THE NATURAL ORDER  1,2,...M,M+1,M+2,...2M  IS
C     REPLACED BY THE ORDER  1,M+1,2,M+2,3,M+3,...2M .  THIS
C     RESTRUCTURES THE COEFFICIENT MATRIX SO THAT ITS FORM IS
C     UPPER TRIANGULAR PLUS TWO NON-ZERO SUBDIAGONALS.
C     IF WE CALL THE RESTRUCTURED MATRIX AR, THEN CORRESPONDING
C     ELEMENTS ARE GIVEN BY
C        AR(II,JJ) = A(I,J)    WHERE II  =  2*I - 1  IF I < M
C                                        =  2*(I-M)  OTHERWISE
C     AND JJ IS SIMILARLY GIVEN IN TERMS OF J .
C
C     TO SAVE SPACE THE TWO-DIMENSIONAL MATRIX AR IS REPRESENTED
C     AS A ONE-DIMENSIONAL ARRAY WKV, USING THE SAME TRANSFORMATION
C     AS IN CASE I .
C
      SD = 2
      IF (M .EQ. 1) SD = 1
C
C     FORM W
C
         IJ = 0
         DO 120 J=1,M
            II = IJ + 1
            JJ = IJ + J + J + SD
            DO 110 I=1,J
               WKV(II) = R(K-1,K-1)*P(I,J) + T(K-1,K-1)*S(I,J)
               WKV(II+1) = T(K,K-1)*S(I,J)
               WKV(JJ) = R(K-1,K)*P(I,J) + T(K-1,K)*S(I,J)
               WKV(JJ+1) = R(K,K)*P(I,J) + T(K,K)*S(I,J)
               II = II + 2
               JJ = JJ + 2
  110       CONTINUE
            IF (M.GT.1 .AND. J.NE.M) THEN
               WKV(II) = R(K-1,K-1)*P(J+1,J)
               WKV(JJ) = R(K-1,K)*P(J+1,J)
               WKV(JJ+1) = R(K,K)*P(J+1,J)
            ENDIF
            IJ = IJ + 4*J + 3
  120    CONTINUE
C
C     SOLVE FOR Y(:,K) AND Y(:,K-1).  RETURN IF A IS SINGULAR.
C
         CALL HSCO(WKV,M+M,IWKV,COND,WKV(OFFSET+1),SD)
         COND = 1.0D0 + COND
         IF (COND .EQ. 1.0D0) THEN
            IERR = K
            RETURN
         ENDIF
C
         IJ = OFFSET+1
         IF (DOSEP) THEN
            DO 130 I=1,M
               TMP = WKV(IJ)
               WKV(IJ) = F(I,K-1)
               F(I,K-1) = TMP
               TMP = WKV(IJ+1)
               WKV(IJ+1) = F(I,K)
               F(I,K) = TMP
               IJ = IJ + 2
  130       CONTINUE
         ELSE
            DO 140 I=1,M
               WKV(IJ) = F(I,K-1)
               WKV(IJ+1) = F(I,K)
               IJ = IJ + 2
  140       CONTINUE
         ENDIF
C
         CALL HSSL(WKV,M+M,IWKV,WKV(OFFSET+1),SD)
C
C     COPY SOLUTION BACK INTO F
C
         IJ = OFFSET+1
         IF (DOSEP) THEN
            DO 150 I=1,M
               TMP = F(I,K-1)
               F(I,K-1) = WKV(IJ)
               WKV(IJ) = TMP
               TMP = F(I,K)
               F(I,K) = WKV(IJ+1)
               WKV(IJ+1) = TMP
               IJ = IJ + 2
  150       CONTINUE
         ELSE
            DO 160 I=1,M
               F(I,K-1) = WKV(IJ)
               F(I,K) = WKV(IJ+1)
               IJ = IJ + 2
  160       CONTINUE
         ENDIF
C
         IF (DOSEP) THEN
            TMP = DDOT(M, WKV(OFFSET+1), 2, F(1,K-1), 1)
            TMP = TMP + DDOT(M, WKV(OFFSET+2), 2, F(1,K), 1)
            TMP = SIGN(1.0D0, TMP)
            IJ = OFFSET + 1
            DO 170 I = 1,M
               F(I,K-1) = TMP*WKV(IJ) + F(I,K-1)
               F(I,K) = TMP*WKV(IJ+1) + F(I,K)
               IJ = IJ + 2
  170       CONTINUE
         ENDIF
C
C     FORM P*Y(:,K), S*Y(:,K), P*Y(:,K-1), AND S*Y(:,K-1)
C
         II = M + M
         JJ = II + M
         DO 190 J=1,M
            IF (J .EQ. 1) THEN
               WKV(J) = 0.0D0
               WKV(J+II) = 0.0D0
            ELSE
               WKV(J) = P(J,J-1)*F(J-1,K)
               WKV(J+II) = P(J,J-1)*F(J-1,K-1)
            ENDIF
            WKV(J+M) = 0.0D0
            WKV(J+JJ) = 0.0D0
            DO 180 I=J,M
               WKV(J) = WKV(J) + P(J,I)*F(I,K)
               WKV(J+M) = WKV(J+M) + S(J,I)*F(I,K)
               WKV(J+II) = WKV(J+II) + P(J,I)*F(I,K-1)
               WKV(J+JJ) = WKV(J+JJ) + S(J,I)*F(I,K-1)
  180       CONTINUE
  190    CONTINUE
C
C     SUBTRACT WEIGHTED COMBINATION OF P*Y(:,K), S*Y(:,K),
C     P*Y(:,K-1), AND S*Y(:,K-1) FROM COLUMNS OF F
C
         DO 210 I=1,K-2
            DO 200 J=1,M
               F(J,I) = F(J,I) - R(I,K)*WKV(J) - T(I,K)*WKV(J+M)
     +                     - R(I,K-1)*WKV(J+II) - T(I,K-1)*WKV(J+JJ)
  200       CONTINUE
  210    CONTINUE
C
         K = K - 2
C
C     GO TO TOP OF LOOP
C
      GO TO 10
C
C --- LAST LINE OF BKHS2 ---
      END
      SUBROUTINE HSCO(AV,N,IPVT,RCOND,Z,SD)
C
      INTEGER N,IPVT(N),SD
      DOUBLE PRECISION AV(N*(N+1)/2 +N*SD),Z(N)
      DOUBLE PRECISION RCOND
C
C     THIS ROUTINE FACTORS A DOUBLE PRECISION MATRIX BY GAUSSIAN
C     ELIMINATION AND ESTIMATES THE CONDITION OF THE MATRIX.  IT IS A
C     MODIFIED VERSION OF DGECO IN WHICH THE MATRIX A HAS THE STRUCTURE
C     OF AN UPPER TRIANGULAR MATRIX PLUS SD NON-ZERO SUBDIAGONALS.
C     TO SAVE SPACE THE TWO-DIMENSIONAL MATRIX A IS REPRESENTED AS A
C     ONE-DIMENSIONAL ARRAY AV.  EACH SUCCESSIVE COLUMN OF A IS STORED
C     IN AV, IN SUCH A WAY THAT THE J'TH COLUMN OF A IS ALLOTTED J+SD
C     POSITIONS IN AV.  A GIVEN ELEMENT A(I,J) IS REPRESENTED AS
C     AV(I + SD*(J-1) + (J*(J-1))/2), PROVIDED I-J > SD .
C     NOTE: IN THE CALLING PROGRAM THE DIMENSION OF IPVT AND Z SHOULD BE
C           AT LEAST N .  SET THE DIMENSION OF AV TO AT LEAST
C           (N*(N+1))/2 + N*SD .
C
C     REFS: J.J. DONGARRA, J.R. BUNCH, C.B. MOLER, AND G.W. STEWART,
C           LINPACK USERS' GUIDE, SIAM, 1979.
C
C     ON ENTRY -
C
C        AV      DOUBLE PRECISION (N*(N+1)/2 +N*SD)
C                ONE-DIMENSIONAL ARRAY REPRESENTING THE MATRIX A TO BE
C                FACTORED.
C
C        N       INTEGER
C                THE ORDER OF THE MATRIX  A .
C
C        SD      INTEGER
C                THE NUMBER OF NON-ZERO SUBDIAGONALS OF A .
C
C     ON RETURN -
C
C        AV      AN ARRAY REPRESENTING AN UPPER TRIANGULAR MATRIX AND
C                THE MULTIPLIERS USED TO OBTAIN IT.  THE FACTORIZATION
C                CAN BE WRITTEN  A = L*U  WHERE L  IS A PRODUCT OF
C                PERMUTATION AND UNIT LOWER TRIANGULAR MATRICES AND
C                U  IS UPPER TRIANGULAR.
C
C        IPVT    INTEGER(N)
C                AN INTEGER VECTOR OF PIVOT INDICES.
C
C        RCOND   DOUBLE PRECISION
C                AN ESTIMATE OF THE RECIPROCAL CONDITION OF  A .
C                FOR THE SYSTEM  A*X = B , RELATIVE PERTURBATIONS
C                IN  A  AND  B  OF SIZE  EPSILON  MAY CAUSE
C                RELATIVE PERTURBATIONS IN  X  OF SIZE  EPSILON/RCOND .
C                IF  RCOND  IS SO SMALL THAT THE LOGICAL EXPRESSION
C                           1.0 + RCOND .EQ. 1.0
C                IS TRUE, THEN  A  MAY BE SINGULAR TO WORKING
C                PRECISION.  IN PARTICULAR,  RCOND  IS ZERO  IF
C                EXACT SINGULARITY IS DETECTED OR THE ESTIMATE
C                UNDERFLOWS.
C
C        Z       DOUBLE PRECISION(N)
C                A WORK VECTOR WHOSE CONTENTS ARE USUALLY UNIMPORTANT.
C                IF  A  IS CLOSE TO A SINGULAR MATRIX, THEN  Z  IS
C                AN APPROXIMATE NULL VECTOR IN THE SENSE THAT
C                NORM(A*Z) = RCOND*NORM(A)*NORM(Z) .
C
C     MODIFIED VERSION OF LINPACK ROUTINE DGECO,  J. AMATO, APRIL 1984.
C     REVISED -
C       28NOV88 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       HSFA; (LINPACK) DAXPY DDOT DSCAL DASUM;
C       (FORTRAN) DABS DMAX1 DSIGN
C
C     INTERNAL VARIABLES -
C
      DOUBLE PRECISION DDOT,EK,T,WK,WKM
      DOUBLE PRECISION ANORM,S,DASUM,SM,YNORM
      INTEGER INFO,J,K,KB,KP1,L,I1,I2
C
      IF (N-SD .LT. 1) RETURN
C
C     INSERT "DUMMY" ELEMENTS FOR EASE OF SUBSEQUENT CODING
C
      DO 10 J = N-SD+1,N
         I1 = SD*(J-1) + (J*(J-1))/2
         DO 5 I2 = N+1,J+SD
            AV(I1+I2) = 0.0D0
    5    CONTINUE
   10 CONTINUE
C
C     COMPUTE 1-NORM OF A
C
      ANORM = 0.0D0
      DO 15 J = 1,N
         I1 = 1 + SD*(J-1) + (J*(J-1))/2
         ANORM = MAX(ANORM,DASUM(J+SD,AV(I1),1))
   15 CONTINUE
C
C     FACTOR
C
      CALL HSFA(AV,N,IPVT,INFO,SD)
C
C     RCOND = 1/(NORM(A)*(ESTIMATE OF NORM(INVERSE(A)))) .
C     ESTIMATE = NORM(Z)/NORM(Y) WHERE  A*Z = Y  AND  TRANS(A)*Y = E .
C     TRANS(A)  IS THE TRANSPOSE OF A .  THE COMPONENTS OF  E  ARE
C     CHOSEN TO CAUSE MAXIMUM LOCAL GROWTH IN THE ELEMENTS OF W  WHERE
C     TRANS(U)*W = E .  THE VECTORS ARE FREQUENTLY RESCALED TO AVOID
C     OVERFLOW.
C
C     SOLVE TRANS(U)*W = E
C
      EK = 1.0D0
      DO 20 J = 1, N
         Z(J) = 0.0D0
   20 CONTINUE
      DO 100 K = 1, N
         I1 = K + SD*(K-1) + (K*(K-1))/2
         IF (Z(K) .NE. 0.0D0) EK = SIGN(EK,-Z(K))
         IF (ABS(EK-Z(K)) .LE. ABS(AV(I1))) GO TO 30
            S = ABS(AV(I1))/ABS(EK-Z(K))
            CALL DSCAL(N,S,Z,1)
            EK = S*EK
   30    CONTINUE
         WK = EK - Z(K)
         WKM = -EK - Z(K)
         S = ABS(WK)
         SM = ABS(WKM)
         IF (AV(I1) .EQ. 0.0D0) GO TO 40
            WK = WK/AV(I1)
            WKM = WKM/AV(I1)
         GO TO 50
   40    CONTINUE
            WK = 1.0D0
            WKM = 1.0D0
   50    CONTINUE
         KP1 = K + 1
         IF (KP1 .GT. N) GO TO 90
            DO 60 J = KP1, N
               I2 = K + SD*(J-1) + (J*(J-1))/2
               SM = SM + ABS(Z(J)+WKM*AV(I2))
               Z(J) = Z(J) + WK*AV(I2)
               S = S + ABS(Z(J))
   60       CONTINUE
            IF (S .GE. SM) GO TO 80
               T = WKM - WK
               WK = WKM
               DO 70 J = KP1, N
                  I2 = K + SD*(J-1) + (J*(J-1))/2
                  Z(J) = Z(J) + T*AV(I2)
   70          CONTINUE
   80       CONTINUE
   90    CONTINUE
         Z(K) = WK
  100 CONTINUE
      S = 1.0D0/DASUM(N,Z,1)
      CALL DSCAL(N,S,Z,1)
C
C     SOLVE TRANS(L)*Y = W
C
      DO 120 KB = 1,N
         K = N + 1 - KB
         I1 = K + SD*(K-1) + (K*(K-1))/2
         IF(K.LT.N) THEN
           Z(K) = Z(K) + DDOT(MIN(SD,N-K), AV(I1+1),1,Z(K+1),1)
         ENDIF
         IF (ABS(Z(K)) .LE. 1.0D0) GO TO 110
            S = 1.0D0/ABS(Z(K))
            CALL DSCAL(N,S,Z,1)
  110    CONTINUE
         L = IPVT(K)
         T = Z(L)
         Z(L) = Z(K)
         Z(K) = T
  120 CONTINUE
      S = 1.0D0/DASUM(N,Z,1)
      CALL DSCAL(N,S,Z,1)
C
      YNORM = 1.0D0
C
C     SOLVE L*V = Y
C
      DO 140 K = 1, N
         I1 = K + SD*(K-1) + (K*(K-1))/2
         L = IPVT(K)
         T = Z(L)
         Z(L) = Z(K)
         Z(K) = T
         IF(K.LT.N) THEN
           CALL DAXPY(MIN(SD,N-K),T,AV(I1+1),1,Z(K+1),1)
         ENDIF
         IF (ABS(Z(K)) .LE. 1.0D0) GO TO 130
            S = 1.0D0/ABS(Z(K))
            CALL DSCAL(N,S,Z,1)
            YNORM = S*YNORM
  130    CONTINUE
  140 CONTINUE
      S = 1.0D0/DASUM(N,Z,1)
      CALL DSCAL(N,S,Z,1)
      YNORM = S*YNORM
C
C     SOLVE  U*Z = V
C
      DO 160 KB = 1, N
         K = N + 1 - KB
         I1 = K + SD*(K-1) + (K*(K-1))/2
         IF (ABS(Z(K)) .LE. ABS(AV(I1))) GO TO 150
            S = ABS(AV(I1))/ABS(Z(K))
            CALL DSCAL(N,S,Z,1)
            YNORM = S*YNORM
  150    CONTINUE
         IF (AV(I1) .NE. 0.0D0) Z(K) = Z(K)/AV(I1)
         IF (AV(I1) .EQ. 0.0D0) Z(K) = 1.0D0
         T = -Z(K)
         CALL DAXPY(K-1,T,AV(I1+1-K),1,Z(1),1)
  160 CONTINUE
C     MAKE ZNORM = 1.0
      S = 1.0D0/DASUM(N,Z,1)
      CALL DSCAL(N,S,Z,1)
      YNORM = S*YNORM
C
      IF (ANORM .NE. 0.0D0) RCOND = YNORM/ANORM
      IF (ANORM .EQ. 0.0D0) RCOND = 0.0D0
      RETURN
C --- LAST LINE OF HSCO ---
      END
      SUBROUTINE HSFA(AV,N,IPVT,INFO,SD)
C
      INTEGER N,IPVT(N),INFO,SD
      DOUBLE PRECISION AV(N*(N+1)/2 + N*SD)
C
C     THIS ROUTINE FACTORS A DOUBLE PRECISION MATRIX BY GAUSSIAN
C     ELIMINATION.  IT IS A MODIFIED VERSION OF DGEFA IN WHICH THE
C     MATRIX A HAS THE STRUCTURE OF AN UPPER TRIANGULAR MATRIX PLUS
C     SD NON-ZERO SUBDIAGONALS.  TO SAVE SPACE THE TWO-DIMENSIONAL
C     MATRIX A IS REPRESENTED AS A ONE-DIMENSIONAL ARRAY AV.  EACH
C     SUCCESSIVE COLUMN OF A IS STORED IN AV, IN SUCH A WAY THAT THE
C     J'TH COLUMN OF A IS ALLOTTED J+SD POSITIONS IN AV .
C     NOTE: IN THE CALLING PROGRAM THE DIMENSION OF IPVT AND Z SHOULD BE
C           AT LEAST N .  SET THE DIMENSION OF AV TO AT LEAST
C           (N*(N+1))/2 + N*SD .
C
C     REFS: J.J. DONGARRA, J.R. BUNCH, C.B. MOLER, AND G.W. STEWART,
C           LINPACK USERS' GUIDE, SIAM, 1979.
C
C     ON ENTRY -
C        AV      DOUBLE PRECISION (N*(N+1)/2 + N*SD)
C                ONE-DIMENSIONAL ARRAY REPRESENTING THE MATRIX A TO BE
C                FACTORED.
C
C        N       INTEGER
C                THE ORDER OF THE MATRIX  A .
C
C        SD      INTEGER
C                THE NUMBER OF NON-ZERO SUBDIAGONALS OF A .
C
C     ON RETURN -
C        AV      DOUBLE PRECISION (N*(N+1)/2)
C                A VECTOR REPRESENTING AN UPPER TRIANGULAR MATRIX AND
C                THE MULTIPLIERS USED TO OBTAIN IT.  THE FACTORIZATION
C                CAN BE WRITTEN  A = L*U  WHERE  L  IS A PRODUCT OF
C                PERMUTATION AND UNIT LOWER TRIANGULAR MATRICES AND
C                U  IS UPPER TRIANGULAR.
C
C        IPVT    INTEGER(N)
C                AN INTEGER VECTOR OF PIVOT INDICES.
C
C        INFO    INTEGER
C                = 0  NORMAL VALUE.
C                = K  IF  U(K,K) .EQ. 0.0 .  THIS IS NOT AN ERROR
C                     CONDITION FOR THIS SUBROUTINE, BUT IT DOES
C                     INDICATE THAT HSSL WILL DIVIDE BY ZERO IF
C                     CALLED.  USE RCOND IN HSCO FOR A RELIABLE
C                     INDICATION OF SINGULARITY.
C
C     MODIFIED VERSION OF LINPACK ROUTINE DGEFA,  J. AMATO, APRIL 1984.
C     REVISED -
C       28NOV88 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       (LINPACK) DAXPY DSCAL IDAMAX
C
C     INTERNAL VARIABLES
C
      DOUBLE PRECISION T
      INTEGER IDAMAX,J,K,KP1,L,NM1,I1,I2,I3
C
      IF (N-SD .LT. 1) RETURN
C
C     INSERT "DUMMY" ELEMENTS FOR EASE OF SUBSEQUENT CODING
C
      DO 8 J = N-SD+1,N
         I1 = SD*(J-1) + (J*(J-1))/2
         DO 5 I2 = N+1,J+SD
            AV(I1+I2) = 0.0D0
    5    CONTINUE
    8 CONTINUE
C
C
C     GAUSSIAN ELIMINATION WITH PARTIAL PIVOTING
C
      INFO = 0
      NM1 = N - 1
      IF (NM1 .LT. 1) GO TO 70
      DO 60 K = 1, NM1
         KP1 = K + 1
*
C
C        FIND L = PIVOT INDEX
C
         I1 = K + SD*(K-1) + (K*(K-1))/2
         L = IDAMAX(SD+1,AV(I1),1) + K - 1
         IPVT(K) = L
C
C        ZERO PIVOT IMPLIES THIS COLUMN ALREADY TRIANGULARIZED
C
         I2 = I1 + L - K
         IF (AV(I2) .EQ. 0.0D0) GO TO 40
C
C           INTERCHANGE IF NECESSARY
C
            IF (L .EQ. K) GO TO 10
               T = AV(I2)
               AV(I2) = AV(I1)
               AV(I1) = T
   10       CONTINUE
C
C           COMPUTE MULTIPLIERS
C
            T = -1.0D0/AV(I1)
            CALL DSCAL(SD,T,AV(I1+1),1)
C
C           ROW ELIMINATION WITH COLUMN INDEXING
C
            DO 30 J = KP1, N
               I2 = L + SD*(J-1) + (J*(J-1))/2
               I3 = I2 + K - L
               T = AV(I2)
               IF (L .EQ. K) GO TO 20
                  AV(I2) = AV(I3)
                  AV(I3) = T
   20          CONTINUE
               CALL DAXPY(SD,T,AV(I1+1),1,AV(I3+1),1)
   30       CONTINUE
         GO TO 50
   40    CONTINUE
            INFO = K
   50    CONTINUE
   60 CONTINUE
   70 CONTINUE
      IPVT(N) = N
      I1 = N + SD*(N-1) + (N*(N-1))/2
      IF (AV(I1) .EQ. 0.0D0) INFO = N
      RETURN
C --- LAST LINE OF HSFA ---
      END
      SUBROUTINE HSSL(AV,N,IPVT,B,SD)
C
      INTEGER N,IPVT(N),SD
      DOUBLE PRECISION AV((N*(N+1))/2 + N*SD),B(N)
C
C     THIS ROUTINE SOLVES THE DOUBLE PRECISION SYSTEM
C     A * X = B  OR  TRANS(A) * X = B
C     USING THE FACTORS COMPUTED BY HSCO OR HSFA.
C     THE INPUT MATRIX IS IN THE FORM OF AN UPPER TRIANGULAR MATRIX
C     PLUS SD NON-ZERO SUBDIAGONALS.  TO SAVE SPACE THE TWO-DIMENSIONAL
C     MATRIX A IS REPRESENTED AS A ONE-DIMENSIONAL ARRAY AV.  EACH
C     SUCCESSIVE COLUMN OF A IS STORED IN AV, SUCH THAT THE J'TH COLUMN
C     OF A IS ALLOTTED J+SD POSITIONS IN AV .
C     NOTE: IN THE CALLING PROGRAM THE DIMENSION OF IPVT AND B SHOULD BE
C           AT LEAST N .  SET THE DIMENSION OF AV TO AT LEAST
C           (N*(N+1))/2 + N*SD .
C
C     REFS: J.J. DONGARRA, J.R. BUNCH, C.B. MOLER, AND G.W. STEWART,
C           LINPACK USERS' GUIDE, SIAM, 1979.
C
C     ON ENTRY -
C
C        AV      DOUBLE PRECISION (N*(N+1)/2 + SD)
C                ONE-DIMENSIONAL ARRAY REPRESENTING THE MATRIX A (OUTPUT
C                FROM HSCO OR HSFA).
C
C        N       INTEGER
C                THE ORDER OF THE MATRIX  A .
C
C        B       DOUBLE PRECISION VECTOR
C                DATA VECTOR (RIGHT HAND SIDE).
C
C        SD      INTEGER
C                THE NUMBER OF NON-ZERO SUBDIAGONALS OF A .
C
C        IPVT    INTEGER(N)
C                THE PIVOT VECTOR FROM HSCO OR HSFA.
C
C     ON RETURN -
C
C        B       CONTAINS THE SOLUTION VECTOR  X .
C
C     ERROR CONDITION -
C
C        A DIVISION BY ZERO WILL OCCUR IF THE INPUT FACTOR CONTAINS A
C        ZERO ON THE DIAGONAL.  TECHNICALLY THIS INDICATES SINGULARITY
C        BUT IT IS OFTEN CAUSED BY IMPROPER ARGUMENTS.  IT WILL NOT
C        OCCUR IF THE SUBROUTINES ARE CALLED CORRECTLY AND IF HSCO HAS
C        SET RCOND .GT. 0.0 OR HSFA HAS SET INFO .EQ. 0 .
C
C     MODIFIED VERSION OF LINPACK ROUTINE DGESL, J. AMATO, APRIL 1984.
C     REVISED -
C       28NOV88 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       (LINPACK) DAXPY DDOT
C
C     INTERNAL VARIABLES -
C
      DOUBLE PRECISION T
      INTEGER J,K,KB,L,NM1,I1
C
      IF (N-SD .LT. 1) RETURN
C
C     INSERT "DUMMY" ELEMENTS FOR EASE OF SUBSEQUENT CODING
C
      DO 8 J = N-SD+1,N
         I1 = SD*(J-1) + (J*(J-1))/2
         DO 5 L = N+1,J+SD
            AV(I1+L) = 0.0D0
    5    CONTINUE
    8 CONTINUE
C
      NM1 = N - 1
C
C        FIRST SOLVE  L*Y = B
C
         IF (NM1 .LT. 1) GO TO 30
         DO 20 K = 1, NM1
            L = IPVT(K)
            T = B(L)
            IF (L .EQ. K) GO TO 10
               B(L) = B(K)
               B(K) = T
   10       CONTINUE
            I1 = K + SD*(K-1) + (K*(K-1))/2
            CALL DAXPY(MIN(SD,N-K),T,AV(I1+1),1,B(K+1),1)
   20    CONTINUE
   30    CONTINUE
C
C        NOW SOLVE  U*X = Y
C
         DO 40 KB = 1, N
            K = N + 1 - KB
            I1 = K + SD*(K-1) + (K*(K-1))/2
            B(K) = B(K)/AV(I1)
            T = -B(K)
            CALL DAXPY(K-1,T,AV(I1+1-K),1,B(1),1)
   40    CONTINUE
      RETURN
C --- LAST LINE OF HSSL ---
      END
      SUBROUTINE KTRAN(NA, N, A)
C
      INTEGER NA, N
      DOUBLE PRECISION A(NA,N)
C
C     PERFORM THE TRANSFORMATION  A <- K*A'*K  (' DENOTES TRANSPOSE)
C     WHERE K IS THE MATRIX WITH ONES IN POSITIONS (I,N+1-I) AND ZEROS
C     ELSEWHERE.  A IS UPPER-HESSENBERG ON INPUT AND ON OUTPUT (ELEMENTS
C     BELOW THE FIRST SUBDIAGONAL ARE NOT REFERENCED).
C
C     ON ENTRY -
C       NA      INTEGER
C               LEADING DIMENSION IN CALLING PROGRAM'S DECLARATION OF A
C
C       N       INTEGER
C               ACTUAL DIMENSION OF A
C
C       A       DOUBLE PRECISION (NA,N)
C               N BY N MATRIX TO BE TRANSFORMED
C
C     ON RETURN -
C       A       DOUBLE PRECISION (NA,N)
C               PERMUTED MATRIX AS DESCRIBED ABOVE
C
C     WRITTEN -
C       19FEB87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-3616
C
      INTEGER I,J,IT,IT1,IT2,IT3
      DOUBLE PRECISION TMP
C
      IF (N .LE. 1) GOTO 30
         IT = N-1
         DO  20 J = 1,IT
            IT1 = MIN(J+1,N-J)
            DO 10 I = 1,IT1
               IT2 = N+1-I
               IT3 = N+1-J
               TMP = A(I,J)
               A(I,J) = A(IT3,IT2)
               A(IT3,IT2) = TMP
  10        CONTINUE
  20     CONTINUE
  30  CONTINUE
      RETURN
C --- LAST LINE OF KTRAN ---
      END
      SUBROUTINE MQFWO (NS,NX,N,S,X,WORK)
C
C     *****PARAMETERS:
      INTEGER NS,NX,N
      DOUBLE PRECISION S(NS,N),X(NX,N),WORK(N)
C
C     *****LOCAL VARIABLES:
      INTEGER I,J,K,JM1
C
C     *****SUBROUTINES CALLED:
C     MULA
C
C     ------------------------------------------------------------------
C
C     *****PURPOSE:
C     THIS SUBROUTINE COMPUTES THE SYMMETRIC MATRIX PRODUCT
C         T
C        X *S*X WHERE S IS SYMMETRIC AND OVERWRITES S WITH
C     THE RESULT.  BOTH S AND X ARE OF ORDER N.
C
C     *****PARAMETER DESCRIPTION:
C
C     ON INPUT:
C
C        NS,NX            ROW DIMENSIONS OF THE ARRAYS CONTAINING S
C                         AND A, RESPECTIVELY, AS DECLARED IN THE
C                         CALLING PROGRAM DIMENSION STATEMENT;
C
C        N                ORDER OF THE MATRICES S AND X;
C
C        S                AN N X N SYMMETRIC MATRIX;
C
C        X                AN N X N MATRIX.
C
C     ON OUTPUT:
C
C                                                             T
C        S                A SYMMETRIC N X N ARRAY CONTAINING X *S*X;
C
C        WORK             A REAL SCRATCH VECTOR OF LENGTH N.
C
C     *****HISTORY:
C     WRITTEN BY ALAN J. LAUB (ELEC. SYS. LAB., M.I.T., RM. 35-331,
C     CAMBRIDGE, MA 02139,  PH.: (617)-253-2125), OCTOBER 1977.
C     MOST RECENT VERSION:  OCT. 12, 1977.
C     MODIFIED BY J.GARDINER (OSU CIS, COLUMBUS, OH 43210 (614)292-8658)
C     TO USE MULA INSTEAD OF MULWOA.  JUNE 30, 1989.
C
C     ------------------------------------------------------------------
C
C     COMPUTE S*X, OVERWRITING INTO S
C
      CALL MULA (NS,NX,N,N,N,S,X,WORK)
C
C                                    T
C     COMPUTE THE LOWER TRIANGLE OF X *S*X
C
      DO 50 J=1,N
         DO 10 I=J,N
            WORK(I)=0.0D0
10       CONTINUE
         DO 30 K=1,N
            DO 20 I=J,N
               WORK(I)=WORK(I)+X(K,I)*S(K,J)
20          CONTINUE
30       CONTINUE
         DO 40 I=J,N
            S(I,J)=WORK(I)
40       CONTINUE
50    CONTINUE
      IF (N.EQ.1) RETURN
C
C     DETERMINE THE STRICT UPPER TRIANGLE BY SYMMETRY
C
      DO 70 J=2,N
         JM1=J-1
         DO 60 I=1,JM1
            S(I,J)=S(J,I)
60       CONTINUE
70    CONTINUE
      RETURN
C
C     LAST LINE OF MQFWO
C
      END
      SUBROUTINE MSCALE (NA,M,N,ALPHA,A)
C
C     *****PARAMETERS:
      INTEGER NA,M,N
      DOUBLE PRECISION ALPHA,A(NA,N)
C
C     *****LOCAL VARIABLES:
      INTEGER I,J
C
C     *****SUBROUTINES CALLED:
C     NONE
C
C     ------------------------------------------------------------------
C
C     *****PURPOSE:
C     THIS SUBROUTINE REPLACES THE M X N ARRAY A WITH (ALPHA*A)
C     WHERE ALPHA IS A (REAL) SCALAR.
C
C     *****PARAMETER DESCRIPTION:
C
C     ON INPUT:
C
C        NA               ROW DIMENSION OF THE ARRAY CONTAINING A AS
C                         DECLARED IN THE CALLING PROGRAM DIMENSION
C                         STATEMENT;
C
C        M                NUMBER OF ROWS OF THE MATRIX A;
C
C        N                NUMBER OF COLUMNS OF THE MATRIX A;
C
C        ALPHA            THE SCALAR MULTIPLIER;
C
C        A                AN M X N MATRIX.
C
C     ON OUTPUT:
C
C        A                THE M X N ARRAY CONTAINING ALPHA*A.
C
C     *****HISTORY:
C     WRITTEN BY ALAN J. LAUB (ELEC. SYS. LAB., M.I.T., RM. 35-331,
C     CAMBRIDGE, MA 02139,  PH.: (617)-253-2125), SEPTEMBER 1977.
C     MOST RECENT VERSION: SEP. 21, 1977.
C
C     ------------------------------------------------------------------
C
      DO 20 J=1,N
         DO 10 I=1,M
            A(I,J)=ALPHA*A(I,J)
10       CONTINUE
20    CONTINUE
      RETURN
C
C     LAST LINE OF MSCALE
C
      END
      SUBROUTINE MULA(NA,NB,N,M,L,A,B,WORK)
C
C     *****PARAMETERS:
      INTEGER NA,NB,N,M,L
      DOUBLE PRECISION A(NA,M),B(NB,L),WORK(L)
C
C     *****LOCAL VARIABLES:
      INTEGER I,J,K
C
C     *****FORTRAN FUNCTIONS:
C     NONE.
C
C     *****SUBROUTINES CALLED:
C     NONE.
C
C     ------------------------------------------------------------------
C
C     *****PURPOSE:
C     THIS SUBROUTINE COMPUTES THE MATRIX PRODUCT A * B AND OVERWRITES
C     IT INTO THE ARRAY A.  WHERE A IS N BY M AND B IS M BY L AND M IS
C     GREATER THAN OR EQUAL TO L.
C
C     *****PARAMETER DESCRIPTION:
C
C     ON INPUT:
C
C       NA,NB   INTEGER
C               ROW DIMENSIONS OF THE ARRAYS CONTAINING A AND B,
C               RESPECTIVELY, AS DECLARED IN THE MAIN CALLING PROGRAM
C               DIMENSION STATEMENT;
C
C       N       INTEGER
C               ROW DIMENSION OF THE MATRIX A;
C
C       M       INTEGER
C               COLUMN DIMENSION OF THE MATRIX A AND ROW DIMENSION OF
C               THE MATRIX B;
C
C       L       INTEGER
C               COLUMN DIMENSION OF THE MATRIX B;
C
C       A       REAL(NA,M)
C               AN N BY M MATRIX;
C
C       B       REAL(NB,L)
C               AN M BY L MATRIX.
C
C     ON OUTPUT:
C
C       A       CONTAINS THE N BY L MATRIX PRODUCT A * B.
C
C     *****ALGORITHM NOTES:
C     NONE.
C
C     *****HISTORY:
C     THIS SUBROUTINE WAS WRITTEN BY W.F. ARNOLD, NAVAL WEAPONS CENTER,
C     CODE 35104, CHINA LAKE, CA  93555, AS PART OF THE SOFTWARE PACKAGE
C     RICPACK, SEPTEMBER 1983.
C
C     ------------------------------------------------------------------
C
      DO 40 I=1,N
          DO 20 J=1,L
              WORK(J) = 0.0D0
              DO 10 K=1,M
                  WORK(J) = WORK(J) + A(I,K)*B(K,J)
   10         CONTINUE
   20     CONTINUE
          DO 30 J=1,L
              A(I,J) = WORK(J)
   30     CONTINUE
   40 CONTINUE
      RETURN
C
C     LAST LINE OF MULA
C
      END
      SUBROUTINE MULB(NA,NB,N,M,L,A,B,WORK)
C
C     PARAMETERS:
      INTEGER NA,NB,N,M,L
      DOUBLE PRECISION A(NA,M),B(NB,L),WORK(N)
C
C     *****LOCAL VARIABLES:
      INTEGER I,J,K
C
C     *****FORTRAN FUNCTIONS:
C     NONE.
C
C     *****SUBROUTINES CALLED:
C     NONE.
C
C     ------------------------------------------------------------------
C
C     *****PURPOSE:
C     THIS SUBROUTINE COMPUTES THE MATRIX PRODUCT A * B AND OVERWRITES
C     IT INTO THE ARRAY B.  WHERE A IS N BY M AND B IS M BY L AND NB IS
C     GREATER THAN OR EQUAL TO N.
C
C     *****PARAMETER DESCRIPTION:
C
C     ON INPUT:
C
C       NA,NB   INTEGER
C               ROW DIMENSIONS OF THE ARRAYS CONTAINING A AND B,
C               RESPECTIVELY, AS DECLARED IN THE MAIN CALLING PROGRAM
C               DIMENSION STATEMENT;
C
C       N       INTEGER
C               ROW DIMENSION OF THE MATRIX A;
C
C       M       INTEGER
C               COLUMN DIMENSION OF THE MATRIX A AND ROW DIMENSION OF
C               THE MATRIX B;
C
C       L       INTEGER
C               COLUMN DIMENSION OF THE MATRIX B;
C
C       A       REAL(NA,M)
C               AN N BY M MATRIX;
C
C       B       REAL(NB,L)
C               AN M BY L MATRIX.
C
C     ON OUTPUT:
C
C       B       CONTAINS THE N BY L MATRIX PRODUCT A * B.
C
C     *****ALGORITHM NOTES:
C     NONE.
C
C     *****HISTORY:
C     THIS SUBROUTINE WAS WRITTEN BY W.F. ARNOLD, NAVAL WEAPONS CENTER,
C     CODE 35104, CHINA LAKE, CA  93555, AS PART OF THE SOFTWARE PACKAGE
C     RICPACK, SEPTEMBER 1983.
C
C     ------------------------------------------------------------------
C
      DO 50 J=1,L
          DO 10 I=1,N
              WORK(I) = 0.0D0
   10     CONTINUE
          DO 30 K=1,M
              DO 20 I=1,N
                  WORK(I) = WORK(I) + A(I,K)*B(K,J)
   20         CONTINUE
   30     CONTINUE
          DO 40 I=1,N
              B(I,J) = WORK(I)
   40     CONTINUE
   50 CONTINUE
      RETURN
C
C     LAST LINE OF MULB
C
      END
      DOUBLE PRECISION FUNCTION D1NRM(NR,N,M,A)
C
C     *****PARAMETERS:
      INTEGER NR,N,M
      DOUBLE PRECISION A(NR,M)
C
C     *****LOCAL VARIABLES:
      INTEGER I,J
      DOUBLE PRECISION TEMP
C
C     *****SUBROUTINES CALLED:
C     NONE
C
C     -----------------------------------------------------------------
C
C     *****PURPOSE:
C     GIVEN AN N BY M MATRIX A, THIS FUNCTION COMPUTES ITS 1-NORM.
C
C     *****PARAMETER DESCRIPTION:
C
C     ON INPUT:
C
C       NR      INTEGER
C               ROW DIMENSION OF THE ARRAY CONTAINING THE MATRIX A AS
C               DECLARED IN THE MAIN CALLING PROGRAM DIMENSION
C               STATEMENT;
C
C       N       INTEGER
C               NUMBER OF ROWS OF THE MATRIX A;
C
C       M       INTEGER
C               NUMBER OF COLUMNS OF THE MATRIX A;
C
C       A       DOUBLE PRECISION(NR,M)
C               N X M MATRIX WHOSE 1-NORM IS TO BE COMPUTED.
C
C     ON OUTPUT:
C
C       D1NRM   DOUBLE PRECISION
C               CONTAINS THE 1-NORM OF THE MATRIX A.
C
C     *****ALGORITHM NOTES:
C     NONE.
C
C     *****HISTORY:
C     THIS SUBROUTINE WAS WRITTEN BY W.F. ARNOLD, NAVAL WEAPONS CENTER,
C     CODE 35104, CHINA LAKE, CA  93555, AS PART OF THE SOFTWARE PACKAGE
C     RICPACK, SEPTEMBER 1983.
C
C     ------------------------------------------------------------------
C
      D1NRM = 0.0D0
      DO 20 I=1,M
          TEMP = 0.0D0
          DO 10 J=1,N
              TEMP = TEMP + ABS(A(J,I))
   10     CONTINUE
          D1NRM = MAX(D1NRM,TEMP)
   20 CONTINUE
      RETURN
C
C     LAST LINE OF D1NRM
C
      END
      SUBROUTINE TRNATA (NA,N,A)
C
C     *****PARAMETERS:
      INTEGER NA,N
      DOUBLE PRECISION A(NA,N)
C
C     *****LOCAL VARIABLES:
      INTEGER I,J,NM1,JP1
      DOUBLE PRECISION TEMP
C
C     ------------------------------------------------------------------
C
C     *****PURPOSE:
C     THIS SUBROUTINE REPLACES THE N X N ARRAY A WITH THE TRANSPOSE
C     OF A.
C
C     *****PARAMETER DESCRIPTION:
C
C     ON INPUT:
C
C        NA               ROW DIMENSION OF THE ARRAY CONTAINING A AS
C                         DECLARED IN THE CALLING PROGRAM DIMENSION
C                         STATEMENT;
C
C        N                ORDER OF THE MATRIX A;
C
C        A                AN N X N MATRIX.
C
C     ON OUTPUT:
C
C        A                AN N X N ARRAY CONTAINING THE TRANSPOSE OF THE
C                         INPUT MATRIX A.
C
C     *****HISTORY:
C     WRITTEN BY ALAN J. LAUB (ELEC. SYS. LAB., M.I.T., RM. 35-331,
C     CAMBRIDGE, MA 02139,  PH.: (617)-253-2125), SEPTEMBER 1977.
C     MOST RECENT VERSION: SEP. 21, 1977.
C
C     ------------------------------------------------------------------
C
      IF (N.EQ.1) RETURN
      NM1 = N- 1
      DO 20 J=1,NM1
         JP1=J+1
         DO 10 I=JP1,N
            TEMP=A(I,J)
            A(I,J)=A(J,I)
            A(J,I)=TEMP
10       CONTINUE
20    CONTINUE
      RETURN
C
C     LAST LINE OF TRNATA
C
      END
      SUBROUTINE QZHESG(NAB,NQZ,N,A,B,Q,Z,LOW,IGH,JOB)
C
      INTEGER NAB,NQZ,N,LOW,IGH,JOB
      DOUBLE PRECISION A(NAB,N),B(NAB,N),Q(NQZ,N),Z(NQZ,N)
C
      INTEGER I,J,K,L,LB,L1,NK1,IGHM1,IGHM2,IQL,IQH,IZL,IZH
      DOUBLE PRECISION R,S,T,U1,U2,V1,V2,RHO
      LOGICAL INITQ,INITZ,ACCUMQ,ACCUMZ
C
C     QZHESG IS A MODIFIED VERSION OF THE EISPACK SUBROUTINE QZHES. THIS
C     ROUTINE PERFORMS ORTHOGONAL  TRANSFORMATIONS ON SUBMATRICES (INDI-
C     CATED  BY  LOW  AND  IGH) OF  A  AND  B , OPTIONALLY  ACCUMULATING
C     THE  LEFT AND RIGHT  TRANSFORMATIONS IN  Q  AND  Z , RESPECTIVELY,
C     SUCH  THAT Q'*A*Z AND Q'*B*Z (WHERE ' DENOTES TRANPOSE) ARE UPPER-
C     HESSENBERG AND  UPPER-TRIANGULAR, RESPECTIVELY.   THIS ROUTINE MAY
C     BE  PRECEDED BY THE BALANCING  ALGORITHM OF  WARD AND  IS USUALLY
C     FOLLOWED BY QZITG, QZVALG, AND POSSIBLY QZVEC.
C
C     REFS: MOLER AND STEWART, SIAM J. NUMER. ANAL. 10, 241-256(1973).
C           WARD, SIAM J. SCI. STAT. COMP. 2, 141-152(1981).
C           GARBOW, BOYLE, DONGARRA, AND MOLER, MATRIX EIGENSYSTEM
C             ROUTINES -- EISPACK GUIDE EXTENSION, 1977.
C
C     ON ENTRY -
C       NAB     INTEGER
C               LEADING DIMENSION OF  A  AND  B  IN THE MAIN CALLING
C               PROGRAM
C
C       NQZ     INTEGER
C               LEADING DIMENSION OF  Q  AND  Z  IN THE MAIN CALLING
C               PROGRAM
C
C       N       INTEGER
C               ORDER OF THE MATRICES A AND B
C
C       A       DOUBLE PRECISION (NAB,N)
C               N BY N MATRIX
C
C       B       DOUBLE PRECISION (NAB,N)
C
C       LOW     INTEGER
C               STARTING INDEX FOR THE SCALED SUBMATRICES OF A AND B
C               OBTAINED FROM THE BALANCING ALGORITHM.  IF THE MATRICES
C               HAVE NOT BEEN BALANCED, SET LOW TO 1.
C
C       IGH     INTEGER
C               THE ENDING INDEX FOR THE SCALED SUBMATRICES OF A AND B
C               OBTAINED FROM THE BALANCING ALGORITHM.  IF THE MATRICES
C               HAVE NOT BEEN BALANCED, SET IGH TO N.
C
C       JOB     INTEGER
C               AN INTEGER IN DECIMAL FORM  ABCDE  GIVING OPTIONS
C                  A,B,C     (NOT USED, MUST BE SET TO 0)
C                  D .EQ. 0  DON'T ACCUMULATE LEFT ORTHOGONAL TRANSFOR-
C                            MATIONS IN  Q; Q  IS NOT REFERENCED.
C                  D .EQ. 1  RIGHT MULTIPLY  Q  BY THE TRANSPOSE OF THE
C                            LEFT TRANSFORMATIONS PERFORMED ON  A AND B
C                  D .EQ. 2  INITAILIZE  Q  TO IDENTITY AND ACCUMULATE
C                            TRANSFORMATIONS AS FOR  D .EQ. 1
C                  E .EQ. 0  DON'T ACCUMULATE RIGHT ORTHOGONAL TRANSFOR-
C                            MATIONS IN  Z; Z  IS NOT REFERENCED
C                  E .EQ. 1  RIGHT MULTIPLY  Z  BY THE RIGHT TRANSFORMA-
C                            TIONS PERFORMED ON  A  AND  B
C                  E .EQ. 2  INITAILIZE  Z  TO IDENTITY AND ACCUMULATE
C                            RIGHT TRANSFORMATIONS AS FOR  E .EQ. 1
C
C     ON RETURN -
C       A       DOUBLE PRECISION (NAB,N)
C               N BY N MATRIX REDUCED TO UPPER-HESSENBERG FORM.  THE
C               ELEMENTS BELOW THE SUBDIAGONAL HAVE BEEN SET TO ZERO.
C
C       B       DOUBLE PRECISION (NAB,N)
C               N BY N MATRIX REDUCED TO UPPER-TRIANGULAR FORM.  THE
C               ELEMENTS BELOW THE SUBDIAGONAL HAVE BEEN SET TO ZERO.
C
C       Q       DOUBLE PRECISION (NQZ,N)
C               N BY N MATRIX OF ACCUMULATED LEFT TRANSFORMATIONS AS
C               SPECFIED BY  JOB  FLAG
C
C       Z       DOUBLE PRECISION (NQZ,N)
C               N BY N MATRIX OF ACCUMULATED LEFT TRANSFORMATIONS AS
C               SPECFIED BY  JOB  FLAG
C
C     MODIFIED - MODIFIED QZHES FROM EISPACK
C       17FEB87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-3616
C     ------------------------------------------------------------------
C
      INITQ = (MOD(JOB/10,10) .EQ. 2)
      INITZ = (MOD(JOB,10) .EQ. 2)
      ACCUMQ = (MOD(JOB/10,10) .GT. 0)
      ACCUMZ = (MOD(JOB,10) .GT. 0)
C
C     .......... INITIALIZE Q AND Z ..........
C
      IQL = 1
      IQH = N
      IF (.NOT.INITQ) GOTO 30
         IQL = LOW
         IQH = IGH
         DO 20 J = 1,N
            DO 10 I = 1,N
               Q(I,J) = 0.0D0
   10       CONTINUE
            Q(J,J) = 1.0D0
   20    CONTINUE
   30 CONTINUE
C
      IZL = 1
      IZH = N
      IF (.NOT.INITZ) GOTO 60
         IZL = LOW
         IZH = IGH
         DO 50 J = 1,N
            DO 40 I = 1,N
               Z(I,J) = 0.0D0
   40       CONTINUE
            Z(J,J) = 1.0D0
   50    CONTINUE
   60 CONTINUE
C
C     .......... REDUCE B TO UPPER TRIANGULAR FORM ..........
      IF (LOW .EQ. IGH) GO TO 310
      IGHM1 = IGH - 1
C
      DO 200 L = LOW, IGHM1
         L1 = L + 1
         S = 0.0D0
C
         DO 70 I = L1, IGH
            S = S + ABS(B(I,L))
   70    CONTINUE
C
         IF (S .EQ. 0.0D0) GO TO 200
         S = S + ABS(B(L,L))
         R = 0.0D0
C
         DO 80 I = L, IGH
            B(I,L) = B(I,L) / S
            R = R + B(I,L)**2
   80    CONTINUE
C
         R = SIGN(SQRT(R),B(L,L))
         B(L,L) = B(L,L) + R
         RHO = R * B(L,L)
C
         DO 110 J = L1, N
            T = 0.0D0
C
            DO 90 I = L, IGH
               T = T + B(I,L) * B(I,J)
   90       CONTINUE
C
            T = -T / RHO
C
            DO 100 I = L, IGH
               B(I,J) = B(I,J) + T * B(I,L)
  100       CONTINUE
C
  110    CONTINUE
C
         DO 140 J = LOW, N
            T = 0.0D0
C
            DO 120 I = L, IGH
               T = T + B(I,L) * A(I,J)
  120       CONTINUE
C
            T = -T / RHO
C
            DO 130 I = L, IGH
               A(I,J) = A(I,J) + T * B(I,L)
  130       CONTINUE
C
  140    CONTINUE
C
         IF (.NOT.ACCUMQ) GOTO 180
            DO 170 I = IQL, IQH
               T = 0.0D0
               DO 150 J = L, IGH
                  T = T + Q(I,J) * B(J,L)
  150          CONTINUE
               T = -T / RHO
               DO 160 J = L, IGH
                  Q(I,J) = Q(I,J) + T * B(J,L)
  160          CONTINUE
  170       CONTINUE
  180    CONTINUE
C
         B(L,L) = -S * R
C
         DO 190 I = L1, IGH
            B(I,L) = 0.0D0
  190    CONTINUE
C
  200 CONTINUE
C     .......... REDUCE A TO UPPER HESSENBERG FORM, WHILE
C                KEEPING B TRIANGULAR ..........
      IF (LOW .EQ. IGHM1) GO TO 310
      IGHM2 = IGH - 2
C
      DO 300 K = LOW, IGHM2
         NK1 = IGHM1 - K
C     .......... FOR L=N-1 STEP -1 UNTIL K+1 DO -- ..........
         DO 290 LB = 1, NK1
            L = N - LB
            L1 = L + 1
C     .......... ZERO A(L+1,K) ..........
            S = ABS(A(L,K)) + ABS(A(L1,K))
            IF (S .EQ. 0.0D0) GO TO 290
            U1 = A(L,K) / S
            U2 = A(L1,K) / S
            R = SIGN(SQRT(U1*U1+U2*U2),U1)
            V1 =  -(U1 + R) / R
            V2 = -U2 / R
            U2 = V2 / V1
C
            DO 210 J = K, N
               T = A(L,J) + U2 * A(L1,J)
               A(L,J) = A(L,J) + T * V1
               A(L1,J) = A(L1,J) + T * V2
  210       CONTINUE
C
            A(L1,K) = 0.0D0
C
            DO 220 J = L, N
               T = B(L,J) + U2 * B(L1,J)
               B(L,J) = B(L,J) + T * V1
               B(L1,J) = B(L1,J) + T * V2
  220       CONTINUE
C
            IF (.NOT.ACCUMQ) GOTO 240
               DO 230 I = IQL, IQH
                  T = Q(I,L) + U2 * Q(I,L1)
                  Q(I,L) = Q(I,L) + T * V1
                  Q(I,L1) = Q(I,L1) + T * V2
  230          CONTINUE
  240       CONTINUE
C
C     .......... ZERO B(L+1,L) ..........
            S = ABS(B(L1,L1)) + ABS(B(L1,L))
            IF (S .EQ. 0.0D0) GO TO 290
            U1 = B(L1,L1) / S
            U2 = B(L1,L) / S
            R = SIGN(SQRT(U1*U1+U2*U2),U1)
            V1 =  -(U1 + R) / R
            V2 = -U2 / R
            U2 = V2 / V1
C
            DO 250 I = 1, L1
               T = B(I,L1) + U2 * B(I,L)
               B(I,L1) = B(I,L1) + T * V1
               B(I,L) = B(I,L) + T * V2
  250       CONTINUE
C
            B(L1,L) = 0.0D0
C
            DO 260 I = 1, IGH
               T = A(I,L1) + U2 * A(I,L)
               A(I,L1) = A(I,L1) + T * V1
               A(I,L) = A(I,L) + T * V2
  260       CONTINUE
C
            IF (.NOT. ACCUMZ) GOTO 280
               DO 270 I = IZL, IZH
                  T = Z(I,L1) + U2 * Z(I,L)
                  Z(I,L1) = Z(I,L1) + T * V1
                  Z(I,L) = Z(I,L) + T * V2
  270          CONTINUE
  280       CONTINUE
C
  290    CONTINUE
C
  300 CONTINUE
C
  310 RETURN
C
C --- LAST LINE OF QZHESG ---
      END
      SUBROUTINE QZITG(NAB,NQZ,N,A,B,Q,Z,LOW,IGH,EPS1,JOB,IERR)
C
      INTEGER NAB,NQZ,N,LOW,IGH,JOB,IERR
      DOUBLE PRECISION A(NAB,N),B(NAB,N),Q(NQZ,N),Z(NQZ,N),EPS1
C
      INTEGER I,J,K,L,EN,K1,K2,LD,LL,L1,NA,ISH,ITS,KM1,LM1,ENM2,LOR1,
     X        ENORN,LOWP1,IQL,IQH,IZL,IZH
      DOUBLE PRECISION R,S,T,A1,A2,A3,EP,SH,U1,U2,U3,V1,V2,V3,ANI,
     X       A11,A12,A21,A22,A33,A34,A43,A44,BNI,B11,B12,B22,B33,B34,
     X       B44,EPSA,EPSB,ANORM,BNORM
      DOUBLE PRECISION D1MACH
      LOGICAL  NOTLAS,ACCUMQ,ACCUMZ,TLOG
C
C     QZITG IS A MODIFICATION OF THE EISPACK QZIT ROUTINE.
C     THIS SUBROUTINE ACCEPTS  UPPER-HESSENBERG AND UPPER-TRIANGULAR
C     MATRICES  A  AND  B  AND REDUCES THE HESSENBERG MATRIX TO
C     QUASI-TRIANGULAR FORM, OPTIONALLY ACCUMULATING LEFT AND RIGHT
C     TRANSFORMATIONS IN  Q  AND  Z , RESPECTIVELY.  THIS ROUTINE IS
C     MAY BE PRECEDED BY WARD'S BALANCING AND IS USUALLY PRECEDED BY
C     QZHESG AND FOLLOWED QZVALG, AND POSSIBLY QZVEC.
C
C     REF:  MOLER AND STEWART, SIAM J. NUMER. ANAL., 10, 241-256 (1973).
C           AND WARD, SIAM J. SCI. STAT. COMP., 2, 141-152 (1981).
C           GARBOW, BOYLE, DONGARRA, AND MOLER, MATRIX EIGENSYSTEM
C             ROUTINES -- EISPACK GUIDE EXTENSION, 1977.
C
C     ON ENTRY -
C       NAB     INTEGER
C               LEADING DIMENSION OF  A  AND  B  AS DECLARED IN THE MAIN
C               CALLING PROGRAM
C
C       NQZ     INTEGER
C               LEADING DIMENSION OF  Q  AND  Z  AS DECLARED IN THE MAIN
C               CALLING PROGRAM
C
C       N       INTEGER
C               ORDER OF THE MATRICES  A  AND  B
C
C       A       DOUBLE PRECISION (NAB,N)
C               N BY N UPPER-HESSENBERG MATRIX
C
C       B       DOUBLE PRECISION (NAB,N)
C               N BY N UPPER-TRIANGULAR MATRIX
C
C       Q,Z     DOUBLE PRECISION (NQZ,N)
C               ARRAYS PRODUCED BY QZHESG.  THESE ARE USED TO ACCUMULATE
C               LEFT AND RIGHT TRANSFORMATIONS
C
C       LOW     INTEGER
C               STARTING INDEX FOR THE SCALED SUBMATRICES OF  A  AND  B
C               OBTAINED FROM THE BALANCING ALGORITHM.  IF THE MATRICES
C               HAVE NOT BEEN BALANCED, SET LOW TO 1.
C
C       IGH     INTEGER
C               ENDING INDEX FOR THE SCALED SUBMATRICES OF  A  AND  B
C               OBTAINED FROM THE BALANCING ALGORITHM.  IF THE MATRICES
C               HAVE NOT BEEN BALANCED, SET LOW TO N.
C
C       EPS1    DOUBLE PRECISION
C               TOLERANCE USED TO DETERMINE NEGLIGIBLE ELEMENTS.
C               EPS1 = 0.0D0 (OR NEGATIVE) MAY BE INPUT, IN WHICH CASE
C               AN ELEMENT WILL BE NEGLECTED ONLY IF IT IS LESS THAN
C               ROUNDOFF ERROR TIMES THE NORM OF ITS MATRIX.  IF THE
C               INPUT EPS1 IS POSITIVE, THEN AN ELEMENT WILL BE
C               CONSIDERED NEGLIGIBLE IF IT IS LESS THAN  EPS1  TIMES
C               THE NORM OF ITS MATRIX.
C
C       JOB     INTEGER
C               INTEGER IN DECIMAL FORM  ABCDE  INDICATING THE FOLLOWING
C                  A,B,C      (CURRENTLY NOT USED, SHOULD BE SET TO 0)
C                  D .EQ. 0   DON'T ACCUMULATE LEFT TRANSFORMATIONS IN
C                             Q.  Q  IS NOT REFERENCED
C                  D .EQ. 1   RIGHT MULTIPLY  Q  BY THE TRANSPOSE OF THE
C                             LEFT TRANSFORMATIONS PERFORMED ON  A AND B
C                  D .EQ. 2   DO AS WITH  D .EQ. 1  BUT ONLY ACCUMULATE
C                             ON ROWS  LOW  TO  IGH OF  Z.
C                  E .EQ. 0   DON'T ACCUMULATE RIGHT TRANSFORMATIONS IN
C                             Z.  Z IS NOT REFERENCED.
C                  E .EQ. 1   RIGHT MULTIPLY  Z  BY THE RIGHT
C                             TRANSFORMATIONS PERFORMED ON  A  AND  B
C                  E .EQ. 2   DO AS WITH  E .EQ. 1  BUT ONLY ACCUMULATE
C                             ON ROWS  LOW  TO  IGH  OF  Z.
C
C     ON RETURN -
C       A       DOUBLE PRECISION (NAB,N)
C               N BY N QUASI-UPPER-TRIANGULAR MATRIX.  THE ELEMENTS
C               BELOW THE FIRST SUBDIAGONAL ARE STILL ZERO AND NO TWO
C               CONSECUTIVE SUBDIAGONAL ELEMENTS ARE NONZERO.
C
C       B       DOUBLE PRECISION (NAB,N)
C               N BY N UPPER-TRIANGULAR MATRIX WHOSE ELEMENTS HAVE BEEN
C               ALTERED SINCE INPUT.  LOCATION  B(N,1)  IS USED TO STORE
C               EPS1  TIMES THE NORM OF  B  FOR LATER USE BY  QZVAL AND
C               QZVEC.
C
C       Q       DOUBLE PRECISION (NQZ,N)
C               N BY N MATRIX RIGHT MULTIPLIED BY TRANSPOSE OF THE LEFT
C               TRANSFORMATIONS IF REQUESTED BY  JOB  PARAMETER.
C
C       Z       DOUBLE PRECISION (NQZ,N)
C               N BY N MATRIX RIGHT MULTIPLIED BY RIGHT TRANSFORMATIONS
C               IF REQUESTED BY  JOB  PARAMETER.
C
C       IERR    INTEGER
C               SET TO ZERO ON NORMAL RETURN OR  J  IF NEITHER  A(J,J-1)
C               NOR  A(J-1,J-2)  HAS BECOME ZERO AFTER 50 ITERATIONS.
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C       (port) d1mach
C
C      MODIFIED -  FROM EISPACK QZIT
C       17FEB87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-3616
C     ------------------------------------------------------------------
C
      ACCUMQ = (MOD(JOB/10,10) .GT. 0)
      TLOG = (MOD(JOB/10,10) .EQ. 1)
      IQL = LOW
      IQH = IGH
      IF (TLOG) GOTO 10
         IQL = 1
         IQH = N
   10 CONTINUE
      ACCUMZ = (MOD(JOB,10) .GT. 0)
      TLOG = (MOD(JOB/10,10) .EQ. 1)
      IZL = LOW
      IZH = IGH
      IF (TLOG) GOTO 20
         IZL = 1
         IZH = N
   20 CONTINUE
      IERR = 0
C     ********** COMPUTE EPSA,EPSB **********
      ANORM = 0.0D0
      BNORM = 0.0D0
C
      DO 40 I = LOW, IGH
         ANI = 0.0D0
         IF (I .NE. LOW) ANI = ABS(A(I,I-1))
         BNI = 0.0D0
C
         DO 30 J = I, IGH
            ANI = ANI + ABS(A(I,J))
            BNI = BNI + ABS(B(I,J))
   30    CONTINUE
C
         IF (ANI .GT. ANORM) ANORM = ANI
         IF (BNI .GT. BNORM) BNORM = BNI
   40 CONTINUE
C
      IF (ANORM .EQ. 0.0D0) ANORM = 1.0D0
      IF (BNORM .EQ. 0.0D0) BNORM = 1.0D0
      EP = EPS1
      IF (EP .GT. 0.0D0) GO TO 50
C     ********** COMPUTE ROUNDOFF LEVEL IF EPS1 IS ZERO **********
      EP = D1MACH(4)
   50 EPSA = EP * ANORM
      EPSB = EP * BNORM
C     ********** REDUCE A TO QUASI-TRIANGULAR FORM, WHILE
C                KEEPING B TRIANGULAR **********
      LOR1 = 1
      ENORN = N
      EN = IGH
      LOWP1 = LOW + 1
C     ********** BEGIN QZ STEP **********
   60 IF (EN .LE. LOWP1) GO TO 380
      IF (.NOT.ACCUMZ) ENORN = EN
      ITS = 0
      NA = EN - 1
      ENM2 = NA - 1
   70 ISH = 2
C     ********** CHECK FOR CONVERGENCE OR REDUCIBILITY.
C                FOR L=EN STEP -1 UNTIL 1 DO -- **********
      DO 80 LL = LOW, EN
         L = EN + LOW - LL
         IF (L .EQ. LOW) GO TO 100
         LM1 = L - 1
         IF (ABS(A(L,LM1)) .LE. EPSA) GO TO 90
   80 CONTINUE
C
   90 A(L,LM1) = 0.0D0
      IF (L .LT. NA) GO TO 100
C     ********** 1-BY-1 OR 2-BY-2 BLOCK ISOLATED **********
      EN = LM1
      GO TO 60
C     ********** CHECK FOR SMALL TOP OF B **********
  100 LD = L
  110 L1 = L + 1
      B11 = B(L,L)
      IF (ABS(B11) .GT. EPSB) GO TO 150
      B(L,L) = 0.0D0
      S = ABS(A(L,L)) + ABS(A(L1,L))
      U1 = A(L,L) / S
      U2 = A(L1,L) / S
      R = SIGN(SQRT(U1*U1+U2*U2),U1)
      V1 = -(U1 + R) / R
      V2 = -U2 / R
      U2 = V2 / V1
C
      DO 120 J = L, ENORN
         T = A(L,J) + U2 * A(L1,J)
         A(L,J) = A(L,J) + T * V1
         A(L1,J) = A(L1,J) + T * V2
         T = B(L,J) + U2 * B(L1,J)
         B(L,J) = B(L,J) + T * V1
         B(L1,J) = B(L1,J) + T * V2
  120 CONTINUE
C
      IF (.NOT.ACCUMQ) GOTO 140
         DO 130 I = IQL, IQH
            T = Q(I,L) + U2 * Q(I,L1)
            Q(I,L) = Q(I,L) + T * V1
            Q(I,L1) = Q(I,L1) + T * V2
  130    CONTINUE
  140 CONTINUE
C
      IF (L .NE. LOW) A(L,LM1) = -A(L,LM1)
      LM1 = L
      L = L1
      GO TO 90
  150 A11 = A(L,L) / B11
      A21 = A(L1,L) / B11
      IF (ISH .EQ. 1) GO TO 170
C     ********** ITERATION STRATEGY **********
      IF (ITS .EQ. 50) GO TO 370
      IF (ITS .EQ. 10) GO TO 190
C     ********** DETERMINE TYPE OF SHIFT **********
      B22 = B(L1,L1)
      IF (ABS(B22) .LT. EPSB) B22 = EPSB
      B33 = B(NA,NA)
      IF (ABS(B33) .LT. EPSB) B33 = EPSB
      B44 = B(EN,EN)
      IF (ABS(B44) .LT. EPSB) B44 = EPSB
      A33 = A(NA,NA) / B33
      A34 = A(NA,EN) / B44
      A43 = A(EN,NA) / B33
      A44 = A(EN,EN) / B44
      B34 = B(NA,EN) / B44
      T = 0.5 * (A43 * B34 - A33 - A44)
      R = T * T + A34 * A43 - A33 * A44
      IF (R .LT. 0.0D0) GO TO 180
C     ********** DETERMINE SINGLE SHIFT ZEROTH COLUMN OF A **********
      ISH = 1
      R = SQRT(R)
      SH = -T + R
      S = -T - R
      IF (ABS(S-A44) .LT. ABS(SH-A44)) SH = S
C     ********** LOOK FOR TWO CONSECUTIVE SMALL
C                SUB-DIAGONAL ELEMENTS OF A.
C                FOR L=EN-2 STEP -1 UNTIL LD DO -- **********
      DO 160 LL = LD, ENM2
         L = ENM2 + LD - LL
         IF (L .EQ. LD) GO TO 170
         LM1 = L - 1
         L1 = L + 1
         T = A(L,L)
         IF (ABS(B(L,L)) .GT. EPSB) T = T - SH * B(L,L)
         IF (ABS(A(L,LM1)) .LE. ABS(T/A(L1,L)) * EPSA) GO TO 110
  160 CONTINUE
C
  170 A1 = A11 - SH
      A2 = A21
      IF (L .NE. LD) A(L,LM1) = -A(L,LM1)
      GO TO 200
C     ********** DETERMINE DOUBLE SHIFT ZEROTH COLUMN OF A **********
  180 A12 = A(L,L1) / B22
      A22 = A(L1,L1) / B22
      B12 = B(L,L1) / B22
      A1 = ((A33 - A11) * (A44 - A11) - A34 * A43 + A43 * B34 * A11)
     X     / A21 + A12 - A11 * B12
      A2 = (A22 - A11) - A21 * B12 - (A33 - A11) - (A44 - A11)
     X     + A43 * B34
      A3 = A(L1+1,L1) / B22
      GO TO 200
C     ********** AD HOC SHIFT **********
  190 A1 = 0.0D0
      A2 = 1.0D0
      A3 = 1.1605D0
  200 ITS = ITS + 1
      IF (.NOT.ACCUMZ) LOR1 = LD
C     ********** MAIN LOOP **********
      DO 360 K = L, NA
         NOTLAS = K .NE. NA .AND. ISH .EQ. 2
         K1 = K + 1
         K2 = K + 2
         KM1 = MAX(K-1,L)
         LL = MIN(EN,K1+ISH)
         IF (NOTLAS) GO TO 250
C     ********** ZERO A(K+1,K-1) **********
         IF (K .EQ. L) GO TO 210
         A1 = A(K,KM1)
         A2 = A(K1,KM1)
  210    S = ABS(A1) + ABS(A2)
         IF (S .EQ. 0.0D0) GO TO 70
         U1 = A1 / S
         U2 = A2 / S
         R = SIGN(SQRT(U1*U1+U2*U2),U1)
         V1 = -(U1 + R) / R
         V2 = -U2 / R
         U2 = V2 / V1
C
         DO 220 J = KM1, ENORN
            T = A(K,J) + U2 * A(K1,J)
            A(K,J) = A(K,J) + T * V1
            A(K1,J) = A(K1,J) + T * V2
            T = B(K,J) + U2 * B(K1,J)
            B(K,J) = B(K,J) + T * V1
            B(K1,J) = B(K1,J) + T * V2
  220    CONTINUE
C
         IF (.NOT.ACCUMQ) GOTO 240
            DO 230 I = IQL, IQH
               T = Q(I,K) + U2 * Q(I,K1)
               Q(I,K) = Q(I,K) + T * V1
               Q(I,K1) = Q(I,K1) + T * V2
  230       CONTINUE
  240    CONTINUE
C
         IF (K .NE. L) A(K1,KM1) = 0.0D0
         GO TO 330
C     ********** ZERO A(K+1,K-1) AND A(K+2,K-1) **********
  250    IF (K .EQ. L) GO TO 260
         A1 = A(K,KM1)
         A2 = A(K1,KM1)
         A3 = A(K2,KM1)
  260    S = ABS(A1) + ABS(A2) + ABS(A3)
         IF (S .EQ. 0.0D0) GO TO 360
         U1 = A1 / S
         U2 = A2 / S
         U3 = A3 / S
         R = SIGN(SQRT(U1*U1+U2*U2+U3*U3),U1)
         V1 = -(U1 + R) / R
         V2 = -U2 / R
         V3 = -U3 / R
         U2 = V2 / V1
         U3 = V3 / V1
C
         DO 270 J = KM1, ENORN
            T = A(K,J) + U2 * A(K1,J) + U3 * A(K2,J)
            A(K,J) = A(K,J) + T * V1
            A(K1,J) = A(K1,J) + T * V2
            A(K2,J) = A(K2,J) + T * V3
            T = B(K,J) + U2 * B(K1,J) + U3 * B(K2,J)
            B(K,J) = B(K,J) + T * V1
            B(K1,J) = B(K1,J) + T * V2
            B(K2,J) = B(K2,J) + T * V3
  270    CONTINUE
C
         IF (.NOT.ACCUMQ) GOTO 290
            DO 280 I = IQL, IQH
               T = Q(I,K) + U2 * Q(I,K1) + U3 * Q(I,K2)
               Q(I,K) = Q(I,K) + T * V1
               Q(I,K1) = Q(I,K1) + T * V2
               Q(I,K2) = Q(I,K2) + T * V3
  280       CONTINUE
  290    CONTINUE
C
         IF (K .EQ. L) GO TO 300
         A(K1,KM1) = 0.0D0
         A(K2,KM1) = 0.0D0
C     ********** ZERO B(K+2,K+1) AND B(K+2,K) **********
  300    S = ABS(B(K2,K2)) + ABS(B(K2,K1)) + ABS(B(K2,K))
         IF (S .EQ. 0.0D0) GO TO 330
         U1 = B(K2,K2) / S
         U2 = B(K2,K1) / S
         U3 = B(K2,K) / S
         R = SIGN(SQRT(U1*U1+U2*U2+U3*U3),U1)
         V1 = -(U1 + R) / R
         V2 = -U2 / R
         V3 = -U3 / R
         U2 = V2 / V1
         U3 = V3 / V1
C
         DO 310 I = LOR1, LL
            T = A(I,K2) + U2 * A(I,K1) + U3 * A(I,K)
            A(I,K2) = A(I,K2) + T * V1
            A(I,K1) = A(I,K1) + T * V2
            A(I,K) = A(I,K) + T * V3
            T = B(I,K2) + U2 * B(I,K1) + U3 * B(I,K)
            B(I,K2) = B(I,K2) + T * V1
            B(I,K1) = B(I,K1) + T * V2
            B(I,K) = B(I,K) + T * V3
  310    CONTINUE
C
         B(K2,K) = 0.0D0
         B(K2,K1) = 0.0D0
         IF (.NOT.ACCUMZ) GO TO 330
C
         DO 320 I = IZL, IZH
            T = Z(I,K2) + U2 * Z(I,K1) + U3 * Z(I,K)
            Z(I,K2) = Z(I,K2) + T * V1
            Z(I,K1) = Z(I,K1) + T * V2
            Z(I,K) = Z(I,K) + T * V3
  320    CONTINUE
C     ********** ZERO B(K+1,K) **********
  330    S = ABS(B(K1,K1)) + ABS(B(K1,K))
         IF (S .EQ. 0.0D0) GO TO 360
         U1 = B(K1,K1) / S
         U2 = B(K1,K) / S
         R = SIGN(SQRT(U1*U1+U2*U2),U1)
         V1 = -(U1 + R) / R
         V2 = -U2 / R
         U2 = V2 / V1
C
         DO 340 I = LOR1, LL
            T = A(I,K1) + U2 * A(I,K)
            A(I,K1) = A(I,K1) + T * V1
            A(I,K) = A(I,K) + T * V2
            T = B(I,K1) + U2 * B(I,K)
            B(I,K1) = B(I,K1) + T * V1
            B(I,K) = B(I,K) + T * V2
  340    CONTINUE
C
         B(K1,K) = 0.0D0
         IF (.NOT.ACCUMZ) GO TO 360
C
         DO 350 I = IZL, IZH
            T = Z(I,K1) + U2 * Z(I,K)
            Z(I,K1) = Z(I,K1) + T * V1
            Z(I,K) = Z(I,K) + T * V2
  350    CONTINUE
C
  360 CONTINUE
C     ********** END QZ STEP **********
      GO TO 70
C     ********** SET ERROR -- NEITHER BOTTOM SUBDIAGONAL ELEMENT
C                HAS BECOME NEGLIGIBLE AFTER 50 ITERATIONS **********
  370 IERR = EN
C     ********** SAVE EPSB FOR USE BY QZVAL AND QZVEC **********
  380 IF (N .GT. 1) B(N,1) = EPSB
      RETURN
C --- LAST LINE OF QZITG ---
      END
      SUBROUTINE QZVALG(NAB,NQZ,N,A,B,Q,Z,ALFR,ALFI,BETA,JOB)
C
      INTEGER NAB,NQZ,N,JOB
      DOUBLE PRECISION A(NAB,N),B(NAB,N),Q(NQZ,N),Z(NQZ,N),ALFR(N),
     X                 ALFI(N),BETA(N)
C
      INTEGER I,J,EN,NA,NN,ISW
      DOUBLE PRECISION C,D,E,R,S,T,AN,A1,A2,BN,CQ,CZ,DI,DR,EI,TI,TR,U1,
     X       U2,V1,V2,A1I,A11,A12,A2I,A21,A22,B11,B12,B22,SQI,SQR,
     X       SSI,SSR,SZI,SZR,A11I,A11R,A12I,A12R,A22I,A22R,EPSB
      LOGICAL ACCUMQ,ACCUMZ
C
C     THIS SUBROUTINE  ACCEPTS A PAIR OF REAL  MATRICES, ONE OF  THEM IN
C     QUASI-TRIANGULAR  FORM AND THE OTHER IN UPPER TRIANGULAR FORM.  IT
C     REDUCES THE QUASI-TRIANGULAR MATRIX FURTHER, SO THAT ANY REMAINING
C     2-BY-2 BLOCKS CORRESPOND TO PAIRS OF COMPLEX  EIGENVALUES, AND RE-
C     TURNS  QUANTITIES WHOSE RATIOS  GIVE THE GENERALIZED  EIGENVALUES.
C     IT OPTIONALLY UPDATES  ACCUMULATED LEFT AND RIGHT -HAND
C     TRANSFORMATIONS IN  Q  AND  Z (SEE THE DESCRIPTION OF  JOB).
C
C     THIS SUBROUTINE IS A MODIFIED VERSION OF THE EISPACK SUBROUTINE
C     QZVAL, THE THIRD STEP OF THE QZ ALGORITHM FOR SOLVING GENERALIZED
C     MATRIX EIGENVALUE PROBLEMS.   IT IS USUALLY PRECEDED BY  QZHESG
C     AND  QZITG  AND MAY BE FOLLOWED BY  QZVEC.
C
C     REF: MOLER AND STEWART, SIAM J. NUMER. ANAL. 10, 241-256(1973).
C          GARBOW, BOYLE, DONGARRA, AND MOLER, MATRIX EIGENSYSTEM
C            ROUTINES -- EISPACK GUIDE EXTENSION, 1977.
C
C     ON ENTRY -
C       NAB     INTEGER
C               LEADING DIMENSION OF  A  AND  B  AS DECLARED IN MAIN
C               PROGRAM
C
C       NQZ     INTEGER
C               LEADING DIMENSION OF  Q  AND  Z  AS DECLARED IN MAIN
C               PROGRAM
C
C       N       INTEGER
C               ORDER OF THE MATRICES  A  AND  B.
C
C       A       DOUBLE PRECISION (NAB,N)
C               N BY N REAL UPPER-QUASI-TRIANGULAR MATRIX
C
C       B       DOUBLE PRECISION (NAB,N)
C               N BY N REAL UPPER-TRIANGULAR MATRIX.  IN ADDITION,
C               LOCATION  B(N,1)  CONTAINS THE TOLERANCE QUANTITY (EPSB)
C               COMPUTED AND SAVED IN  QZITG.
C
C       Q       DOUBLE PRECISION (NQZ,N)
C               N BY N MATRIX AS COMPUTED BY  QZHESG  AND  QZITG. Q  MAY
C               NOT BE REFERENCED IF SO INDICATED BY  JOB (SEE BELOW).
C
C       Z       DOUBLE PRECISION (NQZ,N)
C               N BY N MATRIX AS COMPUTED BY  QZHESG  AND QZITG.  Z  MAY
C               NOT BE REFERENCED IS SO INDICATED BY  JOB (SEE BELOW).
C
C       JOB     INTEGER
C               INTEGER IN DECIMAL FORM  ABCDE  INICATING THE FOLLOWING:
C                  A,B,C      (NOT REFERENCED, SHOULD BE 0)
C                  D .EQ. 0   DON'T ACCUMULATE LEFT ORTHOGONAL TRANSFOR-
C                             MATIONS IN  Q.  Q  IS NOT REFERENCED.
C                  D .GE. 1   RIGHT MULTIPLY  Q  BY THE TRANSPOSE OF THE
C                             LEFT TRANSFORMATIONS PERFORMED ON  A AND B
C                  E .EQ. 0   DON'T ACCUMULATE RIGHT ORTHOGONAL TRANS-
C                             FORMATIONS IN  Z.  Z  IS NOT REFERENCED.
C                  E .GE. 1   RIGHT MULTIPLY  Z  BY THE RIGHT TRANSFOR-
C                             MATIONS PERFORMED ON  A  AND  B.
C
C     ON RETURN -
C       A       DOUBLE PRECISION (NAB,N)
C               N BY N QUASI-TRIANGULAR MATRIX IN WHICH ALL NONZERO
C               SUBDIAGONAL ELEMENTS CORRESPOND TO PAIRS OF COMPLEX
C               EIGENVALUES
C
C       B       DOUBLE PRECISION (NAB,N)
C               N BY N UPPER TRIANGULAR MATRIX WHOSE ELEMENTS HAVE BEEN
C               ALTERED.  B(N,1)  IS UNALTERED.
C
C       Q       DOUBLE PRECISION (NAB,N)
C               N BY N MATRIX WITH ACCUMULATED LEFT TRANSFORMATIONS.
C
C       Z       DOUBLE PRECISION (NAB,N)
C               CONTAINS THE ACCUMULATED RIGHT HAND TRANSFORMATIONS.
C
C       ALFR,ALFI       DOUBLE PRECISION (N)
C               REAL AND IMAGINARY PARTS OF THE DIAGONAL ELEMENTS OF THE
C               TRIANGULAR MATRIX THAT WOULD BE OBTAINED IF  A  WERE RE-
C               DUCED COMPLETELY TO TRIANGULAR FORM BY UNITARY TRANFOR-
C               MATIONS.  NON-ZERO VALUES OF ALFI OCCUR IN PAIRS, THE
C               FIRST MEMBER POSITIVE AND THE SECOND NEGATIVE.
C
C       BETA    DOUBLE PRECISION (N)
C               CONTAINS THE DIAGONAL ELEMENTS OF THE CORRESPONDING  B,
C               NORMALIZED TO BE REAL AND NON-NEGATIVE.  THE GENERALIZED
C               EIGENVALUES ARE THEN THE RATIOS  ((ALFR+I*ALFI)/BETA).
C
C     MODIFIED -
C       18FEB87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-3616
C       THIS IS A MODIFIED VERSION OF THE EISPACK ROUTINE QZVAL.
C     ------------------------------------------------------------------
C
      ACCUMQ = (MOD(JOB/10,10) .GE. 1)
      ACCUMZ = (MOD(JOB,10) .GE. 1)
C
      EPSB = B(N,1)
      ISW = 1
C     .......... FIND EIGENVALUES OF QUASI-TRIANGULAR MATRICES.
C                FOR EN=N STEP -1 UNTIL 1 DO -- ..........
      DO 290 NN = 1, N
         EN = N + 1 - NN
         NA = EN - 1
         IF (ISW .EQ. 2) GO TO 280
         IF (EN .EQ. 1) GO TO 10
         IF (A(EN,NA) .NE. 0.0D0) GO TO 20
C     .......... 1-BY-1 BLOCK, ONE REAL ROOT ..........
   10    ALFR(EN) = A(EN,EN)
         IF (B(EN,EN) .LT. 0.0D0) ALFR(EN) = -ALFR(EN)
         BETA(EN) = ABS(B(EN,EN))
         ALFI(EN) = 0.0D0
         GO TO 290
C     .......... 2-BY-2 BLOCK ..........
   20    IF (ABS(B(NA,NA)) .LE. EPSB) GO TO 110
         IF (ABS(B(EN,EN)) .GT. EPSB) GO TO 30
         A1 = A(EN,EN)
         A2 = A(EN,NA)
         BN = 0.0D0
         GO TO 60
   30    AN = ABS(A(NA,NA)) + ABS(A(NA,EN)) + ABS(A(EN,NA))
     X      + ABS(A(EN,EN))
         BN = ABS(B(NA,NA)) + ABS(B(NA,EN)) + ABS(B(EN,EN))
         A11 = A(NA,NA) / AN
         A12 = A(NA,EN) / AN
         A21 = A(EN,NA) / AN
         A22 = A(EN,EN) / AN
         B11 = B(NA,NA) / BN
         B12 = B(NA,EN) / BN
         B22 = B(EN,EN) / BN
         E = A11 / B11
         EI = A22 / B22
         S = A21 / (B11 * B22)
         T = (A22 - E * B22) / B22
         IF (ABS(E) .LE. ABS(EI)) GO TO 40
         E = EI
         T = (A11 - E * B11) / B11
   40    C = 0.5D0 * (T - S * B12)
         D = C * C + S * (A12 - E * B12)
         IF (D .LT. 0.0D0) GO TO 170
C     .......... TWO REAL ROOTS.
C                ZERO BOTH A(EN,NA) AND B(EN,NA) ..........
         E = E + (C + SIGN(SQRT(D),C))
         A11 = A11 - E * B11
         A12 = A12 - E * B12
         A22 = A22 - E * B22
         IF (ABS(A11) + ABS(A12) .LT.
     X       ABS(A21) + ABS(A22)) GO TO 50
         A1 = A12
         A2 = A11
         GO TO 60
   50    A1 = A22
         A2 = A21
C     .......... CHOOSE AND APPLY REAL Z ..........
   60    S = ABS(A1) + ABS(A2)
         U1 = A1 / S
         U2 = A2 / S
         R = SIGN(SQRT(U1*U1+U2*U2),U1)
         V1 = -(U1 + R) / R
         V2 = -U2 / R
         U2 = V2 / V1
C
         DO 70 I = 1, EN
            T = A(I,EN) + U2 * A(I,NA)
            A(I,EN) = A(I,EN) + T * V1
            A(I,NA) = A(I,NA) + T * V2
            T = B(I,EN) + U2 * B(I,NA)
            B(I,EN) = B(I,EN) + T * V1
            B(I,NA) = B(I,NA) + T * V2
   70    CONTINUE
C
         IF (.NOT.ACCUMZ) GOTO 90
            DO 80 I = 1, N
               T = Z(I,EN) + U2 * Z(I,NA)
               Z(I,EN) = Z(I,EN) + T * V1
               Z(I,NA) = Z(I,NA) + T * V2
   80       CONTINUE
   90    CONTINUE
C
         IF (BN .EQ. 0.0D0) GO TO 160
         IF (AN .LT. ABS(E) * BN) GO TO 110
         A1 = B(NA,NA)
         A2 = B(EN,NA)
         GO TO 120
  110    A1 = A(NA,NA)
         A2 = A(EN,NA)
C     .......... CHOOSE AND APPLY REAL Q ..........
  120    S = ABS(A1) + ABS(A2)
         IF (S .EQ. 0.0D0) GO TO 160
         U1 = A1 / S
         U2 = A2 / S
         R = SIGN(SQRT(U1*U1+U2*U2),U1)
         V1 = -(U1 + R) / R
         V2 = -U2 / R
         U2 = V2 / V1
C
         DO 130 J = NA, N
            T = A(NA,J) + U2 * A(EN,J)
            A(NA,J) = A(NA,J) + T * V1
            A(EN,J) = A(EN,J) + T * V2
            T = B(NA,J) + U2 * B(EN,J)
            B(NA,J) = B(NA,J) + T * V1
            B(EN,J) = B(EN,J) + T * V2
  130    CONTINUE
C
         IF (.NOT.ACCUMQ) GOTO 150
            DO 140 I = 1, N
               T = Q(I,NA) + U2 * Q(I,EN)
               Q(I,NA) = Q(I,NA) + T * V1
               Q(I,EN) = Q(I,EN) + T * V2
  140       CONTINUE
  150    CONTINUE
C
  160    A(EN,NA) = 0.0D0
         B(EN,NA) = 0.0D0
         ALFR(NA) = A(NA,NA)
         ALFR(EN) = A(EN,EN)
         IF (B(NA,NA) .LT. 0.0D0) ALFR(NA) = -ALFR(NA)
         IF (B(EN,EN) .LT. 0.0D0) ALFR(EN) = -ALFR(EN)
         BETA(NA) = ABS(B(NA,NA))
         BETA(EN) = ABS(B(EN,EN))
         ALFI(EN) = 0.0D0
         ALFI(NA) = 0.0D0
         GO TO 280
C     .......... TWO COMPLEX ROOTS ..........
  170    E = E + C
         EI = SQRT(-D)
         A11R = A11 - E * B11
         A11I = EI * B11
         A12R = A12 - E * B12
         A12I = EI * B12
         A22R = A22 - E * B22
         A22I = EI * B22
         IF (ABS(A11R) + ABS(A11I) + ABS(A12R) + ABS(A12I) .LT.
     X       ABS(A21) + ABS(A22R) + ABS(A22I)) GO TO 180
         A1 = A12R
         A1I = A12I
         A2 = -A11R
         A2I = -A11I
         GO TO 190
  180    A1 = A22R
         A1I = A22I
         A2 = -A21
         A2I = 0.0D0
C     .......... CHOOSE COMPLEX Z ..........
  190    CZ = SQRT(A1*A1+A1I*A1I)
         IF (CZ .EQ. 0.0D0) GO TO 200
         SZR = (A1 * A2 + A1I * A2I) / CZ
         SZI = (A1 * A2I - A1I * A2) / CZ
         R = SQRT(CZ*CZ+SZR*SZR+SZI*SZI)
         CZ = CZ / R
         SZR = SZR / R
         SZI = SZI / R
         GO TO 210
  200    SZR = 1.0D0
         SZI = 0.0D0
  210    IF (AN .LT. (ABS(E) + EI) * BN) GO TO 220
         A1 = CZ * B11 + SZR * B12
         A1I = SZI * B12
         A2 = SZR * B22
         A2I = SZI * B22
         GO TO 230
  220    A1 = CZ * A11 + SZR * A12
         A1I = SZI * A12
         A2 = CZ * A21 + SZR * A22
         A2I = SZI * A22
C     .......... CHOOSE COMPLEX Q ..........
  230    CQ = SQRT(A1*A1+A1I*A1I)
         IF (CQ .EQ. 0.0D0) GO TO 240
         SQR = (A1 * A2 + A1I * A2I) / CQ
         SQI = (A1 * A2I - A1I * A2) / CQ
         R = SQRT(CQ*CQ+SQR*SQR+SQI*SQI)
         CQ = CQ / R
         SQR = SQR / R
         SQI = SQI / R
         GO TO 250
  240    SQR = 1.0D0
         SQI = 0.0D0
C     .......... COMPUTE DIAGONAL ELEMENTS THAT WOULD RESULT
C                IF TRANSFORMATIONS WERE APPLIED ..........
  250    SSR = SQR * SZR + SQI * SZI
         SSI = SQR * SZI - SQI * SZR
         I = 1
         TR = CQ * CZ * A11 + CQ * SZR * A12 + SQR * CZ * A21
     X      + SSR * A22
         TI = CQ * SZI * A12 - SQI * CZ * A21 + SSI * A22
         DR = CQ * CZ * B11 + CQ * SZR * B12 + SSR * B22
         DI = CQ * SZI * B12 + SSI * B22
         GO TO 270
  260    I = 2
         TR = SSR * A11 - SQR * CZ * A12 - CQ * SZR * A21
     X      + CQ * CZ * A22
         TI = -SSI * A11 - SQI * CZ * A12 + CQ * SZI * A21
         DR = SSR * B11 - SQR * CZ * B12 + CQ * CZ * B22
         DI = -SSI * B11 - SQI * CZ * B12
  270    T = TI * DR - TR * DI
         J = NA
         IF (T .LT. 0.0D0) J = EN
         R = SQRT(DR*DR+DI*DI)
         BETA(J) = BN * R
         ALFR(J) = AN * (TR * DR + TI * DI) / R
         ALFI(J) = AN * T / R
         IF (I .EQ. 1) GO TO 260
  280    ISW = 3 - ISW
  290 CONTINUE
      B(N,1) = EPSB
C
      RETURN
C --- LAST LINE OF QZVAL ---
      END
      SUBROUTINE SEPG(NPS, NRT, NW, M, N, P, R, S, T, WKV, WKM, IWKV,
     *                RSEP)
C
      INTEGER NPS, NRT, NW, M, N, IWKV(2*M)
      DOUBLE PRECISION P(NPS,M), R(NRT,N), S(NPS,M), T(NRT,N), 
     *    WKV(2*M*M + 7*M), WKM(NW,N), RSEP
C
C     THIS SUBROUTINE ESTIMATES
C
C       INF ( 1-NORM(P*Y*R' + S*Y*T') / 1-NORM(Y) )
C
C     WHERE P, R, S, AND T HAVE THE SPECIAL STRUCTURE INDICATED BELOW.
C     THIS QUANTITY IS USED IN CONDITION ESTIMATION.
C
C     ON ENTRY -
C       NPS     INTEGER
C               LEADING DIMENSION OF  P  AND  S  AS DECLARED IN MAIN
C               CALLING PROGRAM
C
C       NRT     INTEGER
C               LEADING DIMENSION OF  R  AND  T  AS DECLARED IN MAIN
C               CALLING PROGRAM
C
C       NW      INTEGER
C               LEADING DIMENSION OF  WKM  AS DECLARED IN MAIN CALLING
C               PROGRAM
C
C       M,N     INTEGER
C               ORDER OF THE MATRICES AS INDICATED BELOW.  CURRENTLY  M
C               MUST BE GREATER THAN  N.
C
C       P       DOUBLE PRECISION (NPS,M)
C               M BY M UPPER-HESSENBERG MATRIX
C
C       R       DOUBLE PRECISION (NRT,N)
C               N BY N UPPER-TRIANGULAR MATRIX
C
C       S       DOUBLE PRECISION (NPS,M)
C               M BY M UPPER-TRIANGULAR MATRIX
C
C       T       DOUBLE PRECISION (NRT,N)
C               N BY N QUASI-UPPER-TRIANGULAR MATRIX
C
C     ON RETURN -
C       RSEP    DOUBLE PRECISION
C               AN APPROXIMATION TO THE RECIPROCAL OF THE INFIMUM
C               EXPRESSED ABOVE.  RSEP = 0.0 INDICATES THAT THE INFIMUM
C               COULD NOT BE CALCULATED.
C
C     WORKSPACE -
C       WKM     DOUBLE PRECISION (NW,N)
C               MAX M BY N MATRIX
C
C       WKV     DOUBLE PRECISION (2*M*M + 7*M)
C               WORK VECTOR
C
C       IWKV    INTEGER (2*M)
C               WORK VECTOR
C
C     SUBROUTINES AND FUNCTIONS USED -
C       (RICPACK) D1NRM; (MATU) MSCALE; BKHS2, KTRAN
C
C     WRITTEN -
C       18FEB87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-3616
C     REVISED -
C       27JAN89 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
      INTEGER JOB, I, J, II, JJ, IERR
      DOUBLE PRECISION TMP, D1NRM
C
C     -- SET F TO ZERO --
      DO 20 J = 1,N
         DO 10 I = 1,M
            WKM(I,J) = 0.0D0
   10    CONTINUE
   20 CONTINUE
C
C     -- COMPUTE APPROXIMATE NULL MATRIX --
      JOB = 1
      CALL BKHS2(NPS,NRT,NW,M,N,P,R,S,T,WKM,WKV,IWKV,JOB,IERR)
      IF (IERR .NE. 0) THEN
         RSEP = 0.0D0
         RETURN
      ENDIF
C
C     -- COMPUTE NORM AND SCALE --
      TMP = D1NRM(NW, M, N, WKM)
      CALL MSCALE(NW, M, N, 1.0D0/TMP, WKM)
C
C     -- TRANSFORM TO ADJOINT SYSTEM --
      CALL KTRAN(NPS, M, P)
      CALL KTRAN(NRT, N, R)
      CALL KTRAN(NPS, M, S)
      CALL KTRAN(NRT, N, T)
      DO 40 J = 1,(N+1)/2
         DO 30 I = 1,(M+1)/2
            II = M+1-I
            JJ = N+1-J
            TMP = WKM(I,J)
            WKM(I,J) = WKM(II,JJ)
            WKM(II,JJ) = TMP
            IF (I .NE. II  .AND.  J .NE. JJ) THEN
               TMP = WKM(II,J)
               WKM(II,J) = WKM(I,JJ)
               WKM(I,JJ) = TMP
            ENDIF
   30    CONTINUE
   40 CONTINUE
C
C     -- SOLVE FOR TRANSPOSED SYSTEM --
      JOB = 0
      CALL BKHS2(NPS,NRT,NW,M,N,P,R,S,T,WKM,WKV,IWKV,JOB,IERR)
      IF (IERR .NE. 0) THEN
         RSEP = 0.0D0
         RETURN
      ENDIF
C
C     -- COMPUTE SEP --
      RSEP = D1NRM(NW,M,N,WKM)
C
C     -- TRANSFORM BACK TO ORIGINAL SYSTEM
      CALL KTRAN(NPS, M, P)
      CALL KTRAN(NRT, N, R)
      CALL KTRAN(NPS, M, S)
      CALL KTRAN(NRT, N, T)
C
      RETURN
C --- LAST LINE OF SEPG ---
      END
      SUBROUTINE SEPGC(NST, NW, N, S, T, WKM, RSEP)
C
      INTEGER NST, NW, N
      DOUBLE PRECISION S(NST,N), T(NST,N), WKM(NW,N), RSEP
C
C     THIS SUBROUTINE ESTIMATES
C
C       INF ( 1-NORM(S*Y*T' + S*Y*T') / 1-NORM(Y) )
C
C     WHERE  S  AND T HAVE THE SPECIAL STRUCTURE INDICATED BELOW AND  Y
C     IS SYMMETRIC.  THIS QUANTITY IS USED FOR CONDITION ESTIMATION.
C
C     ON ENTRY -
C       NST     INTEGER
C               LEADING DIMENSION OF  P  AND  S  AS DECLARED IN MAIN
C               CALLING PROGRAM
C
C       NW      INTEGER
C               LEADING DIMENSION OF  WKM  AS DECLARED IN MAIN CALLING
C               PROGRAM
C
C       N       INTEGER
C               ORDER OF THE MATRICES AS INDICATED BELOW.
C
C       S       DOUBLE PRECISION (NST,N)
C               N BY N QUASI-UPPER-TRIANGULAR MATRIX
C
C       T       DOUBLE PRECISION (NST,N)
C               N BY N UPPER-TRIANGULAR MATRIX
C
C     ON RETURN -
C       RSEP    DOUBLE PRECISION
C               AN APPROXIMATION TO THE RECIPROCAL OF THE INFIMUM
C               EXPRESSED ABOVE.  RSEP = 0.0 INDICATES THAT THE INFIMUM
C               COULD NOT BE CALCULATED.
C
C     WORKSPACE -
C       WKM     DOUBLE PRECISION (NW,N)
C               N BY N MATRIX
C
C     SUBROUTINES AND FUNCTIONS USED -
C       BKCON D1NRM MSCALE KTRAN
C
C     WRITTEN -
C       05MAR87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-3616
C     MODIFIED -
C       26JAN89 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
      INTEGER JOB, I, J, II, JJ, IERR
      DOUBLE PRECISION TMP, D1NRM
C
C     -- SET R TO ZERO --
      DO 20 J = 1,N
         DO 10 I = 1,N
            WKM(I,J) = 0.0D0
   10    CONTINUE
   20 CONTINUE
C
C     -- COMPUTE APPROXIMATE NULL MATRIX --
      JOB = 1
      CALL BKCON(NST,NW,N,S,T,WKM,JOB,IERR)
      IF (IERR .NE. 0) THEN
         RSEP = 0.0D0
         RETURN
      ENDIF
C
C     -- COMPUTE NORM AND SCALE --
      TMP = D1NRM(NW, N, N, WKM)
      CALL MSCALE(NW, N, N, 1.0D0/TMP, WKM)
C
C     -- TRANSFORM TO ADJOINT SYSTEM --
      CALL KTRAN(NST, N, S)
      CALL KTRAN(NST, N, T)
      DO 40 J = 1,(N+1)/2
         DO 30 I = 1,(N+1)/2
            II = N+1-I
            JJ = N+1-J
            TMP = WKM(I,J)
            WKM(I,J) = WKM(II,JJ)
            WKM(II,JJ) = TMP
            IF (I .NE. II  .AND.  J .NE. JJ) THEN
               TMP = WKM(II,J)
               WKM(II,J) = WKM(I,JJ)
               WKM(I,JJ) = TMP
            ENDIF
   30    CONTINUE
   40 CONTINUE
C
C     -- SOLVE FOR TRANSPOSED SYSTEM --
      JOB = 0
      CALL BKCON(NST,NW,N,S,T,WKM,JOB,IERR)
      IF (IERR .NE. 0) THEN
         RSEP = 0.0D0
         RETURN
      ENDIF
C
C     -- COMPUTE SEP --
      RSEP = D1NRM(NW,N,N,WKM)
C
C     -- TRANSFORM BACK TO ORIGINAL SYSTEM
      CALL KTRAN(NST, N, S)
      CALL KTRAN(NST, N, T)
C
      RETURN
C --- LAST LINE OF SEPGC ---
      END
      SUBROUTINE SEPGD(NST, NW, N, S, T, WKM, RSEP)
C
      INTEGER NST, NW, N
      DOUBLE PRECISION S(NST,N), T(NST,N), WKM(NW,N), RSEP
C
C     THIS SUBROUTINE ESTIMATES
C
C       INF ( 1-NORM(S*Y*S' - T*Y*T') / 1-NORM(Y) )
C
C     WHERE  S  AND T HAVE THE SPECIAL STRUCTURE INDICATED BELOW AND  Y
C     IS SYMMETRIC.  THIS QUANTITY IS USED FOR CONDITION ESTIMATION.
C
C     ON ENTRY -
C       NST     INTEGER
C               LEADING DIMENSION OF  P  AND  S  AS DECLARED IN MAIN
C               CALLING PROGRAM
C
C       NW      INTEGER
C               LEADING DIMENSION OF  WKM  AS DECLARED IN MAIN CALLING
C               PROGRAM
C
C       N       INTEGER
C               ORDER OF THE MATRICES AS INDICATED BELOW.
C
C       S       DOUBLE PRECISION (NST,N)
C               N BY N QUASI-UPPER-TRIANGULAR MATRIX
C
C       T       DOUBLE PRECISION (NST,N)
C               N BY N UPPER-TRIANGULAR MATRIX
C
C     ON RETURN -
C       RSEP    DOUBLE PRECISION
C               AN APPROXIMATION TO THE RECIPROCAL OF THE INFIMUM
C               EXPRESSED ABOVE.  RSEP = 0.0 INDICATES THAT THE INFIMUM
C               COULD NOT BE CALCULATED.
C
C     WORKSPACE -
C       WKM     DOUBLE PRECISION (NW,N)
C               N BY N MATRIX
C
C     SUBROUTINES AND FUNCTIONS USED -
C       BKDIS D1NRM MSCALE KTRAN
C
C     WRITTEN -
C       05MAR87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-3616
C     MODIFIED -
C       26JAN89 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
      INTEGER JOB, I, J, II, JJ, IERR
      DOUBLE PRECISION TMP, D1NRM
C
C     -- SET R TO ZERO --
      DO 20 J = 1,N
         DO 10 I = 1,N
            WKM(I,J) = 0.0D0
   10    CONTINUE
   20 CONTINUE
C
C     -- COMPUTE APPROXIMATE NULL MATRIX --
      JOB = 1
      CALL BKDIS(NST,NW,N,S,T,WKM,JOB,IERR)
      IF (IERR .NE. 0) THEN
         RSEP = 0.0D0
         RETURN
      ENDIF
C
C     -- COMPUTE NORM AND SCALE --
      TMP = D1NRM(NW, N, N, WKM)
      CALL MSCALE(NW, N, N, 1.0D0/TMP, WKM)
C
C     -- TRANSFORM TO ADJOINT SYSTEM --
      CALL KTRAN(NST, N, S)
      CALL KTRAN(NST, N, T)
      DO 40 J = 1,(N+1)/2
         DO 30 I = 1,(N+1)/2
            II = N+1-I
            JJ = N+1-J
            TMP = WKM(I,J)
            WKM(I,J) = WKM(II,JJ)
            WKM(II,JJ) = TMP
            IF (I .NE. II  .AND.  J .NE. JJ) THEN
               TMP = WKM(II,J)
               WKM(II,J) = WKM(I,JJ)
               WKM(I,JJ) = TMP
            ENDIF
   30    CONTINUE
   40 CONTINUE
C
C     -- SOLVE FOR TRANSPOSED SYSTEM --
      JOB = 0
      CALL BKDIS(NST,NW,N,S,T,WKM,JOB,IERR)
      IF (IERR .NE. 0) THEN
         RSEP = 0.0D0
         RETURN
      ENDIF
C
C     -- COMPUTE SEP --
      RSEP = D1NRM(NW,N,N,WKM)
C
C     -- TRANSFORM BACK TO ORIGINAL SYSTEM
      CALL KTRAN(NST, N, S)
      CALL KTRAN(NST, N, T)
C
      RETURN
C --- LAST LINE OF SEPGD ---
      END
      SUBROUTINE SYLG(NAC, NBD, NE, M, N, A, B, C, D, E, WKV, IWKV,
     *                IERR, RCOND)
C
      INTEGER NAC,NBD,NE,M,N,IWKV(2*M),IERR
      DOUBLE PRECISION A(NAC,M),B(NBD,N),C(NAC,M),D(NBD,N),E(NE,N),
     *                 WKV(*),RCOND
C
C     THIS PROGRAM SOLVES THE GENERAL SYLVESTER MATRIX EQUATION
C
C        A * X * B'  +  C * X * D'  =  E    (' DENOTES TRANSPOSE)
C
C     WHERE  A  AND  C  ARE M-BY-M, B  AND  D  ARE N-BY-N, AND  E AND X
C     ARE M-BY-N.   THE UNKNOWN IS  X.  THE  ALGORITHM IS A HESSENBERG-
C     SCHUR ORTHOGONAL TRANSFORMATION METHOD .
C
C     THE CONDITION NUMBER OF THE EQUATION MAY BE COMPUTED AS AN OPTION.
C
C     FOR EFFICIENCY, M SHOULD BE GREATER THAN OR EQUAL TO N.  IF IT IS
C     NOT, SYLG CAN BE APPLIED TO THE TRANSPOSED PROBLEM INSTEAD.
C
C     REFS: G.H. GOLUB, S. NASH AND C. VAN LOAN, IEEE TRANS. AUTO. CONT.
C           VOL. AC-24, NO. 6, PP. 909-913, 1979.
C
C-----------------------------------------------------------------------
C
C     ON ENTRY -
C       NAC     INTEGER
C               LEADING DIMENSION IN CALLING PROGRAM'S DECLARATION OF  A
C               AND  C
C
C       NBD     INTEGER
C               LEADING DIMENSION IN CALLING PROGRAM'S DECLARATION OF  B
C               AND  D.
C
C       NE      INTEGER
C               LEADING DIMENSION IN CALLING PROGRAM'S DECLARATION OF  E
C
C       M,N     INTEGER
C               ACTUAL DIMENSIONS AS INDICATED BELOW
C
C       A,C     DOUBLE PRECISION (NAC,M)
C               M BY M MATRICES
C
C       B,D     DOUBLE PRECISION (NBD,N)
C               N BY N MATRICES
C
C       E       DOUBLE PRECISION (NE,N)
C               M BY N MATRIX
C
C       IERR    INTEGER
C               FLAG INDICATING WHETHER OR NOT THE CONDITION NUMBER
C               OF THE EQUATION IS TO BE ESTIMATED.  IF IERR = 0
C               RCOND IS NOT COMPUTED, OTHERWISE IT IS.
C
C     ON RETURN -
C       A,B,C,D MODIFIED
C
C       E       DOUBLE PRECISION (LDE,N)
C               CONTAINS M BY N SOLUTION MATRIX  X
C
C       IERR    INTEGER
C               0 == NORMAL RETURN
C               1 == QZ ITERATION FAILED, NO SOLUTION OBTAINED
C               2 == BACK SUBSTITUTION FAILED, NO SOLUTION OBTAINED
C               3 == COMPUTATION OF RCOND INDICATES THE EQUATION IS
C                    SINGULAR.  NO SOLUTION ATTEMPTED.
C
C       RCOND   DOUBLE PRECISION
C               AN ESTIMATE OF THE RECIPROCAL OF THE CONDITION NUMBER
C               OF THE SYLVESTER EQUATION.
C
C     WORKSPACE -
C       WKV     DOUBLE PRECISION (2*M*M + N*N + M*N + 7*M + K*K),
C               K=MAX(M,N); LENGTH MAY BE REDUCED BY M*N IF CONDITION
C               ESTIMATION IS NOT REQUESTED (IERR=0 ON ENTRY).
C               WORK VECTOR
C
C       IWKV    INTEGER(2*M)
C               WORK VECTOR OF PIVOT ELEMENTS
C
C     WRITTEN -
C       J. AMATO, APRIL 1984.
C     REVISED -
C       18FEB87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-3616
C       28NOV88 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C       11DEC90 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C
C     SUBROUTINES AND FUNCTIONS CALLED -
C        QZHESG, QZITG, QZVALG - MODIFIED EISPACK ROUTINES
C        BKHS2 - PERFORMS THE BACK SUBSTITUTION STEP
C        SEPG - COMPUTES THE RECIPROCAL OF SEP FOR CONDITION ESTIMATION
C        MULA, MULB, TRNATA - MATRIX UTILITIES
C
C     INTERNAL VARIABLES
C
      INTEGER I,J,K,ICHK,INDXZ1,INDXZ2,INDXT,INDXT0,INDXQ,INDXE,IJQ
      DOUBLE PRECISION EPS1,TMP1,TMP2,RSEP,NRMA,NRMB,NRMC,NRMD
      LOGICAL CNDEST
C
C-----------------------------------------------------------------------
C
C     -- EPS USED BY QZITG --
      EPS1 = 0.0D0
C
C     -- CHECK FOR CONDITION ESTIMATE REQUESTED
      IF (IERR .NE. 0) THEN
         CNDEST = .TRUE.
         IERR = 0
      ELSE
         CNDEST = .FALSE.
      ENDIF
C
C     -- FIND ORTHOGONAL Q1,Z1 SUCH THAT Q1'*A*Z1 IS UPPER-HESSENBERG
C        AND Q1'*C*Z1 IS UPPER-TRIANGULAR.  UPDATE  E  TO  Q1'*E. --
      INDXZ1 = 1
      INDXZ2 = INDXZ1 + M*M
      INDXT = INDXZ2 + N*N
      INDXT0 = INDXT - 1
      INDXQ = INDXT + MAX(M,N) + N + N
      CALL QZHESG(NAC,M,M,A,C,WKV(INDXQ),WKV(INDXZ1),1,M,22)
C     -- UPDATE E --
      DO 50 J = 1,N
         DO 10 I = 1,M
            WKV(INDXT0+I) = 0.0D0
   10    CONTINUE
         IJQ = 0
         DO 30 I = 1,M
            DO 20 K = 1,M
               WKV(INDXT0+I) = WKV(INDXT0+I) + WKV(INDXQ+IJQ)*E(K,J)
               IJQ = IJQ + 1
   20       CONTINUE
   30    CONTINUE
         DO 40 I = 1,M
            E(I,J) = WKV(INDXT0+I)
   40    CONTINUE
   50 CONTINUE
C
C     -- FIND ORTHOGONAL Q2,Z2 SUCH THAT Q2'*D*Z2 IS QUASI-UPPER-TRIAN-
C        GULAR AND Q2'*B*Z2 IS UPPER-TRIANGULAR.  UPDATE  E  TO E*Q2 --
      CALL QZHESG(NBD,N,N,D,B,WKV(INDXQ),WKV(INDXZ2),1,N,22)
      CALL QZITG(NBD,N,N,D,B,WKV(INDXQ),WKV(INDXZ2),1,N,EPS1,22,IERR)
      IF (IERR .NE. 0) THEN
         IERR = 1
         RETURN
      ENDIF
      CALL QZVALG(NBD,N,N,D,B,WKV(INDXQ),WKV(INDXZ2),WKV(INDXT),
     *            WKV(INDXT+N),WKV(INDXT+N+N),22)
C     -- UPDATE  E --
      DO 130 I = 1,M
         DO 90 J = 1,N
            WKV(INDXT0+J) = 0.0D0
   90    CONTINUE
         IJQ = 0
         DO 110 J = 1,N
            DO 100 K = 1,N
               WKV(INDXT0+J) = WKV(INDXT0+J) + E(I,K)*WKV(INDXQ+IJQ)
               IJQ = IJQ + 1
  100       CONTINUE
  110    CONTINUE
         DO 120 J = 1,N
            E(I,J) = WKV(INDXT0+J)
  120    CONTINUE
  130 CONTINUE
C
C     WE NOW HAVE REDUCED THE EQUATION TO THE FORM
C          P * Y * R' + S * Y * T' = F
C
C     WHERE    P  =  Q1'* A * Z1    (UPPER-HESSENBERG)
C              S  =  Q1'* C * Z1    (UPPER-TRIANGULAR)
C              T  =  Q2'* D * Z2    (QUASI-UPPER TRIANGULAR)
C              R  =  Q2'* B * Z2    (UPPER-TRIANGULAR)
C              F  =  Q1'* E * Q2
C              Y  =  Z1'* X * Z2
C
C     -- ESTIMATE CONDITION NUMBER, IF REQUESTED
      IF (CNDEST) THEN
         INDXE = INDXT + 2*M*M + 7*M
         CALL SEPG (NAC,NBD,M,M,N,A,B,C,D,WKV(INDXT),WKV(INDXE),IWKV,
     *              RSEP)
         NRMA = 0.0D0
         NRMC = 0.0D0
         DO 170 J=1,M
            TMP1 = 0.0D0
            TMP2 = 0.0D0
            DO 160 I=1,J
               TMP1 = TMP1 + ABS(A(I,J))
               TMP2 = TMP2 + ABS(C(I,J))
  160       CONTINUE
            IF (J .NE. M) TMP1 = TMP1 + ABS(A(J+1,J))
            IF (TMP1 .GT. NRMA) NRMA = TMP1
            IF (TMP2 .GT. NRMC) NRMC = TMP2
  170    CONTINUE
         NRMB = 0.0D0
         NRMD = 0.0D0
         DO 190 J=1,N
            TMP1 = 0.0D0
            TMP2 = 0.0D0
            DO 180 I=1,J
               TMP1 = TMP1 + ABS(B(J,I))
               TMP2 = TMP2 + ABS(D(J,I))
  180       CONTINUE
            IF (J .NE. N) TMP2 = TMP2 + ABS(D(J,J+1))
            IF (TMP1 .GT. NRMB) NRMB = TMP1
            IF (TMP2 .GT. NRMD) NRMD = TMP2
  190    CONTINUE
C
         RCOND = NRMA * NRMB + NRMC * NRMD
         IF (RCOND .NE. 0.0D0) RCOND = 1.0D0 / (RSEP * RCOND)
         IF (1.0D0 + RCOND  .EQ.  1.0D0) THEN
            IERR = 3
            RETURN
         ENDIF
      ENDIF
C
C     -- BACK-SUBSTITUTE AND SOLVE FOR  Y --
      CALL BKHS2(NAC,NBD,NE,M,N,A,B,C,D,E,WKV(INDXT),IWKV,0,ICHK)
      IF (ICHK .NE. 0) THEN
         IERR = 2
         RETURN
      ENDIF
C
C     -- CALCULATE  X  =  Z1 * Y * Z2'.  Z1 * Y FIRST --
      CALL MULB(M,NE,M,M,N,WKV(INDXZ1),E,WKV(INDXT))
      CALL TRNATA(N,N,WKV(INDXZ2))
      CALL MULA(NE,N,M,N,N,E,WKV(INDXZ2),WKV(INDXT))
C
      RETURN
C
C --- LAST LINE OF SYLG ---
      END
      SUBROUTINE SYLGC(NAE, NC, N, A, E, C, WKV, IERR, RCOND)
C
      INTEGER NAE,NC,N,IERR
      DOUBLE PRECISION A(NAE,N),E(NAE,N),C(NC,N),WKV(2*N*N+3*N),RCOND
C
C     SOLVES THE CONTINUOUS-TIME SYLVESTER EQUATION
C
C       A*X*E' + E*X*A' + C = 0     (' DENOTES TRANSPOSE)
C
C     WHERE  A  AND  E  ARE N BY N GENERAL MATRICES, C IS AN N BY N SYM-
C     METRIC MATRIX, AND  X  IS THE UNKNOWN N BY N SYMMETRIC MATRIX.
C
C     ------------------------------------------------------------------
C     ON ENTRY -
C       NAE     INTEGER
C               LEADING DIMENSION OF  A  AND  E  AS DECLARED IN THE MAIN
C               CALLING PROGRAM
C
C       NC      INTEGER
C               LEADING DIMENSION OF  C  AS DECLARD IN THE MAIN PROGRAM
C
C       N       INTEGER
C               ORDER OF THE PROBLEM
C
C       A       DOUBLE PRECISION (NAE,N)
C               N BY N MATRIX
C
C       E       DOUBLE PRECISION (NAE,N)
C               N BY N MATRIX
C
C       C       DOUBLE PRECISION (NC,N)
C               N BY N SYMMETRIC MATRIX
C
C       IERR    INTEGER
C               FLAG INDICATING WHETHER OR NOT THE CONDITION NUMBER
C               OF THE EQUATION IS TO BE ESTIMATED.  IF IERR = 0
C               RCOND IS NOT COMPUTED, OTHERWISE IT IS.
C
C     ON RETURN -
C       A,E     DOUBLE PRECISION (NAE,N)
C               N BY N MATRICES IN QUASI-UPPER-TRIANGULAR AND UPPER-TRI-
C               ANGULAR FORM, RESPECTIVELY.  THE ORTHOGNAL MATRICES USED
C               TO CONVERT TO THIS FORM ARE RETURNED IN WKM1 AND WKM2 AS
C               DESCRIBED BELOW.
C
C       C       DOUBLE PRECISION (NC,N)
C               N BY N SOLUTION MATRIX
C
C       IERR    INTEGER
C               0 == NORMAL RETURN
C               1 == QZ ITERATION FAILED, NO SOLUTION OBTAINED
C               2 == BACK SUBSTITUTION FAILED, NO SOLUTION OBTAINED
C               3 == COMPUTATION OF RCOND INDICATES THE EQUATION IS
C                    SINGULAR.  NO SOLUTION ATTEMPTED.
C
C       RCOND   DOUBLE PRECISION
C               AN ESTIMATE OF THE RECIPROCAL OF THE CONDITION NUMBER
C
C    WORKSPACE -
C       WKV     DOUBLE PRECISION (2*N*N + 3*N)
C               WORK VECTOR
C
C     SUBROUTINES AND FUNCTIONS USED -
C       QZHESG QZITG QZVALG - GENERALIZED EIGENVALUE DECOMPOSITION;
C       (MATU) MULB, MQFWO, TRNATA; BKCON
C
C     WRITTEN -
C       26FEB87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-3616
C     REVISED -
C       27JAN89 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C       12DEC90 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C     ------------------------------------------------------------------
C
      INTEGER I,J,N2,JOB,LOW,IGH,INDXQ,INDXZ,INDXT
      DOUBLE PRECISION EPS,RSEP,NRMA,NRME,TMP1,TMP2
      LOGICAL CNDEST
C
C     -- EPS USED BY QZITG --
      EPS = 0.0D0
C
C     -- CHECK FOR CONDITION ESTIMATE REQUESTED
      IF (IERR .NE. 0) THEN
         CNDEST = .TRUE.
         IERR = 0
      ELSE
         CNDEST = .FALSE.
      ENDIF
C
C     -- FIND ORTHOGONAL Q AND Z SUCH THAT  Q'*A*Z IS QUASI-UPPER-TRI-
C     -- ANGULAR AND  Q'*E*Z  IS UPPER-TRIANGULAR.  UPDATE C TO Q'*C*Q
      INDXZ = 1
      INDXT = INDXZ + N*N
      INDXQ = INDXT + 3*N
      JOB = 22
      LOW = 1
      IGH = N
      CALL QZHESG(NAE,N,N,A,E,WKV(INDXQ),WKV(INDXZ),LOW,IGH,JOB)
      CALL QZITG(NAE,N,N,A,E,WKV(INDXQ),WKV(INDXZ),LOW,IGH,EPS,JOB,IERR)
      IF (IERR .NE. 0) THEN
         IERR = 1
         RETURN
      ENDIF
      N2 = N + N
      CALL QZVALG(NAE,N,N,A,E,WKV(INDXQ),WKV(INDXZ),WKV(INDXT),
     *            WKV(INDXT+N),WKV(INDXT+N2),JOB)
C     -- UPDATE C --
      CALL MQFWO(NC,N,N,C,WKV(INDXQ),WKV(INDXT))
C
C     -- ESTIMATE CONDITION NUMBER, IF REQUESTED
      IF (CNDEST) THEN
         CALL SEPGC (NAE,N,N,A,E,WKV(INDXT),RSEP)
         NRMA = 0.0D0
         NRME = 0.0D0
         DO 170 J=1,N
            TMP1 = 0.0D0
            TMP2 = 0.0D0
            DO 160 I=1,J
               TMP1 = TMP1 + ABS(A(I,J))
               TMP2 = TMP2 + ABS(E(I,J))
  160       CONTINUE
            IF (J .NE. N) TMP1 = TMP1 + ABS(A(J+1,J))
            IF (TMP1 .GT. NRMA) NRMA = TMP1
            IF (TMP2 .GT. NRME) NRME = TMP2
  170    CONTINUE
C
         RCOND = 2.0D0 * NRMA * NRME
         IF (RCOND .NE. 0.0D0) RCOND = 1.0D0 / (RSEP * RCOND)
         IF (1.0D0 + RCOND  .EQ.  1.0D0) THEN
            IERR = 3
            RETURN
         ENDIF
      ENDIF
C
C     -- BACK SUBSTITUTE, SOLVING FOR Y = Z'*X*Z --
      JOB = 0
      CALL BKCON(NAE, NC, N, A, E, C, JOB, IERR)
      IF (IERR .NE. 0) THEN
         IERR = 2
         RETURN
      ENDIF
C
C     -- CALCULATE X = Z*Y*Z' --
      CALL TRNATA(N,N,WKV(INDXZ))
      CALL MQFWO(NC,N,N,C,WKV(INDXZ),WKV(INDXT))
C
      RETURN
C
C --- LAST LINE OF SYLGC ---
      END
      SUBROUTINE SYLGD(NAE, NC, N, A, E, C, WKV, IERR, RCOND)
C
      INTEGER NAE,NC,N,IERR
      DOUBLE PRECISION A(NAE,N),E(NAE,N),C(NC,N),WKV(2*N*N+3*N),RCOND
C
C     SOLVES THE DISCRETE-TIME SYLVESTER EQUATION
C
C       A*X*A' - E*X*E' + C = 0     (' DENOTES TRANSPOSE)
C
C     WHERE  A  AND  E  ARE N BY N GENERAL MATRICES, C IS AN N BY N SYM-
C     METRIC MATRIX, AND  X  IS THE UNKNOWN N BY N SYMMETRIC MATRIX.
C
C     ------------------------------------------------------------------
C     ON ENTRY -
C       NAE     INTEGER
C               LEADING DIMENSION OF  A  AND  E  AS DECLARED IN THE MAIN
C               CALLING PROGRAM
C
C       NC      INTEGER
C               LEADING DIMENSION OF  C  AS DECLARD IN THE MAIN PROGRAM
C
C       N       INTEGER
C               ORDER OF THE PROBLEM
C
C       A       DOUBLE PRECISION (NAE,N)
C               N BY N MATRIX
C
C       E       DOUBLE PRECISION (NAE,N)
C               N BY N MATRIX
C
C       C       DOUBLE PRECISION (NC,N)
C               N BY N SYMMETRIC MATRIX
C
C       IERR    INTEGER
C               FLAG INDICATING WHETHER OR NOT THE CONDITION NUMBER
C               OF THE EQUATION IS TO BE ESTIMATED.  IF IERR = 0
C               RCOND IS NOT COMPUTED, OTHERWISE IT IS.
C
C     ON RETURN -
C       A,E     DOUBLE PRECISION (NAE,N)
C               N BY N MATRICES IN QUASI-UPPER-TRIANGULAR AND UPPER-TRI-
C               ANGULAR FORM, RESPECTIVELY.  THE ORTHOGNAL MATRICES USED
C               TO CONVERT TO THIS FORM ARE RETURNED IN WKM1 AND WKM2 AS
C               DESCRIBED BELOW.
C
C       C       DOUBLE PRECISION (NC,N)
C               N BY N SOLUTION MATRIX
C
C       IERR    INTEGER
C               0 == NORMAL RETURN
C               1 == QZ ITERATION FAILED, NO SOLUTION OBTAINED
C               2 == BACK SUBSTITUTION FAILED, NO SOLUTION OBTAINED
C               3 == COMPUTATION OF RCOND INDICATES THE EQUATION IS
C                    SINGULAR.  NO SOLUTION ATTEMPTED.
C
C       RCOND   DOUBLE PRECISION
C               AN ESTIMATE OF THE RECIPROCAL OF THE CONDITION NUMBER
C
C    WORKSPACE -
C       WKV     DOUBLE PRECISION (2*N*N + 3*N)
C               WORK VECTOR
C
C     SUBROUTINES AND FUNCTIONS USED -
C       QZHESG QZITG QZVALG - GENERALIZED EIGENVALUE DECOMPOSITION;
C       (MATU) MULB, MQFWO, TRNATA; BKDIS
C
C     WRITTEN -
C       26FEB87 M.WETTE, UCSB ECE, SANTA BARBARA, CA 93106 (805)961-3616
C     REVISED -
C       27JAN89 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C       12DEC90 J. GARDINER, OSU CIS, COLUMBUS, OH  43210  (614)292-8658
C     ------------------------------------------------------------------
C
      INTEGER I,J,N2,JOB,LOW,IGH,INDXQ,INDXZ,INDXT
      DOUBLE PRECISION EPS,RSEP,NRMA,NRME,TMP1,TMP2
      LOGICAL CNDEST
C
C     -- EPS USED BY QZITG --
      EPS = 0.0D0
C
C     -- CHECK FOR CONDITION ESTIMATE REQUESTED
      IF (IERR .NE. 0) THEN
         CNDEST = .TRUE.
         IERR = 0
      ELSE
         CNDEST = .FALSE.
      ENDIF
C
C     -- FIND ORTHOGONAL Q AND Z SUCH THAT  Q'*A*Z IS QUASI-UPPER-TRI-
C     -- ANGULAR AND  Q'*E*Z  IS UPPER-TRIANGULAR.  UPDATE C TO Q'*C*Q
      INDXZ = 1
      INDXT = INDXZ + N*N
      INDXQ = INDXT + 3*N
      JOB = 22
      LOW = 1
      IGH = N
      CALL QZHESG(NAE,N,N,A,E,WKV(INDXQ),WKV(INDXZ),LOW,IGH,JOB)
      CALL QZITG(NAE,N,N,A,E,WKV(INDXQ),WKV(INDXZ),LOW,IGH,EPS,JOB,IERR)
      IF (IERR .NE. 0) THEN
         IERR = 1
         RETURN
      ENDIF
      N2 = N + N
      CALL QZVALG(NAE,N,N,A,E,WKV(INDXQ),WKV(INDXZ),WKV(INDXT),
     *            WKV(INDXT+N),WKV(INDXT+N2),JOB)
C     -- UPDATE C --
      CALL MQFWO(NC,N,N,C,WKV(INDXQ),WKV(INDXT))
C
C     -- ESTIMATE CONDITION NUMBER, IF REQUESTED
      IF (CNDEST) THEN
         CALL SEPGD (NAE,N,N,A,E,WKV(INDXT),RSEP)
         NRMA = 0.0D0
         NRME = 0.0D0
         DO 170 J=1,N
            TMP1 = 0.0D0
            TMP2 = 0.0D0
            DO 160 I=1,J
               TMP1 = TMP1 + ABS(A(I,J))
               TMP2 = TMP2 + ABS(E(I,J))
  160       CONTINUE
            IF (J .NE. N) TMP1 = TMP1 + ABS(A(J+1,J))
            IF (TMP1 .GT. NRMA) NRMA = TMP1
            IF (TMP2 .GT. NRME) NRME = TMP2
  170    CONTINUE
C
         RCOND = NRMA * NRMA + NRME * NRME
         IF (RCOND .NE. 0.0D0) RCOND = 1.0D0 / (RSEP * RCOND)
         IF (1.0D0 + RCOND  .EQ.  1.0D0) THEN
            IERR = 3
            RETURN
         ENDIF
      ENDIF
C
C     -- BACK SUBSTITUTE, SOLVING FOR Y = Z'*X*Z --
      JOB = 0
      CALL BKDIS(NAE, NC, N, A, E, C, JOB, IERR)
      IF (IERR .NE. 0) THEN
         IERR = 2
         RETURN
      ENDIF
C
C     -- CALCULATE X = Z*Y*Z' --
      CALL TRNATA(N,N,WKV(INDXZ))
      CALL MQFWO(NC,N,N,C,WKV(INDXZ),WKV(INDXT))
C
      RETURN
C
C --- LAST LINE OF SYLGD ---
      END
SHAR_EOF
fi # end of overwriting check
cd ..
cd ..
cd ..
#       End of shell archive
exit 0