changeset 0:6b33357c7561 octave-forge

Initial revision
author pkienzle
date Wed, 10 Oct 2001 19:54:49 +0000
parents
children 64117bc24bf1
files COPYING COPYING.GPL FIXES/Makefile FIXES/MersenneTwister.h FIXES/README FIXES/contour.m FIXES/cross.m FIXES/deblank.m FIXES/fftfilt.m FIXES/findstr.m FIXES/freqz.m FIXES/grid.m FIXES/hankel.m FIXES/hilb.m FIXES/imagesc.m FIXES/index.m FIXES/invhilb.m FIXES/kron.m FIXES/lin2mu.m FIXES/mu2lin.m FIXES/polyder.m FIXES/polyderiv.m FIXES/polygcd.m FIXES/rand.cc FIXES/rindex.m FIXES/tf2zp.m FIXES/toeplitz.m FIXES/vander.m FIXES/zp2tf.m INSTALL Makeconf.base Makefile README TODO autogen.sh configure.base cvs-tree extra/Makefile extra/Windows/NOINSTALL extra/Windows/image.m extra/civil/__nlnewmark_fcn__.m extra/civil/newmark.m extra/civil/nlnewmark.m extra/engine/Makefile extra/engine/NOINSTALL extra/engine/README extra/engine/engClose.c extra/engine/engEvalString.c extra/engine/engGetFull.c extra/engine/engOpen.c extra/engine/engOutputBuffer.c extra/engine/engPutFull.c extra/engine/engif.c extra/engine/engif.h extra/engine/engine.h extra/engine/mattest.c extra/engine/mxCalloc.c extra/engine/mxFree.c extra/fake-sparse/NOINSTALL extra/fake-sparse/full.m extra/fake-sparse/issparse.m extra/fake-sparse/sparse.m extra/fake-sparse/spdiags.m extra/fake-sparse/spy.m extra/integration/Contents.m extra/integration/README extra/integration/README.Copying extra/integration/README.gaussq extra/integration/count.m extra/integration/cquadnd.m extra/integration/crule.m extra/integration/crule2d.m extra/integration/crule2dgen.m extra/integration/gquad.m extra/integration/gquad2d.m extra/integration/gquad2d6.m extra/integration/gquad2dgen.m extra/integration/gquad6.m extra/integration/gquadnd.m extra/integration/grule.m extra/integration/grule2d.m extra/integration/grule2dgen.m extra/integration/innerfun.m extra/integration/ncrule.m extra/integration/quad2dc.m extra/integration/quad2dcgen.m extra/integration/quad2dg.m extra/integration/quad2dggen.m extra/integration/quadc.m extra/integration/quadg.m extra/integration/quadndg.m extra/integration/test/run.log extra/integration/test/run2dtests.m extra/integration/test/test_ncrule.m extra/integration/test/test_quadg.m extra/integration/test/tests2d.log extra/integration/test/testsnc.log extra/integration/test/testsqg.log extra/integration/testfun/fxpow.m extra/integration/testfun/glimh.m extra/integration/testfun/glimh2.m extra/integration/testfun/gliml.m extra/integration/testfun/gxy.m extra/integration/testfun/gxy1.m extra/integration/testfun/gxy2.m extra/integration/testfun/hx.m extra/integration/testfun/lcrcl.m extra/integration/testfun/lcrcu.m extra/integration/testfun/x25.m extra/integration/testfun/xcubed.m extra/integration/testfun/xsquar.m extra/integration/zero_count.m extra/linear-algebra/Makefile extra/linear-algebra/README extra/linear-algebra/chol.cc extra/linear-algebra/ov-re-tri.cc extra/linear-algebra/ov-re-tri.h extra/mex/INSTALL extra/mex/Makefile extra/mex/README extra/mex/TODO extra/mex/matrix.h extra/mex/mex.1 extra/mex/mex.cc extra/mex/mex.h extra/mex/mex.in extra/mex/myfeval.c extra/mex/myfevalf.f extra/mex/myset.c extra/ode/ode23.m extra/ode/ode45.m extra/ode/ode78.m extra/ode/penddot.m extra/ode/pendulum.m extra/ode/readme.txt extra/ode/rk2fixed.m extra/ode/rk4fixed.m extra/ode/rk8fixed.m extra/patches/M-v-ops-2.1.31.patch extra/patches/NOINSTALL extra/patches/cell-support-2.1.31.patch extra/patches/exist-type-2.1.19.patch extra/patches/load-to-struct-2.0.19.patch extra/patches/octave-mod-2.1.31.patch extra/testfun/Makefile extra/testfun/README extra/testfun/assert.m extra/testfun/data/pretty extra/testfun/demo.m extra/testfun/example.m extra/testfun/index.html extra/testfun/pretty.cc extra/testfun/speed.m extra/testfun/test.m extra/tk_octave/Makeconf.add extra/tk_octave/Makefile extra/tk_octave/NOINSTALL extra/tk_octave/README extra/tk_octave/configure.add extra/tk_octave/rainbow.m extra/tk_octave/sample.dat extra/tk_octave/tk_busy.m extra/tk_octave/tk_busy_cancel.m extra/tk_octave/tk_dialog.m extra/tk_octave/tk_entry.m extra/tk_octave/tk_error.m extra/tk_octave/tk_init.m extra/tk_octave/tk_input.m extra/tk_octave/tk_interp.cc extra/tk_octave/tk_matrix extra/tk_octave/tk_matrix.tcl extra/tk_octave/tk_menu.m extra/tk_octave/tk_message.m extra/tk_octave/tk_progress.m extra/tk_octave/tk_progress_cancel.m extra/tk_octave/tk_scale.m extra/tk_octave/tk_yesno.m extra/tk_octave/tk_yesnocancel.m extra/ver20/NOINSTALL extra/ver20/fieldnames.m extra/ver20/figure.m extra/ver20/file_in_loadpath.m extra/ver20/is_complex.m extra/ver20/isfinite.m extra/ver20/islogical.m extra/ver20/isreal.m extra/ver20/logical.m extra/ver20/nanfunc.m extra/ver20/nanmax.m extra/ver20/nanmean.m extra/ver20/nanmedian.m extra/ver20/nanmin.m extra/ver20/nanstd.m extra/ver20/nansum.m extra/ver20/orient.m install-sh main/Makefile main/audio/Makefile main/audio/au.m main/audio/aucapture.m main/audio/auload.m main/audio/auplot.m main/audio/aurecord.cc main/audio/aurecord.m main/audio/ausave.m main/audio/bin/.keepme main/audio/clip.m main/audio/data/sample.wav main/audio/endpoint.cc main/audio/endpoint.doc main/audio/endpoint.h main/audio/sound.m main/audio/soundsc.m main/comm/bi2de.m main/comm/compand.m main/comm/de2bi.m main/comm/quantiz.m main/comm/randint.m main/comm/vec2mat.m main/control/feedback.m main/general/Makefile main/general/bitand.cc main/general/bitcmp.m main/general/bitget.m main/general/bitset.m main/general/bitshift.m main/general/blkdiag.m main/general/command.cc main/general/complex.m main/general/cplxpair.m main/general/ctranspose.m main/general/cumtrapz.m main/general/deal.m main/general/del2.m main/general/double.m main/general/fcnchk.m main/general/gradient.m main/general/ifftshift.m main/general/ind2sub.m main/general/interp1.m main/general/interp2.m main/general/interpft.m main/general/isequal.m main/general/isunix.m main/general/lasterr.m main/general/lookup.m main/general/polyarea.m main/general/randperm.m main/general/rat.m main/general/rats.m main/general/repmat.m main/general/sortrows.m main/general/sub2ind.m main/general/transpose.m main/general/trapz.m main/general/unix.m main/general/unwrap.m main/geometry/AUTHORS main/geometry/ChangeLog main/geometry/Makeconf.add main/geometry/Makefile main/geometry/README main/geometry/TODO main/geometry/__voronoi__.cc main/geometry/configure.add main/geometry/convhull.m main/geometry/convhulln.cc main/geometry/delaunay.m main/geometry/delaunay3.m main/geometry/delaunayn.cc main/geometry/griddata.m main/geometry/voronoi.m main/geometry/voronoin.m main/ident/idplot.m main/ident/idsim.m main/ident/mktheta.m main/ident/poly2th.m main/image/Makefile main/image/autumn.m main/image/bone.m main/image/brighten.m main/image/bwborder.m main/image/bwlabel.m main/image/conv2.cc main/image/cool.m main/image/copper.m main/image/cordflt2.cc main/image/corr2.m main/image/flag.m main/image/grayslice.m main/image/histeq.m main/image/hot.m main/image/hsv.m main/image/hsv2rgb.m main/image/im2bw.m main/image/imadjust.m main/image/imhist.m main/image/imnoise.m main/image/impad.m main/image/isbw.m main/image/isgray.m main/image/isind.m main/image/jet.m main/image/mat2gray.m main/image/mean2.m main/image/medfilt2.m main/image/ordfilt2.m main/image/pink.m main/image/prism.m main/image/rainbow.m main/image/rgb2gray.m main/image/rgb2hsv.m main/image/spring.m main/image/std2.m main/image/summer.m main/image/white.m main/image/winter.m main/linear-algebra/Makefile main/linear-algebra/funm.m main/linear-algebra/rref.m main/linear-algebra/rsf2csf.cc main/linear-algebra/rsf2csf.m main/linear-algebra/thfm.m main/optim/Makefile main/optim/__quasi_func__.m main/optim/bfgs.m main/optim/bs_gradient.m main/optim/deriv.m main/optim/dfdp.m main/optim/dfp.m main/optim/fmin.m main/optim/fminbnd.m main/optim/fzero.m main/optim/leasqr.m main/optim/leasqrdemo.m main/optim/lp.cc main/optim/lp_test.m main/optim/nrm.m main/path/addpath.m main/path/fullfile.m main/path/rmpath.m main/plot/Makefile main/plot/__plt3__.m main/plot/clf.m main/plot/dhbar.m main/plot/drawnow.m main/plot/fill.m main/plot/fill3.m main/plot/gget.m main/plot/ginput.cc main/plot/ginput.oct main/plot/grab.cc main/plot/grab.oct main/plot/graphics.cc main/plot/graphics.h main/plot/graphics.oct main/plot/gtext.cc main/plot/gtext.oct main/plot/gzoom.cc main/plot/gzoom.oct main/plot/legend.m main/plot/meshc.m main/plot/orient.m main/plot/patch.m main/plot/pcolor.m main/plot/pie.m main/plot/plot3.m main/plot/print.m main/plot/quiver.m main/plot/stem.m main/plot/surf.m main/plot/surfc.m main/plot/text.m main/plot/view.m main/set/intersect.m main/set/ismember.m main/set/setdiff.m main/set/setxor.m main/set/union.m main/set/unique.m main/signal/Makefile main/signal/__power.m main/signal/arburg.m main/signal/aryule.m main/signal/bilinear.m main/signal/boxcar.m main/signal/butter.m main/signal/buttord.m main/signal/cceps.m main/signal/cheb1ord.m main/signal/cheb2ord.m main/signal/cheby1.m main/signal/cheby2.m main/signal/chirp.m main/signal/cohere.m main/signal/csd.m main/signal/czt.m main/signal/dct.m main/signal/dct2.m main/signal/dctmtx.m main/signal/decimate.m main/signal/filter2.m main/signal/filtfilt.m main/signal/fir1.m main/signal/fir2.m main/signal/gaussian.m main/signal/grpdelay.m main/signal/hilbert.m main/signal/idct.m main/signal/idct2.m main/signal/impz.m main/signal/interp.m main/signal/kaiser.m main/signal/kaiserord.m main/signal/levinson.m main/signal/medfilt1.cc main/signal/pburg.m main/signal/polystab.m main/signal/pulstran.m main/signal/pwelch.m main/signal/pyulear.m main/signal/rceps.m main/signal/rectpuls.m main/signal/remez.cc main/signal/resample.m main/signal/sftrans.m main/signal/sgolay.m main/signal/sgolayfilt.m main/signal/specgram.m main/signal/tfe.m main/signal/triang.m main/signal/tripuls.m main/signal/xcorr.m main/signal/xcorr2.m main/signal/xcov.m main/signal/zplane.m main/sparse/ChangeLog main/sparse/Makefile main/sparse/README main/sparse/SuperLU/CBLAS/dmyblas2.c main/sparse/SuperLU/CBLAS/zmyblas2.c main/sparse/SuperLU/SRC/Cnames.h main/sparse/SuperLU/SRC/colamd.c main/sparse/SuperLU/SRC/colamd.h main/sparse/SuperLU/SRC/dcolumn_bmod.c main/sparse/SuperLU/SRC/dcolumn_dfs.c main/sparse/SuperLU/SRC/dcomplex.c main/sparse/SuperLU/SRC/dcomplex.h main/sparse/SuperLU/SRC/dcopy_to_ucol.c main/sparse/SuperLU/SRC/dgscon.c main/sparse/SuperLU/SRC/dgsequ.c main/sparse/SuperLU/SRC/dgsrfs.c main/sparse/SuperLU/SRC/dgssv.c main/sparse/SuperLU/SRC/dgssvx.c main/sparse/SuperLU/SRC/dgstrf.c main/sparse/SuperLU/SRC/dgstrs.c main/sparse/SuperLU/SRC/dlacon.c main/sparse/SuperLU/SRC/dlamch.c main/sparse/SuperLU/SRC/dlangs.c main/sparse/SuperLU/SRC/dlaqgs.c main/sparse/SuperLU/SRC/dmemory.c main/sparse/SuperLU/SRC/dpanel_bmod.c main/sparse/SuperLU/SRC/dpanel_dfs.c main/sparse/SuperLU/SRC/dpivotL.c main/sparse/SuperLU/SRC/dpivotgrowth.c main/sparse/SuperLU/SRC/dpruneL.c main/sparse/SuperLU/SRC/dreadhb.c main/sparse/SuperLU/SRC/dsnode_bmod.c main/sparse/SuperLU/SRC/dsnode_dfs.c main/sparse/SuperLU/SRC/dsp_blas2.c main/sparse/SuperLU/SRC/dsp_blas3.c main/sparse/SuperLU/SRC/dsp_defs.h main/sparse/SuperLU/SRC/dutil.c main/sparse/SuperLU/SRC/get_perm_c.c main/sparse/SuperLU/SRC/icmax1.c main/sparse/SuperLU/SRC/izmax1.c main/sparse/SuperLU/SRC/lsame.c main/sparse/SuperLU/SRC/memory.c main/sparse/SuperLU/SRC/mmd.c main/sparse/SuperLU/SRC/relax_snode.c main/sparse/SuperLU/SRC/sp_coletree.c main/sparse/SuperLU/SRC/sp_ienv.c main/sparse/SuperLU/SRC/sp_preorder.c main/sparse/SuperLU/SRC/superlu_timer.c main/sparse/SuperLU/SRC/supermatrix.h main/sparse/SuperLU/SRC/util.c main/sparse/SuperLU/SRC/util.h main/sparse/SuperLU/SRC/xerbla.c main/sparse/SuperLU/SRC/zcolumn_bmod.c main/sparse/SuperLU/SRC/zcolumn_dfs.c main/sparse/SuperLU/SRC/zcopy_to_ucol.c main/sparse/SuperLU/SRC/zgscon.c main/sparse/SuperLU/SRC/zgsequ.c main/sparse/SuperLU/SRC/zgsrfs.c main/sparse/SuperLU/SRC/zgssv.c main/sparse/SuperLU/SRC/zgssvx.c main/sparse/SuperLU/SRC/zgstrf.c main/sparse/SuperLU/SRC/zgstrs.c main/sparse/SuperLU/SRC/zlacon.c main/sparse/SuperLU/SRC/zlangs.c main/sparse/SuperLU/SRC/zlaqgs.c main/sparse/SuperLU/SRC/zmemory.c main/sparse/SuperLU/SRC/zpanel_bmod.c main/sparse/SuperLU/SRC/zpanel_dfs.c main/sparse/SuperLU/SRC/zpivotL.c main/sparse/SuperLU/SRC/zpivotgrowth.c main/sparse/SuperLU/SRC/zpruneL.c main/sparse/SuperLU/SRC/zreadhb.c main/sparse/SuperLU/SRC/zsnode_bmod.c main/sparse/SuperLU/SRC/zsnode_dfs.c main/sparse/SuperLU/SRC/zsp_blas2.c main/sparse/SuperLU/SRC/zsp_blas3.c main/sparse/SuperLU/SRC/zsp_defs.h main/sparse/SuperLU/SRC/zutil.c main/sparse/complex_sparse_ops.cc main/sparse/fem_test.m main/sparse/make_sparse.cc main/sparse/make_sparse.h main/sparse/sp_test.m main/sparse/sparse_full.cc main/sparse/sparse_inv.cc main/sparse/sparse_ops.cc main/sparse/sparse_ops.h main/sparse/superlu2.0patch.diff main/specfun/ellipj.m main/specfun/ellipke.m main/specfun/expint.f main/specfun/factor.m main/specfun/factorial.m main/specfun/gammaln.m main/specfun/isprime.m main/specfun/legendre.m main/specfun/mod.m main/specfun/nchoosek.m main/specfun/perms.m main/specfun/primes.m main/special-matrix/magic.m main/special-matrix/pascal.m main/special-matrix/rosser.m main/special-matrix/wilkinson.m main/splines/Makefile main/splines/csape.m main/splines/csapi.m main/splines/dgtsv.f main/splines/dptsv.f main/splines/dpttrf.f main/splines/dpttrs.f main/splines/dptts2.f main/splines/fnder.m main/splines/fnplt.m main/splines/mkpp.m main/splines/pchip.m main/splines/ppval.m main/splines/spline.m main/splines/trisolve.cc main/splines/trisolve.tst main/splines/unmkpp.m main/statistics/geomean.m main/statistics/harmmean.m main/statistics/mad.m main/statistics/nanmax.m main/statistics/nanmean.m main/statistics/nanmedian.m main/statistics/nanmin.m main/statistics/nanstd.m main/statistics/nansum.m main/statistics/prctile.m main/statistics/trimmean.m main/statistics/zscore.m main/strings/mat2str.m main/strings/strcmpi.m main/strings/strmatch.m main/strings/strncmp.m main/strings/strncmpi.m main/strings/strtok.m main/strings/strvcat.m main/struct/README main/struct/fieldnames.m main/struct/getfield.m main/struct/isfield.m main/struct/isstruct.m main/struct/rmfield.m main/struct/setfield.m main/struct/struct.m main/time/datenum.m main/time/datestr.m main/time/datevec.m main/time/now.m main/time/weekday.m nonfree/Makefile nonfree/gpc/AUTHORS nonfree/gpc/ChangeLog nonfree/gpc/Makefile.am nonfree/gpc/NEWS nonfree/gpc/NOINSTALL nonfree/gpc/README nonfree/gpc/TODO nonfree/gpc/bootstrap.sh nonfree/gpc/configure.in nonfree/gpc/debian/changelog nonfree/gpc/debian/control nonfree/gpc/debian/copyright nonfree/gpc/debian/cvsdir.sh nonfree/gpc/debian/docs nonfree/gpc/debian/gpc_test.m nonfree/gpc/debian/rules nonfree/gpc/gpc_clip.cc nonfree/gpc/gpc_create.cc nonfree/gpc/gpc_get.cc nonfree/gpc/gpc_is_polygon.cc nonfree/gpc/gpc_plot.m nonfree/gpc/gpc_read.cc nonfree/gpc/gpc_tristrip.cc nonfree/gpc/gpc_write.cc nonfree/gpc/octave-gpc.cc nonfree/gpc/octave-gpc.h nonfree/splines/LICENSE.gcvsplf nonfree/splines/Makefile nonfree/splines/NOINSTALL nonfree/splines/csaps.m nonfree/splines/gcvspl.cc nonfree/splines/gcvsplf.f octinst.sh.in release.sh
diffstat 614 files changed, 75576 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/COPYING	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,162 @@
+
+This collection of functions for use with GNU Octave is hereby 
+granted to the public domain.
+
+THIS COLLECTION IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+The individual functions are copyrighted by their respective authors
+and released under different licenses.  See the corresponding source
+files for the specific copyright and license.  A summary is provided
+below for your convenience, but it is not guaranteed to be complete
+or up to date.
+
+GPL (see file GPL for details)
+------------------------------
+Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+	nanstd, nanmean, nanmedian, nanmax, nanmin, nansum
+	mad, trimean, geomean, harmmean, zscore, prctile, perms, nchoosek
+	now, weekday, datevec, datestr, datenum
+	test, example, demo, assert, speed_test, lasterr
+	isequal, fzero, cplxpair, complex, gammaln, factor, factorial, primes
+	strtok, strmatch, strjust, magic, rref, repmat
+	zplane, zp2tf, xcov, xcorr, triang, tfe, tf2zp, specgram, sftrans
+	resample, rceps, pyulear, pwelch, pulstran, __power, pburg,
+	medfilt1, levinson, kaiserord, interp, impz, sgolay, sgolayfilt,
+	gaussian, fir2, fir1, filtfilt, decimate, czt, csd, cohere, chirp,
+	cheby2, cheby1, chebord, cheb1ord, buttord, butter, boxcar, bilinear
+	imnoise, polygcd, unmkpp, ppval, mkpp, interp1, lookup, hilbert
+	dct, idct, dct2, idct2, dctmtx, filter2, interpft, rectpuls, tripuls
+	soundsc, sound, clip, aurecord, auplot, au, aucapture, ausave, auload
+	unique, union, setxor, setdiff, ismember, intersect
+	aryule, arburg, poly2th, mktheta, idsim, idplot
+	text, surf, surfc, stem, pcolor, drawnow
+	full, issparse, spdiags, spy
+	pretty (modified from jwe), 
+	strvcat (modified from Kurt Hornik), 
+	mat2str (modified from jwe thru Ariel Tankus)
+	grpdelay (modified from jwe)
+	plot3, __plt3__ (modified from jwe)
+	meshc (modified from jwe)
+	rand, randn (modified from jwe and Dirk Eddelbuettel)
+Kai Habel <kai.habel@gmx.de>
+	bitand, bitor, bitcmp, bitmax, bitxor, bitset, bitget, bitshift
+	csape,csapi,spline,trisolve,fnplt
+	trapz,cumtrapz,del2,gradient,interp2,legendre
+	cool,copper,flag,hot,hsv,jet,pink,prism,rainbow,white
+	autumn,spring,summer,winter
+	brighten,hsv2rgb,mat2gray,rgb2gray,rgb2hsv
+	cart2pol,cart2sph,pol2car,sph2cart
+	corr2,mean2,std2
+	grayslice,histeq,im2bw,imadjust,imhist,isbw,isgray,isind
+Teemu Ikonen <tpikonen@pcu.helsinki.fi>
+	cordflt2,impad,medfilt2,ordfilt2
+Etienne Grossmann <etienne@isr.ist.utl.pt>
+	struct,setfield,rmfield,isstruct,isfield,getfield
+	rmpath, fullfile, addpath
+	bwlabel, bwborder
+	sub2ind, ind2sub
+Andreas Weingessel <Andreas.Weingessel@ci.tuwien.ac.at>
+	cceps
+Pascal Fleury <fleury@sslab.sony.co.jp>
+	sparse
+Stephen Eglen <stephen@cogsci.ed.ac.uk>
+	randperm
+Benn Sapp <bsapp@lanl.gov>
+	__quasi_func__, nrm, lp, dfp, deriv, bs_gradient, bfgs, fminbnd
+Marc Compere <compere@mail.utexas.edu>
+	rk8fixed, rk4fixed, rk2fixed, pendulum, pendot, ode78, ode45, ode23
+P.R. Nienhuis <106130.1515@compuserve.com>
+	funm
+David Doolin <doolin@ce.berkeley.edu>
+	polyarea
+Vincent Cautaerts <vincent@comf5.comm.eng.osaka-u.ac.jp>
+	ifftshift
+Daniel Heiserer <Daniel.heiserer@physik.tu-muenchen.de>
+	patch,dhbar,fill,pie,print,gget
+Ariel Tankus <arielt@math.tau.ac.il>
+	deal, double, view
+Kurt Hornik <??>
+	kaiser
+Roberto A. F. Almeida <roberto@calvin.ocfis.furg.br>
+	quiver
+Jake Janovetz <??>
+	remez
+Peter Ekberg <??>
+	pascal, rosser, wilkinson
+Andy Adler <en254@freenet.carleton.ca>
+	conv2, ginput
+Laurent Mazet <mazet@crm.mot.com>
+	legend, unix, transpose, ctranspose, bi2de, de2bi, vec2mat, randint
+Daniel Calvelo <dcalvelo@yahoo.com>
+	dec2base, base2dec, hex2dec, dec2hex
+	blkdiag, sortrows
+David Billinghurst <David.Billinghurst@riotinto.com>
+	ellipke, ellipj
+Richard I. Shrager <rs9e@nih.gov>
+Arthur Jutan <jutan@charon.engga.uwo.ca>
+Ray Muzic <rfm2@po.cwru.edu>
+Francesco Potorti <F.Potorti@cnuce.cnr.it>
+	leasqr, dfdp, leasqrdemo
+Dave Cogdell <cogdelld@asme.org>
+	xcorr2
+Bryce Gardner <bgard@autoa.com>
+	(grants permission to modify for and distribute with octave)
+	quadndg, quadg, quadc, quad2dg, quad2dggen, quad2dc, quad2dcgen,
+	ncrule, innerfun, grule, grule2d, grule2dgen, gquadnd, gquad,
+	gquad6, gquad2d, gquad2dgen, gquad2d6, crule, crule2d, crule2dgen,
+	cquadnd, count
+
+public domain
+-------------
+Bruce T. Lowerre <??>
+	endpoint.h, endpoint.doc, endpoint.cc
+Sam Sirlin <sirlin@izap.com>
+	fill3  (from http://www.izap.com/~sirlin/matlab/)
+Bill Lash <lash@tellabs.com>
+	unwrap, strncmp, strncmpi, strcmpi
+
+GPL header
+----------
+## Copyright (C) 2001 "author"
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+Public domain header
+--------------------
+## Author: "author"
+##
+## This program is granted to the public domain.
+##
+## THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+## ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+## ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+## FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+## OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+## HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+## LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+## OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+## SUCH DAMAGE.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/COPYING.GPL	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,339 @@
+                    GNU GENERAL PUBLIC LICENSE
+                       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+                          675 Mass Ave, Cambridge, MA 02139, USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                            Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+                    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+                            NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+                     END OF TERMS AND CONDITIONS
+
+            How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) 19yy  <name of author>
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) 19yy name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Library General
+Public License instead of this License.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,12 @@
+include ../Makeconf
+
+PROGS = rand.oct randn.oct
+
+all: $(PROGS)
+
+randn.oct: rand.oct
+	-$(RM) randn.oct
+	$(LN_S) rand.oct randn.oct
+
+clean: 
+	$(RM) *.o $(PROGS) octave-core core *~OA
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/MersenneTwister.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,334 @@
+// MersenneTwister.h
+// Mersenne Twister random number generator -- a C++ class MTRand
+// Based on code by Makoto Matsumoto, Takuji Nishimura, and Shawn Cokus
+// Richard J. Wagner  v0.6  14 February 2001  rjwagner@writeme.com
+
+// The Mersenne Twister is an algorithm for generating random numbers.  It
+// was designed with consideration of the flaws in various other generators.
+// The period, 2^19937-1, and the order of equidistribution, 623 dimensions,
+// are far greater.  The generator is also fast; it avoids multiplication and
+// division, and it benefits from caches and pipelines.  For more information
+// see the inventors' web page at http://www.math.keio.ac.jp/~matumoto/emt.html
+
+// Reference
+// M. Matsumoto and T. Nishimura, "Mersenne Twister: A 623-Dimensionally
+// Equidistributed Uniform Pseudo-Random Number Generator", ACM Transactions on
+// Modeling and Computer Simulation, Vol. 8, No. 1, January 1998, pp 3-30.
+
+// Copyright (C) 2001  Richard J. Wagner
+// 
+// This library is free software; you can redistribute it and/or
+// modify it under the terms of the GNU Lesser General Public
+// License as published by the Free Software Foundation; either
+// version 2.1 of the License, or (at your option) any later version.
+// 
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+// Lesser General Public License for more details.
+// 
+// You should have received a copy of the GNU Lesser General Public
+// License along with this library; if not, write to the Free Software
+// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+// The original code included the following notice:
+//
+//     Copyright (C) 1997, 1999 Makoto Matsumoto and Takuji Nishimura.
+//     When you use this, send an email to: matumoto@math.keio.ac.jp
+//     with an appropriate reference to your work.
+//
+// It would be nice to CC: rjwagner@writeme.com and Cokus@math.washington.edu
+// when you write.
+
+#ifndef MERSENNETWISTER_H
+#define MERSENNETWISTER_H
+
+// Not thread safe (unless auto-initialization is avoided and each thread has
+// its own MTRand object)
+
+#include <stdio.h>
+#include <time.h>
+#include <limits.h>
+#include <iostream.h>
+
+class MTRand {
+// Data
+public:
+	typedef unsigned long uint32;  // unsigned integer type, at least 32 bits
+	
+	enum { N = 624 };              // length of state vector
+	enum { SAVE = N + 1 };         // length of array for save()
+
+protected:
+	enum { M = 397 };              // period parameter
+	enum { MAGIC = 0x9908b0dfU };  // magic constant
+	
+	uint32 state[N];  // internal state
+	uint32 *pNext;    // next value to get from state
+	int left;         // number of values left before reload needed
+
+
+//Methods
+public:
+	MTRand( const uint32& oneSeed );  // initialize with a simple uint32
+	MTRand( uint32 *const bigSeed );  // initialize with an array of N uint32's
+	MTRand();  // auto-initialize with /dev/urandom or time() and clock()
+	
+	// Access to 32-bit random numbers
+	// Do NOT use for CRYPTOGRAPHY without securely hashing several returned
+	// values together, otherwise the generator state can be learned after
+	// reading 624 consecutive values.
+	double rand();                      // real number in [0,1]
+	double rand( const double& n );     // real number in [0,n]
+	double randExc();                   // real number in [0,1)
+	double randExc( const double& n );  // real number in [0,n)
+	uint32 randInt();                       // integer in [0,2^32-1]
+	uint32 randInt( const uint32& n );      // integer in [0,n] for n < 2^32
+	double operator()() { return rand(); }  // same as rand()
+	
+	// Re-seeding functions with same behavior as initializers
+	void seed( uint32 oneSeed );
+	void seed( uint32 *const bigSeed );
+	void seed();
+	
+	// Saving and loading generator state
+	void save( uint32* saveArray ) const;  // to array of size SAVE
+	void load( uint32 *const loadArray );  // from such array
+	friend ostream& operator<<( ostream& os, const MTRand& mtrand );
+	friend istream& operator>>( istream& is, MTRand& mtrand );
+
+protected:
+	void reload();
+	uint32 hiBit( const uint32& u ) const { return u & 0x80000000U; }
+	uint32 loBit( const uint32& u ) const { return u & 0x00000001U; }
+	uint32 loBits( const uint32& u ) const { return u & 0x7fffffffU; }
+	uint32 mixBits( const uint32& u, const uint32& v ) const
+		{ return hiBit(u) | loBits(v); }
+	uint32 twist( const uint32& m, const uint32& s0, const uint32& s1 ) const
+		{ return m ^ (mixBits(s0,s1)>>1) ^ (loBit(s1) ? MAGIC : 0U); }
+	static uint32 hash( time_t t, clock_t c );
+};
+
+
+inline MTRand::MTRand( const uint32& oneSeed )
+	{ seed(oneSeed); }
+
+inline MTRand::MTRand( uint32 *const bigSeed )
+	{ seed(bigSeed); }
+
+inline MTRand::MTRand()
+	{ seed(); }
+
+inline double MTRand::rand()
+    { return double(randInt()) * 2.3283064370807974e-10; }
+
+inline double MTRand::rand( const double& n )
+	{ return rand() * n; }
+
+inline double MTRand::randExc()
+	{ return double(randInt()) * 2.3283064365386963e-10; }
+
+inline double MTRand::randExc( const double& n )
+	{ return randExc() * n; }
+
+inline MTRand::uint32 MTRand::randInt()
+{
+	if( left == 0 ) reload();
+	--left;
+		
+	register uint32 s1;
+	s1 = *pNext++;
+	s1 ^= (s1 >> 11);
+	s1 ^= (s1 <<  7) & 0x9d2c5680U;
+	s1 ^= (s1 << 15) & 0xefc60000U;
+	return ( s1 ^ (s1 >> 18) );
+}
+
+
+inline MTRand::uint32 MTRand::randInt( const uint32& n )
+{
+	// Find which bits are used in n
+	uint32 used = ~0;
+	for( uint32 m = n; m; used <<= 1, m >>= 1 ) {}
+	used = ~used;
+	
+	// Draw numbers until one is found in [0,n]
+	uint32 i;
+	do
+		i = randInt() & used;  // toss unused bits to shorten search
+	while( i > n );
+	return i;
+}
+
+
+inline void MTRand::seed( uint32 oneSeed )
+{
+	// Seed the generator with a simple uint32
+	register uint32 *s;
+	register int i;
+	for( i = N, s = state;
+	     i--;
+		 *s    = oneSeed & 0xffff0000,
+		 *s++ |= ( (oneSeed *= 69069U)++ & 0xffff0000 ) >> 16,
+		 (oneSeed *= 69069U)++ ) {}  // hard to read, but fast
+	reload();
+}
+
+
+inline void MTRand::seed( uint32 *const bigSeed )
+{
+	// Seed the generator with an array of 624 uint32's
+	// There are 2^19937-1 possible initial states.  This function allows
+	// any one of those to be chosen by providing 19937 bits.  The lower
+	// 31 bits of the first element, bigSeed[0], are discarded.  Any bits
+	// above the lower 32 in each element are also discarded.  Theoretically,
+	// the rest of the array can contain any values except all zeroes.
+	// Just call seed() if you want to get array from /dev/urandom
+	register uint32 *s = state, *b = bigSeed;
+	register int i = N;
+	for( ; i--; *s++ = *b++ & 0xffffffff ) {}
+	reload();
+}
+
+
+inline void MTRand::seed()
+{
+	// Seed the generator with an array from /dev/urandom if available
+	// Otherwise use a hash of time() and clock() values
+	
+	// First try getting an array from /dev/urandom
+	FILE* urandom = fopen( "/dev/urandom", "rb" );
+	if( urandom )
+	{
+		register uint32 *s = state;
+		register int i = N;
+		register bool success = true;
+		while( success && i-- )
+		{
+			success = fread( s, sizeof(uint32), 1, urandom );
+			*s++ &= 0xffffffff;  // filter in case uint32 > 32 bits
+		}
+		fclose(urandom);
+		if( success )
+		{
+			// There is a 1 in 2^19937 chance that a working urandom gave
+			// 19937 consecutive zeroes and will make the generator fail
+			// Ignore that case and continue with initialization
+			reload();
+			return;
+		}
+	}
+	
+	// Was not successful, so use time() and clock() instead
+	seed( hash( time(NULL), clock() ) );
+}
+
+
+inline void MTRand::reload()
+{
+	// Generate N new values in state
+	// Made clearer and faster by Matthew Bellew (matthew.bellew@home.com)
+	register uint32 *p = state;
+	register int i;
+	for( i = N - M; i--; )
+		*p++ = twist( p[M], p[0], p[1] );
+	for( i = M; --i; )
+		*p++ = twist( p[M-N], p[0], p[1] );
+	*p = twist( p[M-N], p[0], state[0] );
+
+	left = N, pNext = state;
+}
+
+
+inline MTRand::uint32 MTRand::hash( time_t t, clock_t c )
+{
+	// Get a uint32 from t and c
+	// Better than uint32(x) in case x is floating point in [0,1]
+	// Based on code by Lawrence Kirby (fred@genesis.demon.co.uk)
+
+	static uint32 differ = 0;  // guarantee time-based seeds will change
+
+	uint32 h1 = 0;
+	unsigned char *p = (unsigned char *) &t;
+	for( size_t i = 0; i < sizeof(t); ++i )
+	{
+		h1 *= UCHAR_MAX + 2U;
+		h1 += p[i];
+	}
+	uint32 h2 = 0;
+	p = (unsigned char *) &c;
+	for( size_t j = 0; j < sizeof(c); ++j )
+	{
+		h2 *= UCHAR_MAX + 2U;
+		h2 += p[j];
+	}
+	return ( h1 + differ++ ) ^ h2;
+}
+
+
+inline void MTRand::save( uint32* saveArray ) const
+{
+	register uint32 *sa = saveArray;
+	register const uint32 *s = state;
+	register int i = N;
+	for( ; i--; *sa++ = *s++ ) {}
+	*sa = left;
+}
+
+
+inline void MTRand::load( uint32 *const loadArray )
+{
+	register uint32 *s = state;
+	register uint32 *la = loadArray;
+	register int i = N;
+	for( ; i--; *s++ = *la++ ) {}
+	left = *la;
+	pNext = &state[N-left];
+}
+
+
+inline ostream& operator<<( ostream& os, const MTRand& mtrand )
+{
+	register const MTRand::uint32 *s = mtrand.state;
+	register int i = mtrand.N;
+	for( ; i--; os << *s++ << "\t" ) {}
+	return os << mtrand.left;
+}
+
+
+inline istream& operator>>( istream& is, MTRand& mtrand )
+{
+	register MTRand::uint32 *s = mtrand.state;
+	register int i = mtrand.N;
+	for( ; i--; is >> *s++ ) {}
+	is >> mtrand.left;
+	mtrand.pNext = &mtrand.state[mtrand.N-mtrand.left];
+	return is;
+}
+
+#endif  //MERSENNETWISTER_H
+
+// Change log:
+//
+// v0.1 - First release on 15 May 2000
+//      - Based on code by Makoto Matsumoto, Takuji Nishimura, and Shawn Cokus
+//      - Translated from C to C++
+//      - Made completely ANSI compliant
+//      - Designed convenient interface for initialization, seeding, and
+//        obtaining numbers in default or user-defined ranges
+//      - Added automatic seeding from /dev/urandom or time() and clock()
+//      - Provided functions for saving and loading generator state
+//
+// v0.2 - Fixed bug which reloaded generator one step too late
+//
+// v0.3 - Switched to clearer, faster reload() code from Matthew Bellew
+//
+// v0.4 - Removed trailing newline in saved generator format to be consistent
+//        with output format of built-in types
+//
+// v0.5 - Improved portability by replacing static const int's with enum's and
+//        clarifying return values in seed(); suggested by Eric Heimburg
+//      - Removed MAXINT constant; use 0xffffffff instead
+//
+// v0.6 - Eliminated seed overflow when uint32 is larger than 32 bits
+//      - Changed integer [0,n] generator to give better uniformity
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/README	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,43 @@
+Status as of Octave version 2.0.16/2.1.31
+
+Interface compatibility changes
+===============================
+lin2mu.m        (defaults to -1:1 audio range)
+mu2lin.m	(defaults to -1:1 audio range)
+
+Interface compatibility extensions
+==================================
+contour.m       (default number of contours)
+__pltopt1__.m   (accepts line types)
+cross.m		(accepts matrices)
+deblank.m	(accepts matrices, better \0 handling)
+fftfilt.m	(accepts matrices)
+freqz.m		(lots of changes)
+imagesc.m	(only display if not returning scaled image)
+polyder.m       (accepts a*b, a/b)
+polyderiv.m     (accepts a*b, a/b)
+polygcd.m	(new function for auto-reduction on polyder)
+rand.cc         (accepts "state" argument; use MT)
+MersenneTwister.h (long period random number generator)
+
+Interface extensions
+====================
+grid.m          (control x/y grids and grid density independently)
+
+Bug fixes
+=========
+tf2zp.m         (don't remember)
+zp2tf.m         (don't remember)
+
+Speedups
+========
+findstr.m
+hankel.m
+hilb.m
+index.m
+invhilb.m
+kron.m
+rindex.m
+toeplitz.m
+vander.m
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/contour.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,113 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} contour (@var{z}, @var{n})
+## @deftypefnx {Function File} {} contour (@var{x}, @var{y}, @var{z}, @var{n})
+## Make a contour plot of the three-dimensional surface described by
+## @var{z}.  Someone needs to improve @code{gnuplot}'s contour routines
+## before this will be very useful.
+## @end deftypefn
+## @seealso{plot, semilogx, semilogy, loglog, polar, mesh, contour,
+## bar, stairs, gplot, gsplot, replot, xlabel, ylabel, and title}
+
+## Author: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    matlab compatible interface
+
+function contour (x, y, z, n)
+
+  ## XXX FIXME XXX -- these plot states should really just be set
+  ## temporarily, probably inside an unwind_protect block, but there is
+  ## no way to determine their current values.
+
+  if (nargin == 1 || nargin == 2)
+    z = x;
+    if (nargin == 1) 
+      n = 10;
+    else
+      n = y; 
+    endif
+    if (is_matrix (z))
+      gset nosurface;
+      gset contour;
+      gset cntrparam bspline;
+      if (is_scalar (n))
+        command = sprintf ("gset cntrparam levels %d", n);
+      elseif (is_vector (n))
+        tmp = sprintf ("%f", n(1));
+        for i = 2:length (n)
+          tmp = sprintf ("%s, %f", tmp, n(i));
+        endfor
+        command = sprintf ("gset cntrparam levels discrete %s", tmp);
+      endif
+      eval (command);
+      gset noparametric;
+      gset view 0, 0, 1, 1;
+      gsplot z w l 1;
+    else
+      error ("contour: argument must be a matrix");
+    endif
+  elseif (nargin == 3 || nargin == 4)
+    if (nargin == 3) n = 9; endif
+    if (is_vector (x) && is_vector (y) && is_matrix (z))
+      xlen = length (x);
+      ylen = length (y);
+      if (xlen == rows (z) && ylen == columns (z))
+        if (rows (x) == 1)
+          x = x';
+        endif
+        len = 3 * ylen;
+        zz = zeros (xlen, len);
+        k = 1;
+        for i = 1:3:len
+          zz(:,i)   = x;
+          zz(:,i+1) = y(k) * ones (xlen, 1);
+          zz(:,i+2) = z(:,k);
+          k++;
+        endfor
+        gset nosurface;
+        gset contour;
+        gset cntrparam bspline;
+        if (is_scalar (n))
+          command = sprintf ("gset cntrparam levels %d", n);
+        elseif (is_vector (n))
+          tmp = sprintf ("%f", n(1));
+          for i = 2:length (n)
+            tmp = sprintf ("%s, %f", tmp, n(i));
+          endfor
+          command = sprintf ("gset cntrparam levels discrete %s", tmp);
+        endif
+        eval (command);
+        gset parametric;
+        gset view 0, 0, 1, 1;
+        gsplot zz w l 1;
+      else
+        msg = "contour: rows (z) must be the same as length (x) and";
+        msg = sprintf ("%s\ncolumns (z) must be the same as length (y)", msg);
+        error (msg);
+      endif
+    else
+      error ("contour: x and y must be vectors and z must be a matrix");
+    endif
+  else
+    usage ("contour (z, levels, x, y)");
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/cross.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,84 @@
+## Copyright (C) 1995, 1996  Kurt Hornik
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this file.  If not, write to the Free Software Foundation,
+## 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} cross (@var{x}, @var{y})
+## Computes the vector cross product of the two 3-dimensional vectors
+## @var{x} and @var{y}.
+##
+## A row vector is returned if @var{x} and @var{y} are both row vectors;
+## otherwise, a column vector is returned.
+##
+## If @var{x} and @var{y} are two - dimensional matrices the
+## cross product is applied along the first dimension with 3 elements.
+##
+## @example
+## @group
+## cross ([1,1,0], [0,1,1])
+##      @result{} [ 1; -1; 1 ]
+## @end group
+## @end example
+## @end deftypefn
+
+## Author: KH <Kurt.Hornik@ci.tuwien.ac.at>
+## Created: 15 October 1994
+## Adapted-By: jwe
+
+function z = cross (x, y)
+	
+  if (nargin != 2)
+    usage ("cross (x, y)");
+  endif
+ 
+  if (is_vector(x) && is_vector(y))
+    if (length (x) == 3 && length (y) == 3)
+
+      z = [x(2)*y(3) - x(3)*y(2);\
+           x(3)*y(1) - x(1)*y(3);\
+           x(1)*y(2) - x(2)*y(1)];
+
+      x_nr = rows (x);
+      y_nr = rows (y);
+
+      if (x_nr == y_nr && x_nr == 1)
+        z = z.';
+      endif
+
+    else
+      error ("cross: both x and y must be 3-dimensional vectors");
+    endif
+  elseif (size(x) == size(y))
+
+    [xr,xc]=size(x);
+
+    if (xr == 3)
+      x=x';y=y';
+	elseif (xc != 3)
+      error ("cross: x and y must have one dimension with 3 elements")
+    endif
+
+	z = [x(:,2).*y(:,3) .- x(:,3).*y(:,2)\
+         x(:,3).*y(:,1) .- x(:,1).*y(:,3)\
+         x(:,1).*y(:,2) .- x(:,2).*y(:,1)];
+
+    if (xr == 3)
+      z=z';
+    endif
+  else
+    error ("cross: for matrix arguments x and y must have same size");
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/deblank.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,78 @@
+## Copyright (C) 1996 Kurt Hornik
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} deblank (@var{s})
+## Removes the trailing blanks and nulls from the string @var{s}.
+## If @var{s} is a matrix, @var{deblank} trims each row to the 
+## length of longest string.
+## @end deftypefn
+
+## Author: Kurt Hornik <Kurt.Hornik@ci.tuwien.ac.at>
+## Adapted-By: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    vectorize for speed
+
+function t = deblank (s)
+
+  if (nargin != 1)
+    usage ("deblank (s)");
+  endif
+
+  if (isstr (s))
+
+    [nr, nc] = size (s);
+
+    if (nc == 0)
+      t = s;
+    else
+      ## Need to compare s against space and null.  Since "\0" is not
+      ## defined, need to use setstr.  Since setstr(0) is [], for 2.1.31
+      ## at least, need to store setstr([0, 1]) to variable t and use
+      ## t(1) as the null character.
+      t = setstr([0, 1]);
+      k = find (s != " " & s != t (1));
+      if isempty (k)
+	t = "";
+      else
+	t = s (:, 1 : ceil (max (k) / nr));
+      endif
+    endif
+
+  else
+    error ("deblank: expecting string argument");
+  endif
+
+endfunction
+
+%!assert (deblank(""), "");
+%!assert (deblank(" "), "");
+%!assert (deblank([" ", " "]), "")
+%!assert (isempty(deblank([" ", " "])));
+%!assert (deblank(" f o o "), " f o o");
+%!assert (deblank(["f "; "o "; "o "]), [ "f"; "o"; "o" ]);
+%!test
+%! ## Test strings containing \0 as well.  Need to work a bit to
+%! ## construct them, though.
+%! in = ["fr "; "o0 "; "o 0"]; 
+%! in(2,2:3) = setstr([0 32]);
+%! in(3,2:3) = setstr([32 0]);
+%! out = [ "fr"; "o0"; "o " ];
+%! out(2,:) = setstr([toascii("o") 0]);
+%! assert(deblank(in), out);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/fftfilt.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,100 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} fftfilt (@var{b}, @var{x}, @var{n})
+##
+## With two arguments, @code{fftfilt} filters @var{x} with the FIR filter
+## @var{b} using the FFT.
+##
+## Given the optional third argument, @var{n}, @code{fftfilt} uses the
+## overlap-add method to filter @var{x} with @var{b} using an N-point FFT.
+##
+## If @var{x} is a matrix, filter each column of the matrix.
+## @end deftypefn
+
+## Author: KH <Kurt.Hornik@ci.tuwien.ac.at>
+## Created: 3 September 1994
+## Adapted-By: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    handle matrices
+
+function y = fftfilt (b, x, N)
+
+  ## If N is not specified explicitly, we do not use the overlap-add
+  ## method at all because loops are really slow.  Otherwise, we only
+  ## ensure that the number of points in the FFT is the smallest power
+  ## of two larger than N and length(b).  This could result in length
+  ## one blocks, but if the user knows better ...
+
+  if (nargin < 2 || nargin > 3)
+    usage (" fftfilt (b, x, N)");
+  endif
+
+  transpose = rows(x) == 1;
+  if transpose, x = x.'; endif
+  [r_x, c_x] = size (x);
+  [r_b, c_b] = size (b);
+  if min ([r_b, c_b]) != 1
+    error ("fftfilt: b should be a vector");
+  endif
+  l_b  = r_b * c_b;
+  b = reshape (b, l_b, 1);
+
+  if (nargin == 2)
+    ## Use FFT with the smallest power of 2 which is >= length (x) +
+    ## length (b) - 1 as number of points ...
+    N    = 2^(ceil (log (r_x + l_b - 1) / log(2)));
+    B = fft (b, N);
+    y = ifft(fft (x, N) .* B(:,ones(1,c_x)));
+  else
+    ## Use overlap-add method ...
+    if (! (is_scalar (N)))
+      error ("fftfilt: N has to be a scalar");
+    endif
+    N = 2^(ceil (log (max ([N, l_b])) / log(2)));
+    L = N - l_b + 1;
+    B = fft (b, N);
+    R = ceil (r_x / L);
+    y = zeros (r_x, c_x);
+    for r = 1:R;
+      lo  = (r - 1) * L + 1;
+      hi  = min (r * L, r_x);
+      tmp = zeros(N,c_x);
+      tmp(1:(hi-lo+1),:) = x(lo:hi,:);
+      tmp = ifft(fft (tmp) .* B(:,ones(c_x,1)));
+      hi  = min (lo+N-1, r_x);
+      y(lo:hi,:) = y(lo:hi,:) + tmp(1:(hi-lo+1),:);
+    endfor
+  endif
+
+  y = y(1:r_x,:);
+  if transpose, y=y.'; endif
+
+  ## Final cleanups: if both x and b are real respectively integer, y
+  ## should also be
+
+  if (! (any (imag (x)) || any (imag (b))))
+    y = real (y);
+  endif
+  if (! (any (x - round (x)) || any (b - round (b))))
+    y = round (y);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/findstr.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,127 @@
+## Copyright (C) 1996 Kurt Hornik
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} findstr (@var{s}, @var{t}, @var{overlap})
+## Return the vector of all positions in the longer of the two strings
+## @var{s} and @var{t} where an occurrence of the shorter of the two starts.
+## If the optional argument @var{overlap} is nonzero, the returned vector
+## can include overlapping positions (this is the default).  For example,
+##
+## @example
+## findstr ("ababab", "a")
+##      @result{} [ 1, 3, 5 ]
+## findstr ("abababa", "aba", 0)
+##      @result{} [ 1, 5 ]
+## @end example 
+## @end deftypefn
+##
+## Note that this implementation swaps the strings if second on is longer
+## than the first, so try to put the longer one first.
+##
+## Author: Kurt Hornik <Kurt.Hornik@ci.tuwien.ac.at>
+## Adapted-By: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    vectorize for speed
+
+function v = findstr (s, t, overlap)
+
+  if (nargin < 2 || nargin > 3)
+    usage ("findstr (s, t, overlap)");
+  endif
+
+  if (!isstr (s) || !isstr (t) || all (size (s) > 1) || all (size (t) > 1) )
+    error ("findstr: expecting first two arguments to be strings");
+  endif
+
+  if (nargin == 2)
+    overlap = 1;
+  endif
+
+  ## Make S be the longer string.
+  if (length (s) < length (t))
+    tmp = s;
+    s = t;
+    t = tmp;
+  endif
+  
+  l_s = length (s);
+  l_t = length (t);
+  
+  if ( l_t == 0 )
+    ## zero length target: return all indices
+    v = 1 : l_s;
+    
+  elseif ( l_t == 1 )
+    ## length one target: simple find
+    v = find (s==t);
+    
+  elseif ( l_t == 2 )
+    ## length two target: find first at i and second at i+1
+    v = find (s (1 : l_s-1) == t (1) & s (2 : l_s) == t (2));
+    
+  else
+    ## length three or more: match the first three by find then go through
+    ## the much smaller list to determine which of them are real matches
+    limit = l_s - l_t + 1;
+    v = find (s (1 : limit) == t(1) & s (2 : limit+1) == t (2)
+	      & s (3 : limit+2) == t(3) );
+  endif
+
+  ## Need to search the index vector if our find was too short
+  ## (target length > 3), or if we don't allow overlaps.  Note though
+  ## that there cannot be any overlaps if the first character in the
+  ## target is different from the remaining characters in the target,
+  ## so a single character, two different characters, or first character
+  ## different from the second two don't need to be searched.
+  if ( l_t >= 3 || ( !overlap && l_t > 1 && any (t(1) == t(2:l_t)) ) )
+    ## force strings to be both row vectors or both column vectors
+    if (all (size (s) != size (t)))
+      t = t.';
+    endif
+    
+    ## determine which ones to keep
+    keep = zeros(size(v));
+    ind = 0:l_t-1;
+    if ( overlap )
+      for idx = 1:length(v)
+	keep(idx) = all (s (v(idx) + ind) == t);
+      endfor
+    else
+      next = 1; # first possible position for next non-overlapping match
+      for idx = 1:length(v)
+	if (v (idx) >= next && s (v (idx) + ind) == t)
+	  keep(idx) = 1;
+	  next = v(idx) + l_t; # skip to the next possible match position
+	else
+	  keep(idx) = 0;
+	endif
+      endfor
+    endif
+    if (!isempty(v))
+      v = v(find(keep));
+    endif
+  endif
+  
+  ## Always return a column vector, because that's what the old one did
+  if (rows (v) > 1) 
+    v = v.';
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/freqz.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,214 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {[@var{h}, @var{w}] =} freqz (@var{b}, @var{a}, @var{n}, "whole")
+## Return the complex frequency response @var{h} of the rational IIR filter
+## whose numerator and denominator coefficients are @var{b} and @var{a},
+## respectively.  The response is evaluated at @var{n} angular frequencies
+## between 0 and
+## @ifinfo
+##  2*pi.
+## @end ifinfo
+## @iftex
+## @tex
+##  $2\pi$.
+## @end tex
+## @end iftex
+##
+## @noindent
+## The output value @var{w} is a vector of the frequencies.
+##
+## If the fourth argument is omitted, the response is evaluated at
+## frequencies between 0 and
+## @ifinfo
+##  pi.
+## @end ifinfo
+## @iftex
+## @tex
+##  $\pi$.
+## @end tex
+## @end iftex
+##
+## If @var{n} is omitted, a value of 512 is assumed.
+##
+## If @var{a} is omitted, the denominator is assumed to be 1 (this
+## corresponds to a simple FIR filter).
+##
+## For fastest computation, @var{n} should factor into a small number of
+## small primes.
+##
+## @deftypefnx {Function File} {@var{h} =} freqz (@var{b}, @var{a}, @var{w})
+## Evaluate the response at the specific frequencies in the vector @{w}.
+##
+## @deftypefnx {Function File} {... =} freqz (..., @var{Fs})
+## Return frequencies in Hz instead of radians assuming a sampling rate
+## @{Fs}.  If you are evaluating the response at specific frequencies 
+## @var{w}, those frequencies should be requested in Hz rather than radians.
+##
+## @deftypefnx {Function File} freqz(...)
+## Plot the pass band, stop band and phase response of @var{h} rather
+## than returning them.
+##
+## @end deftypefn
+
+## Author: jwe ???
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    matlab compatible interface
+
+function [h_r, w_r] = freqz(b, a, n, region, Fs)
+
+  if (nargin<1 || nargin>5)
+    usage("[h w]=freqz(b, a, n [, 'whole'] [, Fs])");
+  elseif (nargin == 1)
+    ## Response of an FIR filter.
+    a=[]; n=[]; region=[]; Fs=[];
+  elseif (nargin == 2)
+    ## Response of an IIR filter
+    n=[]; region=[]; Fs=[];
+  elseif (nargin == 3)
+    region=[]; Fs=[];
+  elseif (nargin == 4)
+    Fs=[];
+    if !isstr(region) && !isempty(region)
+      Fs = region; region=[];
+    endif
+  endif
+
+  if isempty(a) a=1; endif
+  if isempty(n) n=512; endif
+  if isempty(region) 
+    if isreal(b) && isreal(a)
+      region = "half";
+    else
+      region = "whole";
+    endif
+  endif
+  if isempty(Fs) 
+    if (nargout==0) Fs = 2; else Fs = 2*pi; endif
+  endif
+
+  la = length(a);
+  a = reshape(a,1,la);
+  lb = length(b);
+  b = reshape(b,1,lb);
+  k = max([la, lb]);
+
+  if !is_scalar(n)
+    if nargin==4 ## Fs was specified
+      w = 2*pi*n/Fs;
+    else
+      w = n;
+    endif
+    n = length(n);
+    extent = 0;
+  elseif strcmp(region,"whole")
+    w = 2*pi*[0:(n-1)]/n;
+    extent = n;
+  else
+    w = pi*[0:(n-1)]/n;
+    extent = 2*n;
+  endif
+
+  if length(b) == 1
+    if length(a) == 1
+      hb=b*ones(1,n);
+    else
+      hb = b;
+    endif
+  elseif extent >= k 
+    hb = fft(postpad(b,extent));
+    hb = hb(1:n);
+  else
+    hb = polyval(postpad(b,k),exp(j*w));
+  endif
+  if length(a) == 1
+    ha = a;
+  elseif  extent >= k
+    ha = fft(postpad(a,extent));
+    ha = ha(1:n);
+  else
+    ha = polyval(postpad(a,k),exp(j*w));
+  endif
+  h = hb./ha;
+  w = Fs*w/(2*pi);
+
+  if nargout != 0, # return values and don't plot
+    h_r = h;
+    w_r = w;
+  else             # plot and don't return values
+    ## ## exclude zero-frequency
+    ## h = h(2:length(h));
+    ## w = w(2:length(w));
+    ## n = n-1;
+    mag = 20*log10(abs(h));
+    phase = unwrap(arg(h));
+    maxmag = max(mag);
+
+    unwind_protect # protect graph state
+      if gnuplot_has_multiplot
+      	subplot(311);
+      	gset lmargin 10;
+	axis("labely");
+	xlabel("");
+      endif
+      grid("on");
+      axis([w(1), w(n), maxmag-3, maxmag]);
+      plot(w, mag, ";Pass band (dB);");
+
+      if gnuplot_has_multiplot
+      	subplot(312);
+	axis("labely");
+	title("");
+	xlabel("");
+      	gset tmargin 0;
+      else
+	input("press any key for the next plot: ");
+      endif
+      grid("on");
+      if (maxmag - min(mag) > 100)
+      	axis([w(1), w(n), maxmag-100, maxmag]);
+      else
+      	axis("autoy");
+      endif
+      plot(w, mag, ";Stop band (dB);");
+      
+      if gnuplot_has_multiplot
+      	subplot(313);
+	axis("label");
+	title("");
+      else
+	input("press any key for the next plot: ");
+      endif
+      grid("on");
+      axis("autoy");
+      xlabel(["Frequency (Fs=", num2str(Fs), ")"]);
+      axis([w(1), w(n)]);
+      plot(w, phase/(2*pi), ";Phase (radians/2pi);");
+      
+    unwind_protect_cleanup # restore graph state
+      grid("off");
+      axis("auto","label");
+      gset lmargin;
+      gset tmargin;
+      oneplot();
+    end_unwind_protect
+  end
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/grid.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,94 @@
+## Copyright (C) 1996 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## usage: grid ("on" | "off" | mode)
+##
+## Turn grid lines on or off for plotting. Without any argument switch on or
+## off grid (depending of previous state).
+##
+## mode can be "x#y#z#", where # is the number of minor tics between the
+## major tics.  If x, y, or z is absent then no grid lines are produced
+## for that axis.  If # is absent then there are no grid lines for minor
+## tics.  If # is '-', then the current number of minor tics is
+## preserved and grid lines are turned on between them.
+##
+## Use "gset mxtics #" to control the number of minor tics directly.
+##
+## See also: plot, semilogx, semilogy, loglog, polar, mesh, contour,
+##           bar, stairs, gplot, gsplot, replot, xlabel, ylabel, title
+
+## Author: jwe
+## 2001-04-02  Laurent Mazet <mazet@crm.mot.com>
+##     * add support for semilog[xy] and loglog minor grid.
+##     * add mode feature (suggested by Paul Kienzle).
+
+function grid (mode)
+
+  if (nargin == 0)
+    if isempty(gget("grid"))
+      mode = "xyz";
+    else
+      mode = "";
+    endif
+  elseif (nargin == 1)
+    if (isstr (mode))
+      if (strcmp ("off", mode))
+        mode = "";
+      elseif (strcmp ("on", mode))
+        mode = "xyz";
+      endif
+    else
+      error ("grid: argument must be a string");
+    endif
+  else
+    error ("usage: grid (\"on\" | \"off\" | mode)");
+  endif
+
+  if isempty(mode)
+
+    gset nogrid;
+
+  else
+
+    len = length(mode);
+    i = 1;
+    while i <= len
+      if any(mode(i) == "xyz")
+	[n, has_n, err, next] = sscanf(mode(i+1:len), "%d", 1);
+	if has_n
+	  eval(sprintf("gset m%stics %d;", mode(i), n));
+	  eval(sprintf("gset grid %stics m%stics;", mode(i), mode(i)));
+	  i = i + next;
+	elseif i+1<=len && mode(i+1) == '-'
+	  eval(sprintf("gset grid %stics m%stics;", mode(i), mode(i)));
+	  i = i + 2;
+	else
+	  eval(sprintf("gset grid %stics nom%stics;", mode(i), mode(i)));
+	  i = i + 1;
+	endif
+      else
+	error("grid: unknown mode %s at character %d", mode, i);
+      endif
+    endwhile
+    if all(mode != "x"),  gset grid noxtics nomxtics; endif
+    if all(mode != "y"),  gset grid noytics nomytics; endif
+    if all(mode != "z"),  gset grid noztics nomztics; endif
+  endif
+  
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/hankel.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,93 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} hankel (@var{c}, @var{r})
+## Return the Hankel matrix constructed given the first column @var{c}, and
+## (optionally) the last row @var{r}.  If the last element of @var{c} is
+## not the same as the first element of @var{r}, the last element of
+## @var{c} is used.  If the second argument is omitted, the last row is
+## taken to be the same as the first column.
+##
+## A Hankel matrix formed from an m-vector @var{c}, and an n-vector
+## @var{r}, has the elements
+## @iftex
+## @tex
+## $$
+## H (i, j) = \cases{c_{i+j-1},&$i+j-1\le m$;\cr r_{i+j-m},&otherwise.\cr}
+## $$
+## @end tex
+## @end iftex
+## @ifinfo
+##
+## @example
+## @group
+## H (i, j) = c (i+j-1),  i+j-1 <= m;
+## H (i, j) = r (i+j-m),  otherwise
+## @end group
+## @end example
+## @end ifinfo
+## @end deftypefn
+## @seealso{vander, sylvester_matrix, hilb, invhilb, and toeplitz}
+
+## Author: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    vectorize for speed
+
+function retval = hankel (c, r)
+
+  if (nargin == 1)
+    r = zeros (size (c));
+  elseif (nargin != 2)
+    usage ("hankel (c, r)");
+  endif
+
+  [c_nr, c_nc] = size (c);
+  [r_nr, r_nc] = size (r);
+
+  if ((c_nr != 1 && c_nc != 1) || (r_nr != 1 && r_nc != 1))
+    error ("hankel: expecting vector arguments");
+  endif
+
+  if (nargin == 1)
+    r (1) = c (length (c));
+  endif
+
+  if (c_nc != 1)
+    c = c.';
+  endif
+
+  if (r_nc != 1)
+    r = r.';
+  endif
+
+  nc = length (r);
+  nr = length (c);
+
+  if (r (1) != c (nr))
+    warning ("hankel: column wins anti-diagonal conflict");
+  endif
+
+  if (nc > 1)
+    c = [ c ; r (2:nc) ];
+  endif
+  retval = c ( ones (nr, 1) * [1:nc] + [0:nr-1]' * ones (1, nc) );
+  retval = reshape (retval, nr, nc);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/hilb.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,65 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} hilb (@var{n})
+## Return the Hilbert matrix of order @var{n}.  The
+## @iftex
+## @tex
+## $i,\,j$
+## @end tex
+## @end iftex
+## @ifinfo
+## i, j
+## @end ifinfo
+## element of a Hilbert matrix is defined as
+## @iftex
+## @tex
+## $$
+## H (i, j) = {1 \over (i + j - 1)}
+## $$
+## @end tex
+## @end iftex
+## @ifinfo
+##
+## @example
+## H (i, j) = 1 / (i + j - 1)
+## @end example
+## @end ifinfo
+## @end deftypefn
+## @seealso{hankel, vander, sylvester_matrix, invhilb, and toeplitz}
+
+## Author: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    vectorize for speed
+
+function retval = hilb (n)
+
+  if (nargin != 1)
+    usage ("hilb (n)");
+  endif
+  
+  if (!is_scalar (n) || n != fix (n) || n < 1)
+    error ("hilb: expecting a positive integer"); 
+  endif
+  
+  retval = [1:n]' * ones (1, n) + ones (n, 1) * [0:n-1];
+  retval = 1 ./ retval;
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/imagesc.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,68 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} imagesc (@var{A}, @var{zoom})
+## @deftypefnx {Function File} {} imagesc (@var{x}, @var{y}, @var{A}, @var{zoom})
+## Display a scaled version of the matrix @var{A} as a color image.  The
+## matrix is scaled so that its entries are indices into the current
+## colormap.  The scaled matrix is returned.  If @var{zoom} is omitted, a
+## comfortable size is chosen.
+##
+## The axis values corresponding to the matrix elements are specified in
+## @var{x} and @var{y}.  At present they are ignored.
+## @end deftypefn
+## @seealso{image and imshow}
+
+## Author: Tony Richardson <arichard@stark.cc.oh.us>
+## Created: July 1994
+## Adapted-By: jwe
+
+function ret = imagesc (x, y, A, zoom)
+
+  if (nargin < 1 || nargin > 4)
+    usage ("imagesc (matrix, zoom) or imagesc (x, y, matrix, zoom)");
+  elseif (nargin == 1)
+    A = x;
+    zoom = [];
+    x = y = [];
+  elseif (nargin == 2)
+    A = x;
+    zoom = y;
+    x = y = [];
+  elseif (nargin == 3)
+    zoom = [];
+  endif
+
+  ## Rescale values to between 1 and length (colormap) inclusive.
+  maxval = max (A (:));
+  minval = min (A (:));
+  if (maxval == minval)
+    B = ones ( size (A) );
+  else
+    B = round ((A - minval) / (maxval - minval) * (rows (colormap) - 1)) + 1;
+  endif
+
+  if ( nargout > 0 )
+    ret = B;
+  else
+    image (x, y, B, zoom);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/index.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,102 @@
+## Copyright (C) 1996 Kurt Hornik
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} index (@var{s}, @var{t})
+## Return the position of the first occurrence of the string @var{t} in the
+## string @var{s}, or 0 if no occurrence is found.  For example,
+##
+## @example
+## index ("Teststring", "t")
+##      @result{} 4
+## @end example
+##
+## @strong{Note:}  This function does not work for arrays of strings.
+## @end deftypefn
+
+## Author: Kurt Hornik <Kurt.Hornik@ci.tuwien.ac.at>
+## Adapted-By: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    vectorize for speed
+
+function n = index (s, t)
+
+  ## This is patterned after the AWK function of the same name.
+
+  if (nargin != 2)
+    usage ("index (s, t)");
+  endif
+  
+  if (!isstr (s) || !isstr (t) || all (size (s) > 1) || all (size (t) > 1) )
+    error ("index: expecting string arguments");
+  endif
+
+  l_s = length (s);
+  l_t = length (t);
+  
+  if ( l_s == 0 || l_s < l_t )
+    ## zero length source, or target longer than source
+    v = [];
+    
+  elseif ( l_t == 0 )
+    ## zero length target: return first
+    v = 1;
+    
+  elseif ( l_t == 1 )
+    ## length one target: simple find
+    v = find (s==t);
+    
+  elseif ( l_t == 2 )
+    ## length two target: find first at i and second at i+1
+    v = find (s (1 : l_s-1) == t (1) & s (2 : l_s) == t (2));
+    
+  else
+    ## length three or more: match the first three by find then go through
+    ## the much smaller list to determine which of them are real matches
+    limit = l_s - l_t + 1;
+    v = find (s (1 : limit) == t(1) & s (2 : limit+1) == t (2)
+	      & s (3 : limit+2) == t(3) );
+  endif
+
+  if (l_t > 3)
+    
+    ## force strings to be both row vectors or both column vectors
+    if (all (size (s) != size (t)))
+      t = t.';
+    endif
+    
+    ## search index vector for a match
+    ind = 0 : l_t - 1;
+    n = 0; # return 0 if loop terminates without finding any match
+    for idx = 1:length(v)
+      if (s (v(idx) + ind) == t)
+	n = v(idx);
+	break;
+      endif
+    endfor
+
+  elseif (length(v) > 0)
+    n = v(1);
+
+  else
+    n = 0;
+
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/invhilb.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,91 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} invhilb (@var{n})
+## Return the inverse of a Hilbert matrix of order @var{n}.  This is exact.
+## Compare with the numerical calculation of @code{inverse (hilb (n))},
+## which suffers from the ill-conditioning of the Hilbert matrix, and the
+## finite precision of your computer's floating point arithmetic.
+## @end deftypefn
+## @seealso{hankel, vander, sylvester_matrix, hilb, and toeplitz}
+
+## Author: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    vectorize for speed
+
+
+function retval = invhilb (n)
+
+  if (nargin != 1)
+    usage ("invhilb (n)");
+  endif
+
+###
+###             1     Prod(k+i-1) Prod(k+j-1)
+### A(i,j) = -------  ----------- -----------
+###          (i+j-1)   Prod(k-i)   Prod(k-j)
+###                    k!=i        k!=i
+###
+### Consider starting at the diagonal and building the matrix along the
+### rows.  That is, find A(i,j+1) in terms of A(i,j).
+### Ignoring the 1/(i+j-1) for the moment, A(i,j+1)/A(i,j) is:
+###
+###      Prod(k+j)     Prod(k-j)       (n+j-1) (n+1-j)        (n)^2
+###     -----------  ------------- =   ------- ------- = 1 - -------
+###     Prod(k+j-1)  Prod(k-(j+1))      (j-1)   (1-j)        (j-i)^2
+###
+### So we can generate a row by taking the cumulative product of
+### (1 - (n/(j-1))^2), multiplying by the initial value Prod(k+i-1)/Prod(k-i)
+### and dividing by 1/(i+j-1).  Since it is symmetric, we only need to
+### generate half a row.
+###
+### The cumulative sum does introduce some error
+###    err_relative < 3*eps for n < 10
+### but rounding gets rid of that.  Error stays under control until at
+### least n=25 (err_relative < 10*eps).  After that I don't know since
+### I get bored of waiting for the old invhilb.  It is a factor of 100
+### slower at n=25, and going up as cube rather than a square.
+###
+### Note that the remaining for loop could probably be eliminated as
+### well, but there is hardly any point. invhilb -> Inf for n>134, and
+### that only takes 0.5 seconds to compute on my machine.  And it's not
+### like invhilb gets called a bunch, either, unlike e.g., an FFT which
+### operates directly on a signal.
+
+  nmax = length (n);
+  if (nmax == 1)
+    retval = zeros (n);
+    for l = 1:n
+      den = [ 1-l:n-l ]; 
+      den (l) = [];
+      lprod = prod (l:l+n-1) / prod (den);
+      if l==n
+	retval (l,l) = lprod^2 / (l+l-1);
+      else
+	row = [ lprod ;  1-(n./[l:n-1]').^2 ];
+      	retval (l:n, l) = lprod * cumprod (row) ./ ([l:n]' + l-1);
+      endif
+    endfor
+    retval = round (retval + retval.' - diag (diag (retval)));
+  else
+    error ("hilb: expecting scalar argument, found something else");
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/kron.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,66 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} kron (@var{a}, @var{b})
+## Form the kronecker product of two matrices, defined block by block as
+##
+## @example
+## x = [a(i, j) b]
+## @end example
+##
+## For example,
+##
+## @example
+## @group
+## kron (1:4, ones (3, 1))
+##      @result{}  1  2  3  4
+##          1  2  3  4
+##          1  2  3  4
+## @end group
+## @end example
+## @end deftypefn
+
+## Author: A. S. Hodel <scotte@eng.auburn.edu>
+## Created: August 1993
+## Adapted-By: jwe
+## Rewritten-By: Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+
+function x = kron (a, b)
+  if (nargin != 2)
+    usage ("kron (a, b)");
+  endif
+
+  [ra, ca] = size (a);
+  [rb, cb] = size (b);
+  if (isempty (a) || isempty (b))
+    x = zeros (ra*rb, ca*cb);
+  else
+    rak = 1:ra;    
+    rak = rak (ones (1, rb), :);
+    cak = 1:ca;    
+    cak = cak (ones (1, cb), :);
+    rbk = [1:rb]'; 
+    rbk = rbk (:, ones (1, ra));
+    cbk = [1:cb]'; 
+    cbk = cbk (:, ones (1, ca));
+    x = a (rak, cak) .* b (rbk, cbk);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/lin2mu.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,68 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} lin2mu (@var{x}, @var{bps})
+## If the matrix @var{x} represents audio data in linear encoding, 
+## @code{lin2mu} converts it to mu-law encoding.  The optional argument
+## @var{bps} specifies whether the output data uses 8 bit samples (range
+## -128 to 127), 16 bit samples (range -32768 to 32767) or default 0 for
+## real values (range -1 to 1).
+## @end deftypefn
+## @seealso{mu2lin, loadaudio, saveaudio, playaudio, setaudio, and record}
+
+## Author: AW <Andreas.Weingessel@ci.tuwien.ac.at>
+## Created: 17 October 1994
+## Adapted-By: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    handle [-1,1] input range
+
+function y = lin2mu (x, bit)
+
+  if (nargin == 1)
+    bit = 0;
+  elseif (nargin == 2)
+    if (bit != 0 && bit != 8 && bit != 16)
+      error ("lin2mu: bit must be either 0, 8 or 16");
+    endif
+  else
+    usage ("y = lin2mu (x, bit)");
+  endif
+
+
+  ## transform real and 8-bit format to 16-bit
+  if (bit == 0)
+    x = 32768 .* x;
+  elseif (bit == 8)
+    x = 256 .* x;
+  endif
+
+  ## determine sign of x, set sign(0) = 1.
+  sig = sign(x) + (x == 0);
+
+  ## take absolute value of x, but force it to be smaller than 32636;
+  ## add bias
+  x = min (abs (x), 32635 * ones (size (x))) + 132;
+
+  ## find exponent and fraction of bineary representation
+  [f, e] = log2 (x);
+
+  y = 64 * sig - 16 * e - fix (32 * f) + 335;
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/mu2lin.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,84 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} mu2lin (@var{x}, @var{bps})
+## If the matrix @var{x} represents audio data in mu-law encoding,
+## @code{mu2lin} converts it to linear encoding.  The optional argument
+## @var{bps} specifies whether the output data uses 8 bit samples (range
+## -128 to 127), 16 bit samples (range -32768 to 32767) or default 0 for
+## real values (range -1 to 1).
+## @end deftypefn
+## @seealso{lin2mu, loadaudio, saveaudio, playaudio, setaudio, and record}
+
+## Author: AW <Andreas.Weingessel@ci.tuwien.ac.at>
+## Created: 18 October 1994
+## Adapted-By: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    handle [-1,1] input range
+
+function y = mu2lin (x, bit)
+
+  if (nargin == 1)
+    bit = 0;
+  elseif (nargin == 2)
+    if (bit != 0 && bit != 8 && bit != 16)
+      error ("mu2lin: bit must be either 0, 8 or 16");
+    endif
+  else
+    usage ("y = mu2lin (x, bit)");
+  endif
+
+  ulaw = [\
+	  -32124, -31100, -30076, -29052, -28028, -27004, -25980, -24956, \
+	  -23932, -22908, -21884, -20860, -19836, -18812, -17788, -16764, \
+	  -15996, -15484, -14972, -14460, -13948, -13436, -12924, -12412, \
+	  -11900, -11388, -10876, -10364, -9852,  -9340,  -8828,  -8316, \
+	  -7932,  -7676,  -7420,  -7164,  -6908,  -6652,  -6396,  -6140, \
+	  -5884,  -5628,  -5372,  -5116,  -4860,  -4604,  -4348,  -4092, \
+	  -3900,  -3772,  -3644,  -3516,  -3388,  -3260,  -3132,  -3004, \
+	  -2876,  -2748,  -2620,  -2492,  -2364,  -2236,  -2108,  -1980, \
+	  -1884,  -1820,  -1756,  -1692,  -1628,  -1564,  -1500,  -1436, \
+	  -1372,  -1308,  -1244,  -1180,  -1116,  -1052,  -988,   -924, \
+	  -876,   -844,   -812,   -780,   -748,   -716,   -684,   -652, \
+	  -620,   -588,   -556,   -524,   -492,   -460,   -428,   -396, \
+	  -372,   -356,   -340,   -324,   -308,   -292,   -276,   -260, \
+	  -244,   -228,   -212,   -196,   -180,   -164,   -148,   -132, \
+	  -120,   -112,   -104,   -96,    -88,    -80,    -72,    -64, \
+	  -56,    -48,    -40,    -32,    -24,    -16,    -8,      0 ];
+  ulaw = [ ulaw, -ulaw ]';
+
+  [nr, nc] = size (x);
+  y = ulaw (x (:) + 1);
+  y = reshape (y, nr, nc);
+
+  ## convert to real or 8-bit
+  if (bit == 0)
+    y = y/32768;
+  elseif (bit == 8)
+    ld = max (max (abs (y)));
+    if (ld < 16384) #% && ld > 0)
+      sc = 64 / ld;
+    else
+      sc = 1 / 256;
+    endif
+    y = fix (y * sc);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/polyder.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,45 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} polyder (@var{c})
+## @deftypefnx {Function File} {[@var{q}] =} polyder (@var{b}, @var{a})
+## @deftypefnx {Function File} {[@var{q}, @var{r}] =} polyder (@var{b}, @var{a})
+## See polyderiv.
+## @end deftypefn
+
+## Author: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    handle b/a and b*a
+
+function [q, r] = polyder (p, a)
+
+  if (nargin == 1)
+    q = polyderiv (p);
+  elseif (nargin==2)
+    if (nargout==2)
+      [q, r] = polyderiv (p,a);
+    else
+      q = polyderiv (p,a);
+    endif
+  else
+    usage ("q=polyder(p) or q=polyder(b,a) or [q, r]=polyder(b,a)");
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/polyderiv.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,93 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} polyderiv (@var{c})
+## @deftypefnx {Function File} {[@var{q}] =} polyder (@var{b}, @var{a})
+## @deftypefnx {Function File} {[@var{q}, @var{r}] =} polyder (@var{b}, @var{a})
+## Return the coefficients of the derivative of the polynomial whose
+## coefficients are given by vector @var{c}.  If a pair of polynomials
+## is given @var{b} and @var{a}, the derivative of the product is
+## returned in @var{q}, or the quotient numerator in @var{q} and the
+## quotient denominator in @var{r}.
+## @end deftypefn
+## @seealso{poly, polyinteg, polyreduce, roots, conv, deconv, residue,
+## filter, polygcd, polyval, and polyvalm}
+
+## Author: Tony Richardson <arichard@stark.cc.oh.us>
+## Created: June 1994
+## Adapted-By: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    handle b/a and b*a
+
+function [q, r] = polyderiv (p, a)
+
+  if (nargin < 1 || nargin > 3)
+    usage ("q=polyderiv(p) or q=polyderiv(b,a) or [q, r]=polyderiv(b,a)");
+  endif
+
+  if (! is_vector (p))
+    error ("polyderiv: argument must be a vector");
+  endif
+
+  if (nargin == 2)
+    if (! is_vector (a))
+      error ("polyderiv: argument must be a vector");
+    endif
+    if (nargout == 1) 
+      ## derivative of p*a returns a single polynomial
+      q = polyderiv(conv(p,a));
+    else
+      ## derivative of p/a returns numerator and denominator
+      r = conv(a, a);
+      if length(p) == 1
+	q = -p * polyderiv(a);
+      elseif length(a) == 1
+	q = a * polyderiv(p);
+      else
+      	q = conv(polyderiv(p),a) - conv(p,polyderiv(a));
+      	q = polyreduce(q);
+      endif
+
+      ## remove common factors from numerator and denominator
+      x = polygcd(q,r);
+      if length(x)!=1
+      	q=deconv(q,x);
+      	r=deconv(r,x);
+      endif
+
+      ## move all the gain into the numerator
+      q=q/r(1);
+      r=r/r(1);
+    endif
+    return;
+  endif
+
+  lp = length (p);
+  if (lp == 1)
+    q = 0;
+    return;
+  elseif (lp == 0)
+    q = [];
+    return;
+  end
+
+  q = p (1:(lp-1)) .* [(lp-1):-1:1];
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/polygcd.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,65 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {[@var{q}]} polygcd (@var{b}, @var{a}, @var{tol})
+##
+## Find greatest common divisor of two polynomials.  This is equivalent
+## to the polynomial found by multiplying together all the common roots.
+## Together with deconv, you can reduce a ratio of two polynomials.
+## Tolerance defaults to 
+## @example 
+## sqrt(eps).
+## @end example
+##  Note that this is an unstable
+## algorithm, so don't try it on large polynomials.
+##
+## Example
+## @example
+##    polygcd(poly(1:8),poly(3:12)) - poly(3:8)
+##    deconv(poly(1:8),polygcd(poly(1:8),poly(3:12))) - poly(1:2)
+## @end example
+## @end deftypefn
+##
+## @seealso{poly, polyinteg, polyderiv, polyreduce, roots, conv, deconv,
+## residue, filter, polyval, and polyvalm}
+
+function x = polygcd(b,a,tol)
+  if (nargin<2 || nargin>3)
+    usage("x=polygcd(b,a [,tol])");
+  endif
+  if (nargin<3), tol=sqrt(eps); endif
+  if (length(a)==1 || length(b)==1)
+    if a==0, x=b;
+    elseif b==0, x=a;
+    else x=1;
+    endif
+    return;
+  endif
+  a = a./a(1);
+  while (1)
+    [d, r] = deconv(b, a);
+    nz = find(abs(r)>tol);
+    if isempty(nz)
+      x = a; 
+      return;
+    else
+      r = r(nz(1):length(r));
+    endif
+    b = a;
+    a = r./r(1);
+  endwhile
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/rand.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,447 @@
+/*
+
+Copyright (C) 1996, 1997 John W. Eaton
+
+This file is part of Octave.
+
+Octave is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+Octave is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with Octave; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+
+// Octave modules for the Mersenne Twister (MT199337) Random Number Generator
+// using Richard J. Wagner's C++ implementaion MersenneTwister.h
+//
+// This file provides two Octave functions:
+//    rand		for Uniform random number
+//    randn		for Normal random number
+//
+// Based on John Eaton's rand.cc and Dirk Eddelbuettel's randmt.cc
+// Copyright (C) 1996, 1997 John W. Eaton
+// Copyright (C) 1998, 1999 Dirk Eddelbuettel <edd@debian.org>
+//
+// 2001-02-10 Paul Kienzle
+//   * use Richard J. Wagner's MersenneTwister.h
+//   * use John Eaton's rand.cc for similar interface
+//   * add rand("state") to obtain complete state
+//   * renamed snorm to randn, and removed the `static' keyword from 
+//     the variables in randu after thoroughly checking that they were
+//     reset each time the function is entered.
+// $Id$
+
+#include <octave/oct.h>
+#include <octave/lo-mappers.h>
+#include "MersenneTwister.h"
+
+static MTRand randu;
+
+// The following routine to transform U(0,UINT_MAX) into N(0,1) is from 
+// the GNU GPL'ed randlib library by Brown, Lovato, Russell and Venier 
+// which is available from   ftp://odin.mdacc.tmc.edu/pub/source
+double randn(void)
+/*
+**********************************************************************
+                                                                      
+                                                                      
+     (STANDARD-)  N O R M A L  DISTRIBUTION                           
+                                                                      
+                                                                      
+**********************************************************************
+**********************************************************************
+                                                                      
+     FOR DETAILS SEE:                                                 
+                                                                      
+               AHRENS, J.H. AND DIETER, U.                            
+               EXTENSIONS OF FORSYTHE'S METHOD FOR RANDOM             
+               SAMPLING FROM THE NORMAL DISTRIBUTION.                 
+               MATH. COMPUT., 27,124 (OCT. 1973), 927 - 937.          
+                                                                      
+     ALL STATEMENT NUMBERS CORRESPOND TO THE STEPS OF ALGORITHM 'FL'  
+     (M=5) IN THE ABOVE PAPER     (SLIGHTLY MODIFIED IMPLEMENTATION)  
+                                                                      
+     Modified by Barry W. Brown, Feb 3, 1988 to use RANF instead of   
+     SUNIF.  The argument IR thus goes away.                          
+
+     Modified by Dirk Eddelbuettel <edd@debian.org> on 1 Aug 1999
+     to use randu() instead of RANF
+
+**********************************************************************
+     THE DEFINITIONS OF THE CONSTANTS A(K), D(K), T(K) AND
+     H(K) ARE ACCORDING TO THE ABOVEMENTIONED ARTICLE
+*/
+{
+  const double a[32] = {
+    0.0,3.917609E-2,7.841241E-2,0.11777,0.1573107,0.1970991,0.2372021,0.2776904,
+    0.3186394,0.36013,0.4022501,0.4450965,0.4887764,0.5334097,0.5791322,
+    0.626099,0.6744898,0.7245144,0.7764218,0.8305109,0.8871466,0.9467818,
+    1.00999,1.077516,1.150349,1.229859,1.318011,1.417797,1.534121,1.67594,
+    1.862732,2.153875
+  };
+  const double d[31] = {
+    0.0,0.0,0.0,0.0,0.0,0.2636843,0.2425085,0.2255674,0.2116342,0.1999243,
+    0.1899108,0.1812252,0.1736014,0.1668419,0.1607967,0.1553497,0.1504094,
+    0.1459026,0.14177,0.1379632,0.1344418,0.1311722,0.128126,0.1252791,
+    0.1226109,0.1201036,0.1177417,0.1155119,0.1134023,0.1114027,0.1095039
+  };
+  const double t[31] = {
+    7.673828E-4,2.30687E-3,3.860618E-3,5.438454E-3,7.0507E-3,8.708396E-3,
+    1.042357E-2,1.220953E-2,1.408125E-2,1.605579E-2,1.81529E-2,2.039573E-2,
+    2.281177E-2,2.543407E-2,2.830296E-2,3.146822E-2,3.499233E-2,3.895483E-2,
+    4.345878E-2,4.864035E-2,5.468334E-2,6.184222E-2,7.047983E-2,8.113195E-2,
+    9.462444E-2,0.1123001,0.136498,0.1716886,0.2276241,0.330498,0.5847031
+  };
+  const double h[31] = {
+    3.920617E-2,3.932705E-2,3.951E-2,3.975703E-2,4.007093E-2,4.045533E-2,
+    4.091481E-2,4.145507E-2,4.208311E-2,4.280748E-2,4.363863E-2,4.458932E-2,
+    4.567523E-2,4.691571E-2,4.833487E-2,4.996298E-2,5.183859E-2,5.401138E-2,
+    5.654656E-2,5.95313E-2,6.308489E-2,6.737503E-2,7.264544E-2,7.926471E-2,
+    8.781922E-2,9.930398E-2,0.11556,0.1404344,0.1836142,0.2790016,0.7010474
+  };
+  int i;
+  double u, s, snorm, ustar, aa, w, y, tt;
+  u = randu();
+  s = 0.0;
+  if(u > 0.5) s = 1.0;
+  u += (u-s);
+  u = 32.0*u;
+  i = (int) (u);
+  if(i == 32) i = 31;
+  if(i == 0) goto S100;
+  /*
+    START CENTER
+  */
+  ustar = u-(double)i;
+  aa = *(a+i-1);
+ S40:
+  if(ustar <= *(t+i-1)) goto S60;
+  w = (ustar-*(t+i-1))**(h+i-1);
+ S50:
+  /*
+    EXIT   (BOTH CASES)
+  */
+  y = aa+w;
+  snorm = y;
+  if(s == 1.0) snorm = -y;
+  return snorm;
+ S60:
+  /*
+    CENTER CONTINUED
+  */
+  u = randu();
+  w = u*(*(a+i)-aa);
+  tt = (0.5*w+aa)*w;
+  goto S80;
+ S70:
+  tt = u;
+  ustar = randu();
+ S80:
+  if(ustar > tt) goto S50;
+  u = randu();
+  if(ustar >= u) goto S70;
+  ustar = randu();
+  goto S40;
+ S100:
+  /*
+    START TAIL
+  */
+  i = 6;
+  aa = *(a+31);
+  goto S120;
+ S110:
+  aa += *(d+i-1);
+  i += 1;
+ S120:
+  u += u;
+  if(u < 1.0) goto S110;
+  u -= 1.0;
+ S140:
+  w = u**(d+i-1);
+  tt = (0.5*w+aa)*w;
+  goto S160;
+ S150:
+  tt = u;
+ S160:
+  ustar = randu();
+  if(ustar > tt) goto S50;
+  u = randu();
+  if(ustar >= u) goto S150;
+  u = randu();
+  goto S140;
+}
+
+
+// Octave interface starts here
+
+static octave_value 
+do_seed (octave_value_list args)
+{
+  octave_value retval;
+
+  // Check if they said the magic words
+  std::string s_arg = args(0).string_value ();
+  if (s_arg == "seed")
+    {
+      // If they ask for the current "seed", then reseed with the next
+      // available random number
+      MTRand::uint32 a = randu.randInt();
+      randu.seed(a);
+      retval = (double)a;
+    }
+  else if (s_arg == "state")
+    {
+      MTRand::uint32 state[randu.SAVE];
+      randu.save(state);
+      RowVector a(randu.SAVE);
+      for (int i=0; i < randu.SAVE; i++)
+	a(i) = state[i];
+      retval = a;
+    }
+  else
+    {
+      error ("rand: unrecognized string argument");
+      return retval;
+    }
+
+  // Check if just getting state
+  if (args.length() == 1)
+    return retval;
+
+  // Set the state from either a scalar or a previously returned state vector
+  octave_value tmp = args(1);
+  if (tmp.is_scalar_type ())
+    {
+      MTRand::uint32 n = MTRand::uint32(tmp.double_value());
+      if (! error_state)
+	randu.seed(n);
+    }
+  else if (tmp.is_matrix_type () 
+	   && tmp.rows() == randu.SAVE && tmp.columns() == 1)
+    {
+      Array<double> a(tmp.vector_value ());
+      if (! error_state)
+	{
+	  MTRand::uint32 state[randu.SAVE];
+	  for (int i = 0; i < randu.SAVE; i++)
+	    state[i] = MTRand::uint32(a(i));
+	  randu.load(state);
+	}
+    }
+  else
+    error ("rand: not a state vector");
+  
+  return retval;
+}
+
+static void
+do_size(octave_value_list args, int& nr, int& nc)
+{
+  int nargin = args.length();
+
+  if (nargin == 0)
+    {
+      nr = nc = 1;
+    }
+  else if (nargin == 1)
+    {
+      octave_value tmp = args(0);
+
+      if (tmp.is_scalar_type ())
+	{
+	  double dval = tmp.double_value ();
+	  
+	  if (xisnan (dval))
+	    {
+	      error ("rand: NaN is invalid a matrix dimension");
+	    }
+	  else
+	    {
+	      nr = nc = NINT (tmp.double_value ());
+	    }
+	}
+      else if (tmp.is_range ())
+	{
+	  Range rng = tmp.range_value ();
+	  nr = 1;
+	  nc = rng.nelem ();
+	}
+      else if (tmp.is_matrix_type ())
+	{
+	  // XXX FIXME XXX -- this should probably use the function
+	  // from data.cc.
+
+	  Matrix a = args(0).matrix_value ();
+
+	  if (error_state)
+	    return;
+	  
+	  nr = a.rows ();
+	  nc = a.columns ();
+	  
+	  if (nr == 1 && nc == 2)
+	    {
+	      nr = NINT (a (0, 0));
+	      nc = NINT (a (0, 1));
+	    }
+	  else if (nr == 2 && nc == 1)
+	    {
+	      nr = NINT (a (0, 0));
+	      nc = NINT (a (1, 0));
+	    }
+	  else
+	    warning ("rand (A): use rand (size (A)) instead");
+	}
+      else
+	{
+	  gripe_wrong_type_arg ("rand", tmp);
+	}
+    }
+  else if (nargin == 2)
+    {
+      double rval = args(0).double_value ();
+      double cval = args(1).double_value ();
+      if (! error_state)
+	{
+	  if (xisnan (rval) || xisnan (cval))
+	    {
+	      error ("rand: NaN is invalid as a matrix dimension");
+	    }
+	  else
+	    {
+	      nr = NINT (rval);
+	      nc = NINT (cval);
+	    }
+	}
+    }
+}
+
+DEFUN_DLD (rand, args, nargout, 
+  "-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {} rand (@var{x})\n\
+@deftypefnx {Loadable Function} {} rand (@var{n}, @var{m})\n\
+@deftypefnx {Loadable Function} {@var{v} =} rand (\"state\", @var{x})\n\
+@deftypefnx {Loadable Function} {@var{s} =} rand (\"seed\", @var{x})\n\
+Return a matrix with random elements uniformly distributed on the\n\
+semi-open interval [0, 1).  The arguments are handled the same as the\n\
+arguments for @code{eye}.\n\
+\n\
+You can reset the state of the random number generator using the\n\
+form\n\
+\n\
+@example\n\
+v = rand (\"state\", x)\n\
+@end example\n\
+\n\
+where @var{x} is a scalar value.  This returns the current state\n\
+of the random number generator in the column vector @var{v}.  If\n\
+@var{x} is not given, then the state is returned but not changed.\n\
+Later, you can restore the random number generator to the state @var{v}\n\
+using the form\n\
+\n\
+@example\n\
+u = rand (\"state\", v)\n\
+@end example\n\
+\n\
+@noindent\n\
+If instead of \"state\" you use \"seed\" to query the random\n\
+number generator, then the state will be collapsed from roughly\n\
+20000 bits down to 32 bits.\n\
+\n\
+@code{rand} uses the Mersenne Twister, with a period of 2^19937-1.\n\
+Do NOT use for CRYPTOGRAPHY without securely hashing several returned\n\
+values together, otherwise the generator state can be learned after\n\
+reading 624 consecutive values.\n\
+\n\
+M. Matsumoto and T. Nishimura, ``Mersenne Twister: A 623-dimensionally\n\
+equidistributed uniform pseudorandom number generator'', ACM Trans. on\n\
+Modeling and Computer Simulation Vol. 8, No. 1, Januray pp.3-30 1998\n\
+\n\
+http://www.math.keio.ac.jp/~matumoto/emt.html\n\
+@end deftypefn\n\
+@seealso{randn}\n")
+{
+  octave_value_list retval;	// list of return values
+
+  int nargin = args.length ();	// number of arguments supplied
+  if (nargin > 2) 
+    print_usage("rand");
+
+  else if (nargin > 0 && args(0).is_string())
+    retval(0) = do_seed (args);
+
+  else
+    {
+      int nr=0, nc=0;
+      do_size (args, nr, nc);
+
+      if (! error_state)
+	{
+	  Matrix X(nr, nc);
+
+	  for (int c=0; c < nc; c++)
+	    for (int r=0; r < nr; r++)
+	      X(r,c) = randu.randExc();
+	  retval(0) = X;
+	}
+    }
+
+  return retval;
+}
+
+DEFUN_DLD (randn, args, nargout, 
+  "-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {} randn (@var{x})\n\
+@deftypefnx {Loadable Function} {} randn (@var{n}, @var{m})\n\
+@deftypefnx {Loadable Function} {@var{v} =} randn (\"state\", @var{x})\n\
+@deftypefnx {Loadable Function} {@var{s} =} randn (\"seed\", @var{x})\n\
+Return a matrix with normally distributed random elements.  The\n\
+arguments are handled the same as the arguments for @code{rand}.\n\
+\n\
+@code{randn} uses Ahrens and Dieter (1973) to transform from U to N(0,1).\n\n\
+@end deftypefn\n\
+@seealso{rand}\n")
+{
+  octave_value_list retval;	// list of return values
+
+  int nargin = args.length ();	// number of arguments supplied
+  if (nargin > 2) 
+    print_usage("randn");
+
+  else if (nargin > 0 && args(0).is_string())
+    retval(0) = do_seed (args);
+
+  else
+    {
+      int nr=0, nc=0;
+      do_size (args, nr, nc);
+
+      if (! error_state)
+	{
+	  Matrix X(nr, nc);
+
+	  for (int c=0; c < nc; c++)
+	    for (int r=0; r < nr; r++)
+	      X(r,c) = randn();
+	  retval(0) = X;
+	}
+    }
+
+  return retval;
+}
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; End: ***
+*/
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/rindex.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,102 @@
+## Copyright (C) 1996 Kurt Hornik
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} rindex (@var{s}, @var{t})
+## Return the position of the last occurrence of the string @var{t} in the
+## string @var{s}, or 0 if no occurrence is found.  For example,
+##
+## @example
+## rindex ("Teststring", "t")
+##      @result{} 6
+## @end example
+##
+## @strong{Note:}  This function does not work for arrays of strings.
+## @end deftypefn
+
+## Author: Kurt Hornik <Kurt.Hornik@ci.tuwien.ac.at>
+## Adapted-By: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    vectorized for speed
+
+function n = rindex (s, t)
+
+  ## This is patterned after the AWK function of the same name.
+
+  if (nargin != 2)
+    usage ("rindex (s, t)");
+  endif
+
+  if (!isstr (s) || !isstr (t) || all (size (s) > 1) || all (size (t) > 1) )
+    error ("rindex: expecting string arguments");
+  endif
+
+  l_s = length (s);
+  l_t = length (t);
+
+  if ( l_s == 0 || l_s < l_t )
+    ## zero length source, or target longer than source
+    v = [];
+    
+  elseif ( l_t == 0 )
+    ## zero length target: return last
+    v = l_s;
+    
+  elseif ( l_t == 1 )
+    ## length one target: simple find
+    v = find (s==t);
+    
+  elseif ( l_t == 2 )
+    ## length two target: find first at i and second at i+1
+    v = find (s (1 : l_s-1) == t (1) & s (2 : l_s) == t (2));
+    
+  else
+    ## length three or more: match the first three by find then go through
+    ## the much smaller list to determine which of them are real matches
+    limit = l_s - l_t + 1;
+    v = find (s (1 : limit) == t(1) & s (2 : limit+1) == t (2)
+	      & s (3 : limit+2) == t(3) );
+  endif
+
+  if (l_t > 3)
+    
+    ## force strings to be both row vectors or both column vectors
+    if (all (size (s) != size (t)))
+      t = t.';
+    endif
+    
+    ## search index vector for a match
+    ind = 0 : l_t - 1;
+    n = 0; # return 0 if loop terminates without finding any match
+    for idx = length(v):-1:1
+      if (s (v(idx) + ind) == t)
+	n = v(idx);
+	break;
+      endif
+    endfor
+
+  elseif (length(v) > 0)
+    n = v(length(v));
+
+  else
+    n = 0;
+
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/tf2zp.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,37 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [z, p, g] = tf2zp(b,a)
+##
+## Convert transfer function f(x)=sum(b*x^n)/sum(a*x^n) to
+## zero-pole-gain form f(x)=g*prod(1-z*x)/prod(1-p*x)
+
+## TODO: See if tf2ss followed by ss2zp gives better results.  These
+## TODO: are available from the control system toolbox.  Note that
+## TODO: the control systems toolbox doesn't bother, but instead uses
+## TODO: roots(b) and roots(a) as we do here (though they are very
+## TODO: long-winded about it---must ask why).
+function [z, p, g] = tf2zp(b, a)
+  if nargin!=2 || nargout!=3,
+    usage("[z, p, g] = tf2zp(b, a)");
+  endif
+  if isempty(b) || isempty(a)
+    error("tf2zp b or a is empty. Perhaps already in zero-pole form?");
+  endif
+  g = b(1)/a(1);
+  z = roots(b);
+  p = roots(a);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/toeplitz.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,110 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} toeplitz (@var{c}, @var{r})
+## Return the Toeplitz matrix constructed given the first column @var{c},
+## and (optionally) the first row @var{r}.  If the first element of @var{c}
+## is not the same as the first element of @var{r}, the first element of
+## @var{c} is used.  If the second argument is omitted, the first row is
+## taken to be the same as the first column.
+##
+## A square Toeplitz matrix has the form
+## @iftex
+## @tex
+## $$
+## \left[\matrix{c_0    & r_1     & r_2      & \ldots & r_n\cr
+##               c_1    & c_0     & r_1      &        & c_{n-1}\cr
+##               c_2    & c_1     & c_0      &        & c_{n-2}\cr
+##               \vdots &         &          &        & \vdots\cr
+##               c_n    & c_{n-1} & c_{n-2} & \ldots & c_0}\right].
+## $$
+## @end tex
+## @end iftex
+## @ifinfo
+##
+## @example
+## @group
+## c(0)  r(1)   r(2)  ...  r(n)
+## c(1)  c(0)   r(1)      r(n-1)
+## c(2)  c(1)   c(0)      r(n-2)
+##  .                       .
+##  .                       .
+##  .                       .
+##
+## c(n) c(n-1) c(n-2) ...  c(0)
+## @end group
+## @end example
+## @end ifinfo
+## @end deftypefn
+## @seealso{hankel, vander, sylvester_matrix, hilb, and invhib}
+
+## Author: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    vectorized for speed
+
+function retval = toeplitz (c, r)
+
+  if (nargin == 1)
+    r = c;
+  elseif (nargin != 2)
+    usage ("toeplitz (c, r)");
+  endif
+
+  [c_nr, c_nc] = size (c);
+  [r_nr, r_nc] = size (r);
+
+  if ((c_nr != 1 && c_nc != 1) || (r_nr != 1 && r_nc != 1))
+    error ("toeplitz: expecting vector arguments");
+  endif
+
+  if (c_nc != 1)
+    c = c.';
+  endif
+
+  if (r_nc != 1)
+    r = r.';
+  endif
+
+  if (r (1) != c (1))
+    warning ("toeplitz: column wins diagonal conflict");
+  endif
+
+  ## If we have a single complex argument, we want to return a
+  ## Hermitian-symmetric matrix (actually, this will really only be
+  ## Hermitian-symmetric if the first element of the vector is real).
+
+  if (nargin == 1)
+    c = conj (c);
+    c(1) = conj (c(1));
+  endif
+
+  nc = length (r);
+  nr = length (c);
+
+  ## Indexing magic: by pasting r and c together we can access both
+  ## appropriately for a column simply by sliding a linear index vector
+  ## up or down.
+  if (nc > 1) 
+    c = [ r(nc:-1:2) ; c ];
+  endif
+  retval = c ( [1:nr]' * ones (1, nc) + ones (nr, 1) * [nc-1:-1:0] );
+  retval = reshape (retval, nr, nc);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/vander.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,71 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} vander (@var{c})
+## Return the Vandermonde matrix whose next to last column is @var{c}.
+##
+## A Vandermonde matrix has the form
+## @iftex
+## @tex
+## $$
+## \left[\matrix{c_0^n  & \ldots & c_0^2  & c_0    & 1\cr
+##               c_1^n  & \ldots & c_1^2  & c_1    & 1\cr
+##               \vdots &        & \vdots & \vdots & \vdots\cr
+##               c_n^n  & \ldots & c_n^2  & c_n    & 1}\right].
+## $$
+## @end tex
+## @end iftex
+## @ifinfo
+##
+## @example
+## @group
+## c(0)^n ... c(0)^2  c(0)  1
+## c(1)^n ... c(1)^2  c(1)  1
+##  .           .      .    .
+##  .           .      .    .
+##  .           .      .    .
+##
+## c(n)^n ... c(n)^2  c(n)  1
+## @end group
+## @end example
+## @end ifinfo
+## @end deftypefn
+## @seealso{hankel, sylvester_matrix, hilb, invhilb, and toeplitz}
+
+## Author: jwe
+## Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    vectorized for speed
+
+function retval = vander (c)
+
+  if (nargin != 1) 
+    usage ("vander (c)");
+  endif
+
+  if (!is_vector (c))
+    error ("vander: argument must be a vector"); 
+  endif
+
+  n = length (c);
+  retval = c ([1:n]' * ones (1, n));
+  retval = reshape (retval, n, n);
+  retval = retval .^ (ones (n, 1) * [n-1:-1:0]);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FIXES/zp2tf.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,30 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [b, a] = zp2tf(z, p, g)
+##
+## Convert to transfer function f(x)=sum(b*x^n)/sum(a*x^n) from
+## zero-pole-gain form f(x)=g*prod(1-z*x)/prod(1-p*x)
+
+function [b, a] = zp2tf(z, p, g)
+  if nargin != 3 || nargout != 2
+    usage("[b, a] = zp2tf(z, p, g)");
+  endif
+  try cplxpair(z); catch error("zp2tf: could not pair complex zeros"); end
+  try cplxpair(p); catch error("zp2tf: could not pair complex poles"); end
+  b = g*real(poly(z));
+  a = real(poly(p));
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/INSTALL	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,258 @@
+=======================================================================
+Simple end user installation
+
+$ tar xzf octave-forge-<ver>.tar.gz
+$ cd octave-forge-<ver>
+$ find . -name NOINSTALL -print
+
+This lists the packages that won't be installed by default.  For
+explanations, see the end of this file.  Remove NOINSTALL for each 
+one that you do indeed want to install.
+
+$ ./configure --with-path=~/octave-forge --prefix=~
+$ make
+$ make install
+
+Remove anything from ~/octave-forge/FIXES that are superceded by recent 
+versions of Octave.
+
+Add the following to ~/.octaverc:
+
+    LOADPATH = [ getenv("HOME"), "/octave-forge//:", LOADPATH ];
+    EXEC_PATH = [ getenv("HOME"), "/octave-forge/bin:", EXEC_PATH ];
+
+If you are using Octave 2.0.x, copy extra/ver20 to ~/octave-forge/ver20
+and add 
+    LOADPATH = [ getenv("HOME"), "/octave-forge/ver20:", LOADPATH ];
+after the previous LOADPATH update statement.
+
+If you are using mex files, make sure that ~/bin is on your path.
+The [much too terse] man page for the mex program is in ~/man/man1.  
+You can read it with "nroff -man ~/man/man1/mex.1 | more"
+
+=======================================================================
+Simple system installation
+
+$ tar xzf octave-forge-<ver>.tar.gz
+$ cd octave-forge-<ver>
+$ find . -name NOINSTALL -print
+
+This lists the packages that won't be installed by default.  For
+explanations, see the end of this file.  Remove NOINSTALL for each 
+one that you do indeed want to install.
+
+$ ./configure
+$ make
+$ su
+root$ cd <path-to>/octave-forge-<ver>
+root$ make install
+
+Remove anything from <site-m-files>/octave-forge/FIXES and <site-oct-files>
+that are superceded by recent versions of Octave.
+
+If you are using Octave 2.0.x, copy extra/ver20 to <site-m-files>/ver20,
+and make sure that <site-m-files>/ver20 is listed first on you system
+LOADPATH.  You can set this up in
+	/usr/local/share/octave/<version>/m/startup/octaverc.m
+or whatever the system startup file is on your site. 
+
+=======================================================================
+Details
+
+The source archive is compiled using tar and compressed using gzip.
+Unpack the archive using
+	$ tar xzf octave-forge-<ver>.tar.gz
+or if you are not using GNU tar
+	$ gunzip -c octave-forge-<ver>.tar.gz | tar xf -
+Then change to the octave-forge directory
+	$ cd octave-forge-<ver>
+
+This assumes you have a file octave-forge-<ver>.tar.gz.  If you are
+building from CVS sources, you will need to login to the server 
+	$ cvs -d:pserver:anonymous@cvs.octave.sf.net:/cvsroot/octave login 
+[press <Enter> when it asks for a password] and check out the source tree
+	$ cvs -z3 -d:pserver:anonymous@cvs.octave.sf.net:/cvsroot/octave co \
+		octave-forge
+If you want a specific version yyyy.mm.dd, then specify "-r Ryyyy-mm-dd".
+Next remove the CVS control files
+	$ find octave-forge -name CVS -print | xargs rm -rf
+Then change to the octave-forge directory
+	$ cd octave-forge
+and build the configure script
+	$ ./autogen.sh
+
+Packages containing the file NOINSTALL will not be built or installed.
+    $ find . -name NOINSTALL -print
+Remove any NOINSTALL files from packages that you actually want to install.
+
+Environment variables:
+
+    Some configuration options are taken from the environment.  These 
+    may be specified using
+	$ var1=val1 var2=val2 ... ./configure
+    or if you are not using the borne shell
+	$ env var1=val1 var2=val2 ... ./configure
+
+
+    MKOCTFILE=...
+	Override the default mkoctfile used to build oct-files.  Normally
+	you will not need to specify it, but if you are maintaining
+	separate versions of Octave on your system (e.g., a patched
+	version in addition to the normal version, or version 2.0 in
+	addition to version 2.1), you will need to specify which version
+	you are building for directly.
+
+    CFLAGS=...
+    CC=...
+    CXX=...
+    CXXFLAGS=...
+    etc.
+	Override the compiler options
+
+Configure options:
+
+    --with-path=...
+	Base install directory.  m-files will be installed in
+	mpath=<prefix>/<package>, where <package> is the name 
+	of the directory containing the m-file. oct-files will be 
+	installed in opath=<prefix>/oct.  Supporting executables 
+	will be installed in xpath=<prefix>/bin.  
+
+        The default path, opath, and xpath are extracted from 
+        <octave/defaults.h> and will depend on how your version of 
+        Octave was built.  Watch the output of make install to see 
+        which paths it uses.  If your system is set up correctly, you 
+	will not need to specify --prefix, and upon install all the 
+        scripts will be available to you.  Note that by default the
+        scripts are all placed in the version-specific directories 
+        of Octave, so if you upgrade to a new version of Octave, you 
+        will need to rebuild and reinstall octave-forge.  Any data files 
+        (e.g., main/audio/data/sample.wav) are in the mpath.
+
+	If you are not using the default, you may need to point your 
+        load and exec paths to the new directories.  If you are 
+        installing in a system-wide directory, then update the octave 
+        startup file to set LOADPATH and EXEC_PATH. This is usually
+           /usr/local/share/octave/<version>/m/startup/octaverc.m
+        or something similar.  
+
+	If you are installing as an end user set the loadpath in 
+	your .octaverc file.
+
+    --with-mpath=...
+    --with-opath=...
+    --with-xpath=...
+	Override the default install path for m-files, oct-files
+	and executables.
+
+    --prefix=/usr/local
+    --mandir=$prefix/man
+    --bindir=$prefix/bin
+    --libdir=$prefix/lib
+	Where to put things to be found by the shell, such as the
+	mex command.
+	
+
+    --x-includes=...
+    --x-libraries=...
+	Location of the X11 headers and libraries.  ./configure will
+	usually find these automatically.
+
+    --enable-nonfree
+    --disable-nonfree
+	*** NOT YET IMPLEMENTED ***
+	Include or exclude the non-free software from the build.  The
+	default is to exclude it. 
+
+    --enable-extra
+    --disable-extra
+	*** NOT YET IMPLEMENTED ***
+	Include or exclude the extra software from the build.  The
+	default is to include some of it, but not all.
+
+Make targets:
+
+    make 
+	Build the supporting executables and the oct-files
+    make clean
+	Remove all the temporary files and constructed files
+    make install
+	Install files to the appropriate path
+    make dist
+	Build the distribution tar file
+
+
+Functions which are fixes to m-files distributed with Octave are
+included in the directory octave-forge-<ver>/FIXES.  If you have a 
+bleeding edge version of Octave, then the fixes may have already been
+incorporated and you can simply delete them from the installed tree
+<mpath>/FIXES and <opath>.  Or you can leave them in place and live 
+with a potentially out of date function.  If you find a bug in a 
+function in FIXES, check if it has been fixed in the latest 
+distribution of Octave before reporting it.
+
+*** NOTE *** If/when functions move from octave-forge into Octave proper,
+we are going to have trouble keeping track of stuff in FIXES.  Perhaps
+if we list which version of Octave incorporates the fixes, then we can
+using octave -v to check if the target installation version already
+includes it and customize the installation accordingly.
+
+Sorry, there is no uninstall target.  make install will tell you where
+it put things.  Remember it, so you can remove them later when you
+upgrade octave or octave-forge.
+
+========================================================================
+Uninstalled packages
+
+Not all packages will be installed by default.  To find out which are not,
+run the following command from the octave-forge root:
+
+    $ find . -name NOINSTALL -print
+
+As of this writing, you will see:
+
+nonfree/gpc
+	this package has its own configure script.  Execute that before
+	removing NOINSTALL and running make from the top level.
+
+nonfree/splines
+	nonfree packages will not be installed by default
+
+extra/tk_octave
+	This version of tk_octave depends on octave compiled with
+	pthreads.  Since it isn't usually, this will not be installed
+	by default.
+
+extra/patches
+	The build process does not modify octave itself, but there 
+	are a number of patches included in extra/patches which 
+	you could apply to the octave sources by hand.  Some of the 
+	patches may have already been applied if you are using the 
+	bleeding-edge octave.  Most of them will not apply if you 
+	are using the 2.0 series.  The patches may not apply cleanly 
+	to the bleeding-edge octave and may even conflict with each 
+	other.  Patches should include the Octave version number on
+	which they are based.
+
+extra/ver20
+	Backported functions on which functions in main depend, or
+	backported versions of functions in main.  These were mentioned
+	above
+
+extra/Windows
+	Functions specific to windows. These are things like image, 
+	which load a different image display program than the default 
+	unix image display programs.  Copy this directory somewhere 
+	and put it ahead of all the Octave system directories in 
+	LOADPATH.
+
+extra/engine
+	No installation scripts written yet.
+
+extra/fake-sparse
+	Real sparse routines are included in main, but you may want
+	these if you can't use DLD functions
+
+extra/testfun
+	functions for embedding demo and test scripts in m-files; not
+	sure if we want to use them
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Makeconf.base	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,43 @@
+
+## Makeconf is automatically generated from Makeconf.base and Makeconf.add
+## in the various subdirectories.  To regenerate, use ./autogen.sh to
+## create a new ./Makeconf.in, then use ./configure to generate a new
+## Makeconf.
+
+SHELL = /bin/sh
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+mandir = @mandir@
+libdir = @libdir@
+datadir = @datadir@
+infodir = @infodir@
+includedir = @includedir@
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+INSTALLOCT=octinst.sh
+
+RANLIB = @RANLIB@
+LN_S = @LN_S@
+
+CC = @CC@
+CFLAGS = @CFLAGS@
+
+CXX = @CXX@
+CXXFLAGS = @CXXFLAGS@
+
+MKOCTFILE = @MKOCTFILE@ -DHAVE_OCTAVE_$(ver) -v
+
+@DEFHAVE_X@
+X_CFLAGS = @X_CFLAGS@
+X_LIBS = @X_LIBS@
+
+ver = @ver@
+MPATH = @mpath@
+OPATH = @opath@
+XPATH = @xpath@
+
+
+%.oct: %.cc ; $(MKOCTFILE) $<
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,54 @@
+
+include Makeconf
+
+ifeq ($(MPATH),$(OPATH))
+  LOADPATH = $(MPATH)//:
+else
+  LOADPATH = $(MPATH)//:$(OPATH)//:
+endif
+
+all:
+	@cd main && $(MAKE)
+	@cd extra && $(MAKE)
+	@cd nonfree && $(MAKE)
+
+install:
+	@chmod a+x $(INSTALLOCT)
+	@if test -f FIXES/NOINSTALL ; then \
+	    echo skipping FIXES ; \
+	else \
+	    echo installing FIXES to $(MPATH)/FIXES ; \
+	    ./$(INSTALLOCT) FIXES $(MPATH)/FIXES $(OPATH) $(XPATH) ; \
+	fi
+	@cd main && $(MAKE) install
+	@cd extra && $(MAKE) install
+	@cd nonfree && $(MAKE) install
+	@echo " "
+	@echo "Installation complete."
+	@echo " "
+	@echo "To use, add the following to .octaverc:"
+	@echo "   LOADPATH = [ '$(OPATH):$(MPATH)//:', LOADPATH ];"
+	@echo "   EXEC_PATH = [ '$(XPATH):', EXEC_PATH ];"
+	@echo " "
+	@echo "To uninstall, remove the following:"
+	@echo "   MPATH = $(MPATH)"
+	@echo "   OPATH = $(OPATH)"
+	@echo "   XPATH = $(XPATH)"
+	@echo " "
+	@echo "Some FIXES may be out of date.  Check the scripts in:"
+	@echo "   $(MPATH)/FIXES"
+	@echo "   $(OPATH)"
+	@echo "against those in your version of Octave."
+
+clean:
+	-$(RM) octave-core octave *~ configure.in
+	@cd main && $(MAKE) clean
+	@cd extra && $(MAKE) clean
+	@cd nonfree && $(MAKE) clean
+
+dist: clean
+	-$(RM) Makeconf octinst.sh config.cache config.status config.log
+	find . -name CVS -print > /tmp/octave-forge.CVS
+	tar czf ../octave-forge-`date +%Y.%m.%d`.tar.gz -X /tmp/octave-forge.CVS -C .. octave-forge
+	-$(RM) /tmp/octave-forge.CVS
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/README	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,170 @@
+
+The octave-forge project contains functions for Octave which are not in
+the main distribution.  While the main Octave distribution is
+conservative about accepting new functions and changes, octave-forge is
+very open.  As a result, be prepared for some lower quality code and
+more rapidly changing interfaces to the functions in octave-forge.
+
+The collection is in the public domain, but the individual functions
+vary.  See COPYING for details.  See INSTALL for installation
+instructions.
+
+=====================================================================
+Project organization
+
+main/
+	Packages which may eventually be included in the main octave 
+	distribution.  As such, they should follow Octave conventions.  
+	The octave-forge CVS tree should be the primary development/release 
+	site.  All functions should work with the latest Octave 
+	interpreter without any special compilation switches or patches
+	applied.
+
+FIXES/
+	Alternatives to existing Octave functions.  Some of these are 
+	needed by the functions in main, some are needed for 
+	compatibility with Matlab, and some are faster than the Octave
+	alternatives.
+
+extra/
+	Packages which:
+	   * are too narrow in scope for main, or
+	   * act as alternatives for functions in main, or
+	   * do not follow octave conventions (because they want
+	     to retain compatibility with matlab for example), or
+	   * are primarily developed elsewhere, or
+	   * require patches to Octave, or
+	   * are designed for older versions of Octave, or
+	   * haven't been tested enough.
+
+extra/patches/
+	Small patches to Octave. Patches should be labelled as
+	name-version.patch, with version being the Octave version 
+	number on which the patch was based.  The start of the 
+	patch file should contain a description of what it does.  
+	Patches should be generated with diff -c or diff -cp.
+
+extra/ver20/
+	Backports of functions to the latest Octave 2.0.x interpreter.  
+	Unless you volunteer to keep them up to date, these functions 
+	will likely fall behind their counterparts in the main
+	distribution.  Note that you should try to write your functions 
+	so that they work without change in Octave 2.0.x, but if doing 
+	so makes them less clean or efficient, then drop 2.0.x 
+	compatibility and consider making a 2.0.x specific version and 
+	adding it to the ver20 directory.  By default these are not 
+	installed.
+
+nonfree/
+	Packages which are not freely modifiable and redistributable 
+	with modifications, or which depend on code which is not 
+	free.  This includes functions which only permit non-commercial 
+	use and functions which must be kept together as a package.  
+	Functions in all other directories must be freely redistributable 
+	with modifications.  Functions in non-free must be freely 
+	redistributable for non-commercial use.  Functions of unknown
+	license should not be included anywhere, since no license implies
+	default license implies no rights to redistribute.
+
+======================================================================
+Package organization
+
+package/NOINSTALL
+	don't install this package; the user can rename or delete this
+	file if they want the package installed anyway.
+package/*.m 
+	m-files for the package; these will be installed in
+	site/mfiles/octave-forge/package
+package/data/*
+	datafiles to be installed with the mfiles.  You can accesses
+	them from your m-files with x = file_in_load_path("a").
+package/Makefile 
+	Makefile with a default target to build anything that needs
+	building, and a "clean" target to remove anything that has been
+	built.  See Makeconf.base for a list of predefined variables
+	and rules.
+
+	Your Makefile could be as simple as:
+
+		include ../../Makeconf
+
+		all: f1.oct f2.oct
+
+		clean:
+			$(RM) *.o *.oct octave-core core *~
+
+package/configure.add
+package/Makeconf.add
+	Additional configuration-time commands to run in order to 
+	find all the components that your package requires.  You 
+	can look for anything you want in configure.add and note 
+	what you need in Makeconf.add.  The definitions in 
+	Makeconf.add will be available when you include ../../Makeconf 
+	into your Makefile. X11 is already included in Makeconf.base, 
+	so you can just use $(X_LIBS) on your link line and $(X_CFLAGS) 
+	on your compile line.
+package/*.oct
+	oct-files built by Makefile. These will be installed all 
+	together in site-oct-files/octave-forge.  You may assume that
+	HAVE_OCTAVE_20 is defined for 2.0.x series mkoctfile, and
+	HAVE_OCTAVE_21 is defined for 2.1.x series mkoctfile.
+package/bin/*
+	executable files built by Makefile.  These will be 
+	installed in Octave's EXEC_PATH, so they will be available 
+	from Octave but not from the shell.  
+
+Note: If you have files that you want installed in the standard 
+bindir/mandir/libdir/includedir, we need to consider automating
+the procedure.  At the time of writing extra/mex handles this
+case with an install target in its Makefile, but special code is
+put into extra/Makefile to trigger this.
+
+==========================================================================
+Administration files
+
+autogen.sh
+	Generates ./configure and Makeconf.in
+
+configure.base
+Makeconf.base
+	Basic configuration checks, such as locating the install paths,
+	and the associated variables to be put into Makeconf.  Each 
+	package can append checks by including configure.add in the 
+	package directory.
+
+octinst.sh.in
+	Install program for packages, with pieces to be filed in by
+	./configure
+
+install-sh
+	intall program to use if /usr/bin/install does not work
+
+COPYING
+	License for the collection, plus an out-of-date list of functions 
+	in the collection and their licenses.
+
+COPYING.GPL
+	The text of the GPL license
+
+cvs-tree
+	Generate web listing of m-files in the tree
+
+README
+	This file
+
+TODO
+	Things that could/should be done
+
+INSTALL
+	Installation instructions
+
+Makefile
+	Top level makefile
+
+release.sh
+	Generates release tarball
+
+==========================================================================
+Paul Kienzle
+pkienzle@users.sf.net
+October 10, 2001
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/TODO	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,89 @@
+Admin
+=====
+
+* Use major.minor version number, and tag source directory with version
+number when building the distribution.
+
+* Include support for test in the makefile.
+
+* Maintain global TODO document by automatically extracting ## TODO:
+comments from all of the scripts.  Update all functions to include
+compatibility notes (aka missing features) in these comments.  Some
+function specific notes in matcompat/compat.dat belong in TODO comments.
+
+* make doc subdirectory for each script directory for ancillary docs and 
+use install to put them in a reasonable place; ideally they should 
+piece-wise construct a manual describing the available functions and
+the relationships between them.  Alternatively, each package could have
+an index.html which is installed in /usr/share/doc/octave-forge/package.html
+
+* Include interfaces for symbolic and geometry toolboxes in
+the tree, but don't include the supporting libraries.  Have make check
+for the required libraries prior to trying to build each interface.
+Consider using autoconf/automake.
+
+* Use ../../Makeconf for engine functions.  Engine functions are not
+installed; figure out how and where to install them (presumably as
+a shared library in /usr/local/lib).
+
+* extra/ver20 is not presently installed.
+
+* nonfree/gpc uses its own configure script and build process
+
+* consider -enable/disable on a package by package basis as a way
+to override the NOINSTALL files on some of the directories; maybe
+just an -enable-all option?
+
+* how to "chmod a+x octinst.sh" from configure? Currently I do it
+in the makefile during install.
+
+All functions
+=============
+
+* Use texinfo in the function descriptions.  Call makeinfo to preformat 
+the descriptions when installing for version 2.0.x.
+
+* Add test and demo scripts for each function.  Should we use
+extra/testfun, or should we use name_test.m and name_demo.m?
+	
+* Replace x(find(cond)) with x(cond) since it is faster and cleaner.
+Remove unwind_protect blocks for do_fortran_indexing, since most
+instances will be covered by this.  For the 2.0.x version of the 
+function you will need to either use find() or set prefer_zero_one_indexing
+to 1 inside an unwind_protect block.
+
+* For 2.0.x, be sure x(:,ones(n,1)) uses prefer_zero_one_indexing = 0.
+
+* Replace max(max(x)) with max(x(:)), and so on for min, sum, etc.
+This will be faster when using version >2.1.31
+
+Specific functions
+==================
+
+* Define idx=lookup(table, y, k) which guarantees that the window of width
+k will lie fully within the table.  Maybe this is equivalent to
+	lookup (table (1+k : length (table)-k), y) + floor(k/2);
+
+* Consider defining lookup as
+	table(idx) < y <= table(idx+1)
+rather than
+	table(idx) <= y < table(idx+1)
+This could be a compatibility issue.
+
+* Maybe recode lookup() in C++.  Use binary search for small y and 
+sort-merge for large y.
+
+* merge plot/dhbar with Octave's bar; add preference variable for 'filled';
+add control for bar width
+
+* split FIXES/freqz into FIXES/freqz and FIXES/freqz_plot so that a 
+non-gnuplot based plot package can override freqz's plot.
+
+* Give ginput a "number of inputs" parameter.  Redefine gtext as an
+m-file which calls ginput(1) to get the text location.
+
+* Give ginput a rubber-banding facility, maybe with number of inputs =
+-1 ?  Redefine gzoom as an m-file which calls ginput(-1) to get the
+region.
+
+* Have ginput return the key/mouse button used to exit.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/autogen.sh	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,22 @@
+#! /bin/sh
+
+## Generate ./configure
+rm -f configure.in
+echo "dnl --- DO NOT EDIT --- Automatically generated by autogen.sh" > configure.in
+cat configure.base >> configure.in
+files=`find . -name configure.add -print`
+if test ! -z "$files" ; then
+  cat $files >> configure.in
+fi
+echo "AC_OUTPUT(Makeconf octinst.sh)" >> configure.in
+autoconf
+rm -f configure.in
+
+## Generate ./Makeconf.in
+rm -f Makeconf.in
+cp Makeconf.base Makeconf.in
+files=`find . -name Makeconf.add -print`
+if test ! -z "$files" ; then
+  cat $files >> Makeconf.in
+fi
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/configure.base	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,123 @@
+dnl The configure script is generated by autogen.sh from configure.base 
+dnl and the various configure.add files in the source tree.  Edit 
+dnl configure.base and reprocess rather than modifying ./configure.
+
+AC_INIT(configure.base)
+
+PACKAGE=octave-forge
+MAJOR_VERSION=0
+MINOR_VERSION=1
+PATCH_LEVEL=0
+
+dnl Kill caching --- this ought to be the default
+define([AC_CACHE_LOAD], )dnl
+define([AC_CACHE_SAVE], )dnl
+
+dnl uncomment to put support files in another directory
+dnl AC_CONFIG_AUX_DIR(config)
+
+VERSION=$MAJOR_VERSION.$MINOR_VERSION.$PATCH_LEVEL
+AC_SUBST(PACKAGE)
+AC_SUBST(VERSION)
+
+AC_PROG_CC
+AC_PROG_CXX
+AC_PROG_LN_S
+AC_PROG_RANLIB
+AC_PROG_INSTALL
+
+dnl *******************************************************************
+dnl Sort out mkoctfile version number and install paths
+
+dnl Check for mkoctfile
+AC_CHECK_PROG(MKOCTFILE,mkoctfile,mkoctfile)
+test -z "$MKOCTFILE" &&	AC_MSG_WARN([no mkoctfile found on path])
+
+AC_SUBST(ver)
+AC_SUBST(mpath)
+AC_SUBST(opath)
+AC_SUBST(xpath)
+
+AC_ARG_WITH(path, 
+	[  --with-path             install path prefix],
+	[ path=$withval ])
+AC_ARG_WITH(mpath,
+	[  --with-mpath            override path for m-files],
+	[mpath=$withval])
+AC_ARG_WITH(opath,
+	[  --with-opath            override path for oct-files],
+	[opath=$withval])
+AC_ARG_WITH(xpath,
+	[  --with-xpath            override path for executables],
+	[xpath=$withval])
+
+if test -n "$path" ; then
+   test -z $mpath && mpath=$path 
+   test -z $opath && opath=$path/oct 
+   test -z $xpath && xpath=$path/bin
+fi
+
+dnl Don't query if path/ver are given in the configure environment
+if test -z "$mpath" || test -z "$opath" || test -z "$xpath" || test -z "$ver" ; then
+
+   dnl Construct program to get mkoctfile version and local install paths
+   cat > conftest.cc <<EOF
+#include <octave/version.h>
+#include <octave/defaults.h>
+
+#define INFOV "\nINFOV=" OCTAVE_VERSION "\n"
+
+#ifdef OCTAVE_LOCALVERFCNFILEDIR
+# define INFOM "\nINFOM=" OCTAVE_LOCALVERFCNFILEDIR "\n"
+#else
+# define INFOM "\nINFOM=" OCTAVE_LOCALFCNFILEPATH "\n"
+#endif
+
+#ifdef OCTAVE_LOCALVEROCTFILEDIR
+# define INFOO "\nINFOO=" OCTAVE_LOCALVEROCTFILEDIR "\n"
+#else
+# define INFOO "\nINFOO=" OCTAVE_LOCALOCTFILEPATH  "\n"
+#endif
+
+#ifdef OCTAVE_LOCALVERARCHLIBDIR
+# define INFOX "\nINFOX=" OCTAVE_LOCALVERARCHLIBDIR  "\n"
+#else
+# define INFOX "\nINFOX=" OCTAVE_LOCALARCHLIBDIR  "\n"
+#endif
+
+const char *infom = INFOM;
+const char *infoo = INFOO;
+const char *infox = INFOX;
+const char *infov = INFOV;
+EOF
+
+   dnl Compile program perhaps with a special version of mkoctfile
+   $MKOCTFILE conftest.cc || AC_MSG_ERROR(Could not run $MKOCTFILE)
+
+   dnl Strip the config info from the compiled file
+   eval `strings conftest.o | grep "^INFO.=" | sed -e "s,//.*$,,"`
+   rm -rf conftest*
+
+   dnl set the appropriate variables if they are not already set
+   ver=`echo $INFOV | sed -e "s/\.//" -e "s/\..*$//"`
+   subver=`echo $INFOV | sed -e "s/^[^.]*.[^.]*.//"`
+   test -z $mpath && mpath=$INFOM/octave-forge
+   test -z $opath && opath=$INFOO/octave-forge
+   test -z $xpath && xpath=$INFOX
+fi
+
+dnl *******************************************************************
+
+
+dnl Things needed to link to X11 programs
+dnl defines X_CFLAGS, X_LIBS
+AC_SUBST(DEFHAVE_X)
+AC_SUBST(X_LIBS)
+AC_SUBST(X_CFLAGS)
+AC_PATH_XTRA
+if test "$no_x" = yes ; then
+	DEFHAVE_X=
+else
+	DEFHAVE_X="HAVE_X=1"
+	X_LIBS="$X_LIBS $X_PRE_LIBS -lX11 $X_EXTRA_LIBS"
+fi
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cvs-tree	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,222 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+# Set environment variables so I can update the cvs tree
+$ENV{CVS_RSH} = 'ssh';
+
+# If you're not cgijobs, you need to change the next line
+$ENV{CVSROOT} = 'cgijobs@cvs.octave.sourceforge.net:/cvsroot/octave';
+
+#	 variables used in this file
+my (
+	$basedir,
+	$maxiter,
+	$extensions,
+	$DMZ,
+	@directories,
+	$maxvar,
+	$temp,               # all-purpose temporary variable
+	$directory,
+	@entries,
+	$entry,
+	$full,
+	$file,
+	%files
+);
+
+print STDERR "Don't forget to do a cvs update before executing this...\n\n";
+
+# ------------------------------------------------------------------
+# Walk the octave directories to find all .m files
+# Parts of this code inspired from the
+# Xavatoria Indexed Search, Index Building Module
+#	http://www.xav.com/scripts/xavatoria/
+# ------------------------------------------------------------------
+
+
+# where to start the search
+$basedir = './';
+
+# maximum number of iterations to avoid runaway process
+$maxiter = 10000;
+
+#$extensions = "\.html\.htm\.shtml\.stm\.ztml\.shtml\.";
+$extensions = '.m.';
+
+# Below are the files or directories that you do NOT want to be 
+# searched.  Note that they all have one blank space after the 
+# file or directory, and that directories do not include trailing 
+# slashes.  Also note that we use the ".=" instead of the "=".
+
+$DMZ = './dld ';
+#$DMZ .= "/usr/www/users/ifunds/cgi-bin ";
+
+unless (-e $basedir) {
+	print STDERR "Fatal Error!\n";
+	print STDERR "Searched for a directory at specified location:\n";
+	print STDERR "    $basedir\n";
+	print STDERR "No directory found. Check settings.\n";
+	exit;
+}
+
+@directories = ($basedir);
+$maxvar = 1;
+for ($temp=0;$temp<$maxiter;$temp++) {
+	$directory = @directories[$temp];
+	last unless $directory =~ /[\w\.]/;       # exit when we run out...
+	next if ($DMZ =~ /$directory /i);
+	next if $directory =~ /CVS\s*$/;      # ignore CVS directories
+	opendir(DIR,$directory);
+	@entries = readdir(DIR);
+	closedir(DIR);
+	foreach $entry (@entries) {
+		next if (($entry eq ".") || ($entry eq ".."));
+		$full = "$directory/$entry";
+		next if ($DMZ =~ /$full /i);
+		if (-d $full) {
+			push(@directories,$full);
+			$maxvar++;
+		}
+		elsif ((-T "$directory/$entry") && ($entry =~ /(.*)\.(.*)/)) {
+			if ($extensions =~ /\.$2\./) { # we found an .m file
+				# store filenames in a hash with the filename as the key
+				# and the directory (comma separated if more than one unique)
+				# as the value
+				if( $files{$entry}) {
+					$files{$entry} .= ",$directory";
+				}
+				else {
+					$files{$entry} = $directory;
+				}
+			}
+		}
+	}
+}
+
+# Output the page:
+# FIXME: Does not handle multiple unique names (in separate directories)...
+
+print '<html><head><title>Octave Repository Function List</title></head>';
+print "\n<body>\n", titlebar(), hline(), '<p>';
+
+print 'Unique file names: ', scalar keys %files, "\n<p>\n";
+
+# first, print the summary
+foreach $file (sort keys %files) {
+	$temp = func_name( $files{$file}, $file);
+	print qq[<a href="#$temp">$temp</a> - ];
+}
+
+# now, print each entry
+print hline();
+foreach $file (sort keys %files) {
+
+	$temp = func_name( $files{$file}, $file);
+	print qq[<p><a name="$temp">$temp</a>];
+
+	$temp = cvs_download_link( $files{$file}, $file);
+	print qq+ [<a href="$temp">Download</a>]+;
+
+	print '<br><pre>' . func_descript( $files{$file}, $file) . "</pre>\n";
+}
+
+print "\n</body></html>\n";
+
+exit;   # all done
+
+
+################################################################################
+#
+#                  SUBROUTINES
+#
+################################################################################
+
+# given the directory and file name, returns the name of the function defined
+# by that file
+sub func_name {
+	my ($_dir, $_file) = @_;
+
+	$_file =~ /([^.]*)/;
+	return $1;
+}
+
+sub hline {
+	return "\n<hr size=1 noshade>\n";
+}
+
+sub titlebar {
+	return qq~
+	<A href="http://octave.sourceforge.net">Home</A>&nbsp;|&nbsp;
+	<A href="http://sourceforge.net/projects/octave/">Summary</A>&nbsp;|&nbsp;
+	<A href="http://sourceforge.net/forum/?group_id=2888">Forums</A>&nbsp;|&nbsp;
+	<A href="http://sourceforge.net/bugs/?group_id=2888">Bugs</A>&nbsp;|&nbsp;
+	<A href="http://sourceforge.net/support/?group_id=2888">Support</A>&nbsp;|&nbsp;
+	<A href="http://sourceforge.net/patch/?group_id=2888">Patches</A>&nbsp;|&nbsp;
+	<A href="http://sourceforge.net/mail/?group_id=2888">Lists</A>&nbsp;|&nbsp;
+	<A href="http://sourceforge.net/pm/?group_id=2888">Tasks</A>&nbsp;|&nbsp;
+	<A href="http://sourceforge.net/docman/?group_id=2888">Docs</A>&nbsp;|&nbsp;
+	<A href="http://sourceforge.net/survey/?group_id=2888">Surveys</A>&nbsp;|&nbsp;
+	<A href="http://sourceforge.net/news/?group_id=2888">News</A>&nbsp;|&nbsp;
+	<A href="http://sourceforge.net/cvs/?group_id=2888">CVS</A>&nbsp;|&nbsp;
+	<A href="http://sourceforge.net/project/filelist.php?group_id=2888">Files</A>
+	~;
+}
+
+# returns the URL to download a file
+sub cvs_download_link {
+	my ($_dir, $_file) = @_;
+
+	$_dir =~ s/^[.\/]*//;  # get rid of the leading garbage
+
+	return 'http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/~checkout~/octave/octave/' .
+		$_dir . '/' . $_file . '?rev=HEAD&content-type=text/plain';
+}
+ 
+sub func_descript {
+	my ($_dir, $_file) = @_;
+	my $retval = '';
+
+	if( open( IN, "$_dir/$_file")) {
+		# skip leading blank lines
+		while (<IN>) {
+			last if /\S/;
+		}
+		if( m/\s*#[\s#]* Copyright/) {
+			# next block is copyright statement, skip it
+			while (<IN>) {
+				last unless /^\s*#/;
+			}
+		}
+		# Skip any blank lines here
+		while ( /^\s*$/) {
+			$_ = <IN>;
+			last if not defined $_;
+		}
+		# At this point we should either have a function statement or
+		# the start of the description
+		if( m/^\s*#/) {
+			# Comment is starting, grab the first line unless its the texinfo thing
+			s/^[\s#]*//;
+			$retval .= $_ unless m/\-\*\-\s*texinfo\s*\-\*\-/;
+		}
+		else {
+			return unless m/function/i;
+		}
+		# Print out the rest of the documentation block
+		while (<IN>) {
+			last unless /^\s*#/;
+			s/^[\s#]*//;
+			# make texinfo substitutions
+			next if m/\-\*\-\s*texinfo\s*\-\*\-/;
+			s/\@var{([^}]*)}/<i>\1<\/i>/g;  # This must go before deftypefnx substitution
+			s/\@deftypefnx*\s*{[^}]*}\s*{([^}]*)}\s*/\1/g;
+			s/\@end\s*deftypefn//g;
+			$retval .= $_;
+		}
+		return $retval;
+	}
+	else {
+		print STDERR "Could not open file ($_dir/$_file): $!\n";
+	}
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,31 @@
+
+include ../Makeconf
+
+SUBMAKES = $(wildcard */Makefile)
+MAKE_SUBDIRS = $(dir $(SUBMAKES))
+INSTALL_SUBDIRS = $(filter-out Makefile, $(wildcard *))
+
+.PHONY: all install clean $(MAKE_SUBDIRS) $(INSTALL_SUBDIRS)
+
+all: $(MAKE_SUBDIRS)
+
+$(MAKE_SUBDIRS):
+	@if test ! -f $@/NOINSTALL || test x$(MAKECMDGOALS) = xclean ; then \
+	    cd $@ && $(MAKE) $(MAKECMDGOALS) ; \
+	fi
+
+install: $(INSTALL_SUBDIRS)
+	@if test ! -f mex/NOINSTALL ; then \
+	    cd mex && $(MAKE) install ; \
+	fi
+
+$(INSTALL_SUBDIRS):
+	@if test -f $@/NOINSTALL ; then \
+	    echo skipping $@ ; \
+	else \
+	    echo installing $@ to $(MPATH)/$@ ; \
+	    ../$(INSTALLOCT) $@ $(MPATH)/$@ $(OPATH) $(XPATH) ; \
+	fi
+
+clean: $(MAKE_SUBDIRS)
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/Windows/image.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,79 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} image (@var{x}, @var{zoom})
+## @deftypefnx {Function File} {} image (@var{x}, @var{y}, @var{A}, @var{zoom})
+## Display a matrix as a color image.  The elements of @var{x} are indices
+## into the current colormap and should have values between 1 and the
+## length of the colormap.  If @var{zoom} is omitted, the image will be
+## scaled to fit within 600x350 (to a max of 4).
+##
+## The axis values corresponding to the matrix elements are specified in
+## @var{x} and @var{y}. At present they are ignored.
+## @end deftypefn
+## @seealso{imshow, imagesc, and colormap}
+
+## Author: Tony Richardson <arichard@stark.cc.oh.us>
+## Created: July 1994
+## Adapted-By: jwe
+## Changes
+##   2000-09-19 Paul Kienzle incorporated Douglas Steele's suggestions 
+##   for a windows version. (Sept. 2000 help-octave archives).
+function image (x, y, A, zoom)
+
+  if (nargin == 0)
+    ## Load Bobbie Jo Richardson (Born 3/16/94)
+    x = loadimage ("default.img");
+    zoom = 2;
+  elseif (nargin == 1)
+    A = x;
+    zoom = [];
+    x=y=[];
+  elseif (nargin == 2)
+    A = x;
+    zoom = y;
+    x=y=[];
+  elseif (nargin == 3)
+    zoom = [];
+  elseif (nargin > 4)
+    usage ("image (matrix, [zoom]) or image (x, y, matrix, [zoom])");
+  endif
+
+  if isempty(zoom)
+    ## Find an integer scale factor which sets the image to
+    ## approximately the size of the screen.
+    zoom = min([350/rows(A), 600/columns(A), 4]);
+    if zoom>=1
+      zoom=floor(zoom);
+    else
+      zoom=1/ceil(1/zoom);
+    endif
+  endif
+
+  B=A-min(min(A))+0.5;
+  B=B/max(max(B)+0.5);
+  
+  map = colormap();
+  [m2,n2]=size(map);
+  bmpwrite(B*m2,map,'tmp');
+  system(['mspaint tmp.bmp');
+  system('rm tmp.bmp');
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/civil/__nlnewmark_fcn__.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,38 @@
+## Copyright (C) 2000 Matthew W. Roberts.  All rights reserved.
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2, or (at your option) any
+## later version.
+##
+## Octave is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+## FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+## for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111 USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{y} =} __nlnewmark_fcn__(@var{x})
+##
+## Non-linear function used with fsolve for nlnewmark.m
+
+## Author:  Matthew W. Roberts
+## Created: May, 2000
+
+function  y = __nlnewmark_fcn__(x)
+
+global nlnewmark_status;
+
+# nlnewmark_status.a1 = dt^2*beta;
+y(1) = -x(1) + nlnewmark_status.a1 * x(3) + nlnewmark_status.rhs(1);
+# nlnewmark_status.a2 = dt*alpha;
+y(2) = -x(2) + nlnewmark_status.a2 * x(3) + nlnewmark_status.rhs(2);
+y(3) = feval( nlnewmark_status.Q, [x(1), x(2), x(3)]) + nlnewmark_status.C * x(2) + nlnewmark_status.M * x(3) - nlnewmark_status.rhs(3);
+
+endfunction
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/civil/newmark.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,177 @@
+## Copyright (C) 2000 Matthew W. Roberts.  All rights reserved.
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2, or (at your option) any
+## later version.
+##
+## Octave is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+## FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+## for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111 USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{x} =} newmark(@var{m}, @var{c}, @var{k}, @var{f}, @var{dt}, @var{x0} = 0, @var{x'0} = 0, @var{alpha} = 1/2, @var{beta} = 1/4, @var{flags} = "")
+## Computes the solution of second-order differential equations of the form
+##
+## @example
+## @var{m}  @var{x}'' + @var{c} @var{x}' + @var{k} @var{x} = @var{f}
+## @end example
+##
+## where @var{x}' denotes the first time derivative of @var{x}.
+##
+## If the function is called without the assigning a return value
+## then @var{x} is plotted versus time.
+##
+## @strong{Inputs}
+##
+## @table @var
+## @item m
+## The mass of the body.
+## @item c
+## Viscous damping of the system.
+## @item k
+## Spring stiffness (restoring force coefficient).
+## @item f
+## The forcing function as a time sampled or impulse vector
+## (see @strong{Special Cases}).
+## @item dt
+## The time step -- assumed to be constant
+## @item x0
+## Initial displacement, default is zero
+## @item x'0
+## Initial velocity, default is zero
+## @item alpha
+## Alpha Coefficient -- Controls "artificial damping" of the system.
+## Unless you have a really good reason, this should be 1/2 which is
+## the default.
+## @item beta
+## Beta Coefficient -- This coefficient is used to estimate the form of the
+## system acceleration between time steps.  Values between 1/4 and 1/6 are
+## common. The default is 1/4 which is unconditionally stable.
+## @item flags
+## A string value which defines special cases.  The cases are defined by 
+## unique characters as explained in @strong{Special Cases} below.
+## @end table
+##
+## @strong{Outputs}
+##
+## @table @var
+## @item  x
+## Matrix of size (3, @func{length}(@var{f})) with time series of displacement
+## (@var{x}(1,:)), velocity (@var{x}(2,:)), and acceleration (@var{x}(3,:))
+## @end table
+##
+## @strong{Special Cases}
+##
+## The @var{flags} variable is used to define special cases of analysis as
+## follows.
+##
+## "i"  - Impulse forcing function.  The forcing function, @var{f} is a
+##        vector of impulses instead of a sampled time history.
+## "n"  - The stiffness is non-linear.  In this case, @var{k} is a string
+##        which contains the name of a function defining the non-linear
+##        stiffness.
+##
+## @end deftypefn
+
+## Author:  Matthew W. Roberts
+## Created: May, 2000
+
+
+
+function  x = newmark( M, C, K, f, dt, u0, v0, alpha, beta, flags)
+
+# Take care of unititalized input variables
+
+if( nargin < 6)
+	u0 = 0;
+endif
+if( nargin < 7)
+	v0 = 0;
+endif
+if( nargin < 8)
+	alpha = 0.5;
+endif
+if( nargin < 9)
+	beta = 0.25;
+endif
+if( nargin < 10)
+	flags = "";
+endif
+
+if( findstr( flags, "n"))
+	x = nlnewmark( M, C, K, f, dt, u0, v0, alpha, beta, flags);
+else # {
+
+# check for flags
+if( findstr( flags, "i"))
+	_local_impulse = 1;  # local variable
+else
+	_local_impulse = 0;
+endif
+
+
+# xxBEGINxx
+# initialize x
+x = zeros( 3, length(f));
+
+x(1,1) = u0;
+x(2,1) = v0;
+
+# compute the initial acceleration
+if( _local_impulse)
+	# an initial impulse has the effect of instantaneously changing
+	# the initial velocity.
+	v0 = v0 + f(1)/M;
+	x(2,1) = v0;
+	# Now, initial acceleration comes from solving m*a0 + c*v0 + k*u0 = 0
+	x(3,1) = ( - C * v0 - K * u0 ) / M;
+else
+	# Compute a0 from m*a0 + c*v0 + k*u0 = f0
+	x(3,1) = ( f(1) - C * v0 - K * u0 ) / M;
+endif
+A = [ 1, 0, -dt^2*beta;
+      0, 1, -dt*alpha;
+      K, C, M];
+
+Ainv = inv(A);
+
+# define some constants so that we won't need to recalculate each loop:
+c1 = dt^2 * (0.5 - beta);
+c2 = dt   * (1 - alpha);
+
+	rhs(3) = 0;  # default value
+	for i = 2:length(f)
+		% create the rhs
+		rhs(1) = x(1, i-1) + dt * x(2, i-1) + c1 * x(3, i-1);
+		rhs(2) =                  x(2, i-1) + c2 * x(3, i-1);
+		if( ! _local_impulse)
+			rhs(3) = f(i);
+		endif
+
+		# solve for x
+		x(:, i) = Ainv * rhs;
+
+		# add the impulse effect...
+		if( _local_impulse)
+			x(2,i) = x(2,i) + f(i)/M;
+		endif
+	
+	endfor
+
+endif  # }
+
+if( nargout < 1)
+	t = 0:dt:(length(f)-1)*dt;
+	length(t);
+	plot( t, x(1,:));
+	x = [];
+endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/civil/nlnewmark.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,188 @@
+## Copyright (C) 2000 Matthew W. Roberts.  All rights reserved.
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2, or (at your option) any
+## later version.
+##
+## Octave is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+## FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+## for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111 USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{x} =} nlnewmark(@var{m}, @var{c}, @var{q}, @var{f}, @var{dt}, @var{x0} = 0, @var{x'0} = 0, @var{alpha} = 1/2, @var{beta} = 1/4, @var{flags} = "")
+## Computes the solution of non-linear second-order differential equations of the form
+##
+## @example
+## @var{m}  @var{x}'' + @var{c} @var{x}' + @var{q}(@var{x}, @var{x}', @var{x}'')  = @var{f}
+## @end example
+##
+## where @var{x}' denotes the first time derivative of @var{x} and @var{q} is
+## a non-linear function.
+##
+## If the function is called without the assigning a return value
+## then @var{x} is plotted versus time.
+##
+## @strong{Inputs}
+##
+## @table @var
+## @item m
+## The mass of the body.
+## @item c
+## Viscous damping of the system.
+## @item q
+## The name of a function
+## that returns the value of the resisting force for a given
+## displacement.  The form of Q must be:
+##
+## @example
+## @var{F} = Q( @var{x})
+## @end example
+## 
+## where @var{F} is the restoring force for the state vector @var{x} 
+## = [@var{u}, @var{u'}, @var{u''}]; displacement
+## (@var{u}), velocity (@var{u'}), and acceleration.
+## @item f
+## The forcing function as a time sampled or impulse vector
+## (see @strong{Special Cases}).
+## @item dt
+## The time step -- assumed to be constant
+## @item x0
+## Initial displacement, default is zero
+## @item x'0
+## Initial velocity, default is zero
+## @item alpha
+## Alpha Coefficient -- Controls "artificial damping" of the system.
+## Unless you have a really good reason, this should be 1/2 which is
+## the default.
+## @item beta
+## Beta Coefficient -- This coefficient is used to estimate the form of the
+## system acceleration between time steps.  Values between 1/4 and 1/6 are
+## common. The default is 1/4 which is unconditionally stable.
+## @item flags
+## A string value which defines special cases.  The cases are defined by 
+## unique characters as explained in @strong{Special Cases} below.
+## @end table
+##
+## @strong{Outputs}
+##
+## @table @var
+## @item  x
+## Matrix of size (3, @func{length}(@var{f})) with time series of displacement
+## (@var{x}(1,:)), velocity (@var{x}(2,:)), and acceleration (@var{x}(3,:))
+## @end table
+##
+## @strong{Special Cases}
+##
+## The @var{flags} variable is used to define special cases of analysis as
+## follows.
+##
+## "i"  - Impulse forcing function.  The forcing function, @var{f} is a
+##        vector of impulses instead of a sampled time history.
+## "n"  - The stiffness is non-linear.  In this case, @var{k} is a string
+##        which contains the name of a function defining the non-linear
+##        stiffness.
+##
+## @end deftypefn
+
+## Author:  Matthew W. Roberts
+## Created: May, 2000
+
+function  x = nlnewmark( M, C, Q, f, dt, u0, v0, alpha, beta, flags)
+
+global nlnewmark_status;
+
+# Take care of unititalized input variables
+
+if( nargin < 6)
+	u0 = 0;
+endif
+if( nargin < 7)
+	v0 = 0;
+endif
+if( nargin < 8)
+	alpha = 0.5;
+endif
+if( nargin < 9)
+	beta = 0.25;
+endif
+if( nargin < 10)
+	flags = "";
+endif
+
+# check for flags
+if( findstr( flags, "i"))
+	_local_impulse = 1;  # local variable
+else
+	_local_impulse = 0;
+endif
+
+
+# xxBEGINxx
+# initialize x
+x = zeros( 3, length(f));
+
+x(1,1) = u0;
+x(2,1) = v0;
+
+# compute the initial acceleration
+if( _local_impulse)
+	# an initial impulse has the effect of instantaneously changing
+	# the initial velocity.
+	v0 = v0 + f(1)/M;
+	x(2,1) = v0;
+	# Now, initial acceleration comes from solving m*a0 + c*v0 + Q = 0
+	## :FIXME: here I'm assuming that the acceleration is not used in Q
+	x(3,1) = ( - C * v0 - feval( Q, [u0, v0, 0]) ) / M;
+else
+	# Compute a0 from m*a0 + c*v0 + Q = f0
+	## :FIXME: here I'm assuming that the acceleration is not used in Q
+	x(3,1) = ( f(1) - C * v0 - feval( Q, [u0, v0, 0]) ) / M;
+endif
+
+# define some constants so that we won't need to recalculate each loop:
+c1 = dt^2 * (0.5 - beta);
+c2 = dt   * (1 - alpha);
+
+# These need to be known by __nlnewmark_fcn__
+nlnewmark_status.a1 = dt^2*beta;
+nlnewmark_status.a2 = dt*alpha;
+nlnewmark_status.C  = C;
+nlnewmark_status.M  = M;
+nlnewmark_status.Q  = Q;
+
+	rhs(3) = 0;  # default value - always this for impulse
+	for i = 2:length(f)
+		% create the rhs
+		nlnewmark_status.rhs(1) = x(1, i-1) + dt * x(2, i-1) + c1 * x(3, i-1);
+		nlnewmark_status.rhs(2) =                  x(2, i-1) + c2 * x(3, i-1);
+		if( ! _local_impulse)
+			nlnewmark_status.rhs(3) = f(i);
+		endif
+
+		# solve for x - using previous value as starting guess...
+		[x(:, i), info] = fsolve( "__nlnewmark_fcn__",
+			[x(1, i-1); x(2, i-1); x(3, i-1)]);
+
+		info
+		# add the impulse effect...
+		if( _local_impulse)
+			x(2,i) = x(2,i) + f(i)/M;
+		endif
+	
+	endfor
+
+if( nargout < 1)
+	t = 0:dt:(length(f)-1)*dt;
+	length(t);
+	plot( t, x(1,:));
+endif
+endfunction
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,35 @@
+# Makefile for MATLAB compatible liboct library           Sept. 8, 1998
+#
+# Copyright (C) 1998 by Jesse Bennett.
+#
+# 2000-11-23: Paul Kienzle (pkienzle@kienzle.powernet.co.uk)
+#   - added -D_BSD_SOURCE to the compile options so mknod could be found
+# 2001-09-19 Paul Kienzle
+#   - use default $(CC), $(AR) and $(RANLIB)
+#   - remove unused flags
+
+# CONFIGURE: compiler flags go here.
+# CFLAGS =	-Wall -ansi -pedantic -O2 -D_BSD_SOURCE -DDEBUGAPI
+CFLAGS =	-Wall -ansi -pedantic -O2 -D_BSD_SOURCE
+
+# CONFIGURE: sources, includes, objects and libraries used.
+INCS =		engine.h engif.h
+TARGETS =	engif.o engClose.o engEvalString.o engGetFull.o \
+		engOpen.o engPutFull.o engOutputBuffer.o mxCalloc.o mxFree.o
+
+all:		liboct.a mattest
+
+liboct.a:	$(TARGETS)
+	$(AR) -r liboct.a $?
+	$(RANLIB) liboct.a
+	$(AR) -tv liboct.a
+
+mattest:	liboct.a
+	$(CC) $(CFLAGS) mattest.c -o mattest -loct -lm
+
+clean:
+	$(RM) $(TARGETS) liboct.a mattest
+
+%.o : %.c
+	$(CC) $(CFLAGS) -c $*.c
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/README	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,82 @@
+liboct.0.1 (alpha version 1e-22) An external interface library for Octave
+
+Author: Jesse Bennett <jesse@seas.smu.edu>
+
+What is liboct?
+===============
+
+A buggy, poorly written and undocumented library of C functions which
+*might* allow *some people* to integrate Octave into their F77/C/C++
+programs.  All I can promise is that it worked for what I needed to do
+at the time it was written.  It is really just a hack which satisfied
+a need I had.
+
+
+Warranty
+========
+
+None.  Use at your own risk.  If it erases your hard drive with all
+your financial records and your wife's nearly complete dissertation,
+I'm not responsible.  Assume it is unfit for any purpose whatsoever.
+You have been warned!
+
+
+License
+=======
+
+GPL.  If/when it becomes useful I expect to make it LGPL.
+
+
+Installation
+============
+
+You did read the warranty, right?
+
+$ cd path/to/where/you/want/it
+$ cat liboct.0.1.tar.gz | gunzip | tar xvf -
+$ cd liboct.0.1
+$ make
+
+This *might* create liboct.a and a program called mattest, which I
+used for testing.  And then again, it might not.
+
+
+Bugs
+====
+
+Yes.
+
+
+NAQ (Never asked questions)
+===========================
+
+Q1. What does mattest do?
+
+A1. Opens an octave engine, initalizes the matrix "a", then goes into
+a "pseudo command-line" mode.  When either "exit" or "quit" is typed
+at the command line, the program prints the "a" matrix (which might
+have been changed), then closes the engine and exits.
+
+Q2. Without documentation, how can this be useful to anyone?
+
+A2. It may not be.  It was coded from the Matlab V4 "External
+Interface Guide" and includes the following functions:
+
+engClose
+engEvalString
+engGetFull
+engOpen
+engOutputBuffer
+engPutFull
+mxCalloc
+mxFree
+
+With a few exceptions (e.g. no support for multiple engines or remote
+execution at this point), things should work as described in the
+referenced document.  To use the functions, include "engine.h" in your
+source and link with -loct.
+
+Q3. What can I do to make this useful?
+
+A3. Offer to fix/improve something.  I am putting together a list of
+TO-DOs.  Any offer of help would be appreciated.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/engClose.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,30 @@
+#include <stdio.h>
+#include <unistd.h>
+#include "engine.h"
+#include "engif.h"
+
+extern int matopen;
+
+
+int engClose( Engine *ep )
+{
+
+#ifdef DEBUGAPI
+  fprintf( stdout, "Begin engClose ...\n" );
+  fflush( stdout );
+#endif
+
+  if( matopen )
+  {
+    putline( "exit\n" );
+    closepipes();
+    matopen = 0;
+  }
+
+#ifdef DEBUGAPI
+  fprintf( stdout, "Exit engClose with status %d\n", 0 );
+  fflush( stdout );
+#endif
+
+  return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/engEvalString.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,56 @@
+#include <stdio.h>
+#include <unistd.h>
+#include "engine.h"
+#include "engif.h"
+
+extern int matopen;
+extern int pfd1[2];
+extern int pfd2[2];
+extern int matbuffer;
+extern char* matbufptr;
+extern int matbufcnt;
+
+static int outcnt;
+
+
+int engEvalString( Engine *ep, char *string )
+{
+  int test;
+  char cmdstr[200];
+
+#ifdef DEBUGAPI
+  fprintf( stdout, "Begin engEvalString(%s)...\n", string );
+  fflush( stdout );
+#endif
+
+  if( matopen )
+  {
+    outcnt = 0;
+
+    flushjunk();
+
+    /* Do not include any newlines in the Octave command string */
+
+    test = 0;
+    while( (string[test] != '\n') && (string[test] != '\0') && (test<198) )
+    {
+      cmdstr[test] = string[test];
+      test++;
+    }
+    cmdstr[test] = '\n';
+    test++;
+    cmdstr[test] = '\0';
+
+    putline( cmdstr );
+    flushprompt( 1 );
+  }
+
+  flushjunk();
+
+#ifdef DEBUGAPI
+  fprintf( stdout, "Exit engEvalString with status %d\n", 0 );
+  fflush( stdout );
+#endif
+
+  return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/engGetFull.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,153 @@
+#include <stdio.h>
+#include <sys/time.h>
+#include <sys/types.h>
+#include <unistd.h>
+#include <string.h>
+#include "engine.h"
+#include "engif.h"
+
+extern int matopen;
+
+#define GETSTR "save -ascii \"-\"\n"
+
+/* Improvement: It would be more efficient to use a binary format */
+
+int engGetFull( Engine *ep, char *name, int *m, int *n,
+		double **pr, double **pi )
+{
+  int i, j, retval;
+  char buf[BUFMAX];
+  char comm, *ptr, str1[BUFMAX], str2[BUFMAX], str3[BUFMAX];
+
+#ifdef DEBUGAPI
+  fprintf( stdout, "Begin engGetFull ...\n" );
+  fflush( stdout );
+#endif
+
+  retval = 1;
+  if( matopen )
+  {
+    flushjunk();
+    sprintf( buf, "exist(\"%s\")\n", name );
+    putline( buf );
+    getline( buf );
+    flushprompt( 0 );
+    sscanf( buf, " ans = %d", &i );
+
+    if( i == 1 )
+    {
+      sprintf( buf, "save -ascii \"-\" %s\n", name );
+      putline( buf );
+
+      getline( buf );
+      sscanf( buf, "%c %s %s", &comm, str1, str2 );
+      if( comm != '#' )
+	return retval;
+      if( !strcmp( "Created", str1 ) )  /* New in Octave 2.0.14 */
+      {
+	getline( buf );
+	sscanf( buf, "%c %s %s", &comm, str1, str2 );
+      }
+      if( strcmp( "name:", str1 ) )
+ 	return retval;
+      if( strcmp( name, str2 ) )
+ 	return retval;
+      getline( buf );
+      sscanf( buf, "%c %s %s %s", &comm, str1, str2, str3 );
+      if( comm != '#' )
+	return retval;
+      if( strcmp( "type:", str1 ) )
+	return retval;
+      if( !strcmp( "complex", str2 ) )  /* Complex data type */
+      {
+	if( !strcmp( "scalar", str3 ) )
+	{
+	  *m = 1;
+	  *n = 1;
+	  *pr = mxCalloc( 1, sizeof( **pr ) );
+	  *pi = mxCalloc( 1, sizeof( **pi ) );
+	  getline( buf );
+	  sscanf( buf, "(%lf,%lf)", &pr[0][0], &pi[0][0] );
+	}
+	else
+	{
+	  if( !strcmp( "matrix", str3 ) )
+	  {
+	    getline( buf );
+	    sscanf( buf, "%c %s %d", &comm, str1, m );
+	    if( strcmp( "rows:", str1 ) )
+	      return retval;
+	    getline( buf );
+	    sscanf( buf, "%c %s %d", &comm, str1, n );
+	    if( strcmp( "columns:", str1 ) )
+	      return retval;
+	    *pr = mxCalloc( (*m)*(*n), sizeof( **pr ) );
+	    *pi = mxCalloc( (*m)*(*n), sizeof( **pi ) );
+	    for( i=0; i<*m; i++ )
+	    {
+	      getline( buf );
+	      ptr = strtok( buf, " " );
+	      for( j=0; j<*n; j++ )
+	      {
+		sscanf( ptr, "(%lf,%lf)", (*pr)+j*(*m)+i, (*pi)+j*(*m)+i );
+		ptr = strtok( NULL, " " );
+	      }
+	    }
+	  }
+	  else
+	    return retval;
+	}
+      }
+      else  /* Real data type */
+      {
+	if( !strcmp( "scalar", str2 ) )
+	{
+	  *m = 1;
+	  *n = 1;
+	  *pr = mxCalloc( 1, sizeof( **pr ) );
+	  *pi = NULL;
+	  getline( buf );
+	  sscanf( buf, "%lf", &pr[0][0] );
+	}
+	else
+	{
+	  if( !strcmp( "matrix", str2 ) )
+	  {
+	    getline( buf );
+	    sscanf( buf, "%c %s %d", &comm, str1, m );
+	    if( strcmp( "rows:", str1 ) )
+	      return retval;
+	    getline( buf );
+	    sscanf( buf, "%c %s %d", &comm, str1, n );
+	    if( strcmp( "columns:", str1 ) )
+	      return retval;
+	    *pr = mxCalloc( (*m)*(*n), sizeof( **pr ) );
+	    *pi = NULL;
+	    for( i=0; i<*m; i++ )
+	    {
+	      getline( buf );
+	      ptr = strtok( buf, " " );
+	      for( j=0; j<*n; j++ )
+	      {
+		sscanf( ptr, "%lf", *pr+j*(*m)+i );
+		ptr = strtok( NULL, " " );
+	      }
+	    }
+	  }
+	  else
+	    return retval;
+	}
+      }
+      retval = 0;
+      flushprompt( 0 );
+    }  /* if variable exists */
+
+  }  /* if( matopen ) */
+
+#ifdef DEBUGAPI
+  fprintf( stdout, "Exit engGetFull with status %d\n", retval );
+  fflush( stdout );
+#endif
+
+  return retval;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/engOpen.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,65 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <unistd.h>
+#include "engine.h"
+#include "engif.h"
+
+Engine matengine=0;
+int    matopen=0;
+
+#define BINEXE "octave"
+
+/* Bug: The parent does not know if the child (octave) dies */
+/* Bug: Need a SIGTERM handler to close the engine */
+
+Engine *engOpen( char *startcommand )
+{
+  static int firstopen=1;
+  pid_t matpid;
+  Engine *retptr;
+
+#ifdef DEBUGAPI
+  fprintf( stdout, "Begin engOpen ...\n" );
+  fflush( stdout );
+#endif
+
+  retptr = NULL;
+  if( !matopen )
+  {
+    if( openpipes() == 0 );
+    {
+      switch(matpid=fork())
+      {
+      case -1:
+	perror("fork");  /* Something went wrong */
+	closepipes();
+	break;
+
+      case 0:            /* This is the child process */
+	plumbpipes();    /* Connect stdin/out to open pipes */
+	execlp(BINEXE, BINEXE, "-q", "-f", "-i", "--traditional", "--no-line-editing", NULL);
+	fprintf( stderr, "Octave execution failed!!!!!\n" );
+	exit( -1 );      /* The child dies */
+
+      default:           /* This is the parent process */
+	matopen = 1;     /* Fork was successful */
+	flushprompt( 0 );   /* Dump the startup stuff */
+	retptr = &matengine;
+	if( firstopen )
+	{
+	  atexit( cleanhouse );  /* If the user doesn't close the engine */
+	  firstopen=0;
+	}
+	break;
+      }
+    }
+  }
+
+#ifdef DEBUGAPI
+  fprintf( stdout, "Exit engOpen with status %p\n", retptr );
+  fflush( stdout );
+#endif
+
+  return retptr;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/engOutputBuffer.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,33 @@
+#include <stdio.h>
+#include "engine.h"
+
+int matbuffer = 0;
+char* matbufptr = NULL;
+int matbufcnt = 0;
+
+int engOutputBuffer( Engine *ep, char *p, int n )
+{
+
+#ifdef DEBUGAPI
+  fprintf( stdout, "Begin engOutputBuffer ...\n" );
+  fflush( stdout );
+#endif
+
+  if( p != NULL )
+  {
+    matbufptr = p;
+    matbufcnt = n;
+  }
+  else
+  {
+    matbufptr = NULL;
+    matbufcnt = 0;
+  }
+
+#ifdef DEBUGAPI
+  fprintf( stdout, "Exit engOutputBuffer with status %d\n", 0 );
+  fflush( stdout );
+#endif
+
+  return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/engPutFull.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,96 @@
+#include <stdio.h>
+#include <unistd.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include "engine.h"
+#include "engif.h"
+
+extern int matopen;
+
+#define PUTSTR "load -ascii -force \"matfifo\"\n"
+#define FIFO_NAME "matfifo"
+
+int engPutFull( Engine *ep, char *name, int m, int n,
+		double *pr, double *pi )
+{
+  int i, j;
+  char buf[BUFMAX];
+  int ffd;
+
+#ifdef DEBUGAPI
+  fprintf( stdout, "Begin engPutFull ...\n" );
+  fflush( stdout );
+#endif
+
+  if( matopen )
+  {
+    /* don't forget to error check this stuff!! */
+    mknod(FIFO_NAME, S_IFIFO | 0655, 0);
+
+    putline( PUTSTR );
+
+    if( strlen( name ) > BUFMAX-9 )
+    {
+      fprintf( stderr, "ERROR: engPutFull name too long\n" );
+      exit( -1 );
+    }
+
+    ffd = open(FIFO_NAME, O_WRONLY);
+
+    sprintf( buf, "# name: %s\n", name );
+    write( ffd, buf, strlen(buf) );
+
+    if( pi == NULL )  /* Real data type */
+    {
+      sprintf( buf, "# type: matrix\n" );
+      write( ffd, buf, strlen(buf) );
+      sprintf( buf, "# rows: %d\n", m );
+      write( ffd, buf, strlen(buf) );
+      sprintf( buf, "# columns: %d\n", n );
+      write( ffd, buf, strlen(buf) );
+      for( i=0; i<m; i++ )
+      {
+	for( j=0; j<n; j++ )
+	{
+	  sprintf( buf, " %f", pr[i+m*j] );
+	  write( ffd, buf, strlen(buf) );
+	}
+	write( ffd, "\n", 1 );
+      }
+    }
+    else  /* Complex data type */
+    {
+      sprintf( buf, "# type: complex matrix\n" );
+      write( ffd, buf, strlen(buf) );
+      sprintf( buf, "# rows: %d\n", m );
+      write( ffd, buf, strlen(buf) );
+      sprintf( buf, "# columns: %d\n", n );
+      write( ffd, buf, strlen(buf) );
+      for( i=0; i<m; i++ )
+      {
+	for( j=0; j<n; j++ )
+	{
+	  sprintf( buf, " (%f,%f)", pr[i+m*j], pi[i+m*j] );
+	  write( ffd, buf, strlen(buf) );
+	}
+	write( ffd, "\n", 1 );
+      }
+    }
+
+    close( ffd );
+
+    remove( FIFO_NAME );
+
+  }
+
+  flushprompt( 0 );
+  flushjunk();
+
+#ifdef DEBUGAPI
+  fprintf( stdout, "Exit engPutFull with status %d\n", 0 );
+  fflush( stdout );
+#endif
+
+  return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/engif.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,265 @@
+#include <stdio.h>
+
+#include <sys/time.h>
+#include <sys/types.h>
+#include <unistd.h>
+
+#include "engine.h"
+#include "engif.h"
+
+int  pfd1[2];
+int  pfd2[2];
+int  outcnt;
+
+extern Engine matengine;
+extern int matopen;
+extern char *matbufptr;
+extern int matbufcnt;
+
+static int savechar( int outdest, char dat );
+
+int openpipes( void )
+{
+  int retval = 0;
+
+  if( pipe( pfd1 ) == -1 )
+  {
+    perror("pipe");
+    retval = -1;
+  }
+  else
+  {
+    if( pipe( pfd2 ) == -1 )
+    {
+      perror("pipe");
+      close( pfd1[0] );  /* Needs some error checking */
+      close( pfd1[1] );  /* Needs some error checking */
+      retval = -1;
+    }
+  }
+  return retval;
+}
+
+
+int closepipes( void )
+{
+  int retval = 0;
+
+  /* Needs some error checking */
+
+  close( pfd1[0] );
+  close( pfd1[1] );
+  close( pfd2[0] );
+  close( pfd2[1] );
+
+  return retval;
+}
+
+
+int plumbpipes( void )
+{
+  int retval = 0;
+
+  /* Needs some error checking */
+
+  close(0);       /* close normal stdin */
+  dup(pfd2[0]);   /* make stdin same as pfd2[0] */
+  close(1);       /* close normal stdout */
+  dup(pfd1[1]);   /* make stdout same as pfd1[1] */
+
+  return retval;
+}
+
+
+void cleanhouse( void )
+{
+  if( matopen )
+    engClose( &matengine );
+}
+
+
+int getline( char* buf )
+{
+  int i;
+
+  /* Read a line into buf */
+  i = 0;
+  do
+  {
+    read( pfd1[0], &buf[i], 1 );
+    i++;
+    if( i == BUFMAX-1 )
+      buf[i-1] = '\n';
+  }
+  while( buf[i-1] != '\n' );
+  buf[i] = '\0';
+
+#ifdef DEBUGAPI
+  printf( "getline: %s", buf );
+#endif
+
+  return 0;
+}
+
+
+int putline( char* buf )
+{
+  int count;
+
+  /* Write a line from buf */
+  count = write( pfd2[1], buf, strlen(buf) );
+
+#ifdef DEBUGAPI
+  printf( "putline: %s", buf );
+#endif
+
+  return count;
+}
+
+int flushjunk( void )
+{
+#ifdef DEBUGAPI
+  char temp;
+  int count;
+  fd_set rfds;
+  struct timeval tv;
+  int retval;
+
+  printf( "flushjunk: " );
+
+  count = 0;
+  do
+  {
+    /* Check the Octave pipe to see if it has input. */
+    FD_ZERO(&rfds);
+    FD_SET(pfd1[0], &rfds);
+    /* Wait up to two seconds. */
+    tv.tv_sec = 2;
+    tv.tv_usec = 0;
+
+    retval = select(pfd1[0]+1, &rfds, NULL, NULL, &tv);
+    /* Don't rely on the value of tv now! */
+
+    if (retval)
+    {
+      count++;
+      read( pfd1[0], &temp, 1 );
+      printf( "%c", temp );
+    }
+  }  while( retval );
+
+  printf("\n");
+  return count;
+#else
+  return 0;
+#endif
+}
+
+
+int flushprompt( int outkey )
+{
+  char temp;
+  int test, count;
+
+  /* If outkey=1  : write all engine output to the output buffer */
+  /*    outkey=2  : write all engine output to stdout */
+  /*    otherwise : discard all output from the engine */
+
+  count = 0;
+  outcnt = 0;
+
+/*   printf( "flushprompt: " ); */
+
+  test = 1;
+  while( test != 4 )
+  {
+    read( pfd1[0], &temp, 1 );
+    switch( test )
+    {
+    case 0:
+      if( temp == '\n' )
+	test = 1;
+      else
+	test = 0;
+      break;
+    case 1:
+      if( temp == '\n' )
+	test = 1;
+      else
+      {
+	if( temp == '>' )
+	  test = 2;
+	else
+	  test = 0;
+      }
+      break;
+    case 2:
+      if( temp == '>' )
+	test = 3;
+      else
+      {
+	test = 0;
+	savechar( outkey, '>' );   /* Save the current ">" char */
+      }
+      break;
+    case 3:
+      if( temp == ' ' )
+	test = 4;
+      else
+      {
+	test = 0;
+	savechar( outkey, '>' );   /* Save the previous ">" char */
+	savechar( outkey, '>' );   /* Save the current ">" char */
+      }
+      break;
+    }
+    if( test < 2 )
+      savechar( outkey, temp );
+  }
+  if( outkey == 2 )
+    printf( ">> " );
+  else
+  {
+    if( outkey == 1 )
+    {
+      /* Add terminating NULL to output buffer */
+      if( matbufptr != NULL )
+	if( outcnt < matbufcnt )
+	{
+	  matbufptr[outcnt] = '\0';
+	  outcnt++;
+	}
+    }
+  }
+
+  return count;
+}
+
+
+static int savechar( int outdest, char dat )
+{
+  /* If outdest=1 : write all engine output to the output buffer */
+  /*    outdest=2 : write all engine output to stdout */
+  /*    otherwise : discard all output from the engine */
+
+  switch( outdest )
+  {
+  case 0:
+    break;
+  case 1:
+    if( matbufptr != NULL )
+      if( outcnt < matbufcnt-1 )
+      {
+	matbufptr[outcnt] = dat;
+	outcnt++;
+      }
+    break;
+  case 2:
+    putchar( dat );
+    break;
+  default:
+    fprintf( stderr, "Engine: unknown output destination specified\n" );
+  }
+
+  return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/engif.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,13 @@
+int flushprompt( int outkey );
+int flushjunk( void );
+int getline( char* buf );
+int putline( char* buf );
+int openpipes( void );
+int closepipes( void );
+int plumbpipes( void );
+void cleanhouse( void );
+
+extern int pfd1[2];
+extern int pfd2[2];
+
+#define BUFMAX 1000
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/engine.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,13 @@
+typedef char Engine;
+
+Engine *engOpen( char *startcommand );
+int engGetFull( Engine *ep, char *name, int *m, int *n,
+		double **pr, double **pi );
+int engPutFull( Engine *ep, char *name, int m, int n,
+		double *pr, double *pi );
+int engEvalString( Engine *ep, char *string );
+int engOutputBuffer( Engine *ep, char *p, int n );
+int engClose( Engine *ep );
+
+void *mxCalloc( unsigned int n, unsigned int size );
+void mxFree( void *ptr );
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/mattest.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,88 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include <string.h>
+#include "engine.h"
+
+#define MAT_STR 4000 	/* maximum number of chars of matlab return string */
+#define CMD_LEN 4   	/* length of "quit" and "exit" commands */
+
+int main( void )
+{
+  Engine *eng_ptr;
+  char out_str[MAT_STR];
+  char in_str[MAT_STR];
+
+  int i, j;
+  int m, n;
+  double ar[100], ai[100], *aar, *aai;
+
+  m = 3;
+  n = 5;
+  for( i=0; i<m; i++ )
+    for( j=0; j<n; j++ )
+      ar[i+m*j] = ai[i+m*j] = j+n*i;
+
+  eng_ptr = engOpen( "\0" );
+  engOutputBuffer(eng_ptr, out_str, MAT_STR);
+
+  engPutFull( eng_ptr, "a", m, n, ar, NULL );
+	
+  strcpy(in_str, " ");
+
+  printf("\n============================================");
+  printf("\n= Emulated MATLAB command-line C interface =");
+  printf("\n============================================");
+  printf("\n\n");
+
+  /* MATLAB emulation loop */
+ 
+  while( strncmp(in_str, "quit", CMD_LEN) && strncmp(in_str, "exit", CMD_LEN ) )
+  {
+    printf(">> ");
+    fgets(in_str, MAT_STR-1, stdin);
+
+    if( strncmp(in_str, "quit", CMD_LEN) && strncmp(in_str, "exit", CMD_LEN ) )
+    {
+      engEvalString(eng_ptr, in_str);
+/*       if(strlen(out_str) >= 2) */
+/*       { */
+/* 	out_str[0] = ' '; */
+/* 	out_str[1] = ' '; */
+/*       } */
+      printf("%s", out_str);
+    } /* if strncmp */ 
+  }  /* while */
+
+  if( engGetFull( eng_ptr, "a", &m, &n, &aar, &aai ) == 0 )
+  {
+    printf( "Matrix a\n" );
+    if( aai == NULL )
+    {
+      for( i=0; i<m; i++ )
+      {
+	for( j=0; j<n; j++ )
+	  printf( " % f", aar[i+m*j]);
+	printf( "\n" );
+      }
+    }
+    else
+    {
+      for( i=0; i<m; i++ )
+      {
+	for( j=0; j<n; j++ )
+	  printf( " % f + % f", aar[i+m*j], aai[i+m*j] );
+	printf( "\n" );
+      }
+    }
+    mxFree( aar );
+    mxFree( aai );
+  }
+  else
+    printf( "Error reading Matrix a\n" );
+
+  printf("\nClosing Matlab engine...\n");
+  engClose( eng_ptr );
+
+  return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/mxCalloc.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,7 @@
+#include "engine.h"
+#include <stdlib.h>
+
+void *mxCalloc( unsigned int n, unsigned int size )
+{
+  return calloc( (size_t) n, (size_t) size );
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/engine/mxFree.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,7 @@
+#include <stdlib.h>
+#include "engine.h"
+
+void mxFree( void *ptr )
+{
+  free( ptr );
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/fake-sparse/full.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,20 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## full(A): return the full matrix corresponding to the sparse matrix A
+## Fake sparse function: represents sparse matrices using full matrices
+function B=full(A)
+  B=A;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/fake-sparse/issparse.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,20 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## issparse(A) : true if A is a sparse matrix
+## Fake sparse function: represents sparse matrices using full matrices
+function t = issparse(A)
+  t = 0;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/fake-sparse/sparse.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,96 @@
+## Copyright (C) 2000  Pascal Fleury
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Fake sparse function: represents sparse matrices using full matrices
+## sparse (A) [A matrix] 
+##              return A
+## sparse (m, n)
+##              return an mxn matrix of zeros
+## sparse (i, j, s [, m, n [, maxnz]])
+##              return an mxn matrix with values of vector s at
+##              locations given by the corresponding indices in
+##              vector i and j.  Any of i, j or s may be given as
+##              scalars, in which case the same value is used for
+##              all sparse entries, otherwise i, j and s must
+##              be the same length.  The maximum number of non-zero
+##              entries allowed in the sparse matrix, maxnz, is
+##              accepted for compatibility but otherwise ignored.
+##              m and n default to max(i) and max(j) respectively.
+## Example:
+##              A = sparse( [1,2,4], [2,1,3], [0.5,0.1,0.2], 4, 3)
+##              A = [  0   0.5   0
+##                    0.1   0    0
+##                     0    0    0
+##                     0    0   0.2 ]
+
+## Author: Pascal Fleury
+## Modified-by: Paul Kienzle (for speed and further compatibility)
+
+function A = sparse(i,j,s,m,n,maxnz)
+  if (nargin < 1 || nargin > 6 || nargin == 4)
+    usage ("sparse(A) or sparse(m, n) or sparse(i, j, s [, m, n [, maxnz]])");
+  endif
+
+  if ( nargin == 1 )
+    ## We get a full matrix to sparsify
+    A = i;
+
+  elseif ( nargin == 2 )
+    ## We get only the size of the matrix
+    A = zeros(i,j);
+
+  else
+    ## ignore original shapes for indices and values
+    i = i(:); j=j(:); s=s(:);
+
+    ## assign defaults for m, n, maxnz
+    if nargin < 5
+      m = max(i);
+      n = max(j);
+    endif
+    sizes = [length(i) length(j) length(s)];
+    nnz = max(sizes);
+    if nargin < 6
+      maxnz = nnz;
+    endif
+
+    ## Verify that the index and value vectors are the same shape
+    if ( any (sizes != nnz & sizes != 1) )
+      error("sparse: index and value vectors i,j, and s must be of same size"); 
+    endif
+
+    ## Verify that the indices lie within A
+    if ( any ( i < 1 | i > m | j < 1 | j > n ) )
+      error("sparse: index [i,j] must lie within the matrix [m,n]");
+    endif
+      
+    ## Force indices to be integers
+    if ( any( i != floor(i) | j != floor(j) ) )
+      warning("sparse: index [i,j] should be integers")
+      i = floor(i); j = floor(j);
+    endif
+      
+    ## Ok, set the values!
+    A = zeros(m,n);
+    dfi = do_fortran_indexing;
+    unwind_protect
+      do_fortran_indexing = 1;
+      A((j-1)*m + i) = s;
+    unwind_protect_cleanup
+      do_fortran_indexing = dfi;
+    end_unwind_protect
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/fake-sparse/spdiags.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,93 @@
+## Copyright (C) 2000-2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## spdiags(A): extract all non-zero diagonals of A.
+## spdiags(A,c): extract diagonals c of A.
+## spdiags(v,c,A): use columns of v to replace the diagonals c of A
+## spdiags(v,c,m,n): use columns of v as the diagonals c of mxn matrix A
+##
+## -c lower diagonal, 0 main diagonal, +c upper diagonal
+## E.g.,
+##
+## v-> 1  5  9
+##     2  6 10
+##     3  7 11
+##     4  8 12
+## spdiags(v, [-1 0 1], 5, 4)
+## ->  5 10  0  0
+##     1  6 11  0
+##     0  2  7 12
+##     0  0  3  8
+##     0  0  0  4
+## Fake sparse function: represents sparse matrices using full matrices
+function [A, c] = spdiags(v,c,m,n)
+
+  dfi = do_fortran_indexing;
+  unwind_protect
+    do_fortran_indexing = 1;
+    
+    if nargin == 1
+      ## extract nonzero diagonals of v into A,c
+      [m, n] = size(v);
+      nr = n;
+      nc = m + n - 1;
+      c = -m+1:n-1;
+      A = zeros(nr,nc);
+      ridx = [1:nr]'*ones(1,nc) - ones(nr,1)*c(:)';
+      Aidx = ridx + m*[0:nr-1]'*ones(1,nc);
+      idx = find(ridx > 0 & ridx <= m);
+      A(idx) = v(Aidx(idx));
+      c = find (any (A != 0));
+      A = A(:,c);
+      c = c - m;
+
+    elseif nargin == 2
+      ## extract specific diagonals c of v into A
+      nr = size(v,2);
+      nc = length(c(:));
+      A = zeros(nr,nc);
+      [m, n] = size(v);
+      ridx = [1:nr]'*ones(1,nc) - ones(nr,1)*c(:)';
+      Aidx = ridx + m*[0:nr-1]'*ones(1,nc);
+      idx = find(ridx > 0 & ridx <= m);
+      A(idx) = v(Aidx(idx));
+
+    elseif nargin == 3
+      ## Replace specific diagonals c of m with v,c
+      A = m;
+      [m, n] = size(A);
+      [nr, nc] = size(v);
+      ridx = [1:nr]'*ones(1,nc) - ones(nr,1)*c(:)';
+      Aidx = ridx + m*[0:nr-1]'*ones(1,nc);
+      idx = find(ridx > 0 & ridx <= m);
+      A(Aidx(idx)) = v(idx);
+      
+    else
+      ## Create new matrix of size mxn using v,c
+      A = zeros(m,n);
+      [nr, nc] = size(v);
+      ridx = [1:nr]'*ones(1,nc) - ones(nr,1)*c(:)';
+      Aidx = ridx + m*[0:nr-1]'*ones(1,nc);
+      idx = find(ridx > 0 & ridx <= m);
+      A(Aidx(idx)) = v(idx);
+      
+    endif
+    
+  unwind_protect_cleanup
+    do_fortran_indexing = dfi;
+  end_unwind_protect
+
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/fake-sparse/spy.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,20 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## spy(x): compactly show which elements of x are non-zero
+## Fake sparse function: represents sparse matrices using full matrices
+function spy(x)
+  imagesc(x!=0);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/Contents.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,113 @@
+% Numerical Integration Toolbox 
+%
+% MATLAB Toolbox for 1-D, 2-D, and n-D Numerical Integration
+%
+% Edited Version for OCTAVE
+% 
+% The original 1-D routines were obtained from NETLIB and were 
+% written by
+%          Howard Wilson
+%          Department of Engineering Mechanics
+%          University of Alabama
+%          Box 870278
+%          Tuscaloosa, Alabama 35487-0278
+%          Phone 205 348-1617
+%          Email address: HWILSON @ UA1VM.UA.EDU
+% 
+% The rest of the routines were written by
+%          Bryce Gardner
+%          Ray W. Herrick Laboratories
+%          Purdue University
+%          West Lafayette, IN 47906
+%          Phone: 317-494-0231
+%          Fax:  317-494-0787
+%          Email:  gardner@ecn.purdue.edu
+%
+% Easy to use routines:  (these routines iteratively integrate with 
+%			  higher order quadratures until the integral has
+%			  converged--use these routine unless you want to
+%			  specify the order of integration quadrature that
+%			  is to be used)
+%	   quadg.m	-- High accuracy replacement for QUAD and QUAD8 (1-D)
+%	   quad2dg.m	-- 2-D integration over a rectangular region
+%	   quad2dggen.m	-- 2-D integration over a general region
+%	   quadndg.m	-- n-D integration over a n-D hyper-rectangular region
+%          README.nit	-- introductory readme file
+%
+% The 1-D routines:
+%          README	-- The original readme file by Howard Wilson
+%          gquad.m	-- Integrates a 1-D function with input Gauss 
+%			   points and weights (modified by Bryce Gardner to
+%			   handle an optional parameter in the function to be
+%			   integrated and also to calculate the Gauss points
+%			   and weights on the fly)
+%          gquad6.m	-- Integrates a 1-D function with a 6-point quadrature
+%          grule.m	-- Calculates the Gauss points and weights
+%          run.log	-- File with examples
+%
+%    New 1-D routines:
+%	   quadg.m	-- High accuracy replacement for QUAD and QUAD8
+%	   quadc.m	-- 1-D Gauss-Chebyshev integration routine
+%          crule.m	-- Calculates the Gauss-Chebyshev points and weights
+%          ncrule.m	-- Calculates the Newton-Coates points and weights
+%
+% The 2-D routines:
+%	   quad2dg.m	-- 2-D integration over a rectangular region
+%	   quad2dc.m	-- 2-D integration over a rectangular region with
+%			   a 1/sqrt(1-x.^2)/sqrt(1-y.^2) sinqularity
+%          gquad2d.m	-- Integrates a 2-D function over a square region
+%          gquad2d6.m	-- Integrates a 2-D function over a square region with
+%			   a 6-point quadrature
+%	   quad2dggen.m	-- 2-D integration over a general region
+%	   quad2dcgen.m	-- 2-D integration over a general region with
+%			   a 1/sqrt(1-x.^2)/sqrt(1-y.^2) sinqularity
+%          gquad2dgen.m -- Integrates a 2-D function over a variable region
+%			   (That is the limits on the inner integration are
+%			   defined by a function of the variable of integration
+%			   of the outer integral.)
+%          grule2d.m	-- Calculates the Gauss points and weights for gquad2d.m
+%          grule2dgen.m -- Calculates the Gauss points and weights for 
+%			   gquad2dgen.m
+%          crule2d.m	-- Calculates the Gauss-Chebyshev points and weights 
+%			   for gquad2d.m
+%          crule2dgen.m -- Calculates the Gauss-Chebyshev points and weights 
+%			   for gquad2dgen.m
+%
+% The n-D routines:
+%          quadndg.m	-- n-D integration over an n-D hyper-rectangular region
+%          gquadnd.m    -- Integrates a n-D function over 
+%                          an n-D hyper-rectangular 
+%			   region using a Gauss quadrature
+%          cquadnd.m    -- Integrates a n-D function over 
+%                          an n-D hyper-rectangular 
+%			   region using a Gauss-Chebyshev quadrature
+%          innerfun.m   -- used internally to gquadnd.m and cquadnd.m
+%
+% Utility routines:
+%	   count.m	-- routine to count the number of function calls
+%	   zero_count.m	-- routine to report the number of function calls and
+%			   then to reset the counter
+%
+% Test scripts:
+%          run2dtests.m	-- 2-D examples and 1-D Gauss-Chebyshev examples
+%	   tests2d.log  -- output of run2dtests.m -- Matlab 4.1 on a Sparc 10
+%	   test_ncrule.m-- m-file to check the Newton-Coates quadrature
+%	   testsnc.log  -- output of test_ncrule.m -- Matlab 4.1 on a Sparc 10
+%	   test_quadg.m -- m-file to check the quadg routine
+%	   testsqg.log  -- output of test_quadg.m -- Matlab 4.1 on a Sparc 10
+%
+% Test functions:
+%          xsquar.m	-- xsquar(x)=x.^2
+%          xcubed.m	-- xcubed(x)=x.^3
+%          x25.m	-- x25(x)=x.^25
+%	   fxpow.m	-- fxpow(x,y)=x.^y
+%          hx.m         -- hx(x)=sum(x.^2)
+%          gxy.m	-- gxy(x,y)=x.^2+y.^2
+%          gxy1.m	-- gxy1(x,y)=ones(size(x))
+%          gxy2.m	-- gxy2(x,y)=sqrt(x.^2+y.^2)
+%          glimh.m	-- glimh(y)=3
+%          glimh2.m	-- glimh(y)=y
+%          gliml.m	-- gliml(y)=0
+%          lcrcl.m	-- lcrcl(y)=-sqrt(4-y.^2)
+%          lcrcu.m	-- lcrcu(y)=sqrt(4-y.^2)
+%
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/README	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,35 @@
+ Numerical Integration Toolbox
+
+ MATLAB Toolbox for 1-D, 2-D, and n-D Numerical Integration
+
+ The original 1-D routines were obtained from NETLIB and were 
+ written by
+          Howard Wilson
+          Department of Engineering Mechanics
+          University of Alabama
+          Box 870278
+          Tuscaloosa, Alabama 35487-0278
+          Phone 205 348-1617
+          Email address: HWILSON @ UA1VM.UA.EDU
+ 
+ The rest of the routines were written by
+          Bryce Gardner
+          Ray W. Herrick Laboratories
+          Purdue University
+          West Lafayette, IN 47906
+          Phone: 317-494-0231
+          Fax:  317-494-0787
+          Email:  gardner@ecn.purdue.edu
+
+ These are the general purpose integration routines: 
+
+        quadg.m      -- High accuracy replacement for QUAD and QUAD8 (1-D)
+        quad2dg.m    -- 2-D integration over a rectangular region
+        quad2dggen.m -- 2-D integration over a general region
+        quadndg.m    -- n-D integration over a n-D hyper-rectangular region
+
+ Use the other routines if you want a specific integration quadrature or
+ specific order of integration quadrature.  It is faster if you know that
+ you need a 10th order integration quadrature to use it directly.  If you
+ use the above routines, the integration will be done with quadratures of 
+ several different orders until the results converge.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/README.Copying	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,59 @@
+From help-octave-request@bevo.che.wisc.edu  Thu Aug 24 11:45:27 1995
+Received: (from daemon@localhost) by bevo.che.wisc.edu (8.6.12/8.6.12) id LAA14483 for help-octave-outgoing; Thu, 24 Aug 1995 11:45:27 -0500
+Received: from bru.mayo.EDU (bru.mayo.edu [129.176.200.17]) by bevo.che.wisc.edu (8.6.12/8.6.12) with SMTP id LAA14470 for <help-octave@bevo.che.wisc.edu>; Thu, 24 Aug 1995 11:45:26 -0500
+Received: from us0.mayo.EDU by bru.mayo.EDU (4.1/SMI-4.0)
+	id AA12458; Thu, 24 Aug 95 10:57:03 CDT
+Received: from us6.sky2 by us0.mayo.EDU (4.1/SMI-4.1)
+	id AA08624; Thu, 24 Aug 95 10:57:46 CDT
+Date: Thu, 24 Aug 95 10:57:46 CDT
+From: vdp@us0.mayo.EDU (Vinayak Dutt)
+Received: by us6.sky2 (4.1/SMI-4.1)
+	id AA18238; Thu, 24 Aug 95 10:58:13 CDT
+Subject: Re:  Integration toolbox for MATLAB
+To: help-octave@bevo.che.wisc.edu
+Message-Id: <vdp-9507241558.AA000118199@us6>
+Reply-To: Dutt.Vinayak@mayo.EDU
+Organization: Ultrasound Research Lab, Mayo Clinic and Foundation
+X-Mailer: TkMail-2.0Beta18
+Sender: help-octave-request@bevo.che.wisc.edu
+
+Hi Octavers:
+
+  I just checked with the author of the original MATLAB toolbox for
+gaussian quadrature about using the toolbox with OCTAVE. And its
+fine with him if we use/distribute the code for OCTAVE. So the ftp site
+maintainers can put the integration toolbox port of mine for
+distribution. Here's the message from Bryce Gradner on his permission.
+
+-vinayak --
+
+---------- Forwarded message from virgo!autoa.com!bgard@msen.com on Thu, 24 Aug 95 10:15:57 EDT -----------
+Return-Path: <virgo!autoa.com!bgard@msen.com>
+Received: from bru.mayo.EDU by us0.mayo.EDU (4.1/SMI-4.1)
+	id AA08207; Thu, 24 Aug 95 10:37:14 CDT
+Received: from heifetz.msen.com by bru.mayo.EDU (4.1/SMI-4.0)
+	id AA12053; Thu, 24 Aug 95 10:36:28 CDT
+Received: from virgo.UUCP by heifetz.msen.com with UUCP
+	(Smail3.1.28.1 #12) id m0sldyI-0009ZsC; Thu, 24 Aug 95 11:13 EDT
+Received: from aquarius.autoa.com by autoa.com (4.1/SMI-4.1)
+	id AA00684; Thu, 24 Aug 95 10:15:57 EDT
+Date: Thu, 24 Aug 95 10:15:57 EDT
+From: bgard@autoa.com (Bryce Gardner)
+Message-Id: <9508241415.AA00684@autoa.com>
+To: Dutt.Vinayak@mayo.EDU
+Subject: Re:  Integration toolbox for MATLAB
+
+Hi,
+
+Sorry it took me so long to get back to you.  I am on the octave mailing
+list, so I already saw that you were porting the integration routines to
+OCTAVE.  I am glad to see that you did; it is certainly OK with me to 
+distribute them with OCTAVE.  I'm glad to see that they are being used.
+
+Bryce
+
+ps:  my email is now     bgard@autoa.com
+
+
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/README.gaussq	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,18 @@
+% Abstract (March 10,1990)
+%
+% GAUSSQ  - Routines for Composite Gauss Integration
+%
+% The following routines perform numerical integration by
+% composite Gauss integration. A function to give  base
+% points and weight factors is also included. A document
+% comparing results from these formulas and output from the
+% function quad provided in MATLAB is provided to illustrate
+% the accuracy obtainable using Gauss composite integration.
+
+%          Written by Howard Wilson
+%          Department of Engineering Mechanics
+%          University of Alabama
+%          Box 870278
+%          Tuscaloosa, Alabama 35487-0278
+%          Phone 205 348-1617
+%          Email address: HWILSON @ UA1VM.UA.EDU
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/count.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,7 @@
+global NUM_COUNT
+
+if ( exist('NUM_COUNT') == 1)
+  NUM_COUNT=NUM_COUNT+length(x(:));
+else
+  NUM_COUNT=length(x(:));
+endif
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/cquadnd.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,20 @@
+function nvol = cquadnd (fun,lowerlim,upperlim,nquad)
+%usage:  nvol = cquadnd (fun,lowerlim,upperlim,nquad);
+%	n	-- number of dimensions to integrate
+%	nvol	-- value of the n-dimensional integral
+%	fun	-- fun(x) (function to be integrated) in this case treat
+%                  all the different values of x as different variables
+%                  as opposed to different instances of the same variable
+%	x	-- n length vector of coordinates
+%	lowerlim-- n length vector of lower limits of integration
+%	upperlim-- n length vector of upper limits of integration
+%	nquad	-- n length vector of number of gauss points 
+%		   in each integration
+
+n=length(lowerlim);
+level=n;
+x=zeros(n,1);
+
+nvol = innerfun(fun,lowerlim,upperlim,nquad,n,level,x,'crule');
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/crule.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,32 @@
+function [bp,wf]=crule(m)
+%
+%usage:  [bp,wf]=crule(m)
+%  This function computes Gauss-Chebyshev base points and weight factors
+%  using the algorithm given by somebody in 'SomeBook',
+%  page 365, Academic Press, 1975, but modified by a change
+%  in index variables:  j=i+1 and m=n+1.
+%  The weights are all wf_j=pi/m
+%  and the base points are bp_j=cos((2j-1)*pi/2/m)
+%
+%  m -- number of Gauss-Chebyshev points (integrates a (2m-1)th order
+%       polynomial exactly)
+%
+%  The Gauss-Chebyshev Quadrature integrates an integral of the form
+%     1					     m
+%  Int ((1/sqrt(1-z^2)) f(z)) dz  =  pi/m Sum  (f(cos((2j-1)*pi/2/m)))
+%    -1					    j=1
+%  For compatability with the other Gauss Quadrature routines, I brought
+%  the weight factor into the summation as
+%     1					 m
+%  Int ((1/sqrt(1-z^2)) f(z)) dz  =   Sum  (pi/m * f(cos((2j-1)*pi/2/m)))
+%    -1					j=1
+
+%  By Bryce Gardner, Purdue University, Spring 1993.
+
+j=[1:m]';
+
+wf = ones(m,1) * pi / m;
+
+bp=cos( (2*j-1)*pi / (2*m) );
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/crule2d.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,12 @@
+function [bpx,bpy,wfxy] = crule2d (nquadx,nquady)
+%
+%usage:  [bpx,bpy,wfxy] = crule2d (nquadx,nquady);
+%
+	[bpxv,wfxv]=crule(nquadx);
+	[bpyv,wfyv]=crule(nquady);
+%	[bpx,bpy]=meshgrid(bpxv,bpyv);
+%	[wfx,wfy]=meshgrid(wfxv,wfyv);
+	[bpx,bpy]=meshdom(bpxv,bpyv);
+	[wfx,wfy]=meshdom(wfxv,wfyv);
+	wfxy=wfx.*wfy;
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/crule2dgen.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,7 @@
+function [bpxv,wfxv,bpyv,wfyv] = crule2dgen (nquadx,nquady)
+%
+%usage:  [bpxv,wfxv,bpyv,wfyv] = crule2dgen (nquadx,nquady);
+%
+	[bpxv,wfxv]=crule(nquadx);
+	[bpyv,wfyv]=crule(nquady);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/gquad.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,57 @@
+function area = gquad (fun,xlow,xhigh,mparts,bp,wf,y)
+%
+%  area = gquad (fun,xlow,xhigh,mparts,bp,wf)
+%    or
+%  area = gquad (fun,xlow,xhigh,mparts,nquad)
+%    or
+%  area = gquad (fun,xlow,xhigh,mparts,bp,wf,y)
+%  This function evaluates the integral of an externally
+%  defined function fun(x) between limits xlow and xhigh. The
+%  numerical integration is performed using a composite Gauss
+%  integration rule.  The whole interval is divided into mparts
+%  subintervals and the integration over each subinterval
+%  is done with an nquad point Gauss formula which involves base
+%  points bp and weight factors wf.  The normalized interval
+%  of integration for the bp and wf constants is -1 to +1. The
+%  algorithm is described by the summation relation
+%  x=b                     j=n k=m
+%  integral( f(x)*dx ) = d1*sum sum( wf(j)*fun(a1+d*k+d1*bp(j)) )
+%  x=a                     j=1 k=1
+%         where bp are base points, wf are weight factors
+%         m = mparts, and n = length(bp) and
+%         d = (b-a)/m, d1 = d/2, a1 = a-d1
+%  The base points and weight factors must first be generated
+%  by a call to grule of the form [bp,wf] = grule(nquad)
+%
+%  Optional argument, nquad, is used if the Gauss points and weights
+%  have not been previously calculated.
+%
+%  Optional argument, y, is used if the function, fun is a function
+%  of x and y.  fun(x,y) will be integrated over the range in x for 
+%  the constant, y.
+
+%      by Howard Wilson, U. of Alabama, Spring 1990
+%      modified by Bryce Gardner, Purdue U., Spring 1993 to handle
+%      optional parameter y and also to call with the number of points
+%      instead of passing the points and weights.
+
+if ( nargin < 6)
+  nquad=bp;
+  [bp,wf]=grule(nquad);
+endif
+bp=reshape(bp,length(bp),1); wf=reshape(wf,length(wf),1);
+d = (xhigh - xlow)/mparts;  d2 = d/2;  nquad = length(bp);
+% x = (d2*bp)*ones([1,mparts]) + (d*ones([nquad,1]))*([1:mparts]);
+x1 = (d2.*bp)*ones([1,mparts]) ;
+x2 = (d.*ones([nquad,1]))*([1:mparts]);
+x = x1 + x2;
+x = x + (xlow-d2); 
+if ( nargin == 7 )
+  fv = feval(fun,x,y); 
+else
+  fv = feval(fun,x); 
+endif
+wv = wf*ones([1,mparts]);
+area=d2.*(sum(wv.*fv));
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/gquad2d.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,63 @@
+function vol = gquad2d(fun,xlow,xhigh,ylow,yhigh,b1,b2,w1)
+%
+%usage:  vol = gquad2d(fun,xlow,xhigh,ylow,yhigh,bpx,bpy,wfxy)
+% or
+%        vol = gquad2d(fun,xlow,xhigh,ylow,yhigh,nquadx,nquady)
+%  This function evaluates the integral of an externally
+%  defined function fun(x,y) between limits xlow and xhigh
+%  and ylow and yhigh. The numerical integration is performed 
+%  using a Gauss integration rule.  The integration 
+%  is done with an nquadx by nquady Gauss formula which involves base
+%  point matrices bpx and bpy and weight factor matrix wfxy.  The normalized 
+%  interval of integration for the bpx, bpy and wfxy constants is -1 to +1 
+%  (in x) and -1 to +1 (in y). The algorithm is described by the 
+%  summation relation
+%  x=b                     j=nx k=ny
+%  integral( f(x)*dx ) = J*sum sum( wfxy(j,k)*fun( x(j), y(k) ) )
+%  x=a                     j=1 k=1
+%         where wfxy are weight factors,
+%         nx = nquadx = number of Gauss points in the x-direction,
+%         ny = nquady = number of Gauss points in the y-direction,
+%         x = (xhigh-xlow)/2 * bpx + (xhigh+xlow)/2 = mapping function in x,
+%         y = (yhigh-ylow)/2 * bpy + (yhigh+ylow)/2 = mapping function in y,
+%         and J = (xhigh-xlow)*(yhigh-ylow)/4 = Jacobian of the mapping.
+%  The base points and weight factors must first be generated
+%  by a call to grule of the form [bpx,bpy,wfxy] = grule2d(nquadx,nquady)
+%
+% The first form of gquad2d is faster when used several times, because 
+% the points and weights are only calculated once.
+%
+% The second form of gquad2d is usefull if it is only called once (or a 
+% few times).
+
+%      by Bryce Gardner, Purdue University, Spring 1993
+%      extending Howard Wilson's (U. of Alabama, Spring 1990) 
+%      set of 1-D Gauss quadrature routines.
+
+if ( nargin == 7 )
+  nquadx=b1;
+  nquady=b2;
+  [bpx,bpy,wfxy]=grule2d(nquadx,nquady);
+elseif ( nargin == 8 )
+  bpx = b1;
+  bpy = b2;
+  wfxy = w1;
+else
+  disp('Wrong Number of Input Arguments')
+  return
+endif
+
+%Map to x
+qx=(xhigh-xlow)/2;
+px=(xhigh+xlow)/2;
+x=qx*bpx+px;
+
+%Map to y
+qy=(yhigh-ylow)/2;
+py=(yhigh+ylow)/2;
+y=qy*bpy+py;
+
+fv = feval(fun,x,y);
+vol = sum(sum(wfxy.*fv))*qx*qy;
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/gquad2d6.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,27 @@
+function vol = gquad6(fun,xlow,xhigh,ylow,yhigh)
+%
+%usage:  vol = gquad6(fun,xlow,xhigh,ylow,yhigh)
+%
+%   ==== Six Point by Six Point Double Integral Gauss Formula ====
+%
+%  This function determines the volume under an externally
+%  defined function fun(x,y) between limits xlow and xhigh and
+%  ylow and yhigh. The numerical integration is performed using 
+%  a gauss integration rule.  The integration is done with a 
+%  six point Gauss formula which involves base
+%  points bpx, bpy and weight factors wfxy.  The normalized interval
+%  of integration for the bp and wf constants is -1 to +1 (in x) and
+%  -1 to 1 (in y).  The algorithm is structured in terms of a 
+%  parameter nquad = 6 which can be changed to accommodate a different
+%  order formula.
+
+%     by Bryce Gardner, Purdue University, Spring 1993
+%     modified from gquad6.m by Howard B. Wilson, U. of Alabama, Spring 1990
+
+nquad = 6;
+nquadx = nquad;
+nquady = nquad;
+[bpx,bpy,wfxy] = grule2d(nquadx,nquady);
+vol = gquad2d(fun,xlow,xhigh,ylow,yhigh,bpx,bpy,wfxy);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/gquad2dgen.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,64 @@
+function vol = gquad2dgen(funxy,limxlow,limxhigh,ylow,yhigh,b1,w1,b2,w2)
+%
+%usage: vol = gquad2dgen(funxy,limxlow,limxhigh,ylow,yhigh,bpxv,wfxv,bpyv,wfyv);
+%  or
+%usage: vol = gquad2dgen(funxy,limxlow,limxhigh,ylow,yhigh,nquadx,nquady);
+%
+% This function evaluates a general double integral.  The limits of the 
+% inner integration may be functions of the outer integral's variable of 
+% integration.  Such as
+%              yhigh    ghigh(y)
+%      Vol = Int     Int       f(x,y)  dx  dy
+%              ylow    glow(y)
+% where
+%      funxy = f(x,y)
+%      limxlow = glow(y)
+%      limxhigh = ghigh(y)
+% and the base points and weighting functions are found from
+%     [bpxv,wfxv,bpyv,wfyv]=grule2dgen(nquadx,nquady);
+% where nquadx and nquady are the number of gauss points in the x- and
+% y-directions, respectively.
+%
+% The first form of gquad2dgen is faster when used several times, because 
+% the points and weights are only calculated once.
+%
+% The second form of gquad2dgen is usefull if it is only called once (or a 
+% few times).
+
+%      by Bryce Gardner, Purdue University, Spring 1993
+%      extending Howard Wilson's (U. of Alabama, Spring 1990) 
+%      set of 1-D Gauss quadrature routines to 2-dimensions.
+
+if ( nargin == 7 )
+  nquadx=b1;
+  nquady=w1;
+  [bpxv,wfxv,bpyv,wfyv]=grule2dgen(nquadx,nquady);
+elseif ( nargin == 9 )
+  bpxv = b1;
+  wfxv = w1;
+  bpyv = b2;
+  wfyv = w2;
+else
+  disp('Wrong Number of Input Arguments')
+  return
+endif
+
+nquady=length(bpyv);
+qy=(yhigh-ylow)/2;
+py=(yhigh+ylow)/2;
+
+vol = 0;
+
+for i=1:nquady
+  y=qy*bpyv(i)+py;
+
+  xhigh=feval(limxhigh,y);
+  xlow=feval(limxlow,y);
+
+  vx  = gquad(funxy,xlow,xhigh,1,bpxv,wfxv,y);
+  vol = vol + (wfyv(i) * vx);
+endfor
+
+vol = vol .* qy;
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/gquad6.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,43 @@
+function area = gquad6(fun,xlow,xhigh,mparts)
+%
+%
+%   ==== Six Point Composite Gauss Formula ====
+%   ====   With Weight Factors Included    ====
+%
+%  area = gquad6(fun,xlow,xhigh,mparts)
+%  This function determines the area under an externally
+%  defined function fun(x) between limits xlow and xhigh. The
+%  numerical integration is performed using a composite gauss
+%  integration rule.  The whole interval is divided into mparts
+%  subintervals and the integration over each subinterval
+%  is done with a six point Gauss formula which involves base
+%  points bp and weight factors wf.  The normalized interval
+%  of integration for the bp and wf constants is -1 to +1.  the
+%  algorithm is structured in terms of a parameter mquad = 6 which
+%  can be changed along with bp and wf to accommodate a different
+%  order formula.  The composite algorithm is described by the
+%  following summation relation
+%  x=b                     j=n k=m
+%  integral( f(x)*dx ) = d1*sum sum( wf(j)*fun(a1+d*k+d1*bp(j)) )
+%  x=a                     j=1 k=1
+%        where d = (b-a)/m, d1 = d/2, a1 = a-d1,
+%              m = mparts, and n = nquad.
+%
+
+%     by Howard B. Wilson, U. of Alabama, Spring 1990
+
+%  The weight factors are
+wf = [ 1.71324492379170d-01;   3.60761573048139d-01;...
+        4.67913934572691d-01]; wf=[wf;wf([3,2,1])];
+
+%  The base points are
+bp = [-9.32469514203152d-01;  -6.61209386466265d-01;...
+      -2.38619186083197d-01]; bp=[bp;-bp([3,2,1])];
+
+d = (xhigh - xlow)/mparts;  d2 = d/2;  nquad = length(bp);
+x = (d2*bp)*ones(1,mparts) + (d*ones(nquad,1))*(1:mparts);
+x = x(:) + (xlow-d2); fv=feval(fun,x); wv = wf*ones(1,mparts);
+
+area=d2*(wv(:)'*fv(:));
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/gquadnd.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,21 @@
+function nvol = gquadnd (fun,lowerlim,upperlim,nquad)
+%
+%usage:  nvol = gquadnd (fun,lowerlim,upperlim,nquad);
+%	n	-- number of dimensions to integrate
+%	nvol	-- value of the n-dimensional integral
+%	fun	-- fun(x) (function to be integrated) in this case treat
+%                  all the different values of x as different variables
+%                  as opposed to different instances of the same variable
+%	x	-- n length vector of coordinates
+%	lowerlim-- n length vector of lower limits of integration
+%	upperlim-- n length vector of upper limits of integration
+%	nquad	-- n length vector of number of gauss points 
+%		   in each integration
+
+n=length(lowerlim);
+level=n;
+x=zeros(n,1);
+
+nvol = innerfun(fun,lowerlim,upperlim,nquad,n,level,x,'grule');
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/grule.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,40 @@
+function [bp,wf]=grule(n)
+%
+% [bp,wf]=grule(n)
+%  This function computes Gauss base points and weight factors
+%  using the algorithm given by Davis and Rabinowitz in 'Methods
+%  of Numerical Integration', page 365, Academic Press, 1975.
+%
+bp=zeros(n,1); wf=bp; iter=2; m=fix((n+1)/2); e1=n*(n+1);
+mm=4*m-1; t=(pi/(4*n+2))*(3:4:mm); nn=(1-(1-1/n)/(8*n*n));
+xo=nn*cos(t);
+for j=1:iter
+   pkm1=1; pk=xo;
+   for k=2:n
+      t1=xo.*pk; pkp1=t1-pkm1-(t1-pkm1)/k+t1;
+      pkm1=pk; pk=pkp1;
+   endfor
+   den=1.-xo.*xo; d1=n*(pkm1-xo.*pk); dpn=d1./den;
+   d2pn=(2.*xo.*dpn-e1.*pk)./den;
+   d3pn=(4*xo.*d2pn+(2-e1).*dpn)./den;
+   d4pn=(6*xo.*d3pn+(6-e1).*d2pn)./den;
+   u=pk./dpn; v=d2pn./dpn;
+   h=-u.*(1+(.5*u).*(v+u.*(v.*v-u.*d3pn./(3*dpn))));
+   p=pk+h.*(dpn+(.5*h).*(d2pn+(h/3).*(d3pn+.25*h.*d4pn)));
+   dp=dpn+h.*(d2pn+(.5*h).*(d3pn+h.*d4pn/3));
+   h=h-p./dp; xo=xo+h;
+endfor
+bp=-xo-h;
+fx=d1-h.*e1.*(pk+(h/2).*(dpn+(h/3).*(d2pn+(h/4).*(d3pn+(.2*h).*d4pn))));
+wf=2*(1-bp.^2)./(fx.*fx);
+if ( (m+m) > n )
+	bp(m)=0; 
+endif
+if ( ! ((m+m) == n) )
+	m=m-1;
+endif
+jj=1:m; n1j=(n+1-jj); bp(n1j)=-bp(jj); wf(n1j)=wf(jj);
+bp = reshape(bp,length(bp),1);
+wf = reshape(wf,length(wf),1);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/grule2d.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,12 @@
+function [bpx,bpy,wfxy] = grule2d (nquadx,nquady)
+%
+%usage:  [bpx,bpy,wfxy] = grule2d (nquadx,nquady);
+%
+	[bpxv,wfxv]=grule(nquadx);
+	[bpyv,wfyv]=grule(nquady);
+%	[bpx,bpy]=meshgrid(bpxv,bpyv);
+%	[wfx,wfy]=meshgrid(wfxv,wfyv);
+	[bpx,bpy]=meshdom(bpxv,bpyv);
+	[wfx,wfy]=meshdom(wfxv,wfyv);
+	wfxy=wfx.*wfy;
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/grule2dgen.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,7 @@
+function [bpxv,wfxv,bpyv,wfyv] = grule2dgen (nquadx,nquady)
+%
+%usage:  [bpxv,wfxv,bpyv,wfyv] = grule2dgen (nquadx,nquady);
+%
+	[bpxv,wfxv]=grule(nquadx);
+	[bpyv,wfyv]=grule(nquady);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/innerfun.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,30 @@
+function int = innerfun(fun,lowerlim,upperlim,nquad,n,level,x,quadrule)
+%
+%usage:  int = innerfun(fun,lowerlim,upperlim,nquad,n,level,x,quadrule);
+%
+
+int = 0;
+[bp,wf]=feval(quadrule,nquad(level));
+
+xx=x;
+qx=(upperlim(level)-lowerlim(level))./2;
+px=(upperlim(level)+lowerlim(level))./2;
+xlevel=qx.*bp+px;
+
+nl=nquad(level);
+if ( level == 1 )
+  for i=1:nl
+    xx(level)=xlevel(i);
+    int = int + wf(i) .* feval(fun,xx);
+  endfor
+else
+  for i=1:nl
+    xx(level)=xlevel(i);
+    vint = innerfun(fun,lowerlim,upperlim,nquad,n,level-1,xx,quadrule);
+    int = int + wf(i) .* vint;
+  endfor
+endif
+
+int = int .* qx;
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/ncrule.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,40 @@
+function [bp,wf]=ncrule(m)
+%usage:  [bp,wf]=ncrule(m);
+%  This function returns the Newton-Coates base points and weight factors
+%  up to an 8 point Newton-Coates formula.
+%
+%  m -- number of Newton-Coates points (integrates an mth order
+%       polynomial exactly (or an (m+1)th order for even m))
+
+%  By Bryce Gardner, Purdue University, Spring 1993.
+
+if ( m == 1 )
+  bp=[-1;1];
+  wf=[1;1];
+elseif ( m == 2 )
+  bp=[-1;0;1];
+  wf=[1;4;1]/3;
+elseif ( m == 3 )
+  bp=[-1;-1/3;1/3;1];
+  wf=[1;3;3;1]/4;
+elseif ( m == 4 )
+  bp=[-1;-1/2;0;1/2;1];
+  wf=[7;32;12;32;7]/45;
+elseif ( m == 5 )
+  bp=[-1;-3/5;-1/5;1/5;3/5;1];
+  wf=[19;75;50;50;75;19]/144;
+elseif ( m == 6 )
+  bp=[-1;-2/3;-1/3;0;1/3;2/3;1];
+  wf=[41;216;27;272;27;216;41]/420;
+elseif ( m == 7 )
+  bp=[-1;-5/7;-3/7;-1/7;1/7;3/7;5/7;1];
+  wf=[751;3577;1323;2989;2989;1323;3577;751]/8640;
+else
+  if ( m != 8 )
+    disp('Dont know formula higher than n=8.  Returning as if n=8.');
+  endif
+  bp=[-1;-3/4;-1/2;-1/4;0;1/4;1/2;3/4;1];
+  wf=[989;5888;-928;10496;-4540;10496;-928;5888;989]/14175;
+endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/quad2dc.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,51 @@
+function int = quad2dc(fun,xlow,xhigh,ylow,yhigh,tol)
+%
+%usage:  int = quad2dc('Fun',xlow,xhigh,ylow,yhigh)
+%or
+%        int = quad2dc('Fun',xlow,xhigh,ylow,yhigh,tol)
+%
+%This function is similar to QUAD or QUAD8 for 2-dimensional integration,
+%but it uses a Gaussian-Chebyshev quadrature integration scheme.  
+% 	int     -- value of the integral
+%       Fun     -- Fun(x,y) (function to be integrated)
+%       xlow    -- lower x limit of integration  (should be -xhigh)
+%       xhigh   -- upper x limit of integration
+%       ylow    -- lower y limit of integration  (should be -yhigh)
+%       yhigh   -- upper y limit of integration
+%       tol     -- tolerance parameter (optional)
+%  The Gauss-Chebyshev Quadrature integrates an integral of the form
+%     yhigh                xhigh
+%  Int ((1/sqrt(1-y^2)) Int ((1/sqrt(1-x^2)) fun(x,y)) dx dy
+%    -yhigh               -xlow
+
+%This routine could be optimized.
+
+if ( exist('tol') != 1 )
+  tol=1e-3;
+elseif ( tol == [] )
+  tol=1e-3;
+endif
+
+n=length(xlow);
+nquad=2*ones(n,1);
+[bpx,bpy,wfxy] = crule2d(2,2);
+int_old=gquad2d(fun,xlow,xhigh,ylow,yhigh,bpx,bpy,wfxy);
+
+converge=0;
+for i=1:7
+  lim = 2^(i+1);
+  [bpx,bpy,wfxy] = crule2d(lim,lim);
+  int=gquad2d(fun,xlow,xhigh,ylow,yhigh,bpx,bpy,wfxy);
+
+  if ( abs(int_old-int) < abs(tol*int) )
+    converge=1;
+    break;
+  endif
+  int_old=int;
+endfor
+
+if ( converge == 0 )
+  disp('Integral did not converge--singularity likely')
+endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/quad2dcgen.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,53 @@
+function int = quad2dcgen(fun,xlow,xhigh,ylow,yhigh,tol)
+%
+%usage:  int = quad2dcgen('Fun','funxlow','funxhigh',ylow,yhigh)
+%or
+%        int = quad2dcgen('Fun','funxlow','funxhigh',ylow,yhigh,tol)
+%
+%This function is similar to QUAD or QUAD8 for 2-dimensional integration
+%over a general 2-dimensional region, but it uses a Gauss-Chebyshev 
+%quadrature integration scheme.  
+%The integral is like:
+%               yhigh                   funxhigh(y)
+%      int = Int  (1/sqrt(1-y.^2))   Int  (1/sqrt(1-x.^2))  Fun(x,y)  dx  dy
+%               ylow                    funxlow(y)
+%
+% 	int     -- value of the integral
+%       Fun     -- Fun(x,y) (function to be integrated)
+%       funxlow -- funxlow(y)
+%       funxhigh-- funxhigh(y)
+%       ylow    -- lower y limit of integration
+%       yhigh   -- upper y limit of integration
+%       tol     -- tolerance parameter (optional)
+
+%This routine could be optimized.
+
+if ( exist('tol') != 1 )
+  tol=1e-3;
+elseif ( tol==[] )
+  tol=1e-3;
+endif
+
+n=length(xlow);
+nquad=2*ones(n,1);
+[bpxv,wfxv,bpyv,wfyv]=crule2dgen(2,2);
+int_old=gquad2dgen(fun,xlow,xhigh,ylow,yhigh,bpxv,wfxv,bpyv,wfyv);
+
+converge=0;
+for i=1:7
+  lim = 2^(i+1);
+  [bpxv,wfxv,bpyv,wfyv]=crule2dgen(lim,lim);
+  int=gquad2dgen(fun,xlow,xhigh,ylow,yhigh,bpxv,wfxv,bpyv,wfyv);
+
+  if ( abs(int_old-int) < abs(tol*int) )
+    converge=1;
+    break;
+  endif
+  int_old=int;
+endfor
+
+if ( converge==0 )
+  disp('Integral did not converge--singularity likely')
+endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/quad2dg.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,51 @@
+function int = quad2dg(fun,xlow,xhigh,ylow,yhigh,tol)
+%
+%usage:  int = quad2dg('Fun',xlow,xhigh,ylow,yhigh)
+%or
+%        int = quad2dg('Fun',xlow,xhigh,ylow,yhigh,tol)
+%
+%This function is similar to QUAD or QUAD8 for 2-dimensional integration,
+%but it uses a Gaussian quadrature integration scheme.  
+% 	int     -- value of the integral
+%       Fun     -- Fun(x,y) (function to be integrated)
+%       xlow    -- lower x limit of integration
+%       xhigh   -- upper x limit of integration
+%       ylow    -- lower y limit of integration
+%       yhigh   -- upper y limit of integration
+%       tol     -- tolerance parameter (optional)
+%Note that if there are discontinuities the region of integration 
+%should be broken up into separate pieces.  And if there are singularities,
+%a more appropriate integration quadrature should be used 
+%(such as the Gauss-Chebyshev for a specific type of singularity).
+
+%This routine could be optimized.
+
+if ( exist('tol') != 1 )
+  tol=1e-3;
+elseif ( tol==[])
+  tol=1e-3;
+endif
+
+n=length(xlow);
+nquad=2*ones(n,1);
+[bpx,bpy,wfxy] = grule2d(2,2);
+int_old=gquad2d(fun,xlow,xhigh,ylow,yhigh,bpx,bpy,wfxy);
+
+converge=0;
+for i=1:7
+  lim = 2^(i+1);
+  [bpx,bpy,wfxy] = grule2d(lim,lim);
+  int=gquad2d(fun,xlow,xhigh,ylow,yhigh,bpx,bpy,wfxy);
+
+  if ( abs(int_old-int) < abs(tol*int) )
+    converge=1;
+    break;
+  endif
+  int_old=int;
+endfor
+
+if ( converge==0 )
+  disp('Integral did not converge--singularity likely')
+endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/quad2dggen.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,55 @@
+function int = quad2dggen(fun,xlow,xhigh,ylow,yhigh,tol)
+%
+%usage:  int = quad2dggen('Fun','funxlow','funxhigh',ylow,yhigh)
+%or
+%        int = quad2dggen('Fun','funxlow','funxhigh',ylow,yhigh,tol)
+%
+%This function is similar to QUAD or QUAD8 for 2-dimensional integration
+%over a general 2-dimensional region, but it uses a Gaussian quadrature 
+%integration scheme.  
+%The integral is like:
+%              yhigh   funxhigh(y)
+%      int = Int     Int       Fun(x,y)  dx  dy
+%              ylow    funxlow(y)
+%
+% 	int     -- value of the integral
+%       Fun     -- Fun(x,y) (function to be integrated)
+%       funxlow -- funxlow(y)
+%       funxhigh-- funxhigh(y)
+%       ylow    -- lower y limit of integration
+%       yhigh   -- upper y limit of integration
+%       tol     -- tolerance parameter (optional)
+%Note that if there are discontinuities the region of integration 
+%should be broken up into separate pieces.  And if there are singularities,
+%a more appropriate integration quadrature should be used 
+%(such as the Gauss-Chebyshev for a specific type of singularity).
+
+%This routine could be optimized.
+
+if ( exist('tol') != 1)
+  tol=1e-3;
+elseif ( tol==[] )
+  tol=1e-3;
+endif
+
+oldint=gquad2dgen(fun,xlow,xhigh,ylow,yhigh,2,2);
+
+converge=0;
+for i=1:7
+  lim = 2^(i+1);
+  int=gquad2dgen(fun,xlow,xhigh,ylow,yhigh,lim,lim);
+
+  diff  = oldint - int;
+  limit = abs(tol*int);
+  if ( abs(diff) < limit )
+    converge=1;
+    break;
+  endif
+  oldint=int;
+endfor
+
+if ( converge==0 )
+  disp('Integral did not converge--singularity likely')
+endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/quadc.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,97 @@
+function int = quadc(fun,xlow,xhigh,tol,trace,p1,p2,p3,p4,p5,p6,p7,p8,p9)
+%
+%usage:  int = quadc('Fun',xlow,xhigh)
+%or
+%        int = quadc('Fun',xlow,xhigh,tol)
+%or
+%        int = quadc('Fun',xlow,xhigh,tol,trace,p1,p2,....)
+%
+%This function works just like QUAD or QUAD8 but uses a Gaussian-Chebyshev
+%quadrature integration scheme.
+%
+%  The Gauss-Chebyshev Quadrature integrates an integral of the form
+%     xhigh
+%  Int ((1/sqrt(1-x^2)) fun(x)) dx
+%    -xhigh
+%This routine ignores xlow
+
+global cb2
+global cw2
+
+if ( exist('tol') != 1)
+  tol=1e-3;
+elseif ( tol==[] )
+  tol=1e-3;
+endif
+if ( exist('trace') != 1)
+  trace=0;
+elseif ( trace==[] )
+  trace=0;
+else
+  trace=1;
+endif
+
+xlow=-xhigh;
+
+%setup string to call the function
+exec_string=['y=',fun,'(x'];
+num_parameters=nargin-5;
+for i=1:num_parameters
+  exec_string=[exec_string,',p',int2str(i)];
+endfor
+exec_string=[exec_string,');'];
+
+%setup mapping parameters
+jacob=(xhigh-xlow)/2;
+
+%generate the first two sets of integration points and weights
+if ( exist('cb2') != 1 )
+  [cb2,cw2]=crule(2);
+endif
+
+x=(cb2+1)*jacob+xlow;
+eval(exec_string);
+int_old=sum(cw2.*y)*jacob;
+if ( trace==1 )
+  x_trace=x(:);
+  y_trace=y(:);
+endif
+
+converge=0;
+for i=1:7
+  gnum=int2str(2^(i+1));
+  vname = ['cb',gnum];
+  if ( exist(vname) == 0 )
+    estr =['[cb',gnum,',cw',gnum,']=crule(',gnum,');'];
+    eval(estr);
+    estr =['global cb' gnum,' cw',gnum,';'];
+    eval(estr);
+  endif
+  estr = ['x=(cb',gnum,'+1)*jacob+xlow;'];
+  eval(estr);
+  x=x(:);
+  eval(exec_string);
+  estr = ['int=sum(cw',gnum,'.*y)*jacob;'];
+  eval(estr);
+
+  if ( trace==1 )
+    x_trace=[x_trace;x(:)];
+    y_trace=[y_trace;y(:)];
+  endif
+
+  if ( abs(int_old-int) < abs(tol*int) )
+    converge=1;
+    break;
+  endif
+  int_old=int;
+endfor
+
+if ( converge==0 )
+  disp('Integral did not converge--singularity likely')
+endif
+
+if ( trace==1 )
+  plot(x_trace,y_trace,'+')
+endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/quadg.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,102 @@
+function int = quadg(fun,xlow,xhigh,tol,trace,p1,p2,p3,p4,p5,p6,p7,p8,p9)
+%
+%usage:  int = quadg('Fun',xlow,xhigh)
+%or
+%        int = quadg('Fun',xlow,xhigh,tol)
+%or
+%        int = quadg('Fun',xlow,xhigh,tol,trace,p1,p2,....)
+%
+%This function works just like QUAD or QUAD8 but uses a Gaussian quadrature
+%integration scheme.  Use this routine instead of QUAD or QUAD8:
+%	if higher accuracy is desired (this works best if the function, 
+%		'Fun', can be approximated by a power series) 
+%	or if many similar integrations are going to be done (I think less
+%		function evaluations will typically be done, but the 
+%		integration points and the weights must be calculated.
+%		These are saved between integrations so when QUADG
+%		is called again, the points and weights are all ready
+%		known.)
+%	or if the function evaluations are time consuming.
+%Note that if there are discontinuities the integral should be broken up into separate 
+%pieces.  And if there are singularities,  a more appropriate integration quadrature
+%should be used (such as the Gauss-Chebyshev).
+
+global b2
+global w2
+
+if ( exist('tol') != 1 )
+  tol=1e-3;
+elseif ( tol==[] )
+  tol=1e-3;
+endif
+if ( exist('trace') != 1 )
+  trace=0;
+elseif ( trace==[] )
+  trace=0;
+else
+  trace=1;
+endif
+
+%setup string to call the function
+exec_string=['y=',fun,'(x'];
+num_parameters=nargin-5;
+for i=1:num_parameters
+  exec_string=[exec_string,',p',int2str(i)];
+endfor
+exec_string=[exec_string,');'];
+
+%setup mapping parameters
+jacob=(xhigh-xlow)/2;
+
+%generate the first two sets of integration points and weights
+if ( exist('b2') != 1 )
+  [b2,w2]=grule(2);
+endif
+
+x=(b2+1)*jacob+xlow;
+eval(exec_string);
+int_old=sum(w2.*y)*jacob;
+if ( trace==1 )
+  x_trace=x(:);
+  y_trace=y(:);
+endif
+
+converge=0;
+for i=1:7
+  gnum=int2str(2^(i+1));
+  vname = ['b',gnum];
+  if ( exist(vname) == 0 )
+    estr = ['[b',gnum,',w',gnum,']=grule(',gnum,');'];
+    eval(estr);
+    estr = ['global b',gnum,' w',gnum,';'];
+    eval(estr);
+  endif
+  estr = ['x=(b',gnum,'+1)*jacob+xlow;'];
+  eval(estr);
+  eval(exec_string);
+  estr = ['int=sum(w',gnum,'.*y)*jacob;'];
+  eval(estr);
+
+  if ( trace==1 )
+    x_trace=[x_trace;x(:)];
+    y_trace=[y_trace;y(:)];
+  endif
+
+  if ( abs(int_old-int) < abs(tol*int) )
+    converge=1;
+    break;
+  endif
+  int_old=int;
+endfor
+
+if ( converge==0 )
+  disp('Integral did not converge--singularity likely')
+endif
+
+if ( trace==1 )
+  plot(x_trace,y_trace,'+')
+endif
+
+%gnum,i,length(x_trace)
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/quadndg.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,51 @@
+function int = quadndg(fun,xlow,xhigh,tol)
+%
+%usage:  int = quadndg('Fun',xlow,xhigh)
+%or
+%        int = quadndg('Fun',xlow,xhigh,tol)
+%
+%This function is similar to QUAD or QUAD8 for n-dimensional integration,
+%but it uses a Gaussian quadrature integration scheme.  
+% 	int     -- value of the integral
+%       Fun     -- Fun(x) (function to be integrated) in this case treat
+%                  all the different values of x as different variables
+%                  as opposed to different instances of the same variable
+%       x       -- n length vector of coordinates
+%       xlow    -- n length vector of lower limits of integration
+%       xhigh   -- n length vector of upper limits of integration
+%       tol     -- tolerance parameter (optional)
+%Note that if there are discontinuities the region of integration 
+%should be broken up into separate pieces.  And if there are singularities,
+%a more appropriate integration quadrature should be used 
+%(such as the Gauss-Chebyshev for a specific type of singularity).
+
+%This routine could be optimized.
+
+if ( exist('tol') != 1 )
+  tol=1e-3;
+elseif ( tol==[] )
+  tol=1e-3;
+endif
+
+n=length(xlow);
+nquad=2*ones(n,1);
+int_old=gquadnd(fun,xlow,xhigh,nquad);
+
+converge=0;  
+for i=1:7
+  nquad=(2^(i+1))*ones(n,1);
+  int=gquadnd(fun,xlow,xhigh,nquad);
+
+  if ( abs(int_old-int) < abs(tol*int) )
+    converge=1;
+    break;
+  endif
+  int_old=int;
+endfor
+
+if ( converge==0 )
+  disp('Integral did not converge--singularity likely')
+endif
+
+endfunction
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/test/run.log	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,90 @@
+
+%
+%   ===   COMPARISON OF RESULTS FROM QUAD, GQUAD, GQUAD6   ===
+
+> format long
+
+> f=quad('sin',0,pi,1.e-5), % Integrate a simple function
+
+f = 2.00000006453000
+
+> % Use a ten point Gauss formula
+> [b10,w10]=grule(10); f=gquad('sin',0,pi,1,b10,w10)
+
+f = 2.00000000000000
+
+> % Try a six point Gauss formula without having to generate
+> % base points and weight factors.
+> f=gquad6('sin',0,pi,1)
+
+f = 1.99999999947727, % Accuracy is quite good even with a
+                       % six point formula
+
+> % Next consider a function having infinite slope at x=0
+> f=3*quad('sqrt',0,1)
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+
+f =1.99998752859620
+
+> f=3*gquad('sqrt',0,1,1,b10,w10)
+
+f = 2.00026812880953, % The exact answer is 2
+
+> [b20,w20]=grule(20); f=3*gquad('sqrt',0,1,1,b20,w20)
+
+f = 2.00003589797091
+
+> [b50,w50]=grule(50);  f=3*gquad('sqrt',0,1,100,b50,w50)
+
+f = 2.00000000239878
+
+> f=quad('log',0,1) ,   % Try to integrate a singular function
+
+Warning: Log of zero
+
+f =  -
+
+> f= quad('log',eps,1) , % Stop just to the right of x=0
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+
+f=  -1.00421574636997
+
+> % How well can a composite Gauss ten point rule do
+> % using ten intervals?
+> f= gquad('log',0,1,10,b10,w10)
+
+f=  -0.99942637022162, % Exact answer is -1 so results are still
+                         % rather poor. Perhaps a higher order
+                         % will help.
+
+> [b100,w100]=grule(100); f=gquad('log',0,1,1,b100,w100)
+
+f= -0.99993748732245,  % This result is not much better
+
+> % Let us try taking a large number of function values
+> f=gquad('log',0,1,100,b100,w100)
+
+f=  -0.99999937487322
+
+> f=gquad6('log',0,1,1600), % Try the simpler six point formula
+
+f=  -0.99999061950636
+
+> %  The last several results show that we cannot just 'integrate
+> %  through' a singularity by using many function values.
+
+> format short
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/test/run2dtests.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,100 @@
+format long
+%
+% x^2+y^2 integrated from -1 to 1 in x and -1 to 1 in y = 8/3
+%
+[bx,by,w]=grule2d(2,2);
+v=gquad2d('gxy',-1,1,-1,1,bx,by,w)
+% or
+v=quad2dg('gxy',-1,1,-1,1)
+% or
+v=gquad2d('gxy',-1,1,-1,1,2,2)
+% or
+n= gquadnd('hx',[-1;-1],[1;1],[2;2])
+% or
+n=quadndg('hx',[-1;-1],[1;1])
+correct_ans=8/3
+%
+% x^2+y^2 integrated from 0 to 2 in x and 0 to 2 in y = 32/3
+%
+[bx,by,w]=grule2d(2,2);
+vol3=gquad2d('gxy',0,2,0,2,bx,by,w)
+% or
+v=quad2dg('gxy',0,2,0,2)
+% or
+v=gquad2d('gxy',0,2,0,2,2,2)
+% or
+n = gquadnd('hx',[0;0],[2;2],[2;2])
+% or
+n = quadndg('hx',[0;0],[2;2])
+correct_ans=32/3
+%
+% x^2+y^2 integrated from 0 to 3 in x and 0 to 3 in y = 54
+%
+[bx,by,w]=grule2d(2,2);
+v=gquad2d('gxy',0,3,0,3,bx,by,w)
+% or
+v=gquad2d('gxy',0,3,0,3,2,2)
+% or
+n = gquadnd('hx',[0;0],[3;3],[2;2])
+correct_ans=54
+%
+% x^2+y^2 integrated from 0 to 3 in x and 0 to 3 in y = 54
+% with the general area of intergration (functional limits in x)
+%
+[bx2,wx,by2,wy]=grule2dgen(2,2);
+v=gquad2dgen('gxy','gliml','glimh',0,3,bx2,wx,by2,wy)
+% or
+v=gquad2dgen('gxy','gliml','glimh',0,3,2,2)
+% or
+v=quad2dggen('gxy','gliml','glimh',0,3)
+correct_ans=54
+%
+% x^2+y^2 integrated from 0 to y in x and 0 to 2 in y = 16/3
+%
+v=gquad2dgen('gxy','gliml','glimh2',0,2,bx2,wx,by2,wy)
+% or
+v=gquad2dgen('gxy','gliml','glimh2',0,2,2,2)
+correct_ans=16/3
+%
+% 1 integrated from -sqrt(4-y^2) to sqrt(4-y^2) in x 
+% and -2 to 2 in y = 4*pi -- area of circle with radius 2 or (pi r^2)
+%
+v=gquad2dgen('gxy1','lcrcl','lcrcu',-2,2,bx2,wx,by2,wy)
+% or
+v=gquad2dgen('gxy1','lcrcl','lcrcu',-2,2,2,2)
+correct_ans=4*pi
+%         ---  same problem better quadratue (more points)
+% 1 integrated from -sqrt(4-y^2) to sqrt(4-y^2) in x 
+% and -2 to 2 in y = 4*pi -- area of circle with radius 2 or (pi r^2)
+%
+[bx3,wx3,by3,wy3]=grule2dgen(5,5);
+v=gquad2dgen('gxy1','lcrcl','lcrcu',-2,2,bx2,wx,by2,wy)
+% or
+v=gquad2dgen('gxy1','lcrcl','lcrcu',-2,2,5,5)
+correct_ans=4*pi
+%
+% sqrt(x^2+y^2) integrated from -sqrt(4-y^2) to sqrt(4-y^2) in x 
+% and -2 to 2 in y = 16*pi/3
+%
+% Need higher order quadrature
+[bx3,wx3,by3,wy3]=grule2dgen(10,10);
+v=gquad2dgen('gxy2','lcrcl','lcrcu',-2,2,bx3,wx3,by3,wy3)
+% or
+v=gquad2dgen('gxy2','lcrcl','lcrcu',-2,2,10,10)
+correct_ans=16*pi/3
+%
+% 1/sqrt(1-x^2) integrated from -1 to 1 in x  = pi
+%
+% Use Gauss-Chebyshev quadrature
+[bpc,wfc]=crule(2);
+a=gquad('gxy1',-1,1,1,bpc,wfc)
+%or
+a=quadc('gxy1',-1,1)
+correct_ans=pi
+%
+% x^2/sqrt(1-x^2) integrated from -1 to 1 in x  = pi/2
+%
+% Use Gauss-Chebyshev quadrature
+a=gquad('xsquar',-1,1,1,bpc,wfc)
+a=quadc('xsquar',-1,1)
+correct_ans=pi/2
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/test/test_ncrule.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,47 @@
+[b1,w1]=ncrule(1);
+[b2,w2]=ncrule(2);
+[b3,w3]=ncrule(3);
+[b4,w4]=ncrule(4);
+[b5,w5]=ncrule(5);
+[b6,w6]=ncrule(6);
+[b7,w7]=ncrule(7);
+[b8,w8]=ncrule(8);
+
+f=gquad('sin',0,pi,1,b1,w1), correct_ans=2
+f=gquad('sin',0,pi,1,b2,w2), correct_ans=2
+f=gquad('sin',0,pi,1,b3,w3), correct_ans=2
+f=gquad('sin',0,pi,1,b4,w4), correct_ans=2
+f=gquad('sin',0,pi,1,b5,w5), correct_ans=2
+f=gquad('sin',0,pi,1,b6,w6), correct_ans=2
+f=gquad('sin',0,pi,1,b7,w7), correct_ans=2
+f=gquad('sin',0,pi,1,b8,w8), correct_ans=2
+
+f=gquad('fxpow',0,2,1,b1,w1,1), correct_ans=2
+f=gquad('fxpow',0,2,1,b1,w1,2), correct_ans=8/3
+f=gquad('fxpow',0,2,1,b1,w1,3), correct_ans=4
+
+f=gquad('fxpow',0,2,1,b2,w2,2), correct_ans=8/3
+f=gquad('fxpow',0,2,1,b2,w2,3), correct_ans=4
+f=gquad('fxpow',0,2,1,b2,w2,4), correct_ans=32/5
+
+f=gquad('fxpow',0,2,1,b3,w3,3), correct_ans=4
+f=gquad('fxpow',0,2,1,b3,w3,4), correct_ans=32/5
+f=gquad('fxpow',0,2,1,b3,w3,5), correct_ans=32/3
+
+f=gquad('fxpow',0,2,1,b4,w4,4), correct_ans=32/5
+f=gquad('fxpow',0,2,1,b4,w4,5), correct_ans=32/3
+f=gquad('fxpow',0,2,1,b4,w4,6), correct_ans=128/7
+
+f=gquad('fxpow',0,2,1,b5,w5,5),correct_ans=32/3
+f=gquad('fxpow',0,2,1,b5,w5,6),correct_ans=128/7
+
+f=gquad('fxpow',0,2,1,b6,w6,6),correct_ans=128/7
+f=gquad('fxpow',0,2,1,b6,w6,7),correct_ans=32
+f=gquad('fxpow',0,2,1,b6,w6,8),correct_ans=512/9
+
+f=gquad('fxpow',0,2,1,b7,w7,7),correct_ans=32
+f=gquad('fxpow',0,2,1,b7,w7,8),correct_ans=512/9
+
+f=gquad('fxpow',0,2,1,b8,w8,8),correct_ans=512/9
+f=gquad('fxpow',0,2,1,b8,w8,9),correct_ans=512/5
+f=gquad('fxpow',0,2,1,b8,w8,10),correct_ans=2048/11
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/test/test_quadg.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,29 @@
+f=quad('sin',0,pi), correct_ans=2
+%f=quad8('sin',0,pi), correct_ans=2
+f=quadg('sin',0,pi), correct_ans=2
+f=quadg('sin',0,pi,1e-13), correct_ans=2  % with tighter tolerence
+
+f=quadg('fxpow',0,2,[],[],1), correct_ans=2
+f=quadg('fxpow',0,2,[],[],2), correct_ans=8/3
+
+%zero_count;
+%f=quad('fxpow',0,2,[],[],3), correct_ans=4
+%num_functs_in_quad =zero_count
+%f=quad8('fxpow',0,2,[],[],3), correct_ans=4
+%num_functs_in_quad8 =zero_count
+%f=quadg('fxpow',0,2,[],[],3), correct_ans=4
+%num_functs_in_quadq =zero_count
+%disp('quadg has lowest number of function calls')
+
+%f=quad('fxpow',0,2,[],[],4), correct_ans=32/5
+%f=quad8('fxpow',0,2,[],[],4), correct_ans=32/5
+f=quadg('fxpow',0,2,[],[],4), correct_ans=32/5
+
+f=quadg('fxpow',0,2,[],[],5), correct_ans=32/3
+f=quadg('fxpow',0,2,[],[],6), correct_ans=128/7
+f=quadg('fxpow',0,2,[],[],7),correct_ans=32
+f=quadg('fxpow',0,2,[],[],8),correct_ans=512/9
+f=quadg('fxpow',0,2,[],[],9),correct_ans=512/5
+
+%f=quad8('fxpow',0,2,[],[],10),correct_ans=2048/11
+f=quadg('fxpow',0,2,[],[],10),correct_ans=2048/11
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/test/tests2d.log	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,197 @@
+>> run2dtests
+
+vol1 =
+
+   2.66666666666667
+
+
+vol1a =
+
+   2.66666666666667
+
+
+vol2 =
+
+   2.66666666666667
+
+
+nvol1 =
+
+   2.66666666666667
+
+
+nvol1a =
+
+   2.66666666666667
+
+
+correct_ans =
+
+   2.66666666666667
+
+
+vol3 =
+
+  10.66666666666667
+
+
+vol3a =
+
+  10.66666666666667
+
+
+vol4 =
+
+  10.66666666666667
+
+
+nvol2 =
+
+  10.66666666666667
+
+
+nvol2a =
+
+  10.66666666666667
+
+
+correct_ans =
+
+  10.66666666666667
+
+
+vol5 =
+
+  54.00000000000002
+
+
+vol6 =
+
+  54.00000000000002
+
+
+correct_ans =
+
+    54
+
+
+vol7 =
+
+    54
+
+
+vol8 =
+
+    54
+
+
+vol8a =
+
+  54.00000000000001
+
+
+correct_ans =
+
+    54
+
+
+vol9 =
+
+   5.33333333333333
+
+
+vol10 =
+
+   5.33333333333333
+
+
+correct_ans =
+
+   5.33333333333333
+
+
+vol11 =
+
+  13.06394529484362
+
+
+vol12 =
+
+  13.06394529484362
+
+
+correct_ans =
+
+  12.56637061435917
+
+
+vol13 =
+
+  13.06394529484362
+
+
+vol14 =
+
+  12.60725067887481
+
+
+correct_ans =
+
+  12.56637061435917
+
+
+vol15 =
+
+  16.78129277383199
+
+
+vol16 =
+
+  16.78129277383199
+
+
+correct_ans =
+
+  16.75516081914556
+
+
+area1 =
+
+   3.14159265358979
+
+
+exec_string =
+
+y=gxy1(x);
+
+
+area1a =
+
+   3.14159265358979
+
+
+correct_ans =
+
+   3.14159265358979
+
+
+area2 =
+
+   1.57079632679490
+
+
+exec_string =
+
+y=xsquar(x);
+
+
+area2a =
+
+   1.57079632679490
+
+
+correct_ans =
+
+   1.57079632679490
+
+>> diary
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/test/testsnc.log	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,302 @@
+>> test_ncrule
+
+f =
+
+     1.923607162353882e-16
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+   2.09439510239320
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+   2.04052428476350
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+   1.99857073182384
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+   1.99920309391571
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+   2.00001781363666
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+   2.00001086554154
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+   1.99999983527472
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+     2
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+     4
+
+
+correct_ans =
+
+   2.66666666666667
+
+
+f =
+
+     8
+
+
+correct_ans =
+
+     4
+
+
+f =
+
+   2.66666666666667
+
+
+correct_ans =
+
+   2.66666666666667
+
+
+f =
+
+     4
+
+
+correct_ans =
+
+     4
+
+
+f =
+
+   6.66666666666667
+
+
+correct_ans =
+
+   6.40000000000000
+
+
+f =
+
+     4
+
+
+correct_ans =
+
+     4
+
+
+f =
+
+   6.51851851851852
+
+
+correct_ans =
+
+   6.40000000000000
+
+
+f =
+
+  11.25925925925926
+
+
+correct_ans =
+
+  10.66666666666667
+
+
+f =
+
+   6.40000000000000
+
+
+correct_ans =
+
+   6.40000000000000
+
+
+f =
+
+  10.66666666666667
+
+
+correct_ans =
+
+  10.66666666666667
+
+
+f =
+
+  18.33333333333334
+
+
+correct_ans =
+
+  18.28571428571428
+
+
+f =
+
+  10.66666666666667
+
+
+correct_ans =
+
+  10.66666666666667
+
+
+f =
+
+  18.31253333333334
+
+
+correct_ans =
+
+  18.28571428571428
+
+
+f =
+
+  18.28571428571428
+
+
+correct_ans =
+
+  18.28571428571428
+
+
+f =
+
+  31.99999999999999
+
+
+correct_ans =
+
+    32
+
+
+f =
+
+  56.90205761316870
+
+
+correct_ans =
+
+  56.88888888888889
+
+
+f =
+
+  32.00000000000001
+
+
+correct_ans =
+
+    32
+
+
+f =
+
+  56.89696413342515
+
+
+correct_ans =
+
+  56.88888888888889
+
+
+f =
+
+  56.88888888888889
+
+
+correct_ans =
+
+  56.88888888888889
+
+
+f =
+
+     1.024000000000000e+02
+
+
+correct_ans =
+
+     1.024000000000000e+02
+
+
+f =
+
+     1.861861979166667e+02
+
+
+correct_ans =
+
+     1.861818181818182e+02
+
+>> diary
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/test/testsqg.log	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,224 @@
+>> test_quadg
+
+f =
+
+   2.00001659104794
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+   1.99999999999989
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+   1.99999999999999
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+   2.00000000000000
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+     2
+
+
+correct_ans =
+
+     2
+
+
+f =
+
+   2.66666666666667
+
+
+correct_ans =
+
+   2.66666666666667
+
+
+f =
+
+     4
+
+
+correct_ans =
+
+     4
+
+
+num_functs_in_quad =
+
+    20
+
+
+f =
+
+     4
+
+
+correct_ans =
+
+     4
+
+
+num_functs_in_quad8 =
+
+    33
+
+
+f =
+
+     4
+
+
+correct_ans =
+
+     4
+
+
+num_functs_in_quadq =
+
+     6
+
+quadg has lowest number of function calls
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+Recursion level limit reached in quad.  Singularity likely.
+
+f =
+
+   6.40003310943535
+
+
+correct_ans =
+
+   6.40000000000000
+
+
+f =
+
+   6.40000000000000
+
+
+correct_ans =
+
+   6.40000000000000
+
+
+f =
+
+   6.39999999999999
+
+
+correct_ans =
+
+   6.40000000000000
+
+
+f =
+
+  10.66666666666666
+
+
+correct_ans =
+
+  10.66666666666667
+
+
+f =
+
+  18.28571428571427
+
+
+correct_ans =
+
+  18.28571428571428
+
+
+f =
+
+  31.99999999999996
+
+
+correct_ans =
+
+    32
+
+
+f =
+
+  56.88888888888881
+
+
+correct_ans =
+
+  56.88888888888889
+
+
+f =
+
+     1.023999999999999e+02
+
+
+correct_ans =
+
+     1.024000000000000e+02
+
+
+f =
+
+     1.861818181859950e+02
+
+
+correct_ans =
+
+     1.861818181818182e+02
+
+
+f =
+
+     1.861818181818181e+02
+
+
+correct_ans =
+
+     1.861818181818182e+02
+
+>> diary
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/testfun/fxpow.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,7 @@
+function z=fxpow(x,y)
+%
+%usage:  z=fxpow(x,y)
+%
+	count;
+	z=x.^y;
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/testfun/glimh.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,6 @@
+function xh=glimh(y)
+%
+%usage:  xh=glimh(y)
+%
+	xh=3;
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/testfun/glimh2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,6 @@
+function xh=glimh2(y)
+%
+%usage:  xh=glimh2(y)
+%
+	xh=y;
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/testfun/gliml.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,6 @@
+function xl=gliml(y)
+%
+%usage:  xl=gliml(y)
+%
+	xl=0;
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/testfun/gxy.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,8 @@
+function z=gxy(x,y)
+%
+%usage:  z=gxy(x,y);
+%
+% z=sqrt(x.^2+y.^2);
+
+	z=x.^2+y.^2;
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/testfun/gxy1.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,7 @@
+function z=gxy1(x,y)
+%
+%usage:  z=gxy1(x,y);
+%
+	z=ones(size(x));
+	% z=1+x*0+y*0;
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/testfun/gxy2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,7 @@
+function z=gxy2(x,y)
+%
+%usage:  z=gxy2(x,y);
+%
+	z=sqrt(x.^2+y.^2);
+	%z=x.^2+y.^2;
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/testfun/hx.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,6 @@
+function z=hx(x)
+%
+%usage:  z=hx(x);
+%
+	z=sum(x.^2);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/testfun/lcrcl.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,6 @@
+function z=lcrcl(y)
+%
+%usage:  z=lcrcl(y);
+%
+	z=-sqrt(2.^2-y.^2);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/testfun/lcrcu.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,6 @@
+function z=lcrcu(y)
+%
+%usage:  z=lcrcu(y);
+%
+	z=sqrt(2.^2-y.^2);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/testfun/x25.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,7 @@
+function y=x25(x)
+%
+%usage:  y=x25(x);
+%
+	y=x.^25;
+	count
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/testfun/xcubed.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,6 @@
+function y=xcubed(x)
+%
+%usage:  y=xcubed(x)
+%
+	y=x.^3;
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/testfun/xsquar.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,6 @@
+function y=xsquar(x)
+%
+% x^2
+%
+	y=x.*x;
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/integration/zero_count.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,13 @@
+function num_fxpow=zero_count
+%
+%usage:  num_fxpow=zero_count
+%
+global NUM_COUNT
+
+if ( exist('NUM_COUNT') == 1 )
+  num_fxpow=NUM_COUNT;
+endif
+
+NUM_COUNT=0;
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/linear-algebra/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,12 @@
+sinclude ../../Makeconf
+ifndef MKOCTFILE
+MKOCTFILE=mkoctfile
+endif
+
+all: chol.oct
+
+chol.oct: chol.cc ov-re-tri.cc
+	$(MKOCTFILE) -v chol.cc ov-re-tri.cc -o chol.oct
+
+clean:
+	$(RM) *.oct *.o *~ octave-core core
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/linear-algebra/README	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,19 @@
+From: "Cai Jianming" <caijianming@yahoo.co.uk>
+To: <octave-sources@bevo.che.wisc.edu>
+Subject: Upper Triangle/Lower Triangle matrix by CHOL
+Date: Tue, 16 Jan 2001 07:15:35 +0800
+
+Hi,
+   The attached file will allow CHOL to return a upper triangle/lower =
+triangle matrix, so that ldiv can be done more efficiently. Any other =
+operations will get passed to octave_matrix. I.e. typical code could be:
+  c = chol(a)
+  x = c\ (c' \ b)
+
+  To compile:
+    mkoctfile *.cc -o chol.oct
+  and copy chol.oct into your libexec/octave/site/oct directory.
+
+Regards,
+Jianming
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/linear-algebra/chol.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,131 @@
+/*
+
+Copyright (C) 1996, 1997 John W. Eaton
+
+This file is part of Octave.
+
+Octave is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+Octave is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with Octave; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+#include "ov-re-tri.h"
+
+#include "CmplxCHOL.h"
+#include "dbleCHOL.h"
+
+#include "defun-dld.h"
+#include "error.h"
+#include "gripes.h"
+#include "oct-obj.h"
+#include "utils.h"
+
+extern void  install_tri_ops(void);
+
+DEFUN_DLD (chol, args, nargout,
+  "-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {} chol (@var{a})\n\
+@cindex Cholesky factorization\n\
+Compute the Cholesky factor, @var{r}, of the symmetric positive definite\n\
+matrix @var{a}, where\n\
+@iftex\n\
+@tex\n\
+$ R^T R = A $.\n\
+@end tex\n\
+@end iftex\n\
+@ifinfo\n\
+\n\
+@example\n\
+r' * r = a.\n\
+@end example\n\
+@end ifinfo\n\
+@end deftypefn")
+{
+  octave_value_list retval;
+
+  int nargin = args.length ();
+
+  if (nargin != 1 || nargout > 2)
+    {
+      print_usage ("chol");
+      return retval;
+    }
+
+  octave_value arg = args(0);
+    
+  int nr = arg.rows ();
+  int nc = arg.columns ();
+
+  int arg_is_empty = empty_arg ("chol", nr, nc);
+
+  if (arg_is_empty < 0)
+    return retval;
+  if (arg_is_empty > 0)
+    return Matrix ();
+
+  if (arg.is_real_type ())
+    {
+      Matrix m = arg.matrix_value ();
+
+      if (! error_state)
+	{
+	  int info;
+	  CHOL fact (m, info);
+	  if (nargout == 2 || info == 0)
+	    {
+	      static bool type_loaded = false;
+	      if (! type_loaded) {       
+		octave_tri::register_type ();
+		install_tri_ops();
+	      }
+
+	      retval(1) = static_cast<double> (info);
+	      retval(0) = new octave_tri(fact.chol_matrix (), octave_tri::Upper);
+	      retval(0).maybe_mutate();
+	    }
+	  else
+	    error ("chol: matrix not positive definite");
+	}
+    }
+  else if (arg.is_complex_type ())
+    {
+      ComplexMatrix m = arg.complex_matrix_value ();
+
+      if (! error_state)
+	{
+	  int info;
+	  ComplexCHOL fact (m, info);
+	  if (nargout == 2 || info == 0)
+	    {
+	      retval(1) = static_cast<double> (info);
+	      retval(0) = fact.chol_matrix ();
+	    }
+	  else
+	    error ("chol: matrix not positive definite");
+	}
+    }
+  else
+    {
+      gripe_wrong_type_arg ("chol", arg);
+    }
+
+  return retval;
+}
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; End: ***
+*/
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/linear-algebra/ov-re-tri.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,160 @@
+#include "ov-re-tri.h"
+
+
+octave_tri::octave_tri(const Matrix &m, tri_type t):
+  octave_matrix(m), tri(t)
+{
+}
+
+octave_tri::octave_tri (const octave_tri& T):
+  octave_matrix(T), tri(T.tri)
+{
+}
+
+octave_tri::~octave_tri(void)
+{
+}
+
+octave_value *octave_tri::clone(void)
+{
+  return new octave_tri(*this);
+}
+
+static octave_value *
+tri_numeric_conversion_function(const octave_value& a)
+{
+  CAST_CONV_ARG (const octave_tri &);
+  
+  return new octave_matrix (v.matrix_value());
+}
+
+type_conv_fcn
+octave_tri::numeric_conversion_function (void) const
+{
+  return tri_numeric_conversion_function;
+}
+
+octave_value * octave_tri::try_narrowing_conversion(void)
+{
+  octave_value *retval = octave_matrix::try_narrowing_conversion();
+
+  if ( retval==0){
+    int nr = matrix.rows ();
+    int nc = matrix.cols ();
+ 
+    bool istri=true;
+    
+    if(tri==Lower){
+      for(int r=0; r<nr; r++)
+	for(int c=r+1; c<nc; c++)
+	  if(matrix(r,c)!=0.0){
+	    istri=false;
+	    break;
+	  }
+    }
+    else if(tri==Upper){
+      for(int c=0; c<nc; c++)
+	for(int r=c+1; r<nr; r++)
+	  if(matrix(r,c)!=0.0){
+	    istri=false;
+	    break;
+	  }
+    }
+    else
+      error("Not a triangular Matrix");
+
+    if(!istri)
+      retval = new octave_matrix (matrix);
+  }
+
+  return retval;
+}
+
+void octave_tri::assign (const octave_value_list& idx, const Matrix& rhs)
+{
+  octave_matrix::assign(idx, rhs);
+  return;
+}
+
+octave_value octave_tri::transpose(void) const
+{
+  return new octave_tri(this->matrix_value().transpose(), tri_type(! bool(tri)));
+}
+
+void octave_tri::print (ostream& os, bool pr_as_read_syntax = false) const
+{
+  octave_matrix::print(os, pr_as_read_syntax);
+  os << (tri == Upper ? "Upper" : "Lower") << " Triangular";
+  newline(os);
+}
+
+DEFUNOP (transpose, tri)
+{
+  CAST_UNOP_ARG (const octave_tri&);
+  return v.transpose ();
+}
+
+DEFBINOP(ldiv, tri, matrix)
+{
+  CAST_BINOP_ARGS (const octave_tri&, const octave_matrix&);
+  const Matrix X = v1.matrix_value();
+  const Matrix Y = v2.matrix_value();
+
+  if(X.cols()!=Y.rows()){
+    error("ldiv -- X.cols!=Y.rows");
+    return octave_value();
+  }
+  
+  if(X.cols()!=X.rows()){
+    error("ldiv -- X not square matrix");
+    return octave_value();
+  }
+
+  Matrix A(X.rows(), Y.cols());
+
+  if (v1.tri_value() == octave_tri::Lower){
+    for(int c=0; c< A.cols(); c++)
+      for(int r=0; r<A.rows(); r++){
+	double sum=Y(r,c);
+	for(int i=0; i<r; i++)
+	  sum=sum-X(r,i)*A(i,c);
+	A(r,c)=sum/X(r,r);
+      }
+  }
+  else if (v1.tri_value() == octave_tri::Upper){
+    for(int c=0; c< A.cols(); c++)
+      for(int r=A.rows()-1; r>=0;  r--){
+	double sum=Y(r,c);
+	for(int i=r+1; i<A.rows(); i++)
+	  sum=sum-X(r,i)*A(i,c);
+	A(r,c)=sum/X(r,r);
+      }
+  }
+  else{
+    error("Not a triangular matrix");
+  }
+
+  return A;
+}
+
+DEFASSIGNOP (assign, tri, matrix)
+{
+  CAST_BINOP_ARGS (octave_tri &, octave_matrix&);
+  v1.assign(idx, v2.matrix_value());
+  return octave_value();
+}
+
+void install_tri_ops(void)
+{
+  INSTALL_UNOP (op_transpose, octave_tri, transpose);
+  INSTALL_UNOP (op_hermitian, octave_tri, transpose);
+
+  INSTALL_BINOP (op_ldiv, octave_tri, octave_matrix, ldiv);
+  INSTALL_ASSIGNOP (op_asn_eq, octave_tri, octave_matrix, assign);
+}
+
+
+DEFINE_OCTAVE_ALLOCATOR (octave_tri);
+
+DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_tri, "tri");
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/linear-algebra/ov-re-tri.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,55 @@
+#include <octave/config.h>
+#include <octave/lo-utils.h>
+#include <octave/mx-base.h>
+#include <octave/str-vec.h>
+#include <octave/defun-dld.h>
+#include <octave/error.h>
+#include <octave/gripes.h>
+#include <octave/lo-mappers.h>
+#include <octave/oct-obj.h>
+#include <octave/ops.h>
+#include <octave/ov-base.h>
+#include <octave/ov-typeinfo.h>
+#include <octave/ov.h>
+#include <octave/ov-scalar.h>
+#include <octave/ov-re-mat.h>
+#include <octave/pager.h>
+#include <octave/pr-output.h>
+#include <octave/symtab.h>
+#include <octave/variables.h>
+
+class Octave_map;
+class octave_value_list;
+
+class tree_walker;
+
+// Define the octave_sparse Class
+class
+octave_tri : public octave_matrix
+{
+public:
+  enum tri_type{
+    Upper=0,
+    Lower=1
+  };
+
+   octave_tri(const Matrix &m, tri_type t);
+   ~octave_tri(void);
+   octave_tri (const octave_tri& D);
+
+   octave_value *clone (void) ;
+
+   type_conv_fcn numeric_conversion_function (void) const;
+   octave_value * try_narrowing_conversion(void);
+
+   inline tri_type tri_value(void) const { return tri;};
+   void assign (const octave_value_list& idx, const Matrix& rhs);
+
+   octave_value transpose (void) const ;
+   void print (ostream& os, bool pr_as_read_syntax = false) const ;
+private:
+   tri_type tri;
+   DECLARE_OCTAVE_ALLOCATOR
+   DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA
+}; // class octave_diag
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/mex/INSTALL	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,14 @@
+To use mex, first compile the mex.cc support library.
+
+a.) If you are using the octaveSF package, then you won't
+    need to do anything---it was compiled and installed when you
+    compiled and installed octaveSF and you can skip the remaining
+    instructions.
+
+b.) If you are using mex with octave 2.0.x, edit the Makefile and
+    replace 'mkoctfile' with 'mkoctfile -DHAVE_OCTAVE_20'.
+
+c.) Type make to build mex.o and mex
+
+d.) Move mex to your executable path (e.g., ~/bin) and mex.1 to your
+    man path and you are done
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/mex/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,55 @@
+sinclude ../../Makeconf
+ifndef MKOCTFILE
+MKOCTFILE = mkoctfile
+opath = $(shell pwd)
+bindir = /usr/local/bin
+mandir = /usr/local/man
+INSTALL = /usr/bin/install -c
+INSTALL_PROGRAM = ${INSTALL}
+INSTALL_DATA = ${INSTALL} -m 644
+LEAVEHERE=1
+endif
+
+man1dir = $(mandir)/man1
+
+all: mex.o mex
+
+mex.o: mex.cc mex.h matrix.h
+	$(MKOCTFILE) -v mex.cc
+	$(RM) mex.oct
+
+mex: mex.in
+	cat mex.in | sed -e "s:@MKOCTFILE@:$(MKOCTFILE):" -e "s:@opath@:$(opath):g" > mex
+	chmod a+x mex
+
+install:
+ifdef LEAVEHERE
+	@echo "Leaving mex.o, mex.h and matrix.h in place --- do not remove!"
+else
+	@if ! test -e $(OPATH) ; then \
+	  $(INSTALL) -d $(OPATH) ; \
+	fi
+	@if test -d $(OPATH) ; then \
+	  $(INSTALL_DATA) mex.o $(OPATH)/mex.o ; \
+	  $(INSTALL_DATA) mex.h $(OPATH)/mex.h ; \
+	  $(INSTALL_DATA) matrix.h $(OPATH)/matrix.h ; \
+	fi
+endif
+	@if ! test -e $(man1dir) ; then \
+	  $(INSTALL) -d $(man1dir) ; \
+	fi
+	@if test -d $(man1dir) ; then \
+	  $(RM) $(man1dir)/mex.1; \
+	  echo "installing mex.1 in $(man1dir)" ; \
+	  $(INSTALL_DATA) mex.1 $(man1dir)/mex.1 ; \
+	fi
+	@if ! test -e $(bindir) ; then \
+	  $(INSTALL) -d $(bindir) ; \
+	fi
+	@if test -d $(bindir) ; then \
+	  $(RM) $(bindir)/mex ; \
+	  $(INSTALL_PROGRAM) mex $(bindir)/mex ; \
+	fi
+
+clean:
+	$(RM) mex mex_* *.o *.oct core octave-core *~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/mex/README	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,336 @@
+
+This is a partial implementation of the Matlab MEX interface for use
+in Octave.  It is only intended to support existing MEX functions, not
+write new ones.  That's because every piece of data passed to and
+returned from mexFunction and mexCallMATLAB must be copied (but see
+TODO).
+
+See INSTALL for instructions on how to build the mex support library.
+
+Then for each mex-file blah.f or blah.c that you have, do
+    mex name.c othersrc.c otherobj.o -L/other/lib/path -lotherlib
+Put name.oct somewhere on your Octave LOADPATH and you are done.
+
+The shell script mex creates an octave DLD file mex_name.cc which
+handles the interface between Octave and the symbol mexFunction.
+
+If you would normally use -V4 as one of your mex options, use -DV4 
+instead.  This will select the Matlab version 4 interface rather than
+the Matlab version 5 interface.
+
+There are two test programs:
+    myfeval is a poor implementation of feval which exercises
+	the mexCallMATLAB function
+    myset tests mexGetArray and mexPutArray; call it with a
+	variable name and a value, and it will show the current
+	value for the variable in the caller and the global space,
+	and set the new value in the caller space.
+
+
+The following functions are implemented:
+
+Types
+*   mxComplexity (enumerated type: mxREAL, mxCOMPLEX)
+*   mxArray
+
+User supplied information
+*   mexFunctionName
+*   mexFunction
+
+Interpreter services
+*   mexCallMATLAB 
+*   mexEvalString 
+*   mexSetTrapFlag 
+*   mexErrMsgTxt 
+*   mexWarnMsgTxt 
+*   mexPrintf 
+
+Memory management
+*   mxMalloc 
+*   mxCalloc 
+*   mxRealloc 
+*   mxFree 
+*   mexMakeMemoryPersistent 
+
+Array creation/destruction
+*   mxCreateDoubleMatrix 
+*   mxCreateFull
+*   mxDestroyArray 
+*   mxFreeMatrix
+*   mexMakeArrayPersistent 
+
+Array type
+*   mxIsFull
+*   mxIsEmpty 
+*   mxIsNumeric 
+*   mxIsComplex 
+*   mxIsSparse 
+
+Array data
+*   mxGetM 
+*   mxGetN 
+*   mxGetPi 
+*   mxGetPr 
+*   mxSetM 
+*   mxSetN 
+*   mxSetPi 
+*   mxSetPr 
+*   mxGetScalar
+
+IEEE floating point support
+*   mxGetEps 
+*   mxGetInf 
+*   mxGetNaN 
+*   mxIsFinite 
+*   mxIsInf 
+*   mxIsNaN 
+*   mexGetEps
+*   mexGetInf
+*   mexGetNaN
+*   mexIsFinite
+*   mexIsInf
+*   mexIsNaN
+
+String support
+*   mxIsChar 
+*   mxIsString
+*   mxCreateString 
+*   mxGetString 
+*   mxArrayToString 
+*   mxCreateCharMatrixFromStrings 
+
+
+Symbol table manipulation
+x   mexPutArray 
+*   mexGetArray 
+*   mexGetArrayPtr 
+*   mexPutMatrix
+*   mexGetMatrix
+*   mexGetMatrixPtr
+*   mexGetGlobal
+*   mxGetName 
+*   mxSetName 
+
+The following functions are not implemented:
+
+Types
+x   mxClassID 
+x   mxChar 
+
+Interpreter services
+x   mexAddFlops 
+x   mexAtExit 
+x   mexUnlock 
+x   mexIsLocked 
+x   mexLock 
+
+Debugging
+x   mxAssert 
+x   mxAssertS 
+
+Plot controls
+x   mexGet 
+x   mexSet 
+
+Data manipulation
+x   mxSetAllocFcns 
+x   mxDuplicateArray 
+x   mxIsFromGlobalWS 
+x   mexIsGlobal 
+x   mexPutFull
+x   mexGetFull
+
+Generic data handling
+x   mxGetClassID 
+x   mxGetNumberOfElements 
+x   mxGetElementSize 
+x   mxGetData 
+x   mxSetData 
+x   mxGetImagData 
+x   mxSetImagData 
+
+Precision support
+x   mxCreateNumericMatrix 
+x   mxIsSingle 
+x   mxIsDouble 
+x   mxIsInt8 
+x   mxIsInt16 
+x   mxIsInt32 
+x   mxIsUint8 
+x   mxIsUint16 
+x   mxIsUint32 
+
+Boolean support
+x   mxIsLogical 
+x   mxSetLogical 
+x   mxClearLogical 
+
+n-D arrays
+x   mxCreateNumericArray 
+x   mxCreateCharArray 
+x   mxCreateStructArray 
+x   mxCreateCellArray 
+x   mxCalcSingleSubscript
+x   mxSetDimensions 
+x   mxGetDimensions 
+x   mxGetNumberOfDimensions 
+
+Cell array support
+x   mxIsCell 
+x   mxCreateCellMatrix 
+x   mxSetCell 
+x   mxGetCell 
+
+Struct support
+x   mxIsStruct 
+x   mxCreateStructMatrix 
+x   mxGetNumberOfFields 
+x   mxGetField 
+x   mxGetFieldByNumber 
+x   mxGetFieldNameByNumber 
+x   mxGetFieldNumber 
+x   mxSetField 
+x   mxSetFieldByNumber 
+
+Sparse support
+x   mxCreateSparse 
+x   mxGetNzmax 
+x   mxSetNzmax 
+x   mxGetIr 
+x   mxGetJc 
+x   mxSetIr 
+x   mxSetJc 
+
+Object support
+x   mxIsClass 
+x   mxGetClassName 
+x   mxSetClassName 
+
+MAT file interface
+x   matClose 
+x   matDeleteArray 
+x   matGetArray 
+x   matGetArrayHeader 
+x   matGetDir 
+x   matGetFp 
+x   matGetNextArray 
+x   matGetNextArrayHeader 
+x   matOpen 
+x   matPutArray 
+x   matPutArrayAsGlobal 
+
+MAT file interface (V4 functions)
+x   matDeleteMatrix 
+x   matGetFull
+x   matGetMatrix
+x   matGetNextMatrix
+x   matGetString
+x   matPutFull
+x   matPutMatrix
+x   matPutString
+
+DDE Interface
+x   ddeadv 
+x   ddeexec 
+x   ddeinit 
+x   ddepoke 
+x   ddereq 
+x   determ 
+x   ddeunadv 
+
+The following compute engine routines are implemented by Jesse Bennet in
+liboct-0.1 <http://www.octave.org/octave/mailing-lists/help-octave/1999/549>
+
+*   engClose 
+*   engEvalString 
+*   engOpen 
+*   engOutputBuffer 
+*   engGetFull
+*   engPutFull
+
+The following compute engine routines are missing
+
+x   engOpenSingleUse 
+x   engGetArray 
+x   engPutArray 
+x   engGetMatrix
+x   engPutMatrix
+x   engSetEvalCallback
+x   engSetEvalTimeout
+x   engWinInit
+
+The following FORTRAN routines are implemented
+
+*   mexFunction
+*   mexPrintf
+*   mexErrMsgTxt
+*   mexCallMATLAB
+
+*   mexGetEps
+*   mexGetInf
+*   mexGetNaN
+*   mexIsFinite
+*   mexIsInf
+*   mexIsNaN
+
+*   mxMalloc
+*   mxCalloc
+*   mxFree
+
+*   mxCreateFull
+*   mxFreeMatrix
+
+*   mxGetM
+*   mxGetN
+*   mxGetPr
+*   mxGetPi
+
+*   mxSetM
+*   mxSetN
+*   mxSetPr
+*   mxSetPi
+
+*   mxIsComplex
+*   mxIsDouble
+*   mxIsNumeric
+*   mxIsFull
+*   mxIsSparse
+
+*   mxGetString
+*   mxIsString
+
+*   mxCopyComplex16ToPtr
+*   mxCopyPtrToComplex16
+*   mxCopyReal8ToPtr
+*   mxCopyPtrToReal8
+
+The following fortran routines are not implemented
+
+x   mexSetTrapFlag
+x   mexEvalString
+
+x   mexGetGlobal
+x   mexGetFull
+x   mexPutFull
+x   mexGetMatrix
+x   mexPutMatrix
+x   mexGetMatrixPtr
+
+x   mxCopyPtrToCharacter
+x   mxCopyCharacterToPtr
+x   mxCopyPtrToInteger4
+x   mxCopyInteger4ToPtr
+
+x   mxCreateSparse
+x   mxCreateString
+x   mxFreeMatrix
+x   mxGetName
+
+x   mxGetNzmax
+x   mxGetIr
+x   mxGetJc
+x   mxSetNzmax
+x   mxSetIr
+x   mxSetJc
+
+x   mxGetScalar
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/mex/TODO	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,84 @@
+
+* mex.oct is a shared library.  We should rename it libmex.so and link to
+it instead of including a separate copy of mex.o in each oct file.  Only
+thing is, how do we install it beside version of liboctave we are using,
+and how do we make the loader find the correct version if we have multiple
+versions of octave installed.
+
+* More complete testing
+* Better error handling in mex
+* Use tempory files for Octave glue?
+* mex should translate -V4 to -DV4
+* mex should remove mex_*.cc when done
+* clean up warnings in myset.c
+
+* If you want to support Octave and Matlab with the same code base
+without penalizing either, you will need to write a high level layer
+which supports both.  
+
+Particularly, you must prohibit direct modification of the fields of 
+the mxArray type, which means eliminating mxSet{Pi,Pr,N,M} from your
+matlab code.  You can get the same functionality by adding the routines:
+	mxResize (to add/remove rows and columns), 
+	mxReshape (to change the shape without changing the data),
+	mxMakeComplex (to change a double matrix into a complex matrix),
+	mxMakeReal (to change a complex matrix into a double matrix),
+	mxAssign (to replace an array with a new one)
+These are all easy enough to define in Matlab. The octave routines
+will represent the data using either ComplexMatrix or Matrix so that
+an octave value can easily be constructed when it is needed.  The
+matlab side can continue to use mxArray.
+
+The function mxGetPr is problematic for values passed from octave. 
+Because you cannot get a reference to the Matrix in the ocave_value,
+you must assign it.  Since mxGetPr returns a pointer to the contents
+of the array, you must use tmp.fortran_vec().  Since tmp is assigned,
+and arrays are copy-on-modify, the simple act of mxGetPr will trigger
+a copy.  A solution is to trick the compiler: return the const pointer
+given by tmp.data(), but declare the function header included in the
+mex files as returning a nonconst pointer.
+
+You will need to hide the difference in storage between complex
+arrays, which matlab defines as two matrices (one for real and one for
+imaginary), and Octave defines as one matrix (with real and imaginary
+values alternating).  This is easy to handle by returning Pi as Pr+1,
+and multiplying the current matlab index by 2. In octave this would be:
+  #define mxStride 2
+  double *mxGetPr(mxArray *m) { return m->data(); }
+  double *mxGetPzr(mxArray *m) { return (double *)(cm->data()); }
+  double *mxGetPzi(mxArray *m) { return (double *)(cm->data()) + 1; }
+and for matlab
+  #define mxStride 1
+  #define mxGetPzr mxGetPr
+  #define mxGetPzi mxGetPi
+Then you could implement abs(z) as something like:
+  int M, N;
+  double *pr, *pi, *pd;
+  M = mxGetM(prhs[0]);
+  N = mxGetN(prhs[0]);
+  pr = mxGetPzr(prhs[0]);
+  pi = mxGetPzi(prhs[0]);
+  plhs[0] = mxCreateDoubleMatrix(M,N);
+  pd = mxGetPr(plhs[0]);
+  for (j=0; j < M*N; j++)
+    pd[j] = sqrt(pr[j*mxStride]*pr[j*mxStride]+pi[j*mxStride]*pi[j*mxStrde]);
+
+If you have any functions which take real and imaginary parts as
+separate arrays, these should be rewritten to accept an mxArray
+applying the solution above, otherwise you will have to do something
+ugly like:
+
+#ifdef HAVE_OCTAVE
+  double *pr, *pi, *newr, *newi;
+  pr = mxGetPzr(m);
+  pi = mxGetPzi(m);
+  newr = mxMalloc(M*N*sizeof(double));
+  newi = mxMalloc(M*N*sizeof(double));
+  for (j=0; j < M*N*mxStride; j+=mxStride) newr[j]=pr[j], newi[j]=pi[j];
+  complex_fun(newr,newi);
+  for (j=0; j < M*N*mxStride; j+=mxStride) pr[j]=newr[j], pi[j]=newi[j];
+  mxFree(newr);
+  mxFree(newi);
+#else
+   complex_fun(mxGetPr(m),mxGetPi(m));
+#endif
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/mex/matrix.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,1 @@
+#include "mex.h"
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/mex/mex.1	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,39 @@
+./"  This is the Unix manual page for mex, written in nroff, the standard
+./"  manual formatter for Unix systems.  To format it, type
+./"
+./"  nroff -man mex.man
+./"
+./"  This will print a formatted copy to standard output.  If you want
+./"  to ensure that the output is plain ASCII, free of any control
+./"  characters that nroff uses for underlining etc, pipe the output
+./"  through "col -b":
+./"
+./"  nroff -man mex.man | col -b
+./"
+./"  Warning: a leading quote "'" or dot "." will not format correctly
+./"
+./"  I hereby grant this work to the public domain.
+./"
+.TH mex 1 "September 20, 2001"
+.SH NAME
+mex \- compile mex file for Octave
+.SH SYNOPSIS
+.nf
+mex [options] mex-file [sources] [objects] [libraries]
+.fi
+.SH OPTIONS
+See mkoctfile for a complete list of options to mex.  
+.SH DESCRIPTION
+mex compiles a file which calls mex functions into an oct-file.  It
+accepts both FORTRAN and C mex-files.  You may include other source
+files and object files and libraries in your mex command and they 
+will be compiled and linked together into the same oct-file, but the
+mex-file must be the first file listed.  See mkoctfile for details.
+.SH BUGS
+If you want to use the V4 mex interface, use -DV4 on the command 
+line instead of -V4.
+.SH AUTHOR
+.nf
+Paul Kienzle
+<pkienzle@users.sf.net>
+.fi
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/mex/mex.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,1002 @@
+// Author: Paul Kienzle, 2001-03-22
+// I grant this code to the public domain.
+//
+// THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+// ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+// ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+// FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+// LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+// OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+// SUCH DAMAGE.
+
+// 2001-06-21 Paul Kienzle <pkienzle@users.sf.net>
+// * fix is_numeric so that character strings aren't called numeric.
+// * use unsigned short for mxChar rather than char
+// 2001-09-20 Paul Kienzle <pkienzle@users.sf.net>
+// * Need <float.h> for DBL_EPSILON
+
+#include <float.h>
+#include <iomanip.h>
+extern "C" {
+#include <stdlib.h>
+#include <setjmp.h>
+  extern const char *mexFunctionName;
+} ;
+
+#include <octave/oct.h>
+#include <octave/pager.h>
+#include <octave/SLList.h>
+// XXX FIXME XXX --- this belongs in SLList.h, not SLList.cc
+template <class T> SLList<T>::~SLList (void) { clear(); }
+#include <octave/f77-fcn.h>
+#include <octave/unwind-prot.h>
+#include <octave/lo-mappers.h>
+#include <octave/lo-ieee.h>
+#include <octave/parse.h>
+#include <octave/toplev.h>
+#include <octave/variables.h>
+
+// ================ Octave 2.0 support ==================
+#if defined(HAVE_OCTAVE_20)
+#include <octave/symtab.h>
+class unwind_protect
+{
+public:
+  static void add(cleanup_func fptr, void *ptr) 
+  { 
+    add_unwind_protect (fptr, ptr);
+  }
+  static void run(void)
+  {
+    run_unwind_protect ();
+  }
+} ;
+
+static octave_value_list
+eval_string (const string& s, int print, int& parse_status, int nargout) 
+{
+  return eval_string(s,print,parse_status);
+}
+
+static int
+octave_vformat (std::ostream& os, const char *fmt, va_list args)
+{
+  int retval = -1;
+
+#if defined (__GNUG__)
+
+  ostrstream buf;
+  buf.vform (fmt, args);
+  buf << ends;
+  char *s = buf.str ();
+  os << s;
+  retval = strlen (s);
+  delete [] s;
+
+#else
+
+  char *s = octave_vsnprintf (fmt, args);
+  if (s)
+    {
+      os << s;
+      retval = strlen (s);
+      free (s);
+    }
+
+#endif
+
+  return retval;
+}
+
+#endif
+
+#if 0
+#define TRACEFN cout << __FUNCTION__ << endl << flush
+#else
+#define TRACEFN do { } while(0)
+#endif
+
+/* ============== mxArray data type ============= */
+// Class mxArray is not much more than a struct for keeping together
+// dimensions and data.  It doesn't even ensure consistency between
+// the dimensions and the data.  Unfortunately you can't do better
+// than this without restricting the operations available in Matlab
+// for directly manipulating its mxArray type.
+
+typedef unsigned short mxChar;
+const int mxMAXNAM=64;
+
+class mxArray {
+public:
+  ~mxArray () { }
+
+  int rows() const { return nr; }
+  int columns() const { return nc; }
+  void rows(int r) { nr = r; }
+  void columns(int c) { nc = c; }
+
+  double *imag() const { return pi; }
+  double *real() const { return pr; }
+  void imag(double *p) { pi = p; }
+  void real(double *p) { pr = p; }
+
+  bool is_empty() const { return nr==0 || nc==0; }
+  bool is_numeric() const { return !isstr && (pr != NULL || nr==0 || nc==0); }
+  bool is_complex() const { return pi != NULL; }
+  bool is_sparse() const { return false; }
+
+  bool is_string() const { return isstr; }
+  void is_string(bool set) { isstr = set; }
+
+  const char* name() const { return aname; }
+  void name(const char *nm) { 
+    strncpy(aname,nm,mxMAXNAM); 
+    aname[mxMAXNAM]='\0'; 
+  }
+
+  octave_value as_octave_value() const;
+
+private:
+  int nr, nc;
+  double *pr, *pi;
+  bool isstr;
+  char aname[mxMAXNAM+1];
+} ;
+
+octave_value mxArray::as_octave_value() const
+{
+  octave_value ret;
+  if (isstr)
+    {
+      charMatrix chm(nr,nc);
+      char *pchm = chm.fortran_vec();
+      for (int i=0; i < nr*nc; i++) 
+	pchm[i] = NINT(pr[i]);
+      ret = octave_value(chm, true);
+    }
+  else if (pi)
+    {
+      ComplexMatrix cm(nr, nc);
+      Complex *pcm = cm.fortran_vec();
+      for (int i=0; i < nr*nc; i++) pcm[i] = Complex(pr[i], pi[i]);
+      ret = cm;
+    }
+  else if (pr)
+    {
+      Matrix m(nr,nc);
+      double *pm = m.fortran_vec();
+      memcpy(pm, pr, nr*nc*sizeof(double));
+      ret = m;
+    }
+  else
+    ret = Matrix(0,0);
+
+  return ret;
+}
+
+/* ========== mex file context ============= */
+// Class mex keeps track of all memory allocated and frees anything
+// not explicitly marked persistent when the it is destroyed.  It also
+// maintains the setjump/longjump buffer required for non-local exit
+// from the mex file, and any other state local to this instance of
+// the mex function invocation.
+
+class mex {
+
+public:
+  mex() { }
+  ~mex() { if (!memlist.empty()) error("mex: no cleanup performed"); }
+
+  // free all unmarked pointers obtained from malloc and calloc
+  static void cleanup(void* context);
+
+  // allocate a pointer, and mark it to be freed on exit
+  Pix malloc(int n);
+
+  // allocate a pointer to be freed on exit, and initialize to 0
+  Pix calloc(int n, int t);
+
+  // reallocate a pointer obtained from malloc or calloc
+  Pix realloc(Pix ptr, int n);
+
+  // free a pointer obtained from malloc or calloc
+  void free(Pix ptr);
+
+  // mark a pointer so that it will not be freed on exit
+  void persistent(Pix ptr) { unmark(ptr); }
+
+  // make a new array value and initialize it with zeros; it will be
+  // freed on exit unless marked as persistent
+  mxArray *make_value(int nr, int nc, int cmplx);
+
+  // make a new array value and initialize from an octave value; it will be
+  // freed on exit unless marked as persistent
+  mxArray *make_value(const octave_value&);
+
+  // free an array and its contents
+  void free_value(mxArray* ptr);
+
+  // mark an array and its contents so it will not be freed on exit
+  void persistent(mxArray* ptr);
+
+  // 1 if error should be returned to MEX file, 0 if abort
+  int trap_feval_error; 
+
+  // longjmp return point if mexErrMsgTxt or error
+  jmp_buf jump;  
+  
+  // trigger a long jump back to the mex calling function
+  void abort() { longjmp(jump, 1); }
+
+private:
+
+  // list of memory resources that need to be freed upon exit
+  SLList<Pix> memlist;
+
+  // mark a pointer to be freed on exit
+  void mark(Pix p);
+
+  // unmark a pointer to be freed on exit, either because it was
+  // made persistent, or because it was already freed
+  void unmark(Pix p);
+
+} ;
+
+
+
+template class SLList<Pix>;
+
+// free all unmarked pointers obtained from malloc and calloc
+void mex::cleanup(Pix ptr)
+{
+  mex* context = (mex*)ptr;
+  for (Pix p = context->memlist.first(); p; context->memlist.next(p))
+    ::free(context->memlist(p));
+  context->memlist.clear();
+}
+
+// XXX FIXME XXX --- could this be added to class SLList<T>?
+void del(SLList<Pix>& l, const Pix& v)
+{
+  if (l.front() == v)
+    l.del_front();
+  else
+    {
+      Pix before = l.first();
+      Pix p = before;
+      l.next(p);
+      while (p && l(p) != v) 
+	{
+	  before = p; l.next(p);
+	}
+      if (p) l.del_after(before);
+    }
+}
+
+
+// mark a pointer to be freed on exit
+void mex::mark(Pix p) 
+{ 
+  if (memlist.owns(p))
+    warning("%s: double registration ignored", mexFunctionName);
+  else
+    memlist.prepend(p);
+}
+
+// unmark a pointer to be freed on exit, either because it was
+// made persistent, or because it was already freed
+void mex::unmark(Pix p) 
+{ 
+  del(memlist, p);
+}
+
+// allocate a pointer, and mark it to be freed on exit
+Pix mex::malloc(int n)
+{
+  if (n == 0) return NULL;
+#if 0
+  // XXX FIXME XXX --- how do you allocate and free aligned, non-typed
+  // memory in C++?
+  Pix ptr = Pix(new double[(n+sizeof(double)-1)/sizeof(double)]);
+#else
+  // XXX FIXME XXX --- can we mix C++ and C-style heap management?
+  Pix ptr = ::malloc(n);
+  if (ptr == NULL)
+    {
+      // XXX FIXME XXX --- could use "octave_new_handler();" instead
+      error("%s: out of memory", mexFunctionName);
+      abort();
+    }
+#endif
+  
+  mark(ptr);
+  return ptr;
+}
+
+// allocate a pointer to be freed on exit, and initialize to 0
+Pix mex::calloc(int n, int t)
+{
+  Pix v = malloc(n*t);
+  memset(v, 0, n*t);
+  return v;
+}
+
+// reallocate a pointer obtained from malloc or calloc
+Pix mex::realloc(Pix ptr, int n)
+{
+#if 0
+  error("%s: cannot reallocate using C++ new/delete operations",
+	mexFunctionName);
+  abort();
+#else
+  Pix v = NULL;
+  if (n == 0) 
+    free(ptr);
+  else if (ptr == NULL) 
+    v = malloc(n);
+  else
+    {
+      v = ::realloc(ptr, n);
+      if (v && memlist.owns(ptr))
+	{
+	  del(memlist, ptr);
+	  memlist.prepend(v);
+	}
+    }
+#endif    
+  return v;
+}
+
+// free a pointer obtained from malloc or calloc
+void mex::free(Pix ptr)
+{
+  unmark(ptr);
+#if 0
+  delete [] ptr;
+#else
+  ::free(ptr);
+#endif
+}
+
+
+// make a new array value and initialize from an octave value; it will be
+// freed on exit unless marked as persistent
+mxArray* mex::make_value(const octave_value &ov)
+{
+  int nr=-1, nc=-1;
+  double *pr = NULL, *pi = NULL;
+
+  if (ov.is_numeric_type() || ov.is_string())
+    {
+      nr = ov.rows();
+      nc = ov.columns();
+    }
+  if (nr > 0 && nc > 0)
+    {
+      if (ov.is_string())
+	{
+	  // XXX FIXME XXX - must use 16 bit unicode to represent strings.
+	  const Matrix m(ov.matrix_value(1));
+	  pr = (double *)malloc(nr*nc*sizeof(double));
+	  memcpy(pr, m.data(), nr*nc*sizeof(double));
+	}
+      else if (ov.is_complex_type())
+	{
+	  // XXX FIXME XXX --- may want to consider lazy copying of the
+	  // matrix, but this will only help if the matrix is being
+	  // passed on to octave via callMATLAB later.
+	  const ComplexMatrix cm(ov.complex_matrix_value());
+	  const Complex * pz = cm.data();
+	  pr = (double *)malloc(nr*nc*sizeof(double));
+	  pi = (double *)malloc(nr*nc*sizeof(double));
+	  for (int i=0; i < nr*nc; i++) 
+	    {
+	      pr[i] = real(pz[i]);
+	      pi[i] = imag(pz[i]);
+	    }
+	}
+      else
+	{
+	  const Matrix m(ov.matrix_value());
+	  pr = (double *)malloc(nr*nc*sizeof(double));
+	  memcpy(pr, m.data(), nr*nc*sizeof(double));
+	}
+    }
+  
+  mxArray *value = (mxArray*)malloc(sizeof(mxArray));
+  value->is_string(ov.is_string());
+  value->real(pr);
+  value->imag(pi);
+  value->rows(nr);
+  value->columns(nc);
+  value->name("");
+
+  return value;
+}
+
+// make a new array value and initialize it with zeros; it will be
+// freed on exit unless marked as persistent
+mxArray *mex::make_value(int nr, int nc, int cmplx)
+{
+
+  mxArray *value = (mxArray*)malloc(sizeof(mxArray));
+  double*p = (double*)calloc(nr*nc, sizeof(double));
+  value->real(p);
+  if (cmplx) value->imag((double*)calloc(nr*nc, sizeof(double)));
+  else value->imag((double*)Pix(0));
+  value->rows(nr);
+  value->columns(nc);
+  value->is_string(false);
+  value->name("");
+
+  return value;
+}
+
+// free an array and its contents
+void mex::free_value(mxArray* ptr)
+{
+  free(ptr->real());
+  free(ptr->imag());
+  free(ptr);
+}
+
+// mark an array and its contents so it will not be freed on exit
+void mex::persistent(mxArray* ptr)
+{ 
+  persistent(Pix(ptr->real()));
+  persistent(Pix(ptr->imag()));
+  persistent(Pix(ptr));
+}
+
+
+/* ========== Octave interface to mex files ============ */
+
+mex* __mex = NULL;
+
+extern "C" {
+  void F77_FCN(mexfunction,MEXFUNCTION)
+    (const int& nargout, mxArray *plhs[], 
+     const int& nargin,  mxArray *prhs[]);
+  void mexFunction(const int nargout, mxArray *plhs[],
+		   const int nargin,  mxArray *prhs[]);
+} ;
+
+#if 0 /* Don't bother trapping stop/exit */
+// To trap for STOP in fortran code, this needs to be registered with atexit
+static void mex_exit()
+{
+  if (__mex) {
+    error("%s: program aborted", mexFunctionName);
+    __mex->abort();
+  }
+}
+#endif
+
+enum callstyle { use_fortran, use_C };
+
+octave_value_list 
+call_mex(callstyle cs, const octave_value_list& args, const int nargout)
+{
+#if 0 /* Don't bother trapping stop/exit */
+  // XXX FIXME XXX ---- should really push "mex_exit" onto the octave
+  // atexit stack before we start and pop it when we are through, but 
+  // the stack handle isn't exported from toplev.cc, so we can't.  mex_exit
+  // would have to be declared as DEFUN(mex_exit,,,"") of course.
+  static bool unregistered = true;
+  if (unregistered)
+    {
+      atexit(mex_exit);
+      unregistered = false;
+    }
+#endif
+
+  // nargout+1 since even for zero specified args, still want to be able
+  // to return an ans.
+  const int nargin = args.length();
+  mxArray * argin[nargin], * argout[nargout+1];
+  for (int i=0; i < nargin; i++) argin[i] = NULL;
+  for (int i=0; i < nargout+1; i++) argout[i] = NULL;
+  
+  mex context;
+  unwind_protect::add(mex::cleanup, Pix(&context));
+		      
+  for (int i=0; i < nargin; i++) argin[i] = context.make_value(args(i));
+
+  unwind_protect_ptr(__mex); // save old mex pointer
+  if (setjmp(context.jump) == 0)
+    {
+      __mex = &context;
+      if (cs == use_fortran)
+	F77_FCN(mexfunction,MEXFUNCTION)(nargout, argout, nargin, argin);
+      else
+	mexFunction(nargout, argout, nargin, argin);
+    }
+  unwind_protect::run(); // restore old mex pointer
+
+  // convert returned array entries back into octave values
+  octave_value_list retval;
+  if (! error_state)
+    {
+      for (int i=0; i < nargout+1; i++)
+	if (argout[i]) retval(i) = argout[i]->as_octave_value();
+      //retval(i) = argout[i] ? argout[i]->as_octave_value() : octave_value();
+    }
+
+  unwind_protect::run(); // clean up mex resources
+  return retval;
+}
+
+octave_value_list 
+Fortran_mex(const octave_value_list& args, const int nargout)
+{
+  return call_mex(use_fortran, args, nargout);
+}
+
+octave_value_list 
+C_mex(const octave_value_list& args, const int nargout)
+{
+  return call_mex(use_C, args, nargout);
+}
+
+/* ============ C interface to mex functions  =============== */
+extern "C" {
+
+  void mexErrMsgTxt (const char *s)
+    {
+      if (s && strlen(s) > 0) error("%s: %s", mexFunctionName, s);
+      else error(""); // just set the error state; don't print msg
+      __mex->abort();
+    }
+  void mexWarnMsgTxt (const char *s)
+    {
+      warning("%s", s);
+    }
+  void mexPrintf (const char *fmt, ...)
+    {
+      va_list args;
+      va_start (args, fmt);
+      octave_vformat(octave_diary, fmt, args);
+      octave_vformat(octave_stdout, fmt, args);
+      va_end (args);
+    }
+
+  // floating point representation
+  int mxIsNaN(const double v) { return xisnan(v) != 0; }
+  int mxIsFinite(const double v) { return xfinite(v) != 0; }
+  int mxIsInf(const double v) { return xisinf(v) != 0; }
+  double mxGetEps() { return DBL_EPSILON; }
+  double mxGetInf() { return octave_Inf; }
+  double mxGetNaN() { return octave_NaN; }
+
+  int mexEvalString(const char* s)
+    {
+      int parse_status;
+      octave_value_list ret;
+      ret = eval_string(s, false, parse_status, 0);
+      if ( parse_status || error_state )
+	{
+	  error_state = 0;
+	  return 1;
+	}
+      else
+	return 0;
+    }
+  int mexCallMATLAB(const int nargout, mxArray* argout[], 
+		    const int nargin, const mxArray* argin[],
+		    const char* fname)
+    {
+      octave_value_list args;
+
+      // XXX FIXME XXX --- do we need unwind protect to clean up args?
+      // Off hand, I would say that this problem is endemic to Octave
+      // and we will continue to have memory leaks after Ctrl-C until
+      // proper exception handling is implemented.  longjmp() only
+      // clears the stack, so any class which allocates data on the
+      // heap is going to leak.
+      args.resize(nargin);
+      for (int i=0; i < nargin; i++)
+	{
+	  args(i) = argin[i]->as_octave_value();
+	}
+      octave_value_list retval = feval(fname, args, nargout);
+
+      if (error_state && __mex->trap_feval_error == 0)
+	{
+	  // XXX FIXME XXX --- is this the correct way to clean up?
+	  // abort() is going to trigger a long jump, so the normal
+	  // class destructors will not be called.  Hopefully this
+	  // will reduce things to a tiny leak.  Maybe create a new
+	  // octave memory tracer type which prints a friendly message
+	  // every time it is created/copied/deleted to check this.
+	  args.resize(0);
+	  retval.resize(0);
+	  __mex->abort();
+	}
+
+      int num_to_copy = retval.length();
+      if (nargout < retval.length()) num_to_copy = nargout;
+      for (int i=0; i < num_to_copy; i++)
+	{
+	  // XXX FIXME XXX --- it would be nice to avoid copying the
+	  // value here, but there is no way to steal memory from a
+	  // matrix, never mind that matrix memory is allocated
+	  // by new[] and mxArray memory is allocated by malloc().
+	  argout[i] = __mex->make_value(retval(i));
+	}
+      while (num_to_copy < nargout) argout[num_to_copy++] = NULL;
+
+      if (error_state)
+	{
+	  error_state = 0;
+	  return 1;
+	}
+      else
+	return 0;
+    }
+
+  void mexSetTrapFlag(int flag) { __mex->trap_feval_error = flag;  }
+
+  Pix mxMalloc(int n) { return __mex->malloc(n);  }
+  Pix mxCalloc(int n, int size) { return __mex->calloc(n, size); }
+  Pix mxRealloc(Pix ptr, int n) { return __mex->realloc(ptr,n); }
+  void mxFree(Pix ptr) { __mex->free(ptr); }
+  void mexMakeMemoryPersistent(Pix ptr) { __mex->persistent(ptr); }
+
+  mxArray* mxCreateDoubleMatrix(int nr, int nc, int iscomplex)
+    {
+      return __mex->make_value(nr, nc, iscomplex);
+    }
+  void mxDestroyArray(mxArray *v) { __mex->free(v);  }
+  void mexMakeArrayPersistent(mxArray *ptr) { __mex->persistent(ptr); }
+
+  int mxIsChar (const mxArray* ptr) { return ptr->is_string(); }
+  int mxIsSparse (const mxArray* ptr) { return ptr->is_sparse(); }
+  int mxIsFull(const mxArray* ptr) { return !ptr->is_sparse(); }
+  int mxIsNumeric (const mxArray* ptr) { return ptr->is_numeric(); }
+  int mxIsComplex (const mxArray* ptr) { return ptr->is_complex(); }
+  int mxIsDouble (const mxArray* ptr) { return true; }
+  int mxIsEmpty (const mxArray* ptr) { return ptr->is_empty(); }
+  Pix mxGetPr (const mxArray* ptr) { return ptr->real(); }
+  Pix mxGetPi (const mxArray* ptr) { return ptr->imag(); }
+  int mxGetM (const mxArray* ptr) { return ptr->rows(); }
+  int mxGetN (const mxArray* ptr) { return ptr->columns(); }
+  void mxSetM (mxArray* ptr, const int M) { return ptr->rows(M); }
+  void mxSetN (mxArray* ptr, const int N) { return ptr->columns(N); }
+  void mxSetPr (mxArray* ptr, Pix pr) { ptr->real((double *)pr); }
+  void mxSetPi (mxArray* ptr, Pix pi) { ptr->imag((double *)pi); }
+  double mxGetScalar (const mxArray* ptr)
+    {
+      double *pr =  ptr->real();
+      if (pr) return pr[0];
+      else mexErrMsgTxt("calling mxGetScalar on an empty matrix");
+    }
+
+  int mxGetString (const mxArray* ptr, char *buf, int buflen)
+    {
+      if (ptr->is_string())
+	{
+	  const int nr = ptr->rows();
+	  const int nc = ptr->columns();
+	  const int n = nr*nc > buflen ? nr*nc : buflen;
+	  const double *pr = ptr->real();
+	  for (int i = 0; i < n; i++) buf[i] = NINT(pr[i]);
+	  if (n < buflen) buf[n] = '\0';
+	  return n >= buflen;
+	}
+      else
+	return 1;
+    }
+
+  char *mxArrayToString (const mxArray* ptr)
+    {
+      const int nr = ptr->rows();
+      const int nc = ptr->columns();
+      const int n = nr*nc*sizeof(mxChar)+1;
+      char *buf = (char *)mxMalloc(n);
+      if (buf) mxGetString(ptr, buf, n);
+      return buf;
+    }
+
+  mxArray *mxCreateString(const char *str)
+    {
+      const int n = strlen(str);
+      mxArray *m = __mex->make_value(1, n, 0);
+      if (m==NULL) return m;
+      m->is_string(true);
+
+      double *pr = m->real();
+      for (int i=0; i < n; i++) pr[i] = str[i];
+      return m;
+    }
+
+  mxArray *mxCreateCharMatrixFromStrings (int n, const char **str)
+    {
+      // Find length of the individual strings
+      Array<int> len(n);
+      for (int i=0; i < n; i++) len(i) = strlen(str[i]);
+
+      // Find maximum length
+      int maxlen = 0;
+      for (int i=0; i < n; i++) if (len(i) > maxlen) maxlen = len(i);
+
+      // Need a place to copy them
+      mxArray *m = __mex->make_value(n, maxlen, 0);
+      if (m==NULL) return m;
+      m->is_string(true);
+
+      // Do the copy (being sure not to exceed the length of any of the
+      // strings)
+      double *pr = m->real();
+      for (int j = 0; j < maxlen; j++)
+	for (int i = 0; i < n; i++)
+	  if (j < len(i)) *pr++ = str[i][j];
+	  else *pr++ = '\0';
+      return m;
+    }
+
+  int mexPutArray(mxArray *ptr, const char *space)
+    {
+      if (ptr == NULL) return 1;
+      const char *name = ptr->name();
+      if (name[0]=='\0') return 1;
+      if (strcmp(space,"global") == 0)
+	set_global_value (name, ptr->as_octave_value());
+      else if (strcmp(space,"caller") == 0)
+	{
+	  // XXX FIXME XXX --- this belongs in variables.cc
+	  symbol_record *sr = curr_sym_tab->lookup (name, true);
+	  if (sr) sr->define(ptr->as_octave_value());
+	  else panic_impossible ();
+	}
+      else if (strcmp(space,"base") == 0)
+	mexErrMsgTxt("mexPutArray: 'base' symbol table not implemented");
+      else
+	mexErrMsgTxt("mexPutArray: symbol table does not exist");
+	
+    }
+
+  mxArray *mexGetArray(const char *name, const char *space)
+    {
+      // XXX FIXME XXX --- this should be in variable.cc, but the correct
+      // functionality is not exported.  Particularly, get_global_value()
+      // generates an error if the symbol is undefined.
+      symbol_record *sr;
+      if (strcmp(space,"global") == 0)
+	sr = global_sym_tab->lookup (name);
+      else if (strcmp(space,"caller") == 0)
+	sr = curr_sym_tab->lookup (name);
+      else if (strcmp(space,"base") == 0)
+	mexErrMsgTxt("mexGetArray: 'base' symbol table not implemented");
+      else
+	mexErrMsgTxt("mexGetArray: symbol table does not exist");
+
+      if (sr)
+	{
+#if defined(HAVE_OCTAVE_20)
+	  octave_value sr_def = sr->variable_value();
+#else
+	  octave_value sr_def = sr->def ();
+#endif
+	  if (!sr_def.is_undefined ())
+	    {
+	      mxArray* ptr = __mex->make_value(sr_def);
+	      ptr->name(name);
+	      return ptr;
+	    }
+	  else
+	    return NULL;
+	}
+      else
+	return NULL;
+    }
+
+  mxArray *mexGetArrayPtr(const char *name, const char *space)
+    {
+      return mexGetArray(name, space);
+    }
+
+  const char* mxGetName(const mxArray* ptr)
+    {
+      return ptr->name();
+    }
+
+  void mxSetName(mxArray* ptr, const char*nm)
+    {
+      ptr->name(nm);
+    }
+
+} ;
+
+/* ============ Fortran interface to mex functions ============== */
+// Where possible, these call the equivalent C function since that API is
+// fixed.  It costs and extra function call, but is easier to maintain.
+extern "C" {
+
+  void F77_FCN(mexerrmsgtxt, MEXERRMSGTXT)
+    (const char *s, const int slen)
+    {
+      if (slen > 1 || (slen == 1 && s[0] != ' ') ) 
+	error("%s: %.*s", mexFunctionName, slen, s);
+      else error(""); // just set the error state; don't print msg
+      __mex->abort();
+    }
+
+  void F77_FCN(mexprintf,MEXPRINTF)
+    (const char *s, const int slen)
+    {
+      mexPrintf("%.*s\n", slen, s);
+    }
+
+  double F77_FCN(mexgeteps,MEXGETEPS)() { return mxGetEps(); }
+  double F77_FCN(mexgetinf,MEXGETINF)() { return mxGetInf(); }
+  double F77_FCN(mexgetnan,MEXGETNAN)() { return mxGetNaN(); }
+  int F77_FCN(mexisfinite,MEXISFINITE)(double v) { return mxIsFinite(v); }
+  int F77_FCN(mexisinf,MEXISINF)(double v) { return mxIsInf(v); }
+  int F77_FCN(mexisnan,MEXISNAN)(double v) { return mxIsNaN(v); }
+
+  // ====> Array access
+  Pix F77_FCN(mxcreatefull,MXCREATEFULL)
+    (const int& nr, const int& nc, const int& iscomplex)
+    {
+      return mxCreateDoubleMatrix(nr,nc,iscomplex);
+    }
+
+  void F77_FCN(mxfreematrix,MXFREEMATRIX)
+    (mxArray* &ptr)
+    {
+      mxDestroyArray(ptr);
+    }
+
+  Pix F77_FCN(mxcalloc,MXCALLOC)(const int& n, const int& size)
+    {
+      return mxCalloc(n,size);
+    }
+
+  void F77_FCN(mxfree,MXFREE)
+    (const Pix &ptr)
+    {
+      mxFree(ptr);
+    }
+  
+  int F77_FCN(mxgetm,MXGETM)
+    (const mxArray* &ptr) 
+    { 
+      return mxGetM(ptr); 
+    }
+
+  int F77_FCN(mxgetn,MXGETN)
+    (const mxArray* &ptr) 
+    { 
+      return mxGetN(ptr); 
+    }
+
+  Pix F77_FCN(mxgetpi,MXGETPI)
+    (const mxArray* &ptr) 
+    {
+      return mxGetPi(ptr);
+    }
+
+  Pix F77_FCN(mxgetpr,MXGETPR)
+    (const mxArray* &ptr) 
+    {
+      return mxGetPr(ptr);
+    }
+
+  void F77_FCN(mxsetm,MXSETM)
+    (mxArray* &ptr, const int& m) 
+    { 
+      mxSetM(ptr, m); 
+    }
+
+  void F77_FCN(mxsetn,MXSETN)
+    (mxArray* &ptr, const int& n) 
+    { 
+      mxSetN(ptr, n);
+    }
+
+  void F77_FCN(mxsetpi,MXSETPI)
+    (mxArray* &ptr, Pix &pi) 
+    {
+      mxSetPi(ptr, pi);
+    }
+
+  void F77_FCN(mxsetpr,MXSETPR)
+    (mxArray* &ptr, Pix &pr) 
+    {
+      mxSetPr(ptr, pr);
+    }
+  
+  int F77_FCN(mxiscomplex,MXISCOMPLEX)
+    (const mxArray* &ptr)
+    {
+      return mxIsComplex(ptr);
+    }
+
+  int F77_FCN(mxisdouble,MXISDOUBLE)
+    (const mxArray* &ptr)
+    {
+      return mxIsDouble(ptr);
+    }
+  
+  int F77_FCN(mxisnumeric,MXISNUMERIC)
+    (const mxArray* &ptr)
+    {
+      return mxIsNumeric(ptr);
+    }
+  
+  int F77_FCN(mxisfull,MXISFULL)
+    (const mxArray* &ptr)
+    {
+      return 1 - mxIsSparse(ptr);
+    }
+  
+  int F77_FCN(mxissparse,MXISSPARSE)
+    (const mxArray* &ptr)
+    {
+      return mxIsSparse(ptr);
+    }
+  
+  int F77_FCN(mxisstring,MXISSTRING)
+    (const mxArray* &ptr)
+    {
+      return mxIsChar(ptr);
+    }
+
+  int F77_FCN(mxgetstring,MXGETSTRING)
+    (const mxArray* &ptr, char *str, const int& len)
+    {
+      return mxGetString(ptr, str, len);
+    }
+
+  int F77_FCN(mexcallmatlab,MEXCALLMATLAB)
+    (const int& nargout, mxArray** argout, 
+     const int& nargin, const mxArray** argin,
+     const char* fname,
+     const int fnamelen)
+    {
+      char str[mxMAXNAM+1];
+      strncpy(str, fname, fnamelen<mxMAXNAM?fnamelen:mxMAXNAM);
+      str[fnamelen] = '\0';
+      return mexCallMATLAB(nargout, argout, nargin, argin, str);
+    }
+
+  // ======> Fake pointer support
+  void F77_FCN(mxcopyreal8toptr,MXCOPYREAL8TOPTR)
+    (const double *d, const int& prref, const int& len)
+    {
+      TRACEFN;
+      double *pr = (double *)prref;
+      for (int i=0; i < len; i++) pr[i] = d[i];
+    }
+  
+  void F77_FCN(mxcopyptrtoreal8,MXCOPYPTRTOREAL8)
+    (const int& prref, double *d, const int& len)
+    {
+      TRACEFN;
+      double *pr = (double *)prref;
+      for (int i=0; i < len; i++) d[i] = pr[i];
+    }
+  
+  void F77_FCN(mxcopycomplex16toptr,MXCOPYCOMPLEX16TOPTR)
+    (const double *d, int& prref, int& piref, const int& len)
+    {
+      TRACEFN;
+      double *pr = (double *)prref;
+      double *pi = (double *)piref;
+      for (int i=0; i < len; i++) pr[i] = d[2*i], pi[i] = d[2*i+1];
+    }
+  
+  void F77_FCN(mxcopyptrtocomplex16,MXCOPYPTRTOCOMPLEX16)
+    (const int& prref, const int& piref, double *d, const int& len)
+    {
+      TRACEFN;
+      double *pr = (double *)prref;
+      double *pi = (double *)piref;
+      for (int i=0; i < len; i++) d[2*i]=pr[i], d[2*i+1] = pi[i];
+    }
+  
+} ;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/mex/mex.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,128 @@
+// Author: Paul Kienzle, 2001-03-22
+// I grant this code to the public domain.
+//
+// THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+// ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+// ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+// FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+// LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+// OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+// SUCH DAMAGE.
+
+// 2001-06-21 Paul Kienzle <pkienzle@users.sf.net>
+// * use unsigned short for mxChar rather than char
+
+/* mex.h is for use in C-programs only; do NOT include it in mex.cc */
+
+#define HAVE_OCTAVE
+typedef void mxArray;
+typedef unsigned short mxChar;
+enum mxComplexity { mxREAL=0, mxCOMPLEX=1 };
+#if !defined(__cplusplus)
+typedef int bool;
+#endif
+
+/* -V4 stuff */
+#if defined(V4)
+#define Matrix mxArray
+#define REAL mxREAL
+#endif
+
+#define mxMAXNAME 64
+
+#if defined(__cplusplus)
+extern "C" {
+#endif
+
+#if defined(V4)
+void mexFunction(int nlhs, mxArray* plhs[], int nrhs, mxArray* prhs[]);
+#else
+void mexFunction(int nlhs, mxArray* plhs[], int nrhs, const mxArray* prhs[]);
+#endif
+
+/* Floating point representation */
+bool mxIsNaN(double v);
+bool mxIsFinite(double v);
+bool mxIsInf(double v);
+double mxGetEps(void);
+double mxGetInf(void);
+double mxGetNaN(void);
+
+/* V4 floating point routines renamed in V5 */
+#define mexIsNaN mxIsNaN
+#define mexIsFinite mxIsFinite
+#define mexIsInf mxIsInf
+#define mexGetEps mxGetEps
+#define mexGetInf mxGetInf
+#define mexGetNaN mxGetNan
+
+/* Interface to the interpreter */
+extern const char *mexFunctionName;
+int mexCallMATLAB(const int nargout, mxArray* argout[], 
+		  const int nargin, const mxArray* argin[],
+		  const char* fname);
+void mexSetTrapFlag(int flag);
+int mexEvalString (const char *s);
+void mexErrMsgTxt (const char *s);
+void mexWarnMsgTxt (const char *s);
+void mexPrintf (const char *fmt, ...);
+
+mxArray* mexGetArray(const char *name, const char *space);
+mxArray* mexGetArrayPtr(const char *name, const char *space);
+#define mexGetGlobal(nm) mexGetArray(nm,"global")
+#define mexGetMatrix(nm) mexGetArray(nm,"caller")
+#define mexGetMatrixPtr(nm) mexGetArrayPtr(nm,"caller")
+int mexPutArray(mxArray* ptr, const char *space);
+#define mexPutMatrix(nm) mexPutArray(nm,"caller")
+
+
+/* Memory */
+void *mxMalloc(int n);
+void *mxCalloc(int n, int size);
+void mxFree(void *ptr);
+void mexMakeArrayPersistent(mxArray *ptr);
+void mexMakeMemoryPersistent(void *ptr);
+
+/* interpreter values */
+mxArray* mxCreateDoubleMatrix(int nr, int nc, int iscomplex);
+#define mxCreateFull mxCreateDoubleMatrix
+void mxDestroyArray(mxArray *v);
+#define mxFreeMatrix mxDestroyArray
+int mxIsChar (const mxArray* ptr);
+#define mxIsString mxIsChar
+int mxIsSparse (const mxArray* ptr);
+int mxIsFull (const mxArray* ptr);
+int mxIsDouble (const mxArray* ptr);
+int mxIsNumeric (const mxArray* ptr);
+int mxIsComplex (const mxArray* ptr);
+int mxIsEmpty (const mxArray* ptr);
+int mxGetM (const mxArray* ptr);
+int mxGetN (const mxArray* ptr);
+double* mxGetPr (const mxArray* ptr);
+
+/* The following cannot be supported in Octave without incurring
+ * the large runtime penalty of copying arrays to/from matlab format
+
+ double* mxGetPi (const mxArray* ptr);
+ void mxSetM (mxArray* ptr, const int M);
+ void mxSetN (mxArray* ptr, const int N);
+ void mxSetPr (mxArray* ptr, double* pr);
+ void mxSetPi (mxArray* ptr, double* pi);
+*/
+
+
+
+int mxGetString (const mxArray* ptr, char *buf, int buflen);
+char *mxArrayToString (const mxArray* ptr);
+mxArray *mxCreateString (const char *str);
+
+double mxGetScalar (const mxArray* ptr);
+
+#if defined(__cplusplus)
+}
+#endif
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/mex/mex.in	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,59 @@
+#! /bin/sh
+
+# This program is granted to the public domain
+
+# 2001-06-20 Paul Kienzle <pkienzle@users.sf.net>
+# * eliminate $(arg:0:1) since it is not available in all bash versions
+# 2001-09-20 Paul Kienzle <pkienzle@users.sf.net>
+# * use config-like syntax to set the name of mkoctfile and the path to mex
+
+if test $# -lt 1 ; then
+    echo usage: mex -options file.c
+fi
+
+first=""
+for arg in $*; do
+    case "$arg" in -*) ;; *) first="$arg"; break ;; esac
+done
+
+if test -z "$first" ; then
+   @MKOCTFILE@ $*
+   exit
+fi
+
+if grep -iq mexfunction $first ; then
+   echo building $first
+else
+   echo $first does not contain mexfunction
+   exit 1
+fi
+
+name=${first%%.*}
+ext=${first#*.}
+#echo $name . $ext
+
+sedopt="-es/NAME/$name/"
+if test ${ext:0:1} = "f" || test ${ext:0:1} = 'F' ; then
+  sedopt="$sedopt -es/C_mex/Fortran_mex/"
+fi
+#echo "$sedopt"
+
+cat <<EOF | sed $sedopt > mex_$name.cc
+#include <octave/oct.h>
+
+extern "C" {
+  const char *mexFunctionName = "NAME";
+} ;
+
+DEFUN_DLD(NAME, args, nargout, "\
+NAME not directly documented. Try the following:\n\
+   type(file_in_loadpath('NAME.m'))\n\
+")
+{
+  octave_value_list C_mex(const octave_value_list &, const int);
+  return C_mex(args, nargout);
+}
+EOF
+
+set -x
+@MKOCTFILE@ -o $name mex_$name.cc @opath@/mex.o -I@opath@ $*
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/mex/myfeval.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,14 @@
+#include "mex.h"
+
+void mexFunction(int nlhs, mxArray* plhs[], int nrhs, const mxArray* prhs[])
+{
+  char *str;
+  mexPrintf("Hello, World!\n");
+  mexPrintf("I have %d inputs and %d outputs\n", nrhs, nlhs);
+  if (nrhs < 1 || !mxIsString(prhs[0])) 
+    mexErrMsgTxt("function name expected");
+  str = mxArrayToString (prhs[0]);
+  mexPrintf("I'm going to call the interpreter function %s\n", str);
+  mexCallMATLAB(nlhs, plhs, nrhs-1, prhs+1, str);
+  mxFree(str);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/mex/myfevalf.f	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,19 @@
+      subroutine mexFunction(nlhs, plhs, nrhs, prhs)
+      implicit none
+      integer*4 nlhs, nrhs, plhs(*), prhs(*)
+
+      integer*4 mxIsString, mxGetString, mxGetN, mexCallMATLAB
+
+      integer*4 status, len
+      character*100 str
+
+      call mexPrintf('Hello, World!')
+      if (nrhs .lt. 1 .or. mxIsString(prhs(1)) .ne. 1) then
+         call mexErrMsgTxt('function name expected')
+      endif
+      len = mxGetN(prhs(1));
+      status = mxGetString (prhs(1), str, 100)
+      call mexPrintf('FORTRAN will call the interpreter now')
+      status = mexCallMATLAB(nlhs, plhs, nrhs-1, prhs(2), str(1:len))
+      return
+      end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/mex/myset.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,25 @@
+#include "mex.h"
+
+void mexFunction(int nlhs, mxArray* plhs[], int nrhs, const mxArray* prhs[])
+{
+  char *str;
+  mxArray *v;
+
+  if (nrhs != 2 || !mxIsString(prhs[0]))
+    mexErrMsgTxt("expects symbol name and value");
+  str = mxArrayToString (prhs[0]);
+  v = mexGetArray(str, "global");
+  if (v != 0) {
+    mexPrintf("%s is a global variable with the following value:\n", str);
+    mexCallMATLAB(0, (mxArray**)0, 1, &v, "disp");
+  }
+  v = mexGetArray(str, "caller");
+  if (v != 0) {
+    mexPrintf("%s is a caller variable with the following value:\n", str);
+    mexCallMATLAB(0, (mxArray**)0, 1, &v, "disp");
+  }
+
+  // WARNING!! Can't do this in MATLAB!  Must copy variable first.
+  mxSetName(prhs[1], str);  
+  mexPutArray(prhs[1], "caller");
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ode/ode23.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,155 @@
+function [tout, xout] = ode23(F,tspan,x0,ode_fcn_format,tol,trace,count)
+
+% Copyright (C) 2000 Marc Compere
+% This file is intended for use with Octave.
+% ode23.m is free software; you can redistribute it and/or modify it
+% under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2, or (at your option)
+% any later version.
+%
+% ode23.m is distributed in the hope that it will be useful, but
+% WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+% General Public License for more details at www.gnu.org/copyleft/gpl.html.
+%
+% --------------------------------------------------------------------
+%
+% ode23 (v1.07) Integrates a system of ordinary differential equations using
+% 2nd & 3rd order Runge-Kutta formulas.  The particular 3rd order method is
+% Simpson's 1/3 rule.
+% This particular implementation uses the 3rd order estimate for xout, although
+% the truncation error is of order(h^2), therefore this method, overall is
+% a 2nd-order method.
+% This requires 3 function evaluations per integration step.
+%
+% The error estimate formula and slopes are from
+% Numerical Methods for Engineers, 2nd Ed., Chappra & Cannle, McGraw-Hill, 1985
+%
+% Usage:
+%         [tout, xout] = ode23(F, tspan, x0, ode_fcn_format, tol, trace, count)
+%
+% INPUT:
+% F     - String containing name of user-supplied problem description.
+%         Call: xprime = fun(t,x) where F = 'fun'.
+%         t      - Time (scalar).
+%         x      - Solution column-vector.
+%         xprime - Returned derivative COLUMN-vector; xprime(i) = dx(i)/dt.
+% tspan - [ tstart, tfinal ]
+% x0    - Initial value COLUMN-vector.
+% ode_fcn_format - this specifies if the user-defined ode function is in
+%         the form:     xprime = fun(t,x)   (ode_fcn_format=0, default)
+%         or:           xprime = fun(x,t)   (ode_fcn_format=1)
+%         Matlab's solvers comply with ode_fcn_format=0 while
+%         Octave's lsode() and sdirk4() solvers comply with ode_fcn_format=1.
+% tol   - The desired accuracy. (optional, default: tol = 1.e-6).
+% trace - If nonzero, each step is printed. (optional, default: trace = 0).
+% count - if nonzero, variable 'rhs_counter' is initalized, made global
+%         and counts the number of state-dot function evaluations
+%         'rhs_counter' is incremented in here, not in the state-dot file
+%         simply make 'rhs_counter' global in the file that calls ode23
+%
+% OUTPUT:
+% tout  - Returned integration time points (column-vector).
+% xout  - Returned solution, one solution column-vector per tout-value.
+%
+% The result can be displayed by: plot(tout, xout).
+%
+% Marc Compere
+% compere@mail.utexas.edu
+% created : 06 October 1999
+% modified: 15 May 2000
+
+if nargin < 7, count = 0; end
+if nargin < 6, trace = 0; end
+if nargin < 5, tol = 1.e-3; end
+if nargin < 4, ode_fcn_format = 0; end
+
+pow = 1/8;
+
+% The 2(3) coefficients:
+ a(1,1)=0;
+ a(2,1)=1/2;
+ a(3,1)=-1; a(3,2)=2;
+ % 2nd order b-coefficients
+ b2(1)=0; b2(2)=1;
+ % 5th order b-coefficients
+ b3(1)=1/6; b3(2)=2/3; b3(3)=1/6;
+ for i=1:3
+  c(i)=sum(a(i,:));
+ end
+
+% Initialization
+t0 = tspan(1);
+tfinal = tspan(2);
+t = t0;
+hmax = (tfinal - t)/2.5;
+hmin = (tfinal - t)/1e12;
+h = (tfinal - t)/200; % initial guess at a step size
+x = x0(:);            % this always creates a column vector, x
+tout = t;             % first output time
+xout = x.';           % first output solution
+
+if count==1,
+ global rhs_counter
+ if ~exist('rhs_counter'),rhs_counter=0; end
+end % if count
+
+if trace
+ clc, t, h, x
+end
+
+% The main loop
+   while (t < tfinal) & (h >= hmin)
+      if t + h > tfinal, h = tfinal - t; end
+
+      % compute the slopes
+      if (ode_fcn_format==0),
+       k(:,1)=feval(F,t,x);
+       k(:,2)=feval(F,t+c(2)*h,x+h*(a(2,1)*k(:,1)));
+       k(:,3)=feval(F,t+c(3)*h,x+h*(a(3,1)*k(:,1)+a(3,2)*k(:,2)));
+      else,
+       k(:,1)=feval(F,x,t);
+       k(:,2)=feval(F,x+h*(a(2,1)*k(:,1)),t+c(2)*h);
+       k(:,3)=feval(F,x+h*(a(3,1)*k(:,1)+a(3,2)*k(:,2)),t+c(3)*h);
+      end % if (ode_fcn_format==0)
+
+      % increment rhs_counter
+      if count==1,
+       rhs_counter = rhs_counter + 3;
+      end % if
+
+      % compute the 2nd order estimate
+      x2=x + h*b2(2)*k(:,2);
+      % compute the 3rd order estimate
+      x3=x + h*(b3(1)*k(:,1) + b3(2)*k(:,2) + b3(3)*k(:,3));
+
+      % estimate the local truncation error
+      gamma1 = x3 - x2;
+
+      % Estimate the error and the acceptable error
+      delta = norm(gamma1,'inf');
+      tau = tol*max(norm(x,'inf'),1.0);
+
+      % Update the solution only if the error is acceptable
+      if delta <= tau
+         t = t + h;
+         x = x3;    % <-- using the higher order estimate is called 'local extrapolation'
+         tout = [tout; t];
+         xout = [xout; x.'];
+      end
+      if trace
+         home, t, h, x
+      end
+
+      % Update the step size
+      if delta == 0.0
+       delta = 1e-16;
+      end
+      h = min(hmax, 0.8*h*(tau/delta)^pow);
+
+   end;
+
+   if (t < tfinal)
+      disp('Step size grew too small.')
+      t, h, x
+   end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ode/ode45.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,168 @@
+function [tout, xout] = ode45(F,tspan,x0,ode_fcn_format,tol,trace,count)
+
+% Copyright (C) 2000 Marc Compere
+% This file is intended for use with Octave.
+% ode45.m is free software; you can redistribute it and/or modify it
+% under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2, or (at your option)
+% any later version.
+%
+% ode45.m is distributed in the hope that it will be useful, but
+% WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+% General Public License for more details at www.gnu.org/copyleft/gpl.html.
+%
+% --------------------------------------------------------------------
+%
+% ode45 (v1.07) integrates a system of ordinary differential equations using
+% 4th & 5th order embedded Runge-Kutta-Fehlberg formulas.
+% This requires 6 function evaluations per integration step.
+% This particular implementation uses the 5th order estimate for xout, although
+% the truncation error is of order(h^4), therefore this method, overall is
+% a 4th-order method.
+%
+% The Fehlberg 4(5) coefficients are from a tableu in
+% U.M. Ascher, L.R. Petzold, Computer Methods for  Ordinary Differential Equations
+% and Differential-Agebraic Equations, Society for Industrial and Applied Mathematics
+% (SIAM), Philadelphia, 1998
+%
+% The error estimate formula and slopes are from
+% Numerical Methods for Engineers, 2nd Ed., Chappra & Cannle, McGraw-Hill, 1985
+%
+% Usage:
+%         [tout, xout] = ode45(F, tspan, x0, ode_fcn_format, tol, trace, count)
+%
+% INPUT:
+% F     - String containing name of user-supplied problem description.
+%         Call: xprime = fun(t,x) where F = 'fun'.
+%         t      - Time (scalar).
+%         x      - Solution column-vector.
+%         xprime - Returned derivative COLUMN-vector; xprime(i) = dx(i)/dt.
+% tspan - [ tstart, tfinal ]
+% x0    - Initial value COLUMN-vector.
+% ode_fcn_format - this specifies if the user-defined ode function is in
+%         the form:     xprime = fun(t,x)   (ode_fcn_format=0, default)
+%         or:           xprime = fun(x,t)   (ode_fcn_format=1)
+%         Matlab's solvers comply with ode_fcn_format=0 while
+%         Octave's lsode() and sdirk4() solvers comply with ode_fcn_format=1.
+% tol   - The desired accuracy. (optional, default: tol = 1.e-6).
+% trace - If nonzero, each step is printed. (optional, default: trace = 0).
+% count - if nonzero, variable 'rhs_counter' is initalized, made global
+%         and counts the number of state-dot function evaluations
+%         'rhs_counter' is incremented in here, not in the state-dot file
+%         simply make 'rhs_counter' global in the file that calls ode45
+%
+% OUTPUT:
+% tout  - Returned integration time points (column-vector).
+% xout  - Returned solution, one solution column-vector per tout-value.
+%
+% The result can be displayed by: plot(tout, xout).
+%
+% Marc Compere
+% compere@mail.utexas.edu
+% created : 06 October 1999
+% modified: 15 May 2000
+
+if nargin < 7, count = 0; end
+if nargin < 6, trace = 0; end
+if nargin < 5, tol = 1.e-6; end
+if nargin < 4, ode_fcn_format = 0; end
+
+pow = 1/8;
+
+% The Fehlberg 4(5) coefficients:
+ a_(1,1)=0;
+ a_(2,1)=1/4;
+ a_(3,1)=3/32; a_(3,2)=9/32;
+ a_(4,1)=1932/2197; a_(4,2)=-7200/2197; a_(4,3)=7296/2197;
+ a_(5,1)=439/216; a_(5,2)=-8; a_(5,3)=3680/513; a_(5,4)=-845/4104; 
+ a_(6,1)=-8/27; a_(6,2)=2; a_(6,3)=-3544/2565; a_(6,4)=1859/4104; a_(6,5)=-11/40; 
+ % 4th order b-coefficients
+ b4_(1)=25/216; b4_(2)=0; b4_(3)=1408/2565; b4_(4)=2197/4104; b4_(5)=-1/5;
+ % 5th order b-coefficients
+ b5_(1)=16/135; b5_(2)=0; b5_(3)=6656/12825; b5_(4)=28561/56430; b5_(5)=-9/50; b5_(6)=2/55;
+ for i=1:6
+  c_(i)=sum(a_(i,:));
+ end
+
+% Initialization
+t0 = tspan(1);
+tfinal = tspan(2);
+t = t0;
+hmax = (tfinal - t)/2.5;
+hmin = (tfinal - t)/1e9;
+h = (tfinal - t)/100; % initial guess at a step size
+x = x0(:);            % this always creates a column vector, x
+tout = t;             % first output time
+xout = x.';           % first output solution
+
+if count==1,
+ global rhs_counter
+ if ~exist('rhs_counter'),rhs_counter=0; end
+end % if count
+
+if trace
+ clc, t, h, x
+end
+
+% The main loop
+   while (t < tfinal) & (h >= hmin)
+      if t + h > tfinal, h = tfinal - t; end
+
+      % compute the slopes
+      if (ode_fcn_format==0),
+       k_(:,1)=feval(F,t,x);
+       k_(:,2)=feval(F,t+c_(2)*h,x+h*(a_(2,1)*k_(:,1)));
+       k_(:,3)=feval(F,t+c_(3)*h,x+h*(a_(3,1)*k_(:,1)+a_(3,2)*k_(:,2)));
+       k_(:,4)=feval(F,t+c_(4)*h,x+h*(a_(4,1)*k_(:,1)+a_(4,2)*k_(:,2)+a_(4,3)*k_(:,3)));
+       k_(:,5)=feval(F,t+c_(5)*h,x+h*(a_(5,1)*k_(:,1)+a_(5,2)*k_(:,2)+a_(5,3)*k_(:,3)+a_(5,4)*k_(:,4)));
+       k_(:,6)=feval(F,t+c_(6)*h,x+h*(a_(6,1)*k_(:,1)+a_(6,2)*k_(:,2)+a_(6,3)*k_(:,3)+a_(6,4)*k_(:,4)+a_(6,5)*k_(:,5)));
+      else,
+       k_(:,1)=feval(F,x,t);
+       k_(:,2)=feval(F,x+h*(a_(2,1)*k_(:,1)),t+c_(2)*h);
+       k_(:,3)=feval(F,x+h*(a_(3,1)*k_(:,1)+a_(3,2)*k_(:,2)),t+c_(3)*h);
+       k_(:,4)=feval(F,x+h*(a_(4,1)*k_(:,1)+a_(4,2)*k_(:,2)+a_(4,3)*k_(:,3)),t+c_(4)*h);
+       k_(:,5)=feval(F,x+h*(a_(5,1)*k_(:,1)+a_(5,2)*k_(:,2)+a_(5,3)*k_(:,3)+a_(5,4)*k_(:,4)),t+c_(5)*h);
+       k_(:,6)=feval(F,x+h*(a_(6,1)*k_(:,1)+a_(6,2)*k_(:,2)+a_(6,3)*k_(:,3)+a_(6,4)*k_(:,4)+a_(6,5)*k_(:,5)),t+c_(6)*h);
+      end % if (ode_fcn_format==0)
+
+      % increment rhs_counter
+      if count==1,
+       rhs_counter = rhs_counter + 6;
+      end % if
+
+      % compute the 4th order estimate
+      x4=x + h*(b4_(1)*k_(:,1) + b4_(3)*k_(:,3) + b4_(4)*k_(:,4) + b4_(5)*k_(:,5));
+      % compute the 5th order estimate
+      x5=x + h*(b5_(1)*k_(:,1) + b5_(3)*k_(:,3) + b5_(4)*k_(:,4) + b5_(5)*k_(:,5) + b5_(6)*k_(:,6));
+
+      % estimate the local truncation error
+      gamma1 = x5 - x4;
+
+      % Estimate the error and the acceptable error
+      delta = norm(gamma1,'inf');       % actual error
+      tau = tol*max(norm(x,'inf'),1.0); % allowable error
+
+      % Update the solution only if the error is acceptable
+      if delta <= tau
+         t = t + h;
+         x = x5;    % <-- using the higher order estimate is called 'local extrapolation'
+         tout = [tout; t];
+         xout = [xout; x.'];
+      end
+      if trace
+         home, t, h, x
+      end
+
+      % Update the step size
+      if delta == 0.0
+       delta = 1e-16;
+      end
+      h = min(hmax, 0.8*h*(tau/delta)^pow);
+
+   end;
+
+   if (t < tfinal)
+      disp('Step size grew too small.')
+      t, h, x
+   end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ode/ode78.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,177 @@
+function [tout, xout] = ode78(F,tspan,x0,ode_fcn_format,tol,trace,count)
+
+% Copyright (C) 2000 Marc Compere
+% This file is intended for use with Octave.
+% ode78.m is free software; you can redistribute it and/or modify it
+% under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2, or (at your option)
+% any later version.
+%
+% ode78.m is distributed in the hope that it will be useful, but
+% WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+% General Public License for more details at www.gnu.org/copyleft/gpl.html.
+%
+% --------------------------------------------------------------------
+%
+% ode78 (v1.07) Integrates a system of ordinary differential equations using
+% 7th order formulas.
+% This particular implementation uses the 8th order estimate for xout, which
+% is called 'local extrapolation'.  The truncation error, gamma1, is of order(h^8).
+% Therefore this method, overall is a 7th-order method.
+% This requires 13 function evaluations per integration step.
+%
+% More may be found in the original author's text containing numerous
+% applications on ordinary and partial differential equations using Matlab:
+%
+%     Howard Wilson and Louis Turcotte, 'Advanced Mathematics and 
+%     Mechanics Applications Using MATLAB', 2nd Ed, CRC Press, 1997
+%
+%
+% [tout, xout] = ode78(F, tspan, x0, ode_fcn_format, tol, trace, count)
+%
+% INPUT:
+% F     - String containing name of user-supplied problem description.
+%         Call: xprime = fun(t,x) where F = 'fun'.
+%         t      - Time (scalar).
+%         x      - Solution column-vector.
+%         xprime - Returned derivative COLUMN-vector; xprime(i) = dx(i)/dt.
+% tspan - [ tstart, tfinal ]
+% x0    - Initial value COLUMN-vector.
+% ode_fcn_format - this specifies if the user-defined ode function is in
+%         the form:     xprime = fun(t,x)   (ode_fcn_format=0, default)
+%         or:           xprime = fun(x,t)   (ode_fcn_format=1)
+%         Matlab's solvers comply with ode_fcn_format=0 while
+%         Octave's lsode() and sdirk4() solvers comply with ode_fcn_format=1.
+% tol   - The desired accuracy. (optional, default: tol = 1.e-6).
+% trace - If nonzero, each step is printed. (optional, default: trace = 0).
+% count - if nonzero, variable 'rhs_counter' is initalized, made global
+%         and counts the number of state-dot function evaluations
+%         'rhs_counter' is incremented in here, not in the state-dot file
+%         simply make 'rhs_counter' global in the file that calls ode78
+%
+% OUTPUT:
+% tout  - Returned integration time points (row-vector).
+% xout  - Returned solution, one solution column-vector per tout-value.
+%
+% The result can be displayed by: plot(tout, xout).
+
+%   Daljeet Singh & Howard Wilson
+%   Dept. Of Electrical Engg., The University of Alabama.
+%   11-24-1988.
+%
+% modified by:
+% Marc Compere
+% compere@mail.utexas.edu
+% created : 06 October 1999
+% modified: 15 May 2000
+
+
+% The Fehlberg coefficients:
+alpha_ = [ 2./27. 1/9 1/6 5/12 .5 5/6 1/6 2/3 1/3 1 0 1 ]';
+beta_ = [ [  2/27  0  0   0   0  0  0  0  0  0  0   0  0  ]
+[  1/36 1/12  0  0  0  0  0  0   0  0  0  0  0  ]
+[  1/24  0  1/8  0  0  0  0  0  0  0  0  0  0 ]
+[  5/12  0  -25/16  25/16  0  0  0  0  0  0   0  0  0  ]
+[ .05   0  0  .25  .2  0  0  0  0  0  0  0  0 ]
+[ -25/108  0  0  125/108  -65/27  125/54  0  0  0  0  0  0   0  ]
+[ 31/300  0  0  0  61/225  -2/9  13/900  0  0  0   0  0  0  ]
+[ 2  0  0  -53/6  704/45  -107/9  67/90  3  0  0  0  0  0  ]
+[ -91/108  0  0  23/108  -976/135  311/54  -19/60  17/6  -1/12  0  0  0  0 ]
+[2383/4100 0 0 -341/164 4496/1025 -301/82 2133/4100 45/82 45/164 18/41 0 0 0]
+[ 3/205  0   0  0   0    -6/41  -3/205   -3/41     3/41   6/41   0   0  0 ]
+[-1777/4100 0 0 -341/164 4496/1025 -289/82 2193/4100 ...
+51/82 33/164 12/41 0 1 0]...
+]';
+ chi_ = [ 0 0 0 0 0 34/105 9/35 9/35 9/280 9/280 0 41/840 41/840]';
+ psi_ = [1  0  0  0  0  0  0  0  0  0  1 -1  -1 ]';
+pow = 1/8;
+
+if nargin < 7, count = 0; end
+if nargin < 6, trace = 0; end
+if nargin < 5, tol = 1.e-6; end
+if nargin < 4, ode_fcn_format = 0; end
+
+% Initialization
+t0 = tspan(1);
+tfinal = tspan(2);
+t = t0;
+% the following step parameters are used in ODE45
+% hmax = (tfinal - t)/5;
+% hmin = (tfinal - t)/20000;
+% h = (tfinal - t)/100;
+% The following parameters were taken because the integrator has
+% higher order than ODE45. This choice is somewhat subjective.
+hmax = (tfinal - t)/2.5;
+%hmin = (tfinal - t)/10000;
+hmin = (tfinal - t)/1000000000;
+h = (tfinal - t)/50;
+x = x0(:);          % the '(:)' ensures x is initialized as a column vector
+f = x*zeros(1,13);  % f needs to be an Nx13 matrix where N=number of cols in x
+tout = t;
+xout = x.';
+tau = tol * max(norm(x, 'inf'), 1);
+
+if count==1,
+ global rhs_counter
+ if ~exist('rhs_counter'),rhs_counter=0;,end
+end % if count
+
+if trace
+%  clc, t, h, x
+   clc, t, x
+end
+% The main loop
+   while (t < tfinal) & (h >= hmin)
+      if t + h > tfinal, h = tfinal - t; end
+
+      % Compute the slopes
+      if (ode_fcn_format==0),
+       f(:,1) = feval(F,t,x);
+       for j = 1: 12
+          f(:,j+1) = feval(F, t+alpha_(j)*h, x+h*f*beta_(:,j));
+       end
+      else,
+       f(:,1) = feval(F,x,t);
+       for j = 1: 12
+          f(:,j+1) = feval(F, x+h*f*beta_(:,j), t+alpha_(j)*h);
+       end
+      end %  if (ode_fcn_format==0)
+
+
+      % increment rhs_counter
+      if count==1,
+       rhs_counter = rhs_counter + 13;
+      end % if
+
+      % Truncation error term
+      gamma1 = h*41/840*f*psi_;
+
+      % Estimate the error and the acceptable error
+      delta = norm(gamma1,'inf');
+      tau = tol*max(norm(x,'inf'),1.0);
+
+      % Update the solution only if the error is acceptable
+      if delta <= tau
+         t = t + h;
+         x = x + h*f*chi_;  % this integrator uses local extrapolation
+         tout = [tout; t];
+         xout = [xout; x.'];
+      end
+      if trace
+         home, t, h, x
+%        home, t, x
+      end
+
+      % Update the step size
+      if delta == 0.0
+       delta = 1e-16;
+      end
+      h = min(hmax, 0.8*h*(tau/delta)^pow);
+
+   end;
+
+   if (t < tfinal)
+      disp('SINGULARITY LIKELY.')
+      t
+   end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ode/penddot.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,56 @@
+function zdot=penddot(t,z)
+
+% Copyright (C) 2000 Marc Compere
+% This file is intended for use with Octave.
+% penddot.m is free software; you can redistribute it and/or modify it
+% under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2, or (at your option)
+% any later version.
+%
+% penddot.m is distributed in the hope that it will be useful, but
+% WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+% General Public License for more details at www.gnu.org/copyleft/gpl.html.
+%
+% --------------------------------------------------------------------
+%
+% This is an example derivative function file that works
+% with Octave or Matlab.
+% The equations represent motion of a simple pendulum with damping.
+%
+% The plots created by pendulum.m show the angular position and velocity
+% trajectories created by each different integrator.
+% Position is the trace that reaches steady state at -pi/2
+% because of the gravity term, -m*g*l/2*cos(z(1)).
+% Velocity reaches a steady state of zero because of the
+% damping term, -b*z(2).
+%
+% Use ode45 to integrate these ODE's
+% like this:
+%    [t,z] = ode45('penddot',tspan,IC);
+%
+% z is the state column vector and meant to be used only within this m-file
+% This function is meant to return the derivatives of the state variable
+% given the state vector and time.
+%
+% Structure:	zdot = [ z1dot, z2dot, ... zNdot ]'
+%
+% eg.  ml^2*thetadd + b*thetad + m*g*l*sin(theta) = 0
+%
+%	z(1) = theta
+%	z(2) = thetad 	( = z(1)dot )
+%
+% Convention: the lowest order states are first columnwise
+%
+% Marc Compere
+% compere@mail.utexas.edu
+% created : 06 October 1999
+% modified: 15 May 2000
+
+global m g l b counter index
+
+zdot=[ z(2) , 1/(1/3*m*l^2)*(-b*z(2)-m*g*l/2*cos(z(1)))]';
+
+% remember to return a column vector
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ode/pendulum.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,145 @@
+% Copyright (C) 2000 Marc Compere
+% This file is intended for use with Octave.
+% pendulum.m is free software; you can redistribute it and/or modify it
+% under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2, or (at your option)
+% any later version.
+%
+% pendulum.m is distributed in the hope that it will be useful, but
+% WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+% General Public License for more details at www.gnu.org/copyleft/gpl.html.
+%
+% --------------------------------------------------------------------
+%
+% This integrates a set of ordinary differential equations (ODE) using 6 different
+% ODE solvers.  The equations represent the dynamics of a simple pendulum.
+%
+% The integrators ode78.m, ode45.m, ode23.m, rk8fixed.m, rk4fixed.m, and rk2fixed.m
+% all produce column vector output similar to Matlab.
+%
+% All integrators work in octave 2.1.24 and Matlab 5.3 with no modification.
+%
+% Marc Compere
+% compere@mail.utexas.edu
+% created : 06 October 1999
+% modified: 15 May 2000
+
+clear
+
+% allow global access to the parameters m, g, l, & b:
+global m g l b rhs_counter
+
+m=1;    % (kg)
+g=9.81; % (m/s^2)
+l=1.;   % (m)
+b=2.;   % ((N-s)/m))
+
+% integrator setup:
+trace = 0;   % this is a (1/0) flag that puts output to the screen or not
+count = 1;   % this is a (1/0) flag that causes rk4fixed to increment 'rhs_counter' or not
+rhs_counter = 0; % 'rhs_counter' is the number of right-hand-side function evaluations, z_dot=f(z)
+ode_fcn_format = 0; % 0 chooses Matlab-format right-hand-side function definitions
+                    % xdot=f(t,x), or Octave's lsode format, xdot=f(x,t)
+t0=0;
+tfinal = 5; % (seconds)
+tspan = [t0,tfinal];
+% Initial Conditions: theta(t=0)=30(deg) & initially at rest
+IC = [ 30*pi/180 0]'; % (rad), (rad/s)
+sps = 100;            % sps -> step per second
+Nsteps=(tfinal-t0)*sps;    % this creates sps number of integration steps per second
+tolerance = 1e-3;
+
+% Solve the ODE specified in penddot.m using each of the 6 m-file integrators.
+
+t_begin_calcs=cputime;
+
+   disp('Integrating using rk2fixed...')
+   [t1,zrk2fixed] = rk2fixed('penddot',tspan,IC,Nsteps,ode_fcn_format,trace,count);     % fixed step integration
+   rk2_counter = rhs_counter
+   rhs_counter=0;
+
+t(1)=cputime-t_begin_calcs;
+t_begin_calcs=cputime;
+
+   disp('Integrating using rk4fixed...')
+   [t2,zrk4fixed] = rk4fixed('penddot',tspan,IC,Nsteps,ode_fcn_format,trace,count);     % fixed step integration
+   rk4_counter = rhs_counter
+   rhs_counter=0;
+
+t(2)=cputime-t_begin_calcs;
+t_begin_calcs=cputime;
+
+   disp('Integrating using rk8fixed...')
+   [t3,zrk8fixed] = rk8fixed('penddot',tspan,IC,Nsteps,ode_fcn_format,trace,count);     % fixed step integration
+   rk8_counter = rhs_counter
+   rhs_counter=0;
+
+t(3)=cputime-t_begin_calcs;
+t_begin_calcs=cputime;
+
+   disp('Integrating using ode23...')
+   [t4,zode23] = ode23('penddot',tspan,IC,ode_fcn_format,tolerance,trace,count); % rk45 variable step integration
+   ode23_counter = rhs_counter
+   rhs_counter=0;
+
+t(4)=cputime-t_begin_calcs;
+t_begin_calcs=cputime;
+
+   disp('Integrating using ode45...')
+   [t5,zode45] = ode45('penddot',tspan,IC,ode_fcn_format,tolerance,trace,count); % rk45 variable step integration
+   ode45_counter = rhs_counter
+   rhs_counter=0;
+
+t(5)=cputime-t_begin_calcs;
+t_begin_calcs=cputime;
+
+   disp('Integrating using ode78...')
+   [t6,zode78] = ode78('penddot',tspan,IC,ode_fcn_format,tolerance,trace,count); % rk78 variable step integration
+   ode78_counter = rhs_counter
+   rhs_counter=0;
+
+t(6)=cputime-t_begin_calcs;
+t_begin_calcs=cputime;
+
+   %disp('Integrating using sdirk4...')
+   % Note: If you want to use sdirk4 you have to compile sdirk4.oct, then change the function definition in
+   %       penddot.m to zdot=penddot(z,t) 
+   %       Then if you want the other integrators to still work, set ode_fcn_format=1 above.
+   %skip_step=10;
+   %h_initial = 1e-3;
+   %[t7,zsdirk4] = sdirk4('penddot',IC,tspan,tolerance,0.1*tolerance,h_initial,trace,skip_step); % 4th order stiff integration
+   %sdirk4_counter = rhs_counter
+   %rhs_counter=0;
+
+t(7)=cputime-t_begin_calcs;
+
+
+
+disp('Elapsed times for each solver to integrate a pendulum:')
+t
+
+
+
+% plot that baby
+figure(1)
+clg
+if ishold~=1, hold, end
+title('Pendulum Position & Velocity')
+ylabel('Theta & Theta_dot (rad) & (rad/s)')
+xlabel('Time (s)')
+plot(t1,zrk2fixed)
+plot(t2,zrk4fixed)
+plot(t3,zrk8fixed)
+plot(t4,zode23)
+plot(t5,zode45)
+plot(t6,zode78)
+%plot(t7,zsdirk4)
+if ishold==1, hold, end
+
+
+% These plots show the angular position and velocity
+% trajectories created by each different integrator.
+% Position is the trace that reaches steady state at -pi/2.
+% Velocity reaches a steady state of zero.
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ode/readme.txt	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,124 @@
+This is the readme.txt file for Octave m-file ordinary differential
+equation (ODE) solvers, version 1.07.  They also work in Matlab.
+
+This directory contains 8 files that provide an Octave user with
+several options for numerically integrating ode.
+There are 3 fixed-step Runge-Kutta algorithms and
+3 variable step Runge-Kutta-Fehlberg algorithms.
+All are explicit RK formulas that work well with nonstiff problems.
+
+----------------------------------------------------------------------
+The archive octave_ode_solvers_v1.07.tar.gz contains 6 single-step
+Runge-Kutta ODE solvers along with 2 files demonstrating example
+uses of each solver:
+
+   - ode23.m    : variable step, 2nd-3rd order
+   - ode45.m    : variable step, 4th-5th order
+   - ode78.m    : variable step, 7th-8th order
+
+   - rk2fixed.m : fixed step, 2nd order
+   - rk4fixed.m : fixed step, 4th order
+   - rk8fixed.m : fixed step, 8th order
+
+   - pendulum.m : a sample m-file script that runs all solvers
+   - penddot.m  : derivative function file, returning dy/dt for a simple pendulum
+   - readme.txt : this file
+
+----------------------------------------------------------------------
+Steps for testing these ode solvers in Octave (version 2.0.14 or better),
+from a unix shell:
+
+(1) unzip and untar the archive:
+	gunzip ode_v1.07.tar.gz
+	tar xvf ode_v1.07.tar
+(2) change directories into the newly created directory and execute Octave:
+	cd ode_v1.07
+	octave
+(3) run the sample pemdulum script from within Octave.  This will sequentially
+    execute all 6 m-file integrators:
+	pendulum
+
+----------------------------------------------------------------------
+I've made an effort to make these portable to most Octave installations
+as well as for use in most Matlab versions.  These work with no modification
+in Matlab v5.2 & v5.3.  If you want to use these in Matlab, however,
+you'll do yourself a favor by renaming ode45.m and ode23.m to something else,
+like ode45_octave.m and ode23_octave.m.  This is because Matlab already has
+two integrators named ode45 and ode23.
+Don't forget to change the function names at the top of ode45_octave.m and
+ode23_octave.m as well.
+
+Some effort has been made to create ode45 and ode23 with similar
+argument structures to their Matlab counterparts.  Only the most basic function
+calls to ode45 and ode23 match up in both Matlab's integrators and these.
+Feel free to change them as you see fit.  You are welcome to mail me for useful
+change suggestions.
+
+----------------------------------------------------------------------
+Basic differences between the integrators:
+
+In general, the higher the integration order, the smaller the local truncation
+error is at each time step.  Small local truncation errors result in larger
+integration steps.  This is demonstrated by ode78 generating far fewer
+steps than ode23 for solving the same problem over the same time interval with
+the same error criterion.
+The cost of the higher order integrators is the number of function evaluations
+required at each step.  This results in longer execution times for each integration
+step.
+The tradeoff between solving a problem with an integrator that takes fewer steps
+versus using one that takes more time for each step will vary with each problem.
+Factors such as the degree of numerical stiffness or the number of discontinuities
+will somteimes cause ode23 to be more effective than ode78, & vice-versa.
+
+Integrator costs in right-hand-side (RHS) evaluations:
+   - ode23.m    : requires 3 RHS function evaluations per step
+   - ode45.m    : requires 6 RHS function evaluations per step
+   - ode78.m    : requires 13 RHS function evaluations per step
+
+   - rk2fixed.m : requires 2 RHS function evaluations per step
+   - rk4fixed.m : requires 4 RHS function evaluations per step
+   - rk8fixed.m : requires 13 RHS function evaluations per step
+
+If you are interested in experimenting with pendulum.m, try turning on
+the 'trace' variable for screen output.  This increases execution speed
+but provides a way to monitor the problem during the integration.
+
+----------------------------------------------------------------------
+Two of the original files rk4fixed.m and ode78.m came from other
+people.
+
+rk4fixed.m was written by:
+     Dr. Raul Longoria, Dept. of Mechanical Engineering,
+     The Univ. of Texas at Austin and
+
+ode78.m was originally written by:
+     Dr. Howard Wilson & 
+     Daljeet Singh, Dept. Of Electrical Engineering,
+     The University of Alabama
+
+The other files were created from the structure of these 
+along with coefficients from standard numerical methods books.
+Dr. Longoria has given permission to redistribute rk4fixed.m.
+
+ode78.m was origianlly found at:
+ftp://ftp.mathworks.com/pub/contrib/v4/diffeq/ode78.m.
+& I am redistributing a modified version with Dr. Wilson's
+permission.  
+
+Numerous applications in ordinary and partial differential equations
+can be found in Dr. Wilson's text:
+
+     Howard Wilson and Louis Turcotte, 'Advanced Mathematics and 
+     Mechanics Applications Using MATLAB', 2nd Ed, CRC Press, 1997
+
+----------------------------------------------------------------------
+
+Bugs or changes or comments should be directed to the email address
+below.  The latest and greatest versions will generally _NOT_ be found
+on the octave-source list, but rather will be maintained  at:
+	http://marc.me.utexas.edu/tmp/octave_ode_solvers/
+
+Marc Compere
+compere@mail.utexas.edu
+created : 06 October 1999
+modified: 15 May 2000
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ode/rk2fixed.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,107 @@
+function [tout,xout] = rk2fixed(F,tspan,x0,Nsteps,ode_fcn_format,trace,count)
+
+% Copyright (C) 2000 Marc Compere
+% This file is intended for use with Octave.
+% rk2fixed.m is free software; you can redistribute it and/or modify it
+% under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2, or (at your option)
+% any later version.
+%
+% rk2fixed.m is distributed in the hope that it will be useful, but
+% WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+% General Public License for more details at www.gnu.org/copyleft/gpl.html.
+%
+% --------------------------------------------------------------------
+%
+% rk2fixed (v1.07) integrates a system of ordinary differential equations using a
+% 2nd order Runge-Kutta formula called Ralston's method.
+% This choice of 2nd order coefficients provides a minimum bound on truncation error.
+% For more, see Ralston & Rabinowitz (1978) or 
+% Numerical Methods for Engineers, 2nd Ed., Chappra & Cannle, McGraw-Hill, 1985
+%
+% rk2fixed() requires 2 function evaluations per integration step.
+%
+% Usage:
+%         [tout, xout] = rk2fixed(F, tspan, x0, Nsteps, ode_fcn_format, trace, count)
+%
+% INPUT:
+% F      - String containing name of user-supplied problem derivatives.
+%          Call: xprime = fun(t,x) where F = 'fun'.
+%          t      - Time (scalar).
+%          x      - Solution column-vector.
+%          xprime - Returned derivative COLUMN-vector; xprime(i) = dx(i)/dt.
+% tspan  - [ tstart, tfinal ]
+% x0     - Initial value COLUMN-vector.
+% Nsteps - number of steps used to span [ tstart, tfinal ]
+% ode_fcn_format - this specifies if the user-defined ode function is in
+%          the form:     xprime = fun(t,x)   (ode_fcn_format=0, default)
+%          or:           xprime = fun(x,t)   (ode_fcn_format=1)
+%          Matlab's solvers comply with ode_fcn_format=0 while
+%          Octave's lsode() and sdirk4() solvers comply with ode_fcn_format=1.
+% trace  - If nonzero, each step is printed. (optional, default: trace = 0).
+% count  - if nonzero, variable 'rhs_counter' is initalized, made global
+%          and counts the number of state-dot function evaluations
+%          'rhs_counter' is incremented in here, not in the state-dot file
+%          simply make 'rhs_counter' global in the file that calls rk2fixed
+%
+% OUTPUT:
+% tout  - Returned integration time points (row-vector).
+% xout  - Returned solution, one solution column-vector per tout-value.
+%
+% The result can be displayed by: plot(tout, xout).
+%
+% Marc Compere
+% compere@mail.utexas.edu
+% created : 06 October 1999
+% modified: 15 May 2000
+
+if nargin < 7, count = 0; end
+if nargin < 6, trace = 0; end
+if nargin < 5, Nsteps = 400/(tspan(2)-tspan(1)); end % <-- 400 is a guess for a default,
+                                                %  try verifying the solution with rk4fixed
+if nargin < 4, ode_fcn_format = 0; end
+
+if count==1,
+ global rhs_counter
+ if ~exist('rhs_counter'),rhs_counter=0;,end
+end % if count
+
+% Initialization
+t = tspan(1);
+h = (tspan(2)-tspan(1))/Nsteps;
+xout(1,:) = x0';           
+tout(1)   = t;
+x = x0(:);
+
+if trace
+ clc, t, h, x
+end
+
+% The main loop
+h = (tspan(2)-tspan(1))/Nsteps;
+
+for i=1:Nsteps,
+     if (ode_fcn_format==0),
+      k1 = feval(F,t,x);
+      k2 = feval(F,t+3/4*h,x+3/4*h*k1);
+     else,
+      k1 = feval(F,x,t);
+      k2 = feval(F,x+3/4*h*k1,t+3/4*h);
+     end % if (ode_fcn_format==0)
+
+     % increment rhs_counter
+     if count==1,
+      rhs_counter = rhs_counter + 2;
+     end % if
+
+     t = t + h;
+     x = (x+h*(1/3*k1+2/3*k2));
+     tout = [tout; t];
+     xout = [xout; x.'];
+
+     if trace,
+      home, t, h, x
+     end
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ode/rk4fixed.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,110 @@
+function [tout,xout] = rk4fixed(F,tspan,x0,Nsteps,ode_fcn_format,trace,count)
+
+% Copyright (C) 2000 Marc Compere
+% This file is intended for use with Octave.
+% rk4fixed.m is free software; you can redistribute it and/or modify it
+% under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2, or (at your option)
+% any later version.
+%
+% rk4fixed.m is distributed in the hope that it will be useful, but
+% WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+% General Public License for more details at www.gnu.org/copyleft/gpl.html.
+%
+% --------------------------------------------------------------------
+%
+% rk4fixed (v1.07) is a 4th order Runge-Kutta numerical integration routine.
+% It requires 4 function evaluations per step.
+%
+% Usage:
+%         [tout, xout] = rk4fixed(F, tspan, x0, Nsteps, ode_fcn_format, trace, count)
+%
+% INPUT:
+% F      - String containing name of user-supplied problem derivatives.
+%          Call: xprime = fun(t,x) where F = 'fun'.
+%          t      - Time or independent variable (scalar).
+%          x      - Solution column-vector.
+%          xprime - Returned derivative COLUMN-vector; xprime(i) = dx(i)/dt.
+% tspan  - [ tstart, tfinal ]
+% x0     - Initial value COLUMN-vector.
+% Nsteps - number of steps used to span [ tstart, tfinal ]
+% ode_fcn_format - this specifies if the user-defined ode function is in
+%          the form:     xprime = fun(t,x)   (ode_fcn_format=0, default)
+%          or:           xprime = fun(x,t)   (ode_fcn_format=1)
+%          Matlab's solvers comply with ode_fcn_format=0 while
+%          Octave's lsode() and sdirk4() solvers comply with ode_fcn_format=1.
+% trace  - If nonzero, each step is printed. (optional, default: trace = 0).
+% count  - if nonzero, variable 'rhs_counter' is initalized, made global
+%          and counts the number of state-dot function evaluations
+%          'rhs_counter' is incremented in here, not in the state-dot file
+%          simply make 'rhs_counter' global in the file that calls rk4fixed
+%
+% OUTPUT:
+% tout  - Returned integration time points (row-vector).
+% xout  - Returned solution, one solution column-vector per tout-value.
+%
+% The result can be displayed by: plot(tout, xout).
+%
+% Marc Compere
+% compere@mail.utexas.edu
+% created : 06 October 1999
+% modified: 15 May 2000
+
+if nargin < 7, count = 0; end
+if nargin < 6, trace = 0; end
+if nargin < 5, Nsteps = 100/(tspan(2)-tspan(1)); end % <-- 100 is a guess for a default,
+                                                %  try verifying the solution with rk8fixed
+if nargin < 4, ode_fcn_format = 0; end
+
+if count==1,
+ global rhs_counter
+ if ~exist('rhs_counter'),rhs_counter=0;,end
+end % if count
+
+% Initialization
+t = tspan(1);
+h = (tspan(2)-tspan(1))/Nsteps;
+xout(1,:) = x0';
+tout(1) = t;
+x = x0(:);
+halfh = 0.5*h;
+
+for i=1:Nsteps,
+     if (ode_fcn_format==0),
+      RK1 = feval(F,t,x);
+      thalf = t+halfh;
+      xtemp = x+halfh*RK1;
+      RK2 = feval(F,thalf,xtemp);
+      xtemp = x+halfh*RK2;
+      RK3 = feval(F,thalf,xtemp);
+      tfull = t+h;
+      xtemp = x+h*RK3;
+      RK4 = feval(F,tfull,xtemp);
+     else,
+      RK1 = feval(F,x,t);
+      thalf = t+halfh;
+      xtemp = x+halfh*RK1;
+      RK2 = feval(F,xtemp,thalf);
+      xtemp = x+halfh*RK2;
+      RK3 = feval(F,xtemp,thalf);
+      tfull = t+h;
+      xtemp = x+h*RK3;
+      RK4 = feval(F,xtemp,tfull);
+     end % if (ode_fcn_format==0)
+
+     % increment rhs_counter
+     if count==1,
+      rhs_counter = rhs_counter + 4;
+     end % if
+
+     t = t + h;
+     x = (x+h/6*(RK1+2.0*(RK2+RK3)+RK4));
+     tout = [tout; t];
+     xout = [xout; x.'];
+
+     if trace,
+      home, t, h, x
+     end
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ode/rk8fixed.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,121 @@
+function [tout,xout] = rk8fixed(F,tspan,x0,Nsteps,ode_fcn_format,trace,count)
+
+% Copyright (C) 2000 Marc Compere
+% This file is intended for use with Octave.
+% rk8fixed.m is free software; you can redistribute it and/or modify it
+% under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2, or (at your option)
+% any later version.
+%
+% rk8fixed.m is distributed in the hope that it will be useful, but
+% WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+% General Public License for more details at www.gnu.org/copyleft/gpl.html.
+%
+% --------------------------------------------------------------------
+%
+% rk8fixed (v1.07) is an 8th order Runge-Kutta numerical integration routine.
+% It requires 13 function evaluations per step.  This is not the most
+% efficient 8th order implementation.  It was just the easiest to put
+% together as a variant from ode78.m.
+%
+% Usage:
+%         [tout, xout] = rk8fixed(F, tspan, x0, Nsteps, ode_fcn_format, trace, count)
+%
+% INPUT:
+% F      - String containing name of user-supplied problem derivatives.
+%          Call: xprime = fun(t,x) where F = 'fun'.
+%          t      - Time or independent variable (scalar).
+%          x      - Solution column-vector.
+%          xprime - Returned derivative COLUMN-vector; xprime(i) = dx(i)/dt.
+% tspan  - [ tstart, tfinal ]
+% x0     - Initial value COLUMN-vector.
+% Nsteps - number of steps used to span [ tstart, tfinal ]
+% ode_fcn_format - this specifies if the user-defined ode function is in
+%          the form:     xprime = fun(t,x)   (ode_fcn_format=0, default)
+%          or:           xprime = fun(x,t)   (ode_fcn_format=1)
+%          Matlab's solvers comply with ode_fcn_format=0 while
+%          Octave's lsode() and sdirk4() solvers comply with ode_fcn_format=1.
+% trace  - If nonzero, each step is printed. (optional, default: trace = 0).
+% count  - if nonzero, variable 'rhs_counter' is initalized, made global
+%          and counts the number of state-dot function evaluations
+%          'rhs_counter' is incremented in here, not in the state-dot file
+%          simply make 'rhs_counter' global in the file that calls rk4fixed
+%
+% OUTPUT:
+% tout  - Returned integration time points (row-vector).
+% xout  - Returned solution, one solution column-vector per tout-value.
+%
+% The result can be displayed by: plot(tout, xout).
+%
+% Marc Compere
+% compere@mail.utexas.edu
+% created : 06 October 1999
+% modified: 15 May 2000
+
+if nargin < 7, count = 0; end
+if nargin < 6, trace = 0; end
+if nargin < 5, Nsteps = 50/(tspan(2)-tspan(1)); end % <-- 50 is a guess for a default,
+                                                %  try verifying the solution with ode78
+if nargin < 4, ode_fcn_format = 0; end
+
+if count==1,
+ global rhs_counter
+ if ~exist('rhs_counter'),rhs_counter=0;,end
+end % if count
+
+alpha_ = [ 2./27. 1/9 1/6 5/12 .5 5/6 1/6 2/3 1/3 1 0 1 ]';
+beta_ = [ [  2/27  0  0   0   0  0  0  0  0  0  0   0  0  ]
+[  1/36 1/12  0  0  0  0  0  0   0  0  0  0  0  ]
+[  1/24  0  1/8  0  0  0  0  0  0  0  0  0  0 ]
+[  5/12  0  -25/16  25/16  0  0  0  0  0  0   0  0  0  ]
+[ .05   0  0  .25  .2  0  0  0  0  0  0  0  0 ]
+[ -25/108  0  0  125/108  -65/27  125/54  0  0  0  0  0  0   0  ]
+[ 31/300  0  0  0  61/225  -2/9  13/900  0  0  0   0  0  0  ]
+[ 2  0  0  -53/6  704/45  -107/9  67/90  3  0  0  0  0  0  ]
+[ -91/108  0  0  23/108  -976/135  311/54  -19/60  17/6  -1/12  0  0  0  0 ]
+[2383/4100 0 0 -341/164 4496/1025 -301/82 2133/4100 45/82 45/164 18/41 0 0 0]
+[ 3/205  0   0  0   0    -6/41  -3/205   -3/41     3/41   6/41   0   0  0 ]
+[-1777/4100 0 0 -341/164 4496/1025 -289/82 2193/4100 ...
+51/82 33/164 12/41 0 1 0]...
+]';
+chi_ = [ 0 0 0 0 0 34/105 9/35 9/35 9/280 9/280 0 41/840 41/840]';
+
+% Initialization
+t = tspan(1);
+h = (tspan(2)-tspan(1))/Nsteps;
+xout(1,:) = x0';
+tout(1) = t;
+x = x0(:);
+f = x*zeros(1,13);
+
+for i=1:Nsteps,
+
+     % Compute the slopes
+     if (ode_fcn_format==0),
+      f(:,1) = feval(F,t,x);
+      for j = 1:12
+         f(:,j+1) = feval(F, t+alpha_(j)*h, x+h*f*beta_(:,j));
+      end
+     else,
+      f(:,1) = feval(F,x,t);
+      for j = 1:12
+         f(:,j+1) = feval(F, x+h*f*beta_(:,j), t+alpha_(j)*h);
+      end
+     end % if (ode_fcn_format==0)
+
+     % increment rhs_counter
+     if count==1,
+      rhs_counter = rhs_counter + 13;
+     end % if
+
+     t = t + h;
+     x = x + h*f*chi_;
+     tout = [tout; t];
+     xout = [xout; x.'];
+
+     if trace,
+      home, t, h, x
+     end
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/patches/M-v-ops-2.1.31.patch	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,365 @@
+From pkienzle@kienzle.powernet.co.uk Thu Oct 05 11:27:38 2000
+Envelope-to: pkienzle@kienzle.powernet.co.uk
+Received: from pkienzle by kienzle with local (Exim 3.12 #1 (Debian))
+	id 13h8FW-0004mU-00; Thu, 05 Oct 2000 11:27:38 +0100
+To: bug-octave@bevo.che.wisc.edu, pkienzle@kienzle.powernet.co.uk
+Subject:  M-v ops
+Message-Id: <E13h8FW-0004mU-00@kienzle>
+From: Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+Date: Thu, 05 Oct 2000 11:27:38 +0100
+Status: RO
+Content-Length: 12828
+Lines: 351
+
+To: bug-octave@bevo.che.wisc.edu
+Cc: pkienzle
+Subject: M-v ops
+
+Bug report for Octave 2.1.31 configured for %OCTAVE_CANONICAL_HOST_TYPE%
+
+Description:
+-----------
+
+Octave's element-wise binary operations .*,./,.\,+,- can be extended
+to handle the case where one of the operands is a row or column vector
+with the same length as the corresponding dimension of the matrix M.
+The vector operation is simply repeated as many times as necessary to
+match the dimensions of M.
+
+The same extension should be done for .^ (in src/xpow.cc) and for the 
+boolean and comparison operators (in mx-op-defs.h).  
+
+The same concept applies for N-dimensional matrices, with the lengths
+of each dimension of v either being 1 or matching the length of the
+corresponding dimension of M.
+
+The concept could be extended to compute outer products as well, if
+you allow M to have dimensions of length 1 while the corresponding
+dimension of v has dimension greater than 1.  I don't know if you
+would want to though.  The convenience of generating outer products
+needs to be weighed against the convenience of debugging errors in
+the shape of your vectors (e.g., when you are applying a window to
+your data, you don't want to accidentally create 1024x1024 arrays).
+
+Repeat-By:
+---------
+
+octave:6> rand(3).*[1:3]  
+error: product: nonconformant arguments (op1 is 3x3, op2 is 1x3)
+error: evaluating assignment expression near line 6, column 8
+
+Fix:
+---
+
+*** MArray2.cc	2000/10/05 09:33:32	1.1
+--- MArray2.cc	2000/10/04 08:47:13
+***************
+*** 149,158 ****
+      int b_nr = b.rows (); \
+      int b_nc = b.cols (); \
+      if (a_nr != b_nr || a_nc != b_nc) \
+!       { \
+!         gripe_nonconformant (#FCN, a_nr, a_nc, b_nr, b_nc); \
+! 	return MArray2<T> (); \
+!       } \
+      if (a_nr == 0 || a_nc == 0) \
+        return MArray2<T> (a_nr, a_nc); \
+      int l = a.length (); \
+--- 149,205 ----
+      int b_nr = b.rows (); \
+      int b_nc = b.cols (); \
+      if (a_nr != b_nr || a_nc != b_nc) \
+!       if (a_nr == b_nr && a_nc == 1) \
+!         { \
+! 	  MArray2<T> result (a_nr, b_nc); \
+!           T *r = result.fortran_vec (); \
+!           const T *x = a.data (); \
+!           const T *y = b.data (); \
+!           int k=0; \
+! 	  for (int j=0; j < b_nc; j++) \
+! 	    for (int i=0; i < a_nr; i++, k++) \
+!                r[k] = x[i] OP y[k]; \
+!           return result; \
+!         } \
+!       else if (a_nr == b_nr && b_nc == 1) \
+!         { \
+! 	  MArray2<T> result (a_nr, a_nc); \
+!           T *r = result.fortran_vec (); \
+!           const T *x = a.data (); \
+!           const T *y = b.data (); \
+!           int k=0; \
+! 	  for (int j=0; j < a_nc; j++) \
+! 	    for (int i=0; i < a_nr; i++, k++) \
+!                r[k] = x[k] OP y[i]; \
+!           return result; \
+!         } \
+!       else if (a_nc == b_nc && b_nr == 1) \
+!         { \
+! 	  MArray2<T> result (a_nr, a_nc); \
+!           T *r = result.fortran_vec (); \
+!           const T *x = a.data (); \
+!           const T *y = b.data (); \
+! 	  for (int i=0; i < a_nr; i++) \
+! 	    for (int j=0, k=i; j < a_nc; j++, k+=a_nr) \
+!                r[k] = x[k] OP y[j]; \
+!           return result; \
+!         } \
+!       else if (a_nc == b_nc && a_nr == 1) \
+!         { \
+! 	  MArray2<T> result (b_nr, a_nc); \
+!           T *r = result.fortran_vec (); \
+!           const T *x = a.data (); \
+!           const T *y = b.data (); \
+! 	  for (int i=0; i < b_nr; i++) \
+! 	    for (int j=0, k=i; j < a_nc; j++, k+=b_nr) \
+!                r[k] = x[j] OP y[k]; \
+!           return result; \
+!         } \
+!       else \
+!         { \
+!           gripe_nonconformant (#FCN, a_nr, a_nc, b_nr, b_nc); \
+! 	  return MArray2<T> (); \
+!         } \
+      if (a_nr == 0 || a_nc == 0) \
+        return MArray2<T> (a_nr, a_nc); \
+      int l = a.length (); \
+*** mx-op-defs.h	2000/10/05 09:33:32	1.1
+--- mx-op-defs.h	2000/10/04 07:41:06
+***************
+*** 23,28 ****
+--- 23,29 ----
+  #if !defined (octave_mx_op_defs_h)
+  #define octave_mx_op_defs_h 1
+  
++ #include "lo-error.h"
+  #include "mx-inlines.cc"
+  
+  #define BIN_OP_DECL(R, OP, X, Y) \
+***************
+*** 353,359 ****
+    BIN_OP_DECL (R, product,    M1, M2); \
+    BIN_OP_DECL (R, quotient,   M1, M2);
+  
+! #define MM_BIN_OP(R, OP, M1, M2, F) \
+    R \
+    OP (const M1& m1, const M2& m2) \
+    { \
+--- 354,360 ----
+    BIN_OP_DECL (R, product,    M1, M2); \
+    BIN_OP_DECL (R, quotient,   M1, M2);
+  
+! #define MM_BIN_OP(R, OP, M1, M2, F, OPSYM) \
+    R \
+    OP (const M1& m1, const M2& m2) \
+    { \
+***************
+*** 366,372 ****
+      int m2_nc = m2.cols (); \
+   \
+      if (m1_nr != m2_nr || m1_nc != m2_nc) \
+!       gripe_nonconformant (#OP, m1_nr, m1_nc, m2_nr, m2_nc); \
+      else \
+        { \
+  	r.resize (m1_nr, m1_nc); \
+--- 367,402 ----
+      int m2_nc = m2.cols (); \
+   \
+      if (m1_nr != m2_nr || m1_nc != m2_nc) \
+!       if (m1_nr == m2_nr && m1_nc == 1) \
+!         { \
+! 	  r.resize (m1_nr, m2_nc); \
+! 	  for (int j = 0; j < m2_nc; j++) \
+! 	    for (int i = 0; i < m1_nr; i++) \
+! 	      r.elem(i, j) = m1.elem(i, 0) OPSYM m2.elem(i, j); \
+!         } \
+!       else if (m1_nr == m2_nr && m2_nc == 1) \
+!         { \
+! 	  r.resize (m1_nr, m1_nc); \
+! 	  for (int j = 0; j < m1_nc; j++) \
+! 	    for (int i = 0; i < m1_nr; i++) \
+! 	      r.elem(i, j) = m1.elem(i, j) OPSYM m2.elem(i, 0); \
+!         } \
+!       else if (m1_nc == m2_nc && m2_nr == 1) \
+!         { \
+! 	  r.resize (m1_nr, m1_nc); \
+! 	  for (int j = 0; j < m1_nc; j++) \
+! 	    for (int i = 0; i < m1_nr; i++) \
+! 	      r.elem(i, j) = m1.elem(i, j) OPSYM m2.elem(0, j); \
+!         } \
+!       else if (m1_nc == m2_nc && m1_nr == 1) \
+!         { \
+! 	  r.resize (m2_nr, m1_nc); \
+! 	  for (int j = 0; j < m1_nc; j++) \
+! 	    for (int i = 0; i < m2_nr; i++) \
+! 	      r.elem(i, j) = m1.elem(0, j) OPSYM m2.elem(i, j); \
+!         } \
+!       else \
+! 	gripe_nonconformant (#OP, m1_nr, m1_nc, m2_nr, m2_nc); \
+      else \
+        { \
+  	r.resize (m1_nr, m1_nc); \
+***************
+*** 379,388 ****
+    }
+  
+  #define MM_BIN_OPS(R, M1, M2) \
+!   MM_BIN_OP (R, operator +, M1, M2, add) \
+!   MM_BIN_OP (R, operator -, M1, M2, subtract) \
+!   MM_BIN_OP (R, product,    M1, M2, multiply) \
+!   MM_BIN_OP (R, quotient,   M1, M2, divide)
+  
+  #define MM_CMP_OP_DECLS(M1, M2) \
+    CMP_OP_DECL (mx_el_lt, M1, M2); \
+--- 409,418 ----
+    }
+  
+  #define MM_BIN_OPS(R, M1, M2) \
+!   MM_BIN_OP (R, operator +, M1, M2, add, +) \
+!   MM_BIN_OP (R, operator -, M1, M2, subtract, -) \
+!   MM_BIN_OP (R, product,    M1, M2, multiply, *) \
+!   MM_BIN_OP (R, quotient,   M1, M2, divide, /)
+  
+  #define MM_CMP_OP_DECLS(M1, M2) \
+    CMP_OP_DECL (mx_el_lt, M1, M2); \
+
+
+
+Configuration (please do not edit this section):
+-----------------------------------------------
+
+uname output:     Linux kienzle 2.2.17 #1 Sun Sep 10 17:51:52 BST 2000 i586 unknown
+configure opts:   --prefix=/usr --datadir=/usr/share --libdir=/usr/lib --libexecdir=/usr/lib --infodir=/usr/share/info --mandir=/usr/share/man --with-g77 --with-fastblas --enable-dl --enable-shared --enable-lite-kernel --disable-static --host i386-linux
+Fortran compiler: g77
+FFLAGS:           -O2
+F2C:              
+F2CFLAGS:         
+FLIBS:            -lg2c -lm -L/usr/lib/gcc-lib/i386-linux/2.95.2 -lm
+CPPFLAGS:         
+INCFLAGS:         -I. -I. -I./liboctave -I./src -I./libcruft/misc  -I./glob -I./glob
+C compiler:       gcc, version 2.95.2 20000220 (Debian GNU/Linux)
+CFLAGS:           -O2
+CPICFLAG:         -fPIC
+C++ compiler:     c++, version 2.95.2 20000220 (Debian GNU/Linux)
+CXXFLAGS:         -O2
+CXXPICFLAG:       -fPIC
+LDFLAGS:          -s
+LIBFLAGS:         -L.
+RLD_FLAG:         -Xlinker -rpath -Xlinker /usr/lib/octave-2.1.31
+TERMLIBS:         -lncurses
+LIBS:             
+LEXLIB:           
+LIBPLPLOT:        
+LIBDLFCN:         
+LIBGLOB:          ./glob/glob.o ./glob/fnmatch.o
+DEFS:
+
+  -DOCTAVE_SOURCE=1 -DSEPCHAR=':' -DSEPCHAR_STR=":" -DUSE_READLINE=1
+  -D__NO_MATH_INLINES=1 -DCXX_NEW_FRIEND_TEMPLATE_DECL=1 -DHAVE_LIBM=1
+  -DHAVE_LIBZ=1 -DF77_APPEND_UNDERSCORE=1 -DOCTAVE_LITE=1 -DSIZEOF_SHORT=2
+  -DSIZEOF_INT=4 -DSIZEOF_LONG=4 -DSIZEOF_LONG_LONG=8 -DHAVE_ALLOCA_H=1
+  -DHAVE_ALLOCA=1 -DNPOS=std::string::npos -DSTDC_HEADERS=1
+  -DHAVE_DIRENT_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_SYS_WAIT_H=1
+  -DHAVE_ASSERT_H=1 -DHAVE_CURSES_H=1 -DHAVE_DLFCN_H=1 -DHAVE_FCNTL_H=1
+  -DHAVE_FLOAT_H=1 -DHAVE_FNMATCH_H=1 -DHAVE_GLOB_H=1 -DHAVE_GRP_H=1
+  -DHAVE_LIMITS_H=1 -DHAVE_MEMORY_H=1 -DHAVE_NCURSES_H=1 -DHAVE_POLL_H=1
+  -DHAVE_PWD_H=1 -DHAVE_SGTTY_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1
+  -DHAVE_SYS_IOCTL_H=1 -DHAVE_SYS_PARAM_H=1 -DHAVE_SYS_POLL_H=1
+  -DHAVE_SYS_RESOURCE_H=1 -DHAVE_SYS_SELECT_H=1 -DHAVE_SYS_STAT_H=1
+  -DHAVE_SYS_TIME_H=1 -DHAVE_SYS_TIMES_H=1 -DHAVE_SYS_TYPES_H=1
+  -DHAVE_SYS_UTSNAME_H=1 -DHAVE_TERMCAP_H=1 -DHAVE_TERMIO_H=1
+  -DHAVE_UNISTD_H=1 -DHAVE_VARARGS_H=1 -DHAVE_ATEXIT=1 -DHAVE_BCOPY=1
+  -DHAVE_BZERO=1 -DHAVE_DUP2=1 -DHAVE_ENDGRENT=1 -DHAVE_ENDPWENT=1
+  -DHAVE_EXECVP=1 -DHAVE_FCNTL=1 -DHAVE_FORK=1 -DHAVE_GETCWD=1
+  -DHAVE_GETEGID=1 -DHAVE_GETEUID=1 -DHAVE_GETGID=1 -DHAVE_GETGRENT=1
+  -DHAVE_GETGRGID=1 -DHAVE_GETGRNAM=1 -DHAVE_GETHOSTNAME=1 -DHAVE_GETPGRP=1
+  -DHAVE_GETPID=1 -DHAVE_GETPPID=1 -DHAVE_GETPWENT=1 -DHAVE_GETPWNAM=1
+  -DHAVE_GETPWUID=1 -DHAVE_GETTIMEOFDAY=1 -DHAVE_GETUID=1 -DHAVE_GETWD=1
+  -DHAVE_LOCALTIME_R=1 -DHAVE_LSTAT=1 -DHAVE_MEMMOVE=1 -DHAVE_MKDIR=1
+  -DHAVE_MKFIFO=1 -DHAVE_ON_EXIT=1 -DHAVE_PIPE=1 -DHAVE_POLL=1
+  -DHAVE_PUTENV=1 -DHAVE_RENAME=1 -DHAVE_RINDEX=1 -DHAVE_RMDIR=1
+  -DHAVE_SELECT=1 -DHAVE_SETGRENT=1 -DHAVE_SETPWENT=1 -DHAVE_SETVBUF=1
+  -DHAVE_SIGACTION=1 -DHAVE_SIGPENDING=1 -DHAVE_SIGPROCMASK=1
+  -DHAVE_SIGSUSPEND=1 -DHAVE_STAT=1 -DHAVE_STRCASECMP=1 -DHAVE_STRDUP=1
+  -DHAVE_STRERROR=1 -DHAVE_STRFTIME=1 -DHAVE_STRNCASECMP=1
+  -DHAVE_STRPTIME=1 -DHAVE_TEMPNAM=1 -DHAVE_UMASK=1 -DHAVE_UNLINK=1
+  -DHAVE_USLEEP=1 -DHAVE_VFPRINTF=1 -DHAVE_VSPRINTF=1 -DHAVE_VSNPRINTF=1
+  -DHAVE_WAITPID=1 -DHAVE_LIBDL=1 -DHAVE_DLOPEN=1 -DHAVE_DLSYM=1
+  -DHAVE_DLERROR=1 -DHAVE_DLCLOSE=1 -DWITH_DL=1 -DWITH_DYNAMIC_LINKING=1
+  -DHAVE_TIMEVAL=1 -DHAVE_FINITE=1 -DHAVE_ISNAN=1 -DHAVE_ISINF=1
+  -DHAVE_ACOSH=1 -DHAVE_ASINH=1 -DHAVE_ATANH=1 -DHAVE_ERF=1 -DHAVE_ERFC=1
+  -DHAVE_ST_BLKSIZE=1 -DHAVE_ST_BLOCKS=1 -DHAVE_ST_RDEV=1 -DHAVE_TM_ZONE=1
+  -DHAVE_GR_PASSWD=1 -DEXCEPTION_IN_MATH=1 -DRETSIGTYPE=void
+  -DSYS_SIGLIST_DECLARED=1 -DHAVE_SYS_SIGLIST=1 -DHAVE_POSIX_SIGNALS=1
+  -DHAVE_GETRUSAGE=1 -DHAVE_TIMES=1 -DGNUPLOT_HAS_MULTIPLOT=1
+  -DGNUPLOT_HAS_FRAMES=1
+
+User-preferences (please do not edit this section):
+--------------------------------------------------
+
+  EDITOR = "vi"
+  EXEC_PATH = "/home/pkienzle/octave/audio::/scratch/programs/audio/package/pipewave.1.3/bin:/scratch/programs/audio/pitch/POWERpv1.1G/bin:/home/pkienzle/pantome/bin:/home/pkienzle/sfs/bin:/home/pkienzle/bin:/usr/local/bin:/usr/bin:/bin:/usr/X11R6/bin:/usr/games"
+  IMAGEPATH = ".:/usr/local/share/octave/2.1.31/imagelib//"
+  INFO_FILE = "/usr/local/info/octave.info"
+  INFO_PROGRAM = "info"
+  LOADPATH = "/home/pkienzle/matcompat//:/home/pkienzle/octave//::/usr/lib/octave/2.1.31/oct/:/usr/share/octave/2.1.31//"
+  PAGER = "less"
+  PS1 = "\\s:\\#> "
+  PS2 = "> "
+  PS4 = "+ "
+  automatic_replot = 0
+  beep_on_error = 0
+  completion_append_char = " "
+  default_eval_print_flag = 1
+# default_global_variable_value = <no value or error in displaying it>
+  default_return_value = []
+  default_save_format = "ascii"
+  define_all_return_values = 0
+  do_fortran_indexing = 0
+  echo_executing_commands = 0
+  empty_list_elements_ok = "warn"
+  fixed_point_format = 0
+  gnuplot_binary = "gnuplot"
+  gnuplot_command_end = "\n"
+  gnuplot_command_plot = "pl"
+  gnuplot_command_replot = "rep"
+  gnuplot_command_splot = "sp"
+  gnuplot_command_title = "t"
+  gnuplot_command_using = "u"
+  gnuplot_command_with = "w"
+  gnuplot_has_frames = 1
+  gnuplot_has_multiplot = 1
+  history_file = "/home/pkienzle/.octave_hist"
+  history_size = 1024
+  ignore_function_time_stamp = "system"
+  implicit_num_to_str_ok = 0
+  implicit_str_to_num_ok = 0
+  initialize_global_variables = 0
+  max_recursion_depth = 256
+  ok_to_lose_imaginary_part = "warn"
+  output_max_field_width = 10
+  output_precision = 5
+  page_output_immediately = 0
+  page_screen_output = 1
+  prefer_column_vectors = 1
+  print_answer_id_name = 1
+  print_empty_dimensions = 1
+  print_rhs_assign_val = 0
+  propagate_empty_matrices = 1
+  resize_on_range_error = 1
+  return_last_computed_value = 0
+  save_precision = 15
+  saving_history = 1
+  silent_functions = 0
+  split_long_rows = 1
+  string_fill_char = " "
+  struct_levels_to_print = 2
+  suppress_verbose_help_message = 1
+  treat_neg_dim_as_zero = 0
+  warn_assign_as_truth_value = 1
+  warn_divide_by_zero = 1
+  warn_function_name_clash = 1
+  warn_future_time_stamp = 1
+  warn_missing_semicolon = 0
+  warn_variable_switch_label = 0
+  whitespace_in_literal_matrix = 
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/patches/cell-support-2.1.31.patch	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,966 @@
+Hi all,
+
+I've increased support for cell arrays in octave 2.1.31.  Now you can
+assign to, extend and delete from cell arrays.  Assignments must be
+from cell arrays, which means you must wrap an octave value in {}
+before assigning.  For dereferencing, I've overloaded the nth function
+from the list type.
+
+Both cell arrays and lists should use the {} dereferencing
+operator.  Support for this will be non-trivial.  The parser must be
+extended to distinguish {} indexing from [] indexing which is easy
+enough, but then every context in which they are interpreted must be
+extended to accept multi-valued rvalues.  This is done already in
+function calls with all_va_args (see pt-arg-list.cc), but this must be
+extended to all other contexts which make sense with a dereferenced
+list.
+
+Dereferencing can also be used for lvalues in Matlab.  In this case,
+you do not have wrap the value in {} before assigning, but you need to
+use {} as the indexing operator.  This will require even more work to
+support.  
+
+While implementing assignment, I noticed that =[] is an operator in
+Matlab.  That is, "x(i)=[];" deletes the ith element of x, but "y=[];
+x(i)=y;" gives a non-conformant arguments error.  Putting deletion in
+the parse.y and separating assignment from deletion would make the code
+in liboctave somewhat cleaner, and fix a hack that I needed to implement
+cell array deletion.
+
+Summary of changes:
+
+Array.h, Array.cc, Array2.cc, Array-s.cc, Array-i.cc, Array-d.cc,
+Array-ch.cc, Array-C.cc, Array-b.cc 
+	When you extend cell arrays by assignment, the missing values must
+	be filled with [] rather than 0.  I invented a template function
+	T& assign_fill_element(Array<T>&) which returns a constant with
+	which to fill the missing array elements.  The template defaults
+	to T(0), but you can override the template with your own function
+	but not instantiating the assign_fill_element function for your type.
+
+Cell.h Cell.cc
+	Cells now inherit directly from Array2.
+
+ov.cc
+	Register octave_cell
+
+ov-list.cc
+	Extend nth to dereference cell arrays as well as lists
+
+op-cell.cc
+	Copied from op-m-m.cc, then trimmed heavily
+
+ov-cell.cc, ov-cell.h
+	Use 'matrix' rather than 'cell_val' so that the code looks more
+	like the matrix code (and hopefully easier to support).
+	Use matrix assignment code more or less directly.
+
+parse.y
+	Treat the empty cell array as an empty cell array rather than
+	an empty matrix.
+
+NOTES: 
+	copy OPERATORS/op-m-m.cc to OPERATORS/op-cell.cc before applying patch
+
+	the patch will probably not apply without displacements since I did
+	the changes on top of other patches I submitted recently.
+
+Enjoy!
+
+Paul Kienzle
+pkienzle@kienzle.powernet.co.uk
+
+*** src/Cell.cc	2000/10/05 12:32:11	1.1
+--- src/Cell.cc	2000/10/19 12:04:08
+*************** Software Foundation, 59 Temple Place - S
+*** 30,49 ****
+  
+  #include "Cell.h"
+  
+- octave_allocator
+- Cell::allocator (sizeof (Cell));
+  
+! Cell
+! Cell::index (idx_vector& i) const
+! {
+!   return Cell (data.index (i));
+! }
+  
+! Cell
+! Cell::index (idx_vector& i, idx_vector& j) const
+  {
+!   return Cell (data.index (i, j));
+  }
+  
+  /*
+  ;;; Local Variables: ***
+--- 30,56 ----
+  
+  #include "Cell.h"
+  
+  
+! #include "Array.h"
+! #include "Array.cc"
+! 
+! template class Array<octave_value>;
+! 
+! template int assign (Array<octave_value>&, const Array<octave_value>&);
+  
+! #include "Array2.h"
+! #include "Array2.cc"
+! 
+! octave_value& assign_fill_element(Array<octave_value>& lhs) 
+  {
+!   static octave_value foo(Matrix(0,0));
+! 
+!   return foo; 
+  }
++ 
++ template class Array2<octave_value>;
++ 
++ template int assign (Array2<octave_value>&, const Array2<octave_value>&);
+  
+  /*
+  ;;; Local Variables: ***
+*** src/ov.cc	2000/10/05 12:32:11	1.1
+--- src/ov.cc	2000/11/04 23:08:26
+*************** install_types (void)
+*** 1537,1542 ****
+--- 1535,1541 ----
+    octave_struct::register_type ();
+    octave_file::register_type ();
+    octave_list::register_type ();
++   octave_cell::register_type ();
+    octave_all_va_args::register_type ();
+    octave_magic_colon::register_type ();
+    octave_builtin::register_type ();
+*** src/ov-cell.cc	2000/10/05 12:32:11	1.1
+--- src/ov-cell.cc	2000/10/23 09:10:27
+*************** Software Foundation, 59 Temple Place - S
+*** 36,41 ****
+--- 36,42 ----
+  #include "defun.h"
+  #include "error.h"
+  #include "ov-cell.h"
++ #include "ov-re-mat.h"
+  #include "oct-obj.h"
+  #include "unwind-prot.h"
+  #include "utils.h"
+*************** octave_cell::do_index_op (const octave_v
+*** 58,64 ****
+  	idx_vector i = idx (0).index_vector ();
+  	idx_vector j = idx (1).index_vector ();
+  
+! 	retval = cell_val.index (i, j);
+        }
+        break;
+  
+--- 59,65 ----
+  	idx_vector i = idx (0).index_vector ();
+  	idx_vector j = idx (1).index_vector ();
+  
+! 	retval = Cell (matrix.index (i, j));
+        }
+        break;
+  
+*************** octave_cell::do_index_op (const octave_v
+*** 66,77 ****
+        {
+  	idx_vector i = idx (0).index_vector ();
+  
+! 	retval = cell_val.index (i);
+        }
+        break;
+  
+      default:
+        {
+  	std::string n = type_name ();
+  
+  	error ("invalid number of indices (%d) for %s value",
+--- 67,79 ----
+        {
+  	idx_vector i = idx (0).index_vector ();
+  
+! 	retval = Cell (matrix.index (i));
+        }
+        break;
+  
+      default:
+        {
++ 
+  	std::string n = type_name ();
+  
+  	error ("invalid number of indices (%d) for %s value",
+*************** octave_cell::do_index_op (const octave_v
+*** 83,110 ****
+    return retval;
+  }
+  
+  void
+! octave_cell::assign (const octave_value_list& idx, const octave_value& rhs)
+  {
+! #if 0
+!   if (idx.length () == 1)
+      {
+!       int i = idx(0).int_value (true);
+  
+!       if (! error_state)
+! 	{
+! 	  int n = lst.length ();
+  
+! 	  if (i > 0 && (Vresize_on_range_error || i <= n))
+! 	    lst(i-1) = rhs;
+! 	  else
+! 	    error ("list index = %d out of range", i);
+! 	}
+!       else
+! 	error ("list index must be an integer");
+      }
+    else
+!     error ("lists may only be indexed by a single scalar");
+  #endif
+  }
+  
+--- 85,149 ----
+    return retval;
+  }
+  
++ #if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL)
++ extern void assign (Array2<octave_value>&, const Array2<octave_value>&);
++ #endif
++ 
+  void
+! octave_cell::assign (const octave_value_list& idx, const Cell& rhs)
+  {
+!   int len = idx.length ();
+!   
+! 
+!   switch (len)
+      {
+!     case 2:
+!       {
+! 	idx_vector i = idx (0).index_vector ();
+! 	idx_vector j = idx (1).index_vector ();
+  
+! 	matrix.set_index (i);
+! 	matrix.set_index (j);
+! 
+! 	::assign (matrix, rhs);
+!       }
+!       break;
+  
+!     case 1:
+!       {
+! 	idx_vector i = idx (0).index_vector ();
+! 
+! 	matrix.set_index (i);
+! 
+! 	::assign (matrix, rhs);
+!       }
+!       break;
+! 
+!     default:
+!       error ("invalid number of indices (%d) for indexed cell assignment",
+! 	     len);
+      }
++ }
++ 
++ 
++ void
++ octave_cell::assign (const octave_value_list& idx, const octave_value& rhs)
++ {
++   // XXX FIX ME XXX
++   // For compatibility, need to be able to delete cells by assigning
++   // them from [].  This will have nasty interactions with auto
++   // conversion between octave values and Cell(1,1), so don't do it.
++   // The proper solution is to make a new postfix operator =[], which 
++   // means delete the indexed elements.  This won't break compatibility
++   // since "y=[]; x(idx)=y;" gives an error in Matlab, but it may
++   // break some existing octave code.
++ #if 1
++   if (rhs.is_real_matrix() && rhs.rows() == 0 && rhs.columns() == 0)
++     assign(idx, Cell(0,0,rhs));
+    else
+!     error ("use {v} to assign v to a cell");
+! #else
+!   assign(idx, Cell(1,1,rhs));
+  #endif
+  }
+  
+*************** octave_cell::print_raw (std::ostream& os
+*** 119,126 ****
+  {
+    unwind_protect::begin_frame ("octave_cell_print");
+  
+!   int nr = cell_val.rows ();
+!   int nc = cell_val.columns();
+  
+    if (nr > 0 && nc > 0)
+      {
+--- 158,165 ----
+  {
+    unwind_protect::begin_frame ("octave_cell_print");
+  
+!   int nr = matrix.rows ();
+!   int nc = matrix.columns();
+  
+    if (nr > 0 && nc > 0)
+      {
+*************** octave_cell::print_raw (std::ostream& os
+*** 138,144 ****
+  	      buf << "[" << i+1 << "," << j+1 << "]" << std::ends;
+  	      const char *nm = buf.str ();
+  
+! 	      octave_value val = cell_val(i,j);
+  
+  	      val.print_with_name (os, nm);
+  
+--- 177,183 ----
+  	      buf << "[" << i+1 << "," << j+1 << "]" << std::ends;
+  	      const char *nm = buf.str ();
+  
+! 	      octave_value val = matrix(i,j);
+  
+  	      val.print_with_name (os, nm);
+  
+*** src/ov-list.cc	2000/10/05 12:32:11	1.1
+--- src/ov-list.cc	2000/10/23 11:12:48
+*************** Software Foundation, 59 Temple Place - S
+*** 37,42 ****
+--- 37,43 ----
+  #include "error.h"
+  #include "ov-list.h"
+  #include "unwind-prot.h"
++ #include "Cell.h"
+  
+  DEFINE_OCTAVE_ALLOCATOR (octave_list);
+  
+*************** DEFUN (nth, args, ,
+*** 157,190 ****
+    "-*- texinfo -*-\n\
+  @deftypefn {Built-in Function} {} nth (@var{list}, @var{n})\n\
+  Return the @var{n}-th element of @var{list}.\n\
+  @end deftypefn")
+  {
+    octave_value retval;
+! 
+!   if (args.length () == 2)
+      {
+        octave_value_list lst = args(0).list_value ();
+! 
+        if (! error_state)
+  	{
+! 	  int n = args(1).int_value (true);
+! 
+! 	  if (! error_state)
+! 	    {
+! 	      if (n > 0 && n <= lst.length ())
+! 		retval = lst(n-1);
+! 	      else
+! 		error ("nth: index = %d out of range", n);
+! 	    }
+  	  else
+! 	    error ("nth: second argument must be an integer");
+  	}
+        else
+! 	error ("nth: first argument must be a list");
+      }
+    else
+!     print_usage ("nth");
+! 
+    return retval;
+  }
+  
+--- 158,239 ----
+    "-*- texinfo -*-\n\
+  @deftypefn {Built-in Function} {} nth (@var{list}, @var{n})\n\
+  Return the @var{n}-th element of @var{list}.\n\
++ @deftypefnx {Built-in Function} {} nth (@var{cell}, @var{i}, @var{j})\n\
++ Return the @var{i,j}-th element of @var{cell}.\n\
+  @end deftypefn")
+  {
+    octave_value retval;
+!   int i=-1,j=-1;
+!   
+!   if (args.length() < 2 
+!       || (args(0).is_list() && args.length() > 2)
+!       || args.length() > 3)
+!     {
+!       print_usage ("nth");
+!       return retval;
+!     }
+!   
+!   i = args(1).int_value (true);
+!   if (error_state || i < 1)
+!     {
+!       error ("nth: second argument must be a positive integer");
+!       return retval;
+!     }
+!   
+!   if (args.length() == 3) 
+!     {
+!       j = args(2).int_value (true);
+!       if (error_state || j < 1)
+! 	{
+! 	  error ("nth: third argument must be a positive integer");
+! 	  return retval;
+! 	}
+!     }
+!   
+!   if (args(0).is_list ())
+      {
+        octave_value_list lst = args(0).list_value ();
+!       
+        if (! error_state)
+  	{
+! 	  if (i <= lst.length ())
+! 	    retval = lst(i-1);
+  	  else
+! 	    error ("nth: index = %d out of range", i);
+  	}
+        else
+! 	error ("nth: list value error");
+      }
+    else
+!     {
+!       Cell cell = args(0).cell_value ();
+!       
+!       if (! error_state)
+! 	{
+! 	  int nr = cell.rows();
+! 	  int nc = cell.columns();
+! 	  
+! 	  if (j == -1) 
+! 	    if (nr == 1)
+! 	      if (i <= nc)
+! 		retval = cell(0,i-1);
+! 	      else
+! 		error ("nth: index = %d out of range", i);
+! 	    else if (nc == 1)
+! 	      if (i <= nr)
+! 		retval = cell(i-1,0);
+! 	      else
+! 		error ("nth: index = %d out of range", i);
+! 	    else
+! 	      error ("nth: single index not valid for 2-D cell array");
+! 	  else if (i <= nr && j <= nc)
+! 	    retval = cell(i-1, j-1);
+! 	  else
+! 	    error ("nth: index = %d,%d out of range", i, j);
+! 	}
+!       else
+! 	error ("nth: first argument must be a list or cell");
+!     }
+    return retval;
+  }
+  
+*** src/Cell.h	2000/10/05 12:32:11	1.1
+--- src/Cell.h	2000/10/09 10:16:06
+*************** Software Foundation, 59 Temple Place - S
+*** 30,92 ****
+  #include <string>
+  
+  #include "Array2.h"
+- #include "oct-alloc.h"
+- #include "str-vec.h"
+  
+  #include "ov.h"
+  
+! class
+! Cell
+  {
+  public:
+  
+!   Cell (void)
+!     : data () { }
+  
+    Cell (int n, int m, const octave_value& val = octave_value ())
+!     : data (n, m, val) { }
+  
+!   Cell (const Array2<octave_value>& c)
+!     : data (c) { }
+  
+!   Cell (const Cell& c)
+!     : data (c.data) { }
+! 
+!   void *operator new (size_t size)
+!     { return allocator.alloc (size); }
+! 
+!   void operator delete (void *p, size_t size)
+!     { allocator.free (p, size); }
+  
+    Cell& operator = (const Cell& c)
+      {
+!       if (this != &c)
+! 	data = c.data;
+! 
+        return *this;
+      }
+  
+!   int rows (void) const { return data.rows (); }
+! 
+!   int columns (void) const { return data.columns (); }
+! 
+!   octave_value& operator () (int i, int j) { return elem (i, j); }
+! 
+!   octave_value operator () (int i, int j) const { return elem (i, j); }
+! 
+!   octave_value& elem (int i, int j) { return data.elem (i, j); }
+! 
+!   octave_value elem (int i, int j) const { return data.elem (i, j); }
+! 
+!   Cell index (idx_vector& i) const;
+! 
+!   Cell index (idx_vector& i, idx_vector& j) const;
+! 
+! private:
+  
+!   static octave_allocator allocator;
+  
+-   Array2<octave_value> data;
+  };
+  
+  #endif
+--- 30,65 ----
+  #include <string>
+  
+  #include "Array2.h"
+  
+  #include "ov.h"
+  
+! class Cell : public Array2<octave_value>
+  {
+  public:
+  
+!   Cell (void) : Array2<octave_value> () { }
+  
+    Cell (int n, int m, const octave_value& val = octave_value ())
+!     : Array2<octave_value> (n, m, val) { }
+  
+!   Cell (const Cell& c) : Array2<octave_value> (c) { }
+  
+!   Cell (const Array2<octave_value>& c) : Array2<octave_value> (c) { }
+  
+    Cell& operator = (const Cell& c)
+      {
+!       Array2<octave_value>::operator = (c);
+        return *this;
+      }
+  
+!   Cell& insert (const Array2<octave_value>& a, int r, int c)
+!   {
+!     Array2<octave_value>::insert (a, r, c);
+!     return *this;
+!   }
+  
+!   Cell transpose (void) const { return Array2<octave_value>::transpose (); }
+  
+  };
+  
+  #endif
+*** src/ov-cell.h	2000/10/05 12:32:11	1.1
+--- src/ov-cell.h	2000/10/19 12:28:30
+*************** public:
+*** 56,66 ****
+    octave_cell (void)
+      : octave_base_value () { }
+  
+!   octave_cell (const Cell& c)
+!     : octave_base_value (), cell_val (c) { }
+  
+!   octave_cell (const octave_cell& c)
+!     : octave_base_value (), cell_val (c.cell_val) { }
+  
+    ~octave_cell (void) { }
+  
+--- 56,66 ----
+    octave_cell (void)
+      : octave_base_value () { }
+  
+!   octave_cell (const Cell& m)
+!     : octave_base_value (), matrix (m) { }
+  
+!   octave_cell (const octave_cell& m)
+!     : octave_base_value (), matrix (m.matrix) { }
+  
+    ~octave_cell (void) { }
+  
+*************** public:
+*** 68,80 ****
+  
+    octave_value do_index_op (const octave_value_list& idx);
+  
+    void assign (const octave_value_list& idx, const octave_value& rhs);
+  
+    bool is_defined (void) const { return true; }
+  
+    bool is_constant (void) const { return true; }
+  
+!   Cell cell_value (void) const { return cell_val; }
+  
+    void print (std::ostream& os, bool pr_as_read_syntax = false) const;
+  
+--- 68,94 ----
+  
+    octave_value do_index_op (const octave_value_list& idx);
+  
++   int rows (void) const { return matrix.rows (); }
++   int columns (void) const { return matrix.columns (); }
++ 
++   int length (void) const
++   {
++     int r = rows ();
++     int c = columns ();
++ 
++     return (r == 0 || c == 0) ? 0 : ((r > c) ? r : c);
++   }
++ 
++   void assign (const octave_value_list& idx, const Cell& rhs);
+    void assign (const octave_value_list& idx, const octave_value& rhs);
+  
+    bool is_defined (void) const { return true; }
+  
+    bool is_constant (void) const { return true; }
+  
+!   bool is_cell (void) const { return true; }
+! 
+!   Cell cell_value (void) const { return matrix; }
+  
+    void print (std::ostream& os, bool pr_as_read_syntax = false) const;
+  
+*************** public:
+*** 84,90 ****
+  
+  private:
+  
+!   Cell cell_val;
+  
+    DECLARE_OCTAVE_ALLOCATOR
+  
+--- 98,104 ----
+  
+  private:
+  
+!   Cell matrix;
+  
+    DECLARE_OCTAVE_ALLOCATOR
+  
+*** src/parse.y	2000/10/05 12:33:31	1.1
+--- src/parse.y	2000/10/26 12:20:02
+*************** Software Foundation, 59 Temple Place - S
+*** 40,45 ****
+--- 40,46 ----
+  
+  #include <strstream.h>
+  
++ #include "Cell.h"
+  #include "Matrix.h"
+  #include "cmd-edit.h"
+  #include "cmd-hist.h"
+*************** matrix_rows1	: cell_or_matrix_row
+*** 603,611 ****
+  		;
+  
+  cell		: '{' '}'
+! 		  { $$ = new tree_constant (octave_value (Matrix ())); }
+  		| '{' ';' '}'
+! 		  { $$ = new tree_constant (octave_value (Matrix ())); }
+  		| '{' cell_rows '}'
+  		  { $$ = finish_cell ($2); }
+  		;
+--- 610,618 ----
+  		;
+  
+  cell		: '{' '}'
+! 		  { $$ = new tree_constant (octave_value (Cell ())); }
+  		| '{' ';' '}'
+! 		  { $$ = new tree_constant (octave_value (Cell ())); }
+  		| '{' cell_rows '}'
+  		  { $$ = finish_cell ($2); }
+  		;
+*** src/OPERATORS/op-cell.cc	2000/10/10 12:44:55	1.1
+--- src/OPERATORS/op-cell.cc	2000/10/23 11:58:11
+*************** Software Foundation, 59 Temple Place - S
+*** 30,131 ****
+  
+  #include "gripes.h"
+  #include "ov.h"
+! #include "ov-re-mat.h"
+  #include "ov-typeinfo.h"
+  #include "ops.h"
+- #include "xdiv.h"
+- #include "xpow.h"
+  
+  // matrix unary ops.
+  
+! DEFUNOP_OP (not, matrix, !)
+! DEFUNOP_OP (uminus, matrix, -)
+! 
+! DEFUNOP (transpose, matrix)
+  {
+!   CAST_UNOP_ARG (const octave_matrix&);
+  
+!   return octave_value (v.matrix_value().transpose ());
+  }
+  
+! DEFNCUNOP_METHOD (incr, matrix, increment)
+! DEFNCUNOP_METHOD (decr, matrix, decrement)
+! 
+! // matrix by matrix ops.
+! 
+! DEFBINOP_OP (add, matrix, matrix, +)
+! DEFBINOP_OP (sub, matrix, matrix, -)
+! DEFBINOP_OP (mul, matrix, matrix, *)
+! 
+! DEFBINOP (div, matrix, matrix)
+  {
+!   CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&);
+! 
+!   return xdiv (v1.matrix_value (), v2.matrix_value ());
+  }
+  
+- DEFBINOPX (pow, matrix, matrix)
+- {
+-   error ("can't do A ^ B for A and B both matrices");
+-   return octave_value ();
+- }
+- 
+- DEFBINOP_FN (ldiv, matrix, matrix, xleftdiv)
+- 
+- DEFBINOP_FN (lt, matrix, matrix, mx_el_lt)
+- DEFBINOP_FN (le, matrix, matrix, mx_el_le)
+- DEFBINOP_FN (eq, matrix, matrix, mx_el_eq)
+- DEFBINOP_FN (ge, matrix, matrix, mx_el_ge)
+- DEFBINOP_FN (gt, matrix, matrix, mx_el_gt)
+- DEFBINOP_FN (ne, matrix, matrix, mx_el_ne)
+- 
+- DEFBINOP_FN (el_mul, matrix, matrix, product)
+- DEFBINOP_FN (el_div, matrix, matrix, quotient)
+- DEFBINOP_FN (el_pow, matrix, matrix, elem_xpow)
+- 
+- DEFBINOP (el_ldiv, matrix, matrix)
+- {
+-   CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&);
+- 
+-   return octave_value (quotient (v2.matrix_value (), v1.matrix_value ()));
+- }
+- 
+- DEFBINOP_FN (el_and, matrix, matrix, mx_el_and)
+- DEFBINOP_FN (el_or, matrix, matrix, mx_el_or)
+- 
+- DEFASSIGNOP_FN (assign, matrix, matrix, assign)
+- 
+  void
+! install_m_m_ops (void)
+  {
+!   INSTALL_UNOP (op_not, octave_matrix, not);
+!   INSTALL_UNOP (op_uminus, octave_matrix, uminus);
+!   INSTALL_UNOP (op_transpose, octave_matrix, transpose);
+!   INSTALL_UNOP (op_hermitian, octave_matrix, transpose);
+! 
+!   INSTALL_NCUNOP (op_incr, octave_matrix, incr);
+!   INSTALL_NCUNOP (op_decr, octave_matrix, decr);
+! 
+!   INSTALL_BINOP (op_add, octave_matrix, octave_matrix, add);
+!   INSTALL_BINOP (op_sub, octave_matrix, octave_matrix, sub);
+!   INSTALL_BINOP (op_mul, octave_matrix, octave_matrix, mul);
+!   INSTALL_BINOP (op_div, octave_matrix, octave_matrix, div);
+!   INSTALL_BINOP (op_pow, octave_matrix, octave_matrix, pow);
+!   INSTALL_BINOP (op_ldiv, octave_matrix, octave_matrix, ldiv);
+!   INSTALL_BINOP (op_lt, octave_matrix, octave_matrix, lt);
+!   INSTALL_BINOP (op_le, octave_matrix, octave_matrix, le);
+!   INSTALL_BINOP (op_eq, octave_matrix, octave_matrix, eq);
+!   INSTALL_BINOP (op_ge, octave_matrix, octave_matrix, ge);
+!   INSTALL_BINOP (op_gt, octave_matrix, octave_matrix, gt);
+!   INSTALL_BINOP (op_ne, octave_matrix, octave_matrix, ne);
+!   INSTALL_BINOP (op_el_mul, octave_matrix, octave_matrix, el_mul);
+!   INSTALL_BINOP (op_el_div, octave_matrix, octave_matrix, el_div);
+!   INSTALL_BINOP (op_el_pow, octave_matrix, octave_matrix, el_pow);
+!   INSTALL_BINOP (op_el_ldiv, octave_matrix, octave_matrix, el_ldiv);
+!   INSTALL_BINOP (op_el_and, octave_matrix, octave_matrix, el_and);
+!   INSTALL_BINOP (op_el_or, octave_matrix, octave_matrix, el_or);
+  
+!   INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_matrix, assign);
+  }
+  
+  /*
+--- 30,66 ----
+  
+  #include "gripes.h"
+  #include "ov.h"
+! #include "ov-cell.h"
+  #include "ov-typeinfo.h"
+  #include "ops.h"
+  
+  // matrix unary ops.
+  
+! DEFUNOP (transpose, cell)
+  {
+!   CAST_UNOP_ARG (const octave_cell&);
+  
+!   return octave_value (v.cell_value().transpose ());
+  }
+  
+! DEFASSIGNOP_FN (assign, cell, cell, assign)
+! DEFASSIGNANYOP_FN (assignany, cell, assign);
+! CONVDECLX (cell_conv)
+  {
+!   return new octave_cell();
+  }
+  
+  void
+! install_cell_ops (void)
+  {
+!   INSTALL_UNOP (op_transpose, octave_cell, transpose);
+!   INSTALL_UNOP (op_hermitian, octave_cell, transpose);
+! 
+!   INSTALL_ASSIGNOP (op_asn_eq, octave_cell, octave_cell, assign);
+!   INSTALL_ASSIGNANYOP (op_asn_eq, octave_cell, assignany);
+  
+!   INSTALL_ASSIGNCONV (octave_base_value, octave_cell, octave_cell);
+!   INSTALL_WIDENOP (octave_base_value, octave_cell, cell_conv);
+  }
+  
+  /*
+*** liboctave/Array-b.cc	2000/10/05 09:33:32	1.1
+--- liboctave/Array-b.cc	2000/10/19 11:56:48
+*************** Software Foundation, 59 Temple Place - S
+*** 31,36 ****
+--- 31,37 ----
+  
+  template class Array<bool>;
+  
++ template bool& assign_fill_element(Array<bool>&);
+  template int assign (Array<bool>&, const Array<bool>&);
+  
+  #include "Array2.h"
+*** liboctave/Array-C.cc	2000/10/05 09:33:32	1.1
+--- liboctave/Array-C.cc	2000/10/19 11:54:42
+*************** Software Foundation, 59 Temple Place - S
+*** 33,38 ****
+--- 33,39 ----
+  
+  template class Array<Complex>;
+  
++ template Complex& assign_fill_element(Array<Complex>&);
+  template int assign (Array<Complex>&, const Array<Complex>&);
+  template int assign (Array<Complex>&, const Array<double>&);
+  template int assign (Array<Complex>&, const Array<int>&);
+*** liboctave/Array-ch.cc	2000/10/05 09:33:32	1.1
+--- liboctave/Array-ch.cc	2000/10/19 11:54:50
+*************** Software Foundation, 59 Temple Place - S
+*** 31,36 ****
+--- 31,37 ----
+  
+  template class Array<char>;
+  
++ template char& assign_fill_element(Array<char>&);
+  template int assign (Array<char>&, const Array<char>&);
+  
+  #include "Array2.h"
+*** liboctave/Array-d.cc	2000/10/05 09:33:32	1.1
+--- liboctave/Array-d.cc	2000/10/19 11:55:22
+*************** Software Foundation, 59 Temple Place - S
+*** 31,36 ****
+--- 31,37 ----
+  
+  template class Array<double>;
+  
++ template double& assign_fill_element(Array<double>&);
+  template int assign (Array<double>&, const Array<double>&);
+  template int assign (Array<double>&, const Array<int>&);
+  template int assign (Array<double>&, const Array<short>&);
+*** liboctave/Array-i.cc	2000/10/05 09:33:32	1.1
+--- liboctave/Array-i.cc	2000/10/19 11:54:31
+*************** Software Foundation, 59 Temple Place - S
+*** 31,36 ****
+--- 31,37 ----
+  
+  template class Array<int>;
+  
++ template int& assign_fill_element(Array<int>&);
+  template int assign (Array<int>&, const Array<int>&);
+  template int assign (Array<int>&, const Array<short>&);
+  template int assign (Array<int>&, const Array<char>&);
+*** liboctave/Array-s.cc	2000/10/05 09:33:32	1.1
+--- liboctave/Array-s.cc	2000/10/19 11:57:39
+*************** Software Foundation, 59 Temple Place - S
+*** 31,36 ****
+--- 31,37 ----
+  
+  template class Array<short>;
+  
++ template short& assign_fill_element(Array<short>&);
+  template int assign (Array<short>&, const Array<short>&);
+  template int assign (Array<short>&, const Array<char>&);
+  
+*** liboctave/Array2-idx.h	2000/10/05 09:33:32	1.1
+--- liboctave/Array2-idx.h	2000/10/18 23:29:56
+*************** Array2<T>::maybe_delete_elements (idx_ve
+*** 487,493 ****
+  	  int new_nr = max_row_idx > lhs_nr ? max_row_idx : lhs_nr; \
+  	  int new_nc = max_col_idx > lhs_nc ? max_col_idx : lhs_nc; \
+   \
+! 	  lhs.resize (new_nr, new_nc, 0.0); \
+  	} \
+      } \
+    while (0)
+--- 497,503 ----
+  	  int new_nr = max_row_idx > lhs_nr ? max_row_idx : lhs_nr; \
+  	  int new_nc = max_col_idx > lhs_nc ? max_col_idx : lhs_nc; \
+   \
+! 	  lhs.resize (new_nr, new_nc, assign_fill_element(lhs)); \
+  	} \
+      } \
+    while (0)
+*** liboctave/Array.h	2000/10/05 09:33:32	1.1
+--- liboctave/Array.h	2000/10/18 23:19:45
+*************** public:
+*** 250,255 ****
+--- 250,259 ----
+  #endif
+  };
+  
++ template <class T>
++ T&
++ assign_fill_element (Array<T>& lhs);
++ 
+  template <class LT, class RT>
+  int
+  assign (Array<LT>& lhs, const Array<RT>& rhs);
+*** liboctave/Array-idx.h	2000/10/05 09:33:32	1.1
+--- liboctave/Array-idx.h	2000/10/18 23:19:31
+*************** Array<T>::maybe_delete_elements (idx_vec
+*** 172,177 ****
+--- 172,185 ----
+      }
+  }
+  
++ template <class T>
++ T& assign_fill_element(Array<T>& lhs)
++ { 
++   static T foo(0);
++ 
++   return foo;
++ }
++ 
+  // ??? FIXME ??? -- this does not handle assignment of empty vectors
+  // to delete elements.  Should it?
+  
+*************** assign (Array<LT>& lhs, const Array<RT>&
+*** 196,202 ****
+  	{
+  	  int max_idx = lhs_idx.max () + 1;
+  	  if (max_idx > lhs_len)
+! 	    lhs.resize (max_idx, 0.0);
+  	}
+  
+        if (rhs_len == n)
+--- 204,210 ----
+  	{
+  	  int max_idx = lhs_idx.max () + 1;
+  	  if (max_idx > lhs_len)
+! 	    lhs.resize (max_idx, assign_fill_element(lhs));
+  	}
+  
+        if (rhs_len == n)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/patches/exist-type-2.1.19.patch	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,219 @@
+From help-octave-request@bevo.che.wisc.edu Fri Mar 24 07:59:53 2000
+Return-Path: <help-octave-request@bevo.che.wisc.edu>
+Received: from kienzle (really [127.0.0.1]) by kienzle.powernet.co.uk
+	via in.smtpd with esmtp
+	id <m12YP0Z-000H4aC@kienzle> (Debian Smail3.2.0.101)
+	for <pkienzle@kienzle>; Fri, 24 Mar 2000 07:59:51 +0000 (GMT) 
+Received: from pop3.powernet.co.uk
+	by kienzle (fetchmail-4.3.9 POP3)
+	for <pkienzle/kienzle> (single-drop); Fri, 24 Mar 2000 07:59:51 GMT
+Received: from bevo.che.wisc.edu (bevo.che.wisc.edu [128.104.177.141])
+	by mail-relay.power.net.uk (8.9.0/8.9.0) with ESMTP id VAA21261
+	for <pkienzle@kienzle.powernet.co.uk>; Thu, 23 Mar 2000 21:19:06 GMT
+Received: from localhost (daemon@localhost)
+	by bevo.che.wisc.edu (8.9.1/8.9.1) with SMTP id PAA18430;
+	Thu, 23 Mar 2000 15:14:52 -0600 (CST)
+Received: by bevo.che.wisc.edu (bulk-mailer v1.3); Thu, 23 Mar 2000 15:14:21 -0600
+Received: (from slist@localhost)
+	by bevo.che.wisc.edu (8.9.1/8.9.1) id PAA31435;
+	Thu, 23 Mar 2000 15:14:17 -0600 (CST)
+Resent-Date: Thu, 23 Mar 2000 15:14:17 -0600 (CST)
+Message-Id: <m12YEyZ-0015vhC@anonimo.isr.ist.utl.pt>
+Date: Thu, 23 Mar 2000 21:17:07 +0000 (WET)
+From: etienne grossmann <etienne@anonimo.isr.ist.utl.pt>
+To: help-octave@bevo.che.wisc.edu, pkienzle@kienzle.powernet.co.uk
+Subject: patch : exist("varname","var")
+CC: etienne@isr.ist.utl.pt
+Reply-to: etienne@isr.isr.ist.utl.pt
+Mime-Version: 1.0 (generated by tm-edit 7.106)
+Content-Type: text/plain; charset=US-ASCII
+Resent-Message-ID: <"xqwlF975YDP.A.NFF.oko24"@bevo.che.wisc.edu>
+Resent-From: help-octave@bevo.che.wisc.edu
+X-Mailing-List: <help-octave@bevo.che.wisc.edu> 
+X-Loop: help-octave@bevo.che.wisc.edu
+Resent-Sender: help-octave-request@bevo.che.wisc.edu
+Sender: help-octave-request@bevo.che.wisc.edu
+X-UIDL: ad85250dfbf12409acfb9a30fdcc4cf5
+Status: RO
+Content-Length: 4645
+Lines: 178
+
+
+  Hello,
+ 
+  here is a little patch so that exist("varname","var") returns 1 if
+there is a variable called "varname" and zero otherwise. No check is
+done for builtin functions or files. This is what I, most often, use
+"exist" for.
+
+  Acceleration is noticable (the script that produces this output is
+  given after the patch) :
+
+======================================================================
+octave:2> test_exist_speed_2 
+ntests = 20
+without exist()      : 0.000000
+really simple        : 0.000500
+empty loop           : 0.000500
+with    exist()      : 0.018500
+with    exist('var') : 0.000500
+======================================================================
+
+
+  Cheers,
+
+  Etienne
+
+Changelog entry :
+======================================================================
+2000-03-23  Etienne Grossmann  <etienne@isr.ist.utl.pt>
+
+        * src/variables.cc : Make "exist()" check only for the
+          existence of a variable (not function, .oct or file), if a
+          second argument is present and equal to "var".
+======================================================================
+
+Patch (against 2.1.19):
+======================================================================
+*** src/variables.cc.orig	Thu Mar 23 20:41:40 2000
+--- src/variables.cc	Thu Mar 23 21:00:00 2000
+***************
+*** 396,402 ****
+  }
+  
+  DEFUN (exist, args, ,
+!   "exist (NAME): check if variable or file exists\n\
+  \n\
+  returns:\n\
+  \n\
+--- 396,402 ----
+  }
+  
+  DEFUN (exist, args, ,
+!   "exist (NAME [,'var']): check if variable or file exists\n\
+  \n\
+  returns:\n\
+  \n\
+***************
+*** 409,421 ****
+  This function also returns 2 if a regular file called NAME exists in\n\
+  Octave's LOADPATH.  If you want information about other types of\n\
+  files, you should use some combination of the functions file_in_path\n\
+! and stat instead.")
+  {
+    octave_value_list retval;
+  
+    int nargin = args.length ();
+  
+!   if (nargin != 1)
+      {
+        print_usage ("exist");
+        return retval;
+--- 409,436 ----
+  This function also returns 2 if a regular file called NAME exists in\n\
+  Octave's LOADPATH.  If you want information about other types of\n\
+  files, you should use some combination of the functions file_in_path\n\
+! and stat instead. If the second argument is present and equal to \n\
+! \"var\", then only the existence of a variable is checked.")
+  {
+    octave_value_list retval;
+  
+    int nargin = args.length ();
++   
++   string var_only = "" ;
++   int var_only_i = 0 ;
+  
+!   if (nargin == 2)
+!     {
+!       var_only = args(1).string_value ();
+!       if( var_only.compare ("var", 0, 3) != 0 )
+! 	{
+! 	  print_usage ("exist");
+! 	  return retval;
+! 	}
+!       else 
+! 	var_only_i = 1 ;
+!     }
+!   if (nargin > 2)
+      {
+        print_usage ("exist");
+        return retval;
+***************
+*** 451,456 ****
+--- 466,475 ----
+      {
+        if (struct_elts.empty () || sr->is_map_element (struct_elts))
+  	retval = 1.0;
++     }
++   else if ( var_only_i ) 
++     {
++       return retval ;
+      }
+    else if (sr && sr->is_builtin_function ())
+      {
+======================================================================
+
+Test script :
+======================================================================
+1 ;
+
+function y = foo(x,y,z)
+  if exist("z")!=1, z = 1 ; end
+  if exist("y")!=1, y = 1 ; end
+  if exist("x")!=1, x = 1 ; end
+end
+
+function y = foo2(x,y,z)
+  if exist("z","var")!=1, z = 1 ; end
+  if exist("y","var")!=1, y = 1 ; end
+  if exist("x","var")!=1, x = 1 ; end
+end
+
+function y = bar(x,y,z)
+  if 1, z = 1 ; end
+  if 1, y = 1 ; end
+  if 1, x = 1 ; end
+end
+
+function y = baz(x,y,z) 
+end
+
+ntests = 20 
+
+mytic();
+for i=1:ntests, bar(1,2); end
+t2 = mytic();
+printf("without exist()      : %f\n",t2/ntests) ;
+
+mytic();
+for i=1:ntests, baz(1,2); end
+t3 = mytic();
+printf("really simple        : %f\n",t3/ntests) ;
+
+mytic();
+for i=1:ntests, end
+t4 = mytic();
+printf("empty loop           : %f\n",t4/ntests) ;
+
+mytic();
+for i=1:ntests, foo(1,2); end
+t1 = mytic();
+printf("with    exist()      : %f\n",t1/ntests) ;
+
+for i=1:ntests, foo2(1,2); end
+t1 = mytic();
+printf("with    exist('var') : %f\n",t1/ntests) ;
+=====================================================================
+
+
+
+-----------------------------------------------------------------------
+Octave is freely available under the terms of the GNU GPL.
+
+Octave's home on the web:  http://www.che.wisc.edu/octave/octave.html
+How to fund new projects:  http://www.che.wisc.edu/octave/funding.html
+Subscription information:  http://www.che.wisc.edu/octave/archive.html
+-----------------------------------------------------------------------
+
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/patches/load-to-struct-2.0.19.patch	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,92 @@
+Hi,
+  The patch allows octave to load variables from a file into a structure
+variable, which is possible in Matlab. Patch is against 2.0.14. Cd to
+octave source and use patch -p1
+
+*** orig/ChangeLog	Mon Oct 30 16:49:53 2000
+--- octave-2.0.14/ChangeLog	Mon Oct 30 16:52:30 2000
+***************
+*** 1,3 ****
+--- 1,7 ----
++ Mon Oct 30 16:50:00 2000  K.M.A. Chai
++ 	* src/load-save.cc: included a quick hack in do_load(..) that allows
++ 	loading of variables from file into a structure variable, to make
++ 	octave more Matlab-compatible.
+  Sun Oct  1 17:25:32 2000  K.M.A. Chai
+  	* liboctave/dMatrix.h (Matrix cumprod (int dim = 0) const): Added
+  	extra argument indicate the dimension along which the operation is
+*** orig/src/load-save.cc	Mon Oct 30 16:47:08 2000
+--- octave-2.0.14/src/load-save.cc	Mon Oct 30 16:47:01 2000
+*************** Software Foundation, 59 Temple Place - S
+*** 48,53 ****
+--- 48,54 ----
+  #include "load-save.h"
+  #include "mappers.h"
+  #include "oct-obj.h"
++ #include "oct-map.h"
+  #include "pager.h"
+  #include "pt-exp.h"
+  #include "pt-fvc.h"
+*************** do_load (istream& stream, const string& 
+*** 1534,1539 ****
+--- 1535,1541 ----
+  	 int argv_idx, int argc, int nargout)
+  {
+    octave_value_list retval;
++   Octave_map retstruct;
+  
+    ostrstream output_buf;
+    int count = 0;
+*************** do_load (istream& stream, const string& 
+*** 1608,1614 ****
+  		    }
+  		  else
+  		    {
+! 		      install_loaded_variable (force, name, tc, global, doc);
+  		    }
+  		}
+  
+--- 1610,1623 ----
+  		    }
+  		  else
+  		    {
+! 		      if(nargout==1)
+! 			{
+! 			  retstruct[name]=tc;
+! 			}
+! 		      else
+! 			{
+! 			  install_loaded_variable (force, name, tc, global, doc);
+! 			}
+  		    }
+  		}
+  
+*************** do_load (istream& stream, const string& 
+*** 1636,1641 ****
+--- 1645,1655 ----
+  	}
+      }
+  
++   if(nargout==1)
++     {
++       retval = octave_value(retstruct);
++     }
++ 
+    if (list_only && count)
+      {
+        output_buf << ends;
+*************** do_load (istream& stream, const string& 
+*** 1655,1662 ****
+--- 1669,1680 ----
+  
+  DEFUN_TEXT (load, args, nargout,
+    "load [-force] [-ascii] [-binary] [-mat-binary] file [pattern ...]\n\
++    argout = load [-force] [-ascii] [-binary] [-mat-binary] file [pattern ...]\n\
+  \n\
+  Load variables from a file.\n\
++ \n\
++ if argout is given on the LHS, then the variables are loaded into variable argout\n\
++ as a structure.\n\
+  \n\
+  If no argument is supplied to select a format, load tries to read the\n\
+  named file as an Octave binary, then as a .mat file, and then as an\n\
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/patches/octave-mod-2.1.31.patch	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,168 @@
+Emacs support for embedded test/demo scripts, using %!
+
+Paul Kienzle
+pkienzle@kienzle.powernet.co.uk
+
+*** emacs/octave-mod.el.orig	Tue May  2 19:20:38 2000
+--- emacs/octave-mod.el	Tue May  2 02:58:06 2000
+***************
+*** 532,538 ****
+      (cond
+       ((eq position 'bol)  (beginning-of-line))
+       ((eq position 'eol)  (end-of-line))
+!      ((eq position 'boi)  (back-to-indentation))
+       ((eq position 'bonl) (forward-line 1))
+       ((eq position 'bopl) (forward-line -1))
+       (t (error "unknown buffer position requested: %s" position)))
+--- 532,538 ----
+      (cond
+       ((eq position 'bol)  (beginning-of-line))
+       ((eq position 'eol)  (end-of-line))
+!      ((eq position 'boi)  (octave-back-to-indentation))
+       ((eq position 'bonl) (forward-line 1))
+       ((eq position 'bopl) (forward-line -1))
+       (t (error "unknown buffer position requested: %s" position)))
+***************
+*** 637,643 ****
+  	(if (zerop (octave-previous-code-line))
+  	    (progn
+  	      (octave-beginning-of-line)
+! 	      (back-to-indentation)
+  	      (setq icol (current-column))
+  	      (let ((bot (point))
+  		    (eol (octave-point 'eol)))
+--- 637,643 ----
+  	(if (zerop (octave-previous-code-line))
+  	    (progn
+  	      (octave-beginning-of-line)
+! 	      (octave-back-to-indentation)
+  	      (setq icol (current-column))
+  	      (let ((bot (point))
+  		    (eol (octave-point 'eol)))
+***************
+*** 659,665 ****
+  	      (if is-continuation-line
+  		  (setq icol (+ icol octave-continuation-offset)))))))
+      (save-excursion
+!       (back-to-indentation)
+        (cond
+         ((and (looking-at octave-block-else-regexp)
+  	     (octave-not-in-string-or-comment-p))
+--- 659,665 ----
+  	      (if is-continuation-line
+  		  (setq icol (+ icol octave-continuation-offset)))))))
+      (save-excursion
+!       (octave-back-to-indentation)
+        (cond
+         ((and (looking-at octave-block-else-regexp)
+  	     (octave-not-in-string-or-comment-p))
+***************
+*** 672,677 ****
+--- 672,687 ----
+  	(setq icol (list 0 icol)))
+         ((looking-at "\\s<\\S<")
+  	(setq icol (list comment-column icol)))))
++     (if (save-excursion           ; if the line starts a test block, 
++ 	  (beginning-of-line)     ; keep indent at 2
++ 	  (looking-at "%![^ \t]"))
++ 	(setq icol 2)
++       (if (and (not (listp icol)) ; otherwise, if it is in a test block
++ 	       (< icol 3)         ; and the indent wants to be less than 3
++ 	       (save-excursion    ; override and set it to 3 so the %!
++ 		 (beginning-of-line) ; doesn't get eaten.
++ 		 (looking-at "%!")))
++ 	  (setq icol 3)))
+      icol))
+  
+  (defun octave-block-end-offset ()
+***************
+*** 705,710 ****
+--- 715,742 ----
+    (indent-for-comment)
+    (indent-according-to-mode))
+  
++ (defun octave-back-to-indentation ()
++   (beginning-of-line)
++   (if (looking-at "%!") (move-to-column 2))
++   (skip-chars-forward " \t"))
++ 
++ (defun octave-indent-line-to (column)
++   (octave-back-to-indentation)
++   (let ((cur-col (current-column)))
++     (cond ((< cur-col column)
++            (if (> (- column (* (/ cur-col tab-width) tab-width)) tab-width)
++                (delete-region (point)
++                               (progn (skip-chars-backward " ") (point))))
++            (indent-to column))
++           ((> cur-col column) ; too far right (after tab?)
++            (delete-region (progn (move-to-column column t) (point))
++                           (progn (octave-back-to-indentation) (point)))))))
++ 
++ (defun octave-current-indentation ()
++   (save-excursion
++     (octave-back-to-indentation)
++     (current-column)))
++ 
+  (defun octave-indent-line (&optional arg)
+    "Indent current line as Octave code.
+  With optional ARG, use this as offset unless this line is a comment with
+***************
+*** 712,724 ****
+    (interactive)
+    (or arg (setq arg 0))
+    (let ((icol (calculate-octave-indent))
+! 	(relpos (- (current-column) (current-indentation))))
+      (if (listp icol)
+  	(setq icol (car icol))
+        (setq icol (+ icol arg)))
+      (if (< icol 0)
+  	(error "Unmatched end keyword")
+!       (indent-line-to icol)
+        (if (> relpos 0)
+  	  (move-to-column (+ icol relpos))))))
+  
+--- 744,756 ----
+    (interactive)
+    (or arg (setq arg 0))
+    (let ((icol (calculate-octave-indent))
+! 	(relpos (- (current-column) (octave-current-indentation))))
+      (if (listp icol)
+  	(setq icol (car icol))
+        (setq icol (+ icol arg)))
+      (if (< icol 0)
+  	(error "Unmatched end keyword")
+!       (octave-indent-line-to icol)
+        (if (> relpos 0)
+  	  (move-to-column (+ icol relpos))))))
+  
+***************
+*** 757,768 ****
+    (interactive "p")
+    (or arg (setq arg 1))
+    (beginning-of-line)
+!   (let ((n 0)
+  	(inc (if (> arg 0) 1 -1)))
+      (while (and (/= arg 0) (= n 0))
+        (setq n (forward-line inc))
+        (while (and (= n 0)
+! 		  (looking-at "\\s-*\\($\\|\\s<\\)"))
+  	(setq n (forward-line inc)))
+        (setq arg (- arg inc)))
+      n))
+--- 789,804 ----
+    (interactive "p")
+    (or arg (setq arg 1))
+    (beginning-of-line)
+!   (let ((is-test-line (looking-at "%!"))
+! 	(n 0)
+  	(inc (if (> arg 0) 1 -1)))
+      (while (and (/= arg 0) (= n 0))
+        (setq n (forward-line inc))
+        (while (and (= n 0)
+! 		  (if is-test-line
+! 		      (or (not (looking-at "%!"))
+! 			  (looking-at "%!\\s-*\\($\\|\\s<\\|%\\)"))
+! 		    (looking-at "\\s-*\\($\\|\\s<\\|%\\)")))
+  	(setq n (forward-line inc)))
+        (setq arg (- arg inc)))
+      n))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/testfun/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,8 @@
+include ../../Makeconf
+
+PROGS = pretty.oct
+
+all: $(PROGS)
+
+clean: 
+	-$(RM) *.o $(PROGS) core octave-core *~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/testfun/README	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,29 @@
+
+This directory contains the following files:
+
+example.m : shows examples from octave scripts 
+demo.m    : runs examples from octave scripts
+test.m    : processes test directives in octave scripts and extracts examples
+assert.m  : checks if two variables are the same, or exit with an error if
+	    they are different.  The error shows the pretty printed expected
+	    and got values.
+pretty.cc : octave variable pretty printer, because x=disp(y) doesn't work
+Makefile  : convert pretty.cc to pretty.oct
+
+pretty    : test script for pretty.oct
+
+octave-mod.el  : modified octave-mod.el for support of test directives in
+                 octave scripts
+octave-mod.diff: context diffs against 2.0.13 octave-mod.el
+
+index.m
+rindex.m
+findstr.m   : speeded up versions of index, rindex and findstr
+index.diff
+rindex.diff
+findstr.diff: context diffs against 2.1.28
+string.tst  : test script for index, rindex, findstr
+
+speed_test.m: compares speed of f and f_orig as a function of input length n
+
+special-matrix.tst: test script for hankel toeplitz kron hilb invhilb vander
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/testfun/assert.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,176 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## assert(cond)
+##   Produce an error if any element of cond is zero
+##
+## assert(v, expected_v)
+##   Produce an error if v is not the same as expected_v.  Note
+##   that v and expected_v can be strings, matrices or structures.
+##
+## assert(v, expected_v, tol)
+##   Produce an error if abs(v-expected_v)>tol for any v
+##
+## assert(v, expected_v, tol, 'rel')
+##   Produce an error if abs((v-expected_v)./expected_v)>tol for any v
+##
+## see also: test, pretty
+function assert(cond, expected, tol, rel)
+
+  if (nargin < 1 || nargin > 4)
+    usage("assert (cond) or assert (v, expected_v [,tol [,'rel']])");
+  endif
+
+  if (nargin < 3)
+    tol = 0;
+  endif
+  if (nargin < 4)
+    rel = [];
+  endif
+
+  coda = "";
+  iserror = 0;
+  if (nargin == 1)
+    if (!all (all (cond)))
+      error ("assert failed");
+    endif
+
+  elseif (isstr (expected))
+    iserror = (!isstr (cond) || !strcmp (cond, expected));
+
+  elseif (is_struct (expected))
+    if (!is_struct (cond))
+      iserror = 1;
+    else
+      z = struct_elements (cond);
+      y = struct_elements (expected);
+      if (any (any (z != y)))
+	iserror = 1;
+      else
+	iserror = 0;
+	for i=1:length (z)
+      	  eval (["assert(cond.", z(i), ", expected.", z(i), ", tol, rel);"],
+		"iserror = 1;");
+	endfor
+      endif
+    endif
+
+  elseif (isempty (expected))
+    iserror = (any (size (cond) != size (expected)));
+
+  else ## numeric
+    if (any (size (cond) != size (expected)))
+      iserror = 1;
+    elseif (isempty(rel))
+      iserror = (any (any (abs (cond-expected) > tol )));
+      if (iserror)
+	coda = sprintf("|| v - v_expected || = %g", norm(cond-expected));
+      endif
+    else
+      iserror = (any (any (abs ( (cond-expected)./expected ) > tol )));
+      if (iserror)
+	coda = sprintf("|| (v - v_expected)./v || = %g", \
+		       norm((cond-expected)./expected));
+      endif
+    endif
+  endif
+
+  if (!iserror)
+    return;
+  endif
+
+  ## pretty print the "expected but got" info
+  msg = "assert expected";
+  str = pretty (expected);
+  idx = find(toascii(str) != toascii("\n"));
+  if (!isempty(idx))
+    str = str(idx(1):idx(length(idx)));
+  endif
+  str2 = pretty (cond);
+  idx = find(toascii(str2) != toascii("\n"));
+  if (!isempty(idx))
+    str2 = str2(idx(1):idx(length(idx)));
+  endif
+  msg = ["assert expected\n", str, "\nbut got\n", str2];
+  if (!isempty(coda))
+    msg = [ msg, "\n", coda ];
+  endif
+  error(msg);
+endfunction
+
+## empty
+%!assert([])
+%!assert(zeros(3,0),zeros(3,0))
+%!error assert(zeros(3,0),zeros(0,2))
+%!error assert(zeros(3,0),[])
+
+## conditions
+%!assert(isempty([]))
+%!assert(1)
+%!error assert(0)
+%!assert(ones(3,1))
+%!assert(ones(1,3))
+%!assert(ones(3,4))
+%!error assert([1,0,1])
+%!error assert([1;1;0])
+%!error assert([1,0;1,1])
+
+## vectors
+%!assert([1,2,3],[1,2,3]);
+%!assert([1;2;3],[1;2;3]);
+%!error assert([2;2;3],[1;2;3]);
+%!error assert([1,2,3],[1;2;3]);
+%!error assert([1,2],[1,2,3]);
+%!error assert([1;2;3],[1;2]);
+%!assert([1,2;3,4],[1,2;3,4]);
+%!error assert([1,4;3,4],[1,2;3,4])
+%!error assert([1,3;2,4;3,5],[1,2;3,4])
+
+## scalars
+%!error assert(3, [3,3; 3,3])
+%!error assert([3,3; 3,3], 3)
+%!assert(3, 3);
+%!assert(3+eps, 3, eps);
+%!assert(3, 3+eps, eps);
+%!error assert(3+2*eps, 3, eps);
+%!error assert(3, 3+2*eps, eps);
+%## must give a little space for floating point errors on relative
+%!assert(100+100*eps, 100, 2*eps, 'rel'); 
+%!assert(100, 100+100*eps, 2*eps, 'rel');
+%!error assert(100+300*eps, 100, 2*eps, 'rel'); 
+%!error assert(100, 100+300*eps, 2*eps, 'rel');
+%!error assert(3, [3,3]);
+%!error assert(3,4);
+
+## structures
+%!shared x,y
+%! x.a = 1; x.b=[2, 2];
+%! y.a = 1; y.b=[2, 2];
+%!assert (x,y)
+%!test y.b=3;
+%!error assert (x,y)
+%!error assert (3, x);
+%!error assert (x, 3);
+
+## check usage statements
+%!error assert
+%!error assert(1,2,3,4,5)
+
+## strings
+%!assert("dog","dog")
+%!error assert("dog","cat")
+%!error assert("dog",3);
+%!error assert(3,"dog");
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/testfun/data/pretty	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,16 @@
+## -*-octave-*-
+## test scripts for the "pretty" built-in
+
+%!demo disp([ "<" pretty(1) ">" ])
+%!demo disp([ "<" pretty ([1,2,3]) ">" ])
+%!demo disp([ "<" pretty ([1;2;3]) ">" ])
+%!demo disp([ "<" pretty (rand(3,5)) ">" ])
+%!demo disp([ "<" pretty (fix(100*rand(3,5))) ">" ])
+%!demo disp([ "<" pretty ("cat") ">" ])
+%!demo disp([ "<" pretty (["cat"; "dog"]) ">" ])
+%!demo x.a=1; x.b=rand(2,2);
+%! disp([ "<" pretty (x) ">" ])
+%!demo disp([ "<" pretty ([]) ">" ])
+%!demo disp([ "<" pretty (zeros(3,0)) ">" ])
+%!demo disp([ "<" pretty (rand(2,2)+rand(2,2)*1i) ">" ])
+%!demo disp([ "<" pretty (rand(6,1000)) ">" ])
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/testfun/demo.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,120 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## demo('name', n)
+##
+## Runs any examples associated with the function 'name'.  Examples are 
+## stored in the script file, or in a file with the same name but no 
+## extension somewhere on your path.  To keep them separate from the
+## usual script code, all lines are prefixed by %!.  Each example is
+## introduced by the keyword 'demo' flush left to the prefix, with no
+## intervening spaces.  The remainder of the example can contain 
+## arbitrary octave code. For example:
+##
+##    %!demo
+##    %! t=0:0.01:2*pi; x = sin(t);
+##    %! plot(t,x)
+##    %! %-------------------------------------------------
+##    %! % the figure window shows one cycle of a sine wave
+##
+## Note that the code is displayed before it is executed, so a simple
+## comment at the end suffices.  It is generally not necessary to use
+## disp or printf within the demo.
+##
+## Demos are run in a function environment with no access to external
+## variables. This means that all demos in your function must use
+## separate initialization code. Alternatively, you can combine your
+## demos into one huge demo, with the code:
+##
+##    %! input("Press <enter> to continue: ","s");
+##
+## between the sections, but this is discouraged.  Other techniques
+## include using multiple plots by saying figure between each, or
+## using subplot to put multiple plots in the same window.
+##
+## Also, since demo evaluates inside a function context, you cannot
+## define new functions inside a demo.  Instead you will have to
+## use eval(example('function',n)) to see them.  Because eval only
+## evaluates one line, or one statement if the statement crosses
+## multiple lines, you must wrap your demo in "if 1 <demo stuff> endif"
+## with the 'if' on the same line as 'demo'. For example,
+##
+##   %!demo if 1
+##   %!  function y=f(x)
+##   %!    y=x;
+##   %!  endfunction
+##   %!  f(3)
+##   %! endif
+##
+## See Also: test, example
+
+## TODO: modify subplot so that gnuplot_has_multiplot == 0 causes it to
+## TODO: use the current figure window but pause if not plotting in the
+## TODO: first subplot.
+
+function demo(name, n)
+
+  if (nargin < 1 || nargin > 2)
+    usage("demo('name')  or demo('name, n)");
+  endif
+
+  if (nargin < 2)
+    n = 0;
+  endif
+
+  [code, idx] = test (name, 'grabdemo');
+  if (length(idx) == 0)
+    warning(["demo not available for ", name]);
+    return;
+  elseif (n >= length(idx))
+    warning(sprintf("only %d demos available for %s", length(idx)-1, name));
+    return;
+  endif
+
+
+  if (n > 0)
+    doidx = n;
+  else
+    doidx = [ 1 : length(idx)-1 ];
+  endif
+  for i=1:length(doidx)
+    ## Pause between demos
+    if (i > 1)
+      input("Press <enter> to continue: ","s");
+    endif
+
+    ## Process each demo without failing
+    try
+      block = code( idx(doidx(i)) : idx(doidx(i)+1) -1 );
+      ## Use an environment without variables
+      eval(["function __demo__()\n", block, "\nendfunction"]);
+      ## Display the code that will be executed before executing it
+      printf("%s example %d:%s\n\n", name, doidx(i), block);
+      __demo__;
+    catch
+      ## Let the programmer know which demo failed.
+      printf("%s example %d: failed\n%s", name, doidx(i), __error_text__);
+    end_try_catch
+    clear __demo__;
+  endfor
+
+endfunction
+
+%!demo
+%! t=0:0.01:2*pi; x = sin(t);
+%! plot(t,x)
+%! %-------------------------------------------------
+%! % the figure window shows one cycle of a sine wave
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/testfun/example.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,89 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## example('name', n)
+##
+##    Display the code for example n associated with the function 'name',
+##    but do not run it.  If n is not given, all examples are displayed.
+##
+## [x, idx] = example(...)
+##    Return the examples as a string, with idx indicating the ending
+##    position of the various examples.
+##
+## See demo for a complete explanation.
+##
+## See also: demo, test
+
+function [code_r, idx_r] = example(name, n)
+
+  if (nargin < 1 || nargin > 2)
+    usage("example('name')  or example('name', n)");
+  endif
+  if (nargin < 2)
+    n = 0;
+  endif
+
+  [code, idx] = test (name, 'grabdemo');
+  if (nargout > 0)
+    if (n > 0)
+      if (n <= length(idx))
+      	code_r = code(idx(n) : idx(n+1)-1);
+      	idx_r = [1, length(code_r)+1];
+      else
+	code_r = "";
+	idx_r = [];
+      endif
+    else
+      code_r = code;
+      idx_r = idx;
+    endif
+  else
+    if (n > 0)
+      doidx = n;
+    else
+      doidx = [ 1:length(idx)-1 ];
+    endif
+    if (length(idx) == 0)
+      warning(["example not available for ", name]);
+    elseif (n >= length(idx))
+      warning(sprintf("only %d examples available for %s", length(idx)-1, name));
+      doidx = [];
+    endif
+
+    for i=1:length(doidx)
+      block = code( idx(doidx(i)) : idx(doidx(i)+1) -1 );
+      printf("%s example %d:%s\n\n", name, doidx(i), block);
+    endfor
+  endif
+
+endfunction
+
+%!## warning: don't modify the demos without modifying the tests!
+%!demo
+%! example('example');
+%!demo
+%! t=0:0.01:2*pi; x=sin(t);
+%! plot(t,x)
+
+%!assert (example('example',1), "\n example('example');");
+%!test
+%! [code, idx] = example('example');
+%! assert (code, ... 
+%!	   "\n example('example');\n t=0:0.01:2*pi; x=sin(t);\n plot(t,x)")
+%! assert (idx, [1, 22, 59]);
+
+%!error example;
+%!error example('example',3,5)
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/testfun/index.html	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,25 @@
+<html><head><title>TestPAK: embedded tests for Octave scripts</title></head>
+<body>
+
+<h1>TestPAK: embedded tests for Octave scripts</h1>
+
+<ul>
+<li><a href=testfun/example.m>example</a>, <a href=testfun/demo.m>demo</a><br>
+   example('name') shows sample code for using function 'name', and 
+   demo('name') runs that code.  The examples are stored in the script file
+   for each function.  Not all functions have examples (yet).
+<li><a href=testfun/test.m>test</a><br>
+   test('name') runs all test code associated with the function 'name'.
+   The test code is stored in the script file for each function.  Not
+   all functions have tests written (yet).
+<li><a href=testfun/assert.m>assert</a>, 
+    <a href=testfun/pretty.cc>pretty</a><br>
+   assert(x,y) produces an error if x != y.  pretty(x) formats the data
+   in x, no matter what it is, and is used by assert to construct the
+   error message.
+<li><a href=testfun/octave-mod.el>emacs support</a> for test code in
+   octave scripts.  Also available as a
+   <a href=testfun/octave-mod.diff>diff against 2.0.14</a>
+</ul>
+
+</body></html>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/testfun/pretty.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,46 @@
+/*
+2000-04-30: Paul Kienzle
+
+Based on functions from Octave with the following copyright:
+
+Copyright (C) 1996, 1997 John W. Eaton
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+This program is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+*/
+
+#include <octave/oct.h>
+#include <octave/oct-strstrm.h>
+
+DEFUN_DLD (pretty, args, ,
+"str = pretty (v)\n\
+\n\
+Equivalent to x=disp(v), but disp doesn't return a value ...")
+{
+  octave_value_list retval;
+
+  int nargin = args.length ();
+
+  if (nargin == 1) 
+    {
+      octave_ostrstream *ostr = new octave_ostrstream();
+      std::ostream& os = *(ostr->output_stream());
+      args(0).print (os, false);
+      retval(0) = octave_value(ostr->str());
+    }
+  else
+    print_usage ("pretty");
+
+  return retval;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/testfun/speed.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,246 @@
+## Copyright (C) 2000-2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## speed(f, init, max_n, f2, tol, err)
+##
+##   Determine the execution time of an expression for various n.
+##   The n are log-spaced from 1 to max_n.  For each n, an
+##   initialization expression is computed to create whatever
+##   data are needed for the test.
+##
+##   f is the expression to evaluate.
+##   max_n = 100 is the maximum test length to run.
+##   init = "x = randn(n, 1);"
+##     Initialization expression for function argument values.  Use 'k' 
+##     for the test number and 'n' for the size of the test.  This should
+##     compute values for all variables listed in args.  Note that init
+##     will be evaluated first for k=0, so things which are constant
+##     throughout the test can be computed then.
+##   f2 = []
+##     is an alternative expression to evaluate, so the speed of the two
+##     can be compared
+##   tol = eps
+##     if tol is inf, then no comparison will be made between the
+##     results of express f and expression f2.  Otherwise, expression
+##     f should produce a value v and expression f2 should produce
+##     a value v2, and these shall be compared using assert(v,v2,tol,err)
+##
+## r = speed (...)
+##   Returns the average speedup ratio instead of displaying and plotting.
+##
+## Some global variables are also referenced. Choose values suitable to
+## your machine and your work style.
+##    speed_test_plot = 1
+##       if true, plot a nice speed comparison graph
+##    speed_test_numtests = 25
+##       number of vector lengths to test
+##
+## Some comments on the graphs.  The line on the speedup ratio graph 
+## should be larger than 1 if your function is faster.  The slope on
+## the runtime graph shows you the O(f) speed characteristics.  Where it
+## is flat, execution time is O(1).  Where it is sloping, execution time
+## is O(n^m), with steeper slopes for larger n.  Generally vectorizing
+## a function will not change the slope of the run-time graph, but it
+## will shift it relative to the original.
+##
+## Example
+##   % If you had an original version of xcorr using for loops and
+##   % another version using FFT, you could compare the run speed
+##   % for various lags as follows, or for a fixed lag with varying
+##   % vector lengths as follows:
+##
+##   speed("v=xcorr(x,n)", "x=rand(128,1);", 100, ...
+##         "v2=xcorr_orig(x,n)", 100*eps,'rel')
+##   speed("v=xcorr(x,15)", "x=rand(20+n,1);", 100, ...
+##         "v2=xcorr_orig(x,n)", 100*eps,'rel')
+##
+##   % Assuming one of the two versions is in xcorr_orig, this would
+##   % would compare their speed and their output values.  Note that the
+##   % FFT version is not exact, so we specify an acceptable tolerance on
+##   % the comparison (100*eps), and the errors should be computed
+##   % relatively, as abs( (x-y)./y ) rather than absolutely as abs(x-y).
+##
+## Example
+##   speed("strrep(s,x,y)", "s=blanks(n);x=' ';y='b';", 100)
+##
+## Type example('speed') to see some real examples.  Note for 
+## obscure reasons, you can't run examples 1 and 2 directly using 
+## demo('speed').  Instead use: 
+##    eval(example('speed',1))
+##    eval(example('speed',2))
+
+## TODO: consider two dimensional speedup surfaces for functions like kron.
+function __ratio_r = speed (__f1, __init, __max_n, __f2, __tol, __err)
+  if nargin < 1 || nargin > 6, 
+    usage("speed_test(f, init, max_n, f2, tol, err)");
+  endif
+  if nargin < 2 || isempty(__init), 
+    __init = "x = randn(n, 1);";
+  endif
+  if nargin < 3 || isempty(__max_n), __max_n = 100; endif
+  if nargin < 4, __f2 = []; endif
+  if nargin < 5 || isempty(__tol), __tol = eps; endif
+  if nargin < 6 || isempty(__err), __err = []; endif
+
+  global speed_test_plot = 1;
+  global speed_test_numtests = 25;
+
+  __test_n = uniq(round(logspace(0,log10(__max_n),speed_test_numtests)));
+  __torig = __tnew = zeros (size(__test_n)) ;
+
+  disp (["testing..........", __f1, "\ninit: ", __init]);
+
+  ## make sure the functions are freshly loaded by evaluating them at
+  ## test_n(1); firt have to initialize the args though.
+  n=1; k=0;
+  eval ([__init, ";"]);
+  if !isempty(__f2), eval ([__f2, ";"]); endif
+  eval ([__f1, ";"]);
+
+  ## run the tests
+  for k=1:length(__test_n)
+    if (k > 1)
+      n=__test_n(k);
+      eval ([__init, ";"]);
+    endif
+    
+    printf ("n%i=%i  ",k, n) ; fflush(1);
+
+    eval (["__t=time();", __f1, "; __v1=ans; __t = time()-__t;"]);
+    if (__t < 0.25)
+      eval (["__t2=time();", __f1, "; __t2 = time()-__t2;"]);
+      eval (["__t3=time();", __f1, "; __t3 = time()-__t3;"]);
+      __t = min([__t,__t2,__t3]);
+    endif
+    __tnew(k) = __t;
+
+    if !isempty(__f2)
+      eval (["__t=time();", __f2, "; __v2=ans; __t = time()-__t;"]);
+      if (__t < 0.25)
+      	eval (["__t2=time();", __f2, "; __t2 = time()-__t2;"]);
+      	eval (["__t3=time();", __f2, "; __t3 = time()-__t3;"]);
+      endif
+      __torig(k) = __t;
+      if !isinf(__tol)
+      	assert(__v1,__v2,__tol,__err);
+      endif
+    endif
+    
+  end
+  
+  if !isempty(__f2),
+				# Don't keep zero times
+    idx = find ( __tnew>sqrt(eps) &  __torig>sqrt(eps) ) ;
+    ratio = mean (__torig(idx) ./ __tnew(idx));
+    if (nargout == 1)
+      __ratio_r = ratio;
+    else
+      printf ("\nmean runtime ratio of %s / %s : %g\n", __f2, __f1, ratio);
+    endif
+  else
+    if (nargout == 1)
+      _ratio_r = mean(__tnew);
+    else
+      printf ("\nmean runtime: %g\n", mean(__tnew));
+    endif
+  endif
+
+  if (speed_test_plot && nargout == 0 && !isempty(__f2))
+
+    if (gnuplot_has_multiplot) subplot(121); endif
+    xlabel("test length");
+    title (__f1);
+    ylabel("speedup ratio");
+    semilogx ( __test_n(idx), __torig(idx)./__tnew(idx) , 
+	      ["-*r;", strrep(__f1,";","."), "/", strrep(__f2,";","."), ";"],
+	       __test_n(idx), __tnew(idx)./__torig(idx) ,
+	      ["-*g;", strrep(__f2,";","."), "/", strrep(__f1,";","."), ";"]);
+    if (gnuplot_has_multiplot) 
+      subplot (122);
+    else
+      input ("Press any key for the next graph:", "s");
+    endif
+
+    ## convert best execution time to milliseconds.
+    __torig = 1000*__torig;
+    __tnew = 1000*__tnew;
+
+    ylabel ("best execution time (ms)");
+    title (["init: ", __init]);
+    loglog ( __test_n (idx), __tnew (idx), ["*-g;", strrep(__f1,";","."), ";" ], 
+	    __test_n (idx), __torig (idx), ["*-r;", strrep(__f2,";","."), ";"])
+    title (""); xlabel (""); ylabel (""); oneplot();
+  elseif (speed_test_plot && nargout == 0)
+    __tnew = 1000*__tnew;
+    xlabel("test length");
+    ylabel ("best execution time (ms)");
+    title ([__f1, "  init: ", __init]);
+    loglog ( __test_n, __tnew, "*-g;;");
+    title (""); xlabel (""); ylabel (""); oneplot();
+  endif
+  
+endfunction
+
+%!demo if 1
+%!  function x = build_orig(n)
+%!    ## extend the target vector on the fly
+%!    for i=0:n-1, x([1:10]+i*10) = 1:10; endfor
+%!  endfunction
+%!  function x = build(n)
+%!    ## preallocate the target vector
+%!    if (prefer_column_vectors), x = zeros(n*10, 1);
+%!    else x = zeros(1, n*10);  endif
+%!    for i=0:n-1, x([1:10]+i*10) = 1:10; endfor
+%!  endfunction
+%!
+%!  disp("-----------------------");
+%!  type build_orig;
+%!  disp("-----------------------");
+%!  type build;
+%!  disp("-----------------------");
+%!
+%!  disp("Preallocated vector test.\nThis takes a little while...");
+%!  speed('build', 'build_orig', 1000, 'v=n;');
+%!  clear build build_orig
+%!  disp("Note how much faster it is to pre-allocate a vector.");
+%!  disp("Notice the peak speedup ratio.");
+%!  clear build build_orig
+%! endif
+
+%!demo if 1
+%!  function x = build_orig(n)
+%!    for i=0:n-1, x([1:10]+i*10) = 1:10; endfor
+%!  endfunction
+%!  function x = build(n)
+%!    idx = [1:10]';
+%!    x = idx(:,ones(1,n));
+%!    if (prefer_column_vectors), x = reshape(x, n*10, 1);
+%!    else x = reshape(x, 1, n*10); endif
+%!  endfunction
+%!
+%!  disp("-----------------------");
+%!  type build_orig;
+%!  disp("-----------------------");
+%!  type build;
+%!  disp("-----------------------");
+%!
+%!  disp("Vectorized test. This takes a little while...");
+%!  speed('build', 'build_orig', 1000, 'v=n;');
+%!  clear build build_orig
+%!  disp("-----------------------");
+%!  disp("This time, the for loop is done away with entirely.");
+%!  disp("Notice how much bigger the speedup is then in example 1.");
+%! endif
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/testfun/test.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,586 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## test('name')
+##   Perform tests interactively, stopping at the first error.
+##   Tests are from the first file matching 'name', 'name.m' 
+##   in your loadpath.
+##
+## test('name', ['quiet'|'normal'|'verbose'])
+##   Perform tests interactively, stopping at the first error.
+##   'quiet': Don't report all the tests as they happen, just the errors.
+##   'normal': Report all tests as they happen, but don't do tests
+##       which require user interaction.
+##   'verbose': Do tests which require user interaction.
+##
+## test('name', ['quiet'|'normal'|'verbose'], fid)
+##   Batch processing.  Write errors to already open file fid (hopefully
+##   then when octave crashes this file will tell you what was happening
+##   when it did).  You can use stdout if you want to see the results as
+##   they happen.
+##
+## success = test(...)
+##   return true if all the tests succeeded.
+##
+## [code, idx] = test('name', 'grabdemo')
+##   Extract the contents of the demo blocks, but do not execute them.
+##   code is the concatenation of all the code blocks and
+##   idx is a vector of positions of the ends of the demo blocks.
+##
+## This function process the named script file looking for lines which
+## start with "%! ".  The prefix is stripped off and the rest of the
+## line is processed through the octave interpreter.  If the code
+## generates an error, then the test is said to fail.
+## 
+## Since eval() will stop at the first error it encounters, you must
+## divide your tests up into blocks, with anything in a separate
+## block evaluated separately.  Blocks are introduced by the keyword
+## 'test' immediately following the '%!'.  For example,
+##    %!test error("this test fails!");
+##    %!test "this test doesn't fail since it doesn't generate an error";
+## When a test fails, you will see something like:
+##      ***** test error('this test fails!')
+##    !!!!! test failed
+##    this test fails!
+##
+## Generally, to test if something works, you want to assert that it
+## produces a correct value.  A real test might look something like
+##    %!test
+##    %! A = [1, 2, 3; 4, 5, 6]; B = [1; 2];
+##    %! expect = [ A ; 2*A ];
+##    %! get = kron (B, A);
+##    %! if (any(size(expect) != size(get)))
+##    %!    error ("wrong size: expected %d,%d but got %d,%d",
+##    %!           size(expect), size(get));
+##    %! elseif (any(any(expect!=get)))
+##    %!    error ("didn't get what was expected.");
+##    %! endif
+## To make the process easier, use the assert function.  For example,
+## with assert the previous test is reduced to:
+##    %!test
+##    %! A = [1, 2, 3; 4, 5, 6]; B = [1; 2];
+##    %! assert (kron (B, A), [ A; 2*A ]);
+## Assert can accept a tolerance so that you can compare results
+## absolutely or relatively. For example, the following all succeed:
+##    %!test assert (1+eps, 1, 2*eps)
+##    %!test assert (100+100*eps, 100, 2*eps, 'rel')
+## You can also do the comparison yourself, but still have assert
+## generate the error:
+##    %!test assert (isempty([]))
+##    %!test assert ([ 1,2; 3,4 ] > 0)
+## Because assert is so frequently used alone in a test block, there
+## is a shorthand form:
+##    %!assert (...)
+## which is equivalent to:
+##    %!test assert (...)
+##
+## Each block is evaluated in its own function environment, which means
+## that variables defined in one block are not automatically shared
+## with other blocks.  If you do want to share variables, then you
+## must declare them as shared before you use them.  For example, the
+## following declares the variable A, gives it an initial value (default
+## is empty), then uses it in several subsequent tests.
+##    %!shared A
+##    %! A = [1, 2, 3; 4, 5, 6];
+##    %!assert (kron ([1; 2], A), [ A; 2*A ]);
+##    %!assert (kron ([1, 2], A), [ A, 2*A ]);
+##    %!assert (kron ([1,2; 3,4], A), [ A,2*A; 3*A,4*A ]);
+## You can share several variables at the same time:
+##    %!shared A, B
+## Note that all previous variables and values are lost when a new 
+## shared block is declared.
+##
+## In addition to testing if something works, you also want to test that
+## it fails cleanly.  Error blocks help with this.  They are like test
+## blocks, but they only succeed if the code generates an error.  You
+## will see the error generated if verbose is set. For example,
+##    %!error error('this test passes!');
+## produces
+##      ***** error error('this test passes!');
+##      #####
+##    this test passes!
+## If the code doesn't generate an error, the test fails. For example,
+##    %!error "this is an error because it succeeds.";
+## produces
+##      ***** error "this is an error because it succeeds.";
+##    !!!!! test failed: no error
+##
+## It is important to automate the tests as much as possible, however
+## some tests require user interaction.  These can be isolated into
+## demo blocks, which if you are in batch mode, are only run when 
+## called with 'demo' or 'verbose'.  The code is displayed before
+## it is executed. For example,
+##    %!demo
+##    %! t=0:0.01:2*pi; x=sin(t);
+##    %! plot(t,x);
+##    %! ## you should now see a sine wave in your figure window
+## produces
+##    > t=0:0.01:2*pi; x=sin(t);
+##    > plot(t,x);
+##    > ## you should now see a sine wave in your figure window
+##    Press <enter> to continue: 
+## Note that demo blocks cannot use any shared variables.  This is so
+## that they can be executed by themselves, ignoring all other tests.
+##
+## If you want to temporarily disable a test block, put '#' in place
+## of the block type.  This creates a comment block which is echoed
+## in the log file, but is not executed.  For example:
+##    %!#demo
+##    %! t=0:0.01:2*pi; x=sin(t);
+##    %! plot(t,x);
+##    %! ## you should now see a sine wave in your figure window
+##
+## Block type summary:
+##    %!test   - test block; fails if error is generated within it
+##    %!error  - error block; fails if error is not generated within it
+##    %!demo   - demo block; only executes in interactive mode
+##    %!#      - comment: ignore everything within the block
+##    %!shared x,y,z - declares variables for use in multiple tests
+##    %!assert (x, y, tol) - shorthand for %!test assert (x, y, tol)
+##
+## You can also create test scripts for builtins and your own C++
+## functions. Just put a file of the function name on your path without
+## any extension and it will be picked up by the test procedure.  You
+## can even embed tests directly in your C++ code:
+##    #if 0
+##    %! disp('this is a test')
+##    #endif
+## or
+##    /*
+##    %! disp('this is a test')
+##    */
+## but then the code will have to be on the load path and the user 
+## will have to remember to type test('name.cc').  Conversely, you
+## can separate the tests from normal octave script files by putting
+## them in plain files with no extension rather than in script files.
+## Don't forget to tell emacs that the plain text file you are using
+## is actually octave code, using something like:
+##    ## -*-octave-*-
+##
+## See Also: error, assert, demo, example, pretty
+
+## TODO: * Consider using keyword fail rather then error?  This allows us
+## TODO: to make a functional form of error blocks, which means we
+## TODO: can include them in test sections which means that we can use
+## TODO: octave flow control for both kinds of tests.
+## TODO: * Show pretty shared variable definitions if failure, which
+## TODO: will help determine why things are failing when you abstract
+## TODO: details of the test into shared variables; alternatively, use
+## TODO: some sort of line number, but that sounds complicated to
+## TODO: recover and won't help if we have multiple tests in the same
+## TODO: block.
+
+function [__ret1, __ret2] = test (__name, __flag, __fid)
+  if (nargin < 2 || isempty(__flag))
+    __flag = 'normal';
+  endif
+  if (nargin < 3) 
+    __fid = []; 
+  endif
+  if (nargin < 1 || nargin > 3 || !isstr(__name) || !isstr(__flag))
+    usage("success = test('name', ['quiet'|'normal'|'verbose'], fid)");
+  endif
+  __batch = (!isempty(__fid));
+
+  if (strcmp(__flag, "normal"))
+    __grabdemo = 0;
+    __rundemo = 0;
+    __hide_error = 0;
+    __verbose = __batch;
+  elseif (strcmp(__flag, "quiet"))
+    __grabdemo = 0;
+    __rundemo = 0;
+    __hide_error = 1;
+    __verbose = 0;
+  elseif (strcmp(__flag, "verbose"))
+    __grabdemo = 0;
+    __rundemo = 1;
+    __hide_error = 0;
+    __verbose = 1;
+  elseif (strcmp(__flag, "grabdemo"))
+    __grabdemo = 1;
+    __rundemo = 0;
+    __hide_error = 0;
+    __verbose = 0;
+    __demo_code = "";
+    __demo_idx = 1;
+  else
+    error(["test unknown flag '", __flag, "'"]);
+  endif
+
+  ## information from test will be introduced by "key" 
+  __signal_fail =  "!!!!! ";
+  __signal_empty = "????? ";
+  __signal_error = "  ##### ";
+  __signal_block = "  ***** ";
+  __signal_file =  ">>>>> ";
+
+  ## decide if error messages should be collected
+  if (__batch)
+    fputs (__fid, [__signal_file, "processing ", __name, "\n" ]);
+  else
+    __fid = stdout;
+  endif
+
+  ## locate the file to test
+  __file = file_in_loadpath (__name);
+  if (isempty (__file)) 
+    __file = file_in_loadpath ([__name, ".m"]);
+  endif
+  if (isempty (__file))
+    __file = file_in_loadpath ([__name, ".cc"]);
+  endif
+  if (isempty (__file))
+    if (__grabdemo)
+      __ret1 = "";
+      __ret2 = [];
+    else
+      fputs(__fid, [__signal_empty, __name, " does not exist in path\n" ]);
+      if (nargout > 0) __ret1 = 0; endif
+    endif
+    return;
+  endif
+
+  ## grab the test code from the file
+  __body = system([ "sed -n 's/^%!//p' ", __file]);
+  if (isempty (__body))
+    if (__grabdemo)
+      __ret1 = "";
+      __ret2 = [];
+    else
+      fputs(__fid, [ __signal_empty, __file, " has no tests available\n" ]);
+      if (nargout > 0) __ret1 = 0; endif
+    endif
+    return;
+  else
+    ## assume it starts and ends with test blocks
+    if (__body (length(__body)) == "\n")
+      __body = [ "\ntest\n", __body, "test" ]; 
+    else
+      __body = [ "\ntest\n", __body, "\ntest" ]; 
+    endif
+  endif
+
+  ## chop it up into blocks for evaluation
+  __lineidx = find(__body == "\n");
+  __blockidx = __lineidx(find(!isspace(__body(__lineidx+1))))+1;
+
+  ## ready to start tests ... if in batch mode, tell us what is happening
+  if (__verbose)
+    disp ([ __signal_file, __file ]);
+  endif
+
+  ## assume all tests will pass
+  __all_success = 1;
+
+  ## process each block separately, initially with no shared variables
+  __shared = " ";
+  __shared_r = " ";
+  for __i=1:length(__blockidx)-1
+
+    ## extract the block
+    __block = __body(__blockidx(__i):__blockidx(__i+1)-2);
+
+    ## let the user/logfile know what is happening
+    if (__verbose)
+      fputs (__fid, [__signal_block, __block, "\n"]);
+    endif
+
+    ## split __block into __type and __code
+    __idx = find(!isletter(__block));
+    if (isempty(__idx))
+      __type = __block;
+      __code = "";
+    else
+      __type = __block(1:__idx(1)-1);
+      __code = __block(__idx(1):length(__block));
+    endif
+
+    ## assume the block will succeed;
+    __success = 1;
+    __msg = [];
+    
+    ## DEMO
+    ## If in __grabdemo mode, then don't process any other block type.
+    ## So that the other block types don't have to worry about
+    ## this __grabdemo mode, the demo block processor grabs all block
+    ## types and skips those which aren't demo blocks.
+    __isdemo = strcmp (__type, "demo");
+    if (__grabdemo || __isdemo)
+
+      if (__grabdemo && __isdemo)
+	if (isempty(__demo_code))
+	  __demo_code = __code;
+	  __demo_idx = [ 1, length(__demo_code)+1 ];
+	else
+	  __demo_code = strcat(__demo_code, __code);
+	  __demo_idx = [ __demo_idx, length(__demo_code)+1 ];
+	endif
+
+      elseif (__rundemo && __isdemo)
+      	try
+	  ## process the code in an environment without variables
+      	  eval(["function __test__()\n", __code, "\nendfunction"]);
+	  __test__;
+	  input("Press <enter> to continue: ","s");
+      	catch
+	  __success = 0;
+	  __msg = [ __signal_fail, "demo failed\n", __error_text__];
+      	end_try_catch
+      	clear __test__;
+
+      endif
+      __code = ""; # code already processed
+      
+    ## SHARED
+    elseif strcmp (__type, "shared")
+      ## separate initialization code from variables
+      __idx = find(__code == "\n");
+      if (isempty(__idx))
+	__vars = __code;
+	__code = "";
+      else
+      	__vars = __code (1:__idx(1)-1);
+      	__code = __code (__idx(1):length(__code));
+      endif
+      
+      ## strip comments off the variables
+      __idx = find(__vars=="%" | __vars == "#");
+      if (!isempty(__idx))
+	__vars = __vars(1:__idx(1)-1);
+      endif
+      
+      ## assign default values to variables
+      try
+	__vars = deblank(__vars);
+	if (!isempty(__vars))
+	  eval([strrep(__vars,",","=[];"), "=[];"]);
+	  __shared = __vars;
+	  __shared_r = ["[ ", __vars, "] = "];
+      	else
+	  __shared = " ";
+	  __shared_r = " ";
+      	endif
+      catch
+	__code = "";  # couldn't declare, so don't initialize
+	__success = 0;
+	__msg = [ __signal_fail, "shared variable initialization failed\n"];
+      end_try_catch
+      
+      ## initialization code will be evaluated below
+    
+    ## ASSERT
+    elseif strcmp (__type, "assert")
+      __code = __block; # put the assert keyword back on the code
+      ## assert code will be evaluated below 
+      
+    ## ERROR
+    elseif strcmp (__type, "error")
+      try
+      	eval(["function ", __shared_r, "__test__(", __shared, ")\n", ...
+	      __code, "\nendfunction"]);
+      catch
+      	__success = 0;
+      	__msg = [ __signal_fail, "test failed: syntax error\n", __error_text__];
+      end_try_catch
+      
+      if (__success)
+      	__success = 0;
+      	__msg = [ __signal_fail, "test failed: no error\n" ];
+      	try
+	  eval([ __shared_r, "__test__(", __shared, ");"]);
+      	catch
+	  __success = 1;
+	  if (__hide_error)
+	    __msg = "";
+	  else
+	    __msg = [ __signal_error, "\n", __error_text__ ];
+	    __idx = index(__msg, "error:");
+	    if (__idx > 1) __msg = __msg(1:__idx-1); endif
+	  endif
+      	end_try_catch
+      	clear __test__;
+      endif
+      __code = ""; # code already processed
+      
+    ## TEST
+    elseif strcmp(__type, "test")
+      ## code will be evaluated below
+      
+    ## comment block
+    elseif strcmp (__block(1:1), "#")
+      __code = ""; # skip the code
+
+    else
+    ## unknown block
+      __success = 0;
+      __msg = [ __signal_fail, "unknown test type!\n"];
+      __code = ""; # skip the code
+    endif
+
+    ## evaluate code for test, shared, and assert.
+    if (!isempty(__code))
+      try
+      	eval(["function ", __shared_r, "__test__(", __shared, ")\n", ...
+	      __code, "\nendfunction"]);
+	eval([__shared_r, "__test__(", __shared, ");"]);
+      catch
+	__success = 0;
+	__msg = [ __signal_fail, "test failed\n", __error_text__];
+      end_try_catch
+      clear __test__;
+    endif
+    
+    ## All done.  Remember if we were successful and print any messages
+    if (!isempty(__msg))
+      ## make sure the user knows what caused the error
+      if (!__verbose)
+      	fputs (__fid, [__signal_block, __block, "\n"]);
+      endif
+      fputs (__fid, __msg);
+      if !strcmp(__type, "error"), eval (__shared); endif
+    endif
+    if (__success == 0)
+      __all_success = 0;
+      	## stop after one error if not in batch mode
+      if (!__batch)
+    	if (nargout > 0) __ret1 = 0; endif
+      	return;
+      endif
+    endif
+  endfor
+  if (nargout > 0)
+    if (__grabdemo)
+      __ret1 = __demo_code;
+      __ret2 = __demo_idx;
+    else
+      __ret1 = __all_success; 
+    endif
+  endif
+endfunction
+
+### example from toeplitz
+%!error toeplitz ([])
+%!error toeplitz ([1,2],[])
+%!error toeplitz ([1,2;3,4])
+%!error toeplitz ([1,2],[1,2;3,4])
+%!error toeplitz ([1,2;3,4],[1,2])
+%!error toeplitz
+%!error toeplitz (1, 2, 3)
+%!test  assert (toeplitz ([1,2,3], [1,4]), [1,4; 2,1; 3,2]);
+%!demo  toeplitz ([1,2,3,4],[1,5,6])
+
+### example from kron
+%!error kron
+%!error kron(1,2,3)
+%!test assert (isempty (kron ([], rand(3, 4))))
+%!test assert (isempty (kron (rand (3, 4), [])))
+%!test assert (isempty (kron ([], [])))
+%!shared A, B
+%!test
+%! A = [1, 2, 3; 4, 5, 6]; 
+%! B = [1, -1; 2, -2];
+%!assert (size (kron (zeros (3, 0), A)), [ 3*rows (A), 0 ])
+%!assert (size (kron (zeros (0, 3), A)), [ 0, 3*columns (A) ])
+%!assert (size (kron (A, zeros (3, 0))), [ 3*rows (A), 0 ])
+%!assert (size (kron (A, zeros (0, 3))), [ 0, 3*columns (A) ])
+%!assert (kron (pi, e), pi*e)
+%!assert (kron (pi, A), pi*A) 
+%!assert (kron (A, e), e*A)
+%!assert (kron ([1, 2, 3], A), [ A, 2*A, 3*A ])
+%!assert (kron ([1; 2; 3], A), [ A; 2*A; 3*A ])
+%!assert (kron ([1, 2; 3, 4], A), [ A, 2*A; 3*A, 4*A ])
+%!test
+%! res = [1,-1,2,-2,3,-3; 2,-2,4,-4,6,-6; 4,-4,5,-5,6,-6; 8,-8,10,-10,12,-12];
+%! assert (kron (A, B), res)
+
+### an extended demo from specgram
+%!#demo 
+%! ## Speech spectrogram
+%! [x, Fs] = auload(file_in_loadpath("sample.wav")); # audio file
+%! step = fix(5*Fs/1000);     # one spectral slice every 5 ms
+%! window = fix(40*Fs/1000);  # 40 ms data window
+%! fftn = 2^nextpow2(window); # next highest power of 2
+%! [S, f, t] = specgram(x, fftn, Fs, window, window-step);
+%! S = abs(S(2:fftn*4000/Fs,:)); # magnitude in range 0<f<=4000 Hz.
+%! S = S/max(max(S));         # normalize magnitude so that max is 0 dB.
+%! S = max(S, 10^(-40/10));   # clip below -40 dB.
+%! S = min(S, 10^(-3/10));    # clip above -3 dB.
+%! imagesc(flipud(20*log10(S)), 1);
+%! % you should now see a spectrogram in the image window
+
+
+### now test test itself
+
+%!## usage and error testing
+%!error  test                    # no args, generates usage()
+%!error  test(1,2,3,4)           # too many args, generates usage()
+%!error  test("test", 'bogus');  # incorrect args, generates error()
+%!error  garbage                 # usage on nonexistent function should be
+
+%!## test of shared variables
+%!shared a                # create a shared variable
+%!test   a=3;             # assign to a shared variable
+%!test   assert(a,3)      # variable should equal 3    
+%!shared b,c              # replace shared variables
+%!test assert (!exist("a"));   # a no longer exists
+%!test assert (isempty(b));    # variables start off empty
+%!shared a,b,c            # recreate a shared variable
+%!test assert (isempty(a));    # value is empty even if it had a previous value
+%!test a=1; b=2; c=3;   # give values to all variables
+%!test assert ([a,b,c],[1,2,3]); # test all of them together
+%!test c=6;             # update a value
+%!test assert([a, b, c],[1, 2, 6]); # show that the update sticks
+%!shared                    # clear all shared variables
+%!test assert(!exist("a"))  # show that they are cleared
+%!shared a,b,c              # support for initializer shorthand
+%! a=1; b=2; c=4;
+
+%!## test of assert block
+%!assert (isempty([]))      # support for test assert shorthand
+
+%!## demo blocks
+%!demo                   # multiline demo block
+%! t=0:0.01:2*pi; x=sin(t);
+%! plot(t,x);
+%! % you should now see a sine wave in your figure window
+%!demo a=3               # single line demo blocks work too
+
+%!## this is a comment block. it can contain anything.
+%!##
+%! it is the "#" as the block type that makes it a comment
+%! and it  stays as a comment even through continuation lines
+%! which means that it works well with commenting out whole tests
+
+%!## failure tests.  All the following should fail
+%!test   error("---------Failure tests.  Use test('test','verbose',1)");
+%!test   assert([a,b,c],[1,3,6]);   # variables have wrong values
+%!bogus                     # unknown block type
+%!error  toeplitz([1,2,3]); # correct usage
+%!test   syntax errors)     # syntax errors fail properly
+%!shared garbage in         # variables must be comma separated
+%!error  syntax++error      # error test fails on syntax errors
+%!error  "succeeds.";       # error test fails if code succeeds
+%!demo   with syntax error  # syntax errors in demo fail properly
+%!shared a,b,c              
+%!demo                      # shared variables not available in demo
+%! assert(exist("a"))
+%!error  
+%! test('/etc/passwd');
+%! test("nonexistent file");
+%! ## These don't signal an error, so the test for an error fails. Note 
+%! ## that the call doesn't reference the current fid (it is unavailable),
+%! ## so of course the informational message is not printed in the log.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/Makeconf.add	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,3 @@
+@DEFHAVE_TCLTK@
+@DEFHAVE_BLT@
+@DEFHAVE_VTK@
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,36 @@
+sinclude ../../Makeconf
+
+## Change this to the location of mkoctfile for your version of
+## octave linked against pthreads (see README).
+ifndef MKOCTFILE
+MKOCTFILE=mkoctfile-pthreads
+HAVE_TCLTK=1
+endif
+
+VTK_OPTS = -DHAVE_VTK -lVTKCommon -lVTKGraphics -lVTKImaging -lGL
+BLT_OPTS = -DHAVE_BLT -lBLT
+
+## Include either or both VTK_OPTS and BLT_OPTS if you have VTK/BLT installed
+ifdef HAVE_BLT
+OPTS += $(BLT_OPTS)
+endif
+ifdef HAVE_VTK
+OPTS += $(VTK_OPTS)
+endif
+
+## The remainder of this file should not need changing
+LIBS = -ltcl -ltk -lpthread
+
+ifdef HAVE_TCLTK
+all: tk_interp.oct
+else
+all:
+	@echo No Tcl/TK: tk_octave is not being built
+endif
+
+tk_interp.oct: tk_interp.cc
+	$(MKOCTFILE) -v $^ -o $@ $(OPTS) $(LIBS)
+
+clean:
+	-$(RM) core octave-core *.o *.oct *~
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/README	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,233 @@
+License
+=======
+
+This code is in the public domain. Use, modify, redistribute with or
+without modification, or license it as you see fit.
+
+Manifest
+========
+
+Files in this package are:
+
+readme.txt		This file
+
+sample.dat		Some sample Octave data, a 100x100 matrix
+
+tk_interp.cc		C++ source for a dynamically loaded Octave module
+			Contains routines for using BLT/VTK with Octave
+
+tk_matrix.tcl		Example Tcl/Tk GUI which uses BLT/VTK with Octave
+
+tk_matrix		Executable script that runs Octave and loads the
+			GUI from tk_matrix.tcl
+
+Makefile		The Makefile for tk_interp.cc
+
+rainbow.m		A colormap function
+
+tk_*.m			Various user interaction dialogs
+
+
+Compiling Octave with tk_interp.cc
+==================================
+
+In order to use tk_interp, we needed to relink the Octave binary with
+pthreads.
+
+1) Untar/gz the octave source to /someplace/octave
+
+2) Change directory to /someplace/octave and run ./configure
+
+4) Edit /someplace/octave/Makeconf, changing
+
+	LIBS = ...
+
+   to
+
+	LIBS = ... -lpthread
+
+   or maybe
+
+        LIBS = ... -lpthreads
+
+5) Change directory to /someplace/octave and run 'make' and optionally run
+   'make install' afterwards.  After installation (which by default is in
+   /usr/local/bin), rename octave to octave-pthreads and mkoctfile to
+   mkoctfile-pthreads
+
+
+Creating tk_interp.oct
+======================
+
+After relinking a custom version of Octave with pthreads, you'll need to 
+create tk_interp.oct.  Modify Makefile in the tk_octave directory to
+reference the appropriate mkoctfile for your custom version of Octave,
+and include either or both of $(BLT_OPTS) and $(VTK_OPTS) on the
+OPTS = ... line.  Type make and it should create tk_interp.oct for you.
+
+Note that to use BLT and VTK, you will need to link with code distributed
+under four different licenses:
+
+   1) Octave uses a GPL license.
+   2) Tcl/Tk uses a BSD-style license without advertising clause,
+      which is said to be GPL compatible.
+   3) BLT uses a BSD-style license with advertising clause, which
+      is said to be GPL incompatible.
+   4) VTK uses a BSD-style license without advertising clause, but
+      with a restriction against redistributing with modifications.
+
+The FSF considers linking as equivalent to modification.  Since
+Octave is GPL, this would mean that all parts of the program have 
+to be compatible since they won't work unless they are linked.
+Since this interpretation of the GPL has not yet been tested in
+any court, use your own judgement.
+
+Some simple tests
+=================
+
+Is it alive?
+
+	$ octave-pthreads
+	tk_interp
+	tk_cmd('toplevel .msg')
+	tk_cmd('button .msg.hello -text "Hello, world!" -command {destroy .msg}')
+	tk_cmd('pack .msg.hello')
+
+Can you get data from it?
+        tk_cmd('toplevel .data');
+	tk_cmd(sprintf('set value %f', pi));
+	tk_cmd('entry .data.entry -textvariable value');
+        tk_cmd('pack .data.entry');
+	tk_cmd('bind .data.entry <Return> {destroy .data}');
+	tk_cmd('tkwait window .data');
+	mypi = eval([tk_cmd('set value'), ";"])
+
+Try one of the built-in dialogs
+
+	tk_message("Hello, world!");
+
+Running the BLT/VTK example
+===========================
+
+In the tk_octave directory you should now be able to run the main example.
+This requires BLT, and can use TkTable and VTK if you have them. The 
+tk_matrix script needs to know the location of your custom version of 
+octave.  If it is not in /usr/local/bin/octave-pthreads, change the top 
+line of the script as appropriate, then type:
+
+	$ ./tk_matrix
+
+If you get the message that oct_mtov is not a proper command, then you 
+haven't specified OPTS = $(BLT_OPTS) in the Makefile.
+
+The example lets you view a 2D matrix of octave data as an image.  Click
+with the middle button to look at the X-Y cross sections at that point.
+Click with the left button, move, and click with the left button to zoom
+into a region of the matrix.  Click with the right button to return to the
+full image.  Click the "Table" button to view the data in a spreadsheet.
+
+You can type octave commands directly into the command window.  E.g.,
+    logsample = log(1+sample);
+
+You can view a different matrix by typing its name into the matrix
+name window.  Assuming you have defined logsample as above, then
+enter "logsample" into the window and press return.
+
+How it works
+============
+
+tk_interp.cc defines the following new commands in octave:
+
+  window_name = tk_interp() 
+     starts the tcl interpreter
+  result = tk_cmd()
+     sends a tcl command to the tcl interpreter
+  tk_loop()
+     waits on the tcl interpreter, processing callbacks as needed
+  tk_end()
+     ends the tcl interpreter
+
+tk_interp.cc defines the following new commands in tcl:
+
+  oct_cmd command
+    sends a callback to the octave interpreter.  All arguments are
+    glued together as one long command string.
+  oct_matrix name [exists|rows|cols|columns|min|max]
+    grabs info about a matrix from octave
+  oct_matrix name [elem|element] i j
+    grabs name(i,j) from octave
+  oct_string exist
+    grabs info about a string from octave
+  oct_string name
+    grabs name as a string from octave
+  oct_mtov name vector x y sizex sizey
+    grabs name(x:x+sizex,y:y+sizey) from octave and places
+    it into a BLT vector.
+  oct_mtovtk name VTKname
+    grabs a matrix from octave and places it into a VTK data structure
+  oct_quit 
+    ends the Octave interpreter
+
+  Note that if name starts with global::, it searches the global symbol table,
+  if name starts with top::, it searchs the top level symbol table.  If name
+  starts with current::, it searches the current symbol table.  The default
+  is to search the top level symbol table.
+
+  WARNING!!! There are concurrency issues to sort out which can be 
+  especially severe with current::, so use with caution.
+
+
+tk_interp also defines a new image format:
+
+  image create photo tclimage
+    defines a new variable tclimage which will contain a photo
+  tclimage configure -data "name"
+    like imagesc, scales the image according to the current colormap
+    This requires the following octave declaration before it will work:
+       global __current_color_map__ = gray(64);
+    Both name and __current_color_map__ are variables in the top level
+    symbol table.
+  tclimage configure -data "name -colormap map"
+    like imagesc, scales the image according to the colormap map
+    Both name and map are octave variables in the top level symbol table
+  tclimage configure -data "name -indexed"
+    like image, doesn't scale the image, but assumes that it's values
+    are are 1-origin indices into the colormap
+
+Projects
+========
+
+Modify tk_matrix.tcl so that you can enter either "z" or "x y z",
+and update the x and y axis limits appropriately.  Also give the
+programmer control over x, y and z axis labels and matrix title.
+
+Implement variable notification so that when the value changes in
+octave, the tcl matrix gets redrawn.
+
+Define a widget type in octave along with packing commands so
+that the user interface can be implemented entirely in Octave.
+
+Sort out concurrency issues.  Currently the tcl thread is looking at the
+octave variables while octave is running in a separate thread.  To see
+how much of a problem this is in practice, enter "sample" as the tk_matrix
+name (and press return), then type the following octave command:
+
+    for i=1:rows(sample), for j=1:columns(sample), sample(i,j)=log(1+sample(i,j)); end; end;
+
+While that command is executing, click on the matrix name entry box and press
+return.  You will see the matrix slowly change from linear to log scale.
+On my machine, this doesn't crash.  These are a couple of real race
+conditions underlying which could lead to a seg_fault, but the window is
+very small (not much wider than the amount of time it takes to copy the
+octave_value reference and update its reference count.  In practice, the
+octave main loop is going to be sitting in tk_cmd or tk_loop during almost
+all GUI interaction, so the issue will never come up, but you will have to
+think carefully about what you put in your tk_cmd and oct_cmd commands to
+be sure.  See SAFE_VAR in tk_interp.cc.
+
+Add an FSF approved "arm's length" separation between octave and tcl by
+sending matrices and commands through a pipe to a separate executable
+rather than copying them to a separate thread.  Alternatively, find a
+GPL compatible replacement for BLT and VTK.  You may still want to keep
+a separate thread in octave for the communication so that you can continue
+to access octave data asynchronously.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/configure.add	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,34 @@
+
+dnl Do we have tcl/tk?
+AC_SUBST(DEFHAVE_TCLTK)
+HAVE_TCLTK=1
+AC_CHECK_HEADERS(tcl.h tk.h,, HAVE_TCLTK=0)
+AC_CHECK_LIB(tcl, Tcl_Init,, HAVE_TCLTK=0)
+AC_CHECK_LIB(tk, Tk_Init,, HAVE_TCLTK=0)
+if test $HAVE_TCLTK = 1 ; then
+	DEFHAVE_TCLTK="HAVE_TCLTK=1"
+else
+	DEFHAVE_TCKTK=
+fi
+
+dnl Do we have BLT?
+AC_SUBST(DEFHAVE_BLT)
+HAVE_BLT=1
+AC_CHECK_HEADERS(blt.h,, HAVE_BLT=0)
+AC_CHECK_LIB(BLT, Blt_Init,, HAVE_BLT=0,-ltcl -ltk)
+if test $HAVE_BLT = 1 ; then
+	DEFHAVE_BLT="HAVE_BLT=1"
+else
+	DEFHAVE_BLT=
+fi
+
+dnl Do we have VTK?
+AC_SUBST(DEFHAVE_VTK)
+HAVE_VTK=1
+AC_CHECK_HEADERS(vtk/vtk.h,, HAVE_VTK=0)
+if test $HAVE_VTK = 1 ; then
+	DEFHAVE_VTK="HAVE_VTK=1"
+else
+	DEFHAVE_VTK=
+fi
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/rainbow.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,53 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} hsv (@var{n})
+## Create color colormap. 
+## (red through yellow, green, cyan,blue,magenta to red)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+## 2001-09-13 Paul Kienzle <pkienzle@users.sf.net>
+## * renamed to rainbow for use with tk_octave
+## * remove reference to __current_color_map__
+
+function map = rainbow (number)
+
+  if (nargin == 0)
+    number = length(colormap);
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("hsv: argument must be a scalar");
+    endif
+  else
+    usage ("hsv (number)");
+  endif
+
+  if (number == 1)
+    map = [1, 0, 0];  
+  elseif (number > 1)
+    h = linspace (0, 1, number)';
+    map = hsv2rgb ([h, ones(number, 1), ones(number, 1)]);
+  else
+    map = [];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/sample.dat	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,133 @@
+# Created by Octave 2.1.33, Thu Apr 26 16:21:52 2001 EDT <johnc@kazoo.ncnr.nist.gov>
+# name: sample
+# type: matrix
+# rows: 128
+# columns: 128
+8.0 8.0 3.0 3.0 11.0 11.0 20.0 20.0 28.0 28.0 21.0 21.0 22.0 22.0 18.0 18.0 28.0 28.0 32.0 32.0 20.0 20.0 22.0 22.0 33.0 33.0 34.0 34.0 24.0 24.0 21.0 21.0 27.0 27.0 18.0 18.0 17.0 17.0 23.0 23.0 32.0 32.0 30.0 30.0 32.0 32.0 42.0 42.0 33.0 33.0 32.0 32.0 41.0 41.0 47.0 47.0 39.0 39.0 43.0 43.0 65.0 65.0 79.0 79.0 71.0 71.0 70.0 70.0 57.0 57.0 59.0 59.0 54.0 54.0 38.0 38.0 44.0 44.0 31.0 31.0 34.0 34.0 30.0 30.0 20.0 20.0 29.0 29.0 23.0 23.0 26.0 26.0 26.0 26.0 26.0 26.0 20.0 20.0 22.0 22.0 23.0 23.0 18.0 18.0 20.0 20.0 24.0 24.0 24.0 24.0 23.0 23.0 22.0 22.0 25.0 25.0 18.0 18.0 16.0 16.0 16.0 16.0 2.0 2.0 0.0 0.0 1.0 1.0
+8.0 8.0 3.0 3.0 11.0 11.0 20.0 20.0 28.0 28.0 21.0 21.0 22.0 22.0 18.0 18.0 28.0 28.0 32.0 32.0 20.0 20.0 22.0 22.0 33.0 33.0 34.0 34.0 24.0 24.0 21.0 21.0 27.0 27.0 18.0 18.0 17.0 17.0 23.0 23.0 32.0 32.0 30.0 30.0 32.0 32.0 42.0 42.0 33.0 33.0 32.0 32.0 41.0 41.0 47.0 47.0 39.0 39.0 43.0 43.0 65.0 65.0 79.0 79.0 71.0 71.0 70.0 70.0 57.0 57.0 59.0 59.0 54.0 54.0 38.0 38.0 44.0 44.0 31.0 31.0 34.0 34.0 30.0 30.0 20.0 20.0 29.0 29.0 23.0 23.0 26.0 26.0 26.0 26.0 26.0 26.0 20.0 20.0 22.0 22.0 23.0 23.0 18.0 18.0 20.0 20.0 24.0 24.0 24.0 24.0 23.0 23.0 22.0 22.0 25.0 25.0 18.0 18.0 16.0 16.0 16.0 16.0 2.0 2.0 0.0 0.0 1.0 1.0
+0.0 0.0 13.0 13.0 16.0 16.0 19.0 19.0 30.0 30.0 24.0 24.0 23.0 23.0 26.0 26.0 15.0 15.0 26.0 26.0 19.0 19.0 24.0 24.0 27.0 27.0 29.0 29.0 34.0 34.0 30.0 30.0 27.0 27.0 31.0 31.0 29.0 29.0 23.0 23.0 26.0 26.0 31.0 31.0 26.0 26.0 34.0 34.0 37.0 37.0 53.0 53.0 39.0 39.0 46.0 46.0 56.0 56.0 88.0 88.0 92.0 92.0 101.0 101.0 85.0 85.0 107.0 107.0 99.0 99.0 71.0 71.0 67.0 67.0 54.0 54.0 54.0 54.0 42.0 42.0 38.0 38.0 31.0 31.0 29.0 29.0 27.0 27.0 27.0 27.0 36.0 36.0 31.0 31.0 30.0 30.0 29.0 29.0 36.0 36.0 21.0 21.0 24.0 24.0 23.0 23.0 33.0 33.0 17.0 17.0 25.0 25.0 18.0 18.0 19.0 19.0 24.0 24.0 23.0 23.0 21.0 21.0 18.0 18.0 8.0 8.0 3.0 3.0
+0.0 0.0 13.0 13.0 16.0 16.0 19.0 19.0 30.0 30.0 24.0 24.0 23.0 23.0 26.0 26.0 15.0 15.0 26.0 26.0 19.0 19.0 24.0 24.0 27.0 27.0 29.0 29.0 34.0 34.0 30.0 30.0 27.0 27.0 31.0 31.0 29.0 29.0 23.0 23.0 26.0 26.0 31.0 31.0 26.0 26.0 34.0 34.0 37.0 37.0 53.0 53.0 39.0 39.0 46.0 46.0 56.0 56.0 88.0 88.0 92.0 92.0 101.0 101.0 85.0 85.0 107.0 107.0 99.0 99.0 71.0 71.0 67.0 67.0 54.0 54.0 54.0 54.0 42.0 42.0 38.0 38.0 31.0 31.0 29.0 29.0 27.0 27.0 27.0 27.0 36.0 36.0 31.0 31.0 30.0 30.0 29.0 29.0 36.0 36.0 21.0 21.0 24.0 24.0 23.0 23.0 33.0 33.0 17.0 17.0 25.0 25.0 18.0 18.0 19.0 19.0 24.0 24.0 23.0 23.0 21.0 21.0 18.0 18.0 8.0 8.0 3.0 3.0
+2.0 2.0 23.0 23.0 24.0 24.0 26.0 26.0 16.0 16.0 20.0 20.0 31.0 31.0 21.0 21.0 23.0 23.0 24.0 24.0 27.0 27.0 34.0 34.0 24.0 24.0 31.0 31.0 30.0 30.0 30.0 30.0 27.0 27.0 23.0 23.0 25.0 25.0 24.0 24.0 31.0 31.0 41.0 41.0 33.0 33.0 54.0 54.0 55.0 55.0 59.0 59.0 67.0 67.0 78.0 78.0 85.0 85.0 101.0 101.0 133.0 133.0 155.0 155.0 128.0 128.0 137.0 137.0 110.0 110.0 87.0 87.0 74.0 74.0 62.0 62.0 37.0 37.0 44.0 44.0 46.0 46.0 48.0 48.0 46.0 46.0 28.0 28.0 22.0 22.0 33.0 33.0 38.0 38.0 27.0 27.0 25.0 25.0 22.0 22.0 25.0 25.0 32.0 32.0 19.0 19.0 22.0 22.0 30.0 30.0 21.0 21.0 23.0 23.0 22.0 22.0 19.0 19.0 26.0 26.0 19.0 19.0 23.0 23.0 13.0 13.0 2.0 2.0
+2.0 2.0 23.0 23.0 24.0 24.0 26.0 26.0 16.0 16.0 20.0 20.0 31.0 31.0 21.0 21.0 23.0 23.0 24.0 24.0 27.0 27.0 34.0 34.0 24.0 24.0 31.0 31.0 30.0 30.0 30.0 30.0 27.0 27.0 23.0 23.0 25.0 25.0 24.0 24.0 31.0 31.0 41.0 41.0 33.0 33.0 54.0 54.0 55.0 55.0 59.0 59.0 67.0 67.0 78.0 78.0 85.0 85.0 101.0 101.0 133.0 133.0 155.0 155.0 128.0 128.0 137.0 137.0 110.0 110.0 87.0 87.0 74.0 74.0 62.0 62.0 37.0 37.0 44.0 44.0 46.0 46.0 48.0 48.0 46.0 46.0 28.0 28.0 22.0 22.0 33.0 33.0 38.0 38.0 27.0 27.0 25.0 25.0 22.0 22.0 25.0 25.0 32.0 32.0 19.0 19.0 22.0 22.0 30.0 30.0 21.0 21.0 23.0 23.0 22.0 22.0 19.0 19.0 26.0 26.0 19.0 19.0 23.0 23.0 13.0 13.0 2.0 2.0
+3.0 3.0 25.0 25.0 26.0 26.0 14.0 14.0 14.0 14.0 21.0 21.0 27.0 27.0 26.0 26.0 13.0 13.0 22.0 22.0 21.0 21.0 23.0 23.0 21.0 21.0 18.0 18.0 30.0 30.0 34.0 34.0 23.0 23.0 32.0 32.0 30.0 30.0 39.0 39.0 25.0 25.0 22.0 22.0 40.0 40.0 31.0 31.0 38.0 38.0 55.0 55.0 70.0 70.0 58.0 58.0 87.0 87.0 118.0 118.0 147.0 147.0 142.0 142.0 142.0 142.0 149.0 149.0 134.0 134.0 131.0 131.0 91.0 91.0 63.0 63.0 52.0 52.0 45.0 45.0 54.0 54.0 52.0 52.0 39.0 39.0 30.0 30.0 36.0 36.0 29.0 29.0 35.0 35.0 27.0 27.0 25.0 25.0 27.0 27.0 23.0 23.0 35.0 35.0 29.0 29.0 17.0 17.0 21.0 21.0 24.0 24.0 26.0 26.0 21.0 21.0 24.0 24.0 24.0 24.0 13.0 13.0 24.0 24.0 20.0 20.0 4.0 4.0
+3.0 3.0 25.0 25.0 26.0 26.0 14.0 14.0 14.0 14.0 21.0 21.0 27.0 27.0 26.0 26.0 13.0 13.0 22.0 22.0 21.0 21.0 23.0 23.0 21.0 21.0 18.0 18.0 30.0 30.0 34.0 34.0 23.0 23.0 32.0 32.0 30.0 30.0 39.0 39.0 25.0 25.0 22.0 22.0 40.0 40.0 31.0 31.0 38.0 38.0 55.0 55.0 70.0 70.0 58.0 58.0 87.0 87.0 118.0 118.0 147.0 147.0 142.0 142.0 142.0 142.0 149.0 149.0 134.0 134.0 131.0 131.0 91.0 91.0 63.0 63.0 52.0 52.0 45.0 45.0 54.0 54.0 52.0 52.0 39.0 39.0 30.0 30.0 36.0 36.0 29.0 29.0 35.0 35.0 27.0 27.0 25.0 25.0 27.0 27.0 23.0 23.0 35.0 35.0 29.0 29.0 17.0 17.0 21.0 21.0 24.0 24.0 26.0 26.0 21.0 21.0 24.0 24.0 24.0 24.0 13.0 13.0 24.0 24.0 20.0 20.0 4.0 4.0
+6.0 6.0 30.0 30.0 27.0 27.0 27.0 27.0 38.0 38.0 16.0 16.0 21.0 21.0 29.0 29.0 18.0 18.0 19.0 19.0 31.0 31.0 25.0 25.0 20.0 20.0 30.0 30.0 42.0 42.0 34.0 34.0 35.0 35.0 31.0 31.0 32.0 32.0 39.0 39.0 37.0 37.0 32.0 32.0 39.0 39.0 47.0 47.0 35.0 35.0 55.0 55.0 77.0 77.0 80.0 80.0 88.0 88.0 150.0 150.0 143.0 143.0 163.0 163.0 168.0 168.0 134.0 134.0 143.0 143.0 102.0 102.0 80.0 80.0 68.0 68.0 72.0 72.0 41.0 41.0 49.0 49.0 36.0 36.0 46.0 46.0 41.0 41.0 40.0 40.0 42.0 42.0 28.0 28.0 34.0 34.0 34.0 34.0 33.0 33.0 29.0 29.0 18.0 18.0 23.0 23.0 30.0 30.0 22.0 22.0 28.0 28.0 22.0 22.0 23.0 23.0 26.0 26.0 14.0 14.0 15.0 15.0 22.0 22.0 35.0 35.0 4.0 4.0
+6.0 6.0 30.0 30.0 27.0 27.0 27.0 27.0 38.0 38.0 16.0 16.0 21.0 21.0 29.0 29.0 18.0 18.0 19.0 19.0 31.0 31.0 25.0 25.0 20.0 20.0 30.0 30.0 42.0 42.0 34.0 34.0 35.0 35.0 31.0 31.0 32.0 32.0 39.0 39.0 37.0 37.0 32.0 32.0 39.0 39.0 47.0 47.0 35.0 35.0 55.0 55.0 77.0 77.0 80.0 80.0 88.0 88.0 150.0 150.0 143.0 143.0 163.0 163.0 168.0 168.0 134.0 134.0 143.0 143.0 102.0 102.0 80.0 80.0 68.0 68.0 72.0 72.0 41.0 41.0 49.0 49.0 36.0 36.0 46.0 46.0 41.0 41.0 40.0 40.0 42.0 42.0 28.0 28.0 34.0 34.0 34.0 34.0 33.0 33.0 29.0 29.0 18.0 18.0 23.0 23.0 30.0 30.0 22.0 22.0 28.0 28.0 22.0 22.0 23.0 23.0 26.0 26.0 14.0 14.0 15.0 15.0 22.0 22.0 35.0 35.0 4.0 4.0
+4.0 4.0 19.0 19.0 27.0 27.0 26.0 26.0 33.0 33.0 26.0 26.0 23.0 23.0 27.0 27.0 28.0 28.0 34.0 34.0 27.0 27.0 25.0 25.0 30.0 30.0 31.0 31.0 38.0 38.0 32.0 32.0 33.0 33.0 35.0 35.0 46.0 46.0 42.0 42.0 29.0 29.0 54.0 54.0 50.0 50.0 60.0 60.0 52.0 52.0 63.0 63.0 65.0 65.0 74.0 74.0 108.0 108.0 134.0 134.0 123.0 123.0 150.0 150.0 149.0 149.0 124.0 124.0 115.0 115.0 94.0 94.0 88.0 88.0 75.0 75.0 66.0 66.0 64.0 64.0 60.0 60.0 53.0 53.0 42.0 42.0 49.0 49.0 44.0 44.0 35.0 35.0 23.0 23.0 30.0 30.0 34.0 34.0 35.0 35.0 23.0 23.0 17.0 17.0 26.0 26.0 24.0 24.0 29.0 29.0 15.0 15.0 34.0 34.0 20.0 20.0 29.0 29.0 35.0 35.0 25.0 25.0 24.0 24.0 18.0 18.0 3.0 3.0
+4.0 4.0 19.0 19.0 27.0 27.0 26.0 26.0 33.0 33.0 26.0 26.0 23.0 23.0 27.0 27.0 28.0 28.0 34.0 34.0 27.0 27.0 25.0 25.0 30.0 30.0 31.0 31.0 38.0 38.0 32.0 32.0 33.0 33.0 35.0 35.0 46.0 46.0 42.0 42.0 29.0 29.0 54.0 54.0 50.0 50.0 60.0 60.0 52.0 52.0 63.0 63.0 65.0 65.0 74.0 74.0 108.0 108.0 134.0 134.0 123.0 123.0 150.0 150.0 149.0 149.0 124.0 124.0 115.0 115.0 94.0 94.0 88.0 88.0 75.0 75.0 66.0 66.0 64.0 64.0 60.0 60.0 53.0 53.0 42.0 42.0 49.0 49.0 44.0 44.0 35.0 35.0 23.0 23.0 30.0 30.0 34.0 34.0 35.0 35.0 23.0 23.0 17.0 17.0 26.0 26.0 24.0 24.0 29.0 29.0 15.0 15.0 34.0 34.0 20.0 20.0 29.0 29.0 35.0 35.0 25.0 25.0 24.0 24.0 18.0 18.0 3.0 3.0
+8.0 8.0 21.0 21.0 22.0 22.0 24.0 24.0 24.0 24.0 29.0 29.0 19.0 19.0 22.0 22.0 21.0 21.0 24.0 24.0 22.0 22.0 27.0 27.0 34.0 34.0 37.0 37.0 27.0 27.0 44.0 44.0 37.0 37.0 42.0 42.0 42.0 42.0 38.0 38.0 56.0 56.0 43.0 43.0 64.0 64.0 62.0 62.0 58.0 58.0 82.0 82.0 79.0 79.0 86.0 86.0 100.0 100.0 126.0 126.0 120.0 120.0 109.0 109.0 128.0 128.0 125.0 125.0 114.0 114.0 92.0 92.0 110.0 110.0 96.0 96.0 78.0 78.0 68.0 68.0 45.0 45.0 40.0 40.0 45.0 45.0 30.0 30.0 49.0 49.0 26.0 26.0 39.0 39.0 36.0 36.0 44.0 44.0 20.0 20.0 32.0 32.0 15.0 15.0 38.0 38.0 24.0 24.0 25.0 25.0 36.0 36.0 26.0 26.0 32.0 32.0 16.0 16.0 20.0 20.0 19.0 19.0 17.0 17.0 19.0 19.0 3.0 3.0
+8.0 8.0 21.0 21.0 22.0 22.0 24.0 24.0 24.0 24.0 29.0 29.0 19.0 19.0 22.0 22.0 21.0 21.0 24.0 24.0 22.0 22.0 27.0 27.0 34.0 34.0 37.0 37.0 27.0 27.0 44.0 44.0 37.0 37.0 42.0 42.0 42.0 42.0 38.0 38.0 56.0 56.0 43.0 43.0 64.0 64.0 62.0 62.0 58.0 58.0 82.0 82.0 79.0 79.0 86.0 86.0 100.0 100.0 126.0 126.0 120.0 120.0 109.0 109.0 128.0 128.0 125.0 125.0 114.0 114.0 92.0 92.0 110.0 110.0 96.0 96.0 78.0 78.0 68.0 68.0 45.0 45.0 40.0 40.0 45.0 45.0 30.0 30.0 49.0 49.0 26.0 26.0 39.0 39.0 36.0 36.0 44.0 44.0 20.0 20.0 32.0 32.0 15.0 15.0 38.0 38.0 24.0 24.0 25.0 25.0 36.0 36.0 26.0 26.0 32.0 32.0 16.0 16.0 20.0 20.0 19.0 19.0 17.0 17.0 19.0 19.0 3.0 3.0
+4.0 4.0 11.0 11.0 25.0 25.0 15.0 15.0 22.0 22.0 26.0 26.0 15.0 15.0 29.0 29.0 21.0 21.0 39.0 39.0 35.0 35.0 22.0 22.0 39.0 39.0 40.0 40.0 34.0 34.0 39.0 39.0 44.0 44.0 49.0 49.0 45.0 45.0 40.0 40.0 42.0 42.0 66.0 66.0 70.0 70.0 60.0 60.0 71.0 71.0 90.0 90.0 92.0 92.0 93.0 93.0 94.0 94.0 100.0 100.0 96.0 96.0 116.0 116.0 115.0 115.0 116.0 116.0 107.0 107.0 97.0 97.0 94.0 94.0 90.0 90.0 77.0 77.0 82.0 82.0 64.0 64.0 58.0 58.0 60.0 60.0 41.0 41.0 52.0 52.0 47.0 47.0 38.0 38.0 37.0 37.0 40.0 40.0 33.0 33.0 28.0 28.0 36.0 36.0 24.0 24.0 26.0 26.0 20.0 20.0 30.0 30.0 36.0 36.0 24.0 24.0 30.0 30.0 23.0 23.0 23.0 23.0 25.0 25.0 22.0 22.0 2.0 2.0
+4.0 4.0 11.0 11.0 25.0 25.0 15.0 15.0 22.0 22.0 26.0 26.0 15.0 15.0 29.0 29.0 21.0 21.0 39.0 39.0 35.0 35.0 22.0 22.0 39.0 39.0 40.0 40.0 34.0 34.0 39.0 39.0 44.0 44.0 49.0 49.0 45.0 45.0 40.0 40.0 42.0 42.0 66.0 66.0 70.0 70.0 60.0 60.0 71.0 71.0 90.0 90.0 92.0 92.0 93.0 93.0 94.0 94.0 100.0 100.0 96.0 96.0 116.0 116.0 115.0 115.0 116.0 116.0 107.0 107.0 97.0 97.0 94.0 94.0 90.0 90.0 77.0 77.0 82.0 82.0 64.0 64.0 58.0 58.0 60.0 60.0 41.0 41.0 52.0 52.0 47.0 47.0 38.0 38.0 37.0 37.0 40.0 40.0 33.0 33.0 28.0 28.0 36.0 36.0 24.0 24.0 26.0 26.0 20.0 20.0 30.0 30.0 36.0 36.0 24.0 24.0 30.0 30.0 23.0 23.0 23.0 23.0 25.0 25.0 22.0 22.0 2.0 2.0
+5.0 5.0 28.0 28.0 17.0 17.0 12.0 12.0 20.0 20.0 19.0 19.0 23.0 23.0 16.0 16.0 18.0 18.0 22.0 22.0 32.0 32.0 30.0 30.0 39.0 39.0 28.0 28.0 37.0 37.0 41.0 41.0 54.0 54.0 50.0 50.0 43.0 43.0 53.0 53.0 59.0 59.0 59.0 59.0 68.0 68.0 88.0 88.0 68.0 68.0 84.0 84.0 96.0 96.0 109.0 109.0 127.0 127.0 102.0 102.0 124.0 124.0 129.0 129.0 101.0 101.0 111.0 111.0 105.0 105.0 96.0 96.0 131.0 131.0 102.0 102.0 101.0 101.0 77.0 77.0 74.0 74.0 79.0 79.0 58.0 58.0 70.0 70.0 52.0 52.0 56.0 56.0 55.0 55.0 31.0 31.0 44.0 44.0 44.0 44.0 52.0 52.0 41.0 41.0 32.0 32.0 39.0 39.0 31.0 31.0 27.0 27.0 26.0 26.0 28.0 28.0 20.0 20.0 16.0 16.0 27.0 27.0 25.0 25.0 27.0 27.0 2.0 2.0
+5.0 5.0 28.0 28.0 17.0 17.0 12.0 12.0 20.0 20.0 19.0 19.0 23.0 23.0 16.0 16.0 18.0 18.0 22.0 22.0 32.0 32.0 30.0 30.0 39.0 39.0 28.0 28.0 37.0 37.0 41.0 41.0 54.0 54.0 50.0 50.0 43.0 43.0 53.0 53.0 59.0 59.0 59.0 59.0 68.0 68.0 88.0 88.0 68.0 68.0 84.0 84.0 96.0 96.0 109.0 109.0 127.0 127.0 102.0 102.0 124.0 124.0 129.0 129.0 101.0 101.0 111.0 111.0 105.0 105.0 96.0 96.0 131.0 131.0 102.0 102.0 101.0 101.0 77.0 77.0 74.0 74.0 79.0 79.0 58.0 58.0 70.0 70.0 52.0 52.0 56.0 56.0 55.0 55.0 31.0 31.0 44.0 44.0 44.0 44.0 52.0 52.0 41.0 41.0 32.0 32.0 39.0 39.0 31.0 31.0 27.0 27.0 26.0 26.0 28.0 28.0 20.0 20.0 16.0 16.0 27.0 27.0 25.0 25.0 27.0 27.0 2.0 2.0
+4.0 4.0 28.0 28.0 21.0 21.0 19.0 19.0 30.0 30.0 25.0 25.0 31.0 31.0 32.0 32.0 29.0 29.0 28.0 28.0 40.0 40.0 29.0 29.0 38.0 38.0 41.0 41.0 42.0 42.0 39.0 39.0 58.0 58.0 35.0 35.0 57.0 57.0 57.0 57.0 74.0 74.0 85.0 85.0 99.0 99.0 93.0 93.0 91.0 91.0 108.0 108.0 122.0 122.0 136.0 136.0 128.0 128.0 132.0 132.0 115.0 115.0 140.0 140.0 120.0 120.0 130.0 130.0 123.0 123.0 111.0 111.0 124.0 124.0 129.0 129.0 126.0 126.0 104.0 104.0 104.0 104.0 106.0 106.0 94.0 94.0 67.0 67.0 62.0 62.0 57.0 57.0 51.0 51.0 38.0 38.0 48.0 48.0 39.0 39.0 37.0 37.0 51.0 51.0 40.0 40.0 27.0 27.0 38.0 38.0 31.0 31.0 32.0 32.0 27.0 27.0 30.0 30.0 24.0 24.0 21.0 21.0 25.0 25.0 21.0 21.0 3.0 3.0
+4.0 4.0 28.0 28.0 21.0 21.0 19.0 19.0 30.0 30.0 25.0 25.0 31.0 31.0 32.0 32.0 29.0 29.0 28.0 28.0 40.0 40.0 29.0 29.0 38.0 38.0 41.0 41.0 42.0 42.0 39.0 39.0 58.0 58.0 35.0 35.0 57.0 57.0 57.0 57.0 74.0 74.0 85.0 85.0 99.0 99.0 93.0 93.0 91.0 91.0 108.0 108.0 122.0 122.0 136.0 136.0 128.0 128.0 132.0 132.0 115.0 115.0 140.0 140.0 120.0 120.0 130.0 130.0 123.0 123.0 111.0 111.0 124.0 124.0 129.0 129.0 126.0 126.0 104.0 104.0 104.0 104.0 106.0 106.0 94.0 94.0 67.0 67.0 62.0 62.0 57.0 57.0 51.0 51.0 38.0 38.0 48.0 48.0 39.0 39.0 37.0 37.0 51.0 51.0 40.0 40.0 27.0 27.0 38.0 38.0 31.0 31.0 32.0 32.0 27.0 27.0 30.0 30.0 24.0 24.0 21.0 21.0 25.0 25.0 21.0 21.0 3.0 3.0
+7.0 7.0 15.0 15.0 24.0 24.0 25.0 25.0 17.0 17.0 23.0 23.0 19.0 19.0 24.0 24.0 36.0 36.0 41.0 41.0 43.0 43.0 47.0 47.0 42.0 42.0 33.0 33.0 49.0 49.0 57.0 57.0 66.0 66.0 50.0 50.0 67.0 67.0 79.0 79.0 91.0 91.0 101.0 101.0 94.0 94.0 129.0 129.0 157.0 157.0 152.0 152.0 146.0 146.0 186.0 186.0 173.0 173.0 162.0 162.0 178.0 178.0 174.0 174.0 173.0 173.0 150.0 150.0 177.0 177.0 164.0 164.0 191.0 191.0 134.0 134.0 158.0 158.0 139.0 139.0 133.0 133.0 106.0 106.0 103.0 103.0 99.0 99.0 67.0 67.0 69.0 69.0 77.0 77.0 64.0 64.0 44.0 44.0 46.0 46.0 38.0 38.0 49.0 49.0 44.0 44.0 27.0 27.0 37.0 37.0 44.0 44.0 29.0 29.0 33.0 33.0 21.0 21.0 31.0 31.0 16.0 16.0 23.0 23.0 22.0 22.0 0.0 0.0
+7.0 7.0 15.0 15.0 24.0 24.0 25.0 25.0 17.0 17.0 23.0 23.0 19.0 19.0 24.0 24.0 36.0 36.0 41.0 41.0 43.0 43.0 47.0 47.0 42.0 42.0 33.0 33.0 49.0 49.0 57.0 57.0 66.0 66.0 50.0 50.0 67.0 67.0 79.0 79.0 91.0 91.0 101.0 101.0 94.0 94.0 129.0 129.0 157.0 157.0 152.0 152.0 146.0 146.0 186.0 186.0 173.0 173.0 162.0 162.0 178.0 178.0 174.0 174.0 173.0 173.0 150.0 150.0 177.0 177.0 164.0 164.0 191.0 191.0 134.0 134.0 158.0 158.0 139.0 139.0 133.0 133.0 106.0 106.0 103.0 103.0 99.0 99.0 67.0 67.0 69.0 69.0 77.0 77.0 64.0 64.0 44.0 44.0 46.0 46.0 38.0 38.0 49.0 49.0 44.0 44.0 27.0 27.0 37.0 37.0 44.0 44.0 29.0 29.0 33.0 33.0 21.0 21.0 31.0 31.0 16.0 16.0 23.0 23.0 22.0 22.0 0.0 0.0
+6.0 6.0 27.0 27.0 28.0 28.0 26.0 26.0 24.0 24.0 36.0 36.0 40.0 40.0 39.0 39.0 44.0 44.0 41.0 41.0 47.0 47.0 57.0 57.0 41.0 41.0 47.0 47.0 57.0 57.0 58.0 58.0 46.0 46.0 73.0 73.0 85.0 85.0 95.0 95.0 102.0 102.0 93.0 93.0 115.0 115.0 183.0 183.0 152.0 152.0 215.0 215.0 217.0 217.0 234.0 234.0 180.0 180.0 214.0 214.0 236.0 236.0 196.0 196.0 207.0 207.0 217.0 217.0 212.0 212.0 224.0 224.0 227.0 227.0 241.0 241.0 230.0 230.0 189.0 189.0 158.0 158.0 144.0 144.0 133.0 133.0 97.0 97.0 102.0 102.0 90.0 90.0 73.0 73.0 59.0 59.0 63.0 63.0 67.0 67.0 58.0 58.0 37.0 37.0 51.0 51.0 53.0 53.0 45.0 45.0 43.0 43.0 34.0 34.0 31.0 31.0 28.0 28.0 34.0 34.0 35.0 35.0 17.0 17.0 21.0 21.0 2.0 2.0
+6.0 6.0 27.0 27.0 28.0 28.0 26.0 26.0 24.0 24.0 36.0 36.0 40.0 40.0 39.0 39.0 44.0 44.0 41.0 41.0 47.0 47.0 57.0 57.0 41.0 41.0 47.0 47.0 57.0 57.0 58.0 58.0 46.0 46.0 73.0 73.0 85.0 85.0 95.0 95.0 102.0 102.0 93.0 93.0 115.0 115.0 183.0 183.0 152.0 152.0 215.0 215.0 217.0 217.0 234.0 234.0 180.0 180.0 214.0 214.0 236.0 236.0 196.0 196.0 207.0 207.0 217.0 217.0 212.0 212.0 224.0 224.0 227.0 227.0 241.0 241.0 230.0 230.0 189.0 189.0 158.0 158.0 144.0 144.0 133.0 133.0 97.0 97.0 102.0 102.0 90.0 90.0 73.0 73.0 59.0 59.0 63.0 63.0 67.0 67.0 58.0 58.0 37.0 37.0 51.0 51.0 53.0 53.0 45.0 45.0 43.0 43.0 34.0 34.0 31.0 31.0 28.0 28.0 34.0 34.0 35.0 35.0 17.0 17.0 21.0 21.0 2.0 2.0
+8.0 8.0 18.0 18.0 18.0 18.0 26.0 26.0 29.0 29.0 34.0 34.0 38.0 38.0 42.0 42.0 49.0 49.0 62.0 62.0 68.0 68.0 64.0 64.0 65.0 65.0 62.0 62.0 72.0 72.0 70.0 70.0 67.0 67.0 62.0 62.0 109.0 109.0 108.0 108.0 140.0 140.0 180.0 180.0 230.0 230.0 234.0 234.0 259.0 259.0 315.0 315.0 312.0 312.0 346.0 346.0 265.0 265.0 315.0 315.0 265.0 265.0 262.0 262.0 247.0 247.0 271.0 271.0 295.0 295.0 286.0 286.0 312.0 312.0 315.0 315.0 311.0 311.0 278.0 278.0 268.0 268.0 220.0 220.0 219.0 219.0 151.0 151.0 112.0 112.0 96.0 96.0 83.0 83.0 70.0 70.0 69.0 69.0 58.0 58.0 71.0 71.0 45.0 45.0 63.0 63.0 58.0 58.0 50.0 50.0 57.0 57.0 47.0 47.0 31.0 31.0 37.0 37.0 26.0 26.0 40.0 40.0 29.0 29.0 38.0 38.0 5.0 5.0
+8.0 8.0 18.0 18.0 18.0 18.0 26.0 26.0 29.0 29.0 34.0 34.0 38.0 38.0 42.0 42.0 49.0 49.0 62.0 62.0 68.0 68.0 64.0 64.0 65.0 65.0 62.0 62.0 72.0 72.0 70.0 70.0 67.0 67.0 62.0 62.0 109.0 109.0 108.0 108.0 140.0 140.0 180.0 180.0 230.0 230.0 234.0 234.0 259.0 259.0 315.0 315.0 312.0 312.0 346.0 346.0 265.0 265.0 315.0 315.0 265.0 265.0 262.0 262.0 247.0 247.0 271.0 271.0 295.0 295.0 286.0 286.0 312.0 312.0 315.0 315.0 311.0 311.0 278.0 278.0 268.0 268.0 220.0 220.0 219.0 219.0 151.0 151.0 112.0 112.0 96.0 96.0 83.0 83.0 70.0 70.0 69.0 69.0 58.0 58.0 71.0 71.0 45.0 45.0 63.0 63.0 58.0 58.0 50.0 50.0 57.0 57.0 47.0 47.0 31.0 31.0 37.0 37.0 26.0 26.0 40.0 40.0 29.0 29.0 38.0 38.0 5.0 5.0
+6.0 6.0 28.0 28.0 39.0 39.0 28.0 28.0 40.0 40.0 43.0 43.0 66.0 66.0 54.0 54.0 64.0 64.0 94.0 94.0 77.0 77.0 65.0 65.0 88.0 88.0 67.0 67.0 82.0 82.0 102.0 102.0 85.0 85.0 112.0 112.0 117.0 117.0 136.0 136.0 174.0 174.0 240.0 240.0 293.0 293.0 345.0 345.0 387.0 387.0 403.0 403.0 408.0 408.0 416.0 416.0 357.0 357.0 327.0 327.0 334.0 334.0 320.0 320.0 310.0 310.0 309.0 309.0 350.0 350.0 316.0 316.0 353.0 353.0 442.0 442.0 431.0 431.0 417.0 417.0 391.0 391.0 312.0 312.0 287.0 287.0 187.0 187.0 183.0 183.0 149.0 149.0 127.0 127.0 92.0 92.0 97.0 97.0 73.0 73.0 86.0 86.0 65.0 65.0 61.0 61.0 69.0 69.0 66.0 66.0 90.0 90.0 60.0 60.0 57.0 57.0 53.0 53.0 37.0 37.0 28.0 28.0 33.0 33.0 22.0 22.0 7.0 7.0
+6.0 6.0 28.0 28.0 39.0 39.0 28.0 28.0 40.0 40.0 43.0 43.0 66.0 66.0 54.0 54.0 64.0 64.0 94.0 94.0 77.0 77.0 65.0 65.0 88.0 88.0 67.0 67.0 82.0 82.0 102.0 102.0 85.0 85.0 112.0 112.0 117.0 117.0 136.0 136.0 174.0 174.0 240.0 240.0 293.0 293.0 345.0 345.0 387.0 387.0 403.0 403.0 408.0 408.0 416.0 416.0 357.0 357.0 327.0 327.0 334.0 334.0 320.0 320.0 310.0 310.0 309.0 309.0 350.0 350.0 316.0 316.0 353.0 353.0 442.0 442.0 431.0 431.0 417.0 417.0 391.0 391.0 312.0 312.0 287.0 287.0 187.0 187.0 183.0 183.0 149.0 149.0 127.0 127.0 92.0 92.0 97.0 97.0 73.0 73.0 86.0 86.0 65.0 65.0 61.0 61.0 69.0 69.0 66.0 66.0 90.0 90.0 60.0 60.0 57.0 57.0 53.0 53.0 37.0 37.0 28.0 28.0 33.0 33.0 22.0 22.0 7.0 7.0
+11.0 11.0 21.0 21.0 21.0 21.0 37.0 37.0 46.0 46.0 85.0 85.0 78.0 78.0 97.0 97.0 98.0 98.0 101.0 101.0 98.0 98.0 70.0 70.0 69.0 69.0 71.0 71.0 79.0 79.0 99.0 99.0 133.0 133.0 136.0 136.0 176.0 176.0 216.0 216.0 295.0 295.0 375.0 375.0 516.0 516.0 650.0 650.0 733.0 733.0 663.0 663.0 585.0 585.0 511.0 511.0 468.0 468.0 406.0 406.0 349.0 349.0 331.0 331.0 354.0 354.0 382.0 382.0 403.0 403.0 404.0 404.0 445.0 445.0 573.0 573.0 647.0 647.0 693.0 693.0 682.0 682.0 614.0 614.0 412.0 412.0 305.0 305.0 253.0 253.0 191.0 191.0 135.0 135.0 110.0 110.0 112.0 112.0 122.0 122.0 81.0 81.0 73.0 73.0 75.0 75.0 74.0 74.0 102.0 102.0 87.0 87.0 110.0 110.0 89.0 89.0 77.0 77.0 71.0 71.0 36.0 36.0 31.0 31.0 34.0 34.0 7.0 7.0
+11.0 11.0 21.0 21.0 21.0 21.0 37.0 37.0 46.0 46.0 85.0 85.0 78.0 78.0 97.0 97.0 98.0 98.0 101.0 101.0 98.0 98.0 70.0 70.0 69.0 69.0 71.0 71.0 79.0 79.0 99.0 99.0 133.0 133.0 136.0 136.0 176.0 176.0 216.0 216.0 295.0 295.0 375.0 375.0 516.0 516.0 650.0 650.0 733.0 733.0 663.0 663.0 585.0 585.0 511.0 511.0 468.0 468.0 406.0 406.0 349.0 349.0 331.0 331.0 354.0 354.0 382.0 382.0 403.0 403.0 404.0 404.0 445.0 445.0 573.0 573.0 647.0 647.0 693.0 693.0 682.0 682.0 614.0 614.0 412.0 412.0 305.0 305.0 253.0 253.0 191.0 191.0 135.0 135.0 110.0 110.0 112.0 112.0 122.0 122.0 81.0 81.0 73.0 73.0 75.0 75.0 74.0 74.0 102.0 102.0 87.0 87.0 110.0 110.0 89.0 89.0 77.0 77.0 71.0 71.0 36.0 36.0 31.0 31.0 34.0 34.0 7.0 7.0
+9.0 9.0 22.0 22.0 32.0 32.0 41.0 41.0 67.0 67.0 100.0 100.0 121.0 121.0 122.0 122.0 108.0 108.0 132.0 132.0 98.0 98.0 90.0 90.0 84.0 84.0 99.0 99.0 106.0 106.0 134.0 134.0 142.0 142.0 169.0 169.0 183.0 183.0 303.0 303.0 417.0 417.0 673.0 673.0 994.0 994.0 1229.0 1229.0 1359.0 1359.0 1105.0 1105.0 970.0 970.0 690.0 690.0 565.0 565.0 443.0 443.0 392.0 392.0 342.0 342.0 329.0 329.0 393.0 393.0 399.0 399.0 484.0 484.0 591.0 591.0 704.0 704.0 1044.0 1044.0 1254.0 1254.0 1435.0 1435.0 1224.0 1224.0 893.0 893.0 571.0 571.0 365.0 365.0 233.0 233.0 221.0 221.0 141.0 141.0 128.0 128.0 100.0 100.0 92.0 92.0 94.0 94.0 87.0 87.0 96.0 96.0 99.0 99.0 120.0 120.0 133.0 133.0 125.0 125.0 111.0 111.0 84.0 84.0 56.0 56.0 48.0 48.0 36.0 36.0 9.0 9.0
+9.0 9.0 22.0 22.0 32.0 32.0 41.0 41.0 67.0 67.0 100.0 100.0 121.0 121.0 122.0 122.0 108.0 108.0 132.0 132.0 98.0 98.0 90.0 90.0 84.0 84.0 99.0 99.0 106.0 106.0 134.0 134.0 142.0 142.0 169.0 169.0 183.0 183.0 303.0 303.0 417.0 417.0 673.0 673.0 994.0 994.0 1229.0 1229.0 1359.0 1359.0 1105.0 1105.0 970.0 970.0 690.0 690.0 565.0 565.0 443.0 443.0 392.0 392.0 342.0 342.0 329.0 329.0 393.0 393.0 399.0 399.0 484.0 484.0 591.0 591.0 704.0 704.0 1044.0 1044.0 1254.0 1254.0 1435.0 1435.0 1224.0 1224.0 893.0 893.0 571.0 571.0 365.0 365.0 233.0 233.0 221.0 221.0 141.0 141.0 128.0 128.0 100.0 100.0 92.0 92.0 94.0 94.0 87.0 87.0 96.0 96.0 99.0 99.0 120.0 120.0 133.0 133.0 125.0 125.0 111.0 111.0 84.0 84.0 56.0 56.0 48.0 48.0 36.0 36.0 9.0 9.0
+5.0 5.0 40.0 40.0 46.0 46.0 57.0 57.0 93.0 93.0 114.0 114.0 172.0 172.0 180.0 180.0 152.0 152.0 195.0 195.0 128.0 128.0 102.0 102.0 109.0 109.0 123.0 123.0 128.0 128.0 147.0 147.0 196.0 196.0 221.0 221.0 295.0 295.0 489.0 489.0 796.0 796.0 1365.0 1365.0 2166.0 2166.0 2800.0 2800.0 2768.0 2768.0 2172.0 2172.0 1372.0 1372.0 871.0 871.0 577.0 577.0 484.0 484.0 373.0 373.0 402.0 402.0 370.0 370.0 407.0 407.0 371.0 371.0 476.0 476.0 603.0 603.0 967.0 967.0 1464.0 1464.0 2387.0 2387.0 2878.0 2878.0 2739.0 2739.0 1876.0 1876.0 1137.0 1137.0 659.0 659.0 421.0 421.0 286.0 286.0 197.0 197.0 160.0 160.0 122.0 122.0 98.0 98.0 105.0 105.0 93.0 93.0 102.0 102.0 127.0 127.0 149.0 149.0 183.0 183.0 168.0 168.0 149.0 149.0 134.0 134.0 65.0 65.0 41.0 41.0 45.0 45.0 15.0 15.0
+5.0 5.0 40.0 40.0 46.0 46.0 57.0 57.0 93.0 93.0 114.0 114.0 172.0 172.0 180.0 180.0 152.0 152.0 195.0 195.0 128.0 128.0 102.0 102.0 109.0 109.0 123.0 123.0 128.0 128.0 147.0 147.0 196.0 196.0 221.0 221.0 295.0 295.0 489.0 489.0 796.0 796.0 1365.0 1365.0 2166.0 2166.0 2800.0 2800.0 2768.0 2768.0 2172.0 2172.0 1372.0 1372.0 871.0 871.0 577.0 577.0 484.0 484.0 373.0 373.0 402.0 402.0 370.0 370.0 407.0 407.0 371.0 371.0 476.0 476.0 603.0 603.0 967.0 967.0 1464.0 1464.0 2387.0 2387.0 2878.0 2878.0 2739.0 2739.0 1876.0 1876.0 1137.0 1137.0 659.0 659.0 421.0 421.0 286.0 286.0 197.0 197.0 160.0 160.0 122.0 122.0 98.0 98.0 105.0 105.0 93.0 93.0 102.0 102.0 127.0 127.0 149.0 149.0 183.0 183.0 168.0 168.0 149.0 149.0 134.0 134.0 65.0 65.0 41.0 41.0 45.0 45.0 15.0 15.0
+19.0 19.0 31.0 31.0 56.0 56.0 84.0 84.0 128.0 128.0 155.0 155.0 216.0 216.0 168.0 168.0 163.0 163.0 171.0 171.0 135.0 135.0 103.0 103.0 125.0 125.0 112.0 112.0 139.0 139.0 186.0 186.0 224.0 224.0 296.0 296.0 415.0 415.0 698.0 698.0 1293.0 1293.0 2210.0 2210.0 3517.0 3517.0 4458.0 4458.0 4088.0 4088.0 2670.0 2670.0 1508.0 1508.0 827.0 827.0 527.0 527.0 410.0 410.0 335.0 335.0 332.0 332.0 315.0 315.0 325.0 325.0 366.0 366.0 410.0 410.0 551.0 551.0 887.0 887.0 1770.0 1770.0 3054.0 3054.0 4542.0 4542.0 4401.0 4401.0 3399.0 3399.0 1935.0 1935.0 1123.0 1123.0 604.0 604.0 358.0 358.0 260.0 260.0 215.0 215.0 179.0 179.0 127.0 127.0 110.0 110.0 101.0 101.0 93.0 93.0 117.0 117.0 161.0 161.0 193.0 193.0 217.0 217.0 202.0 202.0 135.0 135.0 118.0 118.0 67.0 67.0 42.0 42.0 10.0 10.0
+19.0 19.0 31.0 31.0 56.0 56.0 84.0 84.0 128.0 128.0 155.0 155.0 216.0 216.0 168.0 168.0 163.0 163.0 171.0 171.0 135.0 135.0 103.0 103.0 125.0 125.0 112.0 112.0 139.0 139.0 186.0 186.0 224.0 224.0 296.0 296.0 415.0 415.0 698.0 698.0 1293.0 1293.0 2210.0 2210.0 3517.0 3517.0 4458.0 4458.0 4088.0 4088.0 2670.0 2670.0 1508.0 1508.0 827.0 827.0 527.0 527.0 410.0 410.0 335.0 335.0 332.0 332.0 315.0 315.0 325.0 325.0 366.0 366.0 410.0 410.0 551.0 551.0 887.0 887.0 1770.0 1770.0 3054.0 3054.0 4542.0 4542.0 4401.0 4401.0 3399.0 3399.0 1935.0 1935.0 1123.0 1123.0 604.0 604.0 358.0 358.0 260.0 260.0 215.0 215.0 179.0 179.0 127.0 127.0 110.0 110.0 101.0 101.0 93.0 93.0 117.0 117.0 161.0 161.0 193.0 193.0 217.0 217.0 202.0 202.0 135.0 135.0 118.0 118.0 67.0 67.0 42.0 42.0 10.0 10.0
+12.0 12.0 37.0 37.0 54.0 54.0 89.0 89.0 135.0 135.0 191.0 191.0 204.0 204.0 222.0 222.0 218.0 218.0 195.0 195.0 136.0 136.0 110.0 110.0 134.0 134.0 137.0 137.0 146.0 146.0 219.0 219.0 293.0 293.0 383.0 383.0 585.0 585.0 973.0 973.0 1715.0 1715.0 2887.0 2887.0 4235.0 4235.0 4774.0 4774.0 4125.0 4125.0 2439.0 2439.0 1190.0 1190.0 658.0 658.0 437.0 437.0 340.0 340.0 354.0 354.0 279.0 279.0 314.0 314.0 279.0 279.0 336.0 336.0 372.0 372.0 425.0 425.0 735.0 735.0 1479.0 1479.0 2875.0 2875.0 4451.0 4451.0 4863.0 4863.0 4045.0 4045.0 2515.0 2515.0 1492.0 1492.0 845.0 845.0 517.0 517.0 348.0 348.0 254.0 254.0 205.0 205.0 163.0 163.0 129.0 129.0 107.0 107.0 118.0 118.0 119.0 119.0 148.0 148.0 190.0 190.0 205.0 205.0 220.0 220.0 148.0 148.0 119.0 119.0 69.0 69.0 49.0 49.0 13.0 13.0
+12.0 12.0 37.0 37.0 54.0 54.0 89.0 89.0 135.0 135.0 191.0 191.0 204.0 204.0 222.0 222.0 218.0 218.0 195.0 195.0 136.0 136.0 110.0 110.0 134.0 134.0 137.0 137.0 146.0 146.0 219.0 219.0 293.0 293.0 383.0 383.0 585.0 585.0 973.0 973.0 1715.0 1715.0 2887.0 2887.0 4235.0 4235.0 4774.0 4774.0 4125.0 4125.0 2439.0 2439.0 1190.0 1190.0 658.0 658.0 437.0 437.0 340.0 340.0 354.0 354.0 279.0 279.0 314.0 314.0 279.0 279.0 336.0 336.0 372.0 372.0 425.0 425.0 735.0 735.0 1479.0 1479.0 2875.0 2875.0 4451.0 4451.0 4863.0 4863.0 4045.0 4045.0 2515.0 2515.0 1492.0 1492.0 845.0 845.0 517.0 517.0 348.0 348.0 254.0 254.0 205.0 205.0 163.0 163.0 129.0 129.0 107.0 107.0 118.0 118.0 119.0 119.0 148.0 148.0 190.0 190.0 205.0 205.0 220.0 220.0 148.0 148.0 119.0 119.0 69.0 69.0 49.0 49.0 13.0 13.0
+18.0 18.0 40.0 40.0 53.0 53.0 85.0 85.0 154.0 154.0 162.0 162.0 188.0 188.0 201.0 201.0 155.0 155.0 157.0 157.0 102.0 102.0 112.0 112.0 107.0 107.0 150.0 150.0 183.0 183.0 298.0 298.0 327.0 327.0 459.0 459.0 757.0 757.0 1124.0 1124.0 1675.0 1675.0 2538.0 2538.0 3229.0 3229.0 3418.0 3418.0 2661.0 2661.0 1635.0 1635.0 738.0 738.0 452.0 452.0 294.0 294.0 302.0 302.0 277.0 277.0 225.0 225.0 283.0 283.0 245.0 245.0 268.0 268.0 284.0 284.0 329.0 329.0 451.0 451.0 812.0 812.0 1659.0 1659.0 2896.0 2896.0 3330.0 3330.0 3125.0 3125.0 2239.0 2239.0 1507.0 1507.0 987.0 987.0 621.0 621.0 357.0 357.0 314.0 314.0 203.0 203.0 153.0 153.0 154.0 154.0 117.0 117.0 114.0 114.0 96.0 96.0 156.0 156.0 158.0 158.0 184.0 184.0 196.0 196.0 162.0 162.0 103.0 103.0 62.0 62.0 55.0 55.0 28.0 28.0
+18.0 18.0 40.0 40.0 53.0 53.0 85.0 85.0 154.0 154.0 162.0 162.0 188.0 188.0 201.0 201.0 155.0 155.0 157.0 157.0 102.0 102.0 112.0 112.0 107.0 107.0 150.0 150.0 183.0 183.0 298.0 298.0 327.0 327.0 459.0 459.0 757.0 757.0 1124.0 1124.0 1675.0 1675.0 2538.0 2538.0 3229.0 3229.0 3418.0 3418.0 2661.0 2661.0 1635.0 1635.0 738.0 738.0 452.0 452.0 294.0 294.0 302.0 302.0 277.0 277.0 225.0 225.0 283.0 283.0 245.0 245.0 268.0 268.0 284.0 284.0 329.0 329.0 451.0 451.0 812.0 812.0 1659.0 1659.0 2896.0 2896.0 3330.0 3330.0 3125.0 3125.0 2239.0 2239.0 1507.0 1507.0 987.0 987.0 621.0 621.0 357.0 357.0 314.0 314.0 203.0 203.0 153.0 153.0 154.0 154.0 117.0 117.0 114.0 114.0 96.0 96.0 156.0 156.0 158.0 158.0 184.0 184.0 196.0 196.0 162.0 162.0 103.0 103.0 62.0 62.0 55.0 55.0 28.0 28.0
+11.0 11.0 34.0 34.0 51.0 51.0 93.0 93.0 133.0 133.0 134.0 134.0 184.0 184.0 144.0 144.0 162.0 162.0 145.0 145.0 114.0 114.0 108.0 108.0 154.0 154.0 175.0 175.0 243.0 243.0 322.0 322.0 387.0 387.0 565.0 565.0 761.0 761.0 955.0 955.0 1178.0 1178.0 1500.0 1500.0 1676.0 1676.0 1550.0 1550.0 1168.0 1168.0 655.0 655.0 395.0 395.0 331.0 331.0 260.0 260.0 256.0 256.0 222.0 222.0 199.0 199.0 206.0 206.0 241.0 241.0 233.0 233.0 246.0 246.0 262.0 262.0 293.0 293.0 402.0 402.0 696.0 696.0 1168.0 1168.0 1621.0 1621.0 1665.0 1665.0 1393.0 1393.0 1238.0 1238.0 923.0 923.0 726.0 726.0 485.0 485.0 335.0 335.0 237.0 237.0 225.0 225.0 151.0 151.0 129.0 129.0 112.0 112.0 101.0 101.0 129.0 129.0 143.0 143.0 142.0 142.0 176.0 176.0 147.0 147.0 101.0 101.0 63.0 63.0 79.0 79.0 17.0 17.0
+11.0 11.0 34.0 34.0 51.0 51.0 93.0 93.0 133.0 133.0 134.0 134.0 184.0 184.0 144.0 144.0 162.0 162.0 145.0 145.0 114.0 114.0 108.0 108.0 154.0 154.0 175.0 175.0 243.0 243.0 322.0 322.0 387.0 387.0 565.0 565.0 761.0 761.0 955.0 955.0 1178.0 1178.0 1500.0 1500.0 1676.0 1676.0 1550.0 1550.0 1168.0 1168.0 655.0 655.0 395.0 395.0 331.0 331.0 260.0 260.0 256.0 256.0 222.0 222.0 199.0 199.0 206.0 206.0 241.0 241.0 233.0 233.0 246.0 246.0 262.0 262.0 293.0 293.0 402.0 402.0 696.0 696.0 1168.0 1168.0 1621.0 1621.0 1665.0 1665.0 1393.0 1393.0 1238.0 1238.0 923.0 923.0 726.0 726.0 485.0 485.0 335.0 335.0 237.0 237.0 225.0 225.0 151.0 151.0 129.0 129.0 112.0 112.0 101.0 101.0 129.0 129.0 143.0 143.0 142.0 142.0 176.0 176.0 147.0 147.0 101.0 101.0 63.0 63.0 79.0 79.0 17.0 17.0
+15.0 15.0 26.0 26.0 53.0 53.0 77.0 77.0 116.0 116.0 128.0 128.0 136.0 136.0 123.0 123.0 124.0 124.0 128.0 128.0 129.0 129.0 129.0 129.0 159.0 159.0 190.0 190.0 235.0 235.0 358.0 358.0 422.0 422.0 632.0 632.0 639.0 639.0 743.0 743.0 779.0 779.0 800.0 800.0 729.0 729.0 639.0 639.0 462.0 462.0 352.0 352.0 272.0 272.0 262.0 262.0 177.0 177.0 208.0 208.0 189.0 189.0 167.0 167.0 198.0 198.0 176.0 176.0 205.0 205.0 200.0 200.0 213.0 213.0 272.0 272.0 278.0 278.0 360.0 360.0 523.0 523.0 608.0 608.0 682.0 682.0 741.0 741.0 762.0 762.0 756.0 756.0 644.0 644.0 523.0 523.0 416.0 416.0 290.0 290.0 235.0 235.0 162.0 162.0 157.0 157.0 133.0 133.0 108.0 108.0 127.0 127.0 118.0 118.0 116.0 116.0 139.0 139.0 124.0 124.0 93.0 93.0 75.0 75.0 72.0 72.0 23.0 23.0
+15.0 15.0 26.0 26.0 53.0 53.0 77.0 77.0 116.0 116.0 128.0 128.0 136.0 136.0 123.0 123.0 124.0 124.0 128.0 128.0 129.0 129.0 129.0 129.0 159.0 159.0 190.0 190.0 235.0 235.0 358.0 358.0 422.0 422.0 632.0 632.0 639.0 639.0 743.0 743.0 779.0 779.0 800.0 800.0 729.0 729.0 639.0 639.0 462.0 462.0 352.0 352.0 272.0 272.0 262.0 262.0 177.0 177.0 208.0 208.0 189.0 189.0 167.0 167.0 198.0 198.0 176.0 176.0 205.0 205.0 200.0 200.0 213.0 213.0 272.0 272.0 278.0 278.0 360.0 360.0 523.0 523.0 608.0 608.0 682.0 682.0 741.0 741.0 762.0 762.0 756.0 756.0 644.0 644.0 523.0 523.0 416.0 416.0 290.0 290.0 235.0 235.0 162.0 162.0 157.0 157.0 133.0 133.0 108.0 108.0 127.0 127.0 118.0 118.0 116.0 116.0 139.0 139.0 124.0 124.0 93.0 93.0 75.0 75.0 72.0 72.0 23.0 23.0
+10.0 10.0 45.0 45.0 58.0 58.0 83.0 83.0 85.0 85.0 93.0 93.0 105.0 105.0 120.0 120.0 103.0 103.0 124.0 124.0 130.0 130.0 145.0 145.0 182.0 182.0 196.0 196.0 276.0 276.0 348.0 348.0 478.0 478.0 538.0 538.0 547.0 547.0 544.0 544.0 508.0 508.0 479.0 479.0 386.0 386.0 355.0 355.0 269.0 269.0 210.0 210.0 215.0 215.0 219.0 219.0 177.0 177.0 158.0 158.0 153.0 153.0 156.0 156.0 163.0 163.0 209.0 209.0 162.0 162.0 155.0 155.0 185.0 185.0 190.0 190.0 205.0 205.0 243.0 243.0 300.0 300.0 359.0 359.0 412.0 412.0 415.0 415.0 497.0 497.0 574.0 574.0 559.0 559.0 506.0 506.0 465.0 465.0 331.0 331.0 243.0 243.0 206.0 206.0 141.0 141.0 143.0 143.0 105.0 105.0 122.0 122.0 123.0 123.0 106.0 106.0 87.0 87.0 85.0 85.0 78.0 78.0 47.0 47.0 72.0 72.0 33.0 33.0
+10.0 10.0 45.0 45.0 58.0 58.0 83.0 83.0 85.0 85.0 93.0 93.0 105.0 105.0 120.0 120.0 103.0 103.0 124.0 124.0 130.0 130.0 145.0 145.0 182.0 182.0 196.0 196.0 276.0 276.0 348.0 348.0 478.0 478.0 538.0 538.0 547.0 547.0 544.0 544.0 508.0 508.0 479.0 479.0 386.0 386.0 355.0 355.0 269.0 269.0 210.0 210.0 215.0 215.0 219.0 219.0 177.0 177.0 158.0 158.0 153.0 153.0 156.0 156.0 163.0 163.0 209.0 209.0 162.0 162.0 155.0 155.0 185.0 185.0 190.0 190.0 205.0 205.0 243.0 243.0 300.0 300.0 359.0 359.0 412.0 412.0 415.0 415.0 497.0 497.0 574.0 574.0 559.0 559.0 506.0 506.0 465.0 465.0 331.0 331.0 243.0 243.0 206.0 206.0 141.0 141.0 143.0 143.0 105.0 105.0 122.0 122.0 123.0 123.0 106.0 106.0 87.0 87.0 85.0 85.0 78.0 78.0 47.0 47.0 72.0 72.0 33.0 33.0
+7.0 7.0 36.0 36.0 40.0 40.0 68.0 68.0 96.0 96.0 80.0 80.0 77.0 77.0 94.0 94.0 111.0 111.0 125.0 125.0 128.0 128.0 164.0 164.0 198.0 198.0 229.0 229.0 325.0 325.0 422.0 422.0 447.0 447.0 534.0 534.0 504.0 504.0 425.0 425.0 364.0 364.0 325.0 325.0 246.0 246.0 248.0 248.0 233.0 233.0 207.0 207.0 157.0 157.0 132.0 132.0 126.0 126.0 135.0 135.0 143.0 143.0 99.0 99.0 155.0 155.0 127.0 127.0 126.0 126.0 137.0 137.0 149.0 149.0 155.0 155.0 187.0 187.0 191.0 191.0 228.0 228.0 230.0 230.0 284.0 284.0 310.0 310.0 365.0 365.0 456.0 456.0 508.0 508.0 458.0 458.0 469.0 469.0 381.0 381.0 268.0 268.0 226.0 226.0 169.0 169.0 145.0 145.0 114.0 114.0 80.0 80.0 99.0 99.0 105.0 105.0 104.0 104.0 66.0 66.0 61.0 61.0 47.0 47.0 47.0 47.0 32.0 32.0
+7.0 7.0 36.0 36.0 40.0 40.0 68.0 68.0 96.0 96.0 80.0 80.0 77.0 77.0 94.0 94.0 111.0 111.0 125.0 125.0 128.0 128.0 164.0 164.0 198.0 198.0 229.0 229.0 325.0 325.0 422.0 422.0 447.0 447.0 534.0 534.0 504.0 504.0 425.0 425.0 364.0 364.0 325.0 325.0 246.0 246.0 248.0 248.0 233.0 233.0 207.0 207.0 157.0 157.0 132.0 132.0 126.0 126.0 135.0 135.0 143.0 143.0 99.0 99.0 155.0 155.0 127.0 127.0 126.0 126.0 137.0 137.0 149.0 149.0 155.0 155.0 187.0 187.0 191.0 191.0 228.0 228.0 230.0 230.0 284.0 284.0 310.0 310.0 365.0 365.0 456.0 456.0 508.0 508.0 458.0 458.0 469.0 469.0 381.0 381.0 268.0 268.0 226.0 226.0 169.0 169.0 145.0 145.0 114.0 114.0 80.0 80.0 99.0 99.0 105.0 105.0 104.0 104.0 66.0 66.0 61.0 61.0 47.0 47.0 47.0 47.0 32.0 32.0
+14.0 14.0 33.0 33.0 48.0 48.0 64.0 64.0 61.0 61.0 70.0 70.0 86.0 86.0 106.0 106.0 98.0 98.0 111.0 111.0 153.0 153.0 189.0 189.0 209.0 209.0 282.0 282.0 364.0 364.0 439.0 439.0 423.0 423.0 433.0 433.0 402.0 402.0 333.0 333.0 309.0 309.0 245.0 245.0 243.0 243.0 194.0 194.0 201.0 201.0 152.0 152.0 150.0 150.0 142.0 142.0 144.0 144.0 118.0 118.0 119.0 119.0 102.0 102.0 143.0 143.0 122.0 122.0 126.0 126.0 116.0 116.0 151.0 151.0 157.0 157.0 133.0 133.0 169.0 169.0 195.0 195.0 206.0 206.0 264.0 264.0 287.0 287.0 321.0 321.0 368.0 368.0 428.0 428.0 455.0 455.0 520.0 520.0 421.0 421.0 324.0 324.0 290.0 290.0 210.0 210.0 158.0 158.0 132.0 132.0 106.0 106.0 99.0 99.0 92.0 92.0 92.0 92.0 65.0 65.0 68.0 68.0 51.0 51.0 63.0 63.0 27.0 27.0
+14.0 14.0 33.0 33.0 48.0 48.0 64.0 64.0 61.0 61.0 70.0 70.0 86.0 86.0 106.0 106.0 98.0 98.0 111.0 111.0 153.0 153.0 189.0 189.0 209.0 209.0 282.0 282.0 364.0 364.0 439.0 439.0 423.0 423.0 433.0 433.0 402.0 402.0 333.0 333.0 309.0 309.0 245.0 245.0 243.0 243.0 194.0 194.0 201.0 201.0 152.0 152.0 150.0 150.0 142.0 142.0 144.0 144.0 118.0 118.0 119.0 119.0 102.0 102.0 143.0 143.0 122.0 122.0 126.0 126.0 116.0 116.0 151.0 151.0 157.0 157.0 133.0 133.0 169.0 169.0 195.0 195.0 206.0 206.0 264.0 264.0 287.0 287.0 321.0 321.0 368.0 368.0 428.0 428.0 455.0 455.0 520.0 520.0 421.0 421.0 324.0 324.0 290.0 290.0 210.0 210.0 158.0 158.0 132.0 132.0 106.0 106.0 99.0 99.0 92.0 92.0 92.0 92.0 65.0 65.0 68.0 68.0 51.0 51.0 63.0 63.0 27.0 27.0
+5.0 5.0 34.0 34.0 48.0 48.0 48.0 48.0 57.0 57.0 77.0 77.0 95.0 95.0 82.0 82.0 103.0 103.0 132.0 132.0 168.0 168.0 205.0 205.0 245.0 245.0 327.0 327.0 408.0 408.0 474.0 474.0 479.0 479.0 450.0 450.0 392.0 392.0 316.0 316.0 270.0 270.0 269.0 269.0 196.0 196.0 193.0 193.0 153.0 153.0 147.0 147.0 143.0 143.0 137.0 137.0 116.0 116.0 123.0 123.0 124.0 124.0 107.0 107.0 116.0 116.0 117.0 117.0 119.0 119.0 101.0 101.0 101.0 101.0 144.0 144.0 136.0 136.0 146.0 146.0 169.0 169.0 196.0 196.0 243.0 243.0 244.0 244.0 265.0 265.0 319.0 319.0 367.0 367.0 429.0 429.0 496.0 496.0 498.0 498.0 426.0 426.0 289.0 289.0 234.0 234.0 208.0 208.0 167.0 167.0 125.0 125.0 98.0 98.0 83.0 83.0 62.0 62.0 72.0 72.0 55.0 55.0 50.0 50.0 57.0 57.0 23.0 23.0
+5.0 5.0 34.0 34.0 48.0 48.0 48.0 48.0 57.0 57.0 77.0 77.0 95.0 95.0 82.0 82.0 103.0 103.0 132.0 132.0 168.0 168.0 205.0 205.0 245.0 245.0 327.0 327.0 408.0 408.0 474.0 474.0 479.0 479.0 450.0 450.0 392.0 392.0 316.0 316.0 270.0 270.0 269.0 269.0 196.0 196.0 193.0 193.0 153.0 153.0 147.0 147.0 143.0 143.0 137.0 137.0 116.0 116.0 123.0 123.0 124.0 124.0 107.0 107.0 116.0 116.0 117.0 117.0 119.0 119.0 101.0 101.0 101.0 101.0 144.0 144.0 136.0 136.0 146.0 146.0 169.0 169.0 196.0 196.0 243.0 243.0 244.0 244.0 265.0 265.0 319.0 319.0 367.0 367.0 429.0 429.0 496.0 496.0 498.0 498.0 426.0 426.0 289.0 289.0 234.0 234.0 208.0 208.0 167.0 167.0 125.0 125.0 98.0 98.0 83.0 83.0 62.0 62.0 72.0 72.0 55.0 55.0 50.0 50.0 57.0 57.0 23.0 23.0
+10.0 10.0 34.0 34.0 45.0 45.0 51.0 51.0 58.0 58.0 81.0 81.0 85.0 85.0 96.0 96.0 120.0 120.0 137.0 137.0 161.0 161.0 227.0 227.0 313.0 313.0 393.0 393.0 492.0 492.0 576.0 576.0 538.0 538.0 379.0 379.0 366.0 366.0 261.0 261.0 255.0 255.0 237.0 237.0 167.0 167.0 166.0 166.0 158.0 158.0 121.0 121.0 130.0 130.0 137.0 137.0 107.0 107.0 116.0 116.0 114.0 114.0 89.0 89.0 108.0 108.0 89.0 89.0 104.0 104.0 101.0 101.0 114.0 114.0 103.0 103.0 112.0 112.0 137.0 137.0 144.0 144.0 167.0 167.0 200.0 200.0 223.0 223.0 303.0 303.0 316.0 316.0 353.0 353.0 458.0 458.0 531.0 531.0 578.0 578.0 461.0 461.0 376.0 376.0 286.0 286.0 213.0 213.0 153.0 153.0 119.0 119.0 117.0 117.0 77.0 77.0 71.0 71.0 63.0 63.0 45.0 45.0 43.0 43.0 59.0 59.0 21.0 21.0
+10.0 10.0 34.0 34.0 45.0 45.0 51.0 51.0 58.0 58.0 81.0 81.0 85.0 85.0 96.0 96.0 120.0 120.0 137.0 137.0 161.0 161.0 227.0 227.0 313.0 313.0 393.0 393.0 492.0 492.0 576.0 576.0 538.0 538.0 379.0 379.0 366.0 366.0 261.0 261.0 255.0 255.0 237.0 237.0 167.0 167.0 166.0 166.0 158.0 158.0 121.0 121.0 130.0 130.0 137.0 137.0 107.0 107.0 116.0 116.0 114.0 114.0 89.0 89.0 108.0 108.0 89.0 89.0 104.0 104.0 101.0 101.0 114.0 114.0 103.0 103.0 112.0 112.0 137.0 137.0 144.0 144.0 167.0 167.0 200.0 200.0 223.0 223.0 303.0 303.0 316.0 316.0 353.0 353.0 458.0 458.0 531.0 531.0 578.0 578.0 461.0 461.0 376.0 376.0 286.0 286.0 213.0 213.0 153.0 153.0 119.0 119.0 117.0 117.0 77.0 77.0 71.0 71.0 63.0 63.0 45.0 45.0 43.0 43.0 59.0 59.0 21.0 21.0
+10.0 10.0 26.0 26.0 37.0 37.0 51.0 51.0 63.0 63.0 55.0 55.0 76.0 76.0 92.0 92.0 116.0 116.0 141.0 141.0 188.0 188.0 261.0 261.0 318.0 318.0 467.0 467.0 633.0 633.0 629.0 629.0 536.0 536.0 407.0 407.0 314.0 314.0 282.0 282.0 244.0 244.0 232.0 232.0 173.0 173.0 159.0 159.0 112.0 112.0 117.0 117.0 111.0 111.0 135.0 135.0 109.0 109.0 106.0 106.0 100.0 100.0 92.0 92.0 98.0 98.0 98.0 98.0 111.0 111.0 85.0 85.0 108.0 108.0 109.0 109.0 116.0 116.0 129.0 129.0 143.0 143.0 146.0 146.0 191.0 191.0 237.0 237.0 235.0 235.0 304.0 304.0 343.0 343.0 388.0 388.0 518.0 518.0 669.0 669.0 553.0 553.0 446.0 446.0 324.0 324.0 256.0 256.0 175.0 175.0 151.0 151.0 88.0 88.0 80.0 80.0 76.0 76.0 61.0 61.0 58.0 58.0 53.0 53.0 61.0 61.0 19.0 19.0
+10.0 10.0 26.0 26.0 37.0 37.0 51.0 51.0 63.0 63.0 55.0 55.0 76.0 76.0 92.0 92.0 116.0 116.0 141.0 141.0 188.0 188.0 261.0 261.0 318.0 318.0 467.0 467.0 633.0 633.0 629.0 629.0 536.0 536.0 407.0 407.0 314.0 314.0 282.0 282.0 244.0 244.0 232.0 232.0 173.0 173.0 159.0 159.0 112.0 112.0 117.0 117.0 111.0 111.0 135.0 135.0 109.0 109.0 106.0 106.0 100.0 100.0 92.0 92.0 98.0 98.0 98.0 98.0 111.0 111.0 85.0 85.0 108.0 108.0 109.0 109.0 116.0 116.0 129.0 129.0 143.0 143.0 146.0 146.0 191.0 191.0 237.0 237.0 235.0 235.0 304.0 304.0 343.0 343.0 388.0 388.0 518.0 518.0 669.0 669.0 553.0 553.0 446.0 446.0 324.0 324.0 256.0 256.0 175.0 175.0 151.0 151.0 88.0 88.0 80.0 80.0 76.0 76.0 61.0 61.0 58.0 58.0 53.0 53.0 61.0 61.0 19.0 19.0
+15.0 15.0 34.0 34.0 39.0 39.0 46.0 46.0 66.0 66.0 73.0 73.0 83.0 83.0 94.0 94.0 139.0 139.0 168.0 168.0 215.0 215.0 292.0 292.0 410.0 410.0 575.0 575.0 761.0 761.0 773.0 773.0 613.0 613.0 418.0 418.0 321.0 321.0 268.0 268.0 248.0 248.0 209.0 209.0 176.0 176.0 149.0 149.0 145.0 145.0 104.0 104.0 120.0 120.0 106.0 106.0 93.0 93.0 85.0 85.0 92.0 92.0 79.0 79.0 96.0 96.0 93.0 93.0 95.0 95.0 101.0 101.0 104.0 104.0 108.0 108.0 121.0 121.0 115.0 115.0 119.0 119.0 129.0 129.0 176.0 176.0 185.0 185.0 215.0 215.0 269.0 269.0 324.0 324.0 439.0 439.0 638.0 638.0 797.0 797.0 681.0 681.0 576.0 576.0 385.0 385.0 273.0 273.0 188.0 188.0 152.0 152.0 81.0 81.0 88.0 88.0 64.0 64.0 64.0 64.0 48.0 48.0 37.0 37.0 49.0 49.0 29.0 29.0
+15.0 15.0 34.0 34.0 39.0 39.0 46.0 46.0 66.0 66.0 73.0 73.0 83.0 83.0 94.0 94.0 139.0 139.0 168.0 168.0 215.0 215.0 292.0 292.0 410.0 410.0 575.0 575.0 761.0 761.0 773.0 773.0 613.0 613.0 418.0 418.0 321.0 321.0 268.0 268.0 248.0 248.0 209.0 209.0 176.0 176.0 149.0 149.0 145.0 145.0 104.0 104.0 120.0 120.0 106.0 106.0 93.0 93.0 85.0 85.0 92.0 92.0 79.0 79.0 96.0 96.0 93.0 93.0 95.0 95.0 101.0 101.0 104.0 104.0 108.0 108.0 121.0 121.0 115.0 115.0 119.0 119.0 129.0 129.0 176.0 176.0 185.0 185.0 215.0 215.0 269.0 269.0 324.0 324.0 439.0 439.0 638.0 638.0 797.0 797.0 681.0 681.0 576.0 576.0 385.0 385.0 273.0 273.0 188.0 188.0 152.0 152.0 81.0 81.0 88.0 88.0 64.0 64.0 64.0 64.0 48.0 48.0 37.0 37.0 49.0 49.0 29.0 29.0
+20.0 20.0 37.0 37.0 45.0 45.0 62.0 62.0 73.0 73.0 63.0 63.0 76.0 76.0 94.0 94.0 135.0 135.0 158.0 158.0 245.0 245.0 331.0 331.0 560.0 560.0 793.0 793.0 1122.0 1122.0 1091.0 1091.0 773.0 773.0 483.0 483.0 321.0 321.0 268.0 268.0 204.0 204.0 189.0 189.0 173.0 173.0 141.0 141.0 136.0 136.0 129.0 129.0 109.0 109.0 115.0 115.0 84.0 84.0 109.0 109.0 111.0 111.0 100.0 100.0 126.0 126.0 97.0 97.0 113.0 113.0 110.0 110.0 99.0 99.0 111.0 111.0 104.0 104.0 128.0 128.0 117.0 117.0 145.0 145.0 151.0 151.0 204.0 204.0 222.0 222.0 274.0 274.0 366.0 366.0 517.0 517.0 854.0 854.0 1170.0 1170.0 1065.0 1065.0 726.0 726.0 476.0 476.0 289.0 289.0 210.0 210.0 147.0 147.0 124.0 124.0 84.0 84.0 84.0 84.0 60.0 60.0 61.0 61.0 62.0 62.0 38.0 38.0 36.0 36.0
+20.0 20.0 37.0 37.0 45.0 45.0 62.0 62.0 73.0 73.0 63.0 63.0 76.0 76.0 94.0 94.0 135.0 135.0 158.0 158.0 245.0 245.0 331.0 331.0 560.0 560.0 793.0 793.0 1122.0 1122.0 1091.0 1091.0 773.0 773.0 483.0 483.0 321.0 321.0 268.0 268.0 204.0 204.0 189.0 189.0 173.0 173.0 141.0 141.0 136.0 136.0 129.0 129.0 109.0 109.0 115.0 115.0 84.0 84.0 109.0 109.0 111.0 111.0 100.0 100.0 126.0 126.0 97.0 97.0 113.0 113.0 110.0 110.0 99.0 99.0 111.0 111.0 104.0 104.0 128.0 128.0 117.0 117.0 145.0 145.0 151.0 151.0 204.0 204.0 222.0 222.0 274.0 274.0 366.0 366.0 517.0 517.0 854.0 854.0 1170.0 1170.0 1065.0 1065.0 726.0 726.0 476.0 476.0 289.0 289.0 210.0 210.0 147.0 147.0 124.0 124.0 84.0 84.0 84.0 84.0 60.0 60.0 61.0 61.0 62.0 62.0 38.0 38.0 36.0 36.0
+26.0 26.0 42.0 42.0 53.0 53.0 45.0 45.0 54.0 54.0 71.0 71.0 76.0 76.0 106.0 106.0 140.0 140.0 174.0 174.0 266.0 266.0 358.0 358.0 696.0 696.0 1211.0 1211.0 1778.0 1778.0 1910.0 1910.0 1181.0 1181.0 658.0 658.0 392.0 392.0 258.0 258.0 207.0 207.0 162.0 162.0 151.0 151.0 153.0 153.0 129.0 129.0 99.0 99.0 109.0 109.0 106.0 106.0 83.0 83.0 113.0 113.0 107.0 107.0 84.0 84.0 55.0 55.0 97.0 97.0 129.0 129.0 95.0 95.0 83.0 83.0 97.0 97.0 100.0 100.0 126.0 126.0 147.0 147.0 126.0 126.0 168.0 168.0 193.0 193.0 207.0 207.0 239.0 239.0 321.0 321.0 718.0 718.0 1379.0 1379.0 1963.0 1963.0 1727.0 1727.0 1080.0 1080.0 548.0 548.0 336.0 336.0 217.0 217.0 173.0 173.0 92.0 92.0 85.0 85.0 79.0 79.0 52.0 52.0 54.0 54.0 62.0 62.0 54.0 54.0 40.0 40.0
+26.0 26.0 42.0 42.0 53.0 53.0 45.0 45.0 54.0 54.0 71.0 71.0 76.0 76.0 106.0 106.0 140.0 140.0 174.0 174.0 266.0 266.0 358.0 358.0 696.0 696.0 1211.0 1211.0 1778.0 1778.0 1910.0 1910.0 1181.0 1181.0 658.0 658.0 392.0 392.0 258.0 258.0 207.0 207.0 162.0 162.0 151.0 151.0 153.0 153.0 129.0 129.0 99.0 99.0 109.0 109.0 106.0 106.0 83.0 83.0 113.0 113.0 107.0 107.0 84.0 84.0 55.0 55.0 97.0 97.0 129.0 129.0 95.0 95.0 83.0 83.0 97.0 97.0 100.0 100.0 126.0 126.0 147.0 147.0 126.0 126.0 168.0 168.0 193.0 193.0 207.0 207.0 239.0 239.0 321.0 321.0 718.0 718.0 1379.0 1379.0 1963.0 1963.0 1727.0 1727.0 1080.0 1080.0 548.0 548.0 336.0 336.0 217.0 217.0 173.0 173.0 92.0 92.0 85.0 85.0 79.0 79.0 52.0 52.0 54.0 54.0 62.0 62.0 54.0 54.0 40.0 40.0
+17.0 17.0 41.0 41.0 49.0 49.0 46.0 46.0 57.0 57.0 66.0 66.0 76.0 76.0 88.0 88.0 131.0 131.0 182.0 182.0 248.0 248.0 412.0 412.0 909.0 909.0 1834.0 1834.0 2989.0 2989.0 3173.0 3173.0 1952.0 1952.0 794.0 794.0 347.0 347.0 248.0 248.0 207.0 207.0 167.0 167.0 134.0 134.0 128.0 128.0 128.0 128.0 111.0 111.0 118.0 118.0 100.0 100.0 119.0 119.0 115.0 115.0 55.0 55.0 23.0 23.0 3.0 3.0 11.0 11.0 94.0 94.0 102.0 102.0 108.0 108.0 101.0 101.0 84.0 84.0 107.0 107.0 101.0 101.0 135.0 135.0 153.0 153.0 159.0 159.0 211.0 211.0 277.0 277.0 419.0 419.0 972.0 972.0 2316.0 2316.0 3392.0 3392.0 2850.0 2850.0 1608.0 1608.0 690.0 690.0 349.0 349.0 242.0 242.0 197.0 197.0 115.0 115.0 102.0 102.0 78.0 78.0 54.0 54.0 48.0 48.0 43.0 43.0 64.0 64.0 59.0 59.0
+17.0 17.0 41.0 41.0 49.0 49.0 46.0 46.0 57.0 57.0 66.0 66.0 76.0 76.0 88.0 88.0 131.0 131.0 182.0 182.0 248.0 248.0 412.0 412.0 909.0 909.0 1834.0 1834.0 2989.0 2989.0 3173.0 3173.0 1952.0 1952.0 794.0 794.0 347.0 347.0 248.0 248.0 207.0 207.0 167.0 167.0 134.0 134.0 128.0 128.0 128.0 128.0 111.0 111.0 118.0 118.0 100.0 100.0 119.0 119.0 115.0 115.0 55.0 55.0 23.0 23.0 3.0 3.0 11.0 11.0 94.0 94.0 102.0 102.0 108.0 108.0 101.0 101.0 84.0 84.0 107.0 107.0 101.0 101.0 135.0 135.0 153.0 153.0 159.0 159.0 211.0 211.0 277.0 277.0 419.0 419.0 972.0 972.0 2316.0 2316.0 3392.0 3392.0 2850.0 2850.0 1608.0 1608.0 690.0 690.0 349.0 349.0 242.0 242.0 197.0 197.0 115.0 115.0 102.0 102.0 78.0 78.0 54.0 54.0 48.0 48.0 43.0 43.0 64.0 64.0 59.0 59.0
+18.0 18.0 55.0 55.0 58.0 58.0 44.0 44.0 64.0 64.0 70.0 70.0 91.0 91.0 104.0 104.0 143.0 143.0 176.0 176.0 276.0 276.0 471.0 471.0 1156.0 1156.0 2541.0 2541.0 4376.0 4376.0 4379.0 4379.0 2674.0 2674.0 1091.0 1091.0 379.0 379.0 253.0 253.0 195.0 195.0 154.0 154.0 156.0 156.0 120.0 120.0 120.0 120.0 106.0 106.0 105.0 105.0 110.0 110.0 111.0 111.0 108.0 108.0 7.0 7.0 5.0 5.0 1.0 1.0 4.0 4.0 24.0 24.0 122.0 122.0 99.0 99.0 112.0 112.0 82.0 82.0 98.0 98.0 109.0 109.0 136.0 136.0 155.0 155.0 164.0 164.0 193.0 193.0 245.0 245.0 440.0 440.0 1183.0 1183.0 3079.0 3079.0 4569.0 4569.0 3810.0 3810.0 2059.0 2059.0 838.0 838.0 392.0 392.0 225.0 225.0 159.0 159.0 114.0 114.0 83.0 83.0 88.0 88.0 75.0 75.0 30.0 30.0 44.0 44.0 55.0 55.0 37.0 37.0
+18.0 18.0 55.0 55.0 58.0 58.0 44.0 44.0 64.0 64.0 70.0 70.0 91.0 91.0 104.0 104.0 143.0 143.0 176.0 176.0 276.0 276.0 471.0 471.0 1156.0 1156.0 2541.0 2541.0 4376.0 4376.0 4379.0 4379.0 2674.0 2674.0 1091.0 1091.0 379.0 379.0 253.0 253.0 195.0 195.0 154.0 154.0 156.0 156.0 120.0 120.0 120.0 120.0 106.0 106.0 105.0 105.0 110.0 110.0 111.0 111.0 108.0 108.0 7.0 7.0 5.0 5.0 1.0 1.0 4.0 4.0 24.0 24.0 122.0 122.0 99.0 99.0 112.0 112.0 82.0 82.0 98.0 98.0 109.0 109.0 136.0 136.0 155.0 155.0 164.0 164.0 193.0 193.0 245.0 245.0 440.0 440.0 1183.0 1183.0 3079.0 3079.0 4569.0 4569.0 3810.0 3810.0 2059.0 2059.0 838.0 838.0 392.0 392.0 225.0 225.0 159.0 159.0 114.0 114.0 83.0 83.0 88.0 88.0 75.0 75.0 30.0 30.0 44.0 44.0 55.0 55.0 37.0 37.0
+14.0 14.0 43.0 43.0 40.0 40.0 44.0 44.0 63.0 63.0 59.0 59.0 70.0 70.0 108.0 108.0 124.0 124.0 187.0 187.0 273.0 273.0 504.0 504.0 1256.0 1256.0 2702.0 2702.0 4383.0 4383.0 4723.0 4723.0 2923.0 2923.0 1092.0 1092.0 415.0 415.0 237.0 237.0 205.0 205.0 167.0 167.0 144.0 144.0 141.0 141.0 110.0 110.0 97.0 97.0 109.0 109.0 107.0 107.0 124.0 124.0 85.0 85.0 6.0 6.0 7.0 7.0 5.0 5.0 2.0 2.0 23.0 23.0 132.0 132.0 124.0 124.0 106.0 106.0 98.0 98.0 107.0 107.0 142.0 142.0 127.0 127.0 129.0 129.0 184.0 184.0 193.0 193.0 252.0 252.0 425.0 425.0 1277.0 1277.0 3273.0 3273.0 4877.0 4877.0 4168.0 4168.0 2227.0 2227.0 842.0 842.0 375.0 375.0 252.0 252.0 137.0 137.0 131.0 131.0 99.0 99.0 75.0 75.0 63.0 63.0 52.0 52.0 39.0 39.0 42.0 42.0 39.0 39.0
+14.0 14.0 43.0 43.0 40.0 40.0 44.0 44.0 63.0 63.0 59.0 59.0 70.0 70.0 108.0 108.0 124.0 124.0 187.0 187.0 273.0 273.0 504.0 504.0 1256.0 1256.0 2702.0 2702.0 4383.0 4383.0 4723.0 4723.0 2923.0 2923.0 1092.0 1092.0 415.0 415.0 237.0 237.0 205.0 205.0 167.0 167.0 144.0 144.0 141.0 141.0 110.0 110.0 97.0 97.0 109.0 109.0 107.0 107.0 124.0 124.0 85.0 85.0 6.0 6.0 7.0 7.0 5.0 5.0 2.0 2.0 23.0 23.0 132.0 132.0 124.0 124.0 106.0 106.0 98.0 98.0 107.0 107.0 142.0 142.0 127.0 127.0 129.0 129.0 184.0 184.0 193.0 193.0 252.0 252.0 425.0 425.0 1277.0 1277.0 3273.0 3273.0 4877.0 4877.0 4168.0 4168.0 2227.0 2227.0 842.0 842.0 375.0 375.0 252.0 252.0 137.0 137.0 131.0 131.0 99.0 99.0 75.0 75.0 63.0 63.0 52.0 52.0 39.0 39.0 42.0 42.0 39.0 39.0
+15.0 15.0 46.0 46.0 45.0 45.0 41.0 41.0 71.0 71.0 78.0 78.0 80.0 80.0 84.0 84.0 122.0 122.0 193.0 193.0 255.0 255.0 419.0 419.0 1014.0 1014.0 1995.0 1995.0 3539.0 3539.0 3743.0 3743.0 2256.0 2256.0 924.0 924.0 418.0 418.0 251.0 251.0 200.0 200.0 155.0 155.0 138.0 138.0 124.0 124.0 118.0 118.0 92.0 92.0 100.0 100.0 107.0 107.0 98.0 98.0 125.0 125.0 19.0 19.0 7.0 7.0 1.0 1.0 3.0 3.0 50.0 50.0 104.0 104.0 116.0 116.0 97.0 97.0 89.0 89.0 138.0 138.0 108.0 108.0 143.0 143.0 138.0 138.0 152.0 152.0 218.0 218.0 295.0 295.0 399.0 399.0 988.0 988.0 2473.0 2473.0 3580.0 3580.0 3039.0 3039.0 1712.0 1712.0 741.0 741.0 340.0 340.0 241.0 241.0 145.0 145.0 111.0 111.0 92.0 92.0 67.0 67.0 55.0 55.0 45.0 45.0 33.0 33.0 63.0 63.0 23.0 23.0
+15.0 15.0 46.0 46.0 45.0 45.0 41.0 41.0 71.0 71.0 78.0 78.0 80.0 80.0 84.0 84.0 122.0 122.0 193.0 193.0 255.0 255.0 419.0 419.0 1014.0 1014.0 1995.0 1995.0 3539.0 3539.0 3743.0 3743.0 2256.0 2256.0 924.0 924.0 418.0 418.0 251.0 251.0 200.0 200.0 155.0 155.0 138.0 138.0 124.0 124.0 118.0 118.0 92.0 92.0 100.0 100.0 107.0 107.0 98.0 98.0 125.0 125.0 19.0 19.0 7.0 7.0 1.0 1.0 3.0 3.0 50.0 50.0 104.0 104.0 116.0 116.0 97.0 97.0 89.0 89.0 138.0 138.0 108.0 108.0 143.0 143.0 138.0 138.0 152.0 152.0 218.0 218.0 295.0 295.0 399.0 399.0 988.0 988.0 2473.0 2473.0 3580.0 3580.0 3039.0 3039.0 1712.0 1712.0 741.0 741.0 340.0 340.0 241.0 241.0 145.0 145.0 111.0 111.0 92.0 92.0 67.0 67.0 55.0 55.0 45.0 45.0 33.0 33.0 63.0 63.0 23.0 23.0
+25.0 25.0 47.0 47.0 41.0 41.0 52.0 52.0 55.0 55.0 81.0 81.0 75.0 75.0 105.0 105.0 122.0 122.0 190.0 190.0 242.0 242.0 408.0 408.0 727.0 727.0 1404.0 1404.0 2161.0 2161.0 2206.0 2206.0 1333.0 1333.0 649.0 649.0 373.0 373.0 245.0 245.0 187.0 187.0 160.0 160.0 162.0 162.0 114.0 114.0 141.0 141.0 103.0 103.0 96.0 96.0 114.0 114.0 109.0 109.0 94.0 94.0 91.0 91.0 40.0 40.0 37.0 37.0 52.0 52.0 105.0 105.0 100.0 100.0 100.0 100.0 106.0 106.0 87.0 87.0 97.0 97.0 116.0 116.0 120.0 120.0 181.0 181.0 153.0 153.0 227.0 227.0 292.0 292.0 411.0 411.0 743.0 743.0 1545.0 1545.0 2226.0 2226.0 1939.0 1939.0 1203.0 1203.0 601.0 601.0 302.0 302.0 228.0 228.0 145.0 145.0 98.0 98.0 92.0 92.0 75.0 75.0 62.0 62.0 49.0 49.0 50.0 50.0 39.0 39.0 23.0 23.0
+25.0 25.0 47.0 47.0 41.0 41.0 52.0 52.0 55.0 55.0 81.0 81.0 75.0 75.0 105.0 105.0 122.0 122.0 190.0 190.0 242.0 242.0 408.0 408.0 727.0 727.0 1404.0 1404.0 2161.0 2161.0 2206.0 2206.0 1333.0 1333.0 649.0 649.0 373.0 373.0 245.0 245.0 187.0 187.0 160.0 160.0 162.0 162.0 114.0 114.0 141.0 141.0 103.0 103.0 96.0 96.0 114.0 114.0 109.0 109.0 94.0 94.0 91.0 91.0 40.0 40.0 37.0 37.0 52.0 52.0 105.0 105.0 100.0 100.0 100.0 100.0 106.0 106.0 87.0 87.0 97.0 97.0 116.0 116.0 120.0 120.0 181.0 181.0 153.0 153.0 227.0 227.0 292.0 292.0 411.0 411.0 743.0 743.0 1545.0 1545.0 2226.0 2226.0 1939.0 1939.0 1203.0 1203.0 601.0 601.0 302.0 302.0 228.0 228.0 145.0 145.0 98.0 98.0 92.0 92.0 75.0 75.0 62.0 62.0 49.0 49.0 50.0 50.0 39.0 39.0 23.0 23.0
+21.0 21.0 47.0 47.0 50.0 50.0 74.0 74.0 70.0 70.0 64.0 64.0 79.0 79.0 103.0 103.0 126.0 126.0 173.0 173.0 243.0 243.0 346.0 346.0 578.0 578.0 920.0 920.0 1307.0 1307.0 1343.0 1343.0 917.0 917.0 527.0 527.0 376.0 376.0 255.0 255.0 235.0 235.0 169.0 169.0 150.0 150.0 159.0 159.0 118.0 118.0 126.0 126.0 107.0 107.0 109.0 109.0 111.0 111.0 121.0 121.0 99.0 99.0 97.0 97.0 90.0 90.0 133.0 133.0 114.0 114.0 106.0 106.0 107.0 107.0 88.0 88.0 113.0 113.0 116.0 116.0 122.0 122.0 145.0 145.0 159.0 159.0 161.0 161.0 215.0 215.0 262.0 262.0 364.0 364.0 540.0 540.0 923.0 923.0 1305.0 1305.0 1095.0 1095.0 778.0 778.0 420.0 420.0 306.0 306.0 188.0 188.0 166.0 166.0 96.0 96.0 86.0 86.0 77.0 77.0 75.0 75.0 54.0 54.0 52.0 52.0 41.0 41.0 15.0 15.0
+21.0 21.0 47.0 47.0 50.0 50.0 74.0 74.0 70.0 70.0 64.0 64.0 79.0 79.0 103.0 103.0 126.0 126.0 173.0 173.0 243.0 243.0 346.0 346.0 578.0 578.0 920.0 920.0 1307.0 1307.0 1343.0 1343.0 917.0 917.0 527.0 527.0 376.0 376.0 255.0 255.0 235.0 235.0 169.0 169.0 150.0 150.0 159.0 159.0 118.0 118.0 126.0 126.0 107.0 107.0 109.0 109.0 111.0 111.0 121.0 121.0 99.0 99.0 97.0 97.0 90.0 90.0 133.0 133.0 114.0 114.0 106.0 106.0 107.0 107.0 88.0 88.0 113.0 113.0 116.0 116.0 122.0 122.0 145.0 145.0 159.0 159.0 161.0 161.0 215.0 215.0 262.0 262.0 364.0 364.0 540.0 540.0 923.0 923.0 1305.0 1305.0 1095.0 1095.0 778.0 778.0 420.0 420.0 306.0 306.0 188.0 188.0 166.0 166.0 96.0 96.0 86.0 86.0 77.0 77.0 75.0 75.0 54.0 54.0 52.0 52.0 41.0 41.0 15.0 15.0
+11.0 11.0 42.0 42.0 44.0 44.0 44.0 44.0 59.0 59.0 57.0 57.0 83.0 83.0 85.0 85.0 118.0 118.0 151.0 151.0 226.0 226.0 275.0 275.0 459.0 459.0 589.0 589.0 793.0 793.0 850.0 850.0 646.0 646.0 470.0 470.0 367.0 367.0 264.0 264.0 221.0 221.0 189.0 189.0 174.0 174.0 174.0 174.0 142.0 142.0 103.0 103.0 114.0 114.0 110.0 110.0 97.0 97.0 105.0 105.0 93.0 93.0 103.0 103.0 91.0 91.0 94.0 94.0 107.0 107.0 110.0 110.0 116.0 116.0 89.0 89.0 110.0 110.0 128.0 128.0 139.0 139.0 145.0 145.0 178.0 178.0 195.0 195.0 219.0 219.0 274.0 274.0 297.0 297.0 468.0 468.0 657.0 657.0 821.0 821.0 736.0 736.0 553.0 553.0 392.0 392.0 253.0 253.0 193.0 193.0 163.0 163.0 115.0 115.0 79.0 79.0 75.0 75.0 73.0 73.0 44.0 44.0 43.0 43.0 55.0 55.0 11.0 11.0
+11.0 11.0 42.0 42.0 44.0 44.0 44.0 44.0 59.0 59.0 57.0 57.0 83.0 83.0 85.0 85.0 118.0 118.0 151.0 151.0 226.0 226.0 275.0 275.0 459.0 459.0 589.0 589.0 793.0 793.0 850.0 850.0 646.0 646.0 470.0 470.0 367.0 367.0 264.0 264.0 221.0 221.0 189.0 189.0 174.0 174.0 174.0 174.0 142.0 142.0 103.0 103.0 114.0 114.0 110.0 110.0 97.0 97.0 105.0 105.0 93.0 93.0 103.0 103.0 91.0 91.0 94.0 94.0 107.0 107.0 110.0 110.0 116.0 116.0 89.0 89.0 110.0 110.0 128.0 128.0 139.0 139.0 145.0 145.0 178.0 178.0 195.0 195.0 219.0 219.0 274.0 274.0 297.0 297.0 468.0 468.0 657.0 657.0 821.0 821.0 736.0 736.0 553.0 553.0 392.0 392.0 253.0 253.0 193.0 193.0 163.0 163.0 115.0 115.0 79.0 79.0 75.0 75.0 73.0 73.0 44.0 44.0 43.0 43.0 55.0 55.0 11.0 11.0
+13.0 13.0 40.0 40.0 49.0 49.0 60.0 60.0 47.0 47.0 58.0 58.0 70.0 70.0 85.0 85.0 132.0 132.0 138.0 138.0 234.0 234.0 288.0 288.0 349.0 349.0 500.0 500.0 620.0 620.0 676.0 676.0 574.0 574.0 451.0 451.0 313.0 313.0 273.0 273.0 220.0 220.0 211.0 211.0 173.0 173.0 159.0 159.0 163.0 163.0 136.0 136.0 128.0 128.0 125.0 125.0 136.0 136.0 99.0 99.0 106.0 106.0 105.0 105.0 84.0 84.0 101.0 101.0 112.0 112.0 99.0 99.0 98.0 98.0 114.0 114.0 138.0 138.0 119.0 119.0 136.0 136.0 183.0 183.0 179.0 179.0 206.0 206.0 248.0 248.0 222.0 222.0 348.0 348.0 378.0 378.0 537.0 537.0 598.0 598.0 555.0 555.0 461.0 461.0 327.0 327.0 204.0 204.0 180.0 180.0 150.0 150.0 97.0 97.0 77.0 77.0 66.0 66.0 50.0 50.0 40.0 40.0 46.0 46.0 51.0 51.0 9.0 9.0
+13.0 13.0 40.0 40.0 49.0 49.0 60.0 60.0 47.0 47.0 58.0 58.0 70.0 70.0 85.0 85.0 132.0 132.0 138.0 138.0 234.0 234.0 288.0 288.0 349.0 349.0 500.0 500.0 620.0 620.0 676.0 676.0 574.0 574.0 451.0 451.0 313.0 313.0 273.0 273.0 220.0 220.0 211.0 211.0 173.0 173.0 159.0 159.0 163.0 163.0 136.0 136.0 128.0 128.0 125.0 125.0 136.0 136.0 99.0 99.0 106.0 106.0 105.0 105.0 84.0 84.0 101.0 101.0 112.0 112.0 99.0 99.0 98.0 98.0 114.0 114.0 138.0 138.0 119.0 119.0 136.0 136.0 183.0 183.0 179.0 179.0 206.0 206.0 248.0 248.0 222.0 222.0 348.0 348.0 378.0 378.0 537.0 537.0 598.0 598.0 555.0 555.0 461.0 461.0 327.0 327.0 204.0 204.0 180.0 180.0 150.0 150.0 97.0 97.0 77.0 77.0 66.0 66.0 50.0 50.0 40.0 40.0 46.0 46.0 51.0 51.0 9.0 9.0
+25.0 25.0 39.0 39.0 34.0 34.0 49.0 49.0 56.0 56.0 62.0 62.0 81.0 81.0 110.0 110.0 123.0 123.0 142.0 142.0 166.0 166.0 234.0 234.0 298.0 298.0 405.0 405.0 502.0 502.0 568.0 568.0 510.0 510.0 430.0 430.0 313.0 313.0 327.0 327.0 226.0 226.0 200.0 200.0 186.0 186.0 167.0 167.0 156.0 156.0 118.0 118.0 131.0 131.0 123.0 123.0 108.0 108.0 134.0 134.0 102.0 102.0 116.0 116.0 80.0 80.0 121.0 121.0 105.0 105.0 113.0 113.0 118.0 118.0 104.0 104.0 134.0 134.0 146.0 146.0 151.0 151.0 218.0 218.0 205.0 205.0 238.0 238.0 270.0 270.0 283.0 283.0 327.0 327.0 404.0 404.0 537.0 537.0 519.0 519.0 472.0 472.0 370.0 370.0 252.0 252.0 181.0 181.0 161.0 161.0 139.0 139.0 100.0 100.0 92.0 92.0 81.0 81.0 58.0 58.0 61.0 61.0 47.0 47.0 42.0 42.0 19.0 19.0
+25.0 25.0 39.0 39.0 34.0 34.0 49.0 49.0 56.0 56.0 62.0 62.0 81.0 81.0 110.0 110.0 123.0 123.0 142.0 142.0 166.0 166.0 234.0 234.0 298.0 298.0 405.0 405.0 502.0 502.0 568.0 568.0 510.0 510.0 430.0 430.0 313.0 313.0 327.0 327.0 226.0 226.0 200.0 200.0 186.0 186.0 167.0 167.0 156.0 156.0 118.0 118.0 131.0 131.0 123.0 123.0 108.0 108.0 134.0 134.0 102.0 102.0 116.0 116.0 80.0 80.0 121.0 121.0 105.0 105.0 113.0 113.0 118.0 118.0 104.0 104.0 134.0 134.0 146.0 146.0 151.0 151.0 218.0 218.0 205.0 205.0 238.0 238.0 270.0 270.0 283.0 283.0 327.0 327.0 404.0 404.0 537.0 537.0 519.0 519.0 472.0 472.0 370.0 370.0 252.0 252.0 181.0 181.0 161.0 161.0 139.0 139.0 100.0 100.0 92.0 92.0 81.0 81.0 58.0 58.0 61.0 61.0 47.0 47.0 42.0 42.0 19.0 19.0
+19.0 19.0 37.0 37.0 40.0 40.0 53.0 53.0 60.0 60.0 67.0 67.0 80.0 80.0 113.0 113.0 118.0 118.0 131.0 131.0 160.0 160.0 182.0 182.0 241.0 241.0 326.0 326.0 429.0 429.0 479.0 479.0 494.0 494.0 430.0 430.0 346.0 346.0 314.0 314.0 272.0 272.0 221.0 221.0 204.0 204.0 199.0 199.0 171.0 171.0 142.0 142.0 126.0 126.0 149.0 149.0 120.0 120.0 117.0 117.0 115.0 115.0 86.0 86.0 96.0 96.0 112.0 112.0 97.0 97.0 106.0 106.0 92.0 92.0 114.0 114.0 115.0 115.0 142.0 142.0 186.0 186.0 190.0 190.0 220.0 220.0 229.0 229.0 268.0 268.0 301.0 301.0 346.0 346.0 361.0 361.0 458.0 458.0 446.0 446.0 399.0 399.0 277.0 277.0 219.0 219.0 186.0 186.0 149.0 149.0 111.0 111.0 98.0 98.0 70.0 70.0 69.0 69.0 58.0 58.0 57.0 57.0 55.0 55.0 58.0 58.0 17.0 17.0
+19.0 19.0 37.0 37.0 40.0 40.0 53.0 53.0 60.0 60.0 67.0 67.0 80.0 80.0 113.0 113.0 118.0 118.0 131.0 131.0 160.0 160.0 182.0 182.0 241.0 241.0 326.0 326.0 429.0 429.0 479.0 479.0 494.0 494.0 430.0 430.0 346.0 346.0 314.0 314.0 272.0 272.0 221.0 221.0 204.0 204.0 199.0 199.0 171.0 171.0 142.0 142.0 126.0 126.0 149.0 149.0 120.0 120.0 117.0 117.0 115.0 115.0 86.0 86.0 96.0 96.0 112.0 112.0 97.0 97.0 106.0 106.0 92.0 92.0 114.0 114.0 115.0 115.0 142.0 142.0 186.0 186.0 190.0 190.0 220.0 220.0 229.0 229.0 268.0 268.0 301.0 301.0 346.0 346.0 361.0 361.0 458.0 458.0 446.0 446.0 399.0 399.0 277.0 277.0 219.0 219.0 186.0 186.0 149.0 149.0 111.0 111.0 98.0 98.0 70.0 70.0 69.0 69.0 58.0 58.0 57.0 57.0 55.0 55.0 58.0 58.0 17.0 17.0
+17.0 17.0 46.0 46.0 54.0 54.0 58.0 58.0 91.0 91.0 68.0 68.0 87.0 87.0 100.0 100.0 105.0 105.0 114.0 114.0 151.0 151.0 178.0 178.0 216.0 216.0 311.0 311.0 342.0 342.0 432.0 432.0 485.0 485.0 433.0 433.0 395.0 395.0 374.0 374.0 289.0 289.0 284.0 284.0 210.0 210.0 203.0 203.0 179.0 179.0 156.0 156.0 128.0 128.0 144.0 144.0 109.0 109.0 134.0 134.0 113.0 113.0 145.0 145.0 103.0 103.0 107.0 107.0 122.0 122.0 120.0 120.0 114.0 114.0 128.0 128.0 158.0 158.0 177.0 177.0 167.0 167.0 207.0 207.0 225.0 225.0 268.0 268.0 300.0 300.0 327.0 327.0 404.0 404.0 448.0 448.0 448.0 448.0 386.0 386.0 353.0 353.0 223.0 223.0 216.0 216.0 174.0 174.0 134.0 134.0 107.0 107.0 89.0 89.0 79.0 79.0 87.0 87.0 74.0 74.0 68.0 68.0 45.0 45.0 44.0 44.0 17.0 17.0
+17.0 17.0 46.0 46.0 54.0 54.0 58.0 58.0 91.0 91.0 68.0 68.0 87.0 87.0 100.0 100.0 105.0 105.0 114.0 114.0 151.0 151.0 178.0 178.0 216.0 216.0 311.0 311.0 342.0 342.0 432.0 432.0 485.0 485.0 433.0 433.0 395.0 395.0 374.0 374.0 289.0 289.0 284.0 284.0 210.0 210.0 203.0 203.0 179.0 179.0 156.0 156.0 128.0 128.0 144.0 144.0 109.0 109.0 134.0 134.0 113.0 113.0 145.0 145.0 103.0 103.0 107.0 107.0 122.0 122.0 120.0 120.0 114.0 114.0 128.0 128.0 158.0 158.0 177.0 177.0 167.0 167.0 207.0 207.0 225.0 225.0 268.0 268.0 300.0 300.0 327.0 327.0 404.0 404.0 448.0 448.0 448.0 448.0 386.0 386.0 353.0 353.0 223.0 223.0 216.0 216.0 174.0 174.0 134.0 134.0 107.0 107.0 89.0 89.0 79.0 79.0 87.0 87.0 74.0 74.0 68.0 68.0 45.0 45.0 44.0 44.0 17.0 17.0
+13.0 13.0 43.0 43.0 54.0 54.0 68.0 68.0 73.0 73.0 102.0 102.0 79.0 79.0 85.0 85.0 108.0 108.0 135.0 135.0 131.0 131.0 182.0 182.0 211.0 211.0 232.0 232.0 316.0 316.0 418.0 418.0 481.0 481.0 469.0 469.0 422.0 422.0 373.0 373.0 336.0 336.0 297.0 297.0 273.0 273.0 250.0 250.0 217.0 217.0 211.0 211.0 158.0 158.0 171.0 171.0 124.0 124.0 136.0 136.0 143.0 143.0 126.0 126.0 121.0 121.0 133.0 133.0 140.0 140.0 141.0 141.0 137.0 137.0 141.0 141.0 177.0 177.0 173.0 173.0 194.0 194.0 233.0 233.0 269.0 269.0 305.0 305.0 320.0 320.0 399.0 399.0 432.0 432.0 503.0 503.0 446.0 446.0 322.0 322.0 285.0 285.0 192.0 192.0 184.0 184.0 150.0 150.0 134.0 134.0 103.0 103.0 97.0 97.0 91.0 91.0 72.0 72.0 73.0 73.0 58.0 58.0 52.0 52.0 49.0 49.0 18.0 18.0
+13.0 13.0 43.0 43.0 54.0 54.0 68.0 68.0 73.0 73.0 102.0 102.0 79.0 79.0 85.0 85.0 108.0 108.0 135.0 135.0 131.0 131.0 182.0 182.0 211.0 211.0 232.0 232.0 316.0 316.0 418.0 418.0 481.0 481.0 469.0 469.0 422.0 422.0 373.0 373.0 336.0 336.0 297.0 297.0 273.0 273.0 250.0 250.0 217.0 217.0 211.0 211.0 158.0 158.0 171.0 171.0 124.0 124.0 136.0 136.0 143.0 143.0 126.0 126.0 121.0 121.0 133.0 133.0 140.0 140.0 141.0 141.0 137.0 137.0 141.0 141.0 177.0 177.0 173.0 173.0 194.0 194.0 233.0 233.0 269.0 269.0 305.0 305.0 320.0 320.0 399.0 399.0 432.0 432.0 503.0 503.0 446.0 446.0 322.0 322.0 285.0 285.0 192.0 192.0 184.0 184.0 150.0 150.0 134.0 134.0 103.0 103.0 97.0 97.0 91.0 91.0 72.0 72.0 73.0 73.0 58.0 58.0 52.0 52.0 49.0 49.0 18.0 18.0
+16.0 16.0 38.0 38.0 70.0 70.0 73.0 73.0 95.0 95.0 100.0 100.0 116.0 116.0 127.0 127.0 115.0 115.0 122.0 122.0 120.0 120.0 141.0 141.0 171.0 171.0 212.0 212.0 289.0 289.0 336.0 336.0 494.0 494.0 485.0 485.0 479.0 479.0 455.0 455.0 434.0 434.0 378.0 378.0 344.0 344.0 271.0 271.0 240.0 240.0 223.0 223.0 201.0 201.0 218.0 218.0 158.0 158.0 177.0 177.0 160.0 160.0 119.0 119.0 140.0 140.0 147.0 147.0 163.0 163.0 171.0 171.0 173.0 173.0 179.0 179.0 176.0 176.0 217.0 217.0 259.0 259.0 284.0 284.0 335.0 335.0 387.0 387.0 437.0 437.0 476.0 476.0 514.0 514.0 459.0 459.0 450.0 450.0 316.0 316.0 246.0 246.0 164.0 164.0 168.0 168.0 113.0 113.0 117.0 117.0 115.0 115.0 92.0 92.0 125.0 125.0 101.0 101.0 91.0 91.0 80.0 80.0 71.0 71.0 64.0 64.0 16.0 16.0
+16.0 16.0 38.0 38.0 70.0 70.0 73.0 73.0 95.0 95.0 100.0 100.0 116.0 116.0 127.0 127.0 115.0 115.0 122.0 122.0 120.0 120.0 141.0 141.0 171.0 171.0 212.0 212.0 289.0 289.0 336.0 336.0 494.0 494.0 485.0 485.0 479.0 479.0 455.0 455.0 434.0 434.0 378.0 378.0 344.0 344.0 271.0 271.0 240.0 240.0 223.0 223.0 201.0 201.0 218.0 218.0 158.0 158.0 177.0 177.0 160.0 160.0 119.0 119.0 140.0 140.0 147.0 147.0 163.0 163.0 171.0 171.0 173.0 173.0 179.0 179.0 176.0 176.0 217.0 217.0 259.0 259.0 284.0 284.0 335.0 335.0 387.0 387.0 437.0 437.0 476.0 476.0 514.0 514.0 459.0 459.0 450.0 450.0 316.0 316.0 246.0 246.0 164.0 164.0 168.0 168.0 113.0 113.0 117.0 117.0 115.0 115.0 92.0 92.0 125.0 125.0 101.0 101.0 91.0 91.0 80.0 80.0 71.0 71.0 64.0 64.0 16.0 16.0
+1.0 1.0 51.0 51.0 65.0 65.0 88.0 88.0 114.0 114.0 96.0 96.0 132.0 132.0 136.0 136.0 109.0 109.0 123.0 123.0 123.0 123.0 131.0 131.0 156.0 156.0 195.0 195.0 223.0 223.0 314.0 314.0 402.0 402.0 508.0 508.0 666.0 666.0 676.0 676.0 695.0 695.0 667.0 667.0 521.0 521.0 454.0 454.0 364.0 364.0 305.0 305.0 272.0 272.0 218.0 218.0 177.0 177.0 188.0 188.0 207.0 207.0 176.0 176.0 178.0 178.0 188.0 188.0 171.0 171.0 204.0 204.0 211.0 211.0 210.0 210.0 238.0 238.0 288.0 288.0 331.0 331.0 455.0 455.0 601.0 601.0 617.0 617.0 587.0 587.0 646.0 646.0 584.0 584.0 441.0 441.0 368.0 368.0 302.0 302.0 222.0 222.0 207.0 207.0 135.0 135.0 104.0 104.0 109.0 109.0 93.0 93.0 104.0 104.0 125.0 125.0 116.0 116.0 122.0 122.0 108.0 108.0 73.0 73.0 61.0 61.0 20.0 20.0
+1.0 1.0 51.0 51.0 65.0 65.0 88.0 88.0 114.0 114.0 96.0 96.0 132.0 132.0 136.0 136.0 109.0 109.0 123.0 123.0 123.0 123.0 131.0 131.0 156.0 156.0 195.0 195.0 223.0 223.0 314.0 314.0 402.0 402.0 508.0 508.0 666.0 666.0 676.0 676.0 695.0 695.0 667.0 667.0 521.0 521.0 454.0 454.0 364.0 364.0 305.0 305.0 272.0 272.0 218.0 218.0 177.0 177.0 188.0 188.0 207.0 207.0 176.0 176.0 178.0 178.0 188.0 188.0 171.0 171.0 204.0 204.0 211.0 211.0 210.0 210.0 238.0 238.0 288.0 288.0 331.0 331.0 455.0 455.0 601.0 601.0 617.0 617.0 587.0 587.0 646.0 646.0 584.0 584.0 441.0 441.0 368.0 368.0 302.0 302.0 222.0 222.0 207.0 207.0 135.0 135.0 104.0 104.0 109.0 109.0 93.0 93.0 104.0 104.0 125.0 125.0 116.0 116.0 122.0 122.0 108.0 108.0 73.0 73.0 61.0 61.0 20.0 20.0
+11.0 11.0 49.0 49.0 55.0 55.0 97.0 97.0 133.0 133.0 157.0 157.0 166.0 166.0 160.0 160.0 140.0 140.0 129.0 129.0 128.0 128.0 122.0 122.0 149.0 149.0 161.0 161.0 236.0 236.0 314.0 314.0 412.0 412.0 535.0 535.0 678.0 678.0 847.0 847.0 1053.0 1053.0 1212.0 1212.0 1378.0 1378.0 1049.0 1049.0 799.0 799.0 467.0 467.0 356.0 356.0 277.0 277.0 238.0 238.0 254.0 254.0 222.0 222.0 207.0 207.0 211.0 211.0 236.0 236.0 211.0 211.0 232.0 232.0 233.0 233.0 261.0 261.0 331.0 331.0 475.0 475.0 832.0 832.0 1166.0 1166.0 1262.0 1262.0 1211.0 1211.0 983.0 983.0 818.0 818.0 631.0 631.0 471.0 471.0 312.0 312.0 270.0 270.0 220.0 220.0 152.0 152.0 146.0 146.0 122.0 122.0 138.0 138.0 121.0 121.0 153.0 153.0 145.0 145.0 158.0 158.0 142.0 142.0 113.0 113.0 76.0 76.0 76.0 76.0 14.0 14.0
+11.0 11.0 49.0 49.0 55.0 55.0 97.0 97.0 133.0 133.0 157.0 157.0 166.0 166.0 160.0 160.0 140.0 140.0 129.0 129.0 128.0 128.0 122.0 122.0 149.0 149.0 161.0 161.0 236.0 236.0 314.0 314.0 412.0 412.0 535.0 535.0 678.0 678.0 847.0 847.0 1053.0 1053.0 1212.0 1212.0 1378.0 1378.0 1049.0 1049.0 799.0 799.0 467.0 467.0 356.0 356.0 277.0 277.0 238.0 238.0 254.0 254.0 222.0 222.0 207.0 207.0 211.0 211.0 236.0 236.0 211.0 211.0 232.0 232.0 233.0 233.0 261.0 261.0 331.0 331.0 475.0 475.0 832.0 832.0 1166.0 1166.0 1262.0 1262.0 1211.0 1211.0 983.0 983.0 818.0 818.0 631.0 631.0 471.0 471.0 312.0 312.0 270.0 270.0 220.0 220.0 152.0 152.0 146.0 146.0 122.0 122.0 138.0 138.0 121.0 121.0 153.0 153.0 145.0 145.0 158.0 158.0 142.0 142.0 113.0 113.0 76.0 76.0 76.0 76.0 14.0 14.0
+23.0 23.0 44.0 44.0 73.0 73.0 109.0 109.0 155.0 155.0 157.0 157.0 170.0 170.0 175.0 175.0 179.0 179.0 135.0 135.0 150.0 150.0 125.0 125.0 128.0 128.0 161.0 161.0 214.0 214.0 244.0 244.0 355.0 355.0 475.0 475.0 610.0 610.0 921.0 921.0 1445.0 1445.0 2007.0 2007.0 2667.0 2667.0 2668.0 2668.0 2145.0 2145.0 1270.0 1270.0 643.0 643.0 381.0 381.0 299.0 299.0 300.0 300.0 294.0 294.0 252.0 252.0 253.0 253.0 244.0 244.0 278.0 278.0 296.0 296.0 321.0 321.0 402.0 402.0 614.0 614.0 1241.0 1241.0 2240.0 2240.0 2708.0 2708.0 2589.0 2589.0 1842.0 1842.0 1352.0 1352.0 861.0 861.0 573.0 573.0 384.0 384.0 337.0 337.0 217.0 217.0 171.0 171.0 133.0 133.0 148.0 148.0 100.0 100.0 126.0 126.0 142.0 142.0 167.0 167.0 166.0 166.0 173.0 173.0 148.0 148.0 108.0 108.0 65.0 65.0 62.0 62.0 19.0 19.0
+23.0 23.0 44.0 44.0 73.0 73.0 109.0 109.0 155.0 155.0 157.0 157.0 170.0 170.0 175.0 175.0 179.0 179.0 135.0 135.0 150.0 150.0 125.0 125.0 128.0 128.0 161.0 161.0 214.0 214.0 244.0 244.0 355.0 355.0 475.0 475.0 610.0 610.0 921.0 921.0 1445.0 1445.0 2007.0 2007.0 2667.0 2667.0 2668.0 2668.0 2145.0 2145.0 1270.0 1270.0 643.0 643.0 381.0 381.0 299.0 299.0 300.0 300.0 294.0 294.0 252.0 252.0 253.0 253.0 244.0 244.0 278.0 278.0 296.0 296.0 321.0 321.0 402.0 402.0 614.0 614.0 1241.0 1241.0 2240.0 2240.0 2708.0 2708.0 2589.0 2589.0 1842.0 1842.0 1352.0 1352.0 861.0 861.0 573.0 573.0 384.0 384.0 337.0 337.0 217.0 217.0 171.0 171.0 133.0 133.0 148.0 148.0 100.0 100.0 126.0 126.0 142.0 142.0 167.0 167.0 166.0 166.0 173.0 173.0 148.0 148.0 108.0 108.0 65.0 65.0 62.0 62.0 19.0 19.0
+19.0 19.0 36.0 36.0 63.0 63.0 101.0 101.0 146.0 146.0 175.0 175.0 194.0 194.0 198.0 198.0 193.0 193.0 160.0 160.0 118.0 118.0 124.0 124.0 116.0 116.0 126.0 126.0 186.0 186.0 227.0 227.0 279.0 279.0 378.0 378.0 580.0 580.0 919.0 919.0 1552.0 1552.0 2613.0 2613.0 3871.0 3871.0 4657.0 4657.0 3866.0 3866.0 2376.0 2376.0 1233.0 1233.0 574.0 574.0 404.0 404.0 336.0 336.0 318.0 318.0 280.0 280.0 276.0 276.0 290.0 290.0 327.0 327.0 348.0 348.0 405.0 405.0 687.0 687.0 1234.0 1234.0 2433.0 2433.0 4089.0 4089.0 4540.0 4540.0 3701.0 3701.0 2361.0 2361.0 1405.0 1405.0 769.0 769.0 498.0 498.0 307.0 307.0 251.0 251.0 188.0 188.0 166.0 166.0 114.0 114.0 101.0 101.0 92.0 92.0 128.0 128.0 142.0 142.0 172.0 172.0 207.0 207.0 236.0 236.0 167.0 167.0 110.0 110.0 79.0 79.0 63.0 63.0 16.0 16.0
+19.0 19.0 36.0 36.0 63.0 63.0 101.0 101.0 146.0 146.0 175.0 175.0 194.0 194.0 198.0 198.0 193.0 193.0 160.0 160.0 118.0 118.0 124.0 124.0 116.0 116.0 126.0 126.0 186.0 186.0 227.0 227.0 279.0 279.0 378.0 378.0 580.0 580.0 919.0 919.0 1552.0 1552.0 2613.0 2613.0 3871.0 3871.0 4657.0 4657.0 3866.0 3866.0 2376.0 2376.0 1233.0 1233.0 574.0 574.0 404.0 404.0 336.0 336.0 318.0 318.0 280.0 280.0 276.0 276.0 290.0 290.0 327.0 327.0 348.0 348.0 405.0 405.0 687.0 687.0 1234.0 1234.0 2433.0 2433.0 4089.0 4089.0 4540.0 4540.0 3701.0 3701.0 2361.0 2361.0 1405.0 1405.0 769.0 769.0 498.0 498.0 307.0 307.0 251.0 251.0 188.0 188.0 166.0 166.0 114.0 114.0 101.0 101.0 92.0 92.0 128.0 128.0 142.0 142.0 172.0 172.0 207.0 207.0 236.0 236.0 167.0 167.0 110.0 110.0 79.0 79.0 63.0 63.0 16.0 16.0
+16.0 16.0 34.0 34.0 65.0 65.0 89.0 89.0 139.0 139.0 164.0 164.0 201.0 201.0 201.0 201.0 199.0 199.0 146.0 146.0 127.0 127.0 100.0 100.0 116.0 116.0 133.0 133.0 165.0 165.0 186.0 186.0 244.0 244.0 294.0 294.0 418.0 418.0 727.0 727.0 1286.0 1286.0 2418.0 2418.0 3939.0 3939.0 4870.0 4870.0 4394.0 4394.0 2933.0 2933.0 1571.0 1571.0 855.0 855.0 515.0 515.0 402.0 402.0 346.0 346.0 340.0 340.0 334.0 334.0 305.0 305.0 351.0 351.0 371.0 371.0 526.0 526.0 919.0 919.0 1650.0 1650.0 3167.0 3167.0 4478.0 4478.0 4717.0 4717.0 3487.0 3487.0 2042.0 2042.0 1093.0 1093.0 610.0 610.0 367.0 367.0 242.0 242.0 197.0 197.0 166.0 166.0 129.0 129.0 108.0 108.0 90.0 90.0 128.0 128.0 102.0 102.0 144.0 144.0 178.0 178.0 170.0 170.0 204.0 204.0 163.0 163.0 122.0 122.0 62.0 62.0 47.0 47.0 12.0 12.0
+16.0 16.0 34.0 34.0 65.0 65.0 89.0 89.0 139.0 139.0 164.0 164.0 201.0 201.0 201.0 201.0 199.0 199.0 146.0 146.0 127.0 127.0 100.0 100.0 116.0 116.0 133.0 133.0 165.0 165.0 186.0 186.0 244.0 244.0 294.0 294.0 418.0 418.0 727.0 727.0 1286.0 1286.0 2418.0 2418.0 3939.0 3939.0 4870.0 4870.0 4394.0 4394.0 2933.0 2933.0 1571.0 1571.0 855.0 855.0 515.0 515.0 402.0 402.0 346.0 346.0 340.0 340.0 334.0 334.0 305.0 305.0 351.0 351.0 371.0 371.0 526.0 526.0 919.0 919.0 1650.0 1650.0 3167.0 3167.0 4478.0 4478.0 4717.0 4717.0 3487.0 3487.0 2042.0 2042.0 1093.0 1093.0 610.0 610.0 367.0 367.0 242.0 242.0 197.0 197.0 166.0 166.0 129.0 129.0 108.0 108.0 90.0 90.0 128.0 128.0 102.0 102.0 144.0 144.0 178.0 178.0 170.0 170.0 204.0 204.0 163.0 163.0 122.0 122.0 62.0 62.0 47.0 47.0 12.0 12.0
+17.0 17.0 17.0 17.0 43.0 43.0 62.0 62.0 92.0 92.0 130.0 130.0 143.0 143.0 152.0 152.0 142.0 142.0 139.0 139.0 114.0 114.0 131.0 131.0 101.0 101.0 115.0 115.0 127.0 127.0 151.0 151.0 225.0 225.0 268.0 268.0 305.0 305.0 462.0 462.0 790.0 790.0 1406.0 1406.0 2597.0 2597.0 3252.0 3252.0 3212.0 3212.0 2501.0 2501.0 1488.0 1488.0 891.0 891.0 569.0 569.0 434.0 434.0 398.0 398.0 353.0 353.0 312.0 312.0 366.0 366.0 374.0 374.0 447.0 447.0 599.0 599.0 951.0 951.0 1642.0 1642.0 2536.0 2536.0 3385.0 3385.0 3077.0 3077.0 2256.0 2256.0 1269.0 1269.0 628.0 628.0 411.0 411.0 305.0 305.0 209.0 209.0 184.0 184.0 130.0 130.0 115.0 115.0 97.0 97.0 85.0 85.0 83.0 83.0 112.0 112.0 139.0 139.0 160.0 160.0 143.0 143.0 160.0 160.0 139.0 139.0 88.0 88.0 62.0 62.0 37.0 37.0 9.0 9.0
+17.0 17.0 17.0 17.0 43.0 43.0 62.0 62.0 92.0 92.0 130.0 130.0 143.0 143.0 152.0 152.0 142.0 142.0 139.0 139.0 114.0 114.0 131.0 131.0 101.0 101.0 115.0 115.0 127.0 127.0 151.0 151.0 225.0 225.0 268.0 268.0 305.0 305.0 462.0 462.0 790.0 790.0 1406.0 1406.0 2597.0 2597.0 3252.0 3252.0 3212.0 3212.0 2501.0 2501.0 1488.0 1488.0 891.0 891.0 569.0 569.0 434.0 434.0 398.0 398.0 353.0 353.0 312.0 312.0 366.0 366.0 374.0 374.0 447.0 447.0 599.0 599.0 951.0 951.0 1642.0 1642.0 2536.0 2536.0 3385.0 3385.0 3077.0 3077.0 2256.0 2256.0 1269.0 1269.0 628.0 628.0 411.0 411.0 305.0 305.0 209.0 209.0 184.0 184.0 130.0 130.0 115.0 115.0 97.0 97.0 85.0 85.0 83.0 83.0 112.0 112.0 139.0 139.0 160.0 160.0 143.0 143.0 160.0 160.0 139.0 139.0 88.0 88.0 62.0 62.0 37.0 37.0 9.0 9.0
+14.0 14.0 40.0 40.0 45.0 45.0 54.0 54.0 74.0 74.0 102.0 102.0 128.0 128.0 131.0 131.0 134.0 134.0 129.0 129.0 130.0 130.0 105.0 105.0 109.0 109.0 114.0 114.0 127.0 127.0 127.0 127.0 165.0 165.0 212.0 212.0 244.0 244.0 342.0 342.0 447.0 447.0 754.0 754.0 1170.0 1170.0 1603.0 1603.0 1814.0 1814.0 1545.0 1545.0 1127.0 1127.0 778.0 778.0 519.0 519.0 467.0 467.0 422.0 422.0 374.0 374.0 338.0 338.0 341.0 341.0 374.0 374.0 460.0 460.0 590.0 590.0 760.0 760.0 1094.0 1094.0 1565.0 1565.0 1774.0 1774.0 1490.0 1490.0 992.0 992.0 599.0 599.0 340.0 340.0 275.0 275.0 212.0 212.0 149.0 149.0 137.0 137.0 113.0 113.0 103.0 103.0 81.0 81.0 82.0 82.0 83.0 83.0 85.0 85.0 114.0 114.0 113.0 113.0 89.0 89.0 108.0 108.0 75.0 75.0 54.0 54.0 33.0 33.0 33.0 33.0 5.0 5.0
+14.0 14.0 40.0 40.0 45.0 45.0 54.0 54.0 74.0 74.0 102.0 102.0 128.0 128.0 131.0 131.0 134.0 134.0 129.0 129.0 130.0 130.0 105.0 105.0 109.0 109.0 114.0 114.0 127.0 127.0 127.0 127.0 165.0 165.0 212.0 212.0 244.0 244.0 342.0 342.0 447.0 447.0 754.0 754.0 1170.0 1170.0 1603.0 1603.0 1814.0 1814.0 1545.0 1545.0 1127.0 1127.0 778.0 778.0 519.0 519.0 467.0 467.0 422.0 422.0 374.0 374.0 338.0 338.0 341.0 341.0 374.0 374.0 460.0 460.0 590.0 590.0 760.0 760.0 1094.0 1094.0 1565.0 1565.0 1774.0 1774.0 1490.0 1490.0 992.0 992.0 599.0 599.0 340.0 340.0 275.0 275.0 212.0 212.0 149.0 149.0 137.0 137.0 113.0 113.0 103.0 103.0 81.0 81.0 82.0 82.0 83.0 83.0 85.0 85.0 114.0 114.0 113.0 113.0 89.0 89.0 108.0 108.0 75.0 75.0 54.0 54.0 33.0 33.0 33.0 33.0 5.0 5.0
+9.0 9.0 31.0 31.0 27.0 27.0 34.0 34.0 45.0 45.0 58.0 58.0 88.0 88.0 88.0 88.0 100.0 100.0 88.0 88.0 79.0 79.0 72.0 72.0 70.0 70.0 70.0 70.0 104.0 104.0 103.0 103.0 107.0 107.0 133.0 133.0 146.0 146.0 204.0 204.0 254.0 254.0 405.0 405.0 562.0 562.0 677.0 677.0 805.0 805.0 864.0 864.0 704.0 704.0 564.0 564.0 444.0 444.0 413.0 413.0 398.0 398.0 353.0 353.0 340.0 340.0 372.0 372.0 399.0 399.0 395.0 395.0 506.0 506.0 581.0 581.0 660.0 660.0 794.0 794.0 790.0 790.0 641.0 641.0 483.0 483.0 337.0 337.0 262.0 262.0 198.0 198.0 138.0 138.0 121.0 121.0 133.0 133.0 81.0 81.0 88.0 88.0 79.0 79.0 85.0 85.0 68.0 68.0 101.0 101.0 94.0 94.0 86.0 86.0 83.0 83.0 78.0 78.0 46.0 46.0 45.0 45.0 37.0 37.0 28.0 28.0 8.0 8.0
+9.0 9.0 31.0 31.0 27.0 27.0 34.0 34.0 45.0 45.0 58.0 58.0 88.0 88.0 88.0 88.0 100.0 100.0 88.0 88.0 79.0 79.0 72.0 72.0 70.0 70.0 70.0 70.0 104.0 104.0 103.0 103.0 107.0 107.0 133.0 133.0 146.0 146.0 204.0 204.0 254.0 254.0 405.0 405.0 562.0 562.0 677.0 677.0 805.0 805.0 864.0 864.0 704.0 704.0 564.0 564.0 444.0 444.0 413.0 413.0 398.0 398.0 353.0 353.0 340.0 340.0 372.0 372.0 399.0 399.0 395.0 395.0 506.0 506.0 581.0 581.0 660.0 660.0 794.0 794.0 790.0 790.0 641.0 641.0 483.0 483.0 337.0 337.0 262.0 262.0 198.0 198.0 138.0 138.0 121.0 121.0 133.0 133.0 81.0 81.0 88.0 88.0 79.0 79.0 85.0 85.0 68.0 68.0 101.0 101.0 94.0 94.0 86.0 86.0 83.0 83.0 78.0 78.0 46.0 46.0 45.0 45.0 37.0 37.0 28.0 28.0 8.0 8.0
+3.0 3.0 29.0 29.0 32.0 32.0 36.0 36.0 38.0 38.0 47.0 47.0 66.0 66.0 88.0 88.0 78.0 78.0 79.0 79.0 75.0 75.0 87.0 87.0 95.0 95.0 84.0 84.0 94.0 94.0 91.0 91.0 104.0 104.0 127.0 127.0 130.0 130.0 152.0 152.0 229.0 229.0 254.0 254.0 326.0 326.0 434.0 434.0 507.0 507.0 517.0 517.0 506.0 506.0 485.0 485.0 409.0 409.0 370.0 370.0 346.0 346.0 369.0 369.0 333.0 333.0 340.0 340.0 318.0 318.0 363.0 363.0 385.0 385.0 489.0 489.0 519.0 519.0 473.0 473.0 459.0 459.0 393.0 393.0 325.0 325.0 229.0 229.0 196.0 196.0 147.0 147.0 113.0 113.0 113.0 113.0 89.0 89.0 79.0 79.0 81.0 81.0 65.0 65.0 68.0 68.0 70.0 70.0 85.0 85.0 77.0 77.0 60.0 60.0 72.0 72.0 53.0 53.0 44.0 44.0 29.0 29.0 39.0 39.0 28.0 28.0 6.0 6.0
+3.0 3.0 29.0 29.0 32.0 32.0 36.0 36.0 38.0 38.0 47.0 47.0 66.0 66.0 88.0 88.0 78.0 78.0 79.0 79.0 75.0 75.0 87.0 87.0 95.0 95.0 84.0 84.0 94.0 94.0 91.0 91.0 104.0 104.0 127.0 127.0 130.0 130.0 152.0 152.0 229.0 229.0 254.0 254.0 326.0 326.0 434.0 434.0 507.0 507.0 517.0 517.0 506.0 506.0 485.0 485.0 409.0 409.0 370.0 370.0 346.0 346.0 369.0 369.0 333.0 333.0 340.0 340.0 318.0 318.0 363.0 363.0 385.0 385.0 489.0 489.0 519.0 519.0 473.0 473.0 459.0 459.0 393.0 393.0 325.0 325.0 229.0 229.0 196.0 196.0 147.0 147.0 113.0 113.0 113.0 113.0 89.0 89.0 79.0 79.0 81.0 81.0 65.0 65.0 68.0 68.0 70.0 70.0 85.0 85.0 77.0 77.0 60.0 60.0 72.0 72.0 53.0 53.0 44.0 44.0 29.0 29.0 39.0 39.0 28.0 28.0 6.0 6.0
+4.0 4.0 15.0 15.0 26.0 26.0 36.0 36.0 30.0 30.0 23.0 23.0 48.0 48.0 38.0 38.0 52.0 52.0 48.0 48.0 67.0 67.0 52.0 52.0 70.0 70.0 72.0 72.0 65.0 65.0 68.0 68.0 63.0 63.0 107.0 107.0 82.0 82.0 128.0 128.0 133.0 133.0 179.0 179.0 199.0 199.0 233.0 233.0 280.0 280.0 328.0 328.0 315.0 315.0 306.0 306.0 280.0 280.0 277.0 277.0 248.0 248.0 304.0 304.0 258.0 258.0 239.0 239.0 272.0 272.0 255.0 255.0 278.0 278.0 294.0 294.0 305.0 305.0 328.0 328.0 269.0 269.0 229.0 229.0 188.0 188.0 165.0 165.0 134.0 134.0 96.0 96.0 85.0 85.0 78.0 78.0 74.0 74.0 73.0 73.0 66.0 66.0 57.0 57.0 48.0 48.0 49.0 49.0 44.0 44.0 46.0 46.0 38.0 38.0 46.0 46.0 38.0 38.0 29.0 29.0 28.0 28.0 22.0 22.0 25.0 25.0 3.0 3.0
+4.0 4.0 15.0 15.0 26.0 26.0 36.0 36.0 30.0 30.0 23.0 23.0 48.0 48.0 38.0 38.0 52.0 52.0 48.0 48.0 67.0 67.0 52.0 52.0 70.0 70.0 72.0 72.0 65.0 65.0 68.0 68.0 63.0 63.0 107.0 107.0 82.0 82.0 128.0 128.0 133.0 133.0 179.0 179.0 199.0 199.0 233.0 233.0 280.0 280.0 328.0 328.0 315.0 315.0 306.0 306.0 280.0 280.0 277.0 277.0 248.0 248.0 304.0 304.0 258.0 258.0 239.0 239.0 272.0 272.0 255.0 255.0 278.0 278.0 294.0 294.0 305.0 305.0 328.0 328.0 269.0 269.0 229.0 229.0 188.0 188.0 165.0 165.0 134.0 134.0 96.0 96.0 85.0 85.0 78.0 78.0 74.0 74.0 73.0 73.0 66.0 66.0 57.0 57.0 48.0 48.0 49.0 49.0 44.0 44.0 46.0 46.0 38.0 38.0 46.0 46.0 38.0 38.0 29.0 29.0 28.0 28.0 22.0 22.0 25.0 25.0 3.0 3.0
+5.0 5.0 16.0 16.0 18.0 18.0 27.0 27.0 27.0 27.0 24.0 24.0 36.0 36.0 42.0 42.0 46.0 46.0 53.0 53.0 59.0 59.0 43.0 43.0 41.0 41.0 49.0 49.0 55.0 55.0 59.0 59.0 76.0 76.0 70.0 70.0 75.0 75.0 84.0 84.0 96.0 96.0 117.0 117.0 138.0 138.0 173.0 173.0 201.0 201.0 227.0 227.0 255.0 255.0 240.0 240.0 218.0 218.0 250.0 250.0 207.0 207.0 218.0 218.0 184.0 184.0 215.0 215.0 205.0 205.0 191.0 191.0 226.0 226.0 237.0 237.0 201.0 201.0 208.0 208.0 198.0 198.0 173.0 173.0 123.0 123.0 129.0 129.0 100.0 100.0 84.0 84.0 74.0 74.0 66.0 66.0 65.0 65.0 61.0 61.0 55.0 55.0 58.0 58.0 46.0 46.0 45.0 45.0 50.0 50.0 43.0 43.0 38.0 38.0 31.0 31.0 44.0 44.0 31.0 31.0 26.0 26.0 18.0 18.0 26.0 26.0 2.0 2.0
+5.0 5.0 16.0 16.0 18.0 18.0 27.0 27.0 27.0 27.0 24.0 24.0 36.0 36.0 42.0 42.0 46.0 46.0 53.0 53.0 59.0 59.0 43.0 43.0 41.0 41.0 49.0 49.0 55.0 55.0 59.0 59.0 76.0 76.0 70.0 70.0 75.0 75.0 84.0 84.0 96.0 96.0 117.0 117.0 138.0 138.0 173.0 173.0 201.0 201.0 227.0 227.0 255.0 255.0 240.0 240.0 218.0 218.0 250.0 250.0 207.0 207.0 218.0 218.0 184.0 184.0 215.0 215.0 205.0 205.0 191.0 191.0 226.0 226.0 237.0 237.0 201.0 201.0 208.0 208.0 198.0 198.0 173.0 173.0 123.0 123.0 129.0 129.0 100.0 100.0 84.0 84.0 74.0 74.0 66.0 66.0 65.0 65.0 61.0 61.0 55.0 55.0 58.0 58.0 46.0 46.0 45.0 45.0 50.0 50.0 43.0 43.0 38.0 38.0 31.0 31.0 44.0 44.0 31.0 31.0 26.0 26.0 18.0 18.0 26.0 26.0 2.0 2.0
+5.0 5.0 29.0 29.0 22.0 22.0 22.0 22.0 25.0 25.0 36.0 36.0 31.0 31.0 34.0 34.0 36.0 36.0 32.0 32.0 36.0 36.0 44.0 44.0 44.0 44.0 56.0 56.0 61.0 61.0 67.0 67.0 43.0 43.0 62.0 62.0 54.0 54.0 67.0 67.0 99.0 99.0 104.0 104.0 121.0 121.0 149.0 149.0 154.0 154.0 193.0 193.0 168.0 168.0 166.0 166.0 182.0 182.0 171.0 171.0 185.0 185.0 183.0 183.0 153.0 153.0 172.0 172.0 174.0 174.0 174.0 174.0 176.0 176.0 168.0 168.0 167.0 167.0 139.0 139.0 140.0 140.0 124.0 124.0 97.0 97.0 86.0 86.0 75.0 75.0 77.0 77.0 66.0 66.0 78.0 78.0 56.0 56.0 62.0 62.0 58.0 58.0 47.0 47.0 41.0 41.0 47.0 47.0 47.0 47.0 30.0 30.0 32.0 32.0 31.0 31.0 32.0 32.0 28.0 28.0 20.0 20.0 26.0 26.0 22.0 22.0 3.0 3.0
+5.0 5.0 29.0 29.0 22.0 22.0 22.0 22.0 25.0 25.0 36.0 36.0 31.0 31.0 34.0 34.0 36.0 36.0 32.0 32.0 36.0 36.0 44.0 44.0 44.0 44.0 56.0 56.0 61.0 61.0 67.0 67.0 43.0 43.0 62.0 62.0 54.0 54.0 67.0 67.0 99.0 99.0 104.0 104.0 121.0 121.0 149.0 149.0 154.0 154.0 193.0 193.0 168.0 168.0 166.0 166.0 182.0 182.0 171.0 171.0 185.0 185.0 183.0 183.0 153.0 153.0 172.0 172.0 174.0 174.0 174.0 174.0 176.0 176.0 168.0 168.0 167.0 167.0 139.0 139.0 140.0 140.0 124.0 124.0 97.0 97.0 86.0 86.0 75.0 75.0 77.0 77.0 66.0 66.0 78.0 78.0 56.0 56.0 62.0 62.0 58.0 58.0 47.0 47.0 41.0 41.0 47.0 47.0 47.0 47.0 30.0 30.0 32.0 32.0 31.0 31.0 32.0 32.0 28.0 28.0 20.0 20.0 26.0 26.0 22.0 22.0 3.0 3.0
+1.0 1.0 20.0 20.0 21.0 21.0 24.0 24.0 22.0 22.0 29.0 29.0 22.0 22.0 32.0 32.0 32.0 32.0 34.0 34.0 42.0 42.0 34.0 34.0 59.0 59.0 45.0 45.0 49.0 49.0 42.0 42.0 53.0 53.0 56.0 56.0 64.0 64.0 75.0 75.0 72.0 72.0 63.0 63.0 95.0 95.0 97.0 97.0 106.0 106.0 114.0 114.0 139.0 139.0 142.0 142.0 119.0 119.0 144.0 144.0 148.0 148.0 148.0 148.0 128.0 128.0 123.0 123.0 130.0 130.0 132.0 132.0 111.0 111.0 107.0 107.0 107.0 107.0 126.0 126.0 89.0 89.0 83.0 83.0 80.0 80.0 79.0 79.0 80.0 80.0 58.0 58.0 54.0 54.0 40.0 40.0 49.0 49.0 48.0 48.0 50.0 50.0 34.0 34.0 25.0 25.0 34.0 34.0 33.0 33.0 31.0 31.0 18.0 18.0 31.0 31.0 27.0 27.0 25.0 25.0 14.0 14.0 25.0 25.0 17.0 17.0 7.0 7.0
+1.0 1.0 20.0 20.0 21.0 21.0 24.0 24.0 22.0 22.0 29.0 29.0 22.0 22.0 32.0 32.0 32.0 32.0 34.0 34.0 42.0 42.0 34.0 34.0 59.0 59.0 45.0 45.0 49.0 49.0 42.0 42.0 53.0 53.0 56.0 56.0 64.0 64.0 75.0 75.0 72.0 72.0 63.0 63.0 95.0 95.0 97.0 97.0 106.0 106.0 114.0 114.0 139.0 139.0 142.0 142.0 119.0 119.0 144.0 144.0 148.0 148.0 148.0 148.0 128.0 128.0 123.0 123.0 130.0 130.0 132.0 132.0 111.0 111.0 107.0 107.0 107.0 107.0 126.0 126.0 89.0 89.0 83.0 83.0 80.0 80.0 79.0 79.0 80.0 80.0 58.0 58.0 54.0 54.0 40.0 40.0 49.0 49.0 48.0 48.0 50.0 50.0 34.0 34.0 25.0 25.0 34.0 34.0 33.0 33.0 31.0 31.0 18.0 18.0 31.0 31.0 27.0 27.0 25.0 25.0 14.0 14.0 25.0 25.0 17.0 17.0 7.0 7.0
+3.0 3.0 22.0 22.0 23.0 23.0 22.0 22.0 23.0 23.0 18.0 18.0 20.0 20.0 26.0 26.0 32.0 32.0 32.0 32.0 42.0 42.0 39.0 39.0 48.0 48.0 38.0 38.0 33.0 33.0 52.0 52.0 50.0 50.0 55.0 55.0 48.0 48.0 58.0 58.0 59.0 59.0 72.0 72.0 62.0 62.0 78.0 78.0 86.0 86.0 112.0 112.0 102.0 102.0 108.0 108.0 113.0 113.0 119.0 119.0 106.0 106.0 125.0 125.0 114.0 114.0 121.0 121.0 117.0 117.0 108.0 108.0 105.0 105.0 112.0 112.0 129.0 129.0 91.0 91.0 88.0 88.0 97.0 97.0 65.0 65.0 60.0 60.0 64.0 64.0 52.0 52.0 37.0 37.0 39.0 39.0 39.0 39.0 35.0 35.0 41.0 41.0 28.0 28.0 40.0 40.0 38.0 38.0 32.0 32.0 14.0 14.0 29.0 29.0 27.0 27.0 31.0 31.0 24.0 24.0 24.0 24.0 22.0 22.0 28.0 28.0 4.0 4.0
+3.0 3.0 22.0 22.0 23.0 23.0 22.0 22.0 23.0 23.0 18.0 18.0 20.0 20.0 26.0 26.0 32.0 32.0 32.0 32.0 42.0 42.0 39.0 39.0 48.0 48.0 38.0 38.0 33.0 33.0 52.0 52.0 50.0 50.0 55.0 55.0 48.0 48.0 58.0 58.0 59.0 59.0 72.0 72.0 62.0 62.0 78.0 78.0 86.0 86.0 112.0 112.0 102.0 102.0 108.0 108.0 113.0 113.0 119.0 119.0 106.0 106.0 125.0 125.0 114.0 114.0 121.0 121.0 117.0 117.0 108.0 108.0 105.0 105.0 112.0 112.0 129.0 129.0 91.0 91.0 88.0 88.0 97.0 97.0 65.0 65.0 60.0 60.0 64.0 64.0 52.0 52.0 37.0 37.0 39.0 39.0 39.0 39.0 35.0 35.0 41.0 41.0 28.0 28.0 40.0 40.0 38.0 38.0 32.0 32.0 14.0 14.0 29.0 29.0 27.0 27.0 31.0 31.0 24.0 24.0 24.0 24.0 22.0 22.0 28.0 28.0 4.0 4.0
+4.0 4.0 22.0 22.0 19.0 19.0 20.0 20.0 25.0 25.0 20.0 20.0 16.0 16.0 23.0 23.0 28.0 28.0 28.0 28.0 32.0 32.0 29.0 29.0 34.0 34.0 40.0 40.0 41.0 41.0 35.0 35.0 61.0 61.0 38.0 38.0 49.0 49.0 41.0 41.0 49.0 49.0 48.0 48.0 68.0 68.0 53.0 53.0 71.0 71.0 91.0 91.0 105.0 105.0 100.0 100.0 84.0 84.0 100.0 100.0 96.0 96.0 110.0 110.0 97.0 97.0 98.0 98.0 97.0 97.0 89.0 89.0 89.0 89.0 82.0 82.0 67.0 67.0 80.0 80.0 71.0 71.0 61.0 61.0 61.0 61.0 34.0 34.0 55.0 55.0 50.0 50.0 52.0 52.0 42.0 42.0 36.0 36.0 39.0 39.0 34.0 34.0 29.0 29.0 34.0 34.0 29.0 29.0 29.0 29.0 23.0 23.0 19.0 19.0 18.0 18.0 23.0 23.0 22.0 22.0 20.0 20.0 16.0 16.0 21.0 21.0 6.0 6.0
+4.0 4.0 22.0 22.0 19.0 19.0 20.0 20.0 25.0 25.0 20.0 20.0 16.0 16.0 23.0 23.0 28.0 28.0 28.0 28.0 32.0 32.0 29.0 29.0 34.0 34.0 40.0 40.0 41.0 41.0 35.0 35.0 61.0 61.0 38.0 38.0 49.0 49.0 41.0 41.0 49.0 49.0 48.0 48.0 68.0 68.0 53.0 53.0 71.0 71.0 91.0 91.0 105.0 105.0 100.0 100.0 84.0 84.0 100.0 100.0 96.0 96.0 110.0 110.0 97.0 97.0 98.0 98.0 97.0 97.0 89.0 89.0 89.0 89.0 82.0 82.0 67.0 67.0 80.0 80.0 71.0 71.0 61.0 61.0 61.0 61.0 34.0 34.0 55.0 55.0 50.0 50.0 52.0 52.0 42.0 42.0 36.0 36.0 39.0 39.0 34.0 34.0 29.0 29.0 34.0 34.0 29.0 29.0 29.0 29.0 23.0 23.0 19.0 19.0 18.0 18.0 23.0 23.0 22.0 22.0 20.0 20.0 16.0 16.0 21.0 21.0 6.0 6.0
+4.0 4.0 16.0 16.0 24.0 24.0 26.0 26.0 24.0 24.0 28.0 28.0 31.0 31.0 18.0 18.0 26.0 26.0 25.0 25.0 28.0 28.0 32.0 32.0 21.0 21.0 25.0 25.0 38.0 38.0 42.0 42.0 31.0 31.0 45.0 45.0 53.0 53.0 42.0 42.0 59.0 59.0 29.0 29.0 69.0 69.0 59.0 59.0 65.0 65.0 85.0 85.0 82.0 82.0 90.0 90.0 91.0 91.0 92.0 92.0 107.0 107.0 119.0 119.0 104.0 104.0 105.0 105.0 94.0 94.0 102.0 102.0 103.0 103.0 78.0 78.0 76.0 76.0 76.0 76.0 59.0 59.0 55.0 55.0 54.0 54.0 48.0 48.0 33.0 33.0 33.0 33.0 43.0 43.0 36.0 36.0 44.0 44.0 29.0 29.0 38.0 38.0 25.0 25.0 33.0 33.0 30.0 30.0 16.0 16.0 32.0 32.0 27.0 27.0 24.0 24.0 22.0 22.0 21.0 21.0 23.0 23.0 28.0 28.0 25.0 25.0 4.0 4.0
+4.0 4.0 16.0 16.0 24.0 24.0 26.0 26.0 24.0 24.0 28.0 28.0 31.0 31.0 18.0 18.0 26.0 26.0 25.0 25.0 28.0 28.0 32.0 32.0 21.0 21.0 25.0 25.0 38.0 38.0 42.0 42.0 31.0 31.0 45.0 45.0 53.0 53.0 42.0 42.0 59.0 59.0 29.0 29.0 69.0 69.0 59.0 59.0 65.0 65.0 85.0 85.0 82.0 82.0 90.0 90.0 91.0 91.0 92.0 92.0 107.0 107.0 119.0 119.0 104.0 104.0 105.0 105.0 94.0 94.0 102.0 102.0 103.0 103.0 78.0 78.0 76.0 76.0 76.0 76.0 59.0 59.0 55.0 55.0 54.0 54.0 48.0 48.0 33.0 33.0 33.0 33.0 43.0 43.0 36.0 36.0 44.0 44.0 29.0 29.0 38.0 38.0 25.0 25.0 33.0 33.0 30.0 30.0 16.0 16.0 32.0 32.0 27.0 27.0 24.0 24.0 22.0 22.0 21.0 21.0 23.0 23.0 28.0 28.0 25.0 25.0 4.0 4.0
+1.0 1.0 18.0 18.0 14.0 14.0 28.0 28.0 18.0 18.0 22.0 22.0 21.0 21.0 14.0 14.0 16.0 16.0 26.0 26.0 25.0 25.0 34.0 34.0 28.0 28.0 42.0 42.0 28.0 28.0 30.0 30.0 35.0 35.0 31.0 31.0 27.0 27.0 40.0 40.0 32.0 32.0 55.0 55.0 51.0 51.0 57.0 57.0 57.0 57.0 59.0 59.0 79.0 79.0 89.0 89.0 92.0 92.0 118.0 118.0 126.0 126.0 141.0 141.0 130.0 130.0 154.0 154.0 129.0 129.0 95.0 95.0 85.0 85.0 85.0 85.0 66.0 66.0 58.0 58.0 52.0 52.0 39.0 39.0 37.0 37.0 50.0 50.0 37.0 37.0 27.0 27.0 39.0 39.0 39.0 39.0 40.0 40.0 34.0 34.0 38.0 38.0 22.0 22.0 31.0 31.0 25.0 25.0 18.0 18.0 34.0 34.0 23.0 23.0 20.0 20.0 20.0 20.0 18.0 18.0 17.0 17.0 15.0 15.0 19.0 19.0 1.0 1.0
+1.0 1.0 18.0 18.0 14.0 14.0 28.0 28.0 18.0 18.0 22.0 22.0 21.0 21.0 14.0 14.0 16.0 16.0 26.0 26.0 25.0 25.0 34.0 34.0 28.0 28.0 42.0 42.0 28.0 28.0 30.0 30.0 35.0 35.0 31.0 31.0 27.0 27.0 40.0 40.0 32.0 32.0 55.0 55.0 51.0 51.0 57.0 57.0 57.0 57.0 59.0 59.0 79.0 79.0 89.0 89.0 92.0 92.0 118.0 118.0 126.0 126.0 141.0 141.0 130.0 130.0 154.0 154.0 129.0 129.0 95.0 95.0 85.0 85.0 85.0 85.0 66.0 66.0 58.0 58.0 52.0 52.0 39.0 39.0 37.0 37.0 50.0 50.0 37.0 37.0 27.0 27.0 39.0 39.0 39.0 39.0 40.0 40.0 34.0 34.0 38.0 38.0 22.0 22.0 31.0 31.0 25.0 25.0 18.0 18.0 34.0 34.0 23.0 23.0 20.0 20.0 20.0 20.0 18.0 18.0 17.0 17.0 15.0 15.0 19.0 19.0 1.0 1.0
+0.0 0.0 17.0 17.0 14.0 14.0 32.0 32.0 22.0 22.0 16.0 16.0 33.0 33.0 23.0 23.0 26.0 26.0 30.0 30.0 37.0 37.0 27.0 27.0 31.0 31.0 24.0 24.0 34.0 34.0 39.0 39.0 28.0 28.0 35.0 35.0 34.0 34.0 38.0 38.0 33.0 33.0 39.0 39.0 44.0 44.0 45.0 45.0 56.0 56.0 67.0 67.0 67.0 67.0 83.0 83.0 88.0 88.0 140.0 140.0 115.0 115.0 181.0 181.0 152.0 152.0 166.0 166.0 105.0 105.0 101.0 101.0 100.0 100.0 68.0 68.0 48.0 48.0 61.0 61.0 54.0 54.0 44.0 44.0 34.0 34.0 36.0 36.0 37.0 37.0 25.0 25.0 36.0 36.0 25.0 25.0 28.0 28.0 26.0 26.0 25.0 25.0 29.0 29.0 32.0 32.0 28.0 28.0 25.0 25.0 22.0 22.0 26.0 26.0 21.0 21.0 27.0 27.0 24.0 24.0 28.0 28.0 15.0 15.0 21.0 21.0 2.0 2.0
+0.0 0.0 17.0 17.0 14.0 14.0 32.0 32.0 22.0 22.0 16.0 16.0 33.0 33.0 23.0 23.0 26.0 26.0 30.0 30.0 37.0 37.0 27.0 27.0 31.0 31.0 24.0 24.0 34.0 34.0 39.0 39.0 28.0 28.0 35.0 35.0 34.0 34.0 38.0 38.0 33.0 33.0 39.0 39.0 44.0 44.0 45.0 45.0 56.0 56.0 67.0 67.0 67.0 67.0 83.0 83.0 88.0 88.0 140.0 140.0 115.0 115.0 181.0 181.0 152.0 152.0 166.0 166.0 105.0 105.0 101.0 101.0 100.0 100.0 68.0 68.0 48.0 48.0 61.0 61.0 54.0 54.0 44.0 44.0 34.0 34.0 36.0 36.0 37.0 37.0 25.0 25.0 36.0 36.0 25.0 25.0 28.0 28.0 26.0 26.0 25.0 25.0 29.0 29.0 32.0 32.0 28.0 28.0 25.0 25.0 22.0 22.0 26.0 26.0 21.0 21.0 27.0 27.0 24.0 24.0 28.0 28.0 15.0 15.0 21.0 21.0 2.0 2.0
+1.0 1.0 6.0 6.0 32.0 32.0 32.0 32.0 21.0 21.0 19.0 19.0 29.0 29.0 20.0 20.0 19.0 19.0 31.0 31.0 32.0 32.0 24.0 24.0 33.0 33.0 32.0 32.0 37.0 37.0 31.0 31.0 40.0 40.0 32.0 32.0 27.0 27.0 36.0 36.0 42.0 42.0 33.0 33.0 33.0 33.0 55.0 55.0 47.0 47.0 48.0 48.0 54.0 54.0 74.0 74.0 99.0 99.0 139.0 139.0 135.0 135.0 211.0 211.0 157.0 157.0 152.0 152.0 142.0 142.0 111.0 111.0 99.0 99.0 72.0 72.0 42.0 42.0 45.0 45.0 43.0 43.0 39.0 39.0 33.0 33.0 37.0 37.0 32.0 32.0 32.0 32.0 28.0 28.0 33.0 33.0 26.0 26.0 28.0 28.0 29.0 29.0 28.0 28.0 28.0 28.0 22.0 22.0 23.0 23.0 25.0 25.0 16.0 16.0 20.0 20.0 18.0 18.0 24.0 24.0 17.0 17.0 19.0 19.0 4.0 4.0 0.0 0.0
+1.0 1.0 6.0 6.0 32.0 32.0 32.0 32.0 21.0 21.0 19.0 19.0 29.0 29.0 20.0 20.0 19.0 19.0 31.0 31.0 32.0 32.0 24.0 24.0 33.0 33.0 32.0 32.0 37.0 37.0 31.0 31.0 40.0 40.0 32.0 32.0 27.0 27.0 36.0 36.0 42.0 42.0 33.0 33.0 33.0 33.0 55.0 55.0 47.0 47.0 48.0 48.0 54.0 54.0 74.0 74.0 99.0 99.0 139.0 139.0 135.0 135.0 211.0 211.0 157.0 157.0 152.0 152.0 142.0 142.0 111.0 111.0 99.0 99.0 72.0 72.0 42.0 42.0 45.0 45.0 43.0 43.0 39.0 39.0 33.0 33.0 37.0 37.0 32.0 32.0 32.0 32.0 28.0 28.0 33.0 33.0 26.0 26.0 28.0 28.0 29.0 29.0 28.0 28.0 28.0 28.0 22.0 22.0 23.0 23.0 25.0 25.0 16.0 16.0 20.0 20.0 18.0 18.0 24.0 24.0 17.0 17.0 19.0 19.0 4.0 4.0 0.0 0.0
+7.0 7.0 1.0 1.0 14.0 14.0 15.0 15.0 21.0 21.0 21.0 21.0 15.0 15.0 19.0 19.0 16.0 16.0 30.0 30.0 29.0 29.0 24.0 24.0 34.0 34.0 30.0 30.0 23.0 23.0 48.0 48.0 38.0 38.0 35.0 35.0 27.0 27.0 33.0 33.0 47.0 47.0 34.0 34.0 34.0 34.0 47.0 47.0 52.0 52.0 39.0 39.0 46.0 46.0 86.0 86.0 57.0 57.0 128.0 128.0 127.0 127.0 186.0 186.0 144.0 144.0 134.0 134.0 113.0 113.0 109.0 109.0 84.0 84.0 58.0 58.0 59.0 59.0 47.0 47.0 36.0 36.0 59.0 59.0 35.0 35.0 29.0 29.0 28.0 28.0 27.0 27.0 33.0 33.0 27.0 27.0 24.0 24.0 22.0 22.0 26.0 26.0 25.0 25.0 26.0 26.0 33.0 33.0 16.0 16.0 22.0 22.0 20.0 20.0 18.0 18.0 24.0 24.0 24.0 24.0 18.0 18.0 3.0 3.0 1.0 1.0 1.0 1.0
+7.0 7.0 1.0 1.0 14.0 14.0 15.0 15.0 21.0 21.0 21.0 21.0 15.0 15.0 19.0 19.0 16.0 16.0 30.0 30.0 29.0 29.0 24.0 24.0 34.0 34.0 30.0 30.0 23.0 23.0 48.0 48.0 38.0 38.0 35.0 35.0 27.0 27.0 33.0 33.0 47.0 47.0 34.0 34.0 34.0 34.0 47.0 47.0 52.0 52.0 39.0 39.0 46.0 46.0 86.0 86.0 57.0 57.0 128.0 128.0 127.0 127.0 186.0 186.0 144.0 144.0 134.0 134.0 113.0 113.0 109.0 109.0 84.0 84.0 58.0 58.0 59.0 59.0 47.0 47.0 36.0 36.0 59.0 59.0 35.0 35.0 29.0 29.0 28.0 28.0 27.0 27.0 33.0 33.0 27.0 27.0 24.0 24.0 22.0 22.0 26.0 26.0 25.0 25.0 26.0 26.0 33.0 33.0 16.0 16.0 22.0 22.0 20.0 20.0 18.0 18.0 24.0 24.0 24.0 24.0 18.0 18.0 3.0 3.0 1.0 1.0 1.0 1.0
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_busy.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,60 @@
+## Copyright (C) 1998, 1999, 2000 Joao Cardoso.
+## 
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2 of the License, or (at your
+## option) any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## This file is part of tk_octave.
+
+## tk_busy (text)
+##
+## Opens a new window with 'text' printed end with a flashing hourglass.
+##
+## If called with no arguments, close the window.
+## If the window already exists, 'text' is updated
+## Only one tk_busy window is allowed at one time.
+##
+## Octave can continue processing while the hourglass is flashing.
+
+## 2001-09-14 Paul Kienzle <pkienzle@users.sf.net>
+## * convert to pthreads version of octave
+## * fix grammar in documentation
+
+function tk_busy (text)
+
+eval("tk_interp","");
+
+if (nargin == 0)
+	tk_cmd( "foreach i [after info] {after cancel $i}" );
+	tk_cmd( sprintf("proc rep {} {}") );
+	tk_cmd( "destroy .top_tk_busy" );
+elseif (tk_cmd( "winfo exists .top_tk_busy" ) == "1")
+	tk_cmd ( sprintf("set tk_busy_message \"%s\"", text) );
+	tk_cmd(  sprintf( "wm title .top_tk_busy {%s}", text) );
+else
+        tk_cmd( "toplevel .top_tk_busy -borderwidth 2 -relief groove" );
+        tk_cmd( sprintf( "wm title .top_tk_busy {%s}", text) );
+        #tk_cmd( "wm withdraw .top_tk_busy" );
+        tk_cmd( "label .top_tk_busy.l1 -textvar tk_busy_message -relief ridge -padx 10 -pady 5");
+        tk_cmd (sprintf("set tk_busy_message \"%s\"", text)); 
+        tk_cmd ("button .top_tk_busy.b1 -bitmap hourglass");
+
+        #tk_cmd("wm overrideredirect .top_tk_busy 1");
+
+        tk_cmd("pack .top_tk_busy.l1 .top_tk_busy.b1 \
+ -ipadx 2 -ipady 2 -padx 10 -pady 10");
+
+        #tk_cmd("wm deiconify .top_tk_busy");
+
+        tk_cmd("proc rep {a b} { .top_tk_busy.b1 configure \
+-foreground $a -background $b; after 1000 rep $b $a}");
+        tk_cmd("rep salmon green4");
+endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_busy_cancel.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,82 @@
+## Copyright (C) 1998, 1999, 2000 Joao Cardoso.
+## 
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2 of the License, or (at your
+## option) any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## This file is part of tk_octave.
+
+## st = tk_busy_cancel (text)
+##
+## tk_busy_cancel(text) sets up an hourglass box with the text message
+## inside and a cancel button. While in your processing loop you should 
+## periodically test whether the cancel button has been pressed by calling
+## without arguments.  After your loop, you should call tk_busy_cancel
+## without arguments and without a return value.  You may update the
+## message within the loop by calling tk_busy_cancel with a new text
+## string.
+##
+## Example
+##    tk_busy_cancel("Counting...");
+##    for i=1:100000
+##       if (tk_busy_cancel) break; end
+##       if (mod(i,100)==0)
+##          tk_busy_cancel(sprintf("Counting... %d",i));
+##       end
+##    end
+##    tk_busy_cancel;
+##    printf("Counted to %d\n", i);
+
+## 2001-09-14 Paul Kienzle <pkienzle@users.sf.net>
+## * use pthread version of tk_octave
+## * handle query mode without a new text string
+## * update documentation and provide an example
+
+function st = tk_busy_cancel (text)
+
+eval("tk_interp","");
+st = 0;
+
+if (nargin == 0 && nargout == 0)
+	tk_cmd( "\
+foreach i [after info] {after cancel $i}\n\
+destroy .top_tk_busy\n\
+proc busy_rep {} {}\n");
+	return
+endif
+
+if (tk_cmd( "winfo exists .top_tk_busy" ) == "1")
+     if (nargin == 1)
+	tk_cmd( sprintf("set tk_busy_message \"%s\"", text ), 0);
+	tk_cmd( sprintf( "wm title .top_tk_busy {%s}", text ), 0);
+     endif
+     st = tk_cmd("set stop" ) == "1";
+     return
+endif
+
+tk_cmd( "toplevel .top_tk_busy -borderwidth 2 -relief groove" );
+tk_cmd( sprintf( "wm title .top_tk_busy {%s}", text) );
+#tk_cmd( "wm withdraw .top_tk_busy" );
+tk_cmd( "label .top_tk_busy.l1 -textvar tk_busy_message -relief ridge -padx 10 -pady 5" );
+tk_cmd( sprintf("set tk_busy_message \"%s\"", text) ); 
+tk_cmd( "button .top_tk_busy.b1 -bitmap hourglass" );
+tk_cmd( "button .top_tk_busy.b2 -text Stop -command {set stop 1}" );
+tk_cmd( "set stop 0" );
+
+#tk_cmd( "wm overrideredirect .top_tk_busy 1" );
+
+tk_cmd( "pack .top_tk_busy.l1 .top_tk_busy.b1 .top_tk_busy.b2 -ipadx 2 -ipady 2 " );
+
+#tk_cmd( "wm deiconify .top_tk_busy" );
+
+tk_cmd( "proc busy_rep {a b} { .top_tk_busy.b1 configure \
+-foreground $a -background $b; after 1000 busy_rep $b $a}" );
+tk_cmd( "busy_rep salmon green4" );
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_dialog.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,74 @@
+## Copyright (C) 1998, 1999, 2000 Joao Cardoso.
+## 
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2 of the License, or (at your
+## option) any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## This file is part of tk_octave.
+
+## value = tk_dialog(title, text, bitmap, default, ...)
+##
+## open a dialog window named 'title' with 'text' printed and N buttons
+## named as the optional arguments, with button numbered 'default' being
+## the default action. The return value is the number of the clicked button.
+## First button is number 0.
+##
+## eg: ret = tk_dialog("Warning", "You are about to erase the whole disk. Are 
+##       you sure?", "questhead", 0, "No","Yes", "Have I asked you something?")
+## will return 0 if the first button (No) is clicked, etc.
+##
+## there are 6 meaningfull bitmap names: error, hourglass, info, questhead,
+##	question and warning. All arguments must be strings, except 'default'.
+
+## 2001-09-14 Paul Kienzle <pkienzle@users.sf.net>
+## * spelling corrections
+## * modified to work with pthreads version of tk_interp 
+
+
+function value = tk_dialog(title, text, bitmap, default, ...)
+
+eval("tk_interp","");
+
+if (nargin < 5 )
+  help tk_dialog
+  return
+endif
+
+if (! (isstr(title) & isstr(text) & isstr(bitmap) & is_scalar(default)))
+	error("'title', 'text' and 'bitmap' must be strings, and 'default' must be scalar.\n");
+	return
+endif
+
+if (!(strcmp(bitmap, "error") || strcmp(bitmap, "hourglass") || \
+	strcmp(bitmap, "info") || strcmp(bitmap, "questhead") || \
+	strcmp(bitmap, "question") || strcmp(bitmap, "warning")))
+	error("'bitmap' must be one of 'error', 'hourglass', 'info', \
+'questhead', 'question', 'warning'");
+	return	
+endif
+
+if (default > nargin-5)
+	error("'default' must be less then or equal to the number of buttons -1\n");
+	return
+endif
+
+cmd = sprintf("tk_dialog .top_tk_dialog \"%s\" \"%s\" \"%s\" %d", title, text, bitmap, default);
+
+while(--nargin != 3)
+	arg = va_arg;
+	if (! isstr(arg))
+		error("The arguments must be strings.\n");
+		return
+	endif
+	cmd = [cmd " " '"' arg '"'];
+endwhile
+
+value = str2num(tk_cmd( cmd ));
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_entry.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,104 @@
+## Copyright (C) 1998, 1999, 2000 Joao Cardoso.
+## 
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2 of the License, or (at your
+## option) any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## This file is part of tk_octave.
+
+## usage: [r1, r2, ...] = tk_entry (title, name, value, name, value, ...)
+##
+## Dialog to input several variables at once.
+
+## 2001-09-14 Paul Kienzle <pkienzle@users.sf.net>
+## * convert for pthreads-based tk_octave
+
+function [...] = tk_entry (t, ...)
+
+tk_init
+
+if (nargin < 2)
+    usage ("tk_entry (title, legend_1, value_1 | variable_1, ...)");
+endif
+
+tk_cmd( sprintf( "proc isnum {x} {regexp {^[0-9.eE+-]*$} $x}") );
+    
+tk_cmd( sprintf( "proc varcheck {name element op} {\n\
+upvar $name x ${name}_ x_\n\
+if {([isnum $x] && ![isnum $x_]) || (![isnum $x] && [isnum $x_])} {\n\
+	set erro [format \"Value entered, `%%s' has not same type as previous one, `%%s'\" $x $x_]\n\
+	set x $x_\n tkerror $erro \n}\n}\n") );
+
+tk_cmd( sprintf("wm deiconify .;frame .master") );
+
+if (! isempty (t))
+    tk_cmd( sprintf("wm title . \"%s\"", t) );
+	tk_cmd( sprintf("label .master.ltitle -pady 5 -relief groove -borderwidth 2 -text \"%s\";\
+		pack .master.ltitle -fill x -side top", t) );
+endif
+
+    nopt = (nargin - 1)/2;
+    cmd_ok = cmd_res = "";
+	va_start();
+    
+for i=1:nopt
+	desc = va_arg();
+	val = va_arg();
+
+	tk_cmd( sprintf( "unset val_%d val_%d_\n", i, i) );	# unset previous invocation values
+
+	if (isstr(val))									# string
+		tk_cmd( sprintf( "set val_%d \"%s\"", i, val) );	# work value
+		tk_cmd( sprintf( "set val_%d_ \"%s\"", i, val) );	# original value
+		cmd_ok = strcat( cmd_ok, sprintf("val_%d = \\\"$val_%d\\\";", i, i));
+	elseif (floor(val) == val)						# integer
+		tk_cmd( sprintf( "set val_%d %d", i, val));
+		tk_cmd( sprintf( "set val_%d_ %d", i, val));
+		cmd_ok = strcat( cmd_ok, sprintf("val_%d = $val_%d;", i, i));
+	else											# float
+		tk_cmd( sprintf( "set val_%d %f", i, val));
+		tk_cmd( sprintf( "set val_%d_ %f", i, val));
+		cmd_ok = strcat( cmd_ok, sprintf("val_%d = $val_%d;", i, i));
+	endif
+	
+	tk_cmd( sprintf( "trace variable val_%d w varcheck", i));
+
+	tk_cmd( sprintf( "frame .master.f%d", i));
+	tk_cmd( sprintf( "entry .master.f%d.e%d -textvariable val_%d", i, i, i));
+	tk_cmd( sprintf( "pack .master.f%d -fill x", i));
+        if (desc != "")
+	  tk_cmd( sprintf( "label .master.f%d.l%d -font 8x13bold -text \"%s\"", i, i, desc));
+	  tk_cmd( sprintf( "pack .master.f%d.l%d -side left", i, i));
+	endif
+	tk_cmd( sprintf( "pack .master.f%d.e%d -side right", i, i));
+	tk_cmd( sprintf( "bind .master.f%d.e%d <Return> {set val_%d $val_%d}", i, i, i, i));
+	tk_cmd( sprintf( "bind .master.f%d.e%d <Tab> {set val_%d $val_%d}", i, i, i, i));
+	cmd_res = strcat( cmd_res, sprintf("set val_%d $val_%d_;", i, i));
+endfor
+
+tk_cmd( sprintf( "frame .master.f%d -relief groove -borderwidth 2", nargin) );
+	
+tk_cmd( sprintf( "button .master.f%d.b1 -text OK -command { destroy .master}", nargin) );
+tk_cmd( sprintf( "bind .master.f%d.b1 <Return> {destroy .master }", nargin) );
+tk_cmd( sprintf( "button .master.f%d.b2 -text Restore -command {%s}", nargin, cmd_res) );
+tk_cmd( sprintf( "bind .master.f%d.b2 <Return> {%s}", nargin, cmd_res) );
+tk_cmd( sprintf( "pack .master.f%d -side bottom -fill x", nargin) );
+tk_cmd( sprintf( "pack .master.f%d.b1 .master.f%d.b2 -side left", nargin, nargin) );
+
+tk_cmd( sprintf("pack .master -fill both -expand 1") );
+
+tk_cmd( "tkwait window .master" );
+eval(tk_cmd(sprintf("set result \"%s\" ", cmd_ok )));
+
+for i=1:nopt
+	vr_val(eval(sprintf("val_%d;",i)));
+	tk_cmd( sprintf( "trace vdelete val_%d w varcheck", i) );
+endfor
+	
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_error.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,29 @@
+## Copyright (C) 1998, 1999, 2000 Joao Cardoso.
+## 
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2 of the License, or (at your
+## option) any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## This file is part of tk_octave.
+
+## ret = tk_error(text)
+##
+## Open a window with 'text' printed and asking for acknowledgement.
+##
+## see also: tk_dialog
+
+## 2001-09-14 Paul Kienzle <pkienzle@users.sf.net>
+## * documentation update
+
+function ret = tk_error(text)
+
+ret = tk_dialog("",text,"error", 0,"OK");
+
+endfunction
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_init.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,16 @@
+## usage: tk_init
+##
+## Start the interpreter if it is not already running.
+## Do any required initialization. Currently, this
+## just hides the root window.  You can restore it
+## again with tk_cmd("wm deiconify .")
+
+## This code is in the public domain.
+
+function tk_init
+  try
+    tk_interp;
+    tk_cmd("wm withdraw .");
+  catch
+  end
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_input.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,36 @@
+## Copyright (C) 1998, 1999, 2000 Joao Cardoso.
+## 
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2 of the License, or (at your
+## option) any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## This file is part of tk_octave.
+
+## out = tk_input (prompt, opt)
+##
+## Prompt user for input.
+## If the second argument is present, return the user entry as a string,
+## else return the result of evaluating the user entry.
+
+## 2001-09-14 Paul Kienzle <pkienzle@users.sf.net>
+## * adapt for pthreads-based tk_octave
+
+function out = tk_input (prompt, opt)
+
+if (nargin < 1 | nargin > 2)
+    help tk_input
+    return
+endif
+
+out = tk_entry(prompt,""," ");
+if (nargin == 1)
+	out = eval([out, ";"]);
+endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_interp.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,1039 @@
+
+/* 
+
+This code is in the public domain. Use, modify, redistribute with or
+without modification, or license it as you see fit.
+
+*/
+
+#include <octave/config.h>
+#include <octave/oct-obj.h>
+#include <octave/parse.h>
+#include <octave/defun-dld.h>
+#include <octave/error.h>
+#include <octave/variables.h>
+#include <octave/sighandlers.h>
+#include <octave/mx-base.h>
+#include <octave/help.h>
+
+#include <tk.h>
+
+// I have attempted to block all access to octave variables from the tcl
+// thread while octave is running, but I didn't do it correctly and it
+// leads to deadlocks.  Since the window on the race condition is very
+// small, and can be avoided completely with careful programming, I haven't
+// yet debugged this. Set SAFE_VAR to 1 to include what I have done so far.
+
+#define SAFE_VAR 0
+
+#ifndef HAVE_BLT
+#define HAVE_BLT 0
+#endif
+
+#if HAVE_BLT
+#include <blt.h>
+#include <bltVector.h>
+#endif /* HAVE_BLT */
+
+#ifndef HAVE_VTK
+#define HAVE_VTK 0
+#endif
+
+#if HAVE_VTK
+#include <vtk/vtk.h>
+#include <vtk/vtkRenderer.h>
+#include <vtk/vtkRenderWindow.h>
+#include <vtk/vtkRenderWindowInteractor.h>
+#include <vtk/vtkPlaneSource.h>
+#include <vtk/vtkTransform.h>
+#include <vtk/vtkTransformPolyDataFilter.h>
+#include <vtk/vtkPoints.h>
+#include <vtk/vtkScalars.h>
+#include <vtk/vtkWarpScalar.h>
+#include <vtk/vtkDataSetMapper.h>
+#include <vtk/vtkPolyData.h>
+#include <vtk/vtkActor.h>
+#include <vtk/vtkTclUtil.h>
+#endif /* HAVE_VTK */
+
+#include <string>
+#include <strstream>
+
+#include <string.h>
+#include <stdlib.h>
+#include <signal.h>
+#include <unistd.h>
+#include <pthread.h>
+#include <iostream.h>
+
+#define TRUE  1
+#define FALSE 0
+
+#define ID "$Id$"
+
+static Tcl_Interp *interp = NULL;
+
+static char *command_to_do  = NULL;
+static char *command_result = NULL;
+
+static pthread_t       tk_thread = 0;
+static pthread_cond_t  tk_cond   = PTHREAD_COND_INITIALIZER;
+static pthread_mutex_t tk_mutex  = PTHREAD_MUTEX_INITIALIZER;
+
+#if SAVE_VAR
+static pthread_mutex_t oct_mutex = PTHREAD_MUTEX_INITIALIZER;
+#endif
+
+static int continue_running;
+
+class fifo
+{
+   struct fifo_element
+   {
+      char *cmd;
+      struct fifo_element *next;
+   } *front;
+public:
+   fifo(void) { front = NULL; }   /* Initialize the FIFO. */
+   void push(char *cmd)   /* Add command to back of the fifo. */
+   {
+      fifo_element *push_me = front;
+      if(push_me)
+      {
+         while(push_me->next) push_me = push_me->next;
+         push_me->next = new fifo_element;
+         push_me = push_me->next;
+      }
+      else
+      {
+         push_me = new fifo_element;
+         front = push_me;
+      }
+      push_me->cmd = new char[strlen(cmd)+1];
+      strcpy(push_me->cmd, cmd);
+      push_me->next = NULL;
+   }
+   void pop(void)   /* Remove the command at the front of the fifo. */
+   {
+      if(front)
+      {
+         fifo_element *pop_me = front;
+         front = front->next;
+         delete[] pop_me->cmd;
+         delete pop_me;
+      }
+   }
+   char *peek(void)   /* Return the command at the front of the fifo. */
+   {
+      if(front) return front->cmd;
+      else return NULL;
+   }
+} tk_fifo;
+
+
+/************************************************************
+
+   Get an octave value from Octave's global symbol table
+
+   If the symbol does not exist, or the value is undefined, 
+   return a value for which value.is_undefined() is true.
+
+
+************************************************************/
+static octave_value get_octave_value(char *name)
+{
+  octave_value def;
+
+  // Copy variable from octave
+#if SAFE_VAR
+  pthread_mutex_lock(&oct_mutex);
+#endif
+  symbol_record *sr;
+  if (!strncmp(name, "global::", 8))
+    sr = global_sym_tab->lookup (name+8);
+  else if (!strncmp(name, "top::", 5))
+    sr = top_level_sym_tab->lookup (name+5);
+  else if (!strncmp(name, "current::", 9))
+    sr = curr_sym_tab->lookup (name+9);
+  else
+    sr = top_level_sym_tab->lookup (name);
+  if (sr) def = sr->def();
+#if SAFE_VAR
+  pthread_mutex_unlock(&oct_mutex);
+#endif
+
+  return def;
+}
+
+
+/************************************************************
+
+   Tk Photo Image Format for an Octave matrix:
+
+   The following procedures and data structures are used to
+   establish a photo image format within Tk that allows an
+   Octave matrix to be represented as an image.
+
+************************************************************/
+
+static int
+StringMatchOctaveMatrix(Tcl_Obj *, Tcl_Obj *, int *, int *, Tcl_Interp *);
+
+static int
+StringReadOctaveMatrix(Tcl_Interp *, Tcl_Obj *, Tcl_Obj *, Tk_PhotoHandle,
+int, int, int, int, int, int);
+
+Tk_PhotoImageFormat tkImgFmtOctaveMatrix =
+{
+   "OctaveMatrix",            // name
+   NULL,                      // fileMatchProc
+   StringMatchOctaveMatrix,   // stringMatchProc
+   NULL,                      // fileReadProc
+   StringReadOctaveMatrix,    // stringReadProc
+   NULL,                      // fileWriteProc
+   NULL                       // stringWriteProc
+};
+
+#define DEFAULT_COLORMAP_LENGTH 41
+
+unsigned char *make_grayscale_colormap(int length)
+{
+  unsigned char *colormap = (unsigned char *) malloc (3*length);
+  float incr = 255.0 / (length - 1);
+  float rgb_val = 0.0;
+  for(int i = 0; i < length; i++)
+    {
+      colormap[3*i] = colormap[3*i+1] = colormap[3*i+2] 
+	= (unsigned char)rgb_val;
+      rgb_val += incr;
+    }
+  return colormap;
+}
+
+unsigned char *make_custom_colormap(Matrix m)
+{
+  int length = m.rows();
+  unsigned char *colormap = (unsigned char *) malloc (3*length);
+  for(int i = 0; i < length; i++)
+    {
+      colormap[3*i] = (unsigned char)(255.0*m.elem(i, 0));
+      colormap[3*i+1] = (unsigned char)(255.0*m.elem(i, 1));
+      colormap[3*i+2] = (unsigned char)(255.0*m.elem(i, 2));
+   }
+   return colormap;
+}
+
+static int
+myStringMatchOctaveMatrix 
+(int argc, char **argv, int *widthP, int *heightP, Tcl_Interp *interp)
+{
+  if (argc < 1) return FALSE;
+
+  octave_value def = get_octave_value(argv[0]);
+  if(!def.is_defined() || !def.is_real_matrix()) 
+    return FALSE;   // See if the arg is a matrix
+  Matrix m = def.matrix_value();
+
+  // We don't check any of the arguments here since
+  // this will be done in StringReadOctaveMatrix below.
+  *heightP = m.rows();
+  *widthP = m.cols();
+  return TRUE;
+}
+
+static int
+StringMatchOctaveMatrix
+(Tcl_Obj *str, Tcl_Obj *format, int *widthP, int *heightP, Tcl_Interp *interp)
+{
+   int argc;
+   char **argv;
+   if (Tcl_SplitList(interp, (char *) str, &argc, &argv) != TCL_OK)
+     return FALSE;
+
+   int ret = myStringMatchOctaveMatrix(argc, argv, widthP, heightP, interp);
+   Tcl_Free ((char *)argv);
+   return ret;
+}
+
+static int
+myStringReadOctaveMatrix
+(Tcl_Interp *interp, int argc, char **argv, Tk_PhotoHandle imageHandle,
+int destX, int destY, int width, int height, int srcX, int srcY)
+{
+  // find matrix containing octave image
+  octave_value def = get_octave_value(argv[0]);
+  if(!def.is_defined() ||     // See if the arg is defined
+     !def.is_real_matrix())   // See if the arg is a matrix
+    {
+      Tcl_AppendResult(interp, "No such Octave matrix defined.", NULL);
+      return TCL_ERROR;
+    }
+  Matrix m = def.matrix_value();
+
+  // interpret image format info
+  int indexed = FALSE;
+  char *colormap = "global::__current_color_map__";
+  while(--argc)
+    {
+      argv++;
+      if(!strcmp(argv[0], "-indexed"))
+	indexed = TRUE;
+      else if(!strcmp(argv[0], "-colormap"))
+      {
+	if (argc == 0 || argv[1][0] == '-')
+	  {
+	    Tcl_AppendResult(interp,
+			     "-colormap needs the name of the colormap", NULL);
+	    return TCL_ERROR;
+	  }
+	--argc, ++argv;
+	      
+	colormap = argv[0];
+      }
+      else
+	{
+	  Tcl_AppendResult(interp, "unknown octave image option ", argv[0],NULL);
+	  return TCL_ERROR;
+	}
+    }
+
+  // Grab colormap from octave
+  unsigned char *colormap_data = NULL;
+  int colormap_length = DEFAULT_COLORMAP_LENGTH;
+  def = get_octave_value(colormap);
+  if (!def.is_defined())
+    {
+      colormap_length = DEFAULT_COLORMAP_LENGTH;
+      colormap_data = make_grayscale_colormap(colormap_length);
+    }
+  else if (!def.is_real_matrix() || def.columns() != 3)
+    {
+      Tcl_AppendResult(interp, colormap,
+		       " is not a valid colormap");
+      return TCL_ERROR;
+    }
+  else
+    {
+      Matrix m(def.matrix_value());
+      colormap_data = make_custom_colormap(m);
+      colormap_length = m.rows();
+    }
+
+
+  // determine the range of values in the image in case the image is
+  // not indexed, but instead needs to be shifted and scaled to the 
+  // full range of valid colormap indices.
+  float min=0.0, max=0.0;
+  if (!indexed)
+    {
+      min = max = m.elem(0, 0);
+      for(int i = 0; i < height; i++)
+	{
+	  for(int j = 0; j < width; j++)
+	    {
+	      float cur = m.elem(i, j);
+	      if(cur < min) min = cur;
+	      if(cur > max) max = cur;
+	    }
+	}
+      if(min == max) max=max+1.0;;
+    }
+
+  // Build the TK photo image from the octave image and the colormap.
+  Tk_PhotoImageBlock block;
+  block.pixelSize = 3;
+  block.offset[0] = 0;
+  block.offset[1] = 1;
+  block.offset[2] = 2;
+  block.width = width;
+  block.height = height;
+  block.pitch = block.pixelSize * width;
+  block.pixelPtr = (unsigned char *) calloc(height, block.pitch);
+  Tk_PhotoSetSize(imageHandle, width, height);
+  for(int i = 0; i < height; i++)
+    {
+      for(int j = 0; j < width; j++)
+	{
+	  int pixel_index = (height-(i+1)) * block.pitch + j * block.pixelSize;
+	  int color_index;
+
+	  if (indexed)
+	    {
+	      color_index = (int) floor(m.elem(i,j)) - 1;
+	      if (color_index < 0) 
+		color_index = 0;
+	      else if (color_index >= colormap_length) 
+		color_index = colormap_length - 1;
+	    }
+	  else
+	    {
+	      float color = (m.elem(i,j) - min) / (max-min) * 0.999;
+	      color_index = (int)rint(color * (colormap_length-1));
+	    }
+	  block.pixelPtr[pixel_index] = colormap_data[3*color_index];
+	  block.pixelPtr[pixel_index+1] = colormap_data[3*color_index+1];
+	  block.pixelPtr[pixel_index+2] = colormap_data[3*color_index+2];
+	}
+    }
+  Tk_PhotoPutBlock(imageHandle, &block, destX, destY, width, height);
+  free((void *) block.pixelPtr);
+  free((void *) colormap_data);
+  
+  return TCL_OK;
+}
+
+static int
+StringReadOctaveMatrix
+(Tcl_Interp *interp, Tcl_Obj *str, Tcl_Obj *format, Tk_PhotoHandle imageHandle,
+int destX, int destY, int width, int height, int srcX, int srcY)
+{
+   int argc;
+   char **argv;
+
+   if (Tcl_SplitList(interp, (char *) str, &argc, &argv) != TCL_OK)
+     return FALSE;
+
+   int ret = myStringReadOctaveMatrix(interp, argc, argv, imageHandle,
+				      destX, destY, width, height, srcX, srcY);
+
+   Tcl_Free ((char *)argv);
+   return ret;
+}
+
+/************************************************************
+
+   Procedure:  oct_string
+
+   Routine for interrogating an Octave string within Tk.
+
+************************************************************/
+
+int oct_string(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
+{
+  if (argc < 2)
+    {
+      Tcl_AppendResult(interp, "wrong # args: should be \"oct_string \
+stringName options\"", NULL);
+      return TCL_ERROR;
+    }
+
+   octave_value def = get_octave_value(argv[1]);
+   bool exists = def.is_defined() && def.is_string();
+   if (!strcmp(argv[2], "exists"))
+     {
+       Tcl_AppendResult(interp, exists ? "1":"0", NULL);
+       return TCL_OK;
+     }
+   if(!exists)
+   {
+      Tcl_AppendResult(interp, "No such Octave string \"",
+         argv[1], "\" defined.", NULL);
+      return TCL_ERROR;
+   }
+   string s = def.string_value();
+   Tcl_AppendResult(interp, s.c_str(), NULL);
+   return TCL_OK;
+}
+
+
+/************************************************************
+
+   Procedure:  oct_matrix
+
+   Routine for interrogating an Octave matrix within Tk.
+
+************************************************************/
+
+int oct_matrix(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
+{
+   if(argc < 3) 
+   {
+      Tcl_AppendResult(interp, "wrong # args: should be \"oct_matrix \
+matrixName option\"", NULL);
+      return TCL_ERROR;
+   }
+
+   octave_value def = get_octave_value(argv[1]);
+   bool exists = def.is_defined() && def.is_real_matrix();
+   if (!strcmp(argv[2], "exists"))
+     {
+       Tcl_AppendResult(interp, exists ? "1":"0", NULL);
+       return TCL_OK;
+     }
+   if(!exists)
+   {
+      Tcl_AppendResult(interp, "No such Octave matrix \"",
+         argv[1], "\" defined.", NULL);
+      return TCL_ERROR;
+   }
+   Matrix m = def.matrix_value();
+   if(!strcmp(argv[2], "rows"))
+   {
+      char buf[20];
+      sprintf(buf, "%d", m.rows());
+      Tcl_AppendResult(interp, buf, NULL);
+      return TCL_OK;
+   }
+   if(!strcmp(argv[2], "columns") || !strcmp(argv[2], "cols"))
+   {
+      char buf[20];
+      sprintf(buf, "%d", m.cols());
+      Tcl_AppendResult(interp, buf, NULL);
+      return TCL_OK;
+   }
+   if(!strcmp(argv[2], "min"))
+   {
+      double min = m.elem(0, 0);
+      for(int i = 0; i < m.rows(); i++)
+      {
+         for(int j = 0; j < m.cols(); j++)
+         {
+            if(m.elem(i, j) < min) min = m.elem(i, j);
+         }
+      }
+      char buf[20];
+      sprintf(buf, "%f", min);
+      Tcl_AppendResult(interp, buf, NULL);
+      return TCL_OK;
+   }
+   if(!strcmp(argv[2], "max"))
+   {
+      double max = m.elem(0, 0);
+      for(int i = 0; i < m.rows(); i++)
+      {
+         for(int j = 0; j < m.cols(); j++)
+         {
+            if(m.elem(i, j) > max) max = m.elem(i, j);
+         }
+      }
+      char buf[20];
+      sprintf(buf, "%f", max);
+      Tcl_AppendResult(interp, buf, NULL);
+      return TCL_OK;
+   }
+   if(!strcmp(argv[2], "element") || !strcmp(argv[2], "elem"))
+   {
+      if(argc != 5)
+      {
+         Tcl_AppendResult(interp, "wrong # args: should be \"oct_matrix \
+matrixName element row column\"", NULL);
+         return TCL_ERROR;
+      }
+      int row = atoi(argv[3]);
+      int col = atoi(argv[4]);
+      double elem = m.elem(row, col);
+      char buf[20];
+      sprintf(buf, "%f", elem);
+      Tcl_AppendResult(interp, buf, NULL);
+      return TCL_OK;
+   }
+   Tcl_AppendResult(interp, "bad option \"",
+      argv[2], "\": must be exists, rows, col[umn]s, min, max or elem[ent]", NULL);
+   return TCL_ERROR;
+}
+
+#if HAVE_BLT
+/************************************************************
+
+   Procedure:  oct_mtov
+
+   Slices an Octave matrix into a BLT vector.
+
+************************************************************/
+
+int oct_mtov(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
+{
+   if(argc != 7)
+   {
+      Tcl_AppendResult(interp, "wrong # args: should be \"oct_mtov \
+matrixName vectorName startX startY sizeX sizeY\"", NULL);
+      return TCL_ERROR;
+   }
+
+   octave_value def = get_octave_value(argv[1]);
+   bool exists = def.is_defined() && def.is_real_matrix();
+   if(!exists)
+   {
+      Tcl_AppendResult(interp, "No such Octave matrix \"",
+         argv[1], "\" defined.", NULL);
+      return TCL_ERROR;
+   }
+   Matrix m = def.matrix_value();
+   int startX = atoi(argv[3]);
+   if((startX < 0) || (startX >= m.cols()))
+   {
+      Tcl_AppendResult(interp, "startX value is out of bounds.", NULL);
+      return TCL_ERROR;
+   }
+   int startY = atoi(argv[4]);
+   if((startY < 0) || (startY >= m.rows()))
+   {
+      Tcl_AppendResult(interp, "startY value is out of bounds.", NULL);
+      return TCL_ERROR;
+   }
+   int sizeX  = atoi(argv[5]);
+   if((sizeX < 1) || (sizeX > (m.cols() - startX)))
+   {
+      Tcl_AppendResult(interp, "sizeX value is out of bounds.", NULL);
+      return TCL_ERROR;
+   }
+   int sizeY  = atoi(argv[6]);
+   if((sizeY < 1) || (sizeY > (m.rows() - startY)))
+   {
+      Tcl_AppendResult(interp, "sizeY value is out of bounds.", NULL);
+      return TCL_ERROR;
+   }
+   Blt_Vector *v;
+   if(Blt_VectorExists(interp, argv[2]))
+   {
+      if(Blt_GetVector(interp, argv[2], &v) != TCL_OK)
+      {
+         Tcl_AppendResult(interp, "Unable to get pointer to BLT vector \"",
+            argv[2], "\".", NULL);
+         return TCL_ERROR;
+      }
+      if(Blt_ResizeVector(v, (sizeX * sizeY)) != TCL_OK)
+      {
+         Tcl_AppendResult(interp, "Unable to resize BLT vector \"",
+            argv[2], "\".", NULL);
+         return TCL_ERROR;
+      }
+   }
+   else
+   {
+      if(Blt_CreateVector(interp, argv[2], (sizeX * sizeY), &v) != TCL_OK)
+      {
+         Tcl_AppendResult(interp, "Unable to create BLT vector \"",
+            argv[2], "\".", NULL);
+         return TCL_ERROR;
+      }
+   }
+   double *elemPtr = v->valueArr;
+   for(int i = startY; i < (startY + sizeY); i++)
+   {
+      for(int j = startX; j < (startX + sizeX); j++)
+      {
+         *elemPtr++ = m.elem(i, j);
+      }
+   }
+   Blt_ResetVector(v, v->valueArr, v->numValues, v->arraySize, NULL);
+   return TCL_OK;
+}
+#endif /* HAVE_BLT */
+
+#if HAVE_VTK
+/************************************************************
+
+   Procedure:  oct_mtovtk
+
+   Routine to transform an Octave matrix into a VTK surface
+
+************************************************************/
+
+int oct_mtovtk(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
+{
+   if(argc != 3)
+   {
+      Tcl_AppendResult(interp,
+         "wrong # args: should be \"oct_mtovtk matrixName vtkName\"", NULL);
+      return TCL_ERROR;
+   }
+
+   octave_value def = get_octave_value(argv[1]);
+   bool exists = def.is_defined() && def.is_real_matrix();
+   if(!exists)
+   {
+      Tcl_AppendResult(interp, "No such Octave matrix \"",
+         argv[1], "\" defined.", NULL);
+      return TCL_ERROR;
+   }
+   Matrix m = def.matrix_value();
+
+   char buf[128];
+   sprintf(buf, "vtkPolyData %s", argv[2]);
+   if(Tcl_GlobalEval(interp, buf) != TCL_OK)
+   {
+      Tcl_AppendResult(interp, "Creation of vtkPolyData \"",
+         argv[2], "\" failed.", NULL);
+      return TCL_ERROR;
+   }
+   int error;
+   vtkPolyData* surface = (vtkPolyData *)
+      vtkTclGetPointerFromObject(argv[2], "vtkPolyData", interp, error);
+
+   // Get min and max of the Octave matrix
+   float min, max;
+   min = max = m.elem(0, 0);
+   for(int i = 0; i < m.rows(); i++)
+   {
+      for(int j = 0; j < m.cols(); j++)
+      {
+         float cur = m.elem(i, j);
+         if(cur < min) min = cur;
+         if(cur > max) max = cur;
+      }
+   }
+   if(min == max) max++;   // Avoid division by zero
+
+   // Create VTK objects
+   vtkPlaneSource *plane = vtkPlaneSource::New();
+   plane->SetResolution((m.rows() - 1), (m.cols() - 1));
+   vtkTransform *transform = vtkTransform::New();
+   transform->Scale(1.0, 1.0, 1.0);
+   vtkTransformPolyDataFilter *transF = vtkTransformPolyDataFilter::New();
+   transF->SetInput(plane->GetOutput());
+   transF->SetTransform(transform);
+   transF->Update();
+   vtkPolyData *input = transF->GetOutput();
+   int numPts = input->GetNumberOfPoints();
+   vtkPoints *newPts = vtkPoints::New();
+   newPts->SetNumberOfPoints(numPts);
+   vtkScalars *colors = vtkScalars::New();
+   colors->SetNumberOfScalars(numPts);
+
+   // Convert values from Octave matrix and store in VTK object
+   float p[3];
+   for(int k = 0; k < numPts; k++)
+   {
+      input->GetPoint(k, p);
+      int row = int((p[0] + 0.5) * (float) (m.rows() - 1));
+      int col = int((p[1] + 0.5) * (float) (m.cols() - 1));
+      p[2] = ((m.elem(row, col) - min) / (max - min)) - 0.5;
+      newPts->SetPoint(k, p);
+      colors->SetScalar(k, p[2]);
+   }   
+
+   surface->CopyStructure(input);
+   surface->SetPoints(newPts);
+   surface->GetPointData()->SetScalars(colors);
+
+   // Clean up VTK objects
+   plane->Delete();
+   transform->Delete();
+   transF->Delete();
+   newPts->Delete();
+   colors->Delete();
+
+   return TCL_OK;
+}
+#endif /* HAVE_VTK */
+
+#if 0
+/* Don't need get_tk_thread_interp unless other DLD's want to add
+ * commands to the tcl interpreter.  In that case, uncomment this
+ * function, link the other DLD against tk_interp.oct (by running
+ * mkoctfile -v to see what the current link line is, then entering
+ * the modified link line by hand since mkoctfile doesn't handle
+ * linking one DLD against another), then add the current directory
+ * to the LD_LIBRARY_PATH so that the other DLD can find the first
+ * when it needs it. */
+Tcl_Interp *get_tk_thread_interp(void)
+{
+   pthread_mutex_lock(&tk_mutex);
+   Tcl_Interp *result = (tk_thread ? interp : NULL);
+   pthread_mutex_unlock(&tk_mutex);
+   return result;
+}
+#endif
+
+static
+int oct_cmd(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
+{
+   if(argc < 2)
+   {
+      Tcl_AppendResult(interp,
+         "wrong # args: should be \"oct_cmd commandName ?options?\"", NULL);
+      return TCL_ERROR;
+   }
+   int cmd_len = 1;
+   char *cmd_str = (char *) malloc(sizeof(char));
+   *cmd_str = '\0';
+   for(int i = 1; i < argc; i++)
+   {
+      cmd_len += strlen(argv[i]) + 1;
+      cmd_str = (char *) realloc(cmd_str, (cmd_len * sizeof(char)));
+      strcat(cmd_str, argv[i]);
+      if(i != (argc - 1)) strcat(cmd_str, " ");
+      /*      else strcat(cmd_str, ";"); */
+   }
+   pthread_mutex_lock(&tk_mutex);
+   tk_fifo.push(cmd_str);
+   pthread_cond_signal(&tk_cond);
+   pthread_mutex_unlock(&tk_mutex);
+   free(cmd_str);
+   return TCL_OK;
+}
+
+static
+int oct_quit(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
+{
+   if(argc != 1)
+   {
+      Tcl_AppendResult(interp, "wrong # args: should be \"oct_quit\"", NULL);
+      return TCL_ERROR;
+   }
+
+   pthread_mutex_lock(&tk_mutex);
+   continue_running = FALSE;
+   pthread_cond_signal(&tk_cond);
+   pthread_mutex_unlock(&tk_mutex);
+
+   return TCL_OK;
+}
+
+
+static void tk_thread_process_start(void)
+{
+   interp = Tcl_CreateInterp();
+
+   if (Tcl_Init(interp) != TCL_OK)
+   {
+     error ("Tcl_Init: %s", interp->result);
+     return;
+   }
+   if (Tk_Init(interp) != TCL_OK)
+   {
+     error ("Tk_Init: %s", interp->result);
+     return;
+   }
+
+   Tcl_CreateCommand(interp, "oct_cmd",  oct_cmd,  NULL, NULL);
+   Tcl_CreateCommand(interp, "oct_quit", oct_quit, NULL, NULL);
+
+   // Set up photo image format for an Octave matrix
+   Tk_CreatePhotoImageFormat(&tkImgFmtOctaveMatrix);
+
+   // Create command for interrogating an Octave matrix within Tk
+   Tcl_CreateCommand(interp, "oct_matrix", oct_matrix, NULL, NULL);
+
+   // Create command for interrogating an Octave string within Tk
+   Tcl_CreateCommand(interp, "oct_string", oct_string, NULL, NULL);
+
+#if HAVE_BLT
+   // Create command for slicing an Octave matrix into a BLT vector
+   Tcl_CreateCommand(interp, "oct_mtov", oct_mtov, NULL, NULL);
+#endif
+
+#if HAVE_VTK
+   // Create command to transform Octave matrix to VTK surface
+   Tcl_CreateCommand(interp, "oct_mtovtk", oct_mtovtk, NULL, NULL);
+#endif
+
+
+   Tk_Window mainw = Tk_MainWindow(interp);
+   char *name = Tk_SetAppName(mainw, "tk_octave");
+   char buf[40];
+   sprintf(buf, "wm title . {%s}", name);
+   Tcl_Eval(interp, buf);
+   Tcl_Eval(interp, "rename exec {}");
+   Tcl_Eval(interp, "rename exit {}");
+
+   command_result = name;
+}
+
+static void tk_thread_process_end(void *arg)
+{
+   Tcl_DeleteInterp(interp);
+   interp = NULL;
+
+#if SAFE_VAR
+   // Let Octave know that the thread has ended
+   pthread_mutex_lock(&tk_mutex);
+   pthread_cond_signal(&tk_cond);
+   pthread_mutex_unlock(&tk_mutex);
+#endif
+}
+
+static void *tk_thread_process(void *arg)
+{
+   pthread_mutex_lock(&tk_mutex);
+   tk_thread_process_start();
+   pthread_cleanup_push(tk_thread_process_end, NULL);
+   pthread_cond_signal(&tk_cond);
+   pthread_mutex_unlock(&tk_mutex);
+
+   while(1)
+   {
+      pthread_testcancel();
+      if(command_to_do)
+      {
+         pthread_mutex_lock(&tk_mutex);
+	 if (Tcl_Eval(interp, command_to_do) == TCL_ERROR)
+	   Tcl_BackgroundError(interp);
+         command_to_do = NULL;
+         command_result = interp->result;
+         pthread_cond_signal(&tk_cond);
+         pthread_mutex_unlock(&tk_mutex);
+      }
+      while(Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT));
+   }
+   pthread_cleanup_pop(0);
+}
+
+DEFUN_DLD (tk_interp, args,, "\
+Creates a Tk interpreter within Octave.\n\n\
+Usage: retval = tk_interp\n\n\
+See also: tk_end, tk_cmd, tk_loop")
+{
+   octave_value_list ret;
+
+   if(tk_thread)
+   {
+      error("Error: Tk interpreter is already running.");
+      return ret;
+   }
+
+   pthread_mutex_lock(&tk_mutex);
+   pthread_create(&tk_thread, NULL, tk_thread_process, NULL);
+   pthread_cond_wait(&tk_cond, &tk_mutex);
+   pthread_mutex_unlock(&tk_mutex);
+
+#if SAFE_VAR
+   // Don't grab octave values while octave is running
+   pthread_mutex_lock(&oct_mutex);
+#endif
+
+   return octave_value(std::string(command_result));
+}
+
+DEFUN_DLD (tk_end, args,, "\
+Closes the Tk interpreter created by tk_start.\n\n\
+Usage: retval = tk_end\n\n\
+See also: tk_start, tk_cmd, tk_loop")
+{
+   octave_value_list ret;
+
+   if(!tk_thread)
+   {
+      error("Error: Tk interpreter is not running.");
+      return ret;
+   }
+
+   pthread_mutex_lock(&tk_mutex);
+   pthread_cancel(tk_thread);
+   tk_thread = 0;
+#if SAFE_VAR
+   // Wait for the thread to end, then release the octave value access mutex
+   pthread_cond_wait(&tk_cond, &tk_mutex);
+   pthread_mutex_unlock(&oct_mutex);
+#endif
+   pthread_mutex_unlock(&tk_mutex);
+
+   return ret;
+}
+
+DEFUN_DLD (tk_cmd, args,, "\
+Sends the specified command to the Tk interpreter.\n\n\
+Usage: retval = tk_cmd(CMD)\n\n\
+   where CMD is a string containing the command to send.\n\n\
+See also: tk_start, tk_end, tk_loop")
+{
+   octave_value_list ret;
+
+   if(!tk_thread)
+   {
+      error("Error: Tk interpreter is not running.");
+      return ret;
+   }
+
+   int nargin = args.length();
+   if (nargin == 0)
+     {
+       print_usage("tk_cmd");
+       return ret;
+     }
+
+   // Concatenate all input arguments into one big string
+   std::string cmd = "";
+   if (nargin > 0)
+     {
+       cmd = args(0).string_value();
+       if (error_state) return ret;
+       for (int i=1; i < nargin; i++)
+	 {
+	   cmd = cmd + ' ' + args(i).string_value();
+	   if (error_state) return ret;
+	 }
+     }
+
+   if (cmd.length() > 0)
+     {
+#if SAFE_VAR
+       // No longer in octave so it is safe to allow access to octave variables
+       pthread_mutex_unlock(&oct_mutex);
+#endif
+
+       pthread_mutex_lock(&tk_mutex);
+       command_to_do = (char *) cmd.c_str();
+       pthread_cond_wait(&tk_cond, &tk_mutex);
+       pthread_mutex_unlock(&tk_mutex);
+
+#if SAFE_VAR
+       // returning to octave, so block octave variable access
+       pthread_mutex_lock(&oct_mutex);
+#endif
+
+       ret(0) = octave_value(std::string(command_result));
+     }
+
+   return ret;
+}
+
+DEFUN_DLD (tk_loop, args,, "\
+Makes Octave act as a slave to the Tk command loop.\n\
+Processes commands sent to it from the Tk interpreter\n\
+until the 'oct_quit' command is called from Tk.\n\n\
+Usage: retval = tk_loop\n\n\
+See also: tk_start, tk_end, tk_cmd")
+{
+   octave_value_list ret;
+
+   if(!tk_thread)
+   {
+      error("Error: Tk interpreter is not running.");
+      return ret;
+   }
+
+   pthread_mutex_lock(&tk_mutex);
+   continue_running = TRUE;
+   pthread_mutex_unlock(&tk_mutex);
+
+#if SAFE_VAR
+   // No longer running octave, so free the octave mutex
+   pthread_mutex_unlock(&oct_mutex);
+#endif
+   do
+   {
+      pthread_mutex_lock(&tk_mutex);
+      pthread_cond_wait(&tk_cond, &tk_mutex);
+      char *command_to_do = tk_fifo.peek();
+      pthread_mutex_unlock(&tk_mutex);
+      while(command_to_do)
+      {
+         cout << "Processing command: " << command_to_do << "\n";
+         const string octave_cmd = string(command_to_do);
+         int parse_status = 0;
+#if SAFE_VAR
+	 pthread_mutex_lock(&oct_mutex);
+#endif
+         eval_string(octave_cmd, (bool) TRUE, parse_status, 0);
+#if SAFE_VAR
+	 pthread_mutex_unlock(&oct_mutex);
+#endif
+         cout << "Finished\n";
+
+         pthread_mutex_lock(&tk_mutex);
+         tk_fifo.pop();
+         command_to_do = tk_fifo.peek();
+         pthread_mutex_unlock(&tk_mutex);
+      }
+   }
+   while(continue_running);
+
+#if SAFE_VAR
+   pthread_mutex_lock(&oct_mutex);
+#endif
+
+   return ret;
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_matrix	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,11 @@
+#!/usr/local/bin/octave-pthreads
+
+colorbar = [1:100]';
+load sample.dat
+
+tk_interp;
+tk_cmd("source tk_matrix.tcl");
+tk_cmd("set Matrix sample");
+tk_cmd("redraw_matrix");
+tk_loop;
+tk_end;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_matrix.tcl	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,454 @@
+
+package require BLT
+namespace import blt::*
+
+wm deiconify .
+
+set HaveTable [expr [ catch { package require Tktable } ] == 0 ]
+set HaveVTK [expr [ string equal [ info commands oct_mtovtk ] {} ] && \
+	          [ catch {load ./vtktcl} ] == 0 ]
+
+
+set Matrix {}
+proc undefinedMatrix {} {
+    global Matrix
+    if { $Matrix != {} && [ oct_matrix $Matrix exists ] } {
+	return 0
+    } else {
+	return 1
+    }
+}
+
+# ****************** Create graphs ******************************
+
+grid [graph .matrix -height 350 -width 350] -row 0 -col 0 -sticky news
+grid [graph .yslice -width 150] -row 0 -col 1 -sticky news
+grid [graph .xslice -height 150] -row 1 -col 0 -sticky news
+grid rowconfigure    . 0 -weight 1 -minsize 150
+grid columnconfigure . 0 -weight 1 -minsize 150
+grid rowconfigure    . 1 -weight 0
+grid columnconfigure . 1 -weight 0
+
+.xslice element create XSlice -label {} -pix 2 -fill ""
+.yslice element create YSlice -label {} -pix 2 -fill "" -mapx x2 -mapy y2
+
+Blt_ZoomStack    .matrix
+Blt_Crosshairs   .matrix
+Blt_ClosestPoint .matrix
+
+# Use x2-y for the image, x2-y2 for the Y slice and x-y for the X slice
+# Fix margin sizes so that scales are commensurate between the graphs
+.matrix xaxis configure -hide yes
+.matrix x2axis configure -hide no
+.yslice yaxis configure -hide yes
+.yslice y2axis configure -hide no
+.yslice xaxis configure -hide yes
+.yslice x2axis configure -hide no
+.matrix configure -leftmargin 50 -topmargin 50 -rightmargin 0 -bottommargin 0
+.yslice configure -rightmargin 50 -topmargin 50 -leftmargin 0 -bottommargin 0
+.xslice configure -leftmargin 50 -bottommargin 50 -rightmargin 0 -topmargin 0
+
+# Turn on grid marks
+.matrix grid configure -hide no -dashes { 2 2 }
+.xslice grid configure -hide no -dashes { 2 2 } 
+.yslice grid configure -hide no -dashes { 2 2 } 
+
+# Define image for matrix rendering
+image create photo matrix
+
+# ************** Define configurion control frame *****************
+
+grid [frame .options] -row 0 -col 2 -rowspan 2 -sticky ns
+grid columnconfigure . 2 -weight 0
+
+# Add colormap bar
+image create photo colorbar
+grid [graph .options.colorbar -height 150 -width 80] \
+   -row 0 -col 0 -rowspan 10 -sticky ns
+.options.colorbar xaxis configure -hide yes
+
+# Add slice locator
+grid [label .options.slicelabel -text "Slice Coordinates:"] \
+	-col 1 -row 0 -sticky w
+grid [label .options.xvalue -text "X = 0"] -col 1 -row 1 -sticky w
+grid [label .options.yvalue -text "Y = 0"] -col 1 -row 2 -sticky w
+
+# Add colormap chooser
+set colormapChoice {}
+radiobutton .options.ocean \
+	-variable colormapChoice -text Ocean   -value "-colormap tk_ocean"
+radiobutton .options.rainbow \
+	-variable colormapChoice -text Rainbow -value "-colormap tk_hsv"
+radiobutton .options.custom \
+	-variable colormapChoice -text Default -value {}
+label .options.colormaplabel -text "Colormap Options:"
+grid .options.colormaplabel -col 1 -row 3 -sticky w
+grid .options.ocean   -col 1 -row 4 -sticky w
+grid .options.rainbow -col 1 -row 5 -sticky w
+grid .options.custom  -col 1 -row 6 -sticky w
+bind .options.ocean <ButtonPress-1> {
+    oct_cmd "tk_ocean = ocean(64);"
+    set colormapChoice "-colormap tk_ocean"
+    redraw_matrix
+}
+bind .options.rainbow   <ButtonPress-1> {
+    oct_cmd "tk_hsv = rainbow(64);"
+    set colormapChoice "-colormap tk_hsv"
+    redraw_matrix
+}
+bind .options.custom    <ButtonPress-1> {
+    set colormapChoice {}
+    redraw_matrix
+}
+
+# Add matrix chooser
+label .options.lmatrix -text "Octave Matrix Name :" -anchor w
+entry .options.ematrix -textvariable Matrix -relief sunken
+grid .options.lmatrix .options.ematrix
+bind .options.ematrix <Return> {
+    # Update the table with the new matrix dimensions
+    redraw_matrix
+    updateTable
+}
+
+
+# ************************* Graph interactions ***********************
+
+# Record mouse coordinates when middle mouse button is pressed
+
+set startX 0
+set startY 0
+
+proc record_mouse { X Y } {
+   if { [undefinedMatrix] } { return }
+
+   global Matrix
+   global startX
+   global startY
+   set startX \
+      [expr round([.matrix axis invtransform x2 [expr $X - [winfo rootx .]]])]
+   if {$startX < 0} { set startX 0 }
+   if {$startX >= [oct_matrix $Matrix cols]} {
+      set startX [expr [oct_matrix $Matrix cols] - 1]
+   }
+   set startY \
+      [expr round([.matrix axis invtransform y [expr $Y - [winfo rooty .]]])]
+   if {$startY < 0} { set startY 0 }
+   if {$startY >= [oct_matrix $Matrix rows]} {
+      set startY [expr [oct_matrix $Matrix rows] - 1]
+   }
+   .options.xvalue configure -text "X = $startX"
+   .options.yvalue configure -text "Y = $startY"
+   draw_slices
+}
+
+bind . <ButtonPress-2> { record_mouse %X %Y }
+bind . <B2-Motion>     { record_mouse %X %Y }
+
+# We need to redraw our slices whenever zooming in/out.
+
+bind .matrix <ButtonPress-3> { draw_slices }
+bind .matrix <ButtonPress-1> { draw_slices }
+
+# Graph drawing routines
+
+vector x1 y1 x2 y2
+
+proc draw_slices { } {
+    if { [undefinedMatrix] } { return }
+
+    global Matrix
+    global startX
+    global startY
+    set minX [lindex [.matrix x2axis limits] 0]
+    set maxX [lindex [.matrix x2axis limits] 1]
+    set minY [lindex [.matrix yaxis limits] 0]
+    set maxY [lindex [.matrix yaxis limits] 1]
+    if { $startX >= [oct_matrix $Matrix cols]} {
+	set startX [expr [oct_matrix $Matrix cols] - 1]
+	.options.xvalue configure -text "X = $startX"
+    }
+    if { $startY >= [oct_matrix $Matrix rows]} {
+	set startY [expr [oct_matrix $Matrix rows] - 1]
+	.options.yvalue configure -text "Y = $startY"
+    }
+    x1 seq 0 [oct_matrix $Matrix cols]   
+    x2 seq 0 [oct_matrix $Matrix rows]
+    oct_mtov $Matrix y1 0 $startY [oct_matrix $Matrix cols] 1
+    oct_mtov $Matrix y2 $startX 0 1 [oct_matrix $Matrix rows]
+    .xslice element configure XSlice -xdata x1 -ydata y1
+    .yslice element configure YSlice -xdata y2 -ydata x2
+    .xslice xaxis configure -min $minX -max $maxX
+    .yslice y2axis configure -min $minY -max $maxY
+}
+
+proc redraw_matrix { } {
+    if {[undefinedMatrix]} { 
+	if [ .matrix marker exists matrix ] {
+	    .matrix marker delete
+	}
+	return 
+    }
+
+    global Matrix
+    global colormapChoice
+    
+    # Find limits for the matrix value
+    set MatrixRows [oct_matrix $Matrix rows]
+    set MatrixCols [oct_matrix $Matrix cols]
+    set MatrixMin  [oct_matrix $Matrix min]
+    set MatrixMax  [oct_matrix $Matrix max]
+    
+    # Convert the matrix into an image and paste it into the graph
+    matrix configure -data "$Matrix $colormapChoice"
+    .matrix x2axis configure -min 0 -max $MatrixCols
+    .matrix yaxis configure -min 0 -max $MatrixRows
+    .matrix marker create image -name matrix -image matrix \
+	    -coords "0 0 $MatrixCols $MatrixRows" -mapx x2 -under 1
+    
+    # Fix the limits on the X/Y slices so that they will work for any slice
+    # Draw the current slice
+    .xslice yaxis configure -min $MatrixMin -max $MatrixMax
+    .yslice x2axis configure -min $MatrixMin -max $MatrixMax
+    draw_slices
+    
+    # Draw the new colorbar for the given colormap choice
+    # This converts the simple range stored in the octave variable 
+    # "colorbar" into an image and pastes it into the colorbar graph.
+    colorbar configure -data "colorbar $colormapChoice"
+    .options.colorbar yaxis configure -min $MatrixMin -max $MatrixMax
+    .options.colorbar marker create image -name colorbar \
+	    -image colorbar -coords \
+	    "0 $MatrixMin 1 $MatrixMax"
+}
+
+
+
+# ******************* Table commands **************************
+proc updateTable {} {
+    global Matrix
+    if [ winfo exists .table.t ] {
+	if { [undefinedMatrix] } {
+	    .table.t config -rows 1 -cols 1
+	} else {
+	    .table.t config -rows [oct_matrix $Matrix rows] \
+		    -cols [oct_matrix $Matrix cols]
+	}
+    }
+}
+
+proc toggleTable {} {
+    if [ winfo exists .table ] {
+	destroy .table
+    } else {
+	createTable
+    }
+}
+
+proc tableCommand { Row Col Set Value } {
+    global Matrix
+    if {$Set} {
+	oct_cmd "$Matrix\($Row,$Col\)=$Value;"
+	redraw_matrix
+    } else {
+	if { $Row == 0 && $Col == 0 } {
+	    if { $Matrix == "" } {
+		return "<none>"
+	    } else {
+		return $Matrix
+	    }
+	} elseif { $Row == 0 } {
+	    return $Col
+	} elseif { $Col == 0 } {
+	    return $Row
+	} else {
+	    return [oct_matrix $Matrix elem [expr $Row-1] [expr $Col-1] ]
+	}
+    }
+}
+
+proc createTable {} {
+    # ********************* Create data display table ******************
+    toplevel .table
+    wm title .table "TK Octave Data"
+    table .table.t \
+	    -xscrollcommand {.table.x set} -yscrollcommand {.table.y set} \
+	    -height 10 -width 6 -titlerows 1 -titlecols 1 -rows 1 -cols 1 \
+	    -command { tableCommand %r %c %i %s } -usecommand true
+    scrollbar .table.y -orient v -command [list .table.t yview]
+    scrollbar .table.x -orient h -command [list .table.t xview]
+    grid .table.t -row 0 -col 0 -sticky news
+    grid .table.y -row 0 -col 1 -sticky ns
+    grid .table.x -row 1 -col -0 -sticky ew
+    grid rowconfig    .table 0 -weight 1
+    grid columnconfig .table 0 -weight 1
+    grid rowconfig    .table 1 -weight 0
+    grid columnconfigure .table 1 -weight 0
+    updateTable
+}
+
+bind . <Destroy> { catch { if {%W = "."} { oct_quit } } }
+
+
+# ******************* Create Octave Interactor *********************
+
+catch {unset octInteract.bold}
+catch {unset octInteract.normal}
+catch {unset octInteract.tagcount}
+set octInteractBold "-background #43ce80 -foreground #221133 -relief raised -borderwidth 1"
+set octInteractNormal "-background #dddddd -foreground #221133 -relief flat"
+set octInteractTagcount 1
+set octInteractCommandList ""
+set octInteractCommandIndex 0
+
+proc do_oct {s w} {
+   global octInteractBold octInteractNormal octInteractTagcount
+   global octInteractCommandList octInteractCommandIndex
+
+   set c "oct_cmd \{$s\}"
+   set tag [append tagnum $octInteractTagcount]
+   set octInteractCommandIndex $octInteractTagcount
+   incr octInteractTagcount 1
+   .octInteract.display.text configure -state normal
+   .octInteract.display.text insert end $s $tag
+   set octInteractCommandList [linsert $octInteractCommandList end $s]
+   eval .octInteract.display.text tag configure $tag $octInteractNormal
+   .octInteract.display.text tag bind $tag <Any-Enter> \
+   ".octInteract.display.text tag configure $tag $octInteractBold"
+   .octInteract.display.text tag bind $tag <Any-Leave> \
+   ".octInteract.display.text tag configure $tag $octInteractNormal"
+   .octInteract.display.text tag bind $tag <1> "do_oct [list $s] .octInteract"
+   .octInteract.display.text insert end \n;
+   .octInteract.display.text insert end [uplevel 1 $c]
+   .octInteract.display.text insert end \n\n
+   .octInteract.display.text configure -state disabled
+   .octInteract.display.text yview end
+}
+
+catch {destroy .octInteract}
+
+#toplevel .octInteract -bg #bbbbbb
+#wm title .octInteract "tk_octave interactor"
+grid [frame .octInteract -bg #bbbbbb] -row 2 -column 0 \
+	-columnspan 3 -sticky news
+
+grid columnconfigure .octInteract 0 -weight 1
+grid rowconfigure    .octInteract 3 -weight 1
+
+# Command input
+frame .octInteract.file -bg #bbbbbb
+grid columnconfigure .octInteract.file 1 -weight 1
+label .octInteract.file.label -text "Command:" -width 10 -anchor w \
+    -bg #bbbbbb -fg #221133
+entry .octInteract.file.entry -width 40 \
+    -bg #dddddd -fg #221133 -highlightthickness 1 -highlightcolor #221133
+bind .octInteract.file.entry <Return> {
+   do_oct [%W get] .octInteract; %W delete 0 end}
+grid .octInteract.file.label -row 0 -column 0 -sticky w
+grid .octInteract.file.entry -row 0 -column 1 -sticky news
+grid .octInteract.file -row 0 -column 0 -sticky news
+
+# Command output
+frame .octInteract.display -bg #bbbbbb
+grid columnconfigure .octInteract.display 0 -weight 1
+text .octInteract.display.text -yscrollcommand \
+   ".octInteract.display.scroll set" \
+   -setgrid true -width 60 -height 8 -wrap word -bg #dddddd -fg #331144 \
+   -state disabled
+scrollbar .octInteract.display.scroll \
+    -command ".octInteract.display.text yview" -bg #bbbbbb \
+    -troughcolor #bbbbbb -activebackground #cccccc -highlightthickness 0
+grid .octInteract.display.text   -row 0 -column 0 -sticky news
+grid .octInteract.display.scroll -row 0 -column 1 -sticky ns
+grid .octInteract.display -row 1 -column 0 -sticky news -columnspan 2
+
+
+# Keyboard control for command history
+
+bind [winfo toplevel .octInteract] <Down> {
+   if { $octInteractCommandIndex < [expr $octInteractTagcount - 1] } {
+      incr octInteractCommandIndex
+      set command_string \
+         [lindex $octInteractCommandList $octInteractCommandIndex]
+      .octInteract.file.entry delete 0 end
+      .octInteract.file.entry insert end $command_string
+   } elseif {
+      $octInteractCommandIndex == [expr $octInteractTagcount - 1] } {
+      .octInteract.file.entry delete 0 end
+   }
+}
+
+bind [winfo toplevel .octInteract] <Up> {
+   if { $octInteractCommandIndex > 0 } {
+      set octInteractCommandIndex [expr $octInteractCommandIndex - 1]
+      set command_string \
+         [lindex $octInteractCommandList $octInteractCommandIndex]
+      .octInteract.file.entry delete 0 end
+      .octInteract.file.entry insert end $command_string
+   }
+}
+
+# Control buttons
+frame .octInteract.buttons
+button .octInteract.buttons.quit -text Quit  -command oct_quit \
+   -bg #bbbbbb -fg #221133 -activebackground #cccccc -activeforeground #221133
+pack .octInteract.buttons.quit -side left -expand true -fill x
+if { $HaveTable } {
+    button .octInteract.buttons.table -text Table -command toggleTable \
+	    -bg #bbbbbb -fg #221133 \
+	    -activebackground #cccccc -activeforeground #221133
+    pack .octInteract.buttons.table -side left -expand true -fill x
+}
+if { $HaveVTK } {
+    button .octInteract.buttons.render -text Render -command vtk_render \
+	    -bg #bbbbbb -fg #221133 -activebackground #cccccc -activeforeground #221133
+    pack .octInteract.buttons.render -side left -expand true -fill x
+}
+
+grid .octInteract.buttons -row 2 -column 0 -sticky ew -columnspan 2
+
+
+# ************************ VTK test stuff ******************************
+
+
+proc vtk_render { } {
+   if {[undefinedMatrix]} { return }
+
+   global Matrix
+
+   catch { iren Disable }
+   catch { ren RemoveActor carpet }
+   catch { surface Delete }
+   catch { warp Delete }
+   catch { mapper Delete }
+   catch { carpet Delete }
+   catch { ren Delete }
+   catch { iren Delete }
+   catch { vtkTkRenderWidget .octInteract.window }
+   grid .octInteract.window -row 3 -column 0 -columnspan 2 -sticky news
+
+   oct_mtovtk $Matrix surface
+   vtkWarpScalar warp
+   warp SetInput surface
+   warp XYPlaneOn
+   warp SetScaleFactor 0.5
+   vtkDataSetMapper mapper
+   mapper SetInput [warp GetOutput]
+   mapper SetScalarRange \
+      [lindex [surface GetScalarRange] 0] [lindex [surface GetScalarRange] 1]
+   vtkActor carpet
+   carpet SetMapper mapper
+   vtkRenderer ren
+   ren AddActor carpet
+   ren SetBackground 1 1 1
+   set renWin [.octInteract.window GetRenderWindow]
+   $renWin AddRenderer ren
+   $renWin SetSize 300 300
+   vtkRenderWindowInteractor iren
+   iren SetRenderWindow $renWin
+   $renWin Render
+   iren Initialize
+   iren Enable
+   iren Start
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_menu.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,50 @@
+## Copyright (C) 1998, 1999, 2000 Joao Cardoso.
+## 
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2 of the License, or (at your
+## option) any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## This file is part of tk_octave.
+
+# usage: tk_menu (title, opt1, ...)
+
+## 2001-09-14 Paul Kienzle <pkienzle@users.sf.net>
+## * convert for pthreads-based tk_octave
+
+function num = tk_menu (t, ...)
+
+tk_init
+
+if (nargin < 2)
+	usage ("tk_menu (title, opt1, ...)");
+endif
+
+tk_cmd( "proc quit {} { destroy .master; wm withdraw . }" );
+tk_cmd( "wm deiconify .;frame .master" );
+
+if (! isempty (t))
+	tk_cmd( sprintf("wm title . \"%s\"", t) );
+	tk_cmd( sprintf("label .master.ltitle -text \"%s\";\
+ 		pack .master.ltitle -side top", t) );
+endif
+
+nopt = nargin - 1;
+
+va_start ();
+for i = 1:nopt
+	tk_cmd( sprintf ("button .master.b%d -text \"%s\" -command { set menuChoice %d; quit}", i, va_arg(), i) );
+	tk_cmd( sprintf ("pack .master.b%d -fill x", i) );
+endfor
+
+tk_cmd( "pack .master" );
+tk_cmd( "tkwait window .master" );
+num = sscanf(tk_cmd( "set menuChoice" ), "%d");
+
+endfunction
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_message.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,62 @@
+## Copyright (C) 1998, 1999, 2000 Joao Cardoso.
+## 
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2 of the License, or (at your
+## option) any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## This file is part of tk_octave.
+
+# tk_message(text [, time])
+#
+# Opens a new window and displays the "text" message during "time" seconds.
+# if "time" is not specified, the default is five seconds.
+#
+# After "time" is elapsed, if a tk interpreter was launched,
+# it will be terminated.
+#
+# If you want to cancel a message before "time" expires, call tk_message
+# with only one (possibly empty) argument.
+#
+# If a further tk_message is issued before "time" of the previous one has
+# expired, the new message will be displayed, and the timer rearmed with the
+# new value.
+#
+# Octave can continue processing meanwhile.
+
+## 2001-09-14 Paul Kienzle <pkienzle@users.sf.net>
+## * support pthreads-based tk_octave
+## * handle time=0 by putting up an Ok dialog box.
+
+function tk_message(text, time)
+
+eval("tk_interp", "");
+
+if (nargin == 0)
+	tk_cmd( "destroy .msg_message" );
+	return
+endif
+
+if (nargin == 1)
+	time = 0;
+endif
+
+if (time <= 0)
+     tk_dialog("Message", text, "info", 0, "Ok");
+else
+     tk_cmd(sprintf(...
+	"catch {toplevel .msg_message}; catch {message .msg_message.msg};...
+	.msg_message.msg configure -text {%s};...
+	pack .msg_message.msg;...
+	wm title .msg_message Message;...
+	foreach  i [after info] {after cancel $i};...
+	after %d {catch {destroy .msg_message} }",...
+	text, time*1000));
+endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_progress.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,57 @@
+## Copyright (C) 1998, 1999, 2000 Joao Cardoso.
+## 
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2 of the License, or (at your
+## option) any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## This file is part of tk_octave.
+
+## tk_progress(val, text)
+##
+## creates a progress bar indicator window it it does not exist, and
+## sets the bar of scale bar to value ( 0 <= val <= 100), and prints 'text'.
+## if it exists, then only 'val' and 'text' are updated
+## if called without arguments, destroys the window
+##
+## Octave can continue processing
+
+## 2001-09-14 Paul Kienzle <pkienzle@users.sf.net>
+## * converted for use with pthreads-based tk_octave
+
+function tk_progress(val, text)
+
+        tk_init
+	if (nargin == 0)
+		tk_cmd( "destroy .top_progress");
+		return
+	endif
+
+	if (tk_cmd( "winfo exists .top_progress" ) != "1")
+		tk_cmd( "toplevel .top_progress" );
+		tk_cmd( "wm title .top_progress Progress" );
+		tk_cmd( "label .top_progress.lab1 -relief ridge \
+-text \"Wait please\" -padx 10 -pady 5 -textvariable tk_progress_message" ); 
+		tk_cmd( "scale .top_progress.sca1 -orient horiz \
+-showvalue 1 -sliderlength 10 -state disabled -variable tk_progress_value" );
+
+		tk_cmd( "pack .top_progress.lab1 -anchor center -expand 1 \
+-fill both -padx 20 -pady 10 -side top" ); 
+		tk_cmd( "pack .top_progress.sca1 -anchor center -expand 1 \
+-fill x -padx 20 -pady 10 -side top" );
+	endif
+
+	if (nargin >= 1)
+		tk_cmd( sprintf("set tk_progress_value %d", val) );
+	endif
+	if (nargin == 2)
+		tk_cmd( sprintf( "set tk_progress_message \"%s\"", text) );
+		tk_cmd( sprintf( "wm title .top_progress {%s}", text) );
+	endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_progress_cancel.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,63 @@
+## Copyright (C) 1998, 1999, 2000 Joao Cardoso.
+## 
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2 of the License, or (at your
+## option) any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## This file is part of tk_octave.
+
+## st = tk_progress_cancel(intp [, val [, text])
+##
+## similar to tk_progress but with a stop button.
+## when called returns 1 if the stop button has been pressed.
+##
+## see also tk_progress
+
+## 2001-09-14 Paul Kienzle <pkienzle@users.sf.net>
+## * converted for use with pthreads-based tk_octave
+## * allow test of cancel without setting a new value
+
+function st = tk_progress_cancel(val, text)
+
+        st = 0;
+
+        tk_init
+
+	if (nargin == 0 && nargout == 0)
+		tk_cmd( "destroy .top_progress" );
+		return
+	endif
+
+	if (tk_cmd( "winfo exists .top_progress") == "0")
+		tk_cmd( "toplevel .top_progress" );
+		tk_cmd( "wm title .top_progress Progress" );
+		tk_cmd( "label .top_progress.lab1 -relief ridge \
+-text \"Wait please\" -padx 10 -pady 5 -textvariable tk_progress_message" ); 
+		tk_cmd( "scale .top_progress.sca1 -orient horiz \
+-showvalue 1 -sliderlength 10 -state disabled -variable tk_progress_value" );
+
+		tk_cmd( "button .top_progress.b1 -text Stop -command {set stop 1}" );
+		tk_cmd( "set stop 0" );
+		tk_cmd( "pack .top_progress.lab1 -anchor center -expand 1 \
+-fill both -padx 20 -pady 10 -side top" ); 
+		tk_cmd( "pack .top_progress.sca1 -anchor center -expand 1 \
+-fill x -padx 20 -pady 10 -side top" );
+		tk_cmd( "pack .top_progress.b1" );
+	endif
+
+	if (nargin >= 1)
+		tk_cmd( sprintf("set tk_progress_value %d", val) );
+		st = str2num(tk_cmd("set stop"));
+	endif
+	if (nargin == 2)
+		tk_cmd( sprintf( "set tk_progress_message \"%s\"", text) );
+		tk_cmd( sprintf( "wm title .top_progress {%s}", text) );
+	endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_scale.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,75 @@
+## Copyright (C) 1998, 1999, 2000 Joao Cardoso.
+## 
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2 of the License, or (at your
+## option) any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## This file is part of tk_octave.
+
+# tk_scale (title, scale_1, ...)
+#
+#	scale = legend, initial_value, min, max , resolution
+#
+# display N vertical scales, each one labeled with legend; each scale is
+# initially set to initial_value, and its value can span from  min to
+# max in resolution increments.
+#
+# E.g.: [eta lamb mu] = tk_scale("Scale Demo", "eta", 3, 1, 10, 0.1,
+#	"lambda", 4, 2, 20, 1, "mu", 0.01, 0.001, 0.1, 0.01)
+
+## 2001-09-14 Paul Kienzle <pkienzle@users.sf.net>
+## * converted to work with pthreads-based tk_octave
+
+function [...] = tk_scale (title, ...)
+
+tk_init
+
+if (nargin < 5)
+	help tk_scale
+	return
+endif
+
+tk_cmd( sprintf("toplevel .master") );
+
+if (! isempty (title))
+    tk_cmd( sprintf("wm title .master \"%s\"", title) );
+    tk_cmd( sprintf("label .master.ltitle -text \"%s\"; \
+		pack .master.ltitle -side top", title) );
+endif
+
+tk_cmd( "button .master.quit -text Done -command {destroy .master}" );
+tk_cmd( "pack .master.quit -side bottom" );
+	
+nopt = (nargin - 1)/5;
+cmd_ok = cmd_res = "";
+
+va_start();
+for i=1:nopt
+    desc = va_arg();
+    val = va_arg();
+    min_val = va_arg();
+    max_val = va_arg();
+    inc_val = va_arg();
+	
+    tk_cmd( sprintf("set val_%d %f", i, val) );
+    tk_cmd( sprintf("scale .master.s%d -from %f -to %f \
+		-resolution %f 	-label {%s} -variable val_%d \
+		-showvalue 1", \
+		     i, min_val, max_val, inc_val, desc, i) );
+    tk_cmd( sprintf("pack .master.s%d -side left", i) );
+
+endfor
+
+tk_cmd( "tkwait window .master" );
+	
+for i=1:nopt
+    vr_val(eval([tk_cmd (sprintf("set val_%d",i)), ";"]));
+endfor
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_yesno.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,34 @@
+## Copyright (C) 1998, 1999, 2000 Joao Cardoso.
+## 
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2 of the License, or (at your
+## option) any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## This file is part of tk_octave.
+
+## ret = tk_yesno(text [, default])
+##
+## Open a window with 'text' printed and asking for YES or NO, the
+## default being 'default'. The return value is 0 for YES and 1 for NO
+## (the default if 'default' is not specified)
+##
+## see also: tk_dialog
+
+## 2001-09-14 Paul Kienzle <pkienzle@users.sf.net>
+## * returns true for yes and false for no
+
+function ret = tk_yesno(text, default)
+
+if (nargin == 1)
+	default = 1;
+endif
+
+ret = !tk_dialog("",text,"question", default,"Yes","No");
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/tk_octave/tk_yesnocancel.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,32 @@
+## Copyright (C) 1998, 1999, 2000 Joao Cardoso.
+## 
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2 of the License, or (at your
+## option) any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## This file is part of tk_octave.
+
+# ret = tk_yesnocancel(text [, default])
+#
+# Open a window with 'text' printed and asking for YES, NO or CANCEL the
+# default being 'default'. The return value is 0 for YES, 1 for NO and
+# 2 for CANCEL (the default if 'default' is not specified)
+#
+# see also: tk_dialog
+
+function ret = tk_yesnocancel(text, default)
+
+if (nargin == 1)
+	default = 2;
+endif
+
+ret = tk_dialog("",text, "question", default, "Yes", "No", "Cancel");
+
+endfunction
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/fieldnames.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,21 @@
+## f = fieldnames(s)
+##
+## This function exists in Matlab as a function which returns a cell
+## array containing the names of the fields in structure s.  Since
+## Octave 2.0 does not support cell arrays, you must convert your script
+## to use the Octave function struct_elements, which returns a string 
+## matrix instead of a cell array.  The function struct_elements is 
+## easily implemented in Matlab as:
+##
+## function x = struct_elements(s) 
+##    x = char(fieldnames(s));
+##
+## See also cmpstruct, getfield, setfield, rmfield, isfield, isstruct,
+## struct.
+
+
+## Author:        Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+
+function f = fieldnames(s)
+  error("cell arrays unavailable in Octave 2.0; use struct_elements instead");
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/figure.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,55 @@
+## Copyright (C) 1996 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## usage: figure (n)
+##
+## Set the current plot window to plot window N.  This function
+## currently requires X11 and a recent version of gnuplot.
+
+## Author: jwe
+
+## Modified: http://www.che.wisc.edu/octave/mailing-lists/octave-sources/1999/97
+
+function figure (n)
+
+global current_figure
+
+if (nargin <= 1)
+  if (nargin == 0)
+    if (~exist('current_figure'))
+      current_figure = 1;
+    else
+      current_figure = current_figure + 1;
+    endif
+    n = current_figure;
+  endif
+  if (gnuplot_has_frames)
+    if (! isempty (getenv ("DISPLAY")))
+      oneplot ();
+      eval (sprintf ("gset term x11 %d\n", n));
+    else
+      error ("figure: requires X11 and valid DISPLAY");
+    endif
+  else
+    error ("figure: gnuplot doesn't appear to support this feature");
+  endif
+else
+  usage ("figure (n)");
+endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/file_in_loadpath.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,2 @@
+function name = file_in_loadpath(file)
+  name = file_in_path(LOADPATH, file);
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/is_complex.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,25 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software and may be used for any purpose.  This
+## copyright notice must be maintained.  Paul Kienzle is not responsible
+## for the consequences of using this software.
+
+## usage: b = is_complex(x)
+##
+## Returns 1 if any elements of x are complex.
+
+function b = is_complex(x)
+  if (nargin != 1) 
+    usage("b = is_complex(x)"); 
+  endif
+  b = any(any(imag(x)));
+endfunction
+
+%!shared x
+%! x=rand(10,10); 
+%!assert (isreal (x));
+%!test x(5,1)=1i; 
+%!assert (!isreal (x));
+%!assert (isreal ([]));
+%!error isreal
+%!error isreal(1,2)
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/isfinite.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,6 @@
+function x = isfinite(A)
+  if nargin != 1
+    usage("x = isfinite(A)");
+  endif
+  x = !isinf(A);
+  
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/islogical.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,2 @@
+function a = islogical(m)
+  a = all(all(m==1 | m==0));
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/isreal.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,19 @@
+## usage: b = isreal(x)
+##
+## Returns 1 if all elements of x are real.
+
+function b = isreal(x)
+  if (nargin != 1) 
+    usage("b = isreal(x)"); 
+  endif
+  b = !any(any(imag(x)));
+endfunction
+
+%!shared x
+%! x=rand(10,10); 
+%!assert (isreal (x));
+%!test x(5,1)=1i; 
+%!assert (!isreal (x));
+%!assert (isreal ([]));
+%!error isreal
+%!error isreal(1,2)
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/logical.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,2 @@
+function l=logical(a)
+  l = (a != 0);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/nanfunc.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,28 @@
+## Usage: R = nanfunc( which_func, a_matrix, default_for_func ) applies
+## 'which_func' to non-NaN values of 'a_matrix' columnwise, returning
+## 'default_for_func' if all values are NaN.
+
+## Copyright (C) 2000 Daniel Calvelo Aros
+## 
+## Do what you want with this code. No warranty whatsoever.
+##
+## Author:  DCA (dcalvelo@phare.univ-lille2.fr)
+## Description:  Generic function caller for dealing with NaNs as
+##               missing data
+
+function M = nanfunc(func,m,default),
+  [r,c] = size(m);
+  if r == 1,
+    m = m(:);
+    c = 1;
+  endif;
+  M = zeros(1,c);
+  for col=1:c,
+    f = find(~isnan(m(:,col)));
+    if isempty(f),
+      M(col) = default;
+    else
+      M(col) = feval(func, m(f,col) );
+    endif;
+  endfor;
+endfunction;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/nanmax.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,40 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## [v, idx] = nanmax(X [, dim]);
+## nanmax is identical to the max function except that NaN values are
+## treated as -Inf, and so are ignored.  If all values are NaN, the
+## maximum is returned as -Inf. [Is this behaviour compatible?]
+##
+## See also: nansum, nanmin, nanmean, nanmedian
+function [v, idx] = nanmax (X, ...)
+  if nargin < 1
+    usage ("[v, idx] = nanmax(X [, dim])");
+  else
+    dfi = do_fortran_indexing;
+    pzoi = prefer_zero_one_indexing;
+    unwind_protect
+      do_fortran_indexing = 1;
+      prefer_zero_one_indexing = 1;
+
+      X(isnan(X)) = -Inf;
+      [v,idx] = max (X, all_va_args);
+    unwind_protect_cleanup
+      do_fortran_indexing = dfi;
+      prefer_zero_one_indexing = pzoi;
+    end_unwind_protect
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/nanmean.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,42 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## v = nanmean(X [, dim]);
+## nanmean is identical to the mean function except that NaN values are
+## ignored.  If all values are NaN, the mean is returned as NaN. 
+## [Is this behaviour compatible?]
+##
+## See also: nanmin, nanmax, nansum, nanmedian
+function v = nanmean (X, ...)
+  if nargin < 1
+    usage ("v = nanmean(X [, dim])");
+  else
+    dfi = do_fortran_indexing;
+    pzoi = prefer_zero_one_indexing;
+    unwind_protect
+      do_fortran_indexing = 1;
+      prefer_zero_one_indexing = 1;
+
+      n = sum (!isnan(X), all_va_args);
+      n(n == 0) = NaN;
+      X(isnan(X)) = 0;
+      v = sum (X, all_va_args) ./ n;
+    unwind_protect_cleanup
+      do_fortran_indexing = dfi;
+      prefer_zero_one_indexing = pzoi;
+    end_unwind_protect
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/nanmedian.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,71 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## v = nanmedian(X [, dim]);
+## nanmedian is identical to the median function except that NaN values are
+## ignored.  If all values are NaN, the median is returned as NaN. 
+## [Is this behaviour compatible?]
+##
+## See also: nanmin, nanmax, nansum, nanmean
+function v = nanmedian (X, dim)
+  if nargin < 1 || nargin > 2
+    usage ("v = nanmean(X [, dim])");
+  else
+    if nargin == 1
+      if size(X,1) == 1
+	dim = 2; 
+      else
+        dim = 1;
+      endif
+    endif
+    if (dim == 2) X = X.'; endif
+    dfi = do_fortran_indexing;
+    pzoi = prefer_zero_one_indexing;
+    unwind_protect
+      do_fortran_indexing = 1;
+      prefer_zero_one_indexing = 1;
+
+      ## Find lengths of datasets after excluding NaNs; valid datasets
+      ## are those that are not empty after you remove all the NaNs
+      n = size(X,1) - sum (isnan(X));
+      valid = find(n!=0);
+
+      ## Extract all non-empty datasets and sort, replacing NaN with Inf
+      ## so that the invalid elements go toward the ends of the columns
+      X (isnan(X)) = Inf;
+      X = sort ( X (:, valid) );
+
+      ## Determine the offset for each remaining column in single index mode
+      colidx = (0:size(X,2)-1)*size(X,1);
+
+      ## Assume the median for all datasets will be NaNs
+      v = NaN*ones(size(n));
+
+      ## Average the two central values of the sorted list to compute
+      ## the median, but only do so for valid rows.  If the dataset
+      ## is odd length, the single central value will be used twice.
+      ## E.g., 
+      ##   for n==5, ceil(2.5+0.4) is 3 and floor(2.5+0.6) is also 3
+      ##   for n==6, ceil(3.0+0.4) is 4 and floor(3.0+0.6) is 3
+      v(valid) = ( X (colidx + floor(n(valid)./2+0.6)) ...
+		 + X (colidx + ceil(n(valid)./2+0.4)) ) ./ 2;
+    unwind_protect_cleanup
+      do_fortran_indexing = dfi;
+      prefer_zero_one_indexing = pzoi;
+    end_unwind_protect
+    if (dim == 2) v = v.'; endif
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/nanmin.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,40 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## [v, idx] = nanmin (X [, dim]);
+## nanmin is identical to the min function except that NaN values are
+## treated as Inf, and so are ignored.  If all values are NaN, the
+## minimum is returned as Inf. [Is this behaviour compatible?]
+##
+## See also: nansum, nanmax, nanmean, nanmedian
+function [v, idx] = nanmin (X, ...)
+  if nargin < 1
+    usage ("[v, idx] = nanmin (X [, dim])");
+  else
+    dfi = do_fortran_indexing;
+    pzoi = prefer_zero_one_indexing;
+    unwind_protect
+      do_fortran_indexing = 1;
+      prefer_zero_one_indexing = 1;
+
+      X(isnan(X)) = Inf;
+      [v, idx] = min (X, all_va_args);
+    unwind_protect_cleanup
+      do_fortran_indexing = dfi;
+      prefer_zero_one_indexing = pzoi;
+    end_unwind_protect
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/nanstd.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,71 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## v = nanstd(X [, dim]);
+## nanstd is identical to the std function except that NaN values are
+## ignored.  If all values are NaN, the std is returned as NaN. If there
+## is only a single non-NaN value, the std is returned as 0. 
+## [Is this behaviour compatible?]
+##
+## See also: nanmin, nanmax, nansum, nanmedian, nanmean
+function v = nanstd (X, dim)
+  if nargin < 1
+    usage ("v = nanstd(X [, dim])");
+  else
+    if nargin == 1
+      if size(X,1) == 1
+	dim = 2; 
+      else
+        dim = 1;
+      endif
+    endif
+    if (dim == 2) X = X.'; endif
+    dfi = do_fortran_indexing;
+    pzoi = prefer_zero_one_indexing;
+    wdz = warn_divide_by_zero;
+    unwind_protect
+      do_fortran_indexing = 1;
+      prefer_zero_one_indexing = 1;
+      warn_divide_by_zero = 0;
+
+      ## determine the number of non-missing points in each data set
+      n = sum (!isnan(X));
+
+      ## replace missing data with zero and compute the mean
+      X(isnan(X)) = 0;
+      meanX = sum (X) ./ n;
+
+      ## subtract the mean from the data and compute the sum squared
+      v = sumsq (X - ones(size(X,1), 1) * meanX);
+
+      ## because the missing data was set to zero each missing data
+      ## point will contribute (-meanX)^2 to sumsq, so remove these
+      v = v - (meanX .^ 2) .* (size(X,1) - n);
+
+      ## compute the standard deviation from the corrected sumsq
+      v = sqrt ( v ./ (n - 1) );
+
+      ## set special values of std for n=0 and n=1
+      ## v(n == 0) = NaN;  # meanX = 0/0 -> NaN above, so not necessary
+      v(n == 1) = 0;
+    unwind_protect_cleanup
+      do_fortran_indexing = dfi;
+      prefer_zero_one_indexing = pzoi;
+      warn_divide_by_zero = wdz;
+    end_unwind_protect
+    if (dim == 2) v = v.'; endif
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/nansum.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,40 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## v = nansum (X [, dim]);
+## nansum is identical to the sum function except that NaN values are
+## treated as 0 and so ignored.  If all values are NaN, the sum is 
+## returned as 0. [Is this behaviour compatible?]
+##
+## See also: nanmin, nanmax, nanmean, nanmedian
+function v = nansum (X, ...)
+  if nargin < 1
+    usage ("v = nansum (X [, dim])");
+  else
+    dfi = do_fortran_indexing;
+    pzoi = prefer_zero_one_indexing;
+    unwind_protect
+      do_fortran_indexing = 1;
+      prefer_zero_one_indexing = 1;
+
+      X(isnan(X)) = 0;
+      v = sum (X, all_va_args);
+    unwind_protect_cleanup
+      do_fortran_indexing = dfi;
+      prefer_zero_one_indexing = pzoi;
+    end_unwind_protect
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/ver20/orient.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,51 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## orient("landscape"|"portrait")
+##    Set default print orientation
+##
+## ret = orient
+##    Return default print orientation
+
+function ret = orient(orientation)
+
+  ## XXX FIXME XXX --- this should be static instead of global, but that
+  ## means it won't work in Octave 2.0
+  global __print_orientation;
+
+  if (nargin == 0)
+    
+    if !exist("__print_orientation")
+      ret = "landscape";
+    else
+      ret = __print_orientation;
+    endif
+
+  elseif (nargin == 1)
+
+    if strcmp(orientation,"landscape") || strcmp(orienation,"portrait")
+      __print_orientation = orientation;
+    else
+      error ("orient: unknown orientation");
+    endif
+
+  else
+
+    usage("orient(['portrait' | 'landscape'])  OR  ret=orient");
+
+  endif
+
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/install-sh	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,251 @@
+#!/bin/sh
+#
+# install - install a program, script, or datafile
+# This comes from X11R5 (mit/util/scripts/install.sh).
+#
+# Copyright 1991 by the Massachusetts Institute of Technology
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, provided that
+# the above copyright notice appear in all copies and that both that
+# copyright notice and this permission notice appear in supporting
+# documentation, and that the name of M.I.T. not be used in advertising or
+# publicity pertaining to distribution of the software without specific,
+# written prior permission.  M.I.T. makes no representations about the
+# suitability of this software for any purpose.  It is provided "as is"
+# without express or implied warranty.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# `make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.  It can only install one file at a time, a restriction
+# shared with many OS's install programs.
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+mkdirprog="${MKDIRPROG-mkdir}"
+
+transformbasename=""
+transform_arg=""
+instcmd="$mvprog"
+chmodcmd="$chmodprog 0755"
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+dir_arg=""
+
+while [ x"$1" != x ]; do
+    case $1 in
+	-c) instcmd="$cpprog"
+	    shift
+	    continue;;
+
+	-d) dir_arg=true
+	    shift
+	    continue;;
+
+	-m) chmodcmd="$chmodprog $2"
+	    shift
+	    shift
+	    continue;;
+
+	-o) chowncmd="$chownprog $2"
+	    shift
+	    shift
+	    continue;;
+
+	-g) chgrpcmd="$chgrpprog $2"
+	    shift
+	    shift
+	    continue;;
+
+	-s) stripcmd="$stripprog"
+	    shift
+	    continue;;
+
+	-t=*) transformarg=`echo $1 | sed 's/-t=//'`
+	    shift
+	    continue;;
+
+	-b=*) transformbasename=`echo $1 | sed 's/-b=//'`
+	    shift
+	    continue;;
+
+	*)  if [ x"$src" = x ]
+	    then
+		src=$1
+	    else
+		# this colon is to work around a 386BSD /bin/sh bug
+		:
+		dst=$1
+	    fi
+	    shift
+	    continue;;
+    esac
+done
+
+if [ x"$src" = x ]
+then
+	echo "install:	no input file specified"
+	exit 1
+else
+	true
+fi
+
+if [ x"$dir_arg" != x ]; then
+	dst=$src
+	src=""
+	
+	if [ -d $dst ]; then
+		instcmd=:
+		chmodcmd=""
+	else
+		instcmd=mkdir
+	fi
+else
+
+# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
+# might cause directories to be created, which would be especially bad 
+# if $src (and thus $dsttmp) contains '*'.
+
+	if [ -f $src -o -d $src ]
+	then
+		true
+	else
+		echo "install:  $src does not exist"
+		exit 1
+	fi
+	
+	if [ x"$dst" = x ]
+	then
+		echo "install:	no destination specified"
+		exit 1
+	else
+		true
+	fi
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+	if [ -d $dst ]
+	then
+		dst="$dst"/`basename $src`
+	else
+		true
+	fi
+fi
+
+## this sed command emulates the dirname command
+dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
+
+# Make sure that the destination directory exists.
+#  this part is taken from Noah Friedman's mkinstalldirs script
+
+# Skip lots of stat calls in the usual case.
+if [ ! -d "$dstdir" ]; then
+defaultIFS='	
+'
+IFS="${IFS-${defaultIFS}}"
+
+oIFS="${IFS}"
+# Some sh's can't handle IFS=/ for some reason.
+IFS='%'
+set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
+IFS="${oIFS}"
+
+pathcomp=''
+
+while [ $# -ne 0 ] ; do
+	pathcomp="${pathcomp}${1}"
+	shift
+
+	if [ ! -d "${pathcomp}" ] ;
+        then
+		$mkdirprog "${pathcomp}"
+	else
+		true
+	fi
+
+	pathcomp="${pathcomp}/"
+done
+fi
+
+if [ x"$dir_arg" != x ]
+then
+	$doit $instcmd $dst &&
+
+	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
+	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
+	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
+	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
+else
+
+# If we're going to rename the final executable, determine the name now.
+
+	if [ x"$transformarg" = x ] 
+	then
+		dstfile=`basename $dst`
+	else
+		dstfile=`basename $dst $transformbasename | 
+			sed $transformarg`$transformbasename
+	fi
+
+# don't allow the sed command to completely eliminate the filename
+
+	if [ x"$dstfile" = x ] 
+	then
+		dstfile=`basename $dst`
+	else
+		true
+	fi
+
+# Make a temp file name in the proper directory.
+
+	dsttmp=$dstdir/#inst.$$#
+
+# Move or copy the file name to the temp name
+
+	$doit $instcmd $src $dsttmp &&
+
+	trap "rm -f ${dsttmp}" 0 &&
+
+# and set any options; do chmod last to preserve setuid bits
+
+# If any of these fail, we abort the whole thing.  If we want to
+# ignore errors from any of these, just make sure not to ignore
+# errors from the above "$doit $instcmd $src $dsttmp" command.
+
+	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
+	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
+	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
+	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
+
+# Now rename the file to the real destination.
+
+	$doit $rmcmd -f $dstdir/$dstfile &&
+	$doit $mvcmd $dsttmp $dstdir/$dstfile 
+
+fi &&
+
+
+exit 0
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,29 @@
+
+include ../Makeconf
+
+SUBMAKES = $(wildcard */Makefile)
+MAKE_SUBDIRS = $(dir $(SUBMAKES))
+INSTALL_SUBDIRS = $(filter-out Makefile, $(wildcard *))
+
+.PHONY: all install clean $(MAKE_SUBDIRS) $(INSTALL_SUBDIRS)
+
+all: $(MAKE_SUBDIRS)
+
+$(MAKE_SUBDIRS):
+	@if test ! -f $@/NOINSTALL || test x$(MAKECMDGOALS) = xclean ; then \
+	    cd $@ && $(MAKE) $(MAKECMDGOALS) ; \
+	fi
+
+install: $(INSTALL_SUBDIRS)
+
+$(INSTALL_SUBDIRS):
+	@if test -f $@/NOINSTALL ; then \
+	    echo skipping $@ ; \
+	else \
+	    echo installing $@ to $(MPATH)/$@ ; \
+	    ../$(INSTALLOCT) $@ $(MPATH)/$@ $(OPATH) $(XPATH) ; \
+	fi
+
+clean: $(MAKE_SUBDIRS)
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,13 @@
+sinclude ../../Makeconf
+
+PROGS = bin/aurecord
+
+all: $(PROGS)
+
+bin/aurecord: aurecord.o endpoint.o
+	$(CXX) $(CXXFLAGS) -o $@ aurecord.o endpoint.o
+
+aurecord.o endpoint.o : endpoint.h
+
+clean: 
+	-$(RM) *.o $(PROGS) core octave-core *~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/au.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,52 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## y = au(x, fs, lo [, hi])
+##
+## Extract data from x for time range lo to hi in milliseconds.  If lo
+## is [], start at the beginning.  If hi is [], go to the end.  If hi is
+## not specified, return the single element at lo.  If lo<0, prepad the
+## signal to time lo.  If hi is beyond the end, postpad the signal to
+## time hi.
+
+## TODO: modify prepad and postpad so that they accept matrices.
+function y=au(x,fs,lo,hi)
+  if nargin<3 || nargin>4,
+    usage("y = au(x, fs, lo [,hi])");
+  endif
+
+  if nargin<4, hi=lo; endif
+  if isempty(lo), 
+    lo=1; 
+  else
+    lo=fix(lo*fs/1000)+1;
+  endif
+  if isempty(hi),
+    hi=length(x);
+  else
+    hi=fix(hi*fs/1000)+1;
+  endif
+  if hi<lo, t=hi; hi=lo; lo=hi; endif
+  if (size(x,1)==1 || size(x,2)==1)
+    y=x(max(lo,1):min(hi,length(x)));
+    if (lo<1), y=prepad(y,length(y)-lo+1); endif
+    if (hi>length(x)), y=postpad(y,length(y)+hi-length(x)); endif
+  else
+    y=x(max(lo,1):min(hi,length(x)), :);
+    if (lo<1), y=[zeros(size(x,2),-lo+1) ; y]; endif
+    if (hi>length(x)), y=[y ; zeros(size(x,2),hi-length(x))]; endif
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/aucapture.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,52 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [x, fs] = aucapture(t, fs, channels)
+##
+## Capture an audio event at the given sample rate fs.  This uses an
+## endpoint detection routine to eliminate the silence surrounding the
+## event. On return, data contains the samples, one column per channel
+## and rate contains the sample rate used. Note that the sample rate
+## used may not match the requested sample rate. Use the returned rate
+## for further processing.  Similarly, the actual number of samples and
+## channels may not match the request.
+##
+## Time defaults to 10s, rate defaults to 8000 Hz, and channels defaults
+## to 1
+
+## TODO: Consider combining with aurecord.m, with capture indicated by
+## TODO:      time t=[] or t=0 or t<0, or maybe aurecord_usecapture
+function [data, rate] = aucapture(time, rate, channels)
+
+  if nargin>3
+    usage("[x, fs] = aucapture([t, fs, channels]);");
+  end
+  if nargin<1, time = 10.0; end
+  if nargin<2, rate = 8000; end
+  if nargin<3, channels = 1; end
+
+  com = sprintf("aurecord -e -r %d -c %d -t %f", rate, channels, time)
+  fid = popen(com, "r");
+  rate = fread(fid, 1, 'long');
+  channels = fread(fid, 1, 'long');
+  if channels == 0
+    pclose(fid);
+    error("aurecord failed -- perhaps audio device is in use?\n");
+  end;
+  data = fread(fid, Inf, 'short')/32768;
+  data = reshape(data, length(data)/channels, channels);
+  pclose(fid);
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/auload.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,344 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [x, fs, sampleformat] = auload('filename.ext')
+##
+## Reads an audio waveform from a file.  Returns the audio samples in
+## data, one column per channel, one row per time slice.  Also returns
+## the sample rate and stored format (one of ulaw, alaw, char, short,
+## long, float, double). The sample value will be normalized to the
+## range [-1,1) regardless of the stored format.  This does not do any
+## level correction or DC offset correction on the samples.
+##
+## Example
+##    [x, fs] = auload(file_in_loadpath("sample.wav"));
+##    auplot(x,fs);
+
+## 2001-09-04 Paul Kienzle <pkienzle@users.sf.net>
+## * skip unknown blocks in WAVE format.
+## 2001-09-05 Paul Kienzle <pkienzle@users.sf.net>
+## * remove debugging stuff from AIFF format.
+## * use data length if it is given rather than reading to the end of file.
+
+function [data, rate, sampleformat] = auload(path)
+
+  if (nargin != 1)
+    usage("[x, fs, sampleformat] = auload('filename.ext')");
+  end
+  data = [];       # if error then read nothing
+  rate = 8000;
+  sampleformat = 'ulaw';
+  ext = rindex(path, '.');
+  if (ext == 0)
+    usage('x = auload(filename.ext)');
+  end
+  ext = tolower(substr(path, ext+1, length(path)-ext));
+
+  [file, msg] = fopen(path, 'r');
+  if (file == -1)
+    error([ msg, ": ", path]);
+  end
+
+  msg = sprintf('Invalid audio header: %s', path);
+  ## Microsoft .wav format
+  if strcmp(ext,'wav') 
+
+    ## Header format obtained from sox/wav.c
+    ## April 15, 1992
+    ## Copyright 1992 Rick Richardson
+    ## Copyright 1991 Lance Norskog And Sundry Contributors
+    ## This source code is freely redistributable and may be used for
+    ## any purpose.  This copyright notice must be maintained. 
+    ## Lance Norskog And Sundry Contributors are not responsible for 
+    ## the consequences of using this software.
+
+    ## check the file magic header bytes
+    arch = 'ieee-le';
+    str = setstr(fread(file, 4, 'char')');
+    if !strcmp(str, 'RIFF')
+      error(msg);
+    end
+    len = fread(file, 1, 'long', 0, arch);
+    str = setstr(fread(file, 4, 'char')');
+    if !strcmp(str, 'WAVE')
+      error(msg);
+    end
+
+    ## skip to the "fmt " section, ignoring everything else
+    while (1)
+      if feof(file)
+      	error(msg);
+      end
+      str = setstr(fread(file, 4, 'char')');
+      len = fread(file, 1, 'long', 0, arch);
+      if strcmp(str, 'fmt ')
+	break;
+      end
+      fseek(file, len, SEEK_CUR);
+    end
+
+    ## read the "fmt " section
+    formatid = fread(file, 1, 'short', 0, arch);
+    channels = fread(file, 1, 'short', 0, arch);
+    rate = fread(file, 1, 'long', 0, arch);
+    fread(file, 1, 'long', 0, arch);
+    fread(file, 1, 'short', 0, arch);
+    bits = fread(file, 1, 'short', 0, arch);
+    fseek(file, len-16, SEEK_CUR);
+
+    ## skip to the "data" section, ignoring everything else
+    while (1)
+      if feof(file)
+      	error(msg);
+      end
+      str = setstr(fread(file, 4, 'char')');
+      len = fread(file, 1, 'long', 0, arch);
+      if strcmp(str, 'data')
+	break;
+      end
+      fseek(file, len, SEEK_CUR);
+    end
+
+    if (formatid == 1)
+      if bits == 8
+      	sampleformat = 'uchar';
+	precision = 'uchar';
+        samples = len;
+      elseif bits == 16
+      	sampleformat = 'short';
+	precision = 'short';
+        samples = len/2;
+      elseif bits == 32
+	sampleformat = 'long';
+	precision = 'long';
+        samples = len/4;
+      else
+       	error(msg);
+      endif
+    elseif (formatid == 6 && bits == 8)
+      sampleformat = 'alaw';
+      precision = 'uchar';
+      samples = len;
+    elseif (formatid == 7 && bits == 8)
+      sampleformat = 'ulaw';
+      precision = 'uchar';
+      samples = len;
+    else
+      error(msg);
+      return;
+    endif
+
+  ## Sun .au format
+  elseif strcmp(ext, 'au')
+
+    ## Header format obtained from sox/au.c
+    ## September 25, 1991
+    ## Copyright 1991 Guido van Rossum And Sundry Contributors
+    ## This source code is freely redistributable and may be used for
+    ## any purpose.  This copyright notice must be maintained. 
+    ## Guido van Rossum And Sundry Contributors are not responsible for 
+    ## the consequences of using this software.
+
+    str = setstr(fread(file, 4, 'char')');
+    magic=' ds.';
+    invmagic='ds. ';
+    magic(1) = setstr(0);
+    invmagic(1) = setstr(0);
+    if strcmp(str, 'dns.') || strcmp(str, magic)
+      arch = 'ieee-le';
+    elseif strcmp(str, '.snd') || strcmp(str, invmagic)
+      arch = 'ieee-be';
+    else
+      error(msg);
+    end
+    header = fread(file, 1, 'long', 0, 'ieee-be');
+    len = fread(file, 1, 'long', 0, 'ieee-be');
+    formatid = fread(file, 1, 'long', 0, 'ieee-be');
+    rate = fread(file, 1, 'long', 0, 'ieee-be');
+    channels = fread(file, 1, 'long', 0, 'ieee-be');
+    fseek(file, header-24, SEEK_CUR); % skip file comment
+
+    ## interpret the sample format
+    if formatid == 1
+      sampleformat = 'ulaw';
+      precision = 'uchar';
+      bits = 12;
+      samples = len;
+    elseif formatid == 2
+      sampleformat = 'uchar';
+      precision = 'uchar';
+      bits = 8;
+      samples = len;
+    elseif formatid == 3
+      sampleformat = 'short';
+      precision = 'short';
+      bits = 16;
+      samples = len/2;
+    elseif formatid == 5
+      sampleformat = 'long';
+      precision = 'long';
+      bits = 32;
+      samples = len/4;
+    elseif formatid == 6
+      sampleformat = 'float';
+      precision = 'float';
+      bits = 32;
+      samples = len/4;
+    elseif formatid == 7
+      sampleformat = 'double';
+      precision = 'double';
+      bits = 64;
+      samples = len/8;
+    else
+      error(msg);
+    end
+      
+  ## Apple/SGI .aiff format
+  elseif strcmp(ext,'aiff')
+
+    ## Header format obtained from sox/aiff.c
+    ## September 25, 1991
+    ## Copyright 1991 Guido van Rossum And Sundry Contributors
+    ## This source code is freely redistributable and may be used for
+    ## any purpose.  This copyright notice must be maintained. 
+    ## Guido van Rossum And Sundry Contributors are not responsible for 
+    ## the consequences of using this software.
+    ##
+    ## IEEE 80-bit float I/O taken from
+    ##        ftp://ftp.mathworks.com/pub/contrib/signal/osprey.tar
+    ##        David K. Mellinger
+    ##        dave@mbari.org
+    ##        +1-831-775-1805
+    ##        fax       -1620
+    ##        Monterey Bay Aquarium Research Institute
+    ##        7700 Sandholdt Road
+ 
+    ## check the file magic header bytes
+    arch = 'ieee-be';
+    str = setstr(fread(file, 4, 'char')');
+    if !strcmp(str, 'FORM')
+      error(msg);
+    end
+    len = fread(file, 1, 'long', 0, arch);
+    str = setstr(fread(file, 4, 'char')');
+    if !strcmp(str, 'AIFF')
+      error(msg);
+    end
+
+    ## skip to the "COMM" section, ignoring everything else
+    while (1)
+      if feof(file)
+      	error(msg);
+      end
+      str = setstr(fread(file, 4, 'char')');
+      len = fread(file, 1, 'long', 0, arch);
+      if strcmp(str, 'COMM')
+	break;
+      end
+      fseek(file, len, SEEK_CUR);
+    end
+
+    ## read the "COMM" section
+    channels = fread(file, 1, 'short', 0, arch);
+    frames = fread(file, 1, 'long', 0, arch);
+    bits = fread(file, 1, 'short', 0, arch);
+    exp = fread(file, 1, 'ushort', 0, arch);    % read a 10-byte float
+    mant = fread(file, 2, 'ulong', 0, arch);
+    mant = mant(1) / 2^31 + mant(2) / 2^63;
+    if (exp >= 32768), mant = -mant; exp = exp - 32768; end
+    exp = exp - 16383;
+    rate = mant * 2^exp;
+    fseek(file, len-18, SEEK_CUR);
+
+    ## skip to the "SSND" section, ignoring everything else
+    while (1)
+      if feof(file)
+      	error(msg);
+      end
+      str = setstr(fread(file, 4, 'char')');
+      len = fread(file, 1, 'long', 0, arch);
+      if strcmp(str, 'SSND')
+	break;
+      end
+      fseek(file, len, SEEK_CUR);
+    end
+    offset = fread(file, 1, 'long', 0, arch);
+    fread(file, 1, 'long', 0, arch);
+    fseek(file, offset, SEEK_CUR);
+
+    if bits == 8
+      precision = 'uchar';
+      sampleformat = 'uchar';
+      samples = len - 8;
+    elseif bits == 16
+      precision = 'short';
+      sampleformat = 'short';
+      samples = (len - 8)/2;
+    elseif bits == 32
+      precision = 'long';
+      sampleformat = 'long';
+      samples = (len - 8)/4;
+    else
+      error(msg);
+    endif
+    
+  ## file extension unknown
+  else
+    error('auload(filename.ext) understands .wav .au and .aiff only');
+  end
+
+  ## suck in all the samples
+  if (samples <= 0) samples = Inf; end
+  data = fread(file, samples, precision, 0, arch);
+  fclose(file);
+
+  ## convert samples into range [-1, 1)
+  if strcmp(sampleformat, 'alaw')
+    alaw = [ \
+	     -5504,  -5248,  -6016,  -5760,  -4480,  -4224,  -4992,  -4736, \
+	     -7552,  -7296,  -8064,  -7808,  -6528,  -6272,  -7040,  -6784, \
+	     -2752,  -2624,  -3008,  -2880,  -2240,  -2112,  -2496,  -2368, \
+	     -3776,  -3648,  -4032,  -3904,  -3264,  -3136,  -3520,  -3392, \
+	    -22016, -20992, -24064, -23040, -17920, -16896, -19968, -18944, \
+	    -30208, -29184, -32256, -31232, -26112, -25088, -28160, -27136, \
+	    -11008, -10496, -12032, -11520,  -8960,  -8448,  -9984,  -9472, \
+	    -15104, -14592, -16128, -15616, -13056, -12544, -14080, -13568, \
+	      -344,   -328,   -376,   -360,   -280,   -264,   -312,   -296, \
+	      -472,   -456,   -504,   -488,   -408,   -392,   -440,   -424, \
+	       -88,    -72,   -120,   -104,    -24,     -8,    -56,    -40, \
+	      -216,   -200,   -248,   -232,   -152,   -136,   -184,   -168, \
+	     -1376,  -1312,  -1504,  -1440,  -1120,  -1056,  -1248,  -1184, \
+	     -1888,  -1824,  -2016,  -1952,  -1632,  -1568,  -1760,  -1696, \
+	      -688,   -656,   -752,   -720,   -560,   -528,   -624,   -592, \
+	      -944,   -912,  -1008,   -976,   -816,   -784,   -880,   -848 ];
+    alaw = [ alaw, -alaw]/32768;
+    data = alaw(data+1);
+  elseif strcmp(sampleformat, 'ulaw')
+    data = mu2lin(data, 16)/32768;
+  elseif strcmp(sampleformat, 'uchar')
+    data = data/128 - 1;
+  elseif strcmp(sampleformat, 'short')
+    data = data/32768;
+  elseif strcmp(sampleformat, 'long')
+    data = data/2^31;
+  end
+  data = reshape(data, channels, length(data)/channels)';
+
+endfunction
+
+%!demo
+%! [x, fs] = auload(file_in_loadpath("sample.wav"));
+%! auplot(x,fs);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/auplot.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,193 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [y, t, scale] = auplot(x [, fs [, offset]] [, plotstr])
+##
+## Plot the waveform data, displaying time on the x axis.  If you are
+## plotting a slice from the middle of an array, you may want to specify
+## the offset into the array to retain the appropriate time index. If
+## the waveform contains multiple channels, then the data are scaled to
+## the range [-1,1] and shifted so that they do not overlap. If a plot
+## string is given, it is passed as the third argument to the plot
+## command. This allows you to set the linestyle easily. Fs defaults to
+## 8000 Hz, and offset defaults to 0 samples.
+##
+## Instead of plotting directly, you can ask for the returned processed 
+## vectors. If y has multiple channels, the plot should have the y-range
+## [-1 2*size(y,2)-1]. scale specifies how much the matrix was scaled
+## so that each signal would fit in the specified range.
+##
+## Since speech samples can be very long, we need a way to plot them
+## rapidly. For long signals, auplot windows the data and keeps the
+## minimum and maximum values in the window.  Together, these values
+## define the minimal polygon which contains the signal.  The number of
+## points in the polygon is set with the global variable auplot_points.
+## The polygon may be either 'filled' or 'outline', as set by the global
+## variable auplot_format.  For moderately long data, the window does
+## not contain enough points to draw an interesting polygon. In this
+## case, simply choosing an arbitrary point from the window looks best.
+## The global variable auplot_window sets the size of the window
+## required for creating polygons.  You can turn off the polygons
+## entirely by setting auplot_format to 'sampled'.  To turn off fast
+## plotting entirely, set auplot_format to 'direct', or set
+## auplot_points=1. There is no reason to do this since your screen
+## resolution is limited and increasing the number of points plotted
+## will not add any information.  auplot_format, auplot_points and
+## auplot_window may be set in .octaverc.  By default auplot_format is
+## 'outline', auplot_points=1000 and auplot_window=7.
+
+## 2000-03 Paul Kienzle
+##     accept either row or column data
+##     implement fast plotting
+## 2000-04 Paul Kienzle
+##     return signal and time vectors if asked
+
+## TODO: test offset and plotstr
+## TODO: convert offset to time range in the form used by au
+## TODO: rename to au; if nargout return data within time range
+## TODO:     otherwise plot the data
+function [y_r, t_r, scale_r] = auplot(x, fs, offset, plotstr)
+
+  global auplot_points=1000;
+  global auplot_format="outline";
+  global auplot_window=7;
+
+  if nargin<1 || nargin>4
+    usage("[y, t, scale] = auplot(x [, fs [, offset [, plotstr]]])");
+  endif
+  if nargin<2, fs = 8000; offset=0; plotstr = []; endif
+  if nargin<3, offset=0; plotstr = []; endif
+  if nargin<4, plotstr = []; endif
+  if isstr(fs), plotstr=fs; fs=8000; endif
+  if isstr(offset), plotstr=offset; offset=0; endif
+  if isempty(plotstr), plotstr=";;"; endif
+  
+
+  if (size(x,1)<size(x,2)), x=x'; endif
+
+  [samples, channels] = size(x);
+  r = ceil(samples/auplot_points);
+  c = floor(samples/r);
+  hastail = (samples>c*r);
+
+  if r==1 || strcmp(auplot_format,"direct")
+    ## full plot
+    t=[0:samples-1]*1000/fs;
+    y=x;
+  elseif r<auplot_window || strcmp(auplot_format,"sampled")
+    ## sub-sampled plot
+    y=x(1:r:samples,:);
+    t=[0:size(y,1)-1]*1000*r/fs;
+  elseif strcmp(auplot_format,"filled")
+    ## filled plot
+    if hastail
+      t=zeros(2*(c+1),1);
+      y=zeros(2*(c+1),channels);
+      t(2*c+1)=t(2*c+2)=c*1000*r/fs;
+    else
+      t=zeros(2*c,1);
+      y=zeros(2*c,channels);
+    endif
+    t(1:2:2*c) = t(2:2:2*c) = [0:c-1]*1000*r/fs;
+    for chan=1:channels
+      head=reshape(x(1:r*c,chan),r,c);
+      y(1:2:2*c,chan) = max(head)';
+      y(2:2:2*c,chan) = min(head)';
+      if (hastail)
+      	tail=x(r*c+1:samples,chan);
+      	y(2*c+1,chan)=max(tail);
+      	y(2*c+2,chan)=min(tail);
+      endif
+    endfor
+  elseif strcmp(auplot_format,"outline")
+    ## outline plot
+    if hastail
+      y=zeros(2*(c+1)+1,channels);
+      t=[0:c]; 
+    else 
+      y=zeros(2*c+1,channels);
+      t=[0:c-1]; 
+    endif
+    t=[t, fliplr(t), 0]*1000*r/fs;
+    for chan=1:channels
+      head=reshape(x(1:r*c,chan),r,c);
+      if hastail
+      	tail=x(r*c+1:samples,chan);
+      	y(:,chan)=[max(head), max(tail), min(tail), \
+		   fliplr(min(head)),  max(head(:,1))]';
+      else
+      	y(:,chan)=[max(head), fliplr(min(head)), max(head(:,1))]';
+      endif
+    endfor
+  else
+    error("auplot_format must be 'outline', 'filled', 'sampled' or 'direct'");
+  endif
+
+  t=t+offset*1000/fs;
+  grid;
+  if channels > 1
+    scale = max(abs(y(:)));
+    if (scale > 0) y=y/scale; endif
+    for i=1:channels
+      y(:,i) = y(:,i) + 2*(i-1);
+    end
+  else
+    scale = 1;
+  end
+
+  if nargout >= 1, y_r = y; endif
+  if nargout >= 2, t_r = t; endif
+  if nargout >= 3, scale_r = scale; endif
+  if nargout == 0
+    if channels > 1
+      unwind_protect ## protect plot state
+      	ylabel(sprintf('signal scaled by %f', scale));
+      	axis([min(t), max(t), -1, 2*channels-1]);
+      	plot(t,y,plotstr);
+      unwind_protect_cleanup
+      	axis(); ylabel("");
+      end_unwind_protect
+    else
+      plot(t,y,plotstr);
+    end
+  endif
+end
+
+%!demo
+%! [x, fs] = auload(file_in_loadpath("sample.wav"));
+%! subplot(211); title("single channel"); auplot(x,fs);
+%! subplot(212); title("2 channels, x and 3x"); auplot([x, 3*x], fs);
+%! oneplot(); title("");
+
+%!demo
+%! [x, fs] = auload(file_in_loadpath("sample.wav"));
+%! global auplot_points; pts=auplot_points; 
+%! global auplot_format; fmt=auplot_format;
+%! auplot_points=300;
+%! subplot(221); title("filled"); auplot_format="filled"; auplot(x,fs);
+%! subplot(223); title("outline"); auplot_format="outline"; auplot(x,fs);
+%! auplot_points=900;
+%! subplot(222); title("sampled"); auplot_format="sampled"; auplot(x,fs);
+%! subplot(224); title("direct"); auplot_format="direct"; auplot(x,fs);
+%! auplot_format=fmt; auplot_points=pts; title(""); oneplot();
+
+%!demo
+%! [x, fs] = auload(file_in_loadpath("sample.wav"));
+%! title("subrange example"); auplot(au(x,fs,300,450),fs)
+%! title("");
+
+%!error auplot
+%!error auplot(1,2,3,4,5)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/aurecord.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,493 @@
+/*
+ * HISTORY:
+ *    May, 1999 - separate audio open/close from wave play
+ *    Feb. 1999 - first public release.
+ *
+ * Copyright 1999 Paul Kienzle, <pkienzle@cs.indiana.edu>
+ * This source code is freely redistributable and may be used for
+ * any purpose.  This copyright notice must be maintained. 
+ * Paul Kienzle is not responsible for the consequences of using
+ * this software.
+## TODO: Support SGI, Sun and Windows devices
+## TODO: Clean up user interaction, possibly adding GUI support
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <sys/ioctl.h>
+#include <signal.h>
+#include <X11/X.h>
+#include <X11/Xlib.h>
+#include "endpoint.h" 
+
+/* ==================================================================== */
+/* Input conversion routines (audio file -> machine representation) */
+
+/* Read a 2 byte signed integer in little endian (Intel) format */
+static int from_S16_LE(char *buf, short *sample)
+{
+#if __BYTE_ORDER == __BIG_ENDIAN
+  {
+    char t;
+    t = buf[0]; buf[0] = buf[1]; buf[1] = t;
+  }
+#endif
+  *sample = *(short *)buf;
+  return 2;
+}
+
+/* Read a 2 byte signed integer in big endian (non-Intel) format */
+static int from_S16_BE(char *buf, short *sample)
+{
+#if __BYTE_ORDER == __LITTLE_ENDIAN
+  {
+    char t;
+    t = buf[0]; buf[0] = buf[1]; buf[1] = t;
+  }
+#endif
+  *sample = *(short *)buf;
+  return 2;
+}
+
+
+/* Read a 2 byte unsigned integer in little endian (Intel) format */
+static int from_U16_LE(char *buf, short *sample)
+{
+#if __BYTE_ORDER == __BIG_ENDIAN
+  {
+    char t;
+    t = buf[0]; buf[0] = buf[1]; buf[1] = t;
+  }
+#endif
+  *sample = (short)((long)(*(unsigned short *)buf) - 32768);
+  return 2;
+}
+
+/* Read a 2 byte unsigned integer in big endian (non-Intel) format */
+static int from_U16_BE(char *buf, short *sample)
+{
+#if __BYTE_ORDER == __LITTLE_ENDIAN
+  {
+    char t;
+    t = buf[0]; buf[0] = buf[1]; buf[1] = t;
+  }
+#endif
+  *sample = (short)((long)(*(unsigned short *)buf) - 32768);
+  return 2;
+}
+
+/* Read a 1 byte aLaw compressed value and convert to 2 byte signed integer */
+static int from_A_LAW(char *buf, short *sample)
+{
+  static short alaw[] = {
+    -5504,  -5248,  -6016,  -5760,  -4480,  -4224,  -4992,  -4736,
+    -7552,  -7296,  -8064,  -7808,  -6528,  -6272,  -7040,  -6784,
+    -2752,  -2624,  -3008,  -2880,  -2240,  -2112,  -2496,  -2368,
+    -3776,  -3648,  -4032,  -3904,  -3264,  -3136,  -3520,  -3392,
+    -22016, -20992, -24064, -23040, -17920, -16896, -19968, -18944,
+    -30208, -29184, -32256, -31232, -26112, -25088, -28160, -27136,
+    -11008, -10496, -12032, -11520,  -8960,  -8448,  -9984,  -9472,
+    -15104, -14592, -16128, -15616, -13056, -12544, -14080, -13568,
+    -344,   -328,   -376,   -360,   -280,   -264,   -312,   -296,
+    -472,   -456,   -504,   -488,   -408,   -392,   -440,   -424,
+    -88,    -72,   -120,   -104,    -24,     -8,    -56,    -40,
+    -216,   -200,   -248,   -232,   -152,   -136,   -184,   -168,
+    -1376,  -1312,  -1504,  -1440,  -1120,  -1056,  -1248,  -1184,
+    -1888,  -1824,  -2016,  -1952,  -1632,  -1568,  -1760,  -1696,
+    -688,   -656,   -752,   -720,   -560,   -528,   -624,   -592,
+    -944,   -912,  -1008,   -976,   -816,   -784,   -880,   -848 };
+  unsigned char t;
+
+  t = *(unsigned char *)buf;
+  if (t>=128) *sample = -alaw[t&0x7F];
+  else *sample = alaw[t&0x7F];
+  return 1;
+}
+
+/* Read a 1 byte uLaw compressed value and convert to 2 byte signed integer */
+static int from_MU_LAW(char *buf, short *sample)
+{
+  static short ulaw[] = {
+    -32124, -31100, -30076, -29052, -28028, -27004, -25980, -24956,
+    -23932, -22908, -21884, -20860, -19836, -18812, -17788, -16764,
+    -15996, -15484, -14972, -14460, -13948, -13436, -12924, -12412,
+    -11900, -11388, -10876, -10364,  -9852,  -9340,  -8828,  -8316,
+    -7932,  -7676,  -7420,  -7164,  -6908,  -6652,  -6396,  -6140,
+    -5884,  -5628,  -5372,  -5116,  -4860,  -4604,  -4348,  -4092,
+    -3900,  -3772,  -3644,  -3516,  -3388,  -3260,  -3132,  -3004,
+    -2876,  -2748,  -2620,  -2492,  -2364,  -2236,  -2108,  -1980,
+    -1884,  -1820,  -1756,  -1692,  -1628,  -1564,  -1500,  -1436,
+    -1372,  -1308,  -1244,  -1180,  -1116,  -1052,   -988,   -924,
+    -876,   -844,   -812,   -780,   -748,   -716,   -684,   -652,
+    -620,   -588,   -556,   -524,   -492,   -460,   -428,   -396,
+    -372,   -356,   -340,   -324,   -308,   -292,   -276,   -260,
+    -244,   -228,   -212,   -196,   -180,   -164,   -148,   -132,
+    -120,   -112,   -104,    -96,    -88,    -80,    -72,    -64,
+    -56,    -48,    -40,    -32,    -24,    -16,     -8,      0};
+  unsigned char t;
+
+  t = *(unsigned char *)buf;
+  if (t>=128) *sample = -ulaw[t&0x7F];
+  else *sample = ulaw[t&0x7F];
+  return 1;
+}
+
+/* Read a 1 byte unsigned value and convert to 2 byte signed integer */
+static int from_U8(char *buf, short *sample)
+{
+  unsigned char t;
+
+  t = *(unsigned char *)buf;
+  *sample = (t-128)<<8;
+  return 1;
+}
+
+/* Read a 1 byte unsigned value and convert to 2 byte signed integer */
+static int from_S8(char *buf, short *sample)
+{
+  unsigned char t;
+
+  t = *(unsigned char *)buf;
+  *sample = t<<8;
+  return 1;
+}
+
+/* ===================================================================== */
+/* Audio device routines */
+
+/* Okay, now for the OS specific audio code:
+ *
+ * audioopen(int rate, int channels) returns true if the audio device
+ * has been opened.  This routine must set the global variables
+ * audiorate and audiochannels to the actual rate and channels
+ * selected for the device which may be different from those
+ * requested.  This routine must also set audioconvert, the function
+ * which takes the machine representation for samples (2 byte signed
+ * integers) and converts them to the audio format specified for the
+ * audio device.
+ *
+ * audioplay(void *data, int length) returns true if data was played.
+ * The data has already been converted to the correct rate, number of
+ * channels and audio format for the device.  The length is the number
+ * of BYTES to play (not the number of samples).
+ *
+ * audioclose() closes the audio device.  */
+
+typedef int (*CONVERSION)(char *buf, short *sample);
+static CONVERSION audioconvert;
+static int audiorate;
+static int audiochannels;
+
+/* ==================================================================== */
+#if 1  /* LINUX OSS audio drivers */
+#include <linux/soundcard.h>
+
+static int audio = -1;
+int audioopen(int rate, int channels)
+{
+  int format, outformat, mask;
+
+  /* Open audio device */
+  audio = open("/dev/dsp", O_RDONLY);
+  if (audio < 0) return -1;
+
+  /* Set channels (mono vs. stereo) and remember what was set */
+  --channels;
+  if (ioctl(audio, SNDCTL_DSP_STEREO, &channels) < 0) goto error;
+  audiochannels = channels+1;
+
+  /* Set input format. Convert to a format which preserves the most
+   * bits if the selected format is unavailable.
+   */
+#if __BYTE_ORDER == __LITTLE_ENDIAN
+  outformat = format = AFMT_S16_LE, audioconvert=from_S16_LE;
+#else
+  outformat = format = AFMT_S16_BE, audioconvert=from_S16_BE;
+#endif
+  if (ioctl(audio, SNDCTL_DSP_SETFMT, &outformat) < 0) goto error;
+  if (outformat != format) {
+    if (ioctl(audio, SNDCTL_DSP_GETFMTS, &mask) < 0) goto error;
+    if (mask&AFMT_S16_LE)      format = AFMT_S16_LE, audioconvert=from_S16_LE;
+    else if (mask&AFMT_S16_BE) format = AFMT_S16_BE, audioconvert=from_S16_BE;
+    else if (mask&AFMT_U16_LE) format = AFMT_U16_LE, audioconvert=from_U16_LE;
+    else if (mask&AFMT_U16_BE) format = AFMT_U16_BE, audioconvert=from_U16_BE;
+    else if (mask&AFMT_MU_LAW) format = AFMT_MU_LAW, audioconvert=from_MU_LAW;
+    else if (mask&AFMT_A_LAW)  format = AFMT_A_LAW,  audioconvert=from_A_LAW;
+    else if (mask&AFMT_U8)     format = AFMT_U8,     audioconvert=from_U8;
+    else if (mask&AFMT_S8)     format = AFMT_S8,     audioconvert=from_S8;
+    else goto error;
+    if (ioctl(audio, SNDCTL_DSP_SETFMT, &format) < 0) goto error;
+  }
+
+  /* Set sample rate and remember what was set. */
+  if (ioctl(audio, SNDCTL_DSP_SPEED, &rate) < 0) goto error;
+  audiorate = rate;
+  return 1;
+
+error:
+  close(audio);
+  return 0;
+}
+
+static short audiosample()
+{
+  static char buf[2048];
+  static int bufpos = sizeof(buf);
+  int len;
+  short sample;
+
+  if (bufpos >= sizeof(buf)) {
+    len = read(audio, buf, sizeof(buf));
+    while (len < sizeof(buf)) buf[len++] = 0;
+    bufpos = 0;
+  }
+  bufpos += (*audioconvert)(buf+bufpos, &sample);
+  return sample;
+}
+
+void audioclose()
+{
+  close(audio);
+  audio = -1;
+}
+
+void audioabort() 
+{
+  if (audio != -1) {
+    ioctl(audio, SNDCTL_DSP_RESET, NULL);
+    audioclose();
+  }
+}
+#endif
+
+
+
+#if 0
+// This is an attempt at showing the capture interaction in an X window,
+// programmed in raw Xlib.  It doesn't work yet.  Instead, the interaction
+// is done on stderr.  Too bad *Inferior Octave* doesn't handle ^M properly.
+void inform(char str[])
+{
+  static int first = 1;
+  static Display *display = NULL;
+  static int screen;
+  static Window window;
+  static GC gc;
+  static XFontStruct *fontstruct;
+  static Font font; 
+
+  if (display == NULL && !first) return;
+  if (first) {
+    XGCValues gcvalues;
+
+    first = 0;
+    if (str == NULL) return;
+    display = XOpenDisplay(NULL);
+    if (display == NULL) return;
+    screen = DefaultScreen(display);
+    gc = XDefaultGC(display,screen);
+    XGetGCValues(display, gc, GCFont, &gcvalues);
+    //    font = gcvalues.font;
+    //    fontstruct = XQueryFont(display, font);
+    window = XCreateWindow(display, XDefaultRootWindow(display),
+			   0,0,640,20,2,
+			   CopyFromParent, InputOutput, CopyFromParent, 
+			   0, NULL);
+    XStoreName(display, window, "Audio Capture");
+    XMapWindow(display, window);
+  }
+
+  if (str == NULL) {
+    XDestroyWindow(display, window);
+    XCloseDisplay(display);
+  }
+  else {
+    XTextItem txt;
+
+    XClearArea(display, window, 0, 0, 640, 20, 1);
+    txt.chars = str;
+    txt.nchars = strlen(str);
+    txt.delta = 1;
+    txt.font = None;
+    //    XDrawText(display, window, gc, 0, 20-fontstruct->descent, &txt, 1);
+  }
+}
+#else
+void inform(char *str)
+{
+  if (str != NULL) {
+#if 0
+    fprintf(stderr, "\r%-38s", str);
+#else
+    fprintf(stderr, "%s\n", str);
+#endif
+  }
+  else
+    fprintf(stderr, "\n");
+}
+#endif
+
+int capture(int rate, short *capturebuf, int capturelen)
+{
+  // Note: initial silence is WINDOW+2*STEP
+  const float STEP=0.010;	        // step size in sec
+  const float WINDOW=0.016;	// window size in sec
+  const long ENDSILENCE=700;      // duration of end silence in msec 
+  const long MINLENGTH=300;       // minimum utterance in msec
+  
+  endpointer *ep;
+  int framelen, framestep;
+  short *frame;
+  int framenumber=0; /* Currently active frame number */
+  int framepos = 0;
+  int capturepos, captureend, remaining;
+  EPTAG tag, state=EP_RESET;
+
+  /* initialize capture */
+  framelen = (int)(WINDOW*(float)rate);
+  framestep = (int)(STEP*(float)rate);
+  frame = new short[framelen];
+  ep = new endpointer(rate, framestep, framelen, ENDSILENCE, MINLENGTH);
+
+  while (1) {
+    /* Fill the next frame */
+    while (framepos < framelen) frame[framepos++] = audiosample();
+    framenumber++;
+
+    /* Process frame through the end point detector */
+    tag = ep -> getendpoint (frame);// get endpoint tag
+#if 0
+    fprintf(stderr, "     tag=%s, state=%s\n", 
+	    ep->gettagname(tag), ep->gettagname(state));
+#endif
+    switch (tag) {	// determine what to do with this frame
+    case EP_NOSTARTSILENCE:	// error condition --- restart process
+      if (tag == EP_NOSTARTSILENCE)
+	inform("Spoke too soon. Wait a bit and try again...");
+      ep->initendpoint();
+      framenumber = 0;
+      // fall through to RESET
+      
+    case EP_RESET:		// false start --- restart recognizer
+      // fall through to SILENCE
+      
+    case EP_SILENCE:		// not yet start of utterance
+      if (state != EP_SILENCE && framenumber > 3) {
+	inform("Waiting for you to speak...");
+	state = EP_SILENCE;
+      }
+      capturepos = 0;
+      break;
+      
+    case EP_MAYBEEND:		// possible end of utterance
+      if (tag == EP_MAYBEEND) captureend = capturepos;
+      // fall through to SIGNAL
+      
+      
+    case EP_NOTEND:		// the last MAYBEEND was NOT the end 
+      if (tag == EP_NOTEND) captureend = 0;
+      // fall through to SIGNAL
+      
+    case EP_INUTT:		// confirmed signal start
+      // all data frames before this marked as EP_SIGNAL were part
+      // of the actual utterance.  A reset after this point will be
+      // due to a rejected signal rather than a false start.
+      if (state != EP_INUTT) {
+	inform("Capturing your speech...");
+	state = EP_INUTT;
+      }
+      // fall through to SIGNAL
+      
+    case EP_SIGNAL:		// signal frame
+      // Copy frame into capture buf.
+      remaining = capturelen - capturepos;
+      if (remaining > framestep) remaining = framestep;
+      if (remaining > 0) 
+	memcpy(capturebuf+capturepos, frame, remaining*sizeof(*frame));
+      capturepos += remaining;
+      
+      // Check for end of capture buf.
+      if (capturepos == capturelen) {
+	if (captureend == 0) captureend = capturepos;
+	inform("Speech exceeded capture duration. Use -t to increase.");
+	inform(NULL);
+	return captureend;
+      }
+      break;
+      
+    case EP_ENDOFUTT:		// confirmed end of utterance
+      // This is a silence frame after the end of signal.  The previous
+      // MAYBEEND frame was the actual end of utterance
+      inform(NULL);
+      return captureend;
+    }
+
+    /* Shift the frame overlap to the start of the frame. */
+    framepos = framelen - framestep;
+    memmove(frame, frame+framestep, framepos*sizeof(*frame));
+  }
+
+  return 0;
+}
+
+
+void cleanup(int sig)
+{
+  audioabort();
+  exit(2);
+}
+
+int main(int argc, char *argv[]) 
+{
+   int do_endpoint = 0;
+   int rate=16000, channels=1;
+   double time=1;
+   short *buf;
+   int i, c, samples;
+
+
+   /* Interpret options */
+   do {
+     c = getopt(argc, argv, "et:r:c:?");
+     switch (c) {
+     case 'e': do_endpoint = 1; break;
+     case 'r': rate = atoi(optarg); break;
+     case 'c': channels = atoi(optarg); break;
+     case 't': time = atof(optarg); break;
+     case '?': 
+       fprintf (stderr, "usage: aurecord [-t time] [-r rate] [-c channels]\n");
+       exit(1);
+     }
+   } while (c != EOF);
+  
+   /* Prepare for interrupt. */
+   signal(SIGINT, cleanup);
+
+   /* open audio device and skip the first bunch of samples */
+   if (audioopen(rate, channels) < 0) return 1;
+   for (i = 0; i < 1024; i++) audiosample();
+
+   fwrite(&audiorate, 4, 1, stdout);
+   fwrite(&audiochannels, 4, 1, stdout);
+   samples = (long)((double)audiorate * time)*audiochannels;
+   buf = new short[samples];
+
+   if (do_endpoint) {
+     /* wait for audio event before grabbing samples */
+     samples = capture(audiorate, buf, samples);
+   }
+   else {
+     /* grab all the samples you need directly */
+     for (i = 0; i < samples; i++) buf[i] = audiosample();
+   }
+
+   /* close the audio device */
+   audioclose();
+
+   /* output the captured samples */
+   fwrite(buf, 2, samples, stdout);
+   return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/aurecord.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,51 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [x, fs] = aurecord(t, fs, channels)
+##
+## Record for the specified time at the given sample rate. Note that
+## the sample rate used may not match the requested sample rate.  Use
+## the returned rate instead of the requested value in further
+## processing. Similarly, the actual number of samples and channels
+## may not match the request, so check the size of the returned matrix.
+##
+## Fs defaults to 8000 Hz and channels defaults to 1. Time is measured
+## in seconds.
+
+## TODO: Consider converting into record.m
+## TODO: Consider making this a .oct file, incorporating aurecord.cc
+## TODO: Consider using aurecord_command='record %s', and read signal from /tmp/blah.wav
+function [data, rate] = aurecord(time, rate, channels)
+
+  if nargin<1 || nargin>3
+    usage("[x, fs] = aurecord(t [, fs, channels])");
+  end
+  if nargin<2, rate = 8000; end;
+  if nargin<3, channels = 1; end;
+
+  fid=popen(sprintf("aurecord -r %d -c %d -t %f", rate, channels, \
+		    time), "r");
+  rate = fread(fid, 1, 'long');
+  channels = fread(fid, 1, 'long');
+  if channels == 0
+    pclose(fid);
+    error("aurecord failed -- perhaps audio device is in use?\n");
+  end;
+  data = fread(fid, Inf, 'short');
+  if size(data,1) > 0 
+    data = reshape(data'/32768, length(data)/channels, channels);
+  end
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/ausave.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,228 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: ausave('filename.ext', x, fs, format)
+##
+## Writes an audio file with the appropriate header. The extension on
+## the filename determines the layout of the header. Currently supports
+## .wav and .au layouts.  Data is a matrix of audio samples, one row
+## time step, one column per channel. Fs defaults to 8000 Hz.  Format
+## is one of ulaw, alaw, char, short, long, float, double
+function ausave(path, data, rate, sampleformat)
+
+  if nargin < 2 || nargin>4
+    usage("ausave('filename.ext', x [, fs, sampleformat])");
+  end
+  if nargin < 3, rate = 8000; end
+  if nargin < 4, sampleformat = 'short'; end
+
+  ext = rindex(path, '.');
+  if (ext == 0)
+    usage("ausave('filename.ext', x [, fs, sampleformat])");
+  end
+  ext = tolower(substr(path, ext+1, length(path)-ext));
+
+  [samples, channels] = size(data);
+
+  ## Microsoft .wav format
+  if strcmp(ext,'wav') 
+
+    ## Header format obtained from sox/wav.c
+    ## April 15, 1992
+    ## Copyright 1992 Rick Richardson
+    ## Copyright 1991 Lance Norskog And Sundry Contributors
+    ## This source code is freely redistributable and may be used for
+    ## any purpose.  This copyright notice must be maintained. 
+    ## Lance Norskog And Sundry Contributors are not responsible for 
+    ## the consequences of using this software.
+
+    if (strcmp(sampleformat,'uchar'))
+      formatid = 1;
+      samplesize = 1;
+    elseif (strcmp(sampleformat,'short'))
+      formatid = 1;
+      samplesize = 2;
+    elseif (strcmp(sampleformat, 'long'))
+      formatid = 1;
+      samplesize = 4;
+    elseif (strcmp(sampleformat, 'alaw'))
+      formatid = 6;
+      samplesize = 1;
+    elseif (strcmp(sampleformat, 'ulaw'))
+      formatid = 7;
+      samplesize = 1;
+    else
+      error("%s is invalid format for .wav file\n", sampleformat);
+    end
+    datasize = channels*samplesize*samples;
+
+    [file, msg] = fopen(path, 'w');
+    if (file == -1)
+      error("%s: %s", msg, path);
+    end
+
+    ## write the magic header
+    arch = 'ieee-le';
+    fwrite(file, toascii('RIFF'), 'char');
+    fwrite(file, datasize+36, 'long', 0, arch);
+    fwrite(file, toascii('WAVE'), 'char');
+
+    ## write the "fmt " section
+    fwrite(file, toascii('fmt '), 'char');
+    fwrite(file, 16, 'long', 0, arch);
+    fwrite(file, formatid, 'short', 0, arch);
+    fwrite(file, channels, 'short', 0, arch);
+    fwrite(file, rate, 'long', 0, arch);
+    fwrite(file, rate*channels*samplesize, 'long', 0, arch);
+    fwrite(file, channels*samplesize, 'short', 0, arch);
+    fwrite(file, samplesize*8, 'short', 0, arch);
+
+    ## write the "data" section
+    fwrite(file, toascii('data'), 'char');
+    fwrite(file, datasize, 'long', 0, arch);
+
+  ## Sun .au format
+  elseif strcmp(ext, 'au')
+
+    ## Header format obtained from sox/au.c
+    ## September 25, 1991
+    ## Copyright 1991 Guido van Rossum And Sundry Contributors
+    ## This source code is freely redistributable and may be used for
+    ## any purpose.  This copyright notice must be maintained. 
+    ## Guido van Rossum And Sundry Contributors are not responsible for 
+    ## the consequences of using this software.
+
+    if (strcmp(sampleformat, 'ulaw'))
+      formatid = 1;
+      samplesize = 1;
+    elseif (strcmp(sampleformat,'uchar'))
+      formatid = 2;
+      samplesize = 1;
+    elseif (strcmp(sampleformat,'short'))
+      formatid = 3;
+      samplesize = 2;
+    elseif (strcmp(sampleformat, 'long'))
+      formatid = 5;
+      samplesize = 4;
+    elseif (strcmp(sampleformat, 'float'))
+      formatid = 6;
+      samplesize = 4;
+    elseif (strcmp(sampleformat, 'double'))
+      formatid = 7;
+      samplesize = 8;
+    else
+      error("%s is invalid format for .au file\n", sampleformat);
+    end
+    datasize = channels*samplesize*samples;
+
+    [file, msg] = fopen(path, 'w');
+    if (file == -1)
+      error("%s: %s", msg, path);
+    end
+
+    arch = 'ieee-be';
+    fwrite(file, toascii('.snd'), 'char');
+    fwrite(file, 24, 'long', 0, arch);
+    fwrite(file, datasize, 'long', 0, arch);
+    fwrite(file, formatid, 'long', 0, arch);
+    fwrite(file, rate, 'long', 0, arch);
+    fwrite(file, channels, 'long', 0, arch);
+
+  ## Apple/SGI .aiff format
+  elseif strcmp(ext,'aiff')
+
+    ## Header format obtained from sox/aiff.c
+    ## September 25, 1991
+    ## Copyright 1991 Guido van Rossum And Sundry Contributors
+    ## This source code is freely redistributable and may be used for
+    ## any purpose.  This copyright notice must be maintained. 
+    ## Guido van Rossum And Sundry Contributors are not responsible for 
+    ## the consequences of using this software.
+    ##
+    ## IEEE 80-bit float I/O taken from
+    ##        ftp://ftp.mathworks.com/pub/contrib/signal/osprey.tar
+    ##        David K. Mellinger
+    ##        dave@mbari.org
+    ##        +1-831-775-1805
+    ##        fax       -1620
+    ##        Monterey Bay Aquarium Research Institute
+    ##        7700 Sandholdt Road
+
+    if (strcmp(sampleformat,'uchar'))
+      samplesize = 1;
+    elseif (strcmp(sampleformat,'short'))
+      samplesize = 2;
+    elseif (strcmp(sampleformat, 'long'))
+      samplesize = 4;
+    else
+      error("%s is invalid format for .aiff file\n", sampleformat);
+    end
+    datasize = channels*samplesize*samples;
+
+    [file, msg] = fopen(path, 'w');
+    if (file == -1)
+      error("%s: %s", msg, path);
+    end
+
+    ## write the magic header
+    arch = 'ieee-be';
+    fwrite(file, toascii('FORM'), 'char');
+    fwrite(file, datasize+46, 'long', 0, arch);
+    fwrite(file, toascii('AIFF'), 'char');
+
+    ## write the "COMM" section
+    fwrite(file, toascii('COMM'), 'char');
+    fwrite(file, 18, 'long', 0, arch);
+    fwrite(file, channels, 'short', 0, arch);
+    fwrite(file, samples, 'long', 0, arch);
+    fwrite(file, 8*samplesize, 'short', 0, arch);
+    fwrite(file, 16414, 'ushort', 0, arch);         % sample rate exponent
+    fwrite(file, [rate, 0], 'ulong', 0, arch);       % sample rate mantissa
+
+    ## write the "SSND" section
+    fwrite(file, toascii('SSND'), 'char');
+    fwrite(file, datasize+8, 'long', 0, arch); # section length
+    fwrite(file, 0, 'long', 0, arch); # block size
+    fwrite(file, 0, 'long', 0, arch); # offset
+
+  ## file extension unknown
+  else
+    error('ausave(filename.ext,...) understands .wav .au and .aiff only');
+  end
+
+  ## convert samples from range [-1, 1)
+  if strcmp(sampleformat, 'alaw')
+    error("FIXME: ausave needs linear to alaw conversion\n");
+    precision = 'uchar';
+  elseif strcmp(sampleformat, 'ulaw')
+    data = lin2mu(data);
+    precision = 'uchar'
+  elseif strcmp(sampleformat, 'uchar')
+    data = data*128 + 128;
+    precision = 'uchar';
+  elseif strcmp(sampleformat, 'short')
+    data = data*32768;
+    precision = 'short';
+  elseif strcmp(sampleformat, 'long')
+    data = data*2^31;
+    precision = 'long';
+  else
+    precision = sampleformat;
+  end
+  fwrite(file, data', precision, 0, arch);
+  fclose(file);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/clip.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,63 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Clip values outside the range to the value at the boundary of the
+## range.
+##
+## X = clip(X)
+##   Clip to range [0, 1]
+##
+## X = clip(X, hi)
+##   Clip to range [0, hi]
+##
+## X = clip(X, [lo, hi])
+##   Clip to range [lo, hi]
+
+## TODO: more clip modes, such as three level clip(X, [lo, mid, hi]), which
+## TODO: sends everything above hi to hi, below lo to lo and between to
+## TODO: mid; or infinite peak clipping, which sends everything above mid
+## TODO: to hi and below mid to lo.
+
+function x = clip (x, range)
+
+  if (nargin == 2)
+    if (length(range) == 1)
+      range = [0, range];
+    end
+  elseif (nargin == 1)
+    range = [0, 1];
+  else
+    usage("X = clip(X [, range])");
+  end
+  dfi = do_fortran_indexing;
+  unwind_protect
+    do_fortran_indexing = 1;
+    x (find (x > range (2))) = range (2);
+    x (find (x < range (1))) = range (1);
+  unwind_protect_cleanup
+    do_fortran_indexing = dfi;
+  end_unwind_protect
+
+endfunction
+
+%!error clip
+%!error clip(1,2,3)
+%!assert (clip(pi), 1)
+%!assert (clip(-pi), 0)
+%!assert (clip([-1.5, 0, 1.5], [-1, 1]), [-1, 0, 1]);
+%!assert (clip([-1.5, 0, 1.5]', [-1, 1]'), [-1, 0, 1]');
+%!assert (clip([-1.5, 1; 0, 1.5], [-1, 1]), [-1, 1; 0, 1]);
+%!assert (isempty(clip([],1)));
Binary file main/audio/data/sample.wav has changed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/endpoint.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,462 @@
+//
+// ENDPOINT.CC - The endpoint class member routines.
+//
+// Bruce T. Lowerre, Public domain, 1995, 1997
+//
+// $Log$
+// Revision 1.1  2001/10/10 19:54:49  pkienzle
+// Initial revision
+//
+// Revision 1.1  2001/04/22 08:29:30  pkienzle
+// adding in all of matcompat
+//
+// Revision 1.4  2001/03/22 Paul Kienzle
+// added #include <math.h>
+//
+// Revision 1.3  1997/07/31 18:32:13  lowerre
+// fixed bug with EP_INUTT
+//
+// Revision 1.2  1997/05/23 20:01:32  lowerre
+// renamed endpoint to endpointer, conflicts with <rpcsvc/nis.h>
+//
+// Revision 1.1  1997/05/14 20:34:38  lowerre
+// Initial revision
+//
+//
+//
+
+
+/* The endpointer is used to determine the start and end of a live
+ * input signal.  Unlike a pre-recorded utterance, a live input signal
+ * is open-ended in that the actual start and end of the signal is
+ * totally unknown.  The search will usually do a fairly good job of
+ * guessing the start of the signal.  However, the actual end of the
+ * signal is unknown to the recognizer.  Reaching the end state in the
+ * recognizer does not necessarily mean the end of signal.  Therefore,
+ * the end of signal must be calculated by some means.  This is the
+ * job of the end point detector.  This module is accessed via a class
+ * structure.  It should be called for each frame of data to determine
+ * what processing should be done.
+ *
+ * The endpointer uses "cheap" signal processing features (energy and
+ * zero cross count) and is intended to run constantly on a host
+ * processor without the need of a DSP or high speed processor.  When
+ * the start of the utterance is detected, then the expensive search
+ * can be called.
+ *
+ * The endpointer is designed to run with a real-time processing
+ * search.  That means that the live input signal is processed in
+ * real-time while it's being read.  Therefore, the start of signal
+ * will occur (and the search will start) before the entire utterance
+ * has been read.  The ramifications of this is that the endpointer
+ * has to guess as to the possible start and end of utterance.  These
+ * guesses, frame labels, are used by other modules to guide the
+ * utterance capture and search.  The endpointer may realize that it
+ * has mis-labeled either the start of utterance or the end of
+ * utterance.  When this happens, a special frame label (either
+ * EP_RESET if a false start was detected or EP_NOTEND if a false end
+ * was detected) is returned.
+ *
+ * The algorithms used in this module have evolved from 20 years of
+ * work with live input signals.  */
+
+
+#include <iostream>
+#include <cmath>
+#include "endpoint.h"
+
+
+/* ENDPOINTER::ENDPOINTER - class constructor, set initial values */
+endpointer::endpointer
+(
+    long	d_samprate,		// sampling rate in Hz
+    long	d_windowsize,		// windowsize in samples
+    long	d_stepsize,		// step size in samples
+    long	d_maxipause,		// default ending silence in msec
+    long	d_minuttlng,		// default minuttlng in msec
+    long	d_zcthresh,		// default zcthresh, Hz
+    float	d_begfact,		// default begfact
+    float	d_endfact,		// default endfact
+    float	d_energyfact,		// default energyfact
+    float	d_minstartsilence,	// default minstartsilence
+    float	d_triggerfact,		// default triggerfact
+    long	d_numdpnoise,		// default numdpnoise
+    long	d_minfriclng,		// default minfriclng in msec
+    long	d_maxpause,		// default maxpause in msec
+    long	d_startblip,		// default startblip in msec
+    long	d_endblip,		// default endblip in msec
+    long	d_minvoicelng,		// default minvoicelng in msec
+    long	d_minrise		// default minrise in msec
+)
+{
+    long	i;
+
+    samprate = d_samprate;
+    windowsize = d_windowsize;
+    stepsize = d_stepsize;
+    maxipause = (d_maxipause * samprate) / (1000 * stepsize); // num steps
+    minuttlng = (d_minuttlng * samprate) / (1000 * stepsize); // num steps
+    zcthresh = (d_zcthresh * stepsize) / samprate; // per frame
+    begfact = d_begfact;
+    endfact = d_endfact;
+    energyfact = d_energyfact;
+    minstartsilence = d_minstartsilence;
+    numdpnoise = d_numdpnoise;
+    triggerfact = d_triggerfact;
+    minfriclng = (d_minfriclng * samprate) / (1000 * stepsize);   // num steps
+    maxpause = (d_maxpause * samprate) / (1000 * stepsize);       // num steps
+    startblip = (d_startblip * samprate) / (1000 * stepsize);     // num steps
+    endblip = (d_endblip * samprate) / (1000 * stepsize);         // num steps
+    minvoicelng = (d_minvoicelng * samprate) / (1000 * stepsize); // num steps
+    minrise = (d_minrise * samprate) / (1000 * stepsize);         // num steps
+    lastdpnoise = new float[numdpnoise];
+    for (i = 0; i < numdpnoise; i++)
+        lastdpnoise[i] = 0.0;
+    initendpoint ();
+} // end endpointer::endpointer
+
+
+/* ENDPOINTER::~ENDPOINTER - class destructor */
+endpointer::~endpointer ()
+{
+    delete []lastdpnoise;
+} // end endpointer::~endpointer
+
+
+/* ENDPOINT::INITENDPOINT - initialize the endpoint variables */
+void endpointer::initendpoint ()
+{
+    long	i;
+
+    epstate = NOSILENCE;
+    noise = 0.0;
+    ave = 0.0;
+    begthresh = 0.0;
+    endthresh = begthresh;
+    energy = 0.0;
+    maxpeak = 0.0;
+    scnt = 0;
+    vcnt = 0;
+    evcnt = 0;
+    voicecount = 0;
+    zccnt = 0;
+    bscnt = 0;
+    startframe = 0;
+    endframe = 0;
+    avescnt = 0;
+    startsilenceok = false;
+    ncount = 0;
+    low = true;
+    for (i = 0; i < numdpnoise; i++)
+        lastdpnoise[i] = 0.0;
+} // end endpointer::initendpoint
+
+
+void endpointer::setnoise ()
+{
+    dpnoise = lastdpnoise[1] = lastdpnoise[0];
+    ncount = 2;
+} // end endpointer::setnoise
+
+
+/* ENDPOINT::AVERAGENOISE - get average background noise level and
+ * shift noise array */
+void endpointer::averagenoise ()
+{
+    long	i;
+
+    for (dpnoise = 0.0, i = ncount - 1; i > 0; i--)
+    {
+        dpnoise += lastdpnoise[i];
+        lastdpnoise[i] = lastdpnoise[i - 1];
+    }
+    dpnoise = (dpnoise + lastdpnoise[0]) / ncount;
+    if (ncount < numdpnoise)
+        ncount ++;
+} // end endpointer::averagenoise
+
+
+/* ENDPOINT::ZCPEAKPICK - get the zero cross count and average energy */
+void endpointer::zcpeakpick
+(
+    short	*samples			// raw samples
+)
+{
+    long	i;
+    float	sum,
+		trigger;
+    short	*smp;
+
+    for (sum = 0.0, i = 0, smp = samples; i < windowsize; i++, smp++)
+        sum += *smp * *smp;
+    peakreturn = (sqrt (sum / windowsize));
+    lastdpnoise[0] = peakreturn;
+
+    if (ncount == 0)
+        dpnoise = peakreturn;			// initial value
+    trigger = dpnoise * triggerfact;		// schmidt trigger band
+
+    for (i = 0, zc = 0, smp = samples; i < windowsize; i++, smp++)
+    {
+        if (low)
+        {
+            if (*smp > trigger)
+            {					// up cross
+                zc++;
+                low = false;			// search for down cross
+            }
+        }
+        else
+        {
+            if (*smp < -trigger)
+            {					// down cross
+                zc++;
+                low = true;			// search for up cross
+            }
+        }
+    }
+} // end endpointer::zcpeakpick
+
+
+/* ENDPOINT::GETENDPOINT - get the endpoint tag for the raw samples
+ * The recognition system is designed to operate in real-time.  That
+ * is, the search proceeds in parallel with input of the signal.  The
+ * endpoint detection must, therefore, make a guess as to what the
+ * current sample is and correct errors that may have been made
+ * previously.  */
+EPTAG endpointer::getendpoint
+(
+    short	*samples			// raw samples
+)
+{
+    float	tmp;
+
+    zcpeakpick (samples);			// get zc count and peak energy
+    if (peakreturn > maxpeak)
+    {
+        maxpeak = peakreturn;
+        if ((tmp = maxpeak / endfact) > endthresh)
+            endthresh = tmp;
+    }
+
+    switch (epstate)
+    {
+        case NOSILENCE:				// start, get background silence
+            ave += peakreturn;
+            if (++scnt <= 3)
+            {					// average 3 frame's worth
+                if (scnt == 1)
+                    setnoise ();
+                else
+                    averagenoise ();
+                if (dpnoise < minstartsilence)
+                {
+                    startsilenceok = true;
+                    ave += peakreturn;
+                    avescnt++;
+                }
+                return (EP_SILENCE);
+            }
+            if (!startsilenceok)
+            {
+                epstate = START;
+                return (EP_NOSTARTSILENCE);
+            }
+            ave /= avescnt;
+            noise = ave;
+            begthresh = noise + begfact;
+            endthresh = begthresh;
+            mnbe = noise * energyfact;
+            epstate = INSILENCE;
+            return (EP_SILENCE);
+
+        case INSILENCE:
+            ave = ((3.0 * ave) + peakreturn) / 4.0;
+            if (peakreturn > begthresh || zc > zcthresh)
+            {					// looks like start of signal
+                energy += peakreturn - noise;
+                if (zc > zcthresh)
+                    zccnt++;
+                if (peakreturn > begthresh)
+                    voicecount++;
+                if (++vcnt > minrise)
+                {
+                    scnt = 0;
+                    epstate = START;		// definitely start of signal
+                }
+                return (EP_SIGNAL);
+            }
+            else
+            {					// still in silence
+                energy = 0.0;
+                if (ave < noise)
+                {
+                    noise = ave;
+                    begthresh = noise + begfact;
+                    endthresh = begthresh;
+                    mnbe = noise * energyfact;
+                }
+                if (vcnt > 0)
+                {			// previous frame was signal
+                    if (++bscnt > startblip || zccnt == vcnt)
+                    {			// Oops, no longer in the signal
+                        noise = ave;
+                        begthresh = noise * begfact;
+                        endthresh = begthresh;
+                        mnbe = noise * energyfact;
+                        vcnt = 0;
+                        zccnt = 0;
+                        bscnt = 0;
+                        voicecount = 0;
+                        startframe = 0;
+                        return (EP_RESET);// not in the signal, ignore previous
+                    }
+                    return (EP_SIGNAL);
+                }
+                zccnt = 0;
+                return (EP_SILENCE);
+            }
+
+         case START:
+             if (peakreturn > begthresh || zc > zcthresh)
+             {				// possible start of signal
+                 energy += peakreturn - noise;
+                 if (zc > zcthresh)
+                     zccnt++;
+                 if (peakreturn > begthresh)
+                     voicecount++;
+                 vcnt += scnt + 1;
+                 scnt = 0;
+                 if (energy > mnbe || zccnt > minfriclng)
+                 {
+                     epstate = INSIGNAL;
+                     return (EP_INUTT);
+                 }
+                 else 
+                     return (EP_SIGNAL);
+             }
+             else
+             if (++scnt > maxpause)
+             {				// signal went low again, false start
+                 vcnt = zccnt = voicecount = 0;
+                 energy = 0.0;
+                 epstate = INSILENCE;
+                 ave = ((3.0 * ave) + peakreturn) / 4.0;
+                 if (ave < noise + begfact)
+                 {			// lower noise level
+                     noise = ave;
+                     begthresh = noise + begfact;
+                     endthresh = begthresh;
+                     mnbe = noise * energyfact;
+                 }
+                 return (EP_RESET);
+             }
+             else 
+	       return (EP_SIGNAL);
+
+        case INSIGNAL:
+            if (peakreturn > endthresh || zc > zcthresh)
+            {				// still in signal
+                if (peakreturn > endthresh)
+                    voicecount++;
+                vcnt++;
+                scnt = 0;
+                return (EP_SIGNAL);
+            }
+            else
+            {				// below end threshold, may be end
+                scnt++;
+                epstate = END;
+                return (EP_MAYBEEND);
+            }
+
+        case END:
+            if (peakreturn > endthresh || zc > zcthresh)
+            {				// signal went up again, may not be end
+                if (peakreturn > endthresh)
+                    voicecount++;
+                if (++evcnt > endblip)
+                {			// back in signal again
+                    vcnt += scnt + 1;
+                    evcnt = 0;
+                    scnt = 0;
+                    epstate = INSIGNAL;
+                    return (EP_NOTEND);
+                }
+                else 
+		  return (EP_SIGNAL);
+            }
+            else
+            if (++scnt > maxipause)
+            {				// silence exceeds inter-word pause
+                if (vcnt > minuttlng && voicecount > minvoicelng)
+                    return (EP_ENDOFUTT);// end of utterance
+                else
+                {			// signal is too short
+                    scnt = vcnt = voicecount = 0;
+                    epstate = INSILENCE;
+                    return (EP_RESET);	// false utterance, keep looking
+                }
+            }
+            else
+            {				// may be an inter-word pause
+                if (peakreturn == 0)
+                    return (EP_ENDOFUTT);// zero filler frame
+                evcnt = 0;
+                return (EP_SIGNAL);	// assume still in signal
+            }
+    }
+} // end endpointer::getendpoint
+
+
+/* ENDPOINT::PRINTVARS: Print variable values */
+void endpointer::printvars ()
+{
+    cout << "endpoint variables:" << endl;
+    cout << "    begfact         " << begfact << endl;
+    cout << "    endblip         " << endblip << endl;
+    cout << "    endfact         " << endfact << endl;
+    cout << "    energyfact      " << energyfact << endl;
+    cout << "    maxipause       " << maxipause << endl;
+    cout << "    maxpause        " << maxpause << endl;
+    cout << "    minfriclng      " << minfriclng << endl;
+    cout << "    minrise         " << minrise << endl;
+    cout << "    minstartsilence " << minstartsilence << endl;
+    cout << "    minuttlng       " << minuttlng << endl;
+    cout << "    minvoicelng     " << minvoicelng << endl;
+    cout << "    numdpnoise      " << numdpnoise << endl;
+    cout << "    samprate        " << samprate << endl;
+    cout << "    startblip       " << startblip << endl;
+    cout << "    stepsize        " << stepsize << endl;
+    cout << "    triggerfact     " << triggerfact << endl;
+    cout << "    windowsize      " << windowsize << endl;
+    cout << "    zcthresh        " << zcthresh << endl;
+} // end endpointer::printvars
+
+
+/* ENDPOINT::GETTAGNAME - convert the tag to ascii */
+const char *endpointer::gettagname
+(
+    EPTAG	tag
+)
+{
+    static const char *tagnames[] =	// must match EPTAG enum in endpoint.h
+		{
+			"NONE",
+			"RESET",
+			"SILENCE",
+			"SIGNAL",
+			"INUTT",
+			"MAYBEEND",
+			"ENDOFUTT",
+			"NOTEND",
+			"NOSTARTSILENCE"
+		};
+    long	ntag = long (tag);
+
+    if (ntag < 0 || ntag > long (EP_NOSTARTSILENCE))
+        return ("UNKNOWN");
+    else
+        return (tagnames[ntag]);
+} // end endpointer::gettagname
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/endpoint.doc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,124 @@
+Interactive speech recognition systems are only useful if they can
+can run with live input.  The problem with live input, as opposed to
+pre-recorded data, is that the exact start and end of the utterance
+is unknown.  One technique to deal with this problem, is to record
+a fixed size utterance (e.g., 5 seconds) and assume that the user will
+speak the entire utterance within the time period.  A recognizer which
+has silence models for the start and end of the utterance can thus
+parse such an utterance. However, such a scheme is obviously prone
+to errors and is computationally wasteful because the entire input
+buffer must be searched.
+
+The obvious solution is an endpointer which identifies the start and
+end of utterance.  The problem is that endpointing an utterance, like
+speech recognition itself, is non-trivial.
+
+This is an endpointing algorithm designed for real-time input of
+a speech signal.  "Real-time" means that the signal is processed
+in parallel with its recording.  This allows a speech recognition
+system to run in parallel with the input of the utterance.
+
+This algorithm calculates and uses "cheap" parameters, RMS energy and
+zero crossing counts.  Thus, this algorithm can run in real-time on
+any micro processor without the need for a DSP.
+
+Because the signal is end-pointed in real-time, errors can and do
+occur in identifying the start and end of the actual utterance.
+Thus, the labels, or tags, that this endpointer gives for each
+frame of data are some what "fuzzy".  That is, the endpointer will
+tentitively label a frame but may indicate at a later frame that
+the identification of a previous frame was in error.  This requires
+special handling by the speech recognition system in that it must
+be capable of re-starting recognition after false starts and continuing
+searching after possible end of utterance frames.
+
+The endpointer works by passing to it one frame of data at a time.  The
+endpointer will check the frame to determine if it is part of the
+utterance and return a label, or tag, for the frame.  The possible
+labels are the following:
+
+	EP_NONE
+	EP_NOSTARTSILENCE
+	EP_SILENCE
+	EP_SIGNAL
+	EP_RESET
+	EP_MAYBEEND
+	EP_NOTEND
+	EP_ENDOFUTT
+
+EP_NONE - This is a NULL label which the endpointer does not return,
+This is convenient to have for labeling frames for which the endpointer
+is turned off.
+
+EP_NOSTARTSILENCE - The first frame is so loud or noisy that it does not
+"look" like background silence.  This depends on absolute thresholds and
+can generate a false positive for really noisy signals or a false negative
+for really quiet signals.  See theory of operation below.
+
+EP_SILENCE - This label is returned for silence frames before the start
+of the utterance.
+
+EP_SIGNAL - This is returned for each frame that appears to be contained
+in the utterance signal.  The first E_SIGNAL frame marks the start of the
+utterance.
+
+EP_RESET - This indicates a false start condition.  The previous EP_SIGNAL
+frames were, in fact, not part of the utterance.  The recognition system
+should reset itself and start over.
+
+EP_MAYBEEND - This label indicates the possible end of utterance.  The
+frame which has this label is actually one frame after the possible last
+frame of the utterance.  As this is a tentative label, the recognition
+system should either do end of utterance processing or save its state at
+this point for end of utterance processing.  In either case, the recognition
+system must continuing searching, including this frame, until the end of
+utterance has been confirmed.
+
+EP_NOTEND - The previous EP_MAYBEEND label was wrong.  The utterance is
+continuing.  The recognition can now forget its possible end of utterance
+state.
+
+EP_ENDOFUTT - The label confirms the actual end of utterance.  The real
+end of utterance was the last EP_SIGNAL frame before the last EP_MAYBEEND
+labeled frame.
+
+
+Theory of operation:
+For each frame of data, the endpointer calculates the RMS energy and the
+zero-cross count.  The first few frames are assumed to be background
+silence and are used to initialize various thresholds. If there is no
+starting silence (the user speaks too soon), then the endpointer will
+mislabel the first syllable (which may be one or more words) until a
+silence is reached.  Similarly, if there is no ending silence, then the
+endpointer will not mark the end of utterance.
+
+A running average of the background silence is kept which consists of
+averaging the last few silence frames.  This background silence is used
+to set energy thresholds and the Schmidt trigger for the zero-cross
+counter.
+
+The endpointer contains over a dozen thresholds and settings which are used
+to determine frication, voicing, and silence.  These thresholds have been
+determined emperically.
+
+The sampling rate, window size in samples, and the step size in samples
+are passed to the class constructor.  These three arguments are used to
+calculate the internal thresholds (actual zero-cross count values for
+frequencies and number of frames for durations).  Any or all of the internal
+
+CAVEATS:
+The endpointer will fail if there is no starting silence or endsilence.
+If there is no starting silence, then the first syllable up to the first
+stop consonant will be lost.  If there is no ending silence, then the last
+syllable will the lost or no end of utterance will be determined.
+thresholds can be changed by specifying them in the class constructor.
+
+The endpointer makes no distinction between noise and speech.  Impulse
+noises will fool it.  The endpointer tends to be conservative in that it
+will err by including noises with the signal rather than cutting out part
+of the actual speech signal.  So, a good recognition system must model
+noise.
+
+Large amplitude background white noise may cause the endpointer to miss
+fricatives, weak or strong.  If the background noise is known a priori, then
+the endpointer thresholds can be adjusted to cope with the noise.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/endpoint.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,150 @@
+/*
+ * ENDPOINT.H - endpoint class definition
+ *
+ * Bruce T. Lowerre, Public domain, 1995, 1997
+ *
+ * $Log$
+ * Revision 1.1  2001/10/10 19:54:49  pkienzle
+ * Initial revision
+ *
+ * Revision 1.1  2001/04/22 08:29:30  pkienzle
+ * adding in all of matcompat
+ *
+ * Revision 1.2  1997/05/23 19:59:01  lowerre
+ * renamed class endpoint to endpointer, conflicts with <rpcsvc/nis.h>
+ *
+ * Revision 1.1  1997/05/14 20:34:34  lowerre
+ * Initial revision
+ *
+ *
+ */
+
+/* The endpointer is used to determine the start and end of a live
+ * input signal.  Unlike a pre-recorded utterance, a live input signal
+ * is open-ended in that the actual start and end of the signal is
+ * totally unknown.  The search, using HMM techniques with a silence
+ * model, will usually do a fairly good job of guessing the start of
+ * the signal.  However, the actual end of the signal is unknown to
+ * the recognizer.  Reaching the end state in the recognizer does not
+ * necessarily mean the end of signal.  Therefore, the end of signal
+ * must be calculated by some means.  This is the job of the end point
+ * detector.  */
+
+#ifndef ENDPOINT_H
+#define ENDPOINT_H
+
+//#include <general.h>				// contains general defs
+
+typedef enum
+{
+    NOSILENCE,
+    INSILENCE,
+    START,
+    INSIGNAL,
+    END
+} EPSTATE;
+
+typedef enum
+{
+    EP_NONE,
+    EP_RESET,
+    EP_SILENCE,
+    EP_SIGNAL,
+    EP_INUTT,
+    EP_MAYBEEND,
+    EP_ENDOFUTT,
+    EP_NOTEND,
+    EP_NOSTARTSILENCE
+} EPTAG;
+
+class endpointer
+{
+    private:
+        EPSTATE		epstate;
+        float		ave,
+			noise,
+			begthresh,
+			energy,
+			maxpeak,
+			endthresh,
+			begfact,
+			endfact,
+			energyfact,
+			mnbe,
+			peakreturn,	// average energy
+			dpnoise,
+			triggerfact,	// schmidt trigger percent
+			minstartsilence,
+			*lastdpnoise;	// array of size numdpnoise
+        long		samprate,	// sampling rate in Hz
+			windowsize,	// window size in samples
+			stepsize,	// step size in samples
+        		scnt,
+			avescnt,
+			vcnt,
+			evcnt,
+			voicecount,
+			minfriclng,
+			bscnt,
+			zccnt,
+			startframe,
+			endframe,
+			ncount,
+			zcthresh,
+			numdpnoise,
+			minrise,
+			maxpause,
+			maxipause,
+			startblip,
+			endblip,
+			minuttlng,
+			minvoicelng,
+			zc;		// zero cross count per window
+        bool		startsilenceok,
+			low;		// is signal currently low or high?
+        void zcpeakpick			// get zc count and average energy
+        (
+            short*			// raw samples
+        );
+        void setnoise ();		// initial noise level set
+        void averagenoise ();		// average noise array and shift
+    public:
+        endpointer			// constructor
+        (
+            long,			// sampling rate in Hz
+            long,			// window  size in samples
+            long,			// step size in samples
+            long = 700,			// endof utt silence default, msec
+            long = 100,			// minuttlng default, msec
+            long = 600,			// zcthresh default, Hz
+            float = 40.0,		// begfact default
+            float = 80.0,		// endfact default
+            float = 200.0,		// energyfact default
+            float = 2000.0,		// minstartsilence default
+            float = 3.0,		// triggerfact default
+            long = 6,			// numdpnoise default
+            long = 50,			// minfriclng default, msec
+            long = 150,			// maxpause default, msec
+            long = 30,			// startblip default, msec
+            long = 20,			// endblip default, msec
+            long = 60,			// minvoicelng default, msec
+            long = 50			// minrise default, msec
+        );
+        ~endpointer ();			// destructor
+
+        void initendpoint ();		// initialize variables
+        EPTAG getendpoint
+        (
+            short*			// raw samples of window size
+        );
+        const char *gettagname		// convert tag to ascii
+        (
+            EPTAG
+        );
+        void printvars ();		// print variables
+        long getzc () {return (zc);}	// get the zero cross count
+        float getenergy () {return (peakreturn);}	// get the RMS energy
+}; // end class endpointer
+
+
+#endif
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/sound.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,124 @@
+## Copyright (C) 1999-2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: sound(x [, fs])
+##
+## Play the signal through the speakers.  Data is a matrix with
+## one column per channel.  Rate fs defaults to 8000 Hz.  The signal
+## is clipped to [-1, 1].
+##
+## Note that if $DISPLAY != $HOSTNAME:n then a remote shell is opened
+## to the host specified in $HOSTNAME to play the audio.  See manual
+## pages for rsh and .rhosts for your system to learn how to set it up.
+##
+## This function writes the audio data through a pipe to the program
+## "play" from the sox distribution.  sox runs pretty much anywhere,
+## but it only has audio drivers for OSS (primarily linux and freebsd)
+## and SunOS.  In case your local machine is not one of these, write
+## a shell script such as ~/bin/octaveplay, substituting AUDIO_UTILITY
+## with whatever audio utility you happen to have on your system:
+##   #!/bin/sh
+##   cat > ~/.octave_play.au
+##   SYSTEM_AUDIO_UTILITY ~/.octave_play.au
+##   rm -f ~/.octave_play.au
+## and set the global variable (e.g., in .octaverc)
+##   global sound_play_utility="~/bin/octaveplay";
+##
+## If your audio utility can accept an AU file via a pipe, then you
+## can use it directly:
+##   global sound_play_utility="SYSTEM_AUDIO_UTILITY flags"
+## where flags are whatever you need to tell it that it is receiving
+## an AU file.
+##
+## With clever use of the command dd, you can chop out the header and
+## dump the data directly to the audio device in big-endian format:
+##   global sound_play_utility="dd of=/dev/audio ibs=2 skip=12"
+## or little-endian format:
+##   global sound_play_utility="dd of=/dev/dsp ibs=2 skip=12 conv=swab"
+## but you lose the sampling rate in the process.  
+##
+## Finally, you could modify sound.m to produce data in a format that 
+## you can dump directly to your audio device and use "cat >/dev/audio" 
+## as your sound_play_utility.  Things you may want to do are resample
+## so that the rate is appropriate for your machine and convert the data
+## to mulaw and output as bytes.
+function sound(data, rate)
+
+  if nargin<1 || nargin>2
+    usage("sound(x [, fs])");
+  endif
+  if nargin<2 || isempty(rate), rate = 8000; endif
+  if rows(data) != length(data), data=data'; endif
+  [samples, channels] = size(data);
+
+  ## Check if the octave engine is running locally by seeing if the
+  ## DISPLAY environment variable is empty or if it is the same as the 
+  ## host name of the machine running octave.  The host name is
+  ## taken from the HOSTNAME environment variable if it is available,
+  ## otherwise it is taken from the "uname -n" command.
+  display=getenv("DISPLAY");
+  colon = rindex(display,":");
+  if isempty(display) || colon==1
+    islocal = 1;
+  else
+    if colon, display = display(1:colon-1); endif
+    host=getenv("HOSTNAME");
+    if isempty(host), 
+      host = system("uname -n");
+				# trim newline from end of hostname
+      if !isempty(host), host = host(1:length(host)-1); endif
+    endif
+    islocal = strcmp(tolower(host),tolower(display));
+  endif
+
+  ## If not running locally, then must use rsh to execute play command
+  global sound_play_utility="play -t AU -";
+  if islocal
+    fid=popen(sound_play_utility, "w");
+  else
+    fid=popen(["rsh ", host, " ", sound_play_utility], "w");
+  end
+  if fid < 0,
+    warning("sound could not open play process");
+  else
+    ## write sun .au format header to the pipe
+    fwrite(fid, toascii(".snd"), 'char');
+    fwrite(fid, 24, 'long', 0, 'ieee-be');
+    fwrite(fid, -1, 'long', 0, 'ieee-be');
+    fwrite(fid, 3, 'long', 0, 'ieee-be');
+    fwrite(fid, rate, 'long', 0, 'ieee-be');
+    fwrite(fid, channels, 'long', 0, 'ieee-be');
+    fwrite(fid, 32767*clip(data,[-1, 1])', 'short', 0, 'ieee-be');
+    pclose(fid);
+  endif
+end
+
+###### auplay based version: not needed if using sox
+##  ## If not running locally, then must use rsh to execute play command
+##  global sound_play_utility="~/bin/auplay"
+##  if islocal
+##    fid=popen(sound_play_utility, "w");
+##  else
+##    fid=popen(["rsh ", host, " ", sound_play_utility], "w");
+##  end
+##  fwrite(fid, rate, 'long');
+##  fwrite(fid, channels, 'long');
+##  fwrite(fid, 32767*clip(data,[-1, 1])', 'short');
+##  pclose(fid);
+
+%!demo
+%! [x, fs] = auload(file_in_loadpath("sample.wav"));
+%! sound(x,fs);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/audio/soundsc.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,66 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: soundsc(x, fs, limit) or soundsc(x, fs, [ lo, hi ])
+##
+## soundsc(x)
+##    Scale the signal so that [min(x), max(x)] -> [-1, 1], then 
+##    play it through the speakers at 8000 Hz sampling rate.  The
+##    signal has one column per channel.  
+##
+## soundsc(x,fs)
+##    Scale the signal and play it at sampling rate fs.
+##
+## soundsc(x, fs, limit)
+##    Scale the signal so that [-|limit|, |limit|] -> [-1, 1], then
+##    play it at sampling rate fs.  If fs is empty, then the default
+##    8000 Hz sampling rate is used.
+##
+## soundsc(x, fs, [ lo, hi ])
+##    Scale the signal so that [lo, hi] -> [-1, 1], then play it
+##    at sampling rate fs.  If fs is empty, then the default 8000 Hz
+##    sampling rate is used.
+##
+## y=soundsc(...)
+##    return the scaled waveform rather than play it.
+##
+## See sound for more information.
+
+function data_r = soundsc(data, rate, range)
+
+  if nargin < 1 || nargin > 3, usage("soundsc(x, fs, [lo, hi])") endif
+  if nargin < 2, rate = []; endif
+  if nargin < 3, range = [min(data(:)), max(data(:))]; endif
+  if is_scalar(range), range = [-abs(range), abs(range)]; endif
+  
+  data=(data - mean(range))/((range(2)-range(1))/2);
+  if nargout > 0
+    data_r = data;
+  else
+    sound(data, rate);
+  endif
+endfunction
+
+
+%!demo
+%! [x, fs] = auload(file_in_loadpath("sample.wav"));
+%! soundsc(x,fs);
+
+%!shared y
+%! [x, fs] = auload(file_in_loadpath("sample.wav"));
+%! y=soundsc(x);
+%!assert (min(y(:)), -1, eps)
+%!assert (max(y(:)), 1, eps)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/comm/bi2de.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,47 @@
+## Copyright (C) 2001 Laurent Mazet
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: d = bi2de (b [, p])
+##
+## convert bit matrix to vector of integers.
+##
+## p: base of decomposition (default is 2).
+##
+## d: integer vector.
+
+## 2001-02-02
+##   initial release
+
+function d = bi2de (b, p)
+
+  switch (nargin)
+    case 1,
+      p = 2;
+    otherwise
+      error ("usage: d = bi2de (b, [p])");
+  endswitch
+
+  if ( any (b (:) < 0) || any (b (:) > p - 1) )
+    error ("bi2de: d must only contain value in [0, p-1]");
+  endif
+
+  if (length (b) == 0)
+    d = [];
+  else
+    d = b * ( p .^ [ 0 : columns(b)-1 ]' );
+  endif
+
+endfunction;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/comm/compand.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,79 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+## y = compand(x, mu, V, 'mu/compressor')
+## y = compand(x, mu, V, 'mu/expander')
+##   mu-law compressor/expander for reducing the dynamic range of your
+##   signal. Uses:
+##
+##         V log (1 + \mu/V |x|)
+##     y = -------------------- sgn(x)
+##             log (1 + \mu)
+##
+##   Does not convert from/to audio file ulaw format.  Use mu2lin/lin2mu
+##   instead.
+##
+## y = compand(x, A, V, 'A/compressor')
+## y = compand(x, A, V, 'A/expander')
+##   A-law compressor/expander. Uses:
+##
+##         /    A / (1 + log A) x,               0 <= |x| <= V/A  
+##         | 
+##     y = <    V ( 1 + log (A/V |x|) )
+##         |    ----------------------- sgn(x),  V/A < |x| <= V
+##         \        1 + log A
+
+function y = compand(x, mu, V, stype)
+
+  if (nargin != 3 && nargin != 4)
+    usage('y=compand(x,[mu|A],V,stype);'); 
+  endif
+  if (nargin < 4) 
+    stype = 'mu/compressor';
+  else 
+    stype = tolower(stype);
+  endif
+
+  if strcmp(stype, 'mu/compressor')
+    y = (V/log(1+mu)) * log(1+(mu/V)*abs(x)) .* sign(x);
+  elseif strcmp(stype, 'mu/expander')
+    y = (V/mu) * ( exp (abs(x) * (log(1+mu)/V)) - 1 ) .* sign(x);
+  elseif strcmp(stype, 'a/compressor')
+    y = zeros(size(x));
+    idx = find (abs(x) <= V/mu);
+    if (idx)
+      y(idx) = (mu/(1+log(mu))) * abs(x(idx));
+    endif
+    idx = find (abs(x) > V/mu);
+    if (idx)
+      y(idx) = (V/(1+log(mu))) * (1 + log ((mu/V) * abs(x(idx))));
+    endif
+    y = y .* sign(x);
+  elseif strcmp(stype, 'a/expander')
+    y = zeros(size(x));
+    idx = find (abs(x) <= V/(1+log(mu)));
+    if (idx)
+      y(idx) = ((1+log(mu))/mu) * abs(x(idx));
+    endif
+    idx = find (abs(x) > V/(1+log(mu)));
+    if (idx)
+      y(idx) = exp (((1+log(mu))/V) * abs(x(idx)) - 1) * (V/mu);
+    endif
+    y = y .* sign(x);
+  endif
+
+endfunction
+		   
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/comm/de2bi.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,50 @@
+## Copyright (C) 2001 Laurent Mazet
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: b = de2bi(d, [n, [p]])
+##
+## Convert a non-negative integer to bit vector.
+##
+## d: positive integer
+## n: number of rows of the ouput bit vector (default is max. size).
+## p: base of decomposition (default is 2).
+##
+## b : bit vector.
+
+## 2001-02-02
+##   initial release
+
+function b = de2bi(d, n, p)
+
+  if (nargin == 1)
+    p = 2;
+    n = floor ( log (max (max (d), 1)) ./ log (p) ) + 1;
+  elseif (nargin == 2)
+    p = 2;
+  elseif (nargin != 3)
+    error ("usage: b = de2bi (d [, n [, p]])");
+  endif
+
+  d = d(:);
+  if ( any (d < 0) || any (d != floor (d)) )
+    error ("de2bi: only handles non-negative integers");
+  endif
+
+  power = ones (length (d), 1) * (p .^ [0 : n-1] );
+  d = d * ones (1, n);
+  b = floor (rem (d, p*power) ./ power);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/comm/quantiz.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,45 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+## qidx = quantiz(x, table)
+##   Determine position of x in strictly monotonic table.  The first
+##   interval, using index 0, corresponds to x <= table(1).
+##   Subsequent intervals are table(i-1) < x <= table(i).
+##
+## [qidx, q] = quantiz(x, table, codes)
+##   Associate each interval of the table with a code.  Use codes(1) 
+##   for x <= table(1) and codes(n+1) for table(n) < x <= table(n+1).
+##
+## [qidx, q, d] = quantiz(...)
+##   Compute distortion as mean squared distance of x from the
+##   corresponding table positions.  Note that an equally valid
+##   definition of distortion is the distance from the codebook
+##   values.
+function [qidx, q, d] = quantiz (x, table, codes)
+  if (nargin < 2 || nargin > 3)
+    usage("[qidx, q, d] = quantiz(x, table, codes)");
+  endif
+
+  qidx = length(table) - lookup(flipud(table(:)), x);
+  if (nargin > 2 && nargout > 1)
+    q = codes(qidx + 1);
+  endif
+  if (nargout > 2)
+    warning("distortion is relative to table instead of codes");
+    table = [table(1) ; table(:) ];
+    d = sumsq (x(:) - table(qidx+1)) / length(x);
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/comm/randint.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,69 @@
+## Copyright (C) 2001 Laurent Mazet
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: b = randint (n, [m, [range, [seed]]])
+##
+## Generate a matrix of random binary numbers.
+##
+## n: number of rows.
+## m: number of columns (by default m is equal to n).
+## range: range of random numbers. if range is a scalar the integer range
+##        is [0, range-1], else, the ouput range is [range(1), range(2)].
+## seed: seed of the random generator.
+##
+## b : random matrix.
+
+## 2001 FEB 07
+##   initial release
+
+function b = randint (n, m, range, seed)
+
+  switch (nargin)
+    case 1,
+      m = n;
+      range = [0 1];
+      seed = Inf;
+    case 2,
+      range = [0 1];
+      seed = Inf;
+    case 3,
+      seed = Inf;      
+    otherwise
+      error ("b = randint (n, [m, [range, [seed]]])");
+  endswitch
+
+  ## Check range
+  if (length (range) == 1)
+    range = [0, range-1];
+  elseif ( prod (size (range)) != 2)
+    error ("randint: range must be a 2 element vector");
+  endif
+  range = sort (range);
+  
+  ## Check seed;
+  if (!isinf (seed))
+    old_seed = rand ("seed");
+    rand ("seed", seed);
+  endif
+
+  b = range (1) - 1 + ceil (rand (n, m) * (range (2) - range (1) + 1));
+  
+  ## Get back to the old
+  if (!isinf (seed))
+    rand ("seed", old_seed);
+  endif
+
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/comm/vec2mat.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,58 @@
+## Copyright (C) 2001 Laurent Mazet
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: M = vec2mat (V, c [, d])
+##
+## Converts the vector V into a c column matrix with row priority
+## arrangement and with the final column padded with the value d
+## to the correct length.
+##
+## V: vector
+## c: number of colunms
+## d: value of padded elements (default 0)
+##
+## M: matrix.
+
+## 2001-02-02
+##   initial release
+
+function M = vec2mat (V, c, val)
+
+  switch (nargin)
+    case 1,
+      M = V;
+      return;
+    case 2,
+      val = 0;
+    case 3,
+      val = val;
+    otherwise
+      error ("usage: M = vec2mat (V, c [, d])");
+  endswitch
+
+  V = V.';
+  V = V(:);
+
+  r = ceil (length (V) / c);
+
+  d = r * c - length (V);
+  if (d != 0)
+    V = [ V ; val*ones(d, 1) ];
+  endif
+
+  M = reshape (V, c, r).';
+
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/control/feedback.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,29 @@
+## feedback(sys1,sys2)
+##              _____________
+##     +        |            |
+## u --->0----->|    sys1    |------->
+##       |-     |____________|   |
+##       |                       |
+##       |      _____________    |
+##       |      |            |   |
+##       -------|    sys2    |----
+##              |____________|
+##
+## This only works for SISO systems.
+ 
+## Author: Ben Sapp <mailto:bsapp@lanl.gov>
+ 
+function out = feedback(sys1,sys2)
+  if (nargin != 2)
+    error("only 2 arguements accepted");
+  endif
+  if(!is_siso(sys1) || !is_siso(sys2))
+    error("only single input single output systems supported");
+  endif
+  T = sysgroup(sys1,sys2);
+  T = sysdup(T,2,[]);
+  T = sysscale(T,diag([1,1,-1]),[]);
+  T = sysconnect(T,3,1);
+  T = sysconnect(T,1,2);
+  out = sysprune(T,1,1);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,20 @@
+include ../../Makeconf
+
+PROGS=bitand.oct bitor.oct bitxor.oct bitmax.oct command.oct
+
+bitor.oct: bitand.oct
+	-$(RM) $@
+	$(LN_S) $< $@
+
+bitxor.oct: bitand.oct
+	-$(RM) $@
+	$(LN_S) $< $@
+
+bitmax.oct: bitand.oct
+	-$(RM) $@
+	$(LN_S) $< $@
+
+all: $(PROGS)
+
+clean:
+	-$(RM) *.o *.oct core octave-core *~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/bitand.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,187 @@
+/* Copyright (C) 2000  Kai Habel
+**
+** This program is free software; you can redistribute it and/or modify
+** it under the terms of the GNU General Public License as published by
+** the Free Software Foundation; either version 2 of the License, or
+** (at your option) any later version.
+**
+** This program is distributed in the hope that it will be useful,
+** but WITHOUT ANY WARRANTY; without even the implied warranty of
+** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+** GNU General Public License for more details.
+**
+** You should have received a copy of the GNU General Public License
+** along with this program; if not, write to the Free Software
+** Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 
+*/
+
+/*
+INSTALLATION
+- copy this file and the Makefile to directory of octave's LOADPATH
+- compile this file:
+	make
+*/
+
+#include <sys/types.h>
+#include <strstream>
+#include <climits>
+#include <algorithm>
+#include <octave/oct.h>
+#include <octave/lo-ieee.h>
+
+typedef unsigned long bitop_int;
+const unsigned int ULONG_SIZE=CHAR_BIT*sizeof(bitop_int);
+const unsigned int BIT_AND = 1;
+const unsigned int BIT_OR = 2;
+const unsigned int BIT_XOR = 3;
+
+double
+scalar_bitop(double x,double y,unsigned int op) {
+	double a=octave_NaN;
+	if ((x>=0)&&(x<=ULONG_MAX)&&(y>=0)&&(y<=ULONG_MAX)) {
+			bitop_int xval=static_cast<bitop_int>( floor(x) );
+			bitop_int yval=static_cast<bitop_int>( floor(y) );
+			if (op ==BIT_AND)
+				a = static_cast<double>(xval & yval);
+			else if (op==BIT_OR)
+				a = static_cast<double>(xval | yval);
+			else if (op==BIT_XOR)
+				a = static_cast<double>(xval ^ yval);
+	}
+	return(a);
+}
+
+octave_value_list
+bitop(Matrix xmat,Matrix ymat,unsigned int op) {
+
+	octave_value_list retval;
+
+	bool is_scalar_op=false,is_matrix_op=false;
+	unsigned int xr=xmat.rows();
+	unsigned int yr=ymat.rows();
+	unsigned int xc=xmat.columns();
+	unsigned int yc=ymat.columns();
+
+	if ( (xr*xc)==1 || (yr*yc)==1) 
+		is_scalar_op=true;
+	if ( (xr==yr)&&(xc==yc) )
+		is_matrix_op=true;
+	if (is_matrix_op || is_scalar_op) {
+		unsigned int i,j,k,l;
+		unsigned int r=max(xr,yr),c=max(xc,yc);
+		Matrix a(r,c);
+
+		for(i=0;i<xr;i++) {
+			for(j=0;j<xc;j++) {
+				if (is_scalar_op) {
+					for(k=0;k<yr;k++) {
+						for(l=0;l<yc;l++) {
+							a(i+k,j+l)=scalar_bitop( xmat(i,j),ymat(k,l),op );
+						}
+					}
+				}
+				else {
+					// is_matrix_op
+					a(i,j)=scalar_bitop( xmat(i,j),ymat(i,j),op );
+				}
+			}
+		}
+		retval(0)=a;
+	}
+	else 
+		error("size of x and y must match, or one operand must be a scalar");
+	return(retval);
+}
+
+DEFUN_DLD (bitand, args, ,
+	"-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {@var{A} =} bitand (@var{x}, @var{y})\n\
+calculates the bitwise AND of nonnegative integers.\n\
+@var{x},@var{y} must be in range [0..bitmax]\n\
+@seealso{bitor,bitxor,bitset,bitget,bitcmp,bitshift,bitmax}\n\
+@end deftypefn")
+{
+	octave_value_list retval;
+	
+	int nargin = args.length();
+	if (!(nargin==2)) {
+		print_usage ("bitand");
+		return retval;
+	}
+
+	if (args(0).is_real_type()&&args(1).is_real_type()) {
+		Matrix x = args(0).matrix_value();
+		Matrix y = args(1).matrix_value();
+		retval=bitop(x,y,BIT_AND);
+	}
+	else 
+		error("both operands must be of real data type");
+	return retval;
+}
+
+DEFUN_DLD (bitor, args, ,
+	"-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {@var{A} =} bitor (@var{x}, @var{y})\n\
+calculates the bitwise OR of nonnegative integers.\n\
+@var{x},@var{y} must be in range [0..bitmax]\n\
+@seealso{bitor,bitxor,bitset,bitget,bitcmp,bitshift,bitmax}\n\
+@end deftypefn")
+{
+	octave_value_list retval;
+	
+	int nargin = args.length();
+	if (!(nargin==2)) {
+		print_usage ("bitor");
+		return retval;
+	}
+
+	if (args(0).is_real_type()&&args(1).is_real_type()) {
+		Matrix x = args(0).matrix_value();
+		Matrix y = args(1).matrix_value();
+		retval=bitop(x,y,BIT_OR);
+	}
+	else 
+		error("both operands must be of real data type");
+	return retval;
+}
+
+DEFUN_DLD (bitxor, args, ,
+	"-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {@var{A} =} bitxor (@var{x}, @var{y})\n\
+calculates the bitwise XOR of nonnegative integers.\n\
+@var{x},@var{y} must be in range [0..bitmax]\n\
+@seealso{bitand,bitor,bitset,bitget,bitcmp,bitshift,bitmax}\n\
+@end deftypefn")
+{
+	octave_value_list retval;
+	
+	int nargin = args.length();
+	if (!(nargin==2)) {
+		print_usage ("bitxor");
+		return retval;
+	}
+
+	if (args(0).is_real_type()&&args(1).is_real_type()) {
+		Matrix x = args(0).matrix_value();
+		Matrix y = args(1).matrix_value();
+		retval=bitop(x,y,BIT_XOR);
+	}
+	else 
+		error("both operands must be of real data type");
+	return retval;
+}
+
+DEFUN_DLD (bitmax, args, ,
+	"-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {@var{A} =} bitmax\n\
+returns the the maximum unsigned integer.
+@seealso{bitand,bitor,bitxor,bitset,bitget,bitcmp,bitshift}\n\
+@end deftypefn")
+{
+	octave_value_list retval;
+	if (args.length()!=0) 
+		print_usage ("bitmax");
+	else 
+		retval(0)=octave_value(static_cast<double>(ULONG_MAX));
+	return retval;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/bitcmp.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,51 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{X} =} bitcmp (@var{a},@var{k})
+## returns the @var{k}-bit complement of integers in @var{a}. If
+## @var{k} is omitted k = log2(bitmax) is assumed.
+##
+## @example
+## bitcmp(7,4)
+## @result{} 8
+## dec2bin(11)
+## @result{} 1011
+## dec2bin(bitcmp(11))
+## @result{} 11111111111111111111111111110100
+## @seealso{bitand,bitor,bitxor,bitset,bitget,bitcmp,bitshift,bitmax}
+## @end deftypefn
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function X = bitcmp (A,n)
+  
+  if (nargin < 1 || nargin > 2)
+    usage ("bitcmp(A,n)");
+  endif
+
+  if (nargin == 1)
+    n = log2 (bitmax);
+  endif
+
+  if (!(is_matrix (A)) || is_complex (A))
+    error ("first argument must be a real value");
+  else
+	p = bitmax - pow2 (n) + 1;
+	X = bitmax - bitor (A, p);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/bitget.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,48 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{X} =} bitget (@var{a},@var{n})
+## returns the status of bit(s) @var{n} of unsigned integers in @var{a}
+## the lowest significant bit is @var{n} = 1.
+##
+## @example
+## bitget(100,8:-1:1)
+## @result{} 0  1  1  0  0  1  0  0 
+## @end example
+## @seealso{bitand,bitor,bitxor,bitset,bitcmp,bitshift,bitmax}
+## @end deftypefn
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function X = bitget (A,n)
+  
+  if (nargin != 2)
+    usage ("bitget(A,n)");
+  endif
+
+  if (n < 1 || n > (log2(bitmax) + 1) )
+    msg = sprintf ("n must be in range [1,%d]",round(log2(bitmax)+1));
+    error (msg);
+  endif
+
+  if (!(is_matrix (A)) || is_complex (A))
+    error ("first argument must be a real value");
+  else
+	X = bitand (A, pow2 (n - 1)) != 0;
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/bitset.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,55 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{X} =} bitset (@var{a},@var{n})
+## @deftypefnx {Function File} {@var{X} =} bitset (@var{a},@var{n},@var{v})
+## sets or resets bit(s) @var{N} of unsigned integers in @var{A}.
+## @var{v} = 0 resets and @var{v} = 1 sets the bits.
+## The lowest significant bit is: @var{n} = 1
+##
+## @example
+## dec2bin (bitset(10,1))
+## @result{} 1011
+## @seealso{bitand,bitor,bitxor,bitget,bitcmp,bitshift,bitmax}
+## @end deftypefn
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function X = bitset (A, n, value)
+  
+  if (nargin < 2 || nargin > 3)
+    usage ("bitset (A, n, v)");
+  endif
+
+  if (nargin == 2)
+	value = 1;
+  endif
+  
+  if (n < 1 || n > (log2(bitmax) + 1) )
+    msg = sprintf ("n must be in range [1,%d]",round(log2(bitmax)+1));
+    error (msg);
+  endif
+
+  if (!is_matrix (A) || is_complex (A))
+    error ("first argument must be a real value");
+  else
+	X = bitand (pow2 (n - 1), value);
+	Y = bitand (A, bitmax - pow2 (n - 1));
+	X = bitor (X, Y);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/bitshift.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,82 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{X} =} bitshift (@var{a},@var{k})
+## @deftypefnx {Function File} {@var{X} =} bitshift (@var{a},@var{k},@var{n})
+## return a @var{k} bit shift of @var{n}- digit unsigned
+## integers in @var{a}. A positive @var{k} leads to a left shift.
+## A negative value to a right shift. If @var{N} is omitted it defaults
+## to log2(bitmax)+1. 
+## @var{N} must be in range [1,log2(bitmax)+1] usually [1,33]
+## 
+##
+## @example
+## bitshift(eye(3),1))
+## @result{} 
+## @group
+## 2 0 0
+## 0 2 0
+## 0 0 2
+## @end group
+##
+## bitshift(10,[-2, -1, 0, 1, 2])
+## @result{} 2   5  10  20  40
+##
+## bitshift ([1, 10],2,[3,4])
+## @result{} 4  8
+##
+## @seealso{bitand,bitor,bitxor,bitset,bitget,bitcmp,bitmax}
+## @end deftypefn
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+## Bug fixed by Paul Kienzle <pkienzle@kienzle.powernet.co.uk> 
+## log2(bitmax) must be rounded to nearest integer 
+
+function X = bitshift (A,k,n)
+  
+  if ((nargin < 2) | (nargin > 3))
+    usage ("bitshift(A,n,k)");
+  endif
+
+  if (nargin == 3)
+    n = fix (n);
+    if ( is_scalar(n) & (!is_scalar(k)) )
+      if (!is_scalar (A) & (size (A) != size (k)))
+        error ("size of A and k must match");
+      endif 
+      n = n .* ones (size (k));
+    elseif (!is_scalar (n)) & is_scalar (k)
+	  if (!is_scalar (A) & (size (A) != size (n)))
+        error ("size of A and n must match");
+      endif
+      k = fix (k) .* ones (size (n));
+    elseif (size (n) != size (k))
+      error ("size of n and k must match");
+    endif
+  else
+    n = round (log2 (bitmax) * ones (size (k)));
+  endif
+
+  if !(is_matrix (A)) || is_complex (A)
+    error ("first argument must be a real value");
+  else
+	X = fix (A .* pow2 (k));
+	X = bitand (X, pow2 (n) - 1);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/blkdiag.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,38 @@
+## Copyright (C) 2000 Daniel Calvelo
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Build a block-diagonal matrix from all the arguments
+
+## Author: Daniel Calvelo
+function y = blkdiag(...),
+  nin = 0;
+  va_start();
+  sizes = zeros( nargin, 2 );
+  while( ++nin <= nargin ),
+    m = va_arg();
+    if ~isnumeric( m ),
+      error("Non-numeric argument found.");
+    endif
+    sizes(nin,:) = size( m );
+  endwhile
+  csz = [ 0, 0 ; cumsum(sizes) ];
+  y = zeros( max(csz) );
+  va_start();
+  nin = 0;
+  while(++nin <= nargin),
+    y(csz(nin,1)+1:csz(nin+1,1) , csz(nin,2)+1:csz(nin+1,2)) = va_arg();
+  endwhile
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/command.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,92 @@
+/*
+
+Copyright (C) 2001 Paul Kienzle
+
+Modified from variable.cc, Copyright (C) 1996, 1997 John W. Eaton
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+Octave is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with Octave; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+#include <octave/oct.h>
+#include <octave/variables.h>
+#include <octave/symtab.h>
+
+DEFUN_DLD(command, args, , "-*- texinfo -*-\n\
+@deffn {Command} command name @dots{}\n\
+Register all the named functions as commands which can be invoked\n\
+with a set of string arguments without having to quote them or wrap\n\
+them in parentheses.  For example\n\
+\n\
+@example\n\
+command axis\n\
+@end example\n\
+\n\
+@noindent\n\
+allows you to invoke the script axis.m as @code{axis off} rather than\n\
+@code{axis(\"off\")} in order to turn off the axis tic marks.\n\
+\n\
+Note that this effect is applied at run time, not at parse time.  Since\n\
+a function is parsed before it is run, you will not be able to convert\n\
+a function into a command at the beginning of the script and use it as\n\
+a command in the remainder of the script, since the remainder of the\n\
+script will already have been parsed assuming the function was not a\n\
+command.\n\
+\n\
+WARNING: DO NOT APPLY THIS MORE THAN ONCE TO THE SAME FUNCTION otherwise\n\
+octave crashes.  Fixes are welcome.\n\
+@end deffn")
+{
+#if defined(HAVE_OCTAVE_20)
+  error("command: unavailable for Octave 2.0");
+#else
+  int nargin = args.length();
+
+  for (int i=0; i < nargin; i++)
+    {
+      std::string fcn_name;
+      if (args(i).is_string())
+	fcn_name = args(i).string_value();
+
+      if (! error_state)
+	{
+	  symbol_record *sr = 0;
+	  if (! fcn_name.empty ())
+	    {
+	      // check for symbol in global context, or create a new one
+	      sr = global_sym_tab->lookup (fcn_name, true);
+	      
+	      // read/reread function file if necessary, but don't execute
+	      lookup (sr, false);
+	    }
+	  if (sr && sr->is_function ())
+	    {
+	      octave_function* fn = sr->def().function_value();
+	      if (! error_state)
+		// can't do this step for octave 2.0
+		sr->define(fn, sr->type()|symbol_record::TEXT_FUNCTION);
+	      else
+		warning("command: %s function_value error", fcn_name.c_str());
+	    }
+	  else
+	    warning("command: %s is not a valid function", fcn_name.c_str());
+	}
+      else
+	warning("command: expects string values for arg %d", i+1);
+    }
+#endif
+
+  return octave_value_list();
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/complex.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,27 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: z = complex(x,y)
+##    Form complex number z = x + 1i*y.  
+## usage: z = complex(x)
+##    Form complex number z = x + 0i*x.  
+function z = complex (x, y)
+  if nargin==1
+    z = x + 0i*x;
+  else
+    z = x + 1i*y; 
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/cplxpair.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,103 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [z, n] = cplxpair(z [,tol])
+##
+## Sort the numbers z into complex conjugate pairs ordered by increasing
+## real part, or with identical real parts, increasing imaginary
+## magnitude. Place the negative imaginary complex number first within
+## each pair.  Place all the real numbers after all the complex pairs
+## (those with abs(imag(z)/z) < tol).  Signal an error if some complex
+## numbers could not be paired.  Requires all complex numbers to be exact
+## conjugates within tol, or signals an error.  tol defaults to 100*eps.
+## Note that there are no guarantees on the order of the returned pairs
+## with identical real parts but differing imaginary parts.
+##
+## Returns the ordered list of values, plus the number of values which
+## were complex.
+##
+## Example 
+##     [ cplxpair (exp(2i*pi*[0:4]'/5)), exp(2i*pi*[3; 2; 4; 1; 0]/5) ]
+
+## TODO: subsort returned pairs by imaginary magnitude
+## TODO: Consider removing extra return value (the number of complex
+## TODO:    values in the list) for exact compatibility
+## TODO: Why doesn't exp(2i*pi*[0:4]'/5) produce exact conjugates. Does
+## TODO:    it in Matlab?  The reason is that complex pairs are supposed
+## TODO:    to be exact conjugates, and not rely on a tolerance test.
+function [y, n] = cplxpair(z, tol)
+
+  if nargin < 1 || nargin > 2 
+    usage ("[z, n] = cplxpair (z [, tol]);"); 
+  endif
+  if nargin < 2, tol = 100*eps; endif
+
+  y = zeros (size (z));
+  if (length (z) == 0), return; endif
+
+  ## Sort the sequence in terms of increasing real values
+  [q, idx] = sort (real (z));
+  z = z (idx);
+
+  ## Put the purely real values at the end of the returned list
+  idx = find ( abs(imag(z)) ./ (abs(z)+realmin) < tol );
+  n = length (z) - length (idx);
+  if (length (idx) > 0)
+    y (n+1 : length(z)) = z (idx);
+    z (idx) = [];
+  endif
+
+  ## For each remaining z, place the value and its conjugate at the
+  ## start of the returned list, and remove them from further
+  ## consideration.
+  for i=1:2:n
+    if (i+1 > n)
+      error ("cplxpair could not pair all complex numbers");
+    endif
+    [v, idx] = min ( abs (z(i+1:n) - conj(z(i))) );
+    if (v > tol)
+      error ("cplxpair could not pair all complex numbers");
+    endif
+    if imag(z(i)) < 0
+      y ([i, i+1]) = z ([i, idx+i]);
+    else
+      y ([i, i+1]) = z ([idx+i, i]);
+    endif
+    z (idx+i) = z (i+1);
+  endfor
+
+endfunction
+
+%!demo
+%! [ cplxpair (exp(2i*pi*[0:4]'/5)), exp (2i*pi*[3; 2; 4; 1; 0]/5) ]
+
+%!assert (isempty(cplxpair([])));
+%!assert (cplxpair(1), 1)
+%!assert (cplxpair([1+1i, 1-1i]), [1-1i, 1+1i])
+%!assert (cplxpair([1+1i, 1+1i, 1, 1-1i, 1-1i, 2]), \
+%!	  [1-1i, 1+1i, 1-1i, 1+1i, 1, 2])
+%!assert (cplxpair([1+1i; 1+1i; 1; 1-1i; 1-1i; 2]), \
+%!	  [1-1i; 1+1i; 1-1i; 1+1i; 1; 2]) 
+%!assert (cplxpair([0, 1, 2]), [0, 1, 2]);
+
+%!shared z
+%! z=exp(2i*pi*[4; 3; 5; 2; 6; 1; 0]/7);
+%!assert (cplxpair(z(randperm(7))), z);
+%!assert (cplxpair(z(randperm(7))), z);
+%!assert (cplxpair(z(randperm(7))), z);
+
+%!## tolerance test
+%!assert (cplxpair([1i, -1i, 1+(1i*eps)],2*eps), [-1i, 1i, 1+(1i*eps)]);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/ctranspose.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,32 @@
+## Copyright (C) 2001 Laurent Mazet
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: y = ctranspose (x)
+##
+## Generate the complex conjugate transpose. Equivalent to x'
+##
+## x: input matrix.
+##
+## y: complex conjugate transpose of x.
+
+## 2001 FEB 07
+##   initial release
+
+function y = ctranspose (x)  
+
+  y = x.';
+  
+endfunction;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/cumtrapz.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,98 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{C} =} cumtrapz (@var{Y})
+## @deftypefnx {Function File} {@var{C} =} cumtrapz (@var{X},@var{Y})
+## 
+## cumulative numerical intergration using trapezodial method.
+## cumtrapz (@var{y}) computes the cumulative integral of the vector y.
+## If @var{y} is a matrix the integral is computed columnwise.
+## If the @var(X) argument is omitted a equally spaced vector is assumed. 
+## cumtrapz (@var{X},@var{Y}) evaluates the cumulative integral
+## with respect to @var{X}.
+##  
+## @seealso{trapz,cumsum}
+## @end deftypefn
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+##
+## also: June 2000 Paul Kienzle (fixes,suggestions) 
+
+function C = cumtrapz (X, Y)
+
+  transposed = false;
+
+  if (nargin < 1) || (nargin > 2)
+    usage ("trapz (X, Y)");
+  elseif (nargin == 1)
+
+    if !(is_matrix (X))
+      error ("argument must be vector or matrix");
+    endif
+    
+    if (is_vector(X) && (rows (X) == 1))
+      ## row vector
+      X=X(:);
+      transposed = true; 
+    endif
+
+    r = rows(X);
+    C = zeros (size (X));
+
+    tmp = X(2:r, :) .+ X(1:r-1,:);
+
+    if (rows(tmp) == 1)
+      C(2,:) = 0.5 * tmp;
+    else
+      C(2:r,:) = 0.5 * cumsum (tmp);
+    endif
+    
+    if (transposed) C = C'; endif
+
+  elseif (nargin == 2)
+
+    if !(is_matrix (X) && is_matrix (Y))
+      error ("arguments must be vectors or matrices of same size");
+    endif
+
+    if (size (X) == size (Y'))
+      X = X';
+    elseif (size (X) != size (Y))
+      error ("X and Y must have same shape");
+    endif
+
+    if (is_vector (Y) && (rows (Y) == 1))
+      ## Y is row vector
+      X = X (:); Y = Y (:);
+      transposed = true;
+    endif
+
+    r = rows (Y);
+    C = zeros (size (Y));
+
+    tmp = (X(2:r, :) .- X(1:r-1,:)) .* (Y(2:r,:) .+ Y(1:r - 1, :));
+
+    if (rows(tmp) == 1)
+      C(2,:) = 0.5 *tmp;
+    else
+      C(2:r,:) = 0.5 * cumsum (tmp);
+    endif
+
+    if (transposed) C = C'; endif
+
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/deal.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,38 @@
+## Copyright (C) 1998 Ariel Tankus
+## 
+## This program is free software.
+## This file is part of the Image Processing Toolbox for Octave
+##
+## This program is free software; you can redistribute it and/or
+## modify it under the terms of the GNU General Public License
+## as published by the Free Software Foundation; either version 2
+## of the License, or (at your option) any later version.
+## 
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+## 
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+##
+
+## deal    Split the input vector into the corresponding number of output
+##         parameters.  Possible usage: in functions where several input
+##         arguments can be gathered to a single argument.
+##
+##         [...] = deal(v)
+##         v - input vector.
+##         [x1, x2, ..., xn] - outputs, each contains a single element of
+##                             the vector v.
+##
+
+## Author: Ariel Tankus.
+## Created: 13.11.98.
+
+function [...] = deal(v)
+
+for i=1:nargout
+    vr_val(v(i));
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/del2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,115 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{D} =} del2 (@var{M})
+## @deftypefnx {Function File} {@var{D} =}del2 (@var{M}, @var{dx}, @var{dy})
+##
+## @var{D} = del2 (@var{M}) calculates the Laplace Operator
+##
+## @example
+##       1    / d^2            d^2         \
+## D  = --- * | ---  M(x,y) +  ---  M(x,y) | 
+##       4    \ dx^2           dx^2        /
+## @end example
+##
+## Spacing values for x and y direction can be provided by the
+## @var{dx}, @var{dy} parameters, otherwise the spacing is set to 1.
+## A scalar value specifies an equidistant spacing.
+## A vector value can be used to specify a variable spacing. The length
+## must match the respective dimension of @var{M}.
+##
+## You need at least 3 data points for each dimension.
+## Boundary points are calculated with y0'' and y2'' respectively.
+## For interior point y1'' is taken. 
+##
+## @example
+## y0''(i) = 1/(dy^2) *(y(i)-2*y(i+1)+y(i+2)).
+## y1''(i) = 1/(dy^2) *(y(i-1)-2*y(i)+y(i+1)).
+## y2''(i) = 1/(dy^2) *(y(i-2)-2*y(i-1)+y(i)).
+## @end example
+##
+## @end deftypefn
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function D = del2 (M, dx, dy)
+  
+  if ((nargin < 1) || (nargin > 3))
+    usage ("del2(M,dx,dy)");
+  elseif (nargin == 1)
+    dx = dy = 1;
+  elseif (nargin == 2)
+    dy = 1;
+  endif
+
+  if (!is_matrix (M))
+    error ("first argument must be a matrix");
+  else
+    if is_scalar (dx)
+      dx = dx * ones (1, columns(M) - 1);
+    else
+      if !(length(dx) == columns(M))
+        error ("columns of M must match length of dx")
+      else
+        dx = diff (dx);
+      endif
+    endif
+
+    if (is_scalar (dy))
+      dy = dy * ones (rows (M) - 1, 1);
+    else
+      if !(length(dy) == rows(M))
+        error ("rows of M must match length of dy")
+      else
+        dy = diff (dy);
+      endif
+    endif
+  endif
+
+  [mr,mc] = size (M);
+  D = zeros (size (M));
+
+  if (mr >= 3)  
+    ## x direction
+    ## left and right boundary
+    D(:, 1) = (M(:, 1) .- 2 * M(:, 2) + M(:, 3)) / (dx(1) * dx(2));
+    D(:, mc) = (M(:, mc - 2) .- 2 * M(:, mc - 1) + M(:, mc))\
+      / (dx(mc - 2) * dx(mc - 1));
+
+    ## interior points
+    D(:, 2:mc - 1) = D(:, 2:mc - 1)\
+      + (M(:, 3:mc) .- 2 * M(:, 2:mc - 1) + M(:, 1:mc - 2))\
+      ./ kron (dx(1:mc -2 ) .* dx(2:mc - 1), ones (mr, 1));
+  endif
+
+  if (mc >= 3)
+    ## y direction
+    ## top and bottom boundary
+    D(1, :) = D(1,:)\
+      + (M(1, :) .- 2 * M(2, :) + M(3, :)) / (dy(1) * dy(2));
+    D(mr, :) = D(mr, :)\
+      + (M(mr - 2,:) .- 2 * M(mr - 1, :) + M(mr, :))\
+      / (dy(mr - 2) * dx(mr - 1));
+    
+    ## interior points
+    D(2:mr - 1, :) = D(2:mr - 1, :)\
+      + (M(3:mr, :) .- 2 * M(2:mr - 1, :) + M(1:mr - 2, :))\
+      ./ kron (dy(1:mr - 2) .* dy(2:mr - 1), ones (1, mc));
+  endif
+
+  D = D ./ 4;
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/double.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,30 @@
+## Copyright (C) 1998 Ariel Tankus
+## 
+## This program is free software; you can redistribute it and/or
+## modify it under the terms of the GNU General Public License
+## as published by the Free Software Foundation; either version 2
+## of the License, or (at your option) any later version.
+## 
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+## 
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+##
+
+## double    Convert the characters of a string into its representation
+##           as a matrix of ascii codes.
+##
+
+## Author: Ariel Tankus <arielt@math.tau.ac.il>
+## Created: 15.6.98
+## Version: 1.0
+
+function d = double(str)
+
+  d = toascii(str);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/fcnchk.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,3 @@
+function f=fcnchk(x, n)
+  f = x;
+end
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/gradient.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,115 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{X} = } gradient (@var{M})
+## @deftypefnx {Function File} {[@var{X},@var{Y}] = }gradient (@var{M})
+## @deftypefnx {Function File} {[...] = }gradient (...,@var{dx},@var{dy})
+##
+## @var{X} = gradient (@var{M}) calculates the one dimensional
+## gradient if M is a vector. Is M a Matrix the gradient is calculated 
+## for each row.
+## [@var{X},@var{Y}] = gradient (@var{M}) calculates the one dimensinal
+## gradient for each direction if @var{M} is a matrix.
+## Spacing values between two points can be provided by the
+## @var{dx}, @var{dy} parameters, otherwise the spacing is set to 1.
+## A scalar value specifies an equidistant spacing.
+## A vector value can be used to specify a variable spacing. The length
+## must match their respective dimension of @var{M}.
+## 
+## At boundary points a linear extrapolation is applied. Interior points
+## are calculated with the first approximation of the numerical gradient
+## @example
+## y'(i) = 1/(x(i+1)-x(i-1)) *(y(i-1)-y(i+1)).
+## @end example
+## 
+## @end deftypefn
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function [...] = gradient (M, dx, dy)
+  
+  if ((nargin < 1) || (nargin > 3))
+    usage ("gradient(M,dx,dy)");
+  elseif (nargin == 1)
+    dx = dy = 1;
+  elseif (nargin == 2)
+    dy = 1;
+  endif
+
+  if (is_vector (M))
+    ## make a row vector
+    M = M(:)';
+  endif
+
+  if !(is_matrix (M))
+    error ("first argument must be a vector or matrix");
+  else
+    if (is_scalar (dx))
+      dx = dx * ones (1, columns (M) - 1);
+    else
+      if (length (dx) != columns (M))
+        error ("columns of M must match length of dx");
+      else
+        dx = diff (dx);
+        dx = dx(:)';
+      endif
+    endif
+
+    if (is_scalar (dy))
+      dy = dy * ones (rows (M) - 1, 1);
+    else
+      if (length (dy) != rows (M))
+        error ("rows of M must match length of dy")
+      else
+        dy = diff (dy);
+      endif
+    endif
+  endif
+  [mr, mc] = size (M);
+  X = zeros (size (M));
+
+  if (mc > 1)
+    ## left and right boundary
+    X(:, 1) = diff (M(:, 1:2)')' / dx(1);
+    X(:,mc) = diff (M(:, mc - 1:mc)')' / dx(mc - 1);
+  endif
+
+  if (mc > 2)
+    ## interior points
+    X(:, 2:mc - 1) = (M(:, 3:mc) .- M(:,1:mc - 2))\
+      ./ kron (dx(1:mc - 2) .+ dx(2:mc - 1), ones (mr, 1));
+    #  ./ (ones (mr, 1) * (dx(1:mc - 2) .+ dx(2:mc - 1)));
+  endif
+  vr_val (X);
+
+  if (nargout == 2)
+    Y = zeros (size (M));
+    if (mr > 1)
+      ## top and bottom boundary
+      Y(1, :) = diff (M(1:2, :)) / dy(1);
+      Y(mr, :) = diff (M(mr - 1:mr, :)) / dy(mr - 1);
+    endif
+
+    if (mr > 2)
+      ## interior points
+      Y(2:mr-1, :) = (M(3:mc, :) .- M(1:mc - 2, :))\
+        ./kron (dy(1:mr - 2) .+ dy(2:mr - 1), ones(1, mc));
+    endif
+    vr_val (Y);
+  
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/ifftshift.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,49 @@
+## Copyright (C) 1997 by Vincent Cautaerts
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this file.  If not, write to the Free Software Foundation,
+## 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} ifftshift (@var{v})
+## Undo the action of the fftshift function.  For even length @var{v}, fftshift
+## is its own inverse, but odd lengths differ slightly.
+## @end deftypefn
+
+## Author: Vincent Cautaerts <vincent@comf5.comm.eng.osaka-u.ac.jp>
+## Created: July 1997
+## Adapted-By: jwe
+## Modified-By: Paul Kienzle, converted from fftshift
+
+function retval = ifftshift (V)
+
+  retval = 0;
+
+  if (nargin != 1)
+    usage ("usage: ifftshift (X)");
+  endif
+
+  if (is_vector (V))
+    x = length (V);
+    xx = floor (x/2);
+    retval = V([xx+1:x, 1:xx]);
+  elseif (is_matrix (V))
+    [x, y] = size (V);
+    xx = floor (x/2);
+    yy = floor (y/2);
+    retval = V([xx+1:x, 1:xx], [yy+1:y, 1:yy]);
+  else
+    error ("ifftshift: expecting vector or matrix argument");
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/ind2sub.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,47 @@
+## Copyright (C) 2001  Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## [ s1, s2, ...] = ind2sub (dims, ind)
+## S = ind2sub (dims, ind)
+##
+## Convert a linear INDex into SUBscripts.  If only one output argument
+## is specified, then return a matrix, one column per subscript.
+##
+## See also: sub2ind
+
+## Author:        Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+
+function [ ... ] = ind2sub (dims, ind)
+
+  if ( nargin != 2 || all (nargout != [0, 1, length(dims)]) )
+    usage ("[s1 s2 ...] = ind2sub (dims, ind) or S = ind2sub (dims, ind)");
+  endif
+
+  dims = dims(:);
+  n = length(dims);
+  power = ones (length(ind), 1) * cumprod ( [1, dims(1:n-1)'] );
+  S = ind(:) * ones(1, n) - 1;
+  S = floor ( rem (S, dims(1)*power) ./ power ) + 1;
+
+  if nargout <= 1
+    vr_val(S);
+  else
+    for i=1:nargout
+      vr_val(S(:,i));
+    endfor
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/interp1.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,295 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: yi = interp1(x, y, xi [, 'method' [, 'extrap']])
+##
+## Interpolate the function y=f(x) at the points xi. The sample 
+## points x must be strictly monotonic.  If y is a matrix with
+## length(x) rows, yi will be a matrix of size rows(xi) by columns(y),
+## or its transpose if xi is a row vector.
+##
+## Method is one of:
+## 'nearest': return nearest neighbour.
+## 'linear': linear interpolation from nearest neighbours
+## 'pchip': piece-wise cubic hermite interpolating polynomial
+## 'cubic': cubic interpolation from four nearest neighbours
+## 'spline': cubic spline interpolation--smooth first and second
+##           derivatives throughout the curve
+## ['*' method]: same as method, but assumes x is uniformly spaced
+##               only uses x(1) and x(2); usually faster, never slower
+##
+## Method defaults to 'linear'.
+##
+## If extrap is the string 'extrap', then extrapolate values beyond
+## the endpoints.  If extrap is a number, replace values beyond the
+## endpoints with that number.  If extrap is missing, assume NaN.
+##
+## Example:
+##    xf=[0:0.05:10]; yf = sin(2*pi*xf/5);
+##    xp=[0:10];      yp = sin(2*pi*xp/5);
+##    lin=interp1(xp,yp,xf);
+##    spl=interp1(xp,yp,xf,'spline');
+##    cub=interp1(xp,yp,xf,'cubic');
+##    near=interp1(xp,yp,xf,'nearest');
+##    plot(xf,yf,';original;',xf,lin,';linear;',xf,spl,';spline;',...
+##         xf,cub,';cubic;',xf,near,';nearest;',xp,yp,'*;;');
+##
+## See also: interp
+
+## 2000-03-25 Paul Kienzle
+##    added 'nearest' as suggested by Kai Habel
+## 2000-07-17 Paul Kienzle
+##    added '*' methods and matrix y
+##    check for proper table lengths
+
+function yi = interp1(x, y, xi, method, extrap)
+
+  if nargin<3 || nargin>5
+    usage("yi = interp1(x, y, xi [, 'method' [, 'extrap']])");
+  endif
+
+  if nargin < 4, 
+    method = 'linear';
+  else
+    method = tolower(method); 
+  endif
+
+  if nargin < 5
+    extrap = NaN;
+  endif
+
+  ## reshape matrices for convenience
+  x = x(:);
+  if size(y,1)==1, y=y(:); endif
+  transposed = (size(xi,1)==1);
+  xi = xi(:);
+
+  ## determine sizes
+  nx = size(x,1);
+  [ny, nc] = size(y);
+  if (nx < 2 || ny < 2)
+     error ("interp1: table too short");
+  endif
+
+  ## determine which values are out of range and set them to extrap,
+  ## unless extrap=='extrap' in which case, extrapolate them like we
+  ## should have done in the first place.
+  minx = x(1);
+  if (method(1) == '*')
+     dx = x(2) - x(1);
+     maxx = minx + (ny-1)*dx;
+  else
+     maxx = x(nx);
+  endif
+  if strcmp(extrap,"extrap")
+    range=1:nx;
+  else
+    range = find(xi >= minx & xi <= maxx);
+    yi = extrap*ones(size(xi,1), size(y,2));
+    if isempty(range), 
+      if transposed, yi = yi.'; endif
+      return; 
+    endif
+    xi = xi(range);
+  endif
+
+  if strcmp(method, 'nearest')
+    idx = lookup(0.5*(x(1:nx-1)+x(2:nx)), xi)+1;
+    yi(range,:) = y(idx,:);
+
+  elseif strcmp(method, '*nearest')
+    idx = floor((xi-minx)/dx+1.5);
+    yi(range,:) = y(idx,:);
+
+  elseif strcmp(method, 'linear')
+    ## find the interval containing the test point
+    idx = lookup (x(2:nx-1), xi)+1; 
+				# 2:n-1 so that anything beyond the ends
+				# gets dumped into an interval
+
+    ## use the endpoints of the interval to define a line
+    dy = y(2:ny,:) - y(1:ny-1,:);
+    dx = x(2:nx) - x(1:nx-1);
+    s = (xi - x(idx))./dx(idx);
+    yi(range,:) = s(:,ones(1,nc)).*dy(idx,:) + y(idx,:);
+
+  elseif strcmp(method, '*linear')
+    ## find the interval containing the test point
+    t = (xi - minx)/dx + 1;
+    idx = floor(t);
+
+    ## use the endpoints of the interval to define a line
+    dy = [y(2:ny,:) - y(1:ny-1,:); zeros(1,nc)];
+    s = (t - idx)./dx;
+    yi(range,:) = s(:,ones(1,nc)).*dy(idx,:) + y(idx,:); 
+
+  elseif strcmp(method, 'pchip')
+    if (nx == 2) x = linspace(minx, maxx, ny); endif
+    yi(range,:) = pchip(x, y, xi);
+
+  elseif strcmp(method, 'cubic')
+    if (nx < 4 || ny < 4)
+      error ("interp1: table too short");
+    endif
+    idx = lookup(x(3:nx-2), xi) + 1;
+
+    ## Construct cubic equations for each interval using divided
+    ## differences (computation of c and d don't use divided differences
+    ## but instead solve 2 equations for 2 unknowns). Perhaps
+    ## reformulating this as a lagrange polynomial would be more efficient.
+    i=1:nx-3;
+    J = ones(1,nc);
+    dx = diff(x);
+    dx2 = x(i+1).^2 - x(i).^2;
+    dx3 = x(i+1).^3 - x(i).^3;
+    a=diff(y,3)./dx(i,J).^3/6;
+    b=(diff(y(1:nx-1,:),2)./dx(i,J).^2 - 6*a.*x(i+1,J))/2;
+    c=(diff(y(1:nx-2,:),1) - a.*dx3(:,J) - b.*dx2(:,J))./dx(i,J);
+    d=y(i,:) - ((a.*x(i,J) + b).*x(i,J) + c).*x(i,J);
+    yi(range,:) = ((a(idx,:).*xi(:,J) + b(idx,:)).*xi(:,J) ...
+		   + c(idx,:)).*xi(:,J) + d(idx,:);
+
+  elseif strcmp(method, '*cubic')
+    if (nx < 4 || ny < 4)
+      error ("interp1: table too short");
+    endif
+
+    ## From: Miloje Makivic 
+    ## http://www.npac.syr.edu/projects/nasa/MILOJE/final/node36.html
+    t = (xi - minx)/dx + 1;
+    idx = max(min(floor(t), ny-2), 2);
+    t = t - idx;
+    t2 = t.*t;
+    tp = 1 - 0.5*t;
+    a = (1 - t2).*tp;
+    b = (t2 + t).*tp;
+    c = (t2 - t).*tp/3;
+    d = (t2 - 1).*t/6;
+    J = ones(1,nc);
+    yi(range,:) = a(:,J) .* y(idx,:) + b(:,J) .* y(idx+1,:) ...
+		  + c(:,J) .* y(idx-1,:) + d(:,J) .* y(idx+2,:);
+
+  elseif strcmp(method, 'spline') || strcmp(method, '*spline')
+    if (nx == 2) x = linspace(minx, maxx, ny); endif
+    yi(range,:) = spline(x, y, xi);
+
+  else
+    error(["interp1 doesn't understand method '", method, "'"]);
+  endif
+  if transposed, yi=yi.'; endif
+
+endfunction
+
+%!demo
+%! xf=0:0.05:10; yf = sin(2*pi*xf/5);
+%! xp=0:10;      yp = sin(2*pi*xp/5);
+%! lin=interp1(xp,yp,xf,'linear');
+%! spl=interp1(xp,yp,xf,'spline');
+%! cub=interp1(xp,yp,xf,'pchip');
+%! near=interp1(xp,yp,xf,'nearest');
+%! plot(xf,yf,';original;',xf,near,';nearest;',xf,lin,';linear;',...
+%!      xf,cub,';pchip;',xf,spl,';spline;',xp,yp,'*;;');
+%! %--------------------------------------------------------
+%! % confirm that interpolated function matches the original
+
+%!demo
+%! xf=0:0.05:10; yf = sin(2*pi*xf/5);
+%! xp=0:10;      yp = sin(2*pi*xp/5);
+%! lin=interp1(xp,yp,xf,'*linear');
+%! spl=interp1(xp,yp,xf,'*spline');
+%! cub=interp1(xp,yp,xf,'*cubic');
+%! near=interp1(xp,yp,xf,'*nearest');
+%! plot(xf,yf,';*original;',xf,near,';*nearest;',xf,lin,';*linear;',...
+%!      xf,cub,';*cubic;',xf,spl,';*spline;',xp,yp,'*;;');
+%! %--------------------------------------------------------
+%! % confirm that interpolated function matches the original
+
+%!shared xp, yp, xi, style
+%! xp=0:5;      yp = sin(2*pi*xp/5);
+%! xi = sort([-1, max(xp)*rand(1,6), max(xp)+1]);
+
+%!test style = 'nearest';
+%!assert (interp1(xp, yp, [-1, max(xp)]), [NaN, NaN]);
+%!assert (interp1(xp,yp,xp,style), yp, 100*eps);
+%!assert (interp1(xp,yp,xp',style), yp', 100*eps);
+%!assert (interp1(xp',yp',xp',style), yp', 100*eps);
+%!assert (interp1(xp',yp',xp,style), yp, 100*eps);
+%!assert (isempty(interp1(xp',yp',[],style)));
+%!assert (isempty(interp1(xp,yp,[],style)));
+%!assert (interp1(xp,[yp',yp'],xi(:),style),...
+%!	  [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]);
+%!assert (interp1(xp,[yp',yp'],xi,style),
+%!	  interp1(xp,[yp',yp'],xi,["*",style]));
+
+%!test style = 'linear';
+%!assert (interp1(xp, yp, [-1, max(xp)+1]), [NaN, NaN]);
+%!assert (interp1(xp,yp,xp,style), yp, 100*eps);
+%!assert (interp1(xp,yp,xp',style), yp', 100*eps);
+%!assert (interp1(xp',yp',xp',style), yp', 100*eps);
+%!assert (interp1(xp',yp',xp,style), yp, 100*eps);
+%!assert (isempty(interp1(xp',yp',[],style)));
+%!assert (isempty(interp1(xp,yp,[],style)));
+%!assert (interp1(xp,[yp',yp'],xi(:),style),...
+%!	  [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]);
+%!assert (interp1(xp,[yp',yp'],xi,style),
+%!	  interp1(xp,[yp',yp'],xi,["*",style]),100*eps);
+
+%!test style = 'cubic';
+%!assert (interp1(xp, yp, [-1, max(xp)+1]), [NaN, NaN]);
+%!assert (interp1(xp,yp,xp,style), yp, 100*eps);
+%!assert (interp1(xp,yp,xp',style), yp', 100*eps);
+%!assert (interp1(xp',yp',xp',style), yp', 100*eps);
+%!assert (interp1(xp',yp',xp,style), yp, 100*eps);
+%!assert (isempty(interp1(xp',yp',[],style)));
+%!assert (isempty(interp1(xp,yp,[],style)));
+%!assert (interp1(xp,[yp',yp'],xi(:),style),...
+%!	  [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]);
+%!assert (interp1(xp,[yp',yp'],xi,style),
+%!	  interp1(xp,[yp',yp'],xi,["*",style]),1000*eps);
+
+%!test style = 'spline';
+%!assert (interp1(xp, yp, [-1, max(xp) + 1]), [NaN, NaN]);
+%!assert (interp1(xp,yp,xp,style), yp, 100*eps);
+%!assert (interp1(xp,yp,xp',style), yp', 100*eps);
+%!assert (interp1(xp',yp',xp',style), yp', 100*eps);
+%!assert (interp1(xp',yp',xp,style), yp, 100*eps);
+%!assert (isempty(interp1(xp',yp',[],style)));
+%!assert (isempty(interp1(xp,yp,[],style)));
+%!assert (interp1(xp,[yp',yp'],xi(:),style),...
+%!	  [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]);
+%!assert (interp1(xp,[yp',yp'],xi,style),
+%!	  interp1(xp,[yp',yp'],xi,["*",style]),10*eps);
+
+%!error interp1
+%!error interp1(1:2,1:2,1,'bogus')
+
+%!error interp1(1,1,1, 'nearest');
+%!assert (interp1(1:2,1:2,1.4,'nearest'),1);
+%!error interp1(1,1,1, 'linear');
+%!assert (interp1(1:2,1:2,1.4,'linear'),1.4);
+%!error interp1(1:3,1:3,1, 'cubic');
+%!assert (interp1(1:4,1:4,1.4,'cubic'),1.4);
+%!error interp1(1:2,1:2,1, 'spline');
+%!assert (interp1(1:3,1:3,1.4,'spline'),1.4);
+
+%!error interp1(1,1,1, '*nearest');
+%!assert (interp1(1:2,1:2,1.4,'*nearest'),1);
+%!error interp1(1,1,1, '*linear');
+%!assert (interp1(1:2,1:2,1.4,'*linear'),1.4);
+%!error interp1(1:3,1:3,1, '*cubic');
+%!assert (interp1(1:4,1:4,1.4,'*cubic'),1.4);
+%!error interp1(1:2,1:2,1, '*spline');
+%!assert (interp1(1:3,1:3,1.4,'*spline'),1.4);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/interp2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,202 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{zi}=} interp2 (@var{x}, @var{y}, @var{z}, @var{xi}, @var{yi})
+## @deftypefnx {Function File} {@var{zi}=} interp2 (@var{Z}, @var{xi}, @var{yi})
+## @deftypefnx {Function File} {@var{zi}=} interp2 (@var{Z}, @var{n})
+## @deftypefnx {Function File} {@var{zi}=} interp2 (... , '@var{method}')
+## Two-dimensional interpolation. @var{X},@var{Y} and @var{Z} describe a
+## surface function. If @var{X} and @var{Y} are vectors their length
+## must correspondent to the size of @var{Z}. If they are matrices they
+## must have the 'meshgrid' format. 
+##
+## ZI = interp2 (X, Y, Z, XI, YI, ...) returns a matrix corresponding
+## to the points described by the matrices @var{XI}, @var{YI}. 
+##
+## If the last argument is a string, the interpolation method can
+## be specified. At the moment only 'linear' and 'nearest' methods
+## are provided. If it is omitted 'linear' interpolation  is 
+## assumed.
+##
+## ZI = interp2 (Z, XI, YI) assumes X = 1:rows(Z) and Y = 1:columns(Z)
+## 
+## ZI = interp2 (Z, n) interleaves the Matrix Z n-times. If n is ommited
+## n = 1 is assumed
+##
+## @seealso{interp1}
+## @end deftypefn
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+
+function ZI = interp2 (X, Y, Z, XI, YI, method)
+
+  if (nargin > 6 || nargin == 0)
+    usage ("interp2 (X, Y, Z, XI, YI, method)");
+  endif
+
+  if (nargin > 4)
+    if (is_vector (X) && is_vector (Y))
+      [rz, cz] = size (Z);
+      if (rz != length (Y) || cz != length (X))
+        error ("length of X and Y must match the size of Z");
+      endif
+      [X, Y] = meshgrid (X, Y);
+    elseif !( (size (X) == size (Y)) && (size (X) == size (Z)) )
+      error ("X,Y and Z must be matrices of same size");
+    endif
+  endif
+  
+  if (((nargin == 4) || (nargin == 3)) && !isstr (Z))
+   
+    if (nargin == 4)
+      if (isstr (XI))
+        method = XI;
+      else
+        usage("interp2 (z,xi,yi,'format'");
+      endif
+    endif
+    XI = Y;
+    YI = Z;
+    Z = X;
+    [X, Y] = meshgrid(1:columns(Z), 1:rows(Z));
+  else
+    if (nargin == 1)
+      n = 1;
+    elseif (nargin == 2)
+      if (isstr (Y))
+        method = Y;
+        n = 1;
+      elseif (is_scalar (Y))
+        n = Y;
+      endif
+    else
+      n = Y;
+      if (isstr (Z))
+        method = Z;
+      endif
+    endif
+    Z = X;
+    [zr, zc] = size (Z);
+    [X, Y] = meshgrid (1:zc, 1:zr);
+    xi = linspace (1, zc, pow2 (n) * (zc - 1) + 1);
+    yi = linspace (1, zr, pow2 (n) * (zr - 1) + 1);
+    [XI, YI] = meshgrid (xi, yi);
+  endif
+
+  if (! exist ("method"))
+    method = "linear";
+  endif
+
+  xtable = X(1, :);
+  ytable = Y(:, 1);
+
+  if (is_vector (XI) && is_vector (YI))
+    [XI, YI] = meshgrid (XI, YI);
+  elseif (! (size (XI) == size (YI)))
+    error ("XI and YI must be matrices of same size");
+  endif
+
+  ytlen = length (ytable);
+  xtlen = length (xtable);
+
+  ## get x index of values in XI
+  xtable(xtlen) *= (1 + eps);
+  xtable(xtlen) > XI(1, :);
+  [m, n] = sort ([xtable(:); XI(1, :)']);
+  o = cumsum (n <= xtlen);
+  xidx = o([find (n > xtlen)])';
+
+  ## get y index of values in YI
+  ytable(ytlen) *= (1 + eps);
+  [m, n]=sort ([ytable(:); YI(:, 1)]);
+  o = cumsum (n <= ytlen);
+  yidx = o([find (n > ytlen)]);
+
+  [zr, zc] = size (Z);
+
+  ## mark values outside the lookup table
+  xfirst_val = find (XI(1,:) < xtable(1));
+  xlast_val  = find (XI(1,:) > xtable(xtlen));
+  yfirst_val = find (YI(:,1) < ytable(1));
+  ylast_val  = find (YI(:,1) > ytable(ytlen));
+
+  ## set value outside the table preliminary to min max index
+  yidx(yfirst_val) = 1;
+  xidx(xfirst_val) = 1;
+  yidx(ylast_val) = zr - 1;
+  xidx(xlast_val) = zc - 1;
+
+  if strcmp (method, "linear")
+    ## each quad satisfies the equation z(x,y)=a+b*x+c*y+d*xy
+    ##
+    ## a-b
+    ## | |
+    ## c-d
+    a = Z(1:zr - 1, 1:zc - 1);
+    b = Z(1:zr - 1, 2:zc) - a;
+    c = Z(2:zr, 1:zc - 1) - a;
+    d = Z(2:zr, 2:zc) - a - b - c;
+
+    ## scale XI,YI values to a 1-spaced grid
+    Xsc = (XI .- X(yidx, xidx)) ./ (X(yidx, xidx + 1) - X(yidx, xidx));
+    Ysc = (YI .- Y(yidx, xidx)) ./ (Y(yidx + 1, xidx) - Y(yidx, xidx));
+    ## apply plane equation
+    ZI = a(yidx, xidx) .+ b(yidx, xidx) .* Xsc \
+      .+ c(yidx, xidx) .* Ysc .+ d(yidx, xidx) .* Xsc .* Ysc;
+  elseif strcmp (method, "nearest")
+    i = XI(1, :) - xtable(xidx) > xtable(xidx + 1) - XI(1, :);
+    j = YI(:, 1) - ytable(yidx) > ytable(yidx + 1) - YI(:, 1);
+    ZI = Z(yidx + j, xidx + i);
+  else
+    error ("interpolation method not (yet) supported");
+  endif
+
+  ## set points outside the table to NaN
+  if (! (isempty (xfirst_val) && isempty (xlast_val)))
+    ZI(:, [xfirst_val, xlast_val]) = NaN;
+  endif
+  if (! (isempty (yfirst_val) && isempty (ylast_val)))
+    ZI([yfirst_val; ylast_val], :) = NaN;
+  endif
+endfunction
+
+%!demo
+%! A=[13,-1,12;5,4,3;1,6,2];
+%! x=[0,1,4]; y=[10,11,12];
+%! xi=linspace(min(x),max(x),17);
+%! yi=linspace(min(y),max(y),26);
+%! mesh(xi,yi,interp2(x,y,A,xi,yi,'linear'));
+%! [x,y] = meshgrid(x,y); gset nohidden3d;
+%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off;
+
+%!demo
+%! A=[13,-1,12;5,4,3;1,6,2];
+%! x=[0,1,4]; y=[10,11,12];
+%! xi=linspace(min(x),max(x),17);
+%! yi=linspace(min(y),max(y),26);
+%! mesh(xi,yi,interp2(x,y,A,xi,yi,'nearest'));
+%! [x,y] = meshgrid(x,y); gset nohidden3d;
+%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off;
+
+%!#demo
+%! A=[13,-1,12;5,4,3;1,6,2];
+%! x=[0,1,2]; y=[10,11,12];
+%! xi=linspace(min(x),max(x),17);
+%! yi=linspace(min(y),max(y),26);
+%! mesh(xi,yi,interp2(x,y,A,xi,yi,'cubic'));
+%! [x,y] = meshgrid(x,y); gset nohidden3d;
+%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/interpft.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,71 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## y = interpft (x, n)
+## Resample x with n points using Fourier interpolation.
+## The data x must be equally spaced and n >= length(x).
+
+## Author: Paul Kienzle
+## 2001-02-11
+##    * initial version
+
+function z = interpft (x, n)
+  if (nargin < 2 || nargin > 3)
+    usage ("y=interpft (x, n)");
+  endif
+
+  transpose = ( rows (x) == 1 ); 
+  if (transpose) x = x (:); endif
+  [nr, nc] = size (x);
+  if n > nr
+    y = fft (x) / nr;
+    k = floor (nr / 2);
+    z = n * ifft ( [ y(1:k,:); zeros(n-nr,nc); y(k+1:nr) ] );
+    if isreal (x), z = real (z); endif
+  elseif n < nr
+    error ("interpft: n must be bigger than x");
+    ## XXX FIXME XXX the following doesn't work so well
+    y = fft (x) / nr;
+    k = ceil (n / 2);
+    z = n * ifft ( [ y(1:k,:); y(nr-k+2:nr) ] );
+    if isreal (x), z = real (z); endif
+  else
+    z = x;
+  endif
+  if transpose, z = z.'; endif
+endfunction
+
+%!demo
+%! t = 0 : 0.3 : pi; dt = t(2)-t(1);
+%! n = length (t); k = 100;
+%! ti = t(1) + [0 : k-1]*dt*n/k;
+%! y = sin (4*t + 0.3) .* cos (3*t - 0.1);
+%! yp = sin (4*ti + 0.3) .* cos (3*ti - 0.1);
+%! plot (ti, yp, 'g;sin(4t+0.3)cos(3t-0.1);', ...
+%!       ti, interp1 (t, y, ti, 'spline'), 'b;spline;', ...
+%!       ti, interpft (y, k), 'c;interpft;', ...
+%!       t, y, 'r+;data;');
+
+%!#demo
+%! t = 0:0.3:pi; dt = t(2)-t(1);
+%! n = length(t); k = 100;
+%! ti = t(1)+[0:k-1]*dt*n/k;
+%! y = sin (4*t+0.3).*cos(3*t-0.1);
+%! yp = sin (4*ti+0.3).*cos(3*ti-0.1);
+%! plot (ti, yp, 'g;sin(4t+0.3)cos(3t-0.1);', ...
+%!       t, interp1(ti,yp,t,'spline'), 'bx;spline;', ...
+%!       t, interpft(yp,n), 'co;interpft;', ...
+%!       t, y, 'r+;data;');
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/isequal.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,45 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## isequal(x1, x2, ...)
+##    true if all parts of x1, x2, ... are equal
+
+##TODO: list comparison
+function t = isequal(x,y,...)
+  if is_struct(x)
+    if (!is_struct (y))
+      t = 0;
+    else
+      xel = struct_elements (x);
+      yel = struct_elements (y);
+      if (any (any (xel != yel)))
+	t = 0;
+      else
+	for i=1:length (xel)
+      	  t = eval (["isequal(x.", xel(i), ", y.", yel(i), ");"]);
+	  if t == 0, break; endif
+	endfor
+      endif
+    endif
+  elseif any (size (x) != size (y))
+    t = 0;
+  else
+    t = all(all(x==y));
+  endif
+  if nargin > 2 && t == 1
+     t = isequal(x, all_va_args);
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/isunix.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,3 @@
+function x = isunix
+  x=!0;
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/lasterr.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,26 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: p=lasterr
+##
+## returns the last error message
+##
+## lasterr('text') does nothing, but is provided for compatibility
+##
+## Limitations: only returns error if called from catch portion of
+## a try/catch block; doesn't seem to work from 2.1.31. Confirm?
+function p=lasterr(s)
+  p=__error_text__;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/lookup.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,82 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: idx = lookup(table, y)
+##
+## If table is strictly increasing and idx=lookup(table, y), then
+##    table(idx(i)) <= y(i) < table(idx(i+1))
+## for all y(i) within the table.  If y(i) is before the table, then 
+## idx(i) is 0. If y(i) is after the table then idx(i) is table(n).
+## If the table is strictly decreasing, then the tests are reversed.
+## No guarantees for tables which are non-monotonic or are not strictly
+## monotonic.
+##
+## To get an index value which lies within an interval of the table
+## use:
+##      idx = lookup(table(2:length(table)-1), y) - 1
+## This puts values before the table into the first interval, and values
+## after the table into the last interval.
+
+## Changed from binary search to sort.
+## Thanks to Kai Habel <kai.habel@gmx.de> for the suggestion.
+
+## TODO: sort-based lookup is significantly slower given a large table
+## TODO: and small lookup vector.  This shouldn't be a problem since
+## TODO: interpolation (the reason for the table lookup in the first
+## TODO: place) usually involves subsampling of an existing table.  The
+## TODO: other use of interpolation, looking up values one at a time, is
+## TODO: unfortunately significantly slower for large tables.  
+## TODO:    sort is order O((lt+lx)*log(lt+lx)) 
+## TODO:    search is order O(lx*log(lt))
+## TODO: Clearly, search is asymptotically better than sort, but sort
+## TODO: is compiled and search is not.  Could support both, or recode
+## TODO: search in C++, or assume things are good enough as they stand.
+function idx=lookup(table,xi)
+  if isempty (table)
+    idx = zeros(size(xi));
+  elseif is_vector(table)
+    [nr, nc] = size(xi);
+    lt=length(table);
+    if ( table(1) > table(lt) )
+      ## decreasing table
+      [v, p] = sort ([xi(:) ; table(:)]);
+      idx (p) = cumsum (p > nr*nc);
+      idx = lt - idx (1 : nr*nc);
+    else
+      ## increasing table
+      [v, p] = sort ([table(:) ; xi(:) ]);
+      idx (p) = cumsum (p <= lt);
+      idx = idx (lt+1 : lt+nr*nc);
+    endif
+    idx = reshape (idx, nr, nc);
+  else
+    error ("lookup: table must be a vector");
+  endif
+endfunction
+  
+%!assert (lookup(1:3, 0.5), 0)     # value before table
+%!assert (lookup(1:3, 3.5), 3)     # value after table error
+%!assert (lookup(1:3, 1.5), 1)     # value within table error
+%!assert (lookup(1:3, [3,2,1]), [3,2,1])
+%!assert (lookup([1:4]', [1.2, 3.5]'), [1, 3]');
+%!assert (lookup([1:4], [1.2, 3.5]'), [1, 3]');
+%!assert (lookup([1:4]', [1.2, 3.5]), [1, 3]);
+%!assert (lookup([1:4], [1.2, 3.5]), [1, 3]);
+%!assert (lookup(1:3, [3, 2, 1]), [3, 2, 1]);
+%!assert (lookup([3:-1:1], [3.5, 3, 1.2, 2.5, 2.5]), [0, 1, 2, 1, 1])
+%!assert (isempty(lookup([1:3], [])))
+%!assert (isempty(lookup([1:3]', [])))
+%!assert (lookup(1:3, [1, 2; 3, 0.5]), [1, 2; 3, 0]);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/polyarea.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,49 @@
+## Copyright (C) 1999 David M. Doolin 
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## A = polyarea(X,Y)
+##
+## Determines area of a polygon by triangle method.
+##
+## input:
+##   polygon:  x, y form vertex pairs, one polygon per column.
+##
+## output:
+##   area:  Area of polygons.
+##
+## todo:  Add moments for centroid, etc.
+##
+## bugs and limitations:  
+##        Probably ought to be an optional check to make sure that
+##        traversing the vertices doesn't make any sides cross 
+##        (Is simple closed curve the technical definition of this?). 
+
+## Author: doolin $  doolin@ce.berkeley.edu
+## Date: 1999/04/14 15:52:20 $
+## Modified-by: 
+##    2000-01-15 Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    * use matlab compatible interface
+##    * return absolute value of area so traversal order doesn't matter
+
+function a = polyarea (x, y)
+  if (nargin != 2)
+    usage ("polyarea (x, y)");
+  elseif any (size(x) != size(y))
+    error ("polyarea: x and y must have the same shape");
+  else
+    a = abs ( sum (x .* shift (y,-1))  - sum (y .* shift (x, -1)) ) / 2;
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/randperm.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,31 @@
+## Copyright (C) 2000  Stephen Eglen
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Return a random permutation of the integers 1 to N.
+##
+## Example:
+## randperm(5)'
+## ans = 1 4 5 3 2
+
+## Author: Stephen Eglen <stephen@cogsci.ed.ac.uk>
+## Source: http://www.che.wisc.edu/octave/mailing-lists/octave-sources/2000/39
+
+function y = randperm(n)
+  if nargin != 1
+    usage("randperm (n)");
+  endif
+  [ordered_nums, y] = sort(rand(n,1));
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/rat.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,70 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## [n,d] = rat(x,tol)
+## Find a rational approximation to x within tolerance using a continued
+## fraction expansion. E.g,
+##
+##    rat(pi) = 3 + 1/(7 + 1/16) = 355/113
+##    rat(e) = 3 + 1/(-4 + 1/(2 + 1/(5 + 1/(-2 + 1/(-7))))) = 1457/536
+
+function [n,d] = rat(x,tol)
+
+  if (nargin != [1,2] || nargout != 2)
+    usage("[n,d] = rat(x,tol)");
+  endif
+
+  y = x(:);
+  if (nargin < 2)
+    tol = 1e-6 * norm(y,1);
+  endif
+
+  ## First step in the approximation is the integer portion
+  n = round(y);  # first element in the continued fraction
+  d = ones(size(y));
+  frac = y-n;
+  lastn = ones(size(y));
+  lastd = zeros(size(y));
+
+  ## grab new factors until all continued fractions converge
+  while (1)
+    ## determine which fractions have not yet converged
+    idx = find (abs(y-n./d) >= tol);
+    if (isempty(idx)) break; endif
+
+    ## grab the next step in the continued fraction
+    flip = 1./frac(idx);
+    step = round(flip); # next element in the continued fraction
+    frac(idx) = flip-step;
+
+    ## update the numerator/denominator
+    nextn = n;
+    nextd = d;
+    n(idx) = n(idx).*step + lastn(idx);
+    d(idx) = d(idx).*step + lastd(idx);
+    lastn = nextn;
+    lastd = nextd;
+  endwhile
+
+  ## move the minus sign to the top
+  n = n.*sign(d);
+  d = abs(d);
+
+  ## return the same shape as you receive
+  n = reshape(n, size(x));
+  d = reshape(d, size(x));
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/rats.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,57 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## S = rat(x,tol)
+## Convert x into a rational approximation represented as a string.  You
+## can convert the string back into a matrix as follows:
+##
+##    eval(["[",rats(hilb(4)),"];"])
+
+function T = rats(x)
+  if nargin != 1
+    usage("S = rats(x)");
+  endif
+
+  [n, d] = rat(x');
+  [nr, nc] = size(x);
+
+  len = nr*nc;
+  S = sprintf("%d/%d ", [n(:), d(:)]');
+  if (len == 1)
+    T = S;
+  else
+    index = findstr(S, "/1 ");
+    if (index)
+      S = toascii(S);
+      S([index, index+1]) = [];
+      S = setstr(S);
+    endif
+    index = find(S == " ");
+    shift = [index(1), diff(index)];
+    cellsize = max(shift);
+    shift = cellsize - shift;
+    assign = ones(size(S));
+    index = index(1:len-1);
+    assign([1,index]) = assign([1,index]) + ceil(shift/2);
+    assign(index) = assign(index) + floor(shift(1:len-1)/2);
+    assign = cumsum(assign);
+    T = setstr(toascii(" ")*ones(1, nr*nc*cellsize+1));
+    T(assign+1) = S;
+    T(nc*cellsize+1:nc*cellsize:nr*nc*cellsize) = "\n";
+    T(1)='\n';
+  endif
+
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/repmat.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,54 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} repmat (@var{A}, @var{m}, @var{n})
+## @deftypefnx {Function File} {} repmat (@var{A}, [@var{m} @var{n}])
+## Form a block matrix of size @var{m} by @var{n}, with a copy of matrix
+## @var{A} as each element.  If @var{n} is not specified, form an 
+## @var{m} by @var{m} block matrix.
+## @end deftypefn
+
+## Author: Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+## Created: July 2000
+
+## 2001-06-27 Paul Kienzle <pkienzle@users.sf.net>
+## * cleaner, slightly faster code 
+
+function x = repmat (b, m, n)
+  if (nargin < 2 || nargin > 3)
+    usage ("repmat (a, m, n)");
+  endif
+
+  if nargin == 2
+    if is_scalar (m)
+      n = m;
+    elseif (is_vector (m) && length (m) == 2)
+      n = m (2);
+      m = m (1);
+    else
+      error ("repmat: only builds 2D matrices")
+    endif
+  endif
+
+  [rb, cb] = size (b);
+  if (isempty (b))
+    x = zeros (m*rb, n*cb);
+  else
+    x = b ([1:rb]' * ones(1,m), [1:cb]' * ones(1,n));
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/sortrows.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,61 @@
+## Copyright (C) 2000 Daniel Calvelo
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## B = sortrows (A)
+##     returns matrix with rows sorted "lexicographically" (i.e., 
+##
+## B = sortrows(A, c)
+##     returns matrix with rows sorted according to the order of the
+##     columns specified in c.
+##
+## Set implicit_str_to_num_ok and implicit_num_to_str_ok to 1 if you 
+## use this for string sorting.
+
+## Author: Daniel Calvelo
+## 2001-02-24 Paul Kienzle
+##    * cleanup according to Octave conventions
+##    * return reverse index
+##    * handle string arguments
+
+function [s, i] = sortrows (m, c)
+  
+  if nargin < 2
+    indices = [ 1 : size(m,2) ]';
+  else
+    indices = c (:);
+  endif
+
+  if (isstr (m)) 
+    s = toascii (m);
+  else
+    s = m;
+  endif
+
+  ## since sort is 'stable' the order of identical elements will be
+  ## preserved, so by traversing the sort indices in reverse order
+  ## we will make sure that identical elements in index i are subsorted
+  ## by index j.
+  indices = flipud (indices);
+  i = [1 : size(m,1)]';
+  for ii = 1 : length (indices);
+    [ trash, idx ] = sort ( s ( : , indices (ii) ) ); 
+    s = s ( idx, : );
+    i = i (idx );
+  endfor
+  if (isstr (m))
+    s = setstr(s);
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/sub2ind.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,58 @@
+## Copyright (C) 2001  Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## ind = sub2ind (dims, s1, s2, ...)
+## ind = sub2ind (dims, S)
+##
+## Convert SUBscripts into a linear INDex.  If S is a matrix, use
+## one column per subscript.
+##
+## See also: ind2sub
+
+## Author:        Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+
+function ind = sub2ind (dims, s, ...)
+
+  if nargin-1 == length (dims)
+
+    ind = s(:);
+    n = length ( ind );
+    scale = cumprod(dims(:));
+    va_start();
+    for i=1:nargin-2
+      v = va_arg();
+      if (length(v) != n)
+	error("sub2ind: each index must have the same length");
+      endif
+      ind = ind + (v(:)-1)*scale(i);
+    endfor
+    ind = reshape(ind, size(s));
+    
+  elseif nargin == 2
+    
+    if ( columns(s) != length(dims))
+      error("sub2ind: needs one column per dimension\n");
+    endif
+    scale = cumprod(dims(:));
+    ind = (s-1) * [ 1; scale(1:length(dims)-1) ] + 1;
+
+  else
+    
+    error("sub2ind: needs one index per dimension\n");
+    
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/transpose.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,32 @@
+## Copyright (C) 2001 Laurent Mazet
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: y = transpose (x)
+##
+## Generate the non-conjugate transpose. Equivalent to x.'
+##
+## x: input matrix.
+##
+## y: non-conjugate transpose of x.
+
+## 2001 FEB 07
+##   initial release
+
+function y = transpose (x)  
+
+  y = x.';
+  
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/trapz.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,85 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{I} =} trapz (@var{Y})
+## @deftypefnx {Function File} {@var{I} =}trapz (@var{X},@var{Y})
+## 
+## numerical intergration using trapezodial method.
+## trapz (@var{y}) computes the integral of the vector y. If y is a 
+## matrix the integral is computed columnwise.
+## If the argument @var{X} is omitted a equally spaced vector is assumed. 
+## trapz (@var{X},@var{Y}) evaluates the integral with respect to @var{X}
+##  
+## @seealso{cumtrapz}
+## @end deftypefn
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+##
+## also: June 2000 - Paul Kienzle (fixes,suggestions) 
+
+function I = trapz (X, Y)
+	
+  if (nargin < 1) || (nargin > 2)
+    usage ("trapz (X, Y)");
+  elseif (nargin == 1)
+
+    if !(is_matrix (X))
+      error ("argument must be vector or matrix");
+    endif
+    
+    if (is_vector(X))
+      X=X(:);
+    endif
+
+    r = rows(X);
+	
+    tmp = X (2:r, :) .+ X (1:r-1,:);
+
+    if (rows(tmp) == 1)
+      I = 0.5 * tmp;
+    else
+      I = 0.5 * sum (tmp);
+    endif
+
+  elseif (nargin == 2)
+
+    if !(is_matrix (X) && is_matrix (Y))
+      error ("arguments must be vectors or matrices of same size");
+    endif
+
+    if (size (X) == size (Y'))
+      Y = Y';
+    elseif (size (X) != size (Y))
+      error ("X and Y must have same shape");
+    endif
+
+    if (is_vector (X))
+      X = X (:); Y = Y (:);
+    endif
+
+    r = rows (X);
+	
+    tmp = (X(2:r, :) .- X(1:r-1,:)) .* (Y(2:r,:) .+ Y(1:r - 1, :));
+
+    if (rows(tmp) == 1)
+      I = 0.5 * tmp;
+    else
+      I = 0.5 * sum (tmp);
+    endif
+
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/unix.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,32 @@
+## Copyright (C) 2001 Laurent Mazet
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## function [status, result] = unix (command)
+##
+## Execute unix command and return status and standard output.
+##
+## command: command string
+##
+## status: command's status
+## result: standard ouput.
+
+## Jan 31, 2001 LSM
+
+function [status, result] = unix (command)
+
+  [result, status] = system (command);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/general/unwrap.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,106 @@
+## Copyright (C) 2000  Bill Lash
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Usage: b = unwrap(a{,tol{,dim}})
+## 
+## Unwrap radian phases by detecting jumps greater in magnitude
+## than "tol" (default pi) and adding or subtracting 2*pi as
+## appropriate.
+##
+## Unwrap will unwrap along the columns of "a" unless the row
+## dimension of "a" is 1 or the "dim" argument is given with a
+## value of 1, when it will unwrap along the row(s).
+
+## Author: Bill Lash <lash@tellabs.com>
+
+function retval = unwrap(a,tol,dim)
+        
+  if ((nargin<1) || (nargin>3))
+    usage("unwrap(a,[tol,[dim]])")
+  endif
+  if (nargin < 3)
+    if (rows(a)==1)
+      dim = 1;        #row vector, go along the row
+    else
+      dim = 2;        # Otherwise go along the columns
+    endif
+  endif
+  if (nargin < 2)
+    tol = pi;
+  endif
+  if (tol == [])      # if tol is not provided but dim is, handle it
+    tol = pi;
+  endif
+  tol = abs(tol);     # don't let anyone use a negative tol
+  
+  rng = 2*pi;
+  
+  ## Want to get data in a form so that we can unwrap each column
+  if (dim == 1)
+    ra = a.';
+  else
+    ra = a;
+  endif
+  n = columns(ra);
+  m = rows(ra);
+	
+  if (m == 1)       # Handle case where we are trying to unwrap 
+    retval = a;     # a scalar, or only have one sample in the 
+    return;         # specified dimension
+  endif
+
+  ## take first order difference to see so that wraps will show up
+  ## as large values, and the sign will show direction
+  d = [zeros(1,n);ra(1:m-1,:)-ra(2:m,:)];
+
+  ## Find only the peaks, and multiply them by the range so that there
+  ## are kronecker deltas at each wrap point multiplied by the range
+  ## value
+  p =  rng * (((d > tol)>0) - ((d < -tol)>0));
+
+  ## Now need to "integrate" this so that the deltas become steps
+  r = cumsum(p);
+
+  ## Now add the "steps" to the original data and put output in the
+  ## same shape as originally
+  if (dim == 1)
+    retval = (ra + r).';
+  else
+    retval = (ra + r);
+  endif
+
+endfunction
+
+%!shared r,w,tol
+%! r = [0:100];                           #original vector
+%! w = r - 2*pi*floor((r+pi)/(2*pi));     #wrapped version value in [-pi,pi]
+%! tol = 1e3*eps;                         #maximum expected deviation
+
+%!assert(r, unwrap(w), tol)               #unwrap single row
+%!assert(r', unwrap(w'), tol)             #unwrap single column
+%!assert([r',r'], unwrap([w',w']), tol)   #unwrap 2 columns
+%!assert([r;r], unwrap([w;w],[],1), tol)  #verify that dim works
+%!assert(r+10, unwrap(10+w), tol)         #verify that r(1)>pi works
+
+%!assert(w', unwrap(w',[],1))  #unwrap col by rows should not change it
+%!assert(w, unwrap(w,[],2))    #unwrap row by cols should not change it
+%!assert([w;w], unwrap([w;w])) #unwrap 2 rows by cols should not change them
+
+%!## verify that setting tolerance too low will cause bad results.
+%!assert(any(abs(r - unwrap(w,0.8)) > 100))
+
+%!error unwrap           # not enough args
+%!error unwrap(1,2,3,4)  # too many args
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/AUTHORS	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,8 @@
+Kai Habel (kai.habel@gmx.de)
+ - All .cc and .m files, Makefile rules.
+
+Etienne Grossmann (etienne@isr.ist.utl.pt) 
+ - Wrapping up.
+
+Paul Kienzle
+ - Integrate with the octaveSF tree
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/ChangeLog	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,9 @@
+2001-04-28  Kai Habel  <kai.habel@gmx.de>
+  
+  * removed __unique_rows__.m: use unique(...,"rows") in voronoi
+  * __voronoi__.cc, convhulln.cc, delaunayn.cc: use x.fortran_vec()
+
+2001-04-26  Etienne Grossmann  <etienne@anonimo.isr.ist.utl.pt>
+
+	* Added configure.in, Makefile.am and friends
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/Makeconf.add	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,1 @@
+@DEFHAVE_LIBQHULL@
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,19 @@
+
+sinclude ../../Makeconf
+
+ifndef MKOCTFILE
+# assumptions to make if not using ./configure script
+MKOCTFILE=mkoctfile
+DOHAVE_LIBQHULL=1
+endif
+
+%.oct: %.cc ; $(MKOCTFILE) -v -lqhull $<
+
+ifdef DOHAVE_LIBQHULL
+all: convhulln.oct __voronoi__.oct delaunayn.oct
+else
+all:
+endif
+
+clean:
+	$(RM) *.o *.oct core octave-core *~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/README	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,60 @@
+These are some function for computational geometry. They depend on
+the qhull library [1]. 
+
+Build Instructions
+------------------
+
+First you need the qhull library.
+
+a.) install the qhull program from [2]. 
+
+    Add the following target to src/Makefile:
+
+libqhull.so: $(OBJS)
+	c++ -shared -Xlinker -soname -Xlinker $@ -o libqhull.so $(OBJS)
+
+    Build the shared library
+
+	make libqhull.so
+
+    Install the lib to place where the linker can find it.
+	cp libqhull.so /usr/local/lib
+	ldconfig -v.
+
+    Copy all the header files where the C compiler can find them
+	mkdir /usr/local/include/qhull
+	cp qhull/src/*.h /usr/local/include/qhull
+
+b.) Download a qhull 'lite' package from my homepage. [3]
+	
+	make
+	make install
+
+    The lite package contains only the files needed to build the 
+    lib and a adapted Makefile. I have removed all docfiles, too. 
+    So, if you want to develop with qhull choose the package from [2].
+
+Next you need to build the geometry toolbox.
+
+a.) if you are using this package as part of OctaveSF, return the root
+    of the OctaveSF tree and follow the instructions in INSTALL
+
+b.) if you are using this package independently, just type
+
+	make
+
+    and either copy the m-files and oct-files from the current
+    directory onto your octave LOADPATH or update your LOADPATH
+    to include the current directory.
+
+
+[1] http://www.geom.umn.edu/software/qhull/
+[2] ftp://ftp.geom.umn.edu/pub/software/qhull.tar.Z
+[3] http://user.berlin.de/~kai.habel/libqhull.tar.gz
+
+Kai Habel
+kai.habel@gmx.de
+
+2001-09-19 Paul Kienzle
+* Instructions for build within unified octaveSF tree
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/TODO	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,4 @@
+
+
+- Quiet libqhull's warnings.
+- Test suite.
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/__voronoi__.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,157 @@
+/* Copyright (C) 2000  Kai Habel
+**
+** This program is free software; you can redistribute it and/or modify
+** it under the terms of the GNU General Public License as published by
+** the Free Software Foundation; either version 2 of the License, or
+** (at your option) any later version.
+**
+** This program is distributed in the hope that it will be useful,
+** but WITHOUT ANY WARRANTY; without even the implied warranty of
+** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+** GNU General Public License for more details.
+**
+** You should have received a copy of the GNU General Public License
+** along with this program; if not, write to the Free Software
+** Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 
+*/
+
+/*
+20. Augiust 2000 - Kai Habel: first release
+*/
+
+extern "C" { 
+	#include "qhull/qhull_a.h"
+}
+
+#include <iostream>
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+#include <octave/oct.h>
+
+char qh_version[] = "__voronoi__.oct 20. August 2000";
+FILE *outfile = stdout;
+FILE *errfile = stderr;
+char flags[250];
+
+DEFUN_DLD (__voronoi__, args, ,
+        "-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {@var{tri}=} __voronoi__ (@var{point})\n\
+@end deftypefn")
+{
+	octave_value_list retval;
+	retval(0) = 0.0;
+    
+	int nargin = args.length();
+	if (nargin != 1) {
+		print_usage ("__voronoi__ (points)");
+		return retval;
+	}
+
+	Matrix p(args(0).matrix_value());
+
+	const int dim = p.columns();
+	const int np = p.rows();
+  p = p.transpose();
+
+  double *pt_array = p.fortran_vec();
+	/*double  pt_array[dim * np];
+	for (int i = 0; i < np; i++) {
+		for (int j = 0; j < dim; j++) {
+			pt_array[j+i*dim] = p(i,j);
+		}
+	}*/
+
+	boolT ismalloc = False;
+
+	// hmm  lot's of options for qhull here
+	sprintf(flags,"qhull v Fv T0");
+	if (!qh_new_qhull (dim, np, pt_array, ismalloc, flags, NULL, errfile)) {
+
+		/*If you want some debugging information replace the NULL
+		pointer with outfile.
+		*/
+
+		facetT *facet;
+		vertexT *vertex;
+		unsigned int i=0,n=0,k=0,ni[np],m=0,fidx=0,j=0,r=0;
+		for (int i=0;i<np;i++) ni[i]=0;
+		qh_setvoronoi_all(); 
+		bool infinity_seen = false;
+		facetT *neighbor,**neighborp;
+		coordT *voronoi_vertex;
+		FORALLfacets {
+			facet->seen = False;
+		}
+		FORALLvertices {
+			if (qh hull_dim == 3)
+				qh_order_vertexneighbors(vertex);
+			FOREACHneighbor_(vertex) {
+				if (!neighbor->upperdelaunay) {
+					if (!neighbor->seen) {
+						n++;
+						neighbor->seen=True;
+					}
+					ni[k]++;
+				}
+			}
+			k++;
+		}
+
+		Matrix v(n,dim);
+		ColumnVector AtInf(np);
+		for (int i=0;i < np;i++) AtInf(i)=0;
+		octave_value_list F;
+		k=0;
+		FORALLfacets {
+			facet->seen = False;
+		}
+		FORALLvertices {
+			if (qh hull_dim == 3)
+				qh_order_vertexneighbors(vertex);
+			infinity_seen = false;
+			RowVector facet_list(ni[k++]);
+			m = 0;
+			FOREACHneighbor_(vertex) {
+				if (neighbor->upperdelaunay) {
+					if (!infinity_seen) {
+						infinity_seen = true;
+						AtInf(j) = 1;
+					}
+				} else {
+					if (!neighbor->seen) {
+						voronoi_vertex = neighbor->center;
+						fidx = neighbor->id;
+						for (int d=0; d<dim; d++) {
+							v(i,d) = *(voronoi_vertex++);
+						}
+						i++;
+						neighbor->seen = True;
+						neighbor->visitid = i;
+					}
+					facet_list(m++)=neighbor->visitid;
+				}
+			}
+			F(r++)=facet_list;
+			j++;	
+		}
+
+		retval(0) = v;
+		retval(1) = F;
+		retval(2) = AtInf;
+	
+		qh_freeqhull(!qh_ALL);
+			//free long memory
+
+		int curlong, totlong;
+		qh_memfreeshort (&curlong, &totlong);
+			//free short memory and memory allocator
+		
+		if (curlong || totlong) {
+    		cerr << "qhull internal warning (delaunay): did not free ";
+			cerr << totlong << " bytes of long memory (";
+			cerr << curlong << " pieces)" << endl;
+		}
+	}
+	return retval;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/configure.add	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,10 @@
+dnl Do we have libqhull?
+AC_SUBST(DEFHAVE_LIBQHULL)
+HAVE_LIBQHULL=1
+AC_CHECK_HEADERS(qhull.h,, HAVE_LIBQHULL=0)
+AC_CHECK_LIB(qhull,qh_qhull,, HAVE_LIBQHULL=0)
+if test $HAVE_LIBQHULL = 1 ; then
+	DEFHAVE_LIBQHULL="HAVE_LIBQHULL=1"
+else
+	DEFHAVE_LIBQHULL=
+fi
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/convhull.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,57 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Loadable Function} {@var{H} =} convhull (@var{x}, @var{y})
+## returns the index vector to the points of the enclosing convex hull
+## @end deftypefn
+## @seealso{delaunay, convhulln}
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+
+function H = convhull (x,y)
+
+  if (nargin != 2)
+    usage ("convhull(x,y)");
+  endif
+
+  if (is_vector(x) && is_vector(y) && (length(x) == length(y)) )
+    i = convhulln([x(:), y(:)]);
+  endif
+
+  n = rows(i);
+  i=i'(:);
+  H = zeros(n + 1,1);
+
+  H(1) = i(1);
+  next_i = i(2);
+  i(2) = 0;
+  for k = 2:n
+    next_idx = find (i == next_i);
+
+    if (rem (next_idx, 2) == 0)
+      H(k) = i(next_idx);
+      next_i = i(next_idx - 1);
+      i(next_idx - 1) = 0;
+    else
+      H(k) = i(next_idx);
+      next_i = i(next_idx + 1);
+      i(next_idx + 1) = 0;
+    endif
+  endfor
+
+  H(n+1)=H(1);
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/convhulln.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,106 @@
+/* Copyright (C) 2000  Kai Habel
+**
+** This program is free software; you can redistribute it and/or modify
+** it under the terms of the GNU General Public License as published by
+** the Free Software Foundation; either version 2 of the License, or
+** (at your option) any later version.
+**
+** This program is distributed in the hope that it will be useful,
+** but WITHOUT ANY WARRANTY; without even the implied warranty of
+** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+** GNU General Public License for more details.
+**
+** You should have received a copy of the GNU General Public License
+** along with this program; if not, write to the Free Software
+** Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 
+*/
+
+/*
+29. July 2000 - Kai Habel: first release
+*/
+
+extern "C" { 
+	#include "qhull/qhull_a.h"
+}
+#include <iostream>
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+#include <octave/oct.h>
+
+char qh_version[] = "convhulln.oct 08. August 2000";
+char flags[250];
+
+DEFUN_DLD (convhulln, args, ,
+        "-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {@var{H} =} convhulln (@var{p})\n\
+returns the index vector to the points of the enclosing convex hull\n\
+The input matrix of size [dim, n] contains n points of dimension dim.
+@seealso{convhull, delaunayn}\n\
+@end deftypefn")
+{
+	octave_value_list retval;
+    retval(0) = 0.0;
+
+	int nargin = args.length();
+	if (nargin != 1) {
+		print_usage ("convhulln(p)");
+		return retval;
+	}
+
+	Matrix p(args(0).matrix_value());
+
+	const int dim = p.columns();
+	const int n = p.rows();
+  p = p.transpose();
+
+  double *pt_array = p.fortran_vec();
+	/*double  pt_array[dim * n];
+	for (int i = 0; i < n; i++) {
+		for (int j = 0; j < dim; j++) {
+			pt_array[j+i*dim] = p(i,j);
+		}
+	}*/
+
+	boolT ismalloc = False;
+
+	// hmm  lot's of options for qhull here
+	sprintf(flags,"qhull s Tcv");
+	
+	if (!qh_new_qhull (dim,n,pt_array,ismalloc,flags,NULL,stderr)) {
+	
+		// If you want some debugging information replace the NULL
+		// pointer with stdout
+	
+		vertexT *vertex,**vertexp;
+		facetT *facet;
+		unsigned int i=0,j=0,n = qh num_facets;
+
+		Matrix idx(n,dim);
+		qh_vertexneighbors();
+		setT *curr_vtc;
+
+		FORALLfacets {
+			//qh_printfacet(stdout,facet);
+			curr_vtc = facet->vertices;
+			FOREACHvertex_ (curr_vtc) {
+				//qh_printvertex(stdout,vertex);
+				idx(i,j++)= 1 + qh_pointid(vertex->point);
+			}
+			i++;j=0;
+		}
+		retval(0)=idx;
+	}
+	qh_freeqhull(!qh_ALL);
+		//free long memory
+	int curlong, totlong;
+	qh_memfreeshort (&curlong, &totlong);
+		//free short memory and memory allocator
+
+	if (curlong || totlong) {
+    	cerr << "qhull internal warning (delaunay): did not free ";
+		cerr << totlong << " bytes of long memory (";
+		cerr << curlong << " pieces)" << endl;
+	}
+	return retval;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/delaunay.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,40 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Loadable Function} {@var{tri}=} delaunay (@var{x}, @var{y})
+## The return matrix of size [n, 3] contains a set triangles which are
+## described by the indices to the data point x and y vector.
+## The triangulation satisfies the Delaunay circumcircle criterion.
+## No other data point is in the circumcircle of the defining triangle.
+## @end deftypefn
+## @seealso{delaunay3, delaunayn}
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+
+function tri = delaunay (x,y)
+
+  if (nargin != 2)
+    usage ("delaunay(x,y)");
+  endif
+
+  if (is_vector(x) && is_vector(y) && (length(x) == length(y)) )
+    tri = delaunayn([x(:), y(:)]);
+  else
+    error("input arguments must be vectors of same size");
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/delaunay3.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,38 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Loadable Function} {@var{T} =} delaunay3 (@var{x}, @var{y}, @var{z})
+## A matrix of size [n, 4] is returned. Each row contains a 
+## set of tetrahedron which are
+## described by the indices to the data point vectors (x,y,z).
+## @end deftypefn
+## @seealso{delaunay,delaunayn}
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+
+function tetr = delaunay3 (x,y,z)
+
+  if (nargin != 3)
+    usage ("delaunay(x,y,z)");
+  endif
+
+  if (is_vector(x) && is_vector(y) &&is_vector(z) && \
+      (length(x) == length(y)) && (length(x) == length(z))) 
+    tetr = delaunayn([x(:),y(:),z(:)]);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/delaunayn.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,117 @@
+/* Copyright (C) 2000  Kai Habel
+**
+** This program is free software; you can redistribute it and/or modify
+** it under the terms of the GNU General Public License as published by
+** the Free Software Foundation; either version 2 of the License, or
+** (at your option) any later version.
+**
+** This program is distributed in the hope that it will be useful,
+** but WITHOUT ANY WARRANTY; without even the implied warranty of
+** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+** GNU General Public License for more details.
+**
+** You should have received a copy of the GNU General Public License
+** along with this program; if not, write to the Free Software
+** Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 
+*/
+
+/*
+16. July 2000 - Kai Habel: first release
+*/
+
+#include "config.h"
+
+extern "C" { 
+  #include "qhull/qhull_a.h"
+}
+
+#include <iostream>
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+#include <octave/oct.h>
+
+char qh_version[] = "delaunayn.oct 08. August 2000";
+FILE *outfile = stdout;
+FILE *errfile = stderr;
+char flags[250];
+
+DEFUN_DLD (delaunayn, args, ,
+        "-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {@var{T}=} delaunayn (@var{P})\n\
+the input matrix of size [n, dim] contains n points of dimension dim.\n\
+The return matrix @var{T} has the size [dim-1, n]. It contains for\n\
+each row a set of indices to the points, which describes a simplex of\n\
+dimension (dim-1).  The 3d simplex is a tetrahedron.\n  @end deftypefn")
+
+{
+  octave_value_list retval;
+  retval(0) = 0.0;
+    
+  int nargin = args.length();
+  if (nargin != 1) {
+    print_usage ("delaunayn(p)");
+    return retval;
+  }
+
+  Matrix p(args(0).matrix_value());
+
+  const int dim = p.columns();
+  const int n = p.rows();
+
+  if (n > dim) {    
+
+    p = p.transpose();
+    double *pt_array = p.fortran_vec();
+    boolT ismalloc = False;
+
+    sprintf(flags,"qhull d T0");
+    if (!qh_new_qhull (dim, n, pt_array, ismalloc, flags, NULL, errfile)) {
+
+      /*If you want some debugging information replace the NULL
+      pointer with outfile.
+      */
+
+      facetT *facet;
+      vertexT *vertex, **vertexp;
+      int nf=0,i=0;
+
+      FORALLfacets {
+        if (!facet->upperdelaunay) nf++;
+      }
+
+      Matrix simpl(nf,dim+1);
+      FORALLfacets {
+        if (!facet->upperdelaunay) {
+          int j=0;
+          FOREACHvertex_ (facet->vertices) {
+            simpl(i,j++)=1 + qh_pointid(vertex->point);
+          }
+          i++;
+        }
+      }
+      retval(0) = simpl;
+    }
+    qh_freeqhull(!qh_ALL);
+      //free long memory
+
+    int curlong, totlong;
+    qh_memfreeshort (&curlong, &totlong);
+      //free short memory and memory allocator
+    
+    if (curlong || totlong) {
+      cerr << "qhull internal warning (delaunay): did not free ";
+      cerr << totlong << " bytes of long memory (";
+      cerr << curlong << " pieces)" << endl;
+    }
+  } else if (n == dim + 1) {
+    // one should check if nx points span a simplex
+    // I will look at this later.
+    RowVector vec(n);
+    for (int i=0;i<n;i++) {
+      vec(i)=i+1.0;
+    } 
+    retval(0) = vec;
+  }
+  return retval;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/griddata.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,104 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{ZI} =} griddata (@var{x},@var{y},@var{z},@var{xi},@var{yi},method)
+## @deftypefnx {Function File} {[@var{XI},@var{YI},@var{ZI}] =}
+## griddata (@var{x},@var{y},@var{z},@var{xi},@var{yi},method)
+## 
+## 
+## If method is omitted it defaults to 'linear'
+## @seealso{delaunay}
+## @end deftypefn
+## Author:	Kai Habel <kai.habel@gmx.de>
+
+function [...] = griddata (x,y,z,xi,yi)
+	
+	if nargin==5
+		method='linear';
+	endif
+	if (nargin <5|nargin>7 )
+		usage('griddata(x,y,z,xi,yi)');
+	endif
+	if isstr(method), method=tolower(method); endif
+	if !( (size(x)==size(y))&(size(x)==size(z)) )
+		error('x,y,z must be vectors of same length');
+	endif
+	if (size(xi)!=size(yi))
+		error('xi and yi must be vectors or matrices of same size');
+	endif
+	if (is_vector(xi))
+		#xi and yi are vectors
+		[xi,yi]=meshgrid(xi,yi);
+		vr_val(xi);
+		vr_val(yi);
+	endif
+	[nr,nc]=size(xi);
+
+	# triangulate data
+	tri=delaunay(x,y);
+
+	# 
+	xi=reshape(xi,nr*nc,1);
+	yi=reshape(yi,nr*nc,1);
+	zi=zeros(size(xi));
+
+	if strcmp(method,'cubic')
+		error('griddata(...,\'cubic\') cubic interpolation not yet implemented\n')
+	elseif strcmp(method,'nearest')
+		error('griddata(...,\'nearest\') nearest neighbor interpolation not yet implemented\n')
+
+		#search index of nearest point
+		#dsearch not yet implemented
+		idx=dsearch(x,y,tri,xi,yi);
+		zi=z(idx);
+	elseif strcmp(method,'linear')
+		#search for every point the enclosing triangle
+		tri_list=tsearch(x,y,tri,xi,yi);
+
+		#keep non zero values before overwriting zeros with 1
+		t_nzero=tri_list>0;
+		tri_list=tri_list+(tri_list==0);
+		nr_t=rows(tri_list);
+
+		N=zeros(nr_t,4);
+		#assign x,y,z for each point of triangle
+		x1=x(tri([tri_list],1));y1=y(tri([tri_list],1));z1=z(tri([tri_list],1));
+		x2=x(tri([tri_list],2));y2=y(tri([tri_list],2));z2=z(tri([tri_list],2));
+		x3=x(tri([tri_list],3));y3=y(tri([tri_list],3));z3=z(tri([tri_list],3));
+
+		#calculate norm vector
+		N(:,1:3)=cross([x2-x1 y2-y1 z2-z1],[x3-x1 y3-y1 z3-z1]);
+		N_norm=sqrt(N(:,1).^2+N(:,2).^2+N(:,3).^2);
+		N(:,1:3)=N(:,1:3)./kron(N_norm,[1 1 1]);
+
+		#calculate D of plane equation
+		#Ax+By+Cz+D=0;
+		N(:,4)=-(N(:,1).*x1+N(:,2).*y1+N(:,3).*z1);
+
+		#calculate zi by solving plane equation for xi,yi
+		zi=-1./N(:,3).*( N(:,1).*xi+N(:,2).*yi+N(:,4) );
+	
+		#reset zi values for points not in convex hull		
+		zi=t_nzero.*zi;
+
+		# restore original shape
+		zi=reshape(zi,nr,nc);
+		vr_val(zi)
+	else
+		error('unknown interpolation method');
+	endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/voronoi.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,93 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} voronoi (@var{X},@var{Y})
+## @deftypefnx {Function File} {} voronoi (@var{X},@var{Y},"plotstyle")
+## @deftypefnx {Function File} {[@var{vx}, @var{vy}] =} voronoi (@var{X},@var{Y})
+## plots voronoi diagram of points @var{X},@var{Y}. 
+## The voronoi facets with points at infinity are not drawn.
+## [@var{vx}, @var{vy}] = voronoi(...) returns the vertices instead plotting the
+## diagramm. plot (@var{vx}, @var{vy}) shows the voronoi diagram.
+## 
+## @end deftypefn
+## @seealso{voronoin, delaunay, convhull} 
+
+## Author: Kai Habel <kai.habel@gmx.de>
+## First Release: 20/08/2000
+
+function [...] = voronoi (x, y, plt)
+
+	if (nargin < 2 || nargin > 3)
+		usage ("voronoi (x, y)")
+	endif
+	
+	if (nargin < 3)
+		plt = "b;;";
+		## if not specified plot blue solid lines
+	endif
+
+	lx = length (x);
+	ly = length (y);
+
+	if (lx != ly)
+		error ("voronoi: arguments must be vectors of same length");
+	endif
+
+	[p, lst, infi] = __voronoi__ ([x(:),y(:)]);
+
+	idx = find (!infi);
+	ll = length (idx);
+	k = 0;r = 1;
+
+	for i = 1:ll
+		k += length (nth (lst, idx(i)));
+	endfor
+
+	vx = zeros (2,k);
+	vy = zeros (2,k);
+
+	for i=1:ll
+		fac = nth (lst, idx(i));
+		lf = length(fac);
+		fac = [fac, fac(1)];
+		fst = fac(1:length(fac)-1);
+		sec = fac(2:length(fac));
+		vx(:,r:r+lf-1) = [p(fst,1),p(sec,1)]';
+		vy(:,r:r+lf-1) = [p(fst,2),p(sec,2)]';
+		r += lf;
+	endfor
+
+	## this should be replaced with
+	## vx = unique(vx,"rows");
+	## vy = unique(vy,"rows");
+	## when available
+	del_idx = __unique_rows__ (vx);
+	vx(del_idx,:) = [];
+	vy(del_idx,:) = [];
+	##
+	##
+
+	if (nargout == 0)
+		plot (vx, vy, plt);
+	elseif (nargout == 2)
+		vr_val(vx);
+		vr_val(vy);
+	else
+		error ("only two or zero output arguments supported")
+	endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/geometry/voronoin.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,41 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {[@var{C}, @var{F}] =} voronoin (@var{pts})
+## computes n- dimensinal voronoi facets.  The input matrix @var{pts} 
+## of size [n, dim] contains n points of dimension dim.
+## @var{C} contains the points of the voronoi facets. The list @var{F}
+## contains for each facet the indices of the voronoi points.   
+## @end deftypefn
+## @seealso{voronoin, delaunay, convhull} 
+
+## Author: Kai Habel <kai.habel@gmx.de>
+## First Release: 20/08/2000
+
+function [C, F] = voronoin (pts)
+
+	if (nargin != 1)
+		usage ("voronoin (pts)")
+	endif
+	
+	[np,dims] = size (pts);
+	if (np > dims)
+		[C, F, infi] = __voronoi__ (pts);
+	else
+		error ("voronoin: number of points must be greater than their dimension")
+	endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/ident/idplot.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,38 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: idplot(z, idx, dT, outputs, shape)
+##
+
+function idplot(z, idx, dT, outputs, shape)
+
+  if nargin<1 || nargin>5
+    usage("y = idplot(z, idx, dT, outputs, shape)");
+  endif
+  if nargin<2 || isempty(idx), idx = 1:size(z,1); endif
+  if nargin<3 || isempty(dT), dT=1;endif
+  if nargin<4 || isempty(outputs), outputs=1; endif
+  if nargin<5 || isempty(shape), shape='pc'; endif
+
+  subplot(211);
+  title("system outputs");
+  auplot(z(idx,1:outputs), 1/dT, idx(1)-1);
+  subplot(212);
+  title("system inputs");
+  auplot(z(idx,outputs+1:size(z,2)), 1/dT, idx(1)-1);
+  title("");
+  subplot(111);
+end
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/ident/idsim.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,58 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: y = idsim([u e], th)
+##
+## Simulate the effects of the MISO system defined by th.
+##
+## e is the noise in the input.  It is scaled by sqrt(v), where v is 
+## the noise variance given when you created the model, so for proper 
+## effect, e should have mean 0 and variance 1.
+##
+## If e is not given, then a noise free simulation is run.
+##
+## See also: poly2th, idplot
+
+function y = idsim(u, th)
+
+  if nargin!=2,
+    usage("y = idsim(u, th)");
+  endif
+  n = rows(u);
+  nu = columns(u);
+  na = columns(th.a);
+  nb = columns(th.b);
+
+  if na!=1
+    error("idsim: only SISO/MISO systems have been implemented");
+  endif
+
+  if (nu != nb && nu != nb+na)
+    error("idsim: wrong number of input columns in u");
+  endif
+
+  inp = zeros(n,1);
+  for i=1:nb
+    inp = inp + filter(th.b(:,i), th.f(:,i), u(:,i));
+  endfor
+
+  if (nu != nb)
+    inp = inp + filter(th.c, th.d, u(:,nb+1) * sqrt(th.v));
+  endif
+
+  y = filter(1, th.a, inp);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/ident/mktheta.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,24 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## th = mktheta(a,b)
+## Create a theta structure from the IIR system Ay = Bx.  See poly2th
+## for details on the theta structure.
+##
+## See also poly2th, idsim
+function th=mktheta(a,b)
+  th=poly2th(a,b);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/ident/poly2th.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,69 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## th = poly2th(a,b,c,d,f,v,T)
+## Represent the generalized Multi-Input, Single-Output (MISO) system
+## defined as follows:
+##
+##                      / B_i(q)        \     C(q)
+## A_j(q)y(t) =   sum   | ------ u_i(t) | +   ---- e_j(t) 
+##              1<i<=bn \ F_i(q)        /     D(q)
+##
+## e is white noise
+## u is the input signal
+## y is the output signal
+##
+## v is the variance on the noise (default is 1)
+## T is the sampling interval (default is 1)
+##
+## See also: mktheta, idsim
+
+## TODO: incorporate delays: if system is discrete (T>0), then delay for
+## TODO: input i is the number of leading zeros in b(:,i)
+function th = poly2th(a,b,c,d,f,v,T)
+  if nargin<1 || nargin>7,
+    usage("th = poly2th(a,b,c,d,f,v,T)");
+  endif
+  th.a = a;
+  if nargin<2, th.b=[]; else th.b = b; endif
+  if nargin<3, th.c=1;  else th.c=c; endif
+  if nargin<4, th.d=1;  else th.d=d; endif
+  if nargin<5, th.f=[]; else th.f=f; endif
+  if nargin<6, th.v=1;  else th.v=v; endif
+  if nargin<7, th.T=1;  else th.T=T; endif
+
+  if size(th.a,1) == 1, th.a = th.a.'; endif
+  if size(th.b,1) == 1, th.b = th.b.'; endif
+  if size(th.c,1) == 1, th.c = th.c.'; endif
+  if size(th.d,1) == 1, th.d = th.d.'; endif
+  if size(th.f,1) == 1, th.f = th.f.'; endif
+
+  if isempty(th.f), th.f = ones(1,columns(th.b)); endif
+
+  na = columns(th.a);
+  nb = columns(th.b);
+  nc = columns(th.c);
+  nd = columns(th.d);
+  nf = columns(th.f);
+  
+  if nf != nb
+    error("poly2th f and b must have the same number of columns");
+  endif
+
+  if nc>1 || nd>1
+    error("poly2th: c and d may only have one column");
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,10 @@
+
+include ../../Makeconf
+
+PROGS = conv2.oct cordflt2.oct
+
+all: $(PROGS)
+
+clean:
+	$(RM) *.o $(PROGS) octave-core core *~
+ 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/autumn.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,57 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} autumn (@var{n})
+## Create color colormap. 
+## (red through orange to yellow)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function map = autumn (number)
+
+  global __current_color_map__
+
+  if (nargin == 0)
+    if exist("__current_color_map__")
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("autumn: argument must be a scalar");
+    endif
+  else
+    usage ("autumn (number)");
+  endif
+
+  if (number == 1)
+    map = [1, 0, 0];  
+  elseif (number > 1)
+    r = ones (number, 1);
+    g = (0:number - 1)' ./ (number - 1);
+    b = zeros (number, 1);
+    map = [r, g, b];
+  else
+    map = [];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/bone.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,60 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} bone (@var{n})
+## Create color colormap. 
+## (a gray colormap with a light blue tone)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function map = bone (number)
+
+  global __current_color_map__
+
+  if (nargin == 0)
+    if exist ("__current_color_map__")
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("bone: argument must be a scalar");
+    endif
+  else
+    usage ("bone (number)");
+  endif
+
+  if (number == 1)
+    map = [0, 0, 0];  
+  elseif (number > 1)
+    x = linspace (0, 1, number)';
+
+    r = (x < 3/4) .* (7/8 * x) + (x >= 3/4) .* (11/8 * x - 3/8);
+    g = (x < 3/8) .* (7/8 * x)\
+      + (x >= 3/8 & x < 3/4) .* (29/24 * x - 1/8)\
+      + (x >= 3/4) .* (7/8 * x + 1/8);
+    b = (x < 3/8) .* (29/24 * x) + (x >= 3/8) .* (7/8 * x + 1/8);
+    map=[r, g, b];
+  else
+    map = [];
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/brighten.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,67 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} @var{map}= brighten (@var{beta},@var{map})
+## darkens or brightens the current colormap. 
+## The argument @var{beta} should be a scalar between -1...1,
+## where a negative value darkens and a positive value brightens
+## the colormap.
+## If the @var{map} argument is omitted,
+## the function is applied to the current colormap
+## @end deftypefn
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+## Date:	05. March 2000
+
+function [...] = brighten (m, beta)
+
+  global __current_color_map__
+
+  if (nargin == 1)
+    beta = m;
+    m = __current_color_map__;
+
+  elseif (nargin == 2)
+    if (nargout == 0)
+      usage ("map_out=brighten(map,beta)")
+    endif
+
+    if !(is_scalar (beta) || beta < -1 || beta > 1)
+      error ("brighten(...,beta) beta must be a scalar in the range -1..1");
+    endif
+
+    if !( is_matrix (m) && size (m, 2) == 3 )
+      error ("brighten(map,beta) map must be a matrix of size nx3");
+    endif
+
+  else
+    usage ("brighten(...) number of arguments must be 1 or 2");
+  endif
+
+  if (beta > 0)
+    gamma = 1 - beta;
+  else
+    gamma = 1 / (1 + beta);
+  endif
+
+  if (nargout == 0)
+    __current_color_map__ = __current_color_map__ .^ gamma;
+  else
+    vr_val (map .^ gamma);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/bwborder.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,35 @@
+## Copyright (C) 2000  Etienne Grossman
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+##       b = bwborder(im)
+##
+## b is the borders in the 0-1 matrix im. 4-neighborhood is considered.
+## 
+## A pixel is on the border if it is set in im, and it has at least one
+## neighbor that is not set.
+
+## Author:        Etienne Grossmann  <etienne@isr.ist.utl.pt>
+## Last modified: January 2000
+
+function b = bwborder(im)
+
+[R,C]=size(im);
+
+b = im & ...
+    !([im(2:R,:) ;  zeros(1,C) ] & ...
+      [zeros(1,C); im(1:R-1,:) ] & ...
+      [im(:,2:C) ,  zeros(R,1) ] & ...
+      [zeros(R,1),  im(:,1:C-1)] ) ;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/bwlabel.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,231 @@
+## Copyright (C) 2000  Etienne Grossman
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+##       [im2,npix,bb] = bwlabel(im,...)
+##  
+## im  : RxC 0-1 matrix
+##
+## im2 : RxC int matrix in which the connected regions of im have been
+##       numbered. 4-neighborhoods are considered.
+##
+## npix : 1xQ int number of pixel in each region
+##
+## bb   : 4xQ int bounding boxes of the regions. Rows are minrow,
+##        maxrow, mincol, maxcol.
+##
+## Since the algorithm is slow, it will report progress if it has to do
+## more than 100 loops.
+##
+## Options :
+##
+## "verbose"  : Be verbose
+## "quiet"    : Don't report anything (overrides "verbose")
+## "prudent"  : Check that regions do not touch
+## "mins", m  : Minimum size of the regions
+## "maxs", m  : Maximum size of the regions
+##
+
+## Author:        Etienne Grossmann  <etienne@isr.ist.utl.pt>
+## Last modified: January 2000
+
+function [im2,npix,bb] = bwlabel(im,...)
+
+[R,C]=size(im);
+tr = 0 ;
+				# Loop as little as possible
+if R<C, tr = 1; im = im' ; [R,C]=size(im); end
+
+report = C>100 ;
+
+quiet = 0 ;
+verbose = 0 ;
+prudent = 1 ;
+mins = maxs = 0 ;
+
+
+filename = "bwlabel" ;
+opt0 = " verbose quiet " ;
+opt1 = " mins maxs " ;
+nargin-- ;
+read_options ;
+
+
+if any(im(:)&im(:)!=1),
+  printf("bwlabel : im is not binary\n");
+  return
+end
+
+if quiet, verbose = report = 0 ; end
+
+gsize = 100 ;			# Predicted number of slices
+
+im2 = zeros(R,C);
+## keyboard
+				# find horizontal up/down going edges
+imup =  max(im2, diff([zeros(1,C);im])) ;
+imdo = -min(im2, diff([im;zeros(1,C)])) ;
+
+im2 = ones(R,C);
+######################################################################
+## Find connected regions ############################################
+
+rc = 1 ;			# Counter of region slices 
+
+rnum = ones(1,gsize);		# List of labels of each slice
+npix = zeros(1,gsize);		# Sizes of regions (actual size is in
+				# region's first slice)
+bb = zeros(4,gsize);		# Bounding boxes
+
+if report && !verbose,
+  printf("bwlabel : There will be %i loops ... \n%5i ",C,0) ;
+end
+
+lrow = zeros(R,1);		# Last treated image column
+ 
+for i=1:C,
+  ## i
+  t1 = find(imup(:,i)) ;
+  t2 = find(imdo(:,i)) ;
+  
+  nrow = zeros(R,1);		# Next row
+
+  ## if i==42 || i==41,"i==42 || i==41", keyboard; end
+
+  for j = 1:rows(t1(:)) ,	# Loop over slices of i'th column
+
+    rc++ ;			# rc = number of current slice.
+    im2(t1(j):t2(j),i) = rc ;
+    ## if rc==341, "rc==341",keyboard; end
+				# Slices from previous column that touch
+				# this slice.
+    rr = create_set(lrow(t1(j):t2(j))) ;
+    if !isempty(rr) && !rr(1), rr = rr(2:length(rr)) ; end
+
+    if rc>size(rnum,2),		# Get more space (uncertain effect on
+				# speed; avoids resizing rnum and npix)
+      tmp = 2*(ceil(C*rc/i)-rc+1+rows(t1(:))-j) ;
+      sayif(verbose,"bwlabel : (i=%i) Foreseeing %i more regions\n",i,tmp);
+      rnum = [ rnum, ones(1,tmp) ] ;
+      npix = [ npix,zeros(1,tmp) ] ;
+      bb = [ bb,zeros(4,tmp) ] ;
+    end
+
+    if isempty(rr),			# New region 
+      sayif(verbose,"bwlabel : creating region %i\n",rc);
+
+      r0 = rc ;			# r0 = number of the region
+
+      bb(1,r0) = t1(j) ;
+      bb(2,r0) = t2(j) ;
+      bb(3:4,r0) = i ;
+
+    else			# Add to already existing region #####
+
+      ## rr
+      r0 = rnum(rr(1)) ;
+
+      bb(1,r0) = min(bb(1,r0),t1(j)) ;
+      bb(2,r0) = max(bb(2,r0),t2(j)) ;
+      bb(4,r0) = i ;
+
+				# Touches region r0
+      sayif(verbose,"bwlabel : adding to region %i\n",r0);
+
+				# Touches other regions too
+      for k = rr(find(rr!=r0)),	# Loop over other touching regions, that
+				# should be merged to the first.
+	sayif(verbose,"bwlabel : merging regions %i and %i\n",k,r0);
+	rnum(find(rnum==k)) = r0 ;
+	npix(r0) = npix(r0) + npix(k) ;
+	bb([1,3],r0) = min(bb([1,3],r0)',bb([1,3],k)')' ;
+	bb([2,4],r0) = max(bb([2,4],r0)',bb([2,4],k)')' ;
+      end
+      
+    end				# End of add to already existing region
+    ## if r0==259 && i==39,"r0==259",keyboard;end
+    rnum(rc) = r0 ;
+
+    npix(r0) = npix(r0) + 1+t2(j)-t1(j) ;
+
+    nrow(t1(j):t2(j)) = r0 ;
+  end				# End of looping over slices
+  lrow = nrow ;
+  if report && !verbose,
+    printf(".") ;
+    if !rem(i,70) && i<C, printf("\n%5i ",i); end
+  end
+end				# End of looping over columns
+## length(regs)
+if report && !verbose,
+  printf("\n") ;
+end
+## im2
+## [ 1:rc ; rnum(1:rc) ]
+keep = ones(1,rc) ; 
+
+if mins, keep = keep & (npix(rnum(1:rc))>=mins) ; end
+if maxs, keep = keep & (npix(rnum(1:rc))<=maxs) ; end
+keep(1) = 1 ;
+keep = find(keep) ;		# Indices of slices to be kept
+
+foo = create_set(rnum(keep)) ;	# Indices of regions to be kept
+nr = prod(size(foo)) ;		# Number of regions (including bg)
+## lrow = zeros(1,nr) ;
+tmp = zeros(1,rc) ;
+tmp(foo) = 0:nr-1 ;
+
+bar = zeros(1,rc) ;
+bar(keep) = tmp(rnum(keep)) ;
+
+## keyboard
+
+im2 = reshape(bar(im2),R,C) ;
+
+npix = npix(foo(2:nr));
+bb = bb(:,foo(2:nr));
+
+if 0,				# Draw bb on the image (will ruin
+				# coherence)
+  for i=1:nr-1,
+    im2([bb(1,i),bb(2,i)] ,bb(3,i):bb(4,i) ) = i ;
+    im2( bb(1,i):bb(2,i) ,[bb(3,i),bb(4,i)]) = i ;
+  end
+end
+
+## keyboard
+if prudent,
+
+  sayif(verbose,"bwlabel : Checking coherence\n");
+
+  hcontact = im2 & im2!=[im2(:,2:C),zeros(R,1)] & [im2(:,2:C),zeros(R,1)] ;
+  vcontact = im2 & im2!=[im2(2:R,:);zeros(1,C)] & [im2(2:R,:);zeros(1,C)] ;
+  ok = 1 ;
+  if any(hcontact(:)),
+    ok = 0 ;
+    printf("bwlabel: Whoa! Found horizontally connected separated regions\n");
+  end
+  if any(vcontact(:)),
+    ok = 0 ;
+    printf("bwlabel: Whoa! Found vertically connected separated regions\n");
+  end
+  if !ok, keyboard ; end
+end
+
+## Eventually transpose result
+if tr, 
+  im2 = im2' ; 
+  bb = bb([3,4,1,2],:);
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/conv2.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,301 @@
+/*
+ * conv2: 2D convolution for octave
+ *
+ * Copyright (C) 1999 Andy Adler
+ * This code has no warrany whatsoever.
+ * Do what you like with this code as long as you
+ *     leave this copyright in place.
+ *
+ * $Id$
+
+## 2000-05-17: Paul Kienzle
+##    * change argument to vector conversion to work for 2.1 series octave
+##      as well as 2.0 series
+## 2001-02-05: Paul Kienzle
+##    * accept complex arguments
+
+ */
+
+#include <octave/oct.h>
+
+#define MAX(a,b) ((a) > (b) ? (a) : (b))
+
+#define SHAPE_FULL 1
+#define SHAPE_SAME 2
+#define SHAPE_VALID 3
+
+#if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL)
+extern MArray2<double>
+conv2 (MArray<double>&, MArray<double>&, MArray2<double>&, int);
+
+extern MArray2<Complex>
+conv2 (MArray<Complex>&, MArray<Complex>&, MArray2<Complex>&, int);
+#endif
+
+template <class T>
+MArray2<T>
+conv2 (MArray<T>& R, MArray<T>& C, MArray2<T>& A, int ishape)
+{
+      int          Rn=  R.length();
+      int          Cm=  C.length();
+      int          Am = A.rows();
+      int          An = A.columns();
+
+/*
+ * Here we calculate the size of the output matrix,
+ *  in order to stay Matlab compatible, it is based
+ *  on the third parameter if its separable, and the
+ *  first if it's not
+ */
+      int outM, outN, edgM, edgN;
+      if ( ishape == SHAPE_FULL ) {
+         outM= Am + Cm - 1;
+         outN= An + Rn - 1;
+         edgM= Cm - 1;
+         edgN= Rn - 1;
+      } else if ( ishape == SHAPE_SAME ) {
+         outM= Am;
+         outN= An;
+// Matlab seems to arbitrarily choose this convention for
+// 'same' with even length R, C
+         edgM= ( Cm - 1) /2;
+         edgN= ( Rn - 1) /2;
+      } else if ( ishape == SHAPE_VALID ) {
+         outM= Am - Cm + 1;
+         outN= An - Rn + 1;
+         edgM= edgN= 0;
+      }
+
+//    printf("A(%d,%d) C(%d) R(%d) O(%d,%d) E(%d,%d)\n",
+//       Am,An, Cm,Rn, outM, outN, edgM, edgN);
+      MArray2<T> O(outM,outN);
+/*
+ * T accumulated the 1-D conv for each row, before calculating
+ *    the convolution in the other direction
+ * There is no efficiency advantage to doing it in either direction
+ *     first
+ */
+
+      MArray<T> X( An );
+
+      for( int oi=0; oi < outM; oi++ ) {
+         for( int oj=0; oj < An; oj++ ) {
+            T sum=0;
+
+            int           ci= Cm - 1 - MAX(0, edgM-oi);
+            int           ai= MAX(0, oi-edgM) ; 
+            const T* Ad= A.data() + ai + Am*oj;
+            const T* Cd= C.data() + ci;
+            for( ; ci >= 0 && ai < Am;
+                   ci--, Cd--, ai++, Ad++) {
+               sum+= (*Ad) * (*Cd);
+            } // for( int ci=
+
+            X(oj)= sum;
+         } // for( int oj=0
+
+         for( int oj=0; oj < outN; oj++ ) {
+            T sum=0;
+
+            int           rj= Rn - 1 - MAX(0, edgN-oj);
+            int           aj= MAX(0, oj-edgN) ; 
+            const T* Xd= X.data() + aj;
+            const T* Rd= R.data() + rj;
+
+            for( ; rj >= 0 && aj < An;
+                   rj--, Rd--, aj++, Xd++) {
+               sum+= (*Xd) * (*Rd);
+            } //for( int rj= 
+
+            O(oi,oj)= sum;
+         } // for( int oj=0
+      } // for( int oi=0
+
+      return O;
+}
+
+#if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL)
+extern MArray2<double>
+conv2 (MArray2<double>&, MArray2<double>&, int);
+
+extern MArray2<Complex>
+conv2 (MArray2<Complex>&, MArray2<Complex>&, int);
+#endif
+
+template <class T>
+MArray2<T>
+conv2 (MArray2<T>&A, MArray2<T>&B, int ishape)
+{
+/* Convolution works fastest if we choose the A matrix to be
+ *  the largest.
+ *
+ * Here we calculate the size of the output matrix,
+ *  in order to stay Matlab compatible, it is based
+ *  on the third parameter if its separable, and the
+ *  first if it's not
+ *
+ * NOTE in order to be Matlab compatible, we give
+ *  wrong sizes for 'valid' if the smallest matrix is first
+ */
+
+      int     Am = A.rows();
+      int     An = A.columns();
+      int     Bm = B.rows();
+      int     Bn = B.columns();
+
+      int outM, outN, edgM, edgN;
+      if ( ishape == SHAPE_FULL ) {
+         outM= Am + Bm - 1;
+         outN= An + Bn - 1;
+         edgM= Bm - 1;
+         edgN= Bn - 1;
+      } else if ( ishape == SHAPE_SAME ) {
+         outM= Am;
+         outN= An;
+// Matlab seems to arbitrarily choose this convention for
+// 'same' with even length R, C
+         edgM= ( Bm - 1) /2;
+         edgN= ( Bn - 1) /2;
+      } else if ( ishape == SHAPE_VALID ) {
+         outM= Am - Bm + 1;
+         outN= An - Bn + 1;
+         edgM= edgN= 0;
+      }
+
+//    printf("A(%d,%d) B(%d,%d) O(%d,%d) E(%d,%d)\n",
+//       Am,An, Bm,Bn, outM, outN, edgM, edgN);
+      MArray2<T> O(outM,outN);
+
+      for( int oi=0; oi < outM; oi++ ) {
+         for( int oj=0; oj < outN; oj++ ) {
+            T sum=0;
+
+            for( int bj= Bn - 1 - MAX(0, edgN-oj),
+                     aj= MAX(0, oj-edgN);
+                     bj >= 0 && aj < An;
+                     bj--, aj++) {
+               int           bi= Bm - 1 - MAX(0, edgM-oi);
+               int           ai= MAX(0, oi-edgM); 
+               const T* Ad= A.data() + ai + Am*aj;
+               const T* Bd= B.data() + bi + Bm*bj;
+
+               for( ; bi >= 0 && ai < Am;
+                      bi--, Bd--, ai++, Ad++) {
+                  sum+= (*Ad) * (*Bd);
+/* 
+ * It seems to be about 2.5 times faster to use pointers than
+ *    to do this
+ *                sum+= A(ai,aj) * B(bi,bj);
+ */
+               } // for( int bi=
+            } //for( int bj=
+
+            O(oi,oj)= sum;
+         } // for( int oj=
+      } // for( int oi=
+      return O;
+}
+
+DEFUN_DLD (conv2, args, ,
+  "[...] = conv2 (...)
+CONV2: do 2 dimensional convolution
+
+  c= conv2(a,b) -> same as c= conv2(a,b,'full')
+
+  c= conv2(a,b,shape) returns 2-D convolution of a and b
+      where the size of c is given by
+     shape= 'full'  -> returns full 2-D convolution
+     shape= 'same'  -> same size as a. 'central' part of convolution
+     shape= 'valid' -> only parts which do not include zero-padded edges
+
+  c= conv2(a,b,shape) returns 2-D convolution of a and b
+
+  c= conv2(v1,v2,a) -> same as c= conv2(v1,v2,a,'full') 
+
+  c= conv2(v1,v2,a,shape) returns convolution of a by vector v1
+       in the column direction and vector v2 in the row direction ")
+{
+   octave_value_list retval;
+   octave_value tmp;
+   int nargin = args.length ();
+   string shape= "full";
+   bool separable= false;
+   int ishape;
+
+   if (nargin < 2 ) {
+      print_usage ("conv2");
+      return retval;
+   } else if (nargin == 3) {
+      if ( args(2).is_string() )
+         shape= args(2).string_value();
+      else
+         separable= true;
+   } else if (nargin >= 4) {
+      separable= true;
+      shape= args(3).string_value();
+   }
+   if ( shape == "full" ) ishape = SHAPE_FULL;
+   else if ( shape == "same" ) ishape = SHAPE_SAME;
+   else if ( shape == "valid" ) ishape = SHAPE_VALID;
+   else { // if ( shape
+     error("Shape type not valid");
+     print_usage ("conv2");
+     return retval;
+   }
+
+   if (separable) {
+/*
+ * Check that the first two parameters are vectors
+ *  if we're doing separable
+ */
+      if ( !( 1== args(0).rows() || 1== args(0).columns() ) ||
+           !( 1== args(1).rows() || 1== args(1).columns() ) ) {
+         print_usage ("conv2");
+         return retval;
+      }
+
+      if (args(0).is_complex_type() || args(1).is_complex_type()
+	  || args(2).is_complex_type()) {
+	ComplexColumnVector v1 (args(0).complex_vector_value());
+	ComplexColumnVector v2 (args(1).complex_vector_value());
+	ComplexMatrix a (args(2).complex_matrix_value());
+	ComplexMatrix c(conv2(v1, v2, a, ishape));
+	retval(0) = c;
+      } else {
+	ColumnVector v1 (args(0).vector_value());
+	ColumnVector v2 (args(1).vector_value());
+	Matrix a (args(2).matrix_value());
+	Matrix c(conv2(v1, v2, a, ishape));
+	retval(0) = c;
+      }
+   } else { // if (separable) 
+
+     if (args(0).is_complex_type() || args(1).is_complex_type()) {
+	ComplexMatrix a (args(0).complex_matrix_value());
+	ComplexMatrix b (args(1).complex_matrix_value());
+	ComplexMatrix c(conv2(a, b, ishape));
+	retval(0) = c;
+      } else {
+	Matrix a (args(0).matrix_value());
+	Matrix b (args(1).matrix_value());
+	Matrix c(conv2(a, b, ishape));
+	retval(0) = c;
+      }
+
+   } // if (separable) 
+      
+   return retval;
+}
+
+
+template MArray2<double>
+conv2 (MArray<double>&, MArray<double>&, MArray2<double>&, int);
+
+template MArray2<double>
+conv2 (MArray2<double>&, MArray2<double>&, int);
+
+template MArray2<Complex>
+conv2 (MArray<Complex>&, MArray<Complex>&, MArray2<Complex>&, int);
+
+template MArray2<Complex>
+conv2 (MArray2<Complex>&, MArray2<Complex>&, int);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/cool.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,57 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} cool (@var{n})
+## Create color colormap. 
+## (cyan to magenta)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function map = cool (number)
+
+  global __current_color_map__
+
+  if (nargin == 0)
+    if exist ("__current_color_map__")
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("cool: argument must be a scalar");
+    endif
+  else
+    usage ("cool (number)");
+  endif
+
+  if (number == 1)
+    map = [0, 1, 1];  
+  elseif (number > 1)
+    r = (0:number - 1)' ./ (number - 1);
+    g = 1 - r;
+    b = ones (number, 1);
+    map = [r, g, b];
+  else
+    map = [];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/copper.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,58 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} copper (@var{n})
+## Create color colormap. 
+## (black to a light copper tone)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function map = copper (number)
+
+  global __current_color_map__
+
+  if (nargin == 0)
+    if exist("__current_color_map__")
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("copper: argument must be a scalar");
+    endif
+  else
+    usage ("copper (number)");
+  endif
+
+  if (number == 1)
+    map = [0, 0, 0];  
+  elseif (number > 1)
+    x = linspace (0, 1, number)';
+    r = (x < 4/5) .* (5/4 * x) + (x >= 4/5);
+    g = 4/5 * x;
+    b = 1/2 * x;
+    map = [r, g, b];
+  else
+    map = [];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/cordflt2.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,215 @@
+// Copyright (C) 2000 Teemu Ikonen
+//
+// This program is free software; you can redistribute it and/or
+// modify it under the terms of the GNU General Public License
+// as published by the Free Software Foundation; either version 2
+// of the License, or (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+// General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program; if not, write to the Free Software
+// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+#include <octave/oct.h>
+
+#ifdef HAVE_OCTAVE_20
+typedef Matrix boolMatrix;
+#define bool_matrix_value matrix_value
+#endif
+
+#define SWAP(a, b) { SWAP_temp = (a); (a)=(b); (b) = SWAP_temp; }
+
+// Template function for comparison
+// ET is the type of the matrix element
+template <class ET>
+inline bool compare(const ET a, const ET b)
+{
+    if(a > b)
+      return 1;
+    else
+      return 0;
+}
+
+// Explicit template function for complex compare
+template <> inline bool compare<Complex>(const Complex a, const Complex b)
+{
+    double anorm2 = a.real() * a.real() + a.imag() * a.imag();
+    double bnorm2 = b.real() * b.real() + b.imag() * b.imag();
+        
+    if( anorm2 > bnorm2 ) {
+      return 1;
+    } else {
+      return 0;
+    }
+}
+
+// select nth largest member from the array values
+// Partitioning algorithm, see Numerical recipes chap. 8.5
+template <class ET>
+ET selnth(ET *vals, int len, int nth)
+{
+    ET SWAP_temp;
+    ET hinge;
+    int l, r, mid, i, j;
+
+    l = 0;
+    r = len - 1;
+    for(;;) {
+	// if partition size is 1 or two, then sort and return
+	if(r <= l+1) {
+	    if(r == l+1 && compare<ET>(vals[l], vals[r])) {
+		SWAP(vals[l], vals[r]);
+	    }
+	    return vals[nth];
+	} else {
+	    mid = (l+r) >> 1;
+	    SWAP(vals[mid], vals[l+1]);
+	    // choose median of l, mid, r to be the hinge element
+	    // and set up sentinels in the borders (order l, l+1 and r)
+	    if(compare<ET>(vals[l], vals[r])) {
+		SWAP(vals[l], vals[r]);
+	    }
+	    if(compare<ET>(vals[l+1], vals[r])) {
+		SWAP(vals[l+1], vals[r]);
+	    }
+	    if(compare<ET>(vals[l], vals[l+1])) {
+		SWAP(vals[l], vals[l+1]);
+	    }
+	    i = l+1;
+	    j = r;
+	    hinge = vals[l+1];
+	    for(;;) {
+		do i++; while(compare<ET>(hinge, vals[i]));
+		do j--; while(compare<ET>(vals[j], hinge));
+		if(i > j) 
+		    break;
+		SWAP(vals[i], vals[j]);
+	    }
+	    vals[l+1] = vals[j];
+	    vals[j] = hinge;
+	    if(j >= nth)
+		r = j - 1;
+	    if(j <= nth)
+		l = i;
+	}
+    }
+}
+
+// Template function for doing the actual filtering
+// MT is the type of the matrix to be filtered (Matrix or ComplexMatrix)
+// ET is the type of the element of the matrix (double or Complex)
+template <class MT, class ET> 
+octave_value_list do_filtering(MT A, int nth, boolMatrix dom, MT S)
+{
+    int i, j, c, d;
+    
+    int len = 0;
+    for(j = 0; j < dom.columns(); j++) {
+	for(i = 0; i < dom.rows(); i++) {
+	    if(dom.elem(i,j)) 
+	      len++;
+	}
+    }
+    if(nth > len - 1) {
+	warning("nth should be less than number of non-zero values in domain");
+	warning("setting nth to largest possible value\n");
+	nth = len - 1;
+    }
+    if(nth < 0) {
+	warning("nth should be non-negative, setting to 1\n");
+	nth = 0; // nth is a c-index
+    }
+                
+    int rowoffset = (dom.columns() + 1)/2 - 1;
+    int coloffset = (dom.rows() + 1)/2 - 1;
+
+    //outputs
+    octave_value_list out;
+    const int origx = A.columns() - dom.columns()+1;
+    const int origy = A.rows() - dom.rows()+1;
+    MT retval = MT(origy, origx);
+
+    int *offsets = new int[len];
+    ET *values = new ET[len];
+    ET *adds = new ET[len];
+    
+    c = 0;
+    d = A.rows();
+    for(j = 0; j < dom.columns(); j++) {
+	for(i = 0; i < dom.rows(); i++) {
+	    if(dom.elem(i,j)) {
+		offsets[c] = (i - coloffset) + (j - rowoffset)*d;
+		adds[c] = S.elem(i,j);
+		c++;
+	    }
+	}
+    }
+    
+    ET *data = A.fortran_vec();
+    int base = coloffset + A.rows()*rowoffset;
+    for(j = 0; j < retval.columns(); j++) {
+	for(i = 0; i < retval.rows(); i++) {
+	    for(c = 0; c < len; c++) {
+		values[c] = data[base + offsets[c]] + adds[c];
+	    }
+	    base++;
+	    retval(i, j) = selnth(values, len, nth);
+	}
+	base += dom.rows() - 1;
+    }
+
+    out(0) = octave_value(retval);
+    
+    return out;
+}
+
+// instantiate template functions
+template inline bool compare<double>(const double, const double);
+template double selnth(double *, int, int);
+template Complex selnth(Complex *, int, int);
+template octave_value_list do_filtering<Matrix, double>(Matrix, int, boolMatrix, Matrix);
+// g++ is broken, explicit instantiation of specialized template function
+// confuses the compiler.
+//template int compare<Complex>(const Complex, const Complex);
+template octave_value_list do_filtering<ComplexMatrix, Complex>(ComplexMatrix, int, boolMatrix, ComplexMatrix);
+
+DEFUN_DLD(cordflt2, args, ,
+"function retval = cordflt2(A, nth, domain, S)
+
+ Implementation of two-dimensional ordered filtering. User interface
+ in ordfilt2.m
+")
+{
+    if(args.length() != 4) {
+	print_usage ("ordfilt2");
+	return octave_value_list();
+    }
+    
+    // nth is an index to an array, thus - 1
+    int nth = (int) (args(1).vector_value())(0) - 1;
+    boolMatrix dom = args(2).bool_matrix_value();
+
+    octave_value_list retval;
+    
+    if(args(0).is_real_matrix()) {
+	Matrix A = args(0).matrix_value();
+	Matrix S = args(3).matrix_value();
+	retval = do_filtering<Matrix, double>(A, nth, dom, S);
+    } 
+    else if(args(0).is_complex_matrix()) {
+	ComplexMatrix A = args(0).complex_matrix_value();
+	ComplexMatrix S = args(3).complex_matrix_value();
+	retval = do_filtering<ComplexMatrix, Complex>(A, nth, dom, S);
+    } 
+    else {
+	error("A should be real or complex matrix\n");
+	return octave_value_list();
+    }
+    
+    return retval;
+     
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/corr2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,42 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} @var{r}= corr2 (@var{I},@var{J})
+## returns the correlation coefficient between @var{I} and @var{j}.
+## @var{I,J} must be real type matrices or vectors of same size
+## @end deftypefn
+
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+## Date:	01/08/2000
+
+function r = corr2 (I, J)
+
+  if !(nargin == 2)
+    usage ("corr2(I,J)");
+  endif
+
+  if !(is_matrix(I) && isreal(I) && is_matrix(J) && isreal(J))
+	error("argument must be a real type matrix");
+  endif
+
+  if (size (I) != size (J))
+    error("arguments must be of same size")
+  endif
+  
+  r = cov (I, J) / (std2(I)*std2(J));    
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/flag.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,56 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} flag (@var{n})
+## Create color colormap. 
+## (cycling through red, white, blue and black)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+## flag(number) gives a colormap consists of red, white, blue and black
+## changing with each index
+
+function map = flag (number)
+
+  global __current_color_map__
+
+  if (nargin == 0)
+    if exist ("__current_color_map__")
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("flag: argument must be a scalar");
+    endif
+  else
+    usage ("flag (number)");
+  endif
+
+  p = [1, 0, 0; 1, 1, 1; 0, 0, 1; 0, 0, 0];
+  if (rem(number,4) == 0)
+    map=kron (ones (number / 4, 1), p);
+  else
+    map=[kron(ones (fix (number / 4), 1), p); p(1:rem (number, 4), :)];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/grayslice.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,78 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{X} =} grayslice (@var{I},@var{n})
+## @deftypefnx {Function File} {@var{X} =} grayslice (@var{I},@var{v})
+## creates an indexed image @var{X} from an intensitiy image @var{I}
+## using multiple threshold levels.
+## A scalar integer value @var{n} sets the levels to
+## @example
+## 
+## @group
+## 1  2       n-1
+## -, -, ..., ---
+## n  n        n
+## @end group
+## @end example
+##
+## X = grayslice(I,5);
+##
+## For irregular threshold values a real vector @var{v} can be used.
+## The values must be in the range [0,1].
+##
+## @group
+## X = grayslice(I,[0.1,0.33,0.75,0.9])
+## @end group
+##
+## @end deftypefn
+## @seealso{im2bw}
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+## Date:	03. August 2000
+
+function X = grayslice (I, v)
+
+  if (nargin != 2)
+    usage ("grayslice(...) number of arguments must be 1 or 2");
+  endif
+
+  if (is_scalar(v) && (fix(v) == v))
+
+    v = (1:v - 1) / v;
+
+  elseif (is_vector(v))
+
+    if (any (v < 0) || (any (v > 1)))
+      error ("slice vector must be in range [0,1]")
+    endif
+    v = [0,v,1];
+  else
+
+    usage("second argument");
+
+  endif
+
+  [r, c] = size (I);
+  [m, n] = sort ([v(:); I(:)]);
+  lx = length (v);
+  o = cumsum (n <= lx);
+  idx = o (find(n>lx));
+  [m, n] = sort (I(:));
+  [m, n] = sort (n);
+  X = reshape (idx(n), r, c);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/histeq.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,33 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} @var{J}= histeq (@var{I},@var{n})
+## histogram equalization
+## @end deftypefn
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+## Date:	08. August 2000
+
+function J = histeq (I, n)
+
+  [r,c] = size (I); 
+  [X,map] = gray2ind(I);
+  [nn,xx] = imhist(I);
+  Icdf = ceil (n * cumsum (1/prod(size(I)) * nn));
+  J = reshape(Icdf(X),r,c);
+  plot(Icdf,'b;;');
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/hot.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,58 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} hot (@var{n})
+## Create color colormap. 
+## (black through dark red, red, orange, yellow to white)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function map = hot (number)
+
+  global __current_color_map__
+
+  if (nargin == 0)
+    if exist("__current_color_map__")
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1) 
+	if (! is_scalar (number))
+      error ("hot: argument must be a scalar");
+    endif
+  else
+    usage ("hot (number)");
+  endif
+
+  if (number == 1)
+    map = [0, 0, 0];  
+  elseif (number > 1)
+    x = linspace (0, 1, number)';
+    r = (x < 2/5) .* (5/2 * x) + (x >= 2/5);
+    g = (x >= 2/5 & x < 4/5) .* (5/2 * x - 1) + (x >= 4/5);
+    b = (x >= 4/5) .* (5*x - 4);
+    map = [r, g, b];
+  else
+    map = [];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/hsv.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,54 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} hsv (@var{n})
+## Create color colormap. 
+## (red through yellow, green, cyan,blue,magenta to red)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function map = hsv (number)
+  global __current_color_map__
+
+  if (nargin == 0)
+    if exist("__current_color_map__")
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("hsv: argument must be a scalar");
+    endif
+  else
+    usage ("hsv (number)");
+  endif
+
+  if (number == 1)
+    map = [1, 0, 0];  
+  elseif (number > 1)
+    h = linspace (0, 1, number)';
+    map = hsv2rgb ([h, ones(number, 1), ones(number, 1)]);
+  else
+    map = [];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/hsv2rgb.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,63 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} @var{rgb_map} = hsv2rgb (@var{hsv_map})
+## transform a colormap from the hsv space to the rgb space 
+## @end deftypefn
+## @seealso{rgb2hsv}
+
+##
+## Author:	Kai Habel <kai.habel@gmx.de>
+
+function rgb_map=hsv2rgb(hsv_map)
+
+## each color value x=(r,g,b) is calculated with
+## x = (1-s)*v+s*v*f_x(hue)
+## where fx(hue) is a piecewise defined function for
+## each color with f_r(h-2/3)=f_g(h)=f_b(h-1/3)
+
+  if (is_matrix (hsv_map))
+    nc = size (hsv_map, 2);
+    if (nc == 3)
+      #set values <0 to 0 and >1 to 1
+      hsv_map = (hsv_map >= 0 & hsv_map <= 1) .* hsv_map\
+              + (hsv_map < 0) .* 0 + (hsv_map > 1);
+
+      #fill rgb map with v*(1-s)
+      rgb_map = kron ([1, 1, 1], hsv_map(:, 3) .* (1 - hsv_map(:,2)));
+
+      #red(hue-2/3)=green(hue)=blue(hue-1/3)
+      #apply modulo 1 for red and blue 
+      hue = [ (hsv_map(:, 1)' - 2/3) - floor(hsv_map(:, 1) - 2/3)';
+               hsv_map(:, 1)';
+              (hsv_map(:, 1)' - 1/3) - floor(hsv_map(:, 1) - 1/3)'
+            ]';
+      #factor s*v -> f
+      f = kron ([1, 1, 1], hsv_map(:, 2))\
+        .* kron ([1, 1, 1], hsv_map(:, 3));
+
+      #add s*v* hue-function to rgb map
+      rgb_map = rgb_map +  f .* (6 * (hue < 1/6) .* hue\
+              + (hue >= 1/6 & hue < 1/2)\
+              + (hue >= 1/2 & hue < 2/3) .* (4 - 6 * hue));
+    else
+      usage ("hsv2rgb(hsv_map): hsv_map must be a matrix of size nx3");
+    endif
+  else
+    usage ("hsv2rgb(hsv_map): hsv_map must be a matrix of size nx3");
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/im2bw.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,50 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} @var{BW}= im2bw (@var{I},threshold)
+## @deftypefnx {Function File} @var{BW}= im2bw (@var{X},@var{cmap},threshold)
+## converts image data types to a black-white (binary) image.
+## The treshold value should be in the range [0,1].
+## @end deftypefn
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+## Date:	19. March 2000
+
+function BW = im2bw (img, a, b)
+
+  if ( nargin < 2 || nargin > 3)
+    usage("im2bw(I) number of arguments must be 2 or 3");
+  endif
+
+  if (isgray (img))
+    if (is_scalar (a))
+      BW = (img >= a);
+    else
+      error ("threshold value must be scalar");
+    endif
+  elseif (isind (img))
+    if (is_matrix (a) && columns (a) == 3)
+      if (is_scalar (b))
+        I = ind2gray (img, a);
+        BW = (I >= b);
+      endif
+    endif
+  else
+    error ("image matrix must be of index or intensity type");
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/imadjust.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,100 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} @var{J}= imadjust (@var{I},[low high],[bottom top],gamma)
+## the values in the range [low high] of the image I (intensity) are transformed 
+## in range [bottom top] of the resulting intensity image (J).
+## A gamma value is applied.
+## If gamma is ommitted then a linear mapping (gamma=1) is assumed.
+## 
+## @end deftypefn
+
+## o    |
+## u  ot+           ****
+## t    |        *
+## p    |     *
+## u  ob+****
+## t    |
+##      -+--+-------+--+-
+##       0  il      ih 1
+##         input range
+##
+## Author:	Kai Habel <kai.habel@gmx.de>
+## Date:	17/03/2000
+
+function ret = imadjust (I, in, out, gamma)
+
+  if (nargin < 3 || nargin > 4)
+    usage ("imadjust(...) number of arguments must be 3 or 4");
+  endif
+
+  if (nargin == 3)
+    gamma = 1;
+  else 
+    if !(is_scalar (gamma))
+      error ("imadjust(...,gamma) gamma must be a scalar");
+    else
+      if !(gamma >= 0 && gamma < Inf)
+        error ("gamma range [0,Inf)");
+      endif
+    endif
+  endif
+
+  if !(is_matrix (I))
+    error ("imadjust(I,...) I must be a image matrix or colormap");
+  endif
+
+  if !((is_vector (in) || isempty (in)) && (is_vector (out) || isempty (out)) )
+    usage ("imadjust(I,[low high],[bottom top],gamma)");
+  else
+    if (length (in) == 0)
+      il = 0;
+      ih = 1;
+    elseif (length (in) == 2)
+      il = min (in);
+      ih = max (in);
+    else
+      usage ("imadjust(I,[low high],[bottom top],gamma)");
+    endif
+
+    if (length (out) == 0)
+      ob = 0;
+      ot = 1;
+    elseif (length (out) == 2)
+      ob = out (1);
+      ot = out (2);
+
+      if (ob >= ot)
+        ob = out (1);
+        ot = out (2);
+        warning ("bottom greater top");
+      endif
+    else
+      usage ("imadjust(I,[low high],[bottom top],gamma)");
+    endif
+  endif
+
+  ret = (I < il) .* ob;
+  ret = ret + (I >= il && I < ih) .* (ob + (ot - ob) .* ((I - il) / (ih - il)) .^ gamma);
+  ret = ret + (I >= ih) .* ot;
+
+  if (in(1) > in(2))
+    # hmm don't know if this is correct for gamma!=1
+    ret = il + (ih - ret);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/imhist.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,72 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} imhist (@var{I},@var{n})
+## @deftypefnx {Function File} {} imhist (@var{I})
+## @deftypefnx {Function File} {} imhist (@var{X},@var{cmap})
+## @deftypefnx {Function File} {[@var{n,x}] = } imhist (...)
+## Shows the histogram of an image using hist 
+## @end deftypefn
+## @seealso{hist}
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+## July 2000 : Paul Kienzle code simplification for hist() call.
+
+function [...] = imhist (I, b)
+
+  if (nargin < 1 || nargin > 2)
+    usage("imhist(image,n)");
+  endif
+
+  b_is_colormap = 0;
+
+  if (nargin == 2)
+    if (is_matrix (b))
+      b_is_colormap = (columns (b) == 3);
+    endif
+  endif
+
+  if (b_is_colormap)
+    ## assuming I is an indexed image
+    ## b is colormap
+    max_idx = max (max (I));
+    bins = rows (b);
+    if (max_idx > bins)
+      warning ("largest index exceedes length of colormap");
+    endif
+  else
+    ## assuming I is an intensity image
+    ## b is number of bins
+    if (nargin == 1)
+      bins = 256;
+    else
+      bins = b;
+    endif
+
+    ## scale image to range [0,1]
+    I = mat2gray (I);
+  endif
+  
+  if (nargout == 2)
+    [nn,xx] = hist (I(:), bins);
+    vr_val (nn);
+    vr_val (xx);
+  else
+    hist (I(:), bins);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/imnoise.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,56 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: B = imnoise (A, type)
+##
+## Adds noise to image in A.
+##
+## imnoise (A, 'gaussian' [, mean [, var]])
+##    additive gaussian noise: A = A + noise
+##    defaults to mean=0, var=0.01
+##
+## imnoise (A, 'salt & pepper' [, density])
+##    lost pixels: A = 0 or 1 for density*100% of the pixels
+##    defaults to density=0.05, or 5%
+##
+## imnoise (A, 'speckle' [, var])
+##    multiplicative gaussian noise: A = A + A*noise
+##    defaults to var=0.04
+
+function A = imnoise(A, stype, a, b)
+
+  if (nargin < 3 || nargin > 4 || !is_matrix(A) || !isstr(stype))
+    usage("B = imnoise(A, type, parameters, ...)");
+  endif
+
+  stype = tolower(stype);
+  if (strcmp(stype, 'gaussian'))
+    if (nargin < 3), a = 0.0; endif
+    if (nargin < 4), b = 0.01; endif
+    A = A + (a + randn(size(A)) * b);
+  elseif (strcmp(stype, 'salt & pepper'))
+    if (nargin < 3), a = 0.05; endif
+    noise = rand(size(A));
+    A(noise <= a/2) = 0;
+    A(noise >= 1-a/2) = 1;
+  elseif (strcmp(stype, 'speckle'))
+    if (nargin < 3), a = 0.04; endif
+    A = A * (1 + randn(size(A))*a);
+  else
+    error("imnoise: use type 'gaussian', 'salt & pepper', or 'speckle'");
+  endif
+
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/impad.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,135 @@
+## Copyright (C) 2000 Teemu Ikonen
+##
+## This program is free software; you can redistribute it and/or
+## modify it under the terms of the GNU General Public License
+## as published by the Free Software Foundation; either version 2
+## of the License, or (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} impad(@var{A}, @var{xpad}, @var{ypad}, [@var{padding}, [@var{const}]])
+## Pad (augment) a matrix for application of image processing algorithms.
+##
+## Pads the input image @var{A} with @var{xpad}(1) elements from left, 
+## @var{xpad}(2), elements from right, @var{ypad}(1) elements from above 
+## and @var{ypad}(2) elements from below.
+## Values of padding elements are determined from the optional arguments
+## @var{padding} and @var{const}. @var{padding} is one of
+##
+## @table @samp
+## @item "zeros"     
+## pad with zeros (default)
+##
+## @item "ones"      
+## pad with ones
+##
+## @item "constant"  
+## pad with a value obtained from the optional fifth argument const
+##
+## @item "symmetric" 
+## pad with values obtained from @var{A} so that the padded image mirrors 
+## @var{A} starting from edges of @var{A}
+## 
+## @item "reflect"   
+## same as symmetric, but the edge rows and columns are not used in the padding
+##
+## @item "replicate" 
+## pad with values obtained from A so that the padded image 
+## repeates itself in two dimensions
+## 
+## @end table
+
+## Author: Teemu Ikonen <tpikonen@pcu.helsinki.fi>
+## Created: 5.5.2000
+## Keywords: padding image processing
+
+## A nice test matrix for padding:
+## A = 10*[1:5]' * ones(1,5) + ones(5,1)*[1:5]
+
+function retval = impad(A, xpad, ypad, ...)
+
+padding = "zeros";
+const = 1;
+va_start();
+if(nargin > 3)
+  padding = va_arg();
+  if(nargin > 4)
+    const = va_arg();
+  endif
+endif
+  
+origx = size(A,2);
+origy = size(A,1);
+retx = origx + xpad(1) + xpad(2);
+rety = origy + ypad(1) + ypad(2);
+
+emptywarn = empty_list_elements_ok;
+empty_list_elements_ok = 1;
+
+if(strcmp(padding, "zeros"))
+  retval = zeros(rety,retx);
+  retval(ypad(1)+1 : ypad(1)+origy, xpad(1)+1 : xpad(1)+origx) = A;
+  elseif(strcmp(padding,"ones"))
+    retval = ones(rety,retx);
+    retval(ypad(1)+1 : ypad(1)+origy, xpad(1)+1 : xpad(1)+origx) = A;
+  elseif(strcmp(padding,"constant"))
+    retval = const.*ones(rety,retx);
+    retval(ypad(1)+1 : ypad(1)+origy, xpad(1)+1 : xpad(1)+origx) = A;
+  elseif(strcmp(padding,"replicate"))
+    y1 = origy-ypad(1)+1;
+    x1 = origx-xpad(1)+1;    
+    if(y1 < 1 || x1 < 1 || ypad(2) > origy || xpad(2) > origx)
+      error("Too large padding for this padding type");
+    else
+      yrange1 = y1 : origy;
+      yrange2 = 1 : ypad(2);
+      xrange1 = x1 : origx;
+      xrange2 = 1 : xpad(2);
+      retval = [ A(yrange1, xrange1), A(yrange1, :), A(yrange1, xrange2);
+                 A(:, xrange1),       A,             A(:, xrange2);
+                 A(yrange2, xrange1), A(yrange2, :), A(yrange2, xrange2) ];
+    endif                        
+  elseif(strcmp(padding,"symmetric"))
+    y2 = origy-ypad(2)+1;
+    x2 = origx-xpad(2)+1;
+    if(ypad(1) > origy || xpad(1) > origx || y2 < 1 || x2 < 1)
+      error("Too large padding for this padding type");
+    else
+      yrange1 = 1 : ypad(1);
+      yrange2 = y2 : origy;
+      xrange1 = 1 : xpad(1);
+      xrange2 = x2 : origx;
+      retval = [ fliplr(flipud(A(yrange1, xrange1))), flipud(A(yrange1, :)), fliplr(flipud(A(yrange1, xrange2)));
+                 fliplr(A(:, xrange1)), A, fliplr(A(:, xrange2));
+                 fliplr(flipud(A(yrange2, xrange1))), flipud(A(yrange2, :)), fliplr(flipud(A(yrange2, xrange2))) ];
+    endif      
+  elseif(strcmp(padding,"reflect"))
+    y2 = origy-ypad(2);
+    x2 = origx-xpad(2);
+    if(ypad(1)+1 > origy || xpad(1)+1 > origx || y2 < 1 || x2 < 1)
+      error("Too large padding for this padding type");
+    else
+      yrange1 = 2 : ypad(1)+1;
+      yrange2 = y2 : origy-1;
+      xrange1 = 2 : xpad(1)+1;
+      xrange2 = x2 : origx-1;
+      retval = [ fliplr(flipud(A(yrange1, xrange1))), flipud(A(yrange1, :)), fliplr(flipud(A(yrange1, xrange2)));
+                 fliplr(A(:, xrange1)), A, fliplr(A(:, xrange2));
+                 fliplr(flipud(A(yrange2, xrange1))), flipud(A(yrange2, :)), fliplr(flipud(A(yrange2, xrange2))) ];
+    endif
+  else    
+    error("Unknown padding type");
+endif
+
+empty_list_elements_ok = emptywarn;  
+      
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/isbw.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,39 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} @var{bool}= isbw (@var{BW})
+## returns true for a black-white (binary) image.
+## All values must be either 0 or 1
+## @end deftypefn
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+## Date:	20/03/2000
+
+function bool = isbw (BW)
+
+  bool = 0;	
+  if !(nargin == 1)
+    usage ("isbw(BW)");
+  endif
+
+  if !(is_matrix(BW))
+    return;
+  endif
+
+  bool = all (all ((BW == 1) + (BW == 0)));
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/isgray.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,40 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} @var{bool}= isgray (@var{I})
+## returns true for an intensity image. All intensity values must
+## be in the range [0,1].
+## @end deftypefn
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+## Date:	20/03/2000
+
+function bool = isgray (I)
+
+  bool = 0;
+
+  if !(nargin == 1)
+    usage ("isgray(I)");
+  endif
+
+  if (!is_matrix(I))
+    return;
+  endif
+
+  bool = all (all ((I >= 0) && (I <= 1)));
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/isind.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,41 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WXTHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABXLXTY or FXTNESS FOR A PARTXCULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Xnc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} @var{bool}= isind (@var{X})
+## returns true for an index image. All index values must
+## be intergers and greater than 1.
+## @end deftypefn
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+## Date:	20/03/2000
+
+function bool = isind (X)
+
+  bool = 0;	
+  if !(nargin == 1)
+    usage ("isind(X)");
+  endif
+
+  if (!is_matrix(X))
+    return;
+  endif
+
+  is_int = 1 - any (any (X - floor (X) ));
+  is_gt_one = all (all ( X > 1 ));
+  bool = is_int * is_gt_one;
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/jet.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,61 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} jet (@var{n})
+## Create color colormap. 
+## (dark blue through blue, cyan, green, yellow, red to dark red)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function map = jet (number)
+
+  global __current_color_map__
+
+  if (nargin == 0)
+    if (exist ("__current_color_map__"))
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("jet: argument must be a scalar");
+    endif
+  else
+    usage ("jet (number)");
+  endif
+
+  if (number == 1)
+    map = [0, 0, 0.5];  
+  elseif (number > 1)
+    x = linspace(0, 1, number)';
+    r = (x >= 3/8 & x < 5/8) .* (4 * x - 3/2)\
+      + (x >= 5/8 & x < 7/8) + (x >= 7/8) .* (-4 * x + 9/2);
+    g = (x >= 1/8 & x < 3/8) .* (4 * x - 1/2)\
+      + (x >= 3/8 & x < 5/8) + (x >= 5/8 & x < 7/8) .* (-4 * x + 7/2);
+    b = (x < 1/8) .* (4 * x + 1/2) + (x >= 1/8 & x < 3/8)\
+      + (x >= 3/8 & x < 5/8) .* (-4 * x + 5/2);
+    map = [r, g, b];
+  else
+    map = [];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/mat2gray.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,49 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} @var{I}= mat2gray (@var{M},[min max])
+## converts a matrix to a intensity image
+## @end deftypefn
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+## Date:	22/03/2000
+
+function I = mat2gray (M, scale)
+
+  if (nargin < 1|| nargin > 2)
+    usage ("mat2gray(...) number of arguments must be 1 or 2");
+  endif
+
+  if (!is_matrix (M))
+    usage ("mat2gray(M,...) M must be a matrix");
+  endif
+
+  if (nargin == 1)
+    Mmin = min (min (M));
+    Mmax = max (max (M));
+  else 
+    if (is_vector (scale))
+      Mmin = min (scale (1), scale (2));
+      Mmax = max (scale (1), scale (2));
+    endif
+  endif
+
+  I = (M < Mmin) .* 0;
+  I = I + (M >= Mmin & M < Mmax) .* (1 / (Mmax - Mmin) * (M - Mmin));
+  I = I + (M >= Mmax);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/mean2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,39 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} @var{m}= mean2 (@var{I})
+## returns the mean value for a 2d real type matrix.
+## Uses @code{mean(I(:))}
+## @end deftypefn
+## @seealso{std2,mean}
+
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+## Date:	01/08/2000
+
+function m = mean2 (I)
+
+  if !(nargin == 1)
+    usage ("mean2(I)");
+  endif
+
+  if !(is_matrix(I) && isreal(I))
+	error("argument must be a real type matrix");
+  endif
+
+  m = mean (I(:));
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/medfilt2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,69 @@
+## Copyright (C) 2000 Teemu Ikonen
+##
+## This program is free software; you can redistribute it and/or
+## modify it under the terms of the GNU General Public License
+## as published by the Free Software Foundation; either version 2
+## of the License, or (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} medfilt2(@var{A}, [@var{domain}, @var{padding}])
+## Two dimensional median filtering.
+##
+## Replaces elements of @var{A} with the median of their neighbours defined 
+## by true elements of logical matrix @var{domain}. The default @var{domain} 
+## is a 3 by 3 matrix with all elements equal to 1. If @var{domain} is 1 by 2
+## row vector, the domain matrix will be 
+## logical(ones(@var{domain}(2), @var{domain}(1))).
+##
+## Optional variable @var{padding} defines the padding used in augmenting 
+## the borders of @var{A}. See impad for details.
+##
+## @end deftypefn
+## @seealso{ordfilt2}
+
+## Author: Teemu Ikonen <tpikonen@pcu.helsinki.fi>
+## Created: 5.5.2000
+## Keywords: image processing median filtering
+
+function retval = medfilt2(A, ...)
+
+padding = "zeros";
+domain = logical(ones(3,3));
+
+nargin = nargin - 1;
+va_start();
+while(nargin--)
+  a = va_arg();
+  if(isstr(a))
+    padding = a;
+  elseif(is_vector(a) && size(a) == [1, 2])
+    domain = logical(ones(a(2), a(1)));
+  elseif(is_matrix(a))
+    domain = logical(a);
+  endif
+endwhile
+
+n = sum(sum(domain));
+if((n - 2*floor(n/2)) == 0) % n even - more work
+  nth = floor(n/2);
+  a = ordfilt2(A, nth, domain, padding);
+  b = ordfilt2(A, nth + 1, domain, padding);
+  retval = (a + b)./2;
+else
+  nth = floor(n/2) + 1;
+  retval = ordfilt2(A, nth, domain, padding);
+endif
+
+endfunction
+  
+  
+  
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/ordfilt2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,74 @@
+## Copyright (C) 2000 Teemu Ikonen
+##
+## This program is free software; you can redistribute it and/or
+## modify it under the terms of the GNU General Public License
+## as published by the Free Software Foundation; either version 2
+## of the License, or (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} ordfilt2(@var{A}, @var{nth}, @var{domain}, [@var{S}, @var{padding}])
+## Two dimensional ordered filtering.
+##
+## Ordered filter replaces an element of @var{A} with the @var{nth} 
+## element of the sorted set of neighbours defined by the logical 
+## (boolean) matrix @var{domain}.
+## Neighbour elements are selected to the sort if the corresponding 
+## element in the @var{domain} matrix is true.
+## 
+## The optional variable @var{S} is a matrix of size(@var{domain}). 
+## Values of @var{S} corresponding to nonzero values of domain are 
+## added to values obtained from @var{A} when doing the sorting.
+##
+## Optional variable @var{padding} determines how the matrix @var{A} 
+## is padded from the edges. See impad for details.
+## 
+## @end deftypefn
+## @seealso{medfilt2}
+
+
+## Author: Teemu Ikonen <tpikonen@pcu.helsinki.fi>
+## Created: 5.5.2000
+## Keywords: image processing filtering
+
+function retval = ordfilt2(A, nth, domain, ...)
+
+S = zeros(size(domain));
+padding = "zeros";
+nargin = nargin - 3;
+va_start();
+while(nargin--)
+  a = va_arg();
+  if(isstr(a))
+    padding = a;
+  elseif(is_matrix(a) && size(a) == size(domain))
+    S = a;
+  endif
+endwhile
+
+if(!islogical(domain))
+  %  warning("domain should be a boolean matrix, converting");
+  domain = logical(domain);
+endif;
+
+xpad(1) = floor((size(domain, 2)+1)/2) - 1;
+xpad(2) = size(domain,2) - xpad(1) - 1;
+ypad(1) = floor((size(domain, 1)+1)/2) - 1;
+ypad(2) = size(domain,1) - ypad(1) - 1;
+
+if(ypad(1) >= size(A,1) || xpad(1) >= size(A,2))
+  error("domain matrix too large");
+endif;
+
+A = impad(A, xpad, ypad, padding);
+retval = cordflt2(A, nth, domain, S);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/pink.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,60 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} pink (@var{n})
+## Create color colormap. 
+## (gives a sephia tone on b/w images)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function map = pink (number)
+  global __current_color_map__
+
+  if (nargin == 0)
+    if (exist ("__current_color_map__"))
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("pink: argument must be a scalar");
+    endif
+  else
+    usage ("pink (number)");
+  endif
+
+  if (number == 1)
+    map = [0, 0, 0];  
+  elseif (number > 1)
+    x = linspace (0, 1, number)';
+    r = (x < 3/8) .* (14/9 * x) + (x >= 3/8) .* (2/3 * x + 1/3);
+    g = (x < 3/8) .* (2/3 * x)\
+      + (x >= 3/8 & x < 3/4) .* (14/9 * x - 1/3)\
+      + (x >= 3/4) .* (2/3 * x + 1/3);
+    b = (x < 3/4) .* (2/3 * x) + (x >= 3/4) .* (2 * x - 1);
+
+    map = sqrt ([r, g, b]);
+  else
+    map = [];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/prism.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,53 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} prism (@var{n})
+## Create color colormap. 
+## (cycling trough red, orange, yellow, green, blue and violet)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function map = prism (number)
+  global __current_color_map__
+
+  if (nargin == 0)
+    if exist("__current_color_map__")
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("prism: argument must be a scalar");
+    endif
+  else
+    usage ("prism (number)");
+  endif
+
+  p = [1, 0, 0; 1, 1/2, 0; 1, 1, 0; 0, 1, 0; 0, 0, 1; 2/3, 0, 1];
+
+  if (rem (number, 6) == 0)
+    map = kron(ones (fix (number / 6), 1), p);
+  else
+    map = [kron(ones (fix (number / 6), 1), p); p(1:rem (number, 6), :)];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/rainbow.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,62 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} rainbow (@var{n})
+## Create color colormap. 
+## (red through orange, yellow, green, blue to violet)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function map = rainbow (number)
+## this colormap is not part of matlab, it is like the prism
+## colormap map but with a continuous map
+
+  global __current_color_map__
+
+  if (nargin == 0)
+    if exist ("__current_color_map__")
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("rainbow: argument must be a scalar");
+    endif
+  else
+    usage ("rainbow (number)");
+  endif
+
+  if (number == 1)
+    map = [1, 0, 0];  
+  elseif (number > 1)
+    x = linspace (0, 1, number)';
+    r = (x < 2/5) + (x >= 2/5 & x < 3/5) .* (-5 * x + 3)\
+      + (x >= 4/5) .* (10/3 * x - 8/3);
+    g = (x < 2/5) .* (5/2 * x) + (x >= 2/5 & x < 3/5)\
+      + (x >= 3/5 & x < 4/5) .* (-5 * x + 4);
+    b = (x >= 3/5 & x < 4/5) .* (5 * x - 3) + (x >= 4/5);
+    map = [r, g, b];
+  else
+    map = [];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/rgb2gray.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,47 @@
+## Copyright (C) 2000, 2001  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} @var{I}= rgb2gray (@var{M})
+## converts a color map to a gray map. 
+## The RGB map is converted into the YIQ space of ntsc. The luminance
+## value (Y) is taken to create a gray color map.
+## R = G = B = Y
+## @end deftypefn
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+## Date:	19. March 2000
+
+function graymap = rgb2gray (rgb)
+
+  if (nargin != 1)
+    usage ("graymap = rgb2gray (map)");
+  endif
+
+  msg = "rgb2gray: argument must be a matrix of size n x 3";
+  if (! is_matrix (rgb))
+    error (msg);
+  endif
+
+  nc = columns (rgb);
+  if (nc != 3)
+    error (msg);
+  endif
+
+  ntscmap = rgb2ntsc (rgb);
+
+  graymap = ntscmap (:, 1) * ones (1, 3);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/rgb2hsv.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,77 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} @var{hsv_map} = rgb2hsv (@var{rgb_map})
+## transform a colormap from the rgb space to the hsv space 
+## @end deftypefn
+## @seealso{hsv2rgb}
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+
+function hsval = rgb2hsv (rgb)
+  if (is_matrix (rgb))
+    nc = size (rgb, 2);
+    if (nc == 3)
+      #get saturation and value
+      v = max (rgb');
+      s = (v' > 0) .* (1 .- min (rgb') ./ v)';
+      #if v==0 set s to 0 too
+      s = isnan (s) .* 0;
+
+      #subtract minimum and divide trough maximum
+      #to get the bright and saturated colors
+
+      sc = (rgb - kron ([1, 1, 1], min (rgb')'));
+      sv = sc ./ kron([1, 1, 1], max (sc')');
+      #if r=g=b (gray value) set hue to 0
+      sv = isnan (sv) .* 0;
+
+      #hue=f(color) must be splitted into 6 parts 
+      #2 for each color
+
+      #h1(green)
+      tmp = (sv(:, 1) == 1 & sv(:,3) == 0) .* (1/6 * sv(:,2) + eps);
+      #avoid problems with h2(red) since hue(0)==hue(1)
+      h = (tmp < 1/6) .* tmp; 
+      #h2(green)
+      h = h + ((h == 0) & sv(:,1) == 0 & sv(:,3) == 1)\
+        .* (-1/6 * sv(:,2) + 2/3 + eps);
+
+      #h1(red)
+      h = h + ((h == 0) & sv(:,2) == 1 & sv(:,3) == 0)\
+        .* (-1/6 * sv(:,1) + 1/3 + eps);
+      #h2(red)
+      h = h + ((h == 0) & sv(:,2) == 0 & sv(:,3) == 1)\
+        .* (1/6 * sv(:,1) + 2/3 + eps);
+
+      #h1(blue)
+      h = h + ((h == 0) & sv(:,1) == 1 & sv(:,2) == 0)\
+        .* (-1/6 * sv(:,3) + 1 + eps);
+      #h2(blue)
+      h = h + ((h == 0) & sv(:,1) == 0 & sv(:,2) == 1)\
+        .* (1/6 * sv(:,3) + 1/3);
+
+      hsval = [h, s, v'];
+
+    else
+      usage ("rgb2hsv(rgb_map): rgb_map must be a matrix of size nx3");
+    endif
+  else
+    usage ("rgb2hsv(rgb_map): rgb_map must be a matrix of size nx3");
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/spring.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,56 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} spring (@var{n})
+## Create color colormap. 
+## (magenta to yellow)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function map = spring (number)
+  global __current_color_map__
+
+  if (nargin == 0)
+    if exist ("__current_color_map__")
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("spring: argument must be a scalar");
+    endif
+  else
+    usage ("spring (number)");
+  endif
+
+  if (number == 1)
+    map = [1, 0, 1];  
+  elseif (number > 1)
+    r = ones (number, 1);
+    g = (0:number - 1)' ./ (number - 1);
+    b = 1 - g;
+    map = [r, g, b];
+  else
+    map = [];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/std2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,38 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} @var{s}= std2 (@var{I})
+## returns the standard deviation for a 2d real type matrix.
+## Uses @code{std (I(:))}
+## @end deftypefn
+## @seealso{mean2,std}
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+## Date:	01/08/2000
+
+function s = std2 (I)
+
+  if !(nargin == 1)
+    usage ("std2(I)");
+  endif
+
+  if !(is_matrix(I) && isreal(I))
+	error("argument must be a real type matrix");
+  endif
+
+  s = std (I(:));
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/summer.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,57 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} summer (@var{n})
+## Create color colormap. 
+## (green to yellow)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+## Date:  06/03/2000
+function map = summer (number)
+  global __current_color_map__
+
+  if (nargin == 0)
+    if exist ("__current_color_map__")
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("summer: argument must be a scalar");
+    endif
+  else
+    usage ("summer (number)");
+  endif
+
+  if (number == 1)
+    map = [0, 0.5, 0.4];  
+  elseif (number > 1)
+    r = (0:number - 1)' ./ (number - 1);
+    g = 0.5 + r ./ 2;
+    b = 0.4 * ones (number, 1);
+
+    map = [r, g, b];
+  else
+    map = [];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/white.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,51 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} white (@var{n})
+## Create color colormap. 
+## (completly white)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function map = white (number)
+  global __current_color_map__
+
+  if (nargin == 0)
+    if exist ("__current_color_map__")
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("white: argument must be a scalar");
+    endif
+  else
+    usage ("white (number)");
+  endif
+
+  if (number > 0)
+    map = ones (number, 3);
+  else
+    map = [];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/image/winter.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,57 @@
+## Copyright (C) 1999,2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} winter (@var{n})
+## Create color colormap. 
+## (blue to green)
+## The argument @var{n} should be a scalar.  If it
+## is omitted, the length of the current colormap or 64 is assumed.
+## @end deftypefn
+## @seealso{colormap}
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+
+function map = winter (number)
+  global __current_color_map__
+
+  if (nargin == 0)
+    if exist ("__current_color_map__")
+      number = rows (__current_color_map__);
+    else
+      number = 64;
+    endif
+  elseif (nargin == 1)
+    if (! is_scalar (number))
+      error ("winter: argument must be a scalar");
+    endif
+  else
+    usage ("winter (number)");
+  endif
+
+  if (number == 1)
+    map = [0, 0, 1];  
+  elseif (number > 1)
+    r = zeros (number, 1);
+    g = (0:number - 1)' ./ (number - 1);
+    b = 1 - g ./ 2;
+
+    map = [r, g, b];
+  else
+    map = [];
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/linear-algebra/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,8 @@
+include ../../Makeconf
+
+PROGS=rsf2csf.oct
+
+all: $(PROGS)
+
+clean:
+	-$(RM) *.o $(PROGS) octave-core core *~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/linear-algebra/funm.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,63 @@
+## Copyright (C) 2000 P.R. Nienhuis
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING.  If not, write to the
+## Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## funm:  Matrix equivalent of function 'name'
+##
+## Usage:    B = funm(A, name)
+##  where    A = square non-singular matrix, provisionally
+##               real-valued
+##           B = square result matrix
+##        name = string, name of function to apply to A.
+##        args = any arguments to pass to function 'name'
+##               The function must accept a vector and apply
+##               element-wise to that vector.
+##
+## Example:  To compute sqrtm(A), you could use funm(A, 'sqrt')
+##
+## Note that you should not use funm for 'sqrt', 'log' or 'exp'; instead
+## use sqrtm, logm and expm which are more robust. Similarly,
+## trigonometric and hyperbolic functions (cos, sin, tan, cot, sec, csc,
+## cosh, sinh, tanh, coth, sech, csch) are better handled by thfm(A,
+## name), which defines them in terms of the more robust expm.
+
+## NOTE: the following comments are withheld until they can be verified
+##
+## If you have a network of coupled systems, where for the individual
+## systems a solution exists in terms of scalar variables, in many
+## cases the network might be solved using the same form of the
+## solution but with substituting the matrix equivalent of the function
+## applied to the scalar variables.
+## The approach is to do an eigen-analysis of the network to decouple
+## the systems, apply the scalar functions to the eigenvalues,
+## and then recombine the systems into a network.
+
+## Author: P.R. Nienhuis, 106130.1515@compuserve.com
+## Additions by P. Kienzle, .........
+## 2001-03-01 Paul Kienzle
+##    * generate error for repeated eigenvalues
+
+function B = funm(A, name)
+
+  if (nargin != 2 || !isstr(name) || isstr(A))
+    usage ("B = funm (A, 'f' [, args])");
+  endif
+
+  [V, D] = eig (A);
+  D = diag (feval (name, diag(D)));
+  B = V * D * inv (V);
+  
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/linear-algebra/rref.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,75 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## rref   Reduced row echelon form
+##      R = rref (A, tol) returns the reduced row echelon form of a.
+##      tol defaults to eps * max (size (A)) * norm (A, inf)
+##
+##      [R, k] = rref (...) returns the vector of "bound variables",
+##      which are those columns on which elimination has been performed.
+
+## Author: Paul Kienzle (based on a anonymous source from the public domain)
+
+function [A, k] = rref (A, tolerance)
+
+  ## Supress empty list warnings
+  eleo = empty_list_elements_ok;
+  unwind_protect
+    empty_list_elements_ok = 1;
+    
+    [rows,cols] = size (A);
+
+    if (nargin < 2)
+      tolerance = eps * max (rows, cols) * norm (A, inf);
+    endif
+
+    used = zeros(1,cols);
+    r = 1;
+    for c=1:cols
+      ## Find the pivot row
+      [m, pivot] = max (abs (A (r:rows, c)));
+      pivot = r + pivot - 1;
+      
+      if (m <= tolerance)
+      	## Skip column c, making sure the approximately zero terms are
+	## actually zero.
+      	A (r:rows, c) = zeros (rows-r+1, 1);
+
+      else
+	## keep track of bound variables
+	used (1, c) = 1;
+
+      	## Swap current row and pivot row
+	A ([pivot, r], c:cols) = A ([r, pivot], c:cols);
+
+	## Normalize pivot row
+	A (r, c:cols) = A (r, c:cols) / A (r, c);
+
+	## Eliminate the current column
+	ridx = [1:r-1, r+1:rows];
+	A (ridx, c:cols) = A (ridx, c:cols) - A (ridx, c) * A(r, c:cols);
+
+	## Check if done
+      	if (r++ == rows) break; endif
+      endif
+    endfor
+    k = find(used);
+
+  unwind_protect_cleanup
+    ## Restore state
+    empty_list_elements_ok = eleo;
+  end_unwind_protect
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/linear-algebra/rsf2csf.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,175 @@
+/*
+Copyright (C) 2001 Ian Searle
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+2001-03-07 Ross Lippert
+  * adapted from rlab, using a slightly different similarity transform
+2001-03-18 Paul Kienzle
+   * convert to C++
+*/
+
+#include <octave/oct.h>
+
+// XXX FIXME XXX 
+// This should be a constructor for ComplexSCHUR
+//     ComplexSCHUR::ComplexSCHUR(const Matrix& U, const Matrix& T)
+// Should also have something like
+//     ComplexSCHUR::ComplexSCHUR(const SCHUR& s)
+//      { return ComplexSCHUR(s.unitary_mat(), s.schur_mat()); }
+// The reason for using it (other than to provide the Octave function
+// rsf2csf) is that for real A, ComplexSCHUR(SCHUR(A)) is more than
+// twice as fast as ComplexSCHUR(ComplexMatrix(A)).
+
+/* Converts real schur form (all real values, but some non-zero 
+ * subdiagonals) to complex schur form (all zeros below the diagonal).
+ * Assumes correct input: 
+ *    square U and T of the same size, 
+ *    U*T*U'=A, U*U'=I, 
+ *    no consecutive non-zero entries on the subdiagonal, 
+ *    tril(A,-2)==0 everywhere.
+ */
+void
+rsf2csf(const Matrix& U, const Matrix& T, 
+	ComplexMatrix& retU, ComplexMatrix& retT)
+{
+  const int n=U.rows();
+
+  retU = ComplexMatrix(U);
+  retT = ComplexMatrix(T);
+
+  // for m = find(diag (T, -1))'
+  for (int m = 0; m < n-1; m++)
+    {
+      // k = m:m+1
+      const int m1 = m+1;
+      if (T(m1,m) != 0.0)
+	{
+	  // d = eig(T(k,k))
+	  const double b = (T(m,m) + T(m1,m1))/2;
+	  const double c = T(m,m)*T(m1,m1) - T(m,m1)*T(m1,m);
+	  const Complex d(b, sqrt(c - b*b));
+	  
+	  // cs = [ T(m+1,m+1)-d(1), -T(m+1,m) ]
+	  Complex cs1 = T(m1,m1)-d;
+	  double cs2 = -T(m1,m);
+	  
+	  // cs = cs / norm (cs)
+	  const double norm_cs=sqrt(real(cs1*conj(cs1)) + cs2*cs2);
+	  cs1 /= norm_cs;
+	  cs2 /= norm_cs;
+	  
+	  // G = [ conj(cs(1)), cs(2); cs(2), -cs(1) ]
+	  const Complex G11 = conj(cs1);
+	  const Complex G22 = -cs1;
+	  const Complex cG11 = cs1;
+	  const Complex cG22 = conj(-cs1);
+	  
+	  // T (k, m:n) = G' * T (k, m:n)
+	  for (int i=m; i < n; i++)
+	    {
+	      const Complex a = retT(m,i)*cG11 + retT(m1,i)*cs2;
+	      retT(m1,i) = retT(m,i)*cs2 + retT(m1,i)*cG22; 
+	      retT(m,i) = a;
+	    }
+	  
+	  // T (1:m+1, k) = T (1:m+1, k) * G
+	  for (int i=0; i <= m+1; i++)
+	    {
+	      const Complex a = retT(i,m)*G11 + retT(i,m1)*cs2;
+	      retT(i,m1) = retT(i,m)*cs2 + retT(i,m1)*G22; 
+	      retT(i,m) = a;
+	    }
+	  
+	  // U (:, k) = U (:, k) * G
+	  for (int i=0; i < n; i++)
+	    {
+	      const Complex a = retU(i,m)*G11 + retU(i,m1)*cs2;
+	      retU(i,m1) = retU(i,m)*cs2 + retU(i,m1)*G22; 
+	      retU(i,m) = a;
+	    }
+	  
+	  // T (m+1,m) = 0
+	  retT(m+1,m) = 0.0;
+	}
+    }
+  // endfor
+}
+
+DEFUN_DLD(rsf2csf, args, nargout,
+	  "-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {[@var{u}, @var{s} =} rsf2csf (@var{u}, @var{s})\n\
+Converts real schur form (a quasi-triangular system with all real elements)\n\
+into complex schur form (a pure triangular system which may contain complex\n\
+elements). The resulting @var{u} and @var{s},  while completely different\n\
+from what would be obtained with @var{a} slightly complex, still satisfy\n\
+the identities\n\
+@iftex\n\
+@tex\n\
+$S = U^T A U$\n\
+@end tex\n\
+@end iftex\n\
+@ifinfo\n\
+@code{s = u' * a * u}\n\
+@end ifinfo\n\
+and\n\
+@iftex \n\
+@tex\n\
+$I = U U^T$\n\
+@end tex\n\
+@end iftex\n\
+@ifinfo\n\
+@code{I = u' * u}\n\
+@end ifinfo\n\
+@end deftypefn\n\
+@seealso{schur}")
+{
+  octave_value_list retval;
+
+  int nargin = args.length();
+  if (nargin != 2 || nargout != 2)
+    print_usage("rsf2csf");
+  else
+    {
+      const Matrix U = args(0).matrix_value();
+      const Matrix T = args(1).matrix_value();
+      if (!error_state)
+	{
+	  if (U.rows() != U.columns() || T.rows() != T.columns() || 
+	      T.rows() != U.rows())
+	    error ("rsf2csf: improper U,T");
+	  else
+	    {
+	      const int n = U.rows();
+	      bool isreal=true;
+	      for (int i = 0; i < n-1; i++)
+		if (T(i,i+1) != 0.0) isreal = false;
+	      if (isreal)
+		{
+		  retval(0) = U;
+		  retval(1) = T;
+		}
+	      else
+		{
+		  ComplexMatrix retU, retT;
+		  rsf2csf(U,T,retU,retT);
+		  retval(0) = retU;
+		  retval(1) = retT;
+		}
+	    }
+	}
+    }
+    return retval;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/linear-algebra/rsf2csf.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,63 @@
+## Copyright (C) 2001 Ian Searle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## [U, T] = rsf2csf(U,T)
+##
+## Converts a real, upper quasi-triangular Schur form to a complex, 
+## upper triangular Schur form.
+##
+## Note that in a Schur decomposition, the following relations hold:
+##
+##     U*T*U' == A and U'*U == I.
+##
+## Note also that U and T are not unique.
+##
+## Alternatively, you can use the following to get the complex schur
+## form for real A directly:
+##
+##    [U, T] = schur(1i*A);
+##    T = -1i*T;
+##
+
+## 2001-03-07 Ross Lippert
+##   * adapted from rlab, using a slightly different similarity transform
+## 2001-03-08 Paul Kienzle
+##   * cleanup; add Rolf Fabians comment about direct csf computation
+
+function [U, T] = rsf2csf (U, T)
+
+  if (nargin != 2)
+    usage ("[U,T] = rsf2csf (U, T)");
+  endif
+
+  ## Find complex unitary similarities to zero the subdiagonal elements.
+  n = columns (T);
+  if (n > 1)
+    idx = find (diag (T, -1))';
+    for m = idx
+      k = m:m+1;
+      d = eig (T (k, k));
+      cs = [ T(m+1,m+1)-d(1), -T(m+1,m) ];
+      cs = cs / norm (cs);
+      G = [ conj(cs); cs(2), -cs(1) ];
+      T (k, m:n) = G' * T (k, m:n);
+      T (1:m+1, k) = T (1:m+1, k) * G;
+      U (:, k) = U (:, k) * G;
+      T (m+1, m) = 0;
+    endfor
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/linear-algebra/thfm.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,137 @@
+%USAGE  y = thfm ( x, MODE )
+%
+%       trigonometric/hyperbolic functions of square matrix x
+%
+%MODE	cos   sin   tan   sec   csc   cot
+%	cosh  sinh  tanh  sech  csch  coth
+%       acos  asin  atan  asec  acsc  acot
+%       acosh asinh atanh asech acsch acoth
+%       sqrt  log   exp
+%
+%NOTE		--- IMPORTANT ---
+%	This algorithm does  NOT USE an eigensystem
+%	similarity transformation. It maps the MODE
+%	functions to functions of expm, logm and sqrtm, 
+%       which are known to be robust with respect to
+%	non-diagonalizable ('defective') x
+%
+%EXA	thfm( x ,'cos' )  calculates  matrix cosinus
+%	EVEN IF input matrix x IS NOT DIAGONALIZABLE
+%
+%ASSOC	expm, sqrtm, logm, funm
+%AUTHOR	(C) 2001 Rolf Fabian <fabian@tu-cottbus.de> 010213
+%	published under current GNU GENERAL PUBLIC LICENSE
+
+% 2001-03-15 Paul Kienzle
+%     * extend with inverse functions and power functions
+%     * optimize handling of real input
+
+function y=thfm(x,M)
+				#% minimal arg check only
+  if	nargin~=2||~isstr(M)||isstr(x)	
+    usage ("y = thfm (x, MODE)");
+  endif
+
+  ## look for known functions of sqrt, log, exp
+  I = eye(size(x));
+  match = 1;
+  len =  length(M);
+  if	len==3
+    
+    if	M=='cos',  
+      if (isreal(x))     y = real( expm( i*x ) );
+      else               y = ( expm( i*x ) + expm( -i*x ) ) / 2;
+      endif
+      
+    elseif	M=='sin',
+      if (isreal(x))     y = imag( expm( i*x ) );
+      else               y = ( expm( i*x ) - expm( -i*x ) ) / (2*i);
+      endif
+      
+    elseif	M=='tan',
+      if (isreal(x))     t = expm( i*x );    y = imag(t)/real(t);
+      else     	         t = expm( -2*i*x ); y = -i*(I-t)/(I+t);
+      endif
+      
+    elseif	M=='cot',		% == cos/sin
+      if (isreal(x))     t = expm( i*x );    y = real(t)/imag(t);
+      else	         t = expm( -2*i*x ); y = i*(I+t)/(I-t);
+      endif
+      
+    elseif	M=='sec',  
+      if (isreal(x))     y = inv( real(expm(i*x)) );
+      else               y = inv( expm(i*x)+expm(-i*x) )*2 ;
+      endif
+      
+    elseif	M=='csc',  
+      if (isreal(x))     y = inv( imag(expm(i*x)) );
+      else               y = inv( expm(i*x)-expm(-i*x) )*2i;
+      endif
+
+    elseif    M=='log',  y = logm(x);
+      
+    elseif    M=='exp',  y = expm(x);
+      
+    else match = 0;
+
+    endif
+    
+  elseif	len==4
+    
+    if      M=='cosh',   y = ( expm(x)+expm(-x) )/2;
+      
+    elseif  M=='sinh',   y = ( expm(x)-expm(-x) )/2;
+      
+    elseif  M=='tanh'    t = expm( -2*x ); y = (I - t)/(I + t);
+     
+    elseif  M=='coth', 	 t = expm( -2*x ); y = (I + t)/(I - t);
+      
+    elseif  M=='sech',   y = 2 * inv( expm(x) + expm(-x) );
+      
+    elseif  M=='csch',   y = 2 * inv( expm(x) - expm(-x) );
+      
+    elseif  M=='asin',   y = -i * logm( i*x + sqrtm(I - x*x) );
+      
+    elseif  M=='acos',   y =  i * logm( x - i*sqrtm(I - x*x) );
+
+    elseif  M=='atan',   y = -i/2 * logm( (I + i*x)/(I - i*x) );
+
+    elseif  M=='acot',   y =  i/2 * logm( (I + i*x)/(i*x - I) );
+
+    elseif  M=='asec',   y = i * logm( ( I - sqrtm(I - x*x) ) / x );
+
+    elseif  M=='acsc',   y = -i * logm( i*( I + sqrtm(I - x*x) ) / x );
+
+    elseif  M=='sqrt',   y = sqrtm(x);
+
+    else match = 0;
+
+    end
+
+  elseif   len==5
+
+    if      M=='asinh',  y = logm( x + sqrtm (x*x + I) );
+      
+    elseif  M=='acosh',  y = logm( x + sqrtm (x*x - I) );
+      
+    elseif  M=='atanh',  y = logm( (I + x)/(I - x) ) / 2;
+      
+    elseif  M=='acoth',  y = logm( (I + x)/(x - I) ) / 2;
+
+    elseif  M=='asech',  y = logm( (I + sqrtm (I - x*x)) / x );
+
+    elseif  M=='acsch',  y = logm( (I + sqrtm (I + x*x)) / x );
+
+    else match = 0;
+
+    endif
+
+  else match = 0;
+
+  endif
+
+  ## if no known function found, use generic solver
+  if (match == 0)
+    y = funm( x, M );
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,8 @@
+include ../../Makeconf
+
+PROGS=lp.oct
+
+all:$(PROGS)
+
+clean:
+	-$(RM) *.o $(PROGS) core octave-core *~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/__quasi_func__.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,24 @@
+## Copyright (C) 2000 Ben Sapp.  All rights reserved.
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2, or (at your option) any
+## later version.
+##
+## This is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+## FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+## for more details.
+##
+## Author: Ben Sapp <bsapp@lanl.gov>
+## Reference: David G Luenberger's Linear and Nonlinear Programming
+
+## used internally by dfp which is an implementation 
+## of the Davidon-Fletcher-Powell quasi-newton method
+
+function v = __quasi_func__(alpha)
+  global __quasi_d__;
+  global __quasi_x0__;
+  global __quasi_f__;
+  v = feval(__quasi_f__,__quasi_x0__+alpha*__quasi_d__);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/bfgs.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,39 @@
+## Copyright (C) 2000 Ben Sapp.  All rights reserved.
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2, or (at your option) any
+## later version.
+##
+## This is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+## FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+## for more details.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{xmin} =} bfgs(@var{f},@var{x0})
+## Use the BFGS method to find the minimum of a
+## multivariable function @var{f}
+## @end deftypefn 
+
+function x = bfgs(func,x)
+  global __quasi_d__;
+  global __quasi_x0__;
+  global __quasi_f__;
+  __quasi_f__  = func;
+  
+  H = eye(max(size(x)));
+  g = bs_gradient(func,x);
+  while(norm(g) > 0.000001)
+    d = -H*g;
+    __quasi_d__ = d;
+    __quasi_x0__ = x;
+    min = nrm('__quasi_func__',0);
+    p = min*d;
+    x = x+p;
+    g_new = bs_gradient(func,x);
+    q = g_new-g;
+    g = g_new;
+    H = H+(1+(q'*H*q)/(q'*p))*((p*p')/(q'*p))-((p*q'*H+H*q*p')/(q'*p));
+  endwhile
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/bs_gradient.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,69 @@
+## Copyright (C) 2000 Ben Sapp.  All rights reserved.
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2, or (at your option) any
+## later version.
+##
+## This is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+## FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+## for more details.
+
+## bs_gradient(f, x0, [h, O]) 
+##
+
+function dx = bs_gradient(f, x0, ...)
+
+  if(nargin < 2)
+    error("not enough arguements\n");
+  endif
+  if(!isstr(f))
+    error("The first arguement must be a string\n");
+  endif
+  if(!is_vector(x0))
+    error("The second arguement must be a vector.\n");
+  endif
+  if(nargin >= 3)
+    va_start();
+    h = va_arg();
+    if(!is_scalar(h))
+      if(is_vector(h))
+	if(size(x0) != size(h))
+	  error("If h is not a scalar it must be the same size as x0.\n");
+	endif
+      endif
+    else
+      h = size(x0)*h;
+    endif
+    if(nargin >= 4)
+      O = va_arg()
+      if((O != 2) && (O != 4))
+	error("Only order 2 or 4 is supported.\n");
+      endif
+      if(nargin >= 5)
+	warning("ignoring arguements beyond the 4th.\n");
+      endif
+    endif
+  else
+    h = size(x0)*0.0000001;
+    O = 2;
+  endif
+
+  
+  dx = zeros(size(x0));
+  if(O == 2)
+    for i = 1:max(size(x0))
+      del = zeros(size(x0));
+      del(i) = h(i);
+      dx(i) = (feval(f,x0+del)-feval(f,x0-del))./(2*h(i));
+    endfor
+  elseif(O ==4)
+    for i = 1:max(size(x0))
+      del = zeros(size(x0));
+      del(i) = h(i);
+      dx(i) = (-feval(f,x0+2*del)+8*feval(f,x0+del)-8*feval(f,x0-del)+feval(f,x0-2*del))./(12*h(i));
+    endfor	  
+  endif
+endfunction
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/deriv.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,85 @@
+## Copyright (C) 2000 Ben Sapp.  All rights reserved.
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2, or (at your option) any
+## later version.
+##
+## This is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+## FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+## for more details.
+
+## deriv(f,x0[,h,O,N])
+
+## Reference -> Numerical Methods for Mathematics, Science, and
+## Engineering by John H. Mathews.
+
+function dx = deriv(f,x0, ...)
+
+  if(nargin < 2)
+    error("not enough arguements\n");
+  endif
+  if(!isstr(f))
+    error("The first arguement must be a string\n");
+  endif
+  if(!is_scalar(x0))
+    error("The second arguement must be a scalar.\n");
+  endif
+  if(nargin >= 3)
+    va_start();
+    h = va_arg();
+    if(!is_scalar(h))
+      error("h must be a scalar.");
+    endif
+    if(nargin >= 4)
+      O = va_arg();
+      if((O != 2) && (O != 4))
+	error("Only order 2 or 4 is supported.\n");
+      endif
+      if(nargin >= 5)
+	N = va_arg();
+	if((N > 4)||(N < 1))
+	  error("Only 1st,2nd,3rd or 4th order derivatives are acceptable.\n");
+	endif
+	if(nargin >= 6)
+	  warning("Ignoring arguements beyond the 5th.\n");
+	endif
+      endif
+    endif
+  else
+    h = 0.0000001;
+    O = 2;
+  endif
+
+  switch O
+    case (2)
+      switch N
+	case (1)
+	  dx = (feval(f,x0+h)-feval(f,x0-h))/(2*h);
+	case (2)
+	  dx = (feval(f,x0+h)-2*feval(f,x0)+feval(f,x0-h))/(h^2);
+	case (3)
+	  dx = (feval(f,x0+2*h)-2*feval(f,x0+h)+2*feval(f,x0-h)-feval(f,x0-2*h))/(2*h^3);
+	case (4)
+	  dx = (feval(f,x0+2*h)-4*feval(f,x0+h)+6*feval(f,x0)-4*feval(f,x0-h)+feval(f,x0-2*h))/(h^4);
+	otherwise
+	  error("I can only take the 1st,2nd,3rd or 4th derivative\n");
+      endswitch
+    case (4)
+      switch N
+	case (1)
+	  dx = (-feval(f,x0+2*h)+8*feval(f,x0+h)-8*feval(f,x0-h)+feval(f,x0-2*h))/(12*h);
+	case (2)
+	  dx = (-feval(f,x0+2*h)+16*feval(f,x0+h)-30*feval(f,x0)+16*feval(f,x0-h)-feval(f,x0-2*h))/(12*h^2);
+	case (3)
+	  dx = (-feval(f,x0+3*h)+8*feval(f,x0+2*h)-13*feval(f,x0+h)+13*feval(f,x0-h)-8*feval(f,x0-2*h)+feval(f,x0-3*h))/(8*h^3);
+	case (4)
+	  dx = (-feval(f,x0+3*h)+12*feval(f,x0+2*h)-39*feval(f,x0+h)+56*feval(f,x0)-39*feval(f,x0-h)+12*feval(f,x0-2*h)-feval(f,x0-3*h))/(6*h^4);
+	otherwise
+	  error("I can only take the 1st,2nd,3rd or 4th derivative\n");
+      endswitch  
+    otherwise
+      error("Only order 4 or 2 supported\n");
+  endswitch
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/dfdp.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,51 @@
+% Copyright (C) 1992-1994 Richard Shrager, Arthur Jutan and Ray Muzic
+%
+% This program is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% This program is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with this program; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+function prt=dfdp(x,f,p,dp,func)
+% numerical partial derivatives (Jacobian) df/dp for use with leasqr
+% --------INPUT VARIABLES---------
+% x=vec or matrix of indep var(used as arg to func) x=[x0 x1 ....]
+% f=func(x,p) vector initialsed by user before each call to dfdp
+% p= vec of current parameter values
+% dp= fractional increment of p for numerical derivatives
+%      dp(j)>0 central differences calculated
+%      dp(j)<0 one sided differences calculated
+%      dp(j)=0 sets corresponding partials to zero; i.e. holds p(j) fixed
+% func=string naming the function (.m) file
+%      e.g. to calc Jacobian for function expsum prt=dfdp(x,f,p,dp,'expsum')
+%----------OUTPUT VARIABLES-------
+% prt= Jacobian Matrix prt(i,j)=df(i)/dp(j)
+%================================
+
+m=size(x,1); if (m==1), m=size(x,2); end  %# PAK: in case #cols > #rows
+n=length(p);      %dimensions
+ps=p; prt=zeros(m,n);del=zeros(n,1);       % initialise Jacobian to Zero
+for j=1:n
+      del(j)=dp(j) .*p(j);    %cal delx=fract(dp)*param value(p)
+      if p(j)==0
+           del(j)=dp(j);     %if param=0 delx=fraction
+      end
+      p(j)=ps(j) + del(j);
+      if del(j)~=0, f1=feval(func,x,p);
+           if dp(j) < 0, prt(:,j)=(f1-f)./del(j);
+           else
+                p(j)=ps(j)- del(j);
+                prt(:,j)=(f1-feval(func,x,p))./(2 .*del(j));
+           end
+      end
+      p(j)=ps(j);     %restore p(j)
+end
+return
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/dfp.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,39 @@
+## Copyright (C) 2000 Ben Sapp.  All rights reserved.
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2, or (at your option) any
+## later version.
+##
+## This is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+## FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+## for more details.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{xmin} =} dfp(@var{f},@var{x0})
+## Use the Davidon-Flecther-Powell method to find the minimum of a
+## multivariable function @var{f}
+## @end deftypefn 
+
+function x = dfp(func,x)
+  global __quasi_d__;
+  global __quasi_x0__;
+  global __quasi_f__;
+  __quasi_f__  = func;
+
+  H = eye(max(size(x)));
+  g = bs_gradient(func,x);
+  while(norm(g) > 0.000001)
+    d = -H*g;
+    __quasi_d__ = d;
+    __quasi_x0__ = x;
+    min = nrm('__quasi_func__',0);
+    p = min*d;
+    x = x+p;
+    g_new = bs_gradient(func,x);
+    q = g_new-g;
+    g = g_new;
+    H = H+(p*p')/(p'*q)-(H*q*q'*H)/(q'*H*q);
+  endwhile
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/fmin.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,21 @@
+## Copyright (C) 2001 Paul Kienzle
+## 
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+## 
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+## 
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+function ret=fmin(...)
+
+	ret = fminbnd(all_va_args);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/fminbnd.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,59 @@
+## Copyright (C) 2000 Ben Sapp.  All rights reserved.
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2, or (at your option) any
+## later version.
+##
+## This is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+## FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+## for more details.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {[@var{x}] =} fminbnd(@var{f},@var{lb},@var{ub},[@var{tol}])
+## 
+## Find the minimum of a scalar function with the Golden Search method.
+## 
+## @strong{Inputs}
+## @table @var 
+## @item f 
+## A string contining the name of the function to minimiz
+## @item lb
+## Value to use as an initial lower bound on @var{x}.
+## @item ub 
+## Value to use as an initial upper bound on @var{x}.
+## @item tol
+## Tolerence you would like to have.  The default value is @var{tol} =
+## 10e-6 
+## @end table
+## @end deftypefn
+
+function min = fminbnd(_func,lb,ub)
+  delta = 1e-17;
+  gr = (sqrt(5)-1)/2;
+  width = (ub-lb);
+  out = lb:(width/3):ub;
+  out(2) = out(4)-gr*width;
+  out(3) = out(1)+gr*width;
+  upper = feval(_func,out(3));
+  lower = feval(_func,out(2));
+  while((out(3)-out(2)) > delta) #this will not work for symetric funcs
+    if(upper > lower)
+      out(4) = out(3);
+      out(3) = out(2);
+      width = out(4)-out(1);
+      out(2) = out(4)-gr*width;
+      upper = lower;
+      lower = feval(_func,out(2));
+    else
+      out(1) = out(2);
+      out(2) = out(3);
+      width = out(4)-out(1);
+      out(3) = out(1)+width*gr;
+      lower = upper;
+      upper = feval(_func,out(3));
+    endif
+  endwhile
+  min = out(2);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/fzero.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,32 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: x = fzero("f", x0)
+##
+## Find x such that f(x) = 0, starting at x0.
+## If x0 is a range, start at the mid-point of the range.
+## Returns NaN if the solution is not found.
+##
+## Note: This is a simple wrapper around the fsolve built-in function.
+
+function [x, fval, status] = fzero(f,x0)
+
+  [x, info] = fsolve (f, mean (x0));
+  if info != 1
+    x = NaN;
+  endif
+
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/leasqr.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,348 @@
+% Copyright (C) 1992-1994 Richard Shrager, Arthur Jutan and Ray Muzic
+%
+% This program is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% This program is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with this program; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+function [f,p,kvg,iter,corp,covp,covr,stdresid,Z,r2]= ...
+      leasqr(x,y,pin,F,stol,niter,wt,dp,dFdp,options)
+%function[f,p,kvg,iter,corp,covp,covr,stdresid,Z,r2]=
+%                   leasqr(x,y,pin,F,{stol,niter,wt,dp,dFdp,options})
+%
+% Version 3.beta
+%  {}= optional parameters
+% Levenberg-Marquardt nonlinear regression of f(x,p) to y(x), where:
+% x=vec or mat of indep variables, 1 row/observation: x=[x0 x1....xm]
+% y=vec of obs values, same no. of rows as x.
+% wt=vec(dim=length(x)) of statistical weights.  These should be set
+%   to be proportional to (sqrt of var(y))^-1; (That is, the covariance
+%   matrix of the data is assumed to be proportional to diagonal with diagonal
+%   equal to (wt.^2)^-1.  The constant of proportionality will be estimated.),
+%   default=ones(length(y),1).
+% pin=vector of initial parameters to be adjusted by leasqr.
+% dp=fractional incr of p for numerical partials,default= .001*ones(size(pin))
+%   dp(j)>0 means central differences.
+%   dp(j)<0 means one-sided differences.
+% Note: dp(j)=0 holds p(j) fixed i.e. leasqr wont change initial guess: pin(j)
+% F=name of function in quotes,of the form y=f(x,p)
+% dFdp=name of partials M-file in quotes default is prt=dfdp(x,f,p,dp,F)
+% stol=scalar tolerances on fractional improvement in ss,default stol=.0001
+% niter=scalar max no. of iterations, default = 20
+% options=matrix of n rows (same number of rows as pin) containing 
+%   column 1: desired fractional precision in parameter estimates.
+%     Iterations are terminated if change in parameter vector (chg) on two
+%     consecutive iterations is less than their corresponding elements
+%     in options(:,1).  [ie. all(abs(chg*current parm est) < options(:,1))
+%      on two consecutive iterations.], default = zeros().
+%   column 2: maximum fractional step change in parameter vector.
+%     Fractional change in elements of parameter vector is constrained to be 
+%     at most options(:,2) between sucessive iterations.
+%     [ie. abs(chg(i))=abs(min([chg(i) options(i,2)*current param estimate])).],
+%     default = Inf*ones().
+%
+%          OUTPUT VARIABLES
+% f=vec function values computed in function func.
+% p=vec trial or final parameters. i.e, the solution.
+% kvg=scalar: =1 if convergence, =0 otherwise.
+% iter=scalar no. of interations used.
+% corp= correlation matrix for parameters
+% covp= covariance matrix of the parameters
+% covr = diag(covariance matrix of the residuals)
+% stdresid= standardized residuals
+% Z= matrix that defines confidence region
+% r2= coefficient of multiple determination
+%
+% All Zero guesses not acceptable
+
+% A modified version of Levenberg-Marquardt
+% Non-Linear Regression program previously submitted by R.Schrager.
+% This version corrects an error in that version and also provides
+% an easier to use version with automatic numerical calculation of
+% the Jacobian Matrix. In addition, this version calculates statistics
+% such as correlation, etc....
+%
+% Version 3 Notes
+% Errors in the original version submitted by Shrager (now called version 1)
+% and the improved version of Jutan (now called version 2) have been corrected.
+% Additional features, statistical tests, and documentation have also been
+% included along with an example of usage.  BEWARE: Some the the input and
+% output arguments were changed from the previous version.
+%
+%     Ray Muzic     <rfm2@ds2.uh.cwru.edu>
+%     Arthur Jutan  <jutan@charon.engga.uwo.ca>
+
+% Richard I. Shrager (301)-496-1122
+% Modified by A.Jutan (519)-679-2111
+% Modified by Ray Muzic 14-Jul-1992
+%       1) add maxstep feature for limiting changes in parameter estimates
+%          at each step.
+%       2) remove forced columnization of x (x=x(:)) at beginning. x could be
+%          a matrix with the ith row of containing values of the 
+%          independent variables at the ith observation.
+%       3) add verbose option
+%       4) add optional return arguments covp, stdresid, chi2
+%       5) revise estimates of corp, stdev
+% Modified by Ray Muzic 11-Oct-1992
+%	1) revise estimate of Vy.  remove chi2, add Z as return values
+% Modified by Ray Muzic 7-Jan-1994
+%       1) Replace ones(x) with a construct that is compatible with versions
+%          newer and older than v 4.1.
+%       2) Added global declaration of verbose (needed for newer than v4.x)
+%       3) Replace return value var, the variance of the residuals with covr,
+%          the covariance matrix of the residuals.
+%       4) Introduce options as 10th input argument.  Include
+%          convergence criteria and maxstep in it.
+%       5) Correct calculation of xtx which affects coveraince estimate.
+%       6) Eliminate stdev (estimate of standard deviation of parameter
+%          estimates) from the return values.  The covp is a much more
+%          meaningful expression of precision because it specifies a confidence
+%          region in contrast to a confidence interval..  If needed, however,
+%          stdev may be calculated as stdev=sqrt(diag(covp)).
+%       7) Change the order of the return values to a more logical order.
+%       8) Change to more efficent algorithm of Bard for selecting epsL.
+%       9) Tighten up memory usage by making use of sparse matrices (if 
+%          MATLAB version >= 4.0) in computation of covp, corp, stdresid.
+% Modified by Francesco Potorti
+%       for use in Octave
+%
+% References:
+% Bard, Nonlinear Parameter Estimation, Academic Press, 1974.
+% Draper and Smith, Applied Regression Analysis, John Wiley and Sons, 1981.
+%
+%set default args
+
+% argument processing
+%
+
+%if (sscanf(version,'%f') >= 4),
+vernum= sscanf(version,'%f');
+if vernum(1) >= 4,
+  global verbose
+  plotcmd='plot(x(:,1),y,''+'',x(:,1),f); figure(gcf)';
+else
+  plotcmd='plot(x(:,1),y,''+'',x(:,1),f); shg';
+end;
+if (exist('OCTAVE_VERSION'))
+  global verbose
+  plotcmd='plot(x(:,1),y,"+;data;",x(:,1),f,";fit;");';
+end;
+
+if(exist('verbose')~=1), %If verbose undefined, print nothing
+	verbose=0;       %This will not tell them the results
+end;
+
+if (nargin <= 8), dFdp='dfdp'; end;
+if (nargin <= 7), dp=.001*(pin*0+1); end; %DT
+if (nargin <= 6), wt=ones(length(y),1); end;	% SMB modification
+if (nargin <= 5), niter=20; end;
+if (nargin == 4), stol=.0001; end;
+%
+
+y=y(:); wt=wt(:); pin=pin(:); dp=dp(:); %change all vectors to columns
+% check data vectors- same length?
+m=length(y); n=length(pin); p=pin;[m1,m2]=size(x);
+if m1~=m ,error('input(x)/output(y) data must have same number of rows ') ,end;
+
+if (nargin <= 9), 
+  options=[zeros(n,1), Inf*ones(n,1)];
+  nor = n; noc = 2;
+else
+  [nor, noc]=size(options);
+  if (nor ~= n),
+    error('options and parameter matrices must have same number of rows'),
+  end;
+  if (noc ~= 2),
+    options=[options(noc,1), Inf*ones(noc,1)];
+  end;
+end;
+pprec=options(:,1);
+maxstep=options(:,2);
+%
+
+% set up for iterations
+%
+f=feval(F,x,p); fbest=f; pbest=p;
+r=wt.*(y-f);
+sbest=r'*r;
+nrm=zeros(n,1);
+chgprev=Inf*ones(n,1);
+kvg=0;
+epsLlast=1;
+epstab=[.1, 1, 1e2, 1e4, 1e6];
+
+% do iterations
+%
+for iter=1:niter,
+  pprev=pbest;
+  prt=feval(dFdp,x,fbest,pprev,dp,F);
+  r=wt.*(y-fbest);
+  sprev=sbest;
+  sgoal=(1-stol)*sprev;
+  for j=1:n,
+    if dp(j)==0,
+      nrm(j)=0;
+    else
+      prt(:,j)=wt.*prt(:,j);
+      nrm(j)=prt(:,j)'*prt(:,j);
+      if nrm(j)>0,
+        nrm(j)=1/sqrt(nrm(j));
+      end;
+    end
+    prt(:,j)=nrm(j)*prt(:,j);
+  end;
+% above loop could ? be replaced by:
+% prt=prt.*wt(:,ones(1,n)); 
+% nrm=dp./sqrt(diag(prt'*prt)); 
+% prt=prt.*nrm(:,ones(1,m))';
+  [prt,s,v]=svd(prt,0);
+  s=diag(s);
+  g=prt'*r;
+  for jjj=1:length(epstab),
+    epsL = max(epsLlast*epstab(jjj),1e-7);
+    se=sqrt((s.*s)+epsL);
+    gse=g./se;
+    chg=((v*gse).*nrm);
+%   check the change constraints and apply as necessary
+    ochg=chg;
+    for iii=1:n,
+      if (maxstep(iii)==Inf), break; end;
+      chg(iii)=max(chg(iii),-abs(maxstep(iii)*pprev(iii)));
+      chg(iii)=min(chg(iii),abs(maxstep(iii)*pprev(iii)));
+    end;
+    if (verbose & any(ochg ~= chg)),
+      disp(['Change in parameter(s): ', ...
+         sprintf('%d ',find(ochg ~= chg)), 'were constrained']);
+    end;
+    aprec=abs(pprec.*pbest);       %---
+% ss=scalar sum of squares=sum((wt.*(y-f))^2).
+    if (any(abs(chg) > 0.1*aprec)),%---  % only worth evaluating function if
+      p=chg+pprev;                       % there is some non-miniscule change
+      f=feval(F,x,p);
+      r=wt.*(y-f);
+      ss=r'*r;
+      if ss<sbest,
+        pbest=p;
+        fbest=f;
+        sbest=ss;
+      end;
+      if ss<=sgoal,
+        break;
+      end;
+    end;                          %---
+  end;
+  epsLlast = epsL;
+  if (verbose),
+    eval(plotcmd);
+  end;
+  if ss<eps,
+    break;
+  end
+  aprec=abs(pprec.*pbest);
+%  [aprec, chg, chgprev]
+  if (all(abs(chg) < aprec) & all(abs(chgprev) < aprec)),
+    kvg=1;
+    if (verbose),
+      fprintf('Parameter changes converged to specified precision\n');
+    end;
+    break;
+  else
+    chgprev=chg;
+  end;
+  if ss>sgoal,
+    break;
+  end;
+end;
+
+% set return values
+%
+p=pbest;
+f=fbest;
+ss=sbest;
+kvg=((sbest>sgoal)|(sbest<=eps)|kvg);
+if kvg ~= 1 , disp(' CONVERGENCE NOT ACHIEVED! '), end;
+
+% CALC VARIANCE COV MATRIX AND CORRELATION MATRIX OF PARAMETERS
+% re-evaluate the Jacobian at optimal values
+jac=feval(dFdp,x,f,p,dp,F);
+msk = dp ~= 0;
+n = sum(msk);           % reduce n to equal number of estimated parameters
+jac = jac(:, msk);	% use only fitted parameters
+
+%% following section is Ray Muzic's estimate for covariance and correlation
+%% assuming covariance of data is a diagonal matrix proportional to
+%% diag(1/wt.^2).  
+%% cov matrix of data est. from Bard Eq. 7-5-13, and Row 1 Table 5.1 
+
+if vernum(1) >= 4,
+  Q=sparse(1:m,1:m,(0*wt+1)./(wt.^2));  % save memory
+  Qinv=inv(Q);
+else
+  Q=diag((0*wt+1)./(wt.^2));
+  Qinv=diag(wt.*wt);
+end;
+resid=y-f;                                    %un-weighted residuals
+covr=resid'*Qinv*resid*Q/(m-n);                 %covariance of residuals
+Vy=1/(1-n/m)*covr;  % Eq. 7-13-22, Bard         %covariance of the data 
+
+jtgjinv=inv(jac'*Qinv*jac);			%argument of inv may be singular
+covp=jtgjinv*jac'*Qinv*Vy*Qinv*jac*jtgjinv; % Eq. 7-5-13, Bard %cov of parm est
+d=sqrt(abs(diag(covp)));
+corp=covp./(d*d');
+
+covr=diag(covr);                 % convert returned values to compact storage
+stdresid=resid./sqrt(diag(Vy));  % compute then convert for compact storage
+Z=((m-n)*jac'*Qinv*jac)/(n*resid'*Qinv*resid);
+
+%%% alt. est. of cov. mat. of parm.:(Delforge, Circulation, 82:1494-1504, 1990
+%%disp('Alternate estimate of cov. of param. est.')
+%%acovp=resid'*Qinv*resid/(m-n)*jtgjinv
+
+%Calculate R^2 (Ref Draper & Smith p.46)
+%
+r=corrcoef(y,f);
+if (exist('OCTAVE_VERSION'))
+  r2=r^2;
+else
+  r2=r(1,2).^2;
+end
+
+% if someone has asked for it, let them have it
+%
+if (verbose), 
+  eval(plotcmd);
+  disp(' Least Squares Estimates of Parameters')
+  disp(p')
+  disp(' Correlation matrix of parameters estimated')
+  disp(corp)
+  disp(' Covariance matrix of Residuals' )
+  disp(covr)
+  disp(' Correlation Coefficient R^2')
+  disp(r2)
+  sprintf(' 95%% conf region: F(0.05)(%.0f,%.0f)>= delta_pvec''*Z*delta_pvec',n,m-n)
+  Z
+%   runs test according to Bard. p 201.
+  n1 = sum((f-y) < 0);
+  n2 = sum((f-y) > 0);
+  nrun=sum(abs(diff((f-y)<0)))+1;
+  if ((n1>10)&(n2>10)), % sufficent data for test?
+    zed=(nrun-(2*n1*n2/(n1+n2)+1)+0.5)/(2*n1*n2*(2*n1*n2-n1-n2)...
+      /((n1+n2)^2*(n1+n2-1)));
+    if (zed < 0),
+      prob = erfc(-zed/sqrt(2))/2*100;
+      disp([num2str(prob),'% chance of fewer than ',num2str(nrun),' runs.']);
+    else,
+      prob = erfc(zed/sqrt(2))/2*100;
+      disp([num2str(prob),'% chance of greater than ',num2str(nrun),' runs.']);
+    end;
+  end;
+end;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/leasqrdemo.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,73 @@
+## Copyright (C) 1992-1994 Richard Shrager, Arthur Jutan and Ray Muzic
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## leasqrdemo
+##
+## An example showing how to use non-linear least squares to fit 
+## simulated data to the function:
+##
+##      y = a e^{-bx}
+
+## 2001-02-05 Paul Kienzle
+##   * collected example into a single script
+
+1; # Force this to be a script
+
+function y = leasqrfunc(x,p)
+  ##sprintf('called leasqrfunc(x,[%e %e]\n', p(1),p(2))
+  ## y = p(1)+p(2)*x;
+  y=p(1)*exp(-p(2)*x);
+endfunction
+
+function y = leasqrdfdp(x,f,p,dp,func)
+  ## y = [0*x+1, x];
+  y= [exp(-p(2)*x), -p(1)*x.*exp(-p(2)*x)];
+endfunction
+
+## generate test data
+t = [1:100]';
+p = [1; 0.1];
+data = leasqrfunc (t, p);
+
+## add noise
+## wt1 = 1 /sqrt of variances of data
+## 1 / wt1 = sqrt of var = standard deviation
+wt1 = (1 + 0 * t) ./ sqrt (data); 
+data = data + 0.05 * randn (100, 1) ./ wt1; 
+
+## Note by Thomas Walter <walter@pctc.chemie.uni-erlangen.de>:
+##
+## Using a step size of 1 to calculate the derivative is WRONG !!!!
+## See numerical mathbooks why.
+## A derivative calculated from central differences need: s 
+##     step = 0.001...1.0e-8
+## And onesided derivative needs:
+##     step = 1.0e-5...1.0e-8 and may be still wrong
+
+F = "leasqrfunc";
+dFdp = "leasqrdfdp"; # exact derivative
+% dFdp = "dfdp";     # estimated derivative
+dp = [0.001; 0.001];
+pin = [.8; .05]; 
+stol=0.001; niter=50;
+minstep = [0.01; 0.01];
+maxstep = [0.8; 0.8];
+options = [minstep, maxstep];
+
+global verbose;
+verbose=1;
+[f1, p1, kvg1, iter1, corp1, covp1, covr1, stdresid1, Z1, r21] = ...
+    leasqr (t, data, pin, F, stol, niter, wt1, dp, dFdp, options);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/lp.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,603 @@
+#include <octave/oct.h>
+#include <octave/pager.h>
+#include <lo-ieee.h>
+#include <float.h>
+
+// Copyright (C) 2000 Ben Sapp.  All rights reserved.
+//
+// This is free software; you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option) any
+// later version.
+//
+// This is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+// FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+// for more details.
+
+// 2001-09-20 Paul Kienzle <pkienzle@users.sf.net>
+// * Use x((int)rint(m(i,j))) instead of x(m(i,j))
+
+#define TRUE 1
+#define FALSE 0
+
+static inline Matrix identity_matrix(int m,int n)
+{
+  int min = (m > n) ? n : m; 
+  Matrix me(m,n,0.0);
+  for(int i=0;i<min;i++){
+    me(i,i) = 1.0;
+  }
+  return(me);
+}
+
+static inline Matrix identity_matrix(int n)
+{
+  return(identity_matrix(n,n));
+}
+
+// It would be nice if this was a function in the Matrix class
+static Matrix pivot(Matrix T, int the_row,int the_col)
+{
+  int nr = T.rows();
+  Matrix Id = identity_matrix(nr);
+  Matrix result;
+  for(int i=0;i<nr;i++){
+    Id(i,the_row) = -T(i,the_col)/T(the_row,the_col);
+  }
+  Id(the_row,the_row) = 1/T(the_row,the_col);
+  //octave_stdout << "After pivot T =\n" << Id*T << "\n";
+  result = Id*T;
+  for(int j=0;j<nr;j++){
+    T(j,the_col) = 0;
+  }
+  T(the_row,the_col) = 1;
+  return(result);
+}
+
+// Remove the 
+static Matrix multi_pivot(Matrix T,Matrix the_pivots)
+{
+  if(the_pivots.cols() != 2){
+    octave_stdout << "Error in multi_pivot\n";
+  }
+  int nr = the_pivots.rows();
+  for(int i=0;i<nr;i++){
+    T = pivot(T,int(the_pivots(i,0)),int(the_pivots(i,1)));
+  }
+  return(T);
+}
+
+#define CASE_A 0 // h_j -> The upper bound is the smallest
+#define CASE_B 1 // min{y_i0/y_ij} for all y_ij > 0 is the smallest 
+#define CASE_C 2 // min{(y_i0-h_j)/y_ij) for all y_ij < 0 is the smallest
+// This takes a tableau and reduces it to the solution tableau.  
+static Matrix minimize(Matrix T, Matrix &basis,ColumnVector upper_bounds,RowVector &which_bound)
+{
+  int nr = T.rows();
+  int nc = T.cols();
+  int i,j,k,min_case;
+  double min_val;
+  int min_row = 0;
+  int found_one;
+
+  while(TRUE){
+    found_one = FALSE;
+    for(i=0;i<(nc-1);i++){
+      if(T(nr-1,i) < -10.0*DBL_EPSILON){
+	found_one = TRUE;
+	break;
+      }
+    }
+    if(!found_one){
+      break;
+    }
+    // Now i is the column we will pivot on.  
+    min_row = -1;
+    min_case = CASE_A;
+    min_val = upper_bounds(i);
+    for(j=0;j<(nr-1);j++){
+      if(T(j,i) > 0){
+	if(min_val > (T(j,nc-1)/T(j,i))){
+	  min_row = j;
+	  min_val = T(j,nc-1)/T(j,i);
+	  min_case = CASE_B;
+	}
+      }else if(T(j,i) < 0){
+	if(min_val > ((T(j,nc-1)-upper_bounds(i))/T(j,i))){
+	  min_row = j;
+	  min_val = (T(j,nc-1)-upper_bounds(i))/T(j,i);
+	  min_case = CASE_C;
+	}
+      }
+    }
+    
+    int interesting_column=0;
+    for(j=0;j<(nr-1);j++){
+      if(basis(j,0) == min_row){
+	interesting_column = int(basis(j,1));
+	/*basis(j,0) = min_row;
+	  basis(j,1) = i; */
+	break;
+      } 
+    }
+    
+    // Now min_row is the row and i is the column to pivot on.
+    Matrix Id;
+    switch(min_case)
+      {
+      case CASE_A:
+	for(k = 0; k < nr; k++)
+	  {
+	    T(k,i) = -T(k,i);
+	    T(k,nc-1) += T(k,i);
+	  }
+	which_bound(i) = -which_bound(i);
+	break;
+      case CASE_B:
+	T = pivot(T,min_row,i);
+	for(j=0;j<nr;j++)
+	  {
+	    if(basis(j,0) == min_row)
+	      { // This row was just pivoted out
+		basis(j,0) = min_row;
+		basis(j,1) = i;
+		break;
+	      }
+	  }
+	break;
+      case CASE_C:
+	which_bound(min_row) = -which_bound(min_row);
+	T(min_row,interesting_column) = -T(min_row,interesting_column);
+	T(min_row,nc-1) -= upper_bounds(interesting_column);
+	T = pivot(T,min_row,i);// Be careful about the one below
+	for(j=0;j<nr;j++)
+	  {
+	    if(basis(j,0) == min_row)
+	      { // This row was just pivoted out
+		basis(j,0) = min_row;
+		basis(j,1) = i;
+		break;
+	      }
+	  }
+	break;
+      default:
+	break;
+      }
+  }
+  return(T);
+}
+
+// A should be a tableau without the cost on the bottom. basis stores the current basis.  
+static ColumnVector extract_solution(Matrix A,Matrix basis,ColumnVector upper_bounds,RowVector which_bound)
+{
+  ColumnVector x;
+  int i;
+  int nr = A.rows();
+  int nc = A.cols()-1;
+  if(basis.rows() != nr)
+    {
+      octave_stdout << "lp: internal error in extract_solution\n";
+      octave_stdout << "please report this problem\n";
+      octave_stdout << "A = \n" << A << "\n";
+      octave_stdout << "basis =\n" << basis << "\n";
+      octave_stdout << "nr = " << nr << ", basis.rows() = " << basis.rows() << "\n";
+    }
+  x = ColumnVector(nc,0.0);
+  for(i=0;i<nr;i++)
+    {
+      if(basis(i,1) <= nc)
+	{
+	  x((int)rint(basis(i,1))) = A(i,nc);
+	}
+    }
+  for(i=0;i<nc;i++)
+    {
+      if((which_bound(i) == -1) && (x(i) == 0))
+	  x(i) = upper_bounds(i);
+    }
+  return(x);
+}
+
+int check_dimensions(RowVector c,Matrix A,ColumnVector b,ColumnVector vlb,ColumnVector vub)
+{
+  int errors = 0;
+  int num_rows = A.rows();
+  int num_cols = A.cols();
+
+  if(Matrix(c).cols() != num_cols)
+    {
+      octave_stdout << "Columns in first arguement do not match rows in the second arguement.\n";
+      errors--;
+    }
+  if(Matrix(b).rows() != num_rows)
+    {
+      octave_stdout << "The rows in the second arguement do not match the third arguement.\n";
+      errors--;
+    }
+  if(Matrix(vlb).rows() != num_cols)
+    {
+      octave_stdout << "The columns in the second arguement do not match the fourth arguement.\n";
+      errors--;
+    }
+  if(Matrix(vub).rows() != num_cols)
+    {
+      octave_stdout << "The columns in the second arguement do not match the fifth arguement.\n";
+      errors--;
+    }
+  return(errors);
+}
+
+DEFUN_DLD(lp,args, ,
+"-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {x =} lp(@var{f},@var{a},@var{b} [,@var{lb},@var{ub},@var{h}])\n\
+Solve linear programming problems.\n\
+\n\
+min @var{f}*x\n\
+ x  \n\
+Subject to: @var{a}*x <= @var{b}\n\
+\n\
+@table @var\n\
+@item f \n\
+  @var{m} dimensional cost vector.\n\
+@item a\n\
+  @var{m}x@var{n} matrix representing the system.\n\
+@item b\n\
+  @var{n} dimensional vector.\n\
+@item lb\n\
+  Additional lower bound constraint vector on x.  Make\n\
+  this -Infinity if you want no lower bound, but you\n\
+  would like an upper bound or equality constraints.\n\
+@item ub\n\
+  Additional upper bound contraint vector on x.  If this\n\
+  is Infinity that implies no upper bound constraint.\n\
+@item h\n\
+  An integer representing how many of the constraints are\n\
+  equality constraints instead of inequality.\n\
+@end table\n\
+\n\
+\n\
+@end deftypefn" )
+{
+#ifdef HAVE_OCTAVE_20
+  error("lp: unavaible in Octave 2.0");
+  return octave_value_list();
+#else  /* !HAVE_OCTAVE_20 */
+  int i,j,k,l;
+  octave_value_list retval;
+  int nargin = args.length();
+  int ne = 0; // The number of equality constraints
+  int fatal_errors = 0;
+  int include_in_basis;
+  ColumnVector x;
+  Matrix T;
+  Matrix freeVars(1,2,0.0);
+  int freeVarNum = 0;
+  
+  // Declarations of arguement variables
+  RowVector c;
+  Matrix A;
+  ColumnVector b,vlb,vub,orig_vub;
+  // Start checking arguements 
+  if(nargin<3)
+    {
+      fatal_errors++;
+    }
+  else
+    {
+      c = RowVector(args(0).vector_value());
+      A = args(1).matrix_value();
+      b = ColumnVector(args(2).vector_value());
+    }
+  switch(nargin)
+    {
+    case 6:
+      if(args(5).is_real_scalar())
+	{
+	  ne = int(args(5).double_value());
+	}
+      else
+	{
+	  cerr << "You must supply a scalar for the number of constraints that are equalities\n";
+	  fatal_errors++;
+	}
+    case 5:
+      vub = ColumnVector(args(4).vector_value());
+      orig_vub = vub;
+    case 4:
+      vlb = ColumnVector(args(3).vector_value());
+      break;
+    case 3:
+      break;
+    default:
+      cerr << "Incorrect number of arguements.\n";
+      fatal_errors++;
+    }
+
+  int nr = A.rows();
+  int nc = A.columns();
+  
+  if(check_dimensions(c,A,b,vlb,vub) < 0){fatal_errors++;}
+  if(fatal_errors > 0){
+    print_usage("lp");
+    return(retval);
+  }
+  
+  // Now take care of upper and lower bounds
+  idx_vector aRange;
+  idx_vector bRange(Range(1,nr));
+  for(i =0;i<nc;i++)
+    {
+      if(vlb(i) > -octave_Inf)
+	{
+	  // Translate variable up;
+	  // Make the {x_min < x < x_max} constraint now equal to {0 < x_new < x_max - x_min}
+	  aRange = idx_vector(Range(i+1,i+1));
+	  b = b-ColumnVector(Matrix(A.index(bRange,aRange))*double(vlb(i)));
+	  // If the upper bound is Infinity we do not change it.  
+	  if(vub(i) < octave_Inf){
+	    vub(i) = vub(i)-vlb(i);
+	  }
+	}
+      else if(vub(i) < octave_Inf)
+	{
+	  // Now we have the following constraint ==> {-Inf < x < x_max}
+	  // After we are done it will be {0 < x_new < Inf}, where {x_new = -x+x_max}
+	  b = b-ColumnVector(Matrix(A.index(bRange,aRange))*double(vub(i)));
+	  T = identity_matrix(A.rows());
+	  T(i,i) = -1.0;
+	  A = A*T;
+	  vub(i) = octave_Inf;
+	}
+      else
+	{
+	  // both bounds are infinity so make this into two variables;
+	  // Now we have the following constraint -Inf < x < Inf 
+	  // After we are done we have {0 < x1_new < Inf} and 
+	  // {0 < x2_new < Inf} where {x = x1_new-x2_new} 
+	  aRange = idx_vector(Range(i+1,i+1));
+	  A = A.append(-Matrix(A.index(bRange,aRange)));
+	  c = RowVector(Matrix(c).append(Matrix(1,1,-c(i))));
+	  if(freeVarNum > 0)
+	    {
+	      freeVars.stack(Matrix(1,2,0.0));
+	    }
+	  freeVars(i,0) = i;
+	  freeVars(i,1) = A.cols()-1;
+	  freeVarNum++;
+	  vub = ColumnVector(Matrix(vub).stack(Matrix(1,1,octave_Inf)));
+	}
+    }
+  
+  // find a basis.  Each row of basis holds where one element of the basis is. 
+  // For example if [1,2] is on row 1 of basis then row 1 , column 2 is an 
+  // element in the basis.   
+  Matrix basis(nr,2,-1.0);
+  RowVector which_bound(nc+freeVarNum,1.0);
+  int index = 0;
+  int slacks = 0;
+  if(ne <= nr)
+    {
+      A = A.append(identity_matrix(nr,(nr-ne)));
+      for(i=0;i<(nr-ne);i++)
+	{
+	  basis(i,1) = i+nc;
+	  basis(i,0) = i;
+	  index++;
+	  slacks++;
+	}
+      which_bound = which_bound.append(RowVector(nr-ne,1.0));
+      vub = vub.stack(ColumnVector(nr-ne,octave_Inf));
+      c = c.append(RowVector(nr-ne,0));
+    }
+  else
+    {
+      octave_stdout << "It does not make sense to have more equalities than the rank of the system\n";
+      return(retval);
+    }
+  
+  if(index < nr)
+    {
+      include_in_basis = FALSE;
+      // Loop over all columns
+      for(i = 0;i < nc;i++)
+	{
+	  k=0;
+	  // Decide if this column can be included in a basis
+	  for(j = 0;j<nr;j++)
+	    {
+	      if(A(j,i) == 0){k++;}else{basis(index,0) =j;}
+	      if((j-k) > 1){break; /* If there are already too many non-zero entries ... move on! */ }
+	    }
+	  if(k == (nr-1))
+	    {
+	      basis(index,1) = i;
+	      include_in_basis = TRUE;
+	      for(l = 0;l<index;l++)
+		{// Make sure this is not already in the basis
+		  if(basis(l,0) == basis(index,0))
+		    {// Uh, oh!  it is in the basis.
+		      include_in_basis = FALSE;
+		      break;
+		    }
+		}
+	      if(include_in_basis)
+		{
+		  // I believe this was extraneous
+		  // A = pivot(A,int(basis(index,0)),int(basis(index,1)));
+		  index++;
+		  which_bound(i) = 1.0;
+		  // This column can be included in the basis
+		  if(index == nr){break;}
+		}
+	      else
+		{
+		  basis(index,0) = -1.0;
+		  basis(index,1) = -1.0;
+		}
+	    }
+	}
+    }
+
+  idx_vector tmp_rows;
+  idx_vector tmp_cols; 
+  if(index == nr)
+    {
+      // We have a full basis
+      A = A.stack(Matrix(c));
+      A = A.append(Matrix(b).stack(Matrix(1,1,0.0)));
+      A = multi_pivot(A,basis);
+      A = minimize(A,basis,vub,which_bound); 
+      // now that we have the solution remove the slack variables.
+      tmp_rows = Range(1,nr);
+      tmp_cols = Range(1,nc+freeVarNum);
+      T = Matrix(A.index(tmp_rows,tmp_cols));
+      idx_vector tmp_cols2(Range(1,nc+freeVarNum));
+      which_bound = RowVector(which_bound.index(tmp_cols2));
+      idx_vector tmp_cols3(Range(nc+slacks+freeVarNum+1,A.cols()));
+      T = T.append(Matrix(A.index(tmp_rows,tmp_cols3)));
+    }
+  else
+    {
+      // We still need to get a basis
+      // I need to introduce artificial variable and solve the new lp in order to get a basis  
+      int slop_columns = nr-index;
+      int slop_column_index = 0;
+      Matrix mp = Matrix(slop_columns,2,0.0);
+      Matrix slop(nr,slop_columns,0.0);
+      slop = slop.stack(Matrix(1,slop_columns,1.0));
+      // loop over all rows looking to see which are not in the basis
+      for(i=0;i<nr;i++)
+	{
+	  include_in_basis = TRUE;
+	  // compare this row with each row in the basis
+	  for(j=0;j<index;j++)
+	    {
+	      if(basis(j,0) == i)
+		{
+		  include_in_basis = FALSE;
+		}
+	    }
+	  if(include_in_basis)
+	    {
+	      basis(index,0) = i;
+	      basis(index,1) = nc+slop_column_index+freeVarNum;
+	      slop(i,slop_column_index) = 1.0;
+	      slop_column_index++;
+	      index++;
+	    }
+	}
+      which_bound = which_bound.append(RowVector(slop_column_index,1.0));
+      T = A.stack(Matrix(1,A.columns(),0.0));
+      T = T.append(slop);
+      T = T.append(Matrix(b).stack(Matrix(1,1,0.0)));
+      tmp_rows = Range(nr-slop_columns+1,nr);
+      tmp_cols = Range(1,2);
+      T = multi_pivot(T,Matrix(basis.index(tmp_rows,tmp_cols)));
+      T = minimize(T,basis,vub,which_bound);
+      // Go ahead and reuse the idx_vectors
+      tmp_cols = Range(1,nc+freeVarNum);
+      tmp_rows = Range(1,nr);
+      A = Matrix(T.index(tmp_rows,tmp_cols));
+      tmp_rows = Range(1.0,1.0);
+      tmp_cols = Range(1,nc+freeVarNum);
+      Matrix temp = Matrix(which_bound);
+      temp = Matrix(temp.index(tmp_rows,tmp_cols));
+      which_bound = RowVector(temp);
+      A = A.stack(Matrix(c));
+      tmp_cols = Range(T.cols(),T.cols());
+      T(nr+1,T.cols()) = 0; 
+      tmp_rows = Range(1,nr+1);
+      temp = Matrix(T.index(tmp_rows,tmp_cols));
+      A = A.append(temp);
+      A = multi_pivot(A,basis);
+      // Finally, I solve the problem.
+      T = minimize(A,basis,vub,which_bound);
+      // now remove the bottom row -- the cost
+      tmp_cols = Range(1,T.cols());
+      tmp_rows = Range(1,T.rows()-1);
+      T = Matrix(T.index(tmp_rows,tmp_cols));
+    }
+  x = extract_solution(T,basis,vub,which_bound);
+  // --------------------------------------------------------
+  idx_vector cRange;
+  bRange = Range(1,1);
+  for(j=0,i=0;i<nc;i++)
+    {
+      if(vlb(i) > -octave_Inf)
+	{
+	  // Make the {x_min < x < x_max} constraint now equal to {0 < x_new < x_max - x_min}
+	  x(i) = x(i)-vlb(i);
+	}
+      else if(orig_vub(i) < octave_Inf)
+	{
+	  // Translate negative variable up;
+	  x(i) = -x(i)+orig_vub(i);
+	}
+      else
+	{
+	  // both bounds are infinity so make this into two variables;
+	  if(x((int)rint(freeVars(j,0))) != 0)
+	    {
+	      if(x((int)rint(freeVars(j,1))) != 0)
+		{
+		  // This should be a mathematical impossibility!
+		  octave_stdout << "You have found a bug in lp.\n";
+		  octave_stdout << "Something that should be mathematically impossible occured\n";
+		  octave_stdout << "The answer given may or may not be correct\n";
+		  octave_stdout << "Please report the problem\n";
+		}
+	      T = Matrix(x);
+	      aRange = idx_vector(Range(1,freeVars(j,1)-1));
+	      if(freeVars(j,1) < T.rows())
+		{
+		  cRange = idx_vector(Range(freeVars(j,1)+1,T.rows()));
+		  T = Matrix(T.index(aRange,bRange)).stack(Matrix(T.index(cRange,bRange)));
+		}
+	      else
+		{
+		  T = Matrix(T.index(aRange,bRange));
+		}
+	      x = ColumnVector(T);	
+	    }
+	  else if(x((int)rint(freeVars(j,1))) != 0)
+	    {
+	      // This means that a free variable is nagative  
+	      x((int)rint(freeVars(j,0))) = -x((int)rint(freeVars(j,1)));
+	      T = Matrix(x);
+	      aRange = idx_vector(Range(1,freeVars(j,1)));
+	      if(freeVars(j,1) < (T.rows()-1))
+		{
+		  cRange = idx_vector(Range(freeVars(j,1)+1,T.rows()));
+		  T = Matrix(T.index(aRange,bRange)).stack(Matrix(T.index(cRange,bRange)));
+		}
+	      else
+		{
+		  T = Matrix(T.index(aRange,bRange));
+		}
+	      x = ColumnVector(T);	
+	    }
+	  else
+	    {
+	      // This means that both variables are zero.
+	      // I simply remove the extra one and proceed as normal
+	      T = Matrix(x);
+	      aRange = idx_vector(Range(1,freeVars(j,1)));
+	      if(freeVars(j,1) < T.rows())
+		{
+		  cRange = idx_vector(Range(freeVars(j,1)+1,T.rows()));
+		  T = Matrix(T.index(aRange,bRange)).stack(Matrix(T.index(cRange,bRange)));
+		}
+	      else
+		{
+		  T = Matrix(T.index(aRange,bRange));
+		}	
+	      x = ColumnVector(T);
+	    }
+	}
+    }
+  // --------------------------------------------------------
+  
+  return(x);
+#endif /* !HAVE_OCTAVE_20 */
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/lp_test.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,73 @@
+page_screen_output = 0;
+A1 = [-1 1 2 1 2 ; -1 2 3 1 1 ; -1 1 1 2 1 ];
+B1 = [7;6;4];
+F1 = [-2 4 7 1 5];
+LB1 = [-Inf;0;0;0;0];
+UB1 = [1;1;1;1;1]*Inf;
+N1 = 3;
+x1 = [-1;0;1;0;2];
+sol1 = lp(F1,A1,B1,LB1,UB1,N1);
+if(x1 != sol1) 
+  disp("Problem with test 1\n");
+else 
+  disp("Test 1 worked\n");
+  i
+endif
+
+A2 = [2 1 2 ; 3 3 1];
+B2 = [4 ; 3];
+F2 = [4 1 1];
+LB2 = [0;0;0];
+UB2 = [1;1;1]*Inf;
+N2 = 2;
+x2 = [0;2/5;9/5];
+sol2 = lp(F2,A2,B2,LB2,UB2,N2);
+if(x2 != sol2) 
+  disp("Problem with test 2\n");
+else 
+  disp("Test 2 worked\n");
+endif
+
+A3 = [2 1 1; 1 2 3; 2 2 1];
+B3 = [2; 5; 6];
+F3 = -[3 1 3]; 
+LB3 = [0;0;0];
+UB3 = [1;1;1]*Inf;
+N3  = 0;
+x3 = [1/5;0;8/5];
+sol3 = lp(F3,A3,B3,LB3,UB3,N3);
+if(x3 != sol3) 
+  disp("Problem with test 3\n");
+else 
+  disp("Test 3 worked\n");
+endif
+
+% This problem is identical to the third problem 
+% accept for the fact that the x3 = x3+10;    
+A4  = A3;
+B4  = [-8;-25;-4];
+F4  = F3;
+LB4 = [0;0;-10];
+UB4 = [1;1;1]*Inf;
+N4  = 0;
+x4 = x3+[0;0;10];
+sol4 = lp(F4,A4,B4,LB4,UB4,N4);
+if(x4 != sol4) 
+  disp("Problem with test 4\n");
+else 
+  disp("Test 4 worked\n");
+endif
+
+A5 = [1 0 1 -1 2 ; 0 1 2 2 1 ];
+B5 = [5;9];
+F5 = [2 1 3 -2 10];
+LB5 = [0;0;0;0;0];
+UB5 = [7;10;1;5;3];
+N5 = 2;
+sol5 = lp(F5,A5,B5,LB5,UB5,N5);
+x5 = [7;1;1;3;0];
+if(x5 != sol5) 
+  disp("Problem with test 5\n");
+else 
+  disp("Test 5 worked\n");
+endif
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/optim/nrm.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,36 @@
+## Copyright (C) 2000 Ben Sapp.  All rights reserved.
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by the
+## Free Software Foundation; either version 2, or (at your option) any
+## later version.
+##
+## This is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+## FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+## for more details.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{xmin} =} nrm(@var{f},@var{x0})
+## Using @var{x0} as a starting point find a minimum of the scalar
+## function @var{f}.  The Newton-Raphson method is used.  
+## @end deftypefn
+
+## Author: Ben Sapp <bsapp@lanl.gov>
+## Reference: David G Luenberger's Linear and Nonlinear Programming
+
+function x = nrm(func,x)
+  velocity = 1;
+  acceleration = 1;
+  
+  i = 0;
+  while(abs(velocity) > 0.0001)
+    velocity = deriv(func,x,0.01,2,1);
+    acceleration = deriv(func,x,0.01,2,2);
+    if(velocity > 0)
+      x = x-abs(velocity/acceleration);
+    else
+      x = x+abs(velocity/acceleration);
+    endif
+  endwhile
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/path/addpath.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,65 @@
+## Copyright (C) 2000  Etienne Grossman
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+##       addpath(dir1,...)
+##
+## Prepends dir1,... to the current LOADPATH.
+## 
+##       addpath(dir1,'-end',dir2,'-begin',dir3,'-END',dir4,'-BEGIN',dir5)
+## 
+## Prepends dir1, dir3 and dir5 and appends dir2 and dir4. 
+##
+## For m****b compat.
+## 
+## BUG : Can't add directories called '-END', '-end', '-BEGIN' or '-begin'
+##       Can't add directories that are not readable by their owner
+##
+## FEATURE : Won't add a string that is not a dir. 
+
+## Author:        Etienne Grossmann  <etienne@isr.ist.utl.pt>
+## Last modified: January 2000
+
+function addpath(...)
+
+  app = 0 ;			# Append? Default is 'no'.
+  while nargin--,
+    p = va_arg() ;
+    if strcmp(p,"-end") | strcmp(p,"-END") ,
+      app = 1 ;
+    elseif strcmp(p,"-begin") | strcmp(p,"-BEGIN") ,
+      app = 0 ;
+    else
+      pp = p ;
+      ## Not needed
+      ## while rindex(pp,"/") == size(pp,2), pp = pp(1:size(pp,2)-1) ; end
+      [s,err,m] = stat(pp) ;		# Check for existence
+      if err,
+	printf("addpath : Stat on %s returns\n %s\n",pp,m);
+      elseif index(s.modestr,"d")!=1,
+	printf("addpath : >%s< is not a dir (mode=%s)\n",pp, s.modestr);
+
+      elseif  index(s.modestr,"r")!=2, # Asume I'm owner. That's a bug
+
+	printf("addpath : >%s< is not a readable (mode=%s)\n",...
+	       pp,s.modestr);
+      elseif ! app,
+	LOADPATH = [p,':',LOADPATH] ;
+      else
+	LOADPATH = [LOADPATH,':',p] ;
+      end
+    end
+  end
+    
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/path/fullfile.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,41 @@
+## Copyright (C) 2000  Etienne Grossman
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+##  barely tested *and* undocumented
+##
+## s = fullfile(...)
+
+## Author:        Etienne Grossmann  <etienne@isr.ist.utl.pt>
+## Last modified: January 2000
+
+function s = fullfile(...)
+  filesep = "/" ;		# Change this for non-unix
+  if nargin--, 
+    s = va_arg(); 
+  else 
+    s=""; 
+    return
+  end
+  while nargin--,
+    s=[s,filesep,va_arg()];
+  end 
+  t='';
+  while !strcmp(t,s), 
+    t=s;
+    s=strrep(t,"/./","/");
+    s=strrep(s,"//","/");
+  end
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/path/rmpath.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,67 @@
+## Copyright (C) 2000  Etienne Grossman
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+##       rmpath(dir1,...)
+##
+## Removes dir1,... from the current LOADPATH.
+## 
+## For m****b compat.
+## 
+
+## Author:        Etienne Grossmann  <etienne@isr.ist.utl.pt>
+## Last modified: January 2000
+
+function rmpath(...)
+
+  while nargin--,
+    p = va_arg() ;
+    lp = length(p) 
+    printf("removing %s\n",p);
+				# Nothing like perl for strings!
+    np = LOADPATH ;
+    lo = 0 ;
+    while lo != length(np),	# Loop while I can substitute
+      lo = length(np) ;
+      np = strrep(np,[":",p,":"],":") ;
+    end
+    if length(np)>=lp,
+
+				# Check at beginning
+      f = index(np,p) ;
+      if f == 1 ,
+	printf("rmpath : removing from beginning\n") ;
+	if length(np) == lp , 
+	      np = "" ;
+	elseif length(np) > lp && strcmp( np(lp+1),":" ) ,	
+	  np = np(lp+2:length(np)) ;
+	end
+      end
+				# Check at end
+      f = rindex(np,p) ;
+      if f == length(np)-lp+1 && length(np)-lp>0 && \
+	    strcmp(np(length(np)-lp),":") ,
+	printf("rmpath : removing from end\n") ;
+	np = np(1:length(np)-lp-1) ;
+      end
+    end
+  end
+  ## LOADPATH
+  ## np
+  ## keyboard
+  if !strcmp(LOADPATH,np),
+    printf("rmpath : loadpath is changed\n") ;
+    LOADPATH = np 
+  end
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,41 @@
+sinclude ../../Makeconf
+
+ifndef MKOCTFILE
+MKOCTFILE = mkoctfile
+HAVE_X = 1
+X_CFLAGS = -I/usr/X11R6/include
+X_LIBS = -L/usr/X11R6/lib
+endif
+
+MOFLAGS = $(X_CFLAGS) $(X_LIBS)
+
+TARGETS = graphics.o ginput.oct grab.oct gtext.oct gzoom.oct
+
+ifdef HAVE_X
+all: $(TARGETS)
+else
+all:
+	@echo WARNING: X Windows not found on your system
+endif
+
+ginput.oct: graphics.o
+grab.oct: graphics.o
+gtext.oct: graphics.o
+gzoom.oct: graphics.o
+
+%.o: %.cc
+	$(MKOCTFILE) $(MOFLAGS) $< -o $@
+
+%.oct: %.cc
+	$(MKOCTFILE) $(MOFLAGS) graphics.o $< -o $@
+	$(RM) $(@:.oct=.o)
+
+clean:
+	$(RM) *.o *~
+
+purge: clean
+	$(RM) -f *.oct
+
+archive:
+	tar cvzf graphics.tgz Makefile *.cc *.h *.m
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/__plt3__.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,50 @@
+## Copyright (C) 1996 John W. Eaton
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## __plt3__ is not a user callable function
+
+## Author: Paul Kienzle <kienzle.powernet.co.uk>
+## 2001-04-06 Paul Kienzle <kienzle.powernet.co.uk>
+##     * gset nohidden3d; vector X,Y, matrix Z => meshgrid(X,Y)
+
+function __plt3__ (x, y, z, fmt)
+
+  if (is_vector(x) && is_vector(y))
+    if (is_vector(z))
+      x = x(:); y=y(:); z=z(:);
+    elseif (length(x) == rows(z) && length(y) == columns(z))
+      error("plot3: [length(x), length(y)] must match size(z)");
+    else
+      [x,y] = meshgrid(x,y);
+    endif
+  endif
+
+  if (any(size(x) != size(y)) || any(size(x) != size(z)))
+    error("plot3: x, y, and z must have the same shape");
+  endif
+
+  unwind_protect
+    gset parametric;
+    gset nohidden3d;
+    for i=1:columns(x)
+      tmp = [x(:,i), y(:,i), z(:,i)];
+      eval(sprintf("gsplot tmp %s", fmt));
+    endfor
+  unwind_protect_cleanup
+    gset noparametric; 
+  end_unwind_protect
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/clf.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,20 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## TODO: should send gnuplot the 'reset;' command, so that any strange
+## TODO: things that have been done to the state (such as removing tic
+## TODO: marks) are fully restored to the default configuration.
+clg;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/dhbar.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,84 @@
+## Copyright (C) 1999 Daniel Heiserer
+##
+## This program is free software.  It is distributed in the hope that it
+## will be useful, but WITHOUT ANY WARRANTY; without even the implied
+## warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See
+## the GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this file; see the file COPYING.  If not, write to the
+## Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## BAR create Bar graph
+## USAGE: 
+##     BAR(X) creates a bar plot using the colums of the m x n Matrix X
+##     as columns of the bars. The rows of X will 
+## 
+##     BAR(...,'stack') creates a vertical bar chart. 
+##     BAR(...,'group') creates a horizontal bar chart.
+## 
+## 
+##     e.g.: bar(rand(3,5),'stack')
+## 
+##    See also FILL, PATCH.
+
+## REMARK: fakes gnuplots unability of plotting shaded patches
+## AUTHOR: Daniel Heiserer <Daniel.heiserer@physik.tu-muenchen.de>
+## 2001-01-16 Paul Kienzle
+## * reformatting, unwind protect, compatible style names
+
+function dhbar(X,btype)
+
+  if nargin<2
+    btype='stack';
+  end
+  if isstr(btype)~=1
+    error('second argument has to be a string!!!!');
+  end
+
+  barwidth=0.8;
+  bw2=barwidth/2;
+
+  ## uups. I did it the wrong way, this helps:
+  X=X';
+
+  held = ishold;
+  unwind_protect
+
+    if min(size(X))==1
+      ## oh nice only single bars
+      for jj=1:length(X)
+      	patch(jj + [-bw2, -bw2, bw2, bw2], [ 0, X(jj), X(jj), 0 ], 'r');
+    	hold on
+      endfor
+    else
+      if btype=='group'
+      	## we have to change the barwidth:
+      	barwidth=0.8;
+      	bw=barwidth;
+      	for jj=1:size(X,1)
+	  for kk=1:size(X,2)
+	    patch(jj + ([-1,-1,0,0]+kk-size(X,2)/2)./size(X,2)*bw,...
+		  [ 0, X(jj,kk),  X(jj,kk), 0 ], num2str(kk));
+	    hold on
+	  endfor
+      	endfor
+      elseif btype=='stack'
+      	for jj=1:size(X,1)
+	  for kk=1:size(X,2)
+	    patch(jj + [-bw2, -bw2, bw2, bw2],...
+		  sum(X(jj,1:kk-1)) + [0,X(jj,kk),X(jj,kk),0], num2str(kk));
+	    hold on
+	  endfor
+      	endfor	
+      else
+      	error("patch: unknown type %s; use 'stack' or 'group'", btype);
+      endif
+    endif
+
+  unwind_protect_cleanup
+    if (!held) hold off; end;
+  end_unwind_protect
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/drawnow.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,1 @@
+## This program intensionally left blank
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/fill.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,133 @@
+## Copyright (C) 1999 Daniel Heiserer
+##
+## This program is free software.  It is distributed in the hope that it
+## will be useful, but WITHOUT ANY WARRANTY; without even the implied
+## warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See
+## the GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this file; see the file COPYING.  If not, write to the
+## Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## FILL creates a pseudo-shaded patch 
+## USAGE: 
+##     FILL(X,Y,C) 
+##     X x-coordinates of the patch
+##     Y y-coordinates of the patch
+##     C colour code as given by plot
+## 
+##    See also PATCH.
+
+## AUTHOR: Daniel Heiserer <Daniel.heiserer@physik.tu-muenchen.de>
+## 2001-01-16 Paul Kienzle
+## * reformatting, small speedup, unwind protect
+
+function fill(x,y,c)
+
+  if nargin!=3
+    usage("fill (x,y,c)");
+  end
+  
+  c=[c(1),';;'];
+  
+  xs=size(x);
+  ys=size(y);
+  
+  if ys~=xs
+    error('x and y have to have the same size');
+  end
+  
+  ys=max(ys);
+  xs=max(xs);
+  
+  
+  ## What do we do, if we dont have a quad?
+
+  if ys<3
+    ##	error('Area only defined for at least 3 coordinates')
+    ## should I care?
+    x(2)=x(1);
+    y(2)=y(1);
+    x(3)=x(2);
+    y(3)=y(2);
+    x(4)=x(3);
+    y(4)=y(3);
+  elseif ys==3
+    ## a triangle, merge node 4 to 1
+    x(4)=x(1);
+    y(4)=y(1);
+  elseif ys>4
+    ## ok we have to split it into multiple trias,  quads look ugly 
+    held = ishold;
+    unwind_protect
+      for jj=3:ys
+      	fill([x(1),x(jj-1),x(jj)],[y(1),y(jj-1),y(jj)],c);
+      	hold on;
+      end
+    unwind_protect_cleanup
+      if (!held) hold off; end;
+    end_unwind_protect
+  end
+
+
+  ## well as long as gnuplot has no fill function ...
+  ## we do it ourselves ....
+  ## maybe this looks really ugly if we have to fill
+  ## lots of triangles which should represent a polygon
+  ## but this approach has an excellent effort/work relationship 
+  ## (maybe we are a little to economic here ;-)) ...
+  ## improveme!!!!
+  ## ok we assume our patch looks like this:
+  ##
+  ##      2+-------------------+3
+  ##       |                   |
+  ##       |                   |
+  ##       |                   |
+  ##       |                   |
+  ##       |                   |
+  ##      1+-------------------+4
+  ##
+  ## and we want to have something like this:
+  ##
+  ##      2+-------------------+3
+  ##       | | | | | | | | | | |
+  ##       | | | | | | | | | | |
+  ##       | | | | | | | | | | |
+  ##       | | | | | | | | | | |
+  ##      1+-------------------+4
+  ##
+  ## for triangles we want to have only the grids 1-2-3
+
+  ## so we create a spacing from 1:4 and 2:3 using 1/increments
+  increments=50;
+  X_14=x(1):(x(4)-x(1))/increments:x(4);
+  X_23=x(2):(x(3)-x(2))/increments:x(3);
+  ## the same for Y
+  Y_14=y(1):(y(4)-y(1))/increments:y(4);
+  Y_23=y(2):(y(3)-y(2))/increments:y(3);
+  ## ok now assume x(1)==x(4) then the :: wouldn't generate anything
+  if (length(X_14)==0)
+    X_14=x(1)*ones(1,increments+1);
+  end
+  if (length(X_23)==0)
+    X_23=x(2)*ones(1,increments+1);
+  end
+  if (length(Y_14)==0)
+    Y_14=y(1)*ones(1,increments+1);
+  end
+  if (length(Y_23)==0)
+    Y_23=y(2)*ones(1,increments+1);
+  end
+  
+  X=[X_23;X_14];
+  Y=[Y_23;Y_14];
+  idx=2:2:increments+1;
+  X(:,idx) = flipud(X(:,idx));
+  Y(:,idx) = flipud(Y(:,idx));
+  X=X(:);
+  Y=Y(:);
+  
+  plot(X,Y,c)
+  
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/fill3.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,66 @@
+## function y = fill3(x,y,z,c)
+## given a polygon defined by xyz
+## octave fake surface fill
+
+## Author: Sam Sirlin, 2000
+## This program is granted to the public domain.
+##
+## THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+## ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+## ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+## FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+## OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+## HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+## LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+## OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+## SUCH DAMAGE.
+
+function y = fill3(x,y,z,c)
+
+  % check current hold state
+  isheld = ishold; 
+  
+  [rx,cx] = size(x);
+  [ry,cy] = size(y);
+  [rz,cz] = size(z);
+  c = [cx, cy, cz] ;
+  r = [rx, ry, rz] ;
+  nc = max(c);
+  nr = max(r);
+  if any (c != nc & c != 1) || any (r != nr)
+    error("fill3 x,y,z must have same shape");
+  endif
+  if nc > 1
+    if (cx == 1), x = x(:,ones(1,nc)); endif
+    if (cy == 1), y = y(:,ones(1,nc)); endif
+    if (cz == 1), z = z(:,ones(1,nc)); endif
+  endif
+  
+  unwind_protect
+    gset parametric
+    
+    for i=1:nc
+      xyz = [x(:,i), y(:,i), z(:,i)];
+      
+      if 1        % do borders
+      	if any(xyz(1,:) != xyz(nr,:))
+    	  xyz = [ xyz ; xyz(1, :) ];
+      	endif
+      else        % do radial lines
+      	xc = sum(xyz)/nr;  % centroid
+      	xyz = xyz([1:nr ; 1:nr], :);
+      	xyz(2:2:2*nr, :) = xc(ones(1,nr), :);
+      end
+      gset linestyle 1
+      gsplot xyz t ""  with lines
+      hold on
+    endfor
+    
+  unwind_protect_cleanup
+    if !isheld, hold off; endif
+    gset noparametric
+  end_unwind_protect
+  
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/gget.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,68 @@
+## Copyright (C) 1999 Daniel Heiserer
+##
+## This program is free software; it is distributed in the hope that it
+## will be useful, but WITHOUT ANY WARRANTY; without even the implied
+## warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See
+## the GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this file; see the file COPYING.  If not, write to the
+## Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## usage:  m = gget(option)
+##
+## returns gnuplot's setting of option.
+##
+## REQUIRES: unix piping functionality, grep, sed
+## COMMENT: would be much better to have the result directly from gnuplot,
+##          but show/gshow deliver a human readable format, which cannot
+##          be read by a machine clearly
+##
+
+## Author: Daniel Heiserer <Daniel.heiserer@physik.tu-muenchen.de>
+
+## 2001-03-30 Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##     * strip spaces
+##     * use proper temporary files
+## 2001-04-04 Laurent Mazet <mazet@crm.mot.com>
+##     * check if gnuplot very create a file
+
+function gout = gget(option)
+
+  ## tell gnuplot to save all its options to a file, scan that file
+  ## for the option we are interested in, then delete it.
+  optfile = tmpnam;
+  graw (["save set \"", optfile, "\"\n"]);
+  f = fopen(optfile);
+  while f == -1
+    sleep (1);
+    f = fopen(optfile);
+  endwhile
+  fclose(f);
+  
+  cmd = sprintf("grep \"[# ]*set %s\" %s | sed 's/.*set %s *//'; rm -f %s", ...
+		option, optfile, option, optfile);
+  gout = system(cmd);
+  if (length(gout) == 0) 
+    error("gget: option %s not found", option);
+  endif
+
+  ## grab the first output line only, without newline
+  ## XXX FIXMEXXX --- some options (e.g., key) may return multiple lines
+  ## since the real options are actually "key title" and "key".  Tricky...
+  idx = find(gout == "\n");
+  if !isempty(idx)
+    gout = gout(1:idx(1)-1); 
+    if (length(gout) == 0) return; endif
+  endif
+
+  ## strip leading and trailing blanks
+  idx = find(gout != " ");
+  if isempty(idx)
+    gout = "";
+  else
+    gout = gout(min(idx) : max(idx));
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/ginput.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,154 @@
+/*
+ * Get graphical coordinates from screen
+ * 
+ * This contains bits of code hacked from the
+ * X Consortium and from Octave. Please see the
+ * appropriate licences. The rest is mine, and
+ * you can do what you want with that part.
+ * 
+ * Andy Adler <adlera@ncf.ca> (C) 1997
+ * 
+ * Compile like this
+ * mkoctfile -L/usr/X11R6/lib -lX11 -I/usr/X11R6/include/ ginput.cc 
+ *
+ * Please excuse the ugly code. I wrote while I was learning C.
+ */
+
+#include <octave/config.h>
+#include <iostream.h>
+
+#include <octave/pager.h>
+
+#include <octave/defun-dld.h>
+#include <octave/error.h>
+#include <octave/help.h>
+#include <octave/symtab.h>
+#include <octave/oct-obj.h>
+#include <octave/utils.h>
+
+#include <X11/Xlib.h>
+#include <X11/cursorfont.h>
+
+#define maxpoints 100
+
+DEFUN_DLD (ginput, args, nargout ,
+  "[...] = ginput (...)\n\
+\n\
+GINPUT: gets points mouse clicks on the screen\n\
+ \n\
+[x,y]= ginput(axis)\n\
+ x -> x coordinates of the points\n\
+ y -> y coordinates of the points\n\
+\n\
+ axis -> if specified then the first 2 (or 4) clicks\n\
+      must be on the appropriate axes. x and y (or just x\n\
+      if only 2 points specified ) will then be normalised.\n\
+\n\
+for example: x=ginput([1 10]) \n\
+   the first two clicks should correspond to x=1 and x=10 \n\
+   subsequent clicks will then be normalized to graph units.  \n\
+\n\
+for example: [x,y]=ginput; \n\
+   gives x and y in screen pixel units (upper left = 0,0 ) \n\
+\n\
+select points with button #1. Buttons 2 and 3 quit. ")
+{
+  XEvent event;
+  XButtonEvent *e;
+  Cursor  cursor;
+  Display *dpy;
+  int     xc[maxpoints],yc[maxpoints],nc=0;
+  octave_value_list retval;
+
+  int nargin = args.length();
+
+  if (nargin > 1) {
+    print_usage ("ginput");
+    return retval;
+  }
+  else if (nargin == 1) {
+    Matrix axis= args(0).matrix_value();
+
+    nc= args(0).columns();
+    
+    if (nc==2 || nc==4) 
+      octave_stdout << "First click on x-axis points " << 
+                axis(0,0) << ", " << axis(0,1) <<"\n";
+    if (nc==4) 
+      octave_stdout << "Then click on y-axis points " << 
+                axis(0,2) << ", " << axis(0,3) <<"\n";
+    flush_octave_stdout ();
+  }
+
+  char *displayname = NULL;
+  dpy = XOpenDisplay (displayname);
+
+  if (!dpy) {
+    fprintf(stderr,"GINPUT:  unable to open display %s\n",
+                    XDisplayName(displayname));
+    exit (1);
+  }
+
+  cursor = XCreateFontCursor(dpy, XC_crosshair);
+
+  /* Grab the pointer using target cursor, letting it room all over */
+  Window root = RootWindow(dpy,0);
+  int done = XGrabPointer(dpy, root, False, ButtonPressMask,
+         GrabModeSync, GrabModeAsync, root, cursor, CurrentTime);
+  if (done != GrabSuccess) {
+    fprintf(stderr,"GINPUT: Can't grab the mouse.\n");
+    exit(1);
+  };
+
+  int m=0;
+  do {
+    XAllowEvents(dpy, SyncPointer, CurrentTime);
+    XWindowEvent(dpy, root, ButtonPressMask, &event);
+
+    e = (XButtonEvent *) &event;
+
+    xc[m]= e->x_root;
+    yc[m]= e->y_root;
+
+/*
+    printf("%d,%d,(%d,%d),B=%u,t=%lu\n",
+         e->x, e->y, e->x_root, e->y_root, e->button, e->time);
+*/
+  } while (e->button == 1 && ++m < maxpoints);
+
+  if (m < nc) {
+    fprintf(stderr,"GINPUT: Not enough points selected.\n");
+    exit(1);
+  };
+
+  double xb=0, xm=1, yb=0, ym=1;
+  if (nc==2 || nc==4) {
+    Matrix axis= args(0).matrix_value();
+
+    xm= (axis(0,0)-axis(0,1)) / (xc[0]-xc[1]);
+    xb= (xc[1]*axis(0,0)-xc[0]*axis(0,1)) / (xc[1]-xc[0]);
+
+//  octave_stdout << "xm=" << xm << " xb=" << xb ;
+
+    if (nc==4) {
+      ym= (axis(0,2)-axis(0,3)) / (yc[2]-yc[3]);
+      yb= (yc[3]*axis(0,2)-yc[2]*axis(0,3)) / (yc[3]-yc[2]);
+    };
+  };
+  
+  ColumnVector x(m-nc),y(m-nc);
+  for(int i=nc; i<m; i++) {
+    x(i-nc)= (double) xc[i]*xm + xb;
+    y(i-nc)= (double) yc[i]*ym + yb;
+  };
+
+  XUngrabPointer(dpy, CurrentTime);      /* Done with pointer */
+  XCloseDisplay (dpy);
+
+  retval(0) = x;
+  if (nargout == 2) 
+      retval(1) = y;
+  
+  return retval;
+}
+
Binary file main/plot/ginput.oct has changed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/grab.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,194 @@
+/*
+ * Get graphical coordinates from screen
+ * 
+ * This contains bits of code hacked from the
+ * X Consortium and from Octave. Please see the
+ * appropriate licences. The rest is mine, and
+ * you can do what you want with that part.
+ * 
+ * Andy Adler <adlera@ncf.ca> (C) 1997
+ * 
+ * Compile like this
+ * mkoctfile -L/usr/X11R6/lib -lX11 -I/usr/X11R6/include/ ginput.cc 
+ *
+ * Please excuse the ugly code. I wrote while I was learning C.
+ */
+
+/*
+ * Laurent Mazet <mazet@crm.mot.com> (C) 2001
+ *
+ * Fix error handler to avoid octave core-dump.
+ * Change to avoid the input limit.
+ * Minimize the number of cliks for full x-y axis definitions.
+ * Make the code a bit less ugly.
+ */
+
+#include <string>
+
+#include <octave/oct.h>
+#include <octave/toplev.h>
+
+extern "C" {
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+#include <X11/cursorfont.h>
+}
+
+#define maxpoints 10
+
+DEFUN_DLD (grab, args, nargout,
+           "[...] = grab (...)\n"
+           "\n"
+           "grab: grab points mouse clicks on the screen\n"
+           " \n"
+           "[x,y]= grab(axis)\n"
+           " x -> x coordinates of the points\n"
+           " y -> y coordinates of the points\n"
+           "\n"
+           " axis -> if specified then the first 2 clicks\n"
+           "      must be on the appropriate axes. x and y (or just x\n"
+           "      if only 2 points specified ) will then be normalised.\n"
+           "\n"
+           "for example: x=grab([1 10]) \n"
+           "   the first two clicks should correspond to x=1 and x=10 \n"
+           "   subsequent clicks will then be normalized to graph units.  \n"
+           "\n"
+           "for example: [x,y]=grab; \n"
+           "   gives x and y in screen pixel units (upper left = 0,0 ) \n"
+           "\n"
+           "select points with button #1. Buttons #2 and #3 quit. ") {
+
+  ColumnVector axis;
+  ColumnVector xaxis(2);
+  ColumnVector yaxis(2);
+  int nc;
+  
+  switch (args.length()) {
+  case 0:
+    nc = 0;
+    break;
+  case 1:
+      { // we need to do this to allow arbitrary orientation
+         ColumnVector tmp( args(0).vector_value() );
+	 if (error_state) return octave_value_list();
+         axis = tmp;
+      }
+      nc = axis.length ();
+      if ((nc == 2) || (nc == 4))
+        break;
+  default:
+    print_usage ("grab");
+    return octave_value_list();
+  }
+    
+  switch (nc) {
+  case 2:
+    cout << "First click on x-axis " << axis(0) << endl;
+    cout << "Then click on x-axis " << axis(1) << endl;
+    cout.flush();
+    break;
+  case 4:
+    cout << "First click on point "
+                  << "(" << axis(0) << "," << axis(2) << ")" << endl;
+    cout << "Then click on point "
+                  << "(" << axis(1) << "," << axis(3) << ")" << endl;
+    cout.flush();
+    break;
+  }
+
+  char *displayname = NULL;
+  Display *dpy = XOpenDisplay (displayname);
+
+  if (!dpy) {
+    cerr << "grab: unable to open display " << XDisplayName(displayname)
+         << "." << endl;
+    return octave_value_list();
+  }
+
+  Cursor  cursor = XCreateFontCursor(dpy, XC_crosshair);
+
+  /* Grab the pointer using target cursor, letting it room all over */
+  Window root = RootWindow(dpy,0);
+  int done = XGrabPointer(dpy, root, False, ButtonPressMask,
+                          GrabModeSync, GrabModeAsync, root,
+                          cursor, CurrentTime);
+  if (done != GrabSuccess) {
+    error ("grab: Can't grab the mouse.");
+    return octave_value_list();
+  };
+
+  XEvent event;
+  XButtonEvent *e = NULL;
+
+  if (nc != 0)
+    for (int i=0; i<2; i++) {
+      XAllowEvents(dpy, SyncPointer, CurrentTime);
+      XWindowEvent(dpy, root, ButtonPressMask, &event);
+      
+      e = (XButtonEvent *) &event;
+      
+      if (e->button != 1) {
+        XUngrabPointer(dpy, CurrentTime);      /* Done with pointer */
+        XCloseDisplay (dpy);
+        error ("grab: Not enough points selected.");
+        return octave_value_list();
+      }
+
+      xaxis (i) = double(e->x_root);
+      yaxis (i) = double(e->y_root);
+    }
+
+
+  /* Wait for a click */
+  MArray<int> xc(maxpoints);
+  MArray<int> yc(maxpoints);
+
+  int nb_elements = 0;
+  while (1) {
+    XAllowEvents(dpy, SyncPointer, CurrentTime);
+    XWindowEvent(dpy, root, ButtonPressMask, &event);
+    
+    e = (XButtonEvent *) &event;
+    
+    if (e->button != 1)
+      break;
+    
+    xc (nb_elements) = e->x_root;
+    yc (nb_elements) = e->y_root;
+    
+    nb_elements++;
+    
+    if (nb_elements == xc.length()) {
+      xc.resize (xc.length()+maxpoints);
+      yc.resize (yc.length()+maxpoints);
+    }
+  }
+
+  XUngrabPointer(dpy, CurrentTime);      /* Done with pointer */
+  XCloseDisplay (dpy);
+  
+  double xb=0, xm=1, yb=0, ym=1;
+  if ((nc == 2) || (nc == 4)) {
+    double xdiff = xaxis(1) - xaxis(0);
+    xm = -(axis(0)-axis(1)) / xdiff;
+    xb = (xaxis(1)*axis(0)-xaxis(0)*axis(1)) / xdiff;
+    if (nc == 4) {
+      double ydiff = yaxis(1) - yaxis(0);
+      ym = -(axis(2)-axis(3)) / ydiff;
+      yb = (yaxis(1)*axis(2)-yaxis(0)*axis(3)) / ydiff;
+    }
+  }
+
+  ColumnVector x(nb_elements), y(nb_elements);
+  for(int i=0; i<nb_elements; i++) {
+    x(i) = xc(i)*xm + xb;
+    y(i) = yc(i)*ym + yb;
+  }
+
+  octave_value_list retval;
+  retval (0) = x;
+  if (nargout == 2) 
+      retval(1) = y;
+  
+  return retval;
+}
Binary file main/plot/grab.oct has changed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/graphics.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,403 @@
+/*
+ * Copyright (C) 2000 Laurent Mazet <mazet@crm.mot.com>
+ *
+ * This program is free software and may be used for any purpose.  This
+ * copyright notice must be maintained.  Paul Kienzle is not responsible
+ * for the consequences of using this software.
+ */
+
+/*
+ * Graphics extention for hacking gnuplot on X11
+ */
+
+#include <string>
+
+#include <octave/oct.h>
+#include <octave/toplev.h>
+#include <octave/parse.h>
+
+extern "C" {
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+#include <X11/cursorfont.h>
+}
+
+#include "graphics.h"
+
+/*
+ * Ask gnuplot for current figure
+ */
+
+string find_gnuplot_window (string func) 
+{
+  /* send gget command to get terminal */
+  octave_value_list gget_args;
+  gget_args(0) = "terminal";
+  octave_value_list gget_ret = feval ("gget", gget_args, 0);
+
+  /* get figure number */
+  string st = gget_ret(0).string_value();
+  int fig_nb = -1;
+  if (st.length() > 2 && (st[0] == 'x' || st[0] == 'X') &&
+      st[1] == '1' && st[2] == '1')
+    fig_nb = strtol (st.substr(3, st.length()).c_str(), NULL, 10);
+
+  /* check if there is a gnuplot figure */
+  if (fig_nb < 0) {
+    cerr << func << ": no figure." << endl;
+    return ("");
+  }
+
+  /* Identify current figure window title */
+  char win_name[11]; /* Big enough to hold "Gnuplot " + 2 digit number */
+  if (fig_nb > 0)
+    sprintf(win_name, "Gnuplot %2d", fig_nb);
+  else
+    strcpy(win_name, "Gnuplot");
+
+  return (win_name);
+}
+
+/*
+ * Recursively search the window heirarchy for a window of the given name
+ */
+
+Window find_x11_window(Display *display, Window top, string name)
+{
+  Window root, parent, *children, found;
+  char *window_name;
+  unsigned int N, i;
+
+  /* Check if we've already got it */
+  XFetchName(display, top, &window_name);
+  if (!window_name==None && name.compare(window_name) == 0) {
+    XFree(window_name);
+    return top;
+  }
+
+  /* If not, recursively check all children */
+  if (!XQueryTree(display, top, &root, &parent, &children, &N))
+    return 0;
+  found = 0;
+  for (i=0; i < N; i++) {
+    found = find_x11_window(display, children[i], name);
+    if (found) break;
+  }
+  XFree(children);
+  return found;
+}
+
+/*
+ * Initialize gwindow structure
+ */
+
+int init_gwindow (gwindow &gw, string wname, string func)
+{
+  
+  /* Find plot window from title */
+  gw.display = XOpenDisplay(NULL);
+  gw.screen = DefaultScreen(gw.display);
+  gw.root = RootWindow(gw.display, gw.screen);
+  gw.window = find_x11_window(gw.display, gw.root, wname);
+  if (gw.window == 0) {
+    cerr << func << ": plot window not found." << endl;
+    XCloseDisplay (gw.display);
+    return 0;
+  }
+
+  /* Make sure we can capture the clicks */
+  XWindowAttributes wattr;
+  XGetWindowAttributes(gw.display, gw.window, &wattr);
+  if (wattr.all_event_masks & ButtonPressMask) {
+    cerr << func << ": could not capture button events." << endl;
+    XCloseDisplay (gw.display);
+    return 0;
+  }
+  
+  /* Set cross-hairs cursor */
+  Cursor cursor;
+  cursor = XCreateFontCursor (gw.display, XC_crosshair);
+  XDefineCursor (gw.display, gw.window, cursor);
+
+  /* Get width and height */
+  Window wroot;
+  int wx, wy;
+  unsigned int bw;
+  XGetGeometry(gw.display, gw.window,
+	       &wroot, &wx, &wy, &gw.width, &gw.height, &bw, &gw.depth);
+
+  /* Check scale and origin */
+  octave_value_list gget_args, gget_ret;
+  string st;
+  char *second;
+
+  gget_args(0) = "size";
+  gget_ret = feval ("gget", gget_args, 0);
+  st = gget_ret(0).string_value();
+  gw.xscale = strtod (st.substr (st.rfind(" "), st.length()).c_str(), &second);
+  gw.yscale = strtod (second+1, NULL);
+
+  gget_args(0) = "origin";
+  gget_ret = feval ("gget", gget_args, 0);
+  st = gget_ret(0).string_value();
+  gw.xorigin = strtod (st.c_str(), &second);
+  gw.yorigin = strtod (second+1, NULL);
+
+  return 1;
+}
+
+/*
+ * close gwindow structure
+ */
+
+void close_gwindow (gwindow &gw)
+{
+  /* Stop watching for key/button press (among others) */
+  XSelectInput (gw.display, gw.window, 0);
+
+  /* Restore cursor */
+  XUndefineCursor (gw.display, gw.window);
+  XCloseDisplay (gw.display);
+}
+
+/*
+ * warp on window center
+ */
+
+void warp_center (gwindow &gw)
+{
+  
+  /* Warp to window center */
+  XWarpPointer (gw.display, gw.root, gw.window, 0, 0,
+		0, 0,
+		int(gw.width*(gw.xorigin+gw.xscale/2)),
+		int(gw.height*(1-gw.yorigin-gw.yscale/2)));
+
+}
+
+/*
+ * Get one point or abort if any key. Return button number or 0 if abort.
+ */
+
+int get_point (gwindow &gw, int &x, int &y)
+{
+
+  /* Watch for key/button press (among others) */
+  XSelectInput (gw.display, gw.window, ButtonPressMask|KeyPressMask);
+
+  XEvent event;
+  XNextEvent (gw.display, &event);
+  if (event.type != ButtonPress)
+    return 0;
+
+  x = event.xbutton.x;
+  y = event.xbutton.y;
+  return event.xbutton.button;
+}
+
+/*
+ * Get one area, one point or abort if any key. 
+ * Return button number, 0  for a key, or -1 if abort.
+ */
+
+int get_area_point (gwindow &gw, MArray<int> &x, MArray<int> &y)
+{
+
+  /* Watch for key/button press (among others) */
+  XSelectInput (gw.display, gw.window, ButtonPressMask|KeyPressMask);
+
+  /* First point */
+  XEvent event;
+  XNextEvent (gw.display, &event);
+  if (event.type != ButtonPress)
+    return 0;
+
+  if (x.length() != 2)
+    x.resize(2);
+  if (y.length() != 2)
+    y.resize(2);
+  
+  x(0) = event.xbutton.x;
+  y(0) = event.xbutton.y;
+  if (event.xbutton.button != 1)
+    return event.xbutton.button;
+
+  XGCValues gcv;
+  GC gc;
+  
+  // FIX ME! White is 0xffffff for TrueColor !
+  gcv.function = GXxor;
+  gcv.foreground = 0xffffff;
+  gc = XCreateGC (gw.display, gw.window, GCForeground|GCFunction, &gcv);
+  
+  x(1) = x(0);
+  y(1) = x(0);      
+  
+  XSelectInput (gw.display, gw.window,
+		ButtonPressMask | PointerMotionMask | KeyPressMask);
+  /* Loop to get second point */
+  while (1) {
+    XNextEvent (gw.display, &event);
+    
+    /* Erase old rectangle */
+    if (x(1) != x(0) || y(1) != x(0))
+      XDrawRectangle (gw.display, gw.window, gc,
+		      (x(1) < x(0)) ? x(1) : x(0),
+		      (y(1) < y(0)) ? y(1) : y(0),
+		      abs (x(1) - x(0))+1,
+		      abs (y(1) - y(0))+1);
+    
+    switch (event.type) {
+    case ButtonPress:
+      /* Check button and quit */
+      x(1) = event.xbutton.x;
+      y(1) = event.xbutton.y;
+      return (event.xbutton.button == 1) ? 1 : -1;
+      break;
+      
+    case MotionNotify:
+      /* Draw new rectangle */
+      x(1) = event.xmotion.x;
+      y(1) = event.xmotion.y;
+      if (x(1) != x(0) || y(1) != x(0))
+	XDrawRectangle (gw.display, gw.window, gc,
+			(x(1) < x(0)) ? x(1) : x(0),
+			(y(1) < y(0)) ? y(1) : y(0),
+			abs (x(1) - x(0))+1,
+			abs (y(1) - y(0))+1);
+      break;
+
+    case KeyPress:
+      /* Quit and send key code */
+      return 0;
+      break;
+    }
+  }
+
+  return -1;
+}
+
+
+/*
+ * Guess border from gnuplot image
+ */
+
+ColumnVector guess_border (gwindow &gw)
+{
+
+  // FIX ME! White is 0xffffffL for TrueColor !
+  XImage *image = XGetImage (gw.display, gw.window,
+			     int(gw.width*gw.xorigin),
+			     int(gw.height*(1-gw.yorigin-gw.yscale)),
+			     int(gw.width*gw.xscale),
+			     int(gw.height*gw.yscale),
+			     0xffffffL, ZPixmap);  
+  int width = image->width;
+  int height = image->height;
+  
+  /* compute line and column correlations */
+  MArray<int> x_cor (width, 0);
+  MArray<int> y_cor (height, 0);
+
+  for (int i=0; i<width; i++)
+    for (int j=0; j<height; j++)
+      if (XGetPixel (image, i, j)) {
+	x_cor (i) ++;
+	y_cor (j) ++;
+      }
+
+  /* find two x minima */
+  int x1=0;
+  for (int i=1; i<width; i++)
+    if (x_cor(i) < x_cor(x1))
+      x1 = i;
+  int x2 = (x1 == 0) ? 1 : 0;
+  for (int i=0; i<width; i++)
+    if (x_cor(i) < x_cor(x2) && i != x1 && i != x1-1 && i != x1+1)
+      x2 = i;
+
+  /* find two y minima */
+  int y1=0;
+  for (int j=0; j<height; j++)
+    if (y_cor(j) < y_cor(y1))
+      y1 = j;
+  int y2 = (y1 == 0) ? 1 : 0;
+  for (int j=0; j<height; j++)
+    if (y_cor(j) < y_cor(y2) && j != y1 && j != y1-1 && j != y1+1)
+      y2 = j;
+  
+  /* take multiplot into account */
+  x1 += int(gw.width*gw.xorigin);
+  x2 += int(gw.width*gw.xorigin);
+  y1 += int(gw.height*(1-gw.yorigin-gw.yscale));
+  y2 += int(gw.height*(1-gw.yorigin-gw.yscale));
+
+  /* create axis vector */
+  ColumnVector axis (4);
+
+  axis(0) = (x1 < x2) ? x1 : x2;
+  axis(1) = (x1 < x2) ? x2 : x1;
+  axis(2) = (y1 < y2) ? y1 : y2;
+  axis(3) = (y1 < y2) ? y2 : y1;
+  
+  // Freed image
+  XFree (image);
+
+  return axis;
+}
+
+/*
+ * Guess axis
+ */
+
+ColumnVector guess_axis (string func)
+{
+  ColumnVector axis(4);
+  octave_value_list gget_args, gget_ret;
+  string st;
+
+  /* Get xrange */
+  gget_args(0) = "xrange";
+  gget_ret = feval ("gget", gget_args, 0);
+  st = gget_ret(0).string_value();
+
+  /* Check if axis are set or if nowriteback option is not active */
+  if (st.find("[ * : * ]") == 0 && st.find("nowriteback") < st.length()) {
+    cerr << func << ": no axis set and `nowriteback' option active." << endl;
+    return (ColumnVector (0));
+  }
+
+  if (st.find("[ * : * ]") == 0) {
+    /* Writeback option is active */
+    axis(0) =  strtod (st.substr(st.rfind("[")+1, st.length()).c_str(), NULL);
+    axis(1) =  strtod (st.substr(st.rfind(":")+1, st.length()).c_str(), NULL);
+  }
+  else {
+    /* Axis are set */
+    axis(0) = strtod (st.substr(1, st.find(":")).c_str(), NULL);
+    axis(1) = strtod (st.substr(st.find(":")+1, st.find("]")).c_str(), NULL);
+  }
+
+  /* Get yrange */
+  gget_args(0) = "yrange";
+  gget_ret = feval ("gget", gget_args, 0);
+  st = gget_ret(0).string_value();
+
+  /* Check if axis are set or if nowriteback option is not active */
+  if (st.find("[ * : * ]") == 0 && st.find("nowriteback") < st.length()) {
+    cerr << func << ": no axis set and `nowriteback' option active." << endl;
+    return (ColumnVector (0));
+  }
+
+  if (st.find("[ * : * ]") == 0) {
+    /* Writeback option is active */
+    axis(2) =  strtod (st.substr(st.rfind("[")+1, st.length()).c_str(), NULL);
+    axis(3) =  strtod (st.substr(st.rfind(":")+1, st.length()).c_str(), NULL);
+  }
+  else {    /* Axis are set */
+    axis(2) = strtod (st.substr(1, st.find(":")).c_str(), NULL);
+    axis(3) = strtod (st.substr(st.find(":")+1, st.find("]")).c_str(), NULL);
+  }
+
+  return axis;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/graphics.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,54 @@
+/*
+ * Copyright (C) 2000 Laurent Mazet <mazet@crm.mot.com>
+ *
+ * This program is free software and may be used for any purpose.  This
+ * copyright notice must be maintained.  Paul Kienzle is not responsible
+ * for the consequences of using this software.
+ */
+
+/*
+ * Graphics extention for hacking gnuplot on X11
+ */
+
+#ifndef __GRAPHICS_H__
+#define __GRAPHICS_H__
+
+#include <string>
+
+extern "C" {
+#include <X11/Xlib.h>
+}
+
+typedef struct {
+  Display *display;
+  int screen;
+  Window root;
+  Window window;
+  unsigned int width;
+  unsigned int height;
+  unsigned int depth;
+  double xscale;
+  double yscale;
+  double xorigin;
+  double yorigin;
+} gwindow;
+
+string find_gnuplot_window (string func);
+
+Window find_x11_window(Display *display, Window top, string name);
+
+int init_gwindow (gwindow &gw, string wname, string func);
+
+void close_gwindow (gwindow &gw);
+
+void warp_center (gwindow &gw);
+
+int get_point (gwindow &gw, int &x, int &y);
+
+int get_area_point (gwindow &gw, MArray<int> &x, MArray<int> &y);
+
+ColumnVector guess_border (gwindow &gw);
+
+ColumnVector guess_axis (string func);
+
+#endif /* __GRAPHICS_H__ */
Binary file main/plot/graphics.oct has changed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/gtext.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,101 @@
+/*
+ * Copyright (C) 2000 Paul Kienzle
+ * This program is free software and may be used for any purpose.  This
+ * copyright notice must be maintained.  Paul Kienzle is not responsible
+ * for the consequences of using this software.
+ */
+
+/*
+ * Laurent Mazet <mazet@crm.mot.com> (C) 2001
+ *
+ * - 1/4/01 -
+ * Automatically choose the last figure and warp pointer on it.
+ * Any key abort placement.
+ * - 8/4/01 -
+ * Use graphics library functions.
+ */
+
+#include <string>
+
+#include <octave/oct.h>
+#include <octave/toplev.h>
+#include <octave/parse.h>
+
+#include "graphics.h"
+
+DEFUN_DLD (gtext, args, ,
+	   "usage: [res] = gtext (\"text\")\n"
+	   "\n"
+           "Click where you want the text.\n"
+           "Use left button for left-justified text, middle button for centered\n"
+           "text, or right button for right-justified text. Press any key to abort.\n"
+           "\n"
+           "I'm using screen coordinates rather than graph\n"
+           "coordinates to position the text, so expect it to shift from screen\n"
+           "to print version.  If you want a good solution, get the mouse support\n"
+           "patches for gnuplot.\n"
+           "\n"
+	   "res will be 1 if the operation is successful, otherwise it will be 0.\n"
+	   "\n"
+           "Note that gtext() doesn't work with multiplot().") {
+  int nargin = args.length ();
+  if (nargin != 1) {
+    print_usage ("gtext");
+    return octave_value(0.0);
+  }
+
+  /* Ask gnuplot for current figure */
+  string name = find_gnuplot_window ("gtext");
+  if (name.length() == 0)
+    return octave_value(0.0);
+
+  /* Get window and initialize gwindow structure */ 
+  gwindow gw;
+  if (!init_gwindow (gw, name, "gtext"))
+    return octave_value(0.0);
+
+  /* Warp to window */
+  warp_center (gw);
+
+  /* Watch for key/button press (among others) */
+  int x=0, y=0;
+  int button = get_point (gw, x, y);
+
+  close_gwindow (gw);
+
+  if (!button)
+    return octave_value(0.0);
+
+  /* Determine click position */
+  double rel_x = (double)x/double(gw.width);
+  double rel_y = (double)(gw.height-y)/double(gw.height);
+
+  /* do the text call */
+  octave_value_list fargs;
+  fargs(0) = rel_x;
+  fargs(1) = rel_y;
+  fargs(2) = args(0);
+  fargs(3) = "Units";
+  fargs(4) = "Screen";
+  fargs(5) = "HorizontalAlignment";
+  switch (button) {
+  case 1:
+  default:
+    fargs(6) = "left";
+    break;
+  case 2:
+    fargs(6) = "center";
+    break;
+  case 3:
+    fargs(6) = "right";
+    break;
+  }
+  feval ("text", fargs, 0);
+
+  /* automatically replot */
+  octave_value_list rargs;
+  rargs(0) = "replot";
+  feval ("eval", rargs, 0);
+
+  return octave_value(1.0);
+}
Binary file main/plot/gtext.oct has changed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/gzoom.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,127 @@
+/*
+ * Copyright (C) 2001 Laurent Mazet
+ * This program is free software and may be used for any purpose.  This
+ * copyright notice must be maintained.  Paul Kienzle is not responsible
+ * for the consequences of using this software.
+ */
+
+/*
+ * Laurent Mazet <mazet@crm.mot.com> (C) 2001
+ *
+ * - 10/4/01 -
+ * Initial release
+ */
+
+
+#include <string>
+
+#include <octave/oct.h>
+#include <octave/toplev.h>
+#include <octave/parse.h>
+
+#include "graphics.h"
+
+DEFUN_DLD (gzoom, args, ,
+	   "usage: gzoom()\n"
+	   "\n"
+	   "Controls are:\n"
+	   " * Use left button to zoom on an area.\n"
+	   " * Use right button to zoom back on a point.\n"
+	   " * Use middle button to quit and keep current axis settings.\n"
+	   " * Press any key to quit and recover old axis setting") {
+
+  /* Ask gnuplot for current figure */
+  string name = find_gnuplot_window ("gzoom");
+  if (name.length() == 0)
+    return octave_value();
+
+  /* Ask gnuplot for axis limits */
+  ColumnVector initial_axis = guess_axis ("gzoom");
+  if (initial_axis.length() == 0)
+    return octave_value();
+  ColumnVector axis = initial_axis;
+
+  octave_value_list axis_args;
+  axis_args(0) = initial_axis;
+  feval ("axis", axis_args, 0);
+  
+  octave_value_list replot_args;
+  replot_args(0) = "replot";
+  feval ("eval", replot_args, 0);
+  
+  /* Get window and initialize gwindow structure */ 
+  gwindow gw;
+  if (!init_gwindow (gw, name, "gzoom"))
+    return octave_value();
+
+  /* Warp to window */
+  warp_center (gw);
+
+  /* Guess border */
+  ColumnVector guess_axis = guess_border (gw);
+  
+  MArray<int> x(2);
+  MArray<int> y(2);
+  
+ /* Watch for key/button press (among others) */
+  while (1) {
+
+    /* Compute real coordonnates */
+    double xdiff = guess_axis(1) - guess_axis(0);
+    double xm = -(axis(0)-axis(1)) / xdiff;
+    double xb = (guess_axis(1)*axis(0)-guess_axis(0)*axis(1)) / xdiff;
+    double ydiff = guess_axis(2) - guess_axis(3);
+    double ym = -(axis(2)-axis(3)) / ydiff;
+    double yb = (guess_axis(2)*axis(2)-guess_axis(3)*axis(3)) / ydiff;
+    
+    switch (get_area_point (gw, x, y)) {
+    case 0:
+      /* Key pressed */
+      axis_args(0) = initial_axis;
+      feval ("axis", axis_args, 0);
+      feval ("eval", replot_args, 0);
+      close_gwindow (gw);
+      return octave_value();
+      break;
+
+    case 1:
+      /* Left button */
+
+      /* Choice axis */
+      axis(0) = ((x(0) > x(1)) ? x(1) : x(0))*xm + xb;
+      axis(1) = ((x(0) > x(1)) ? x(0) : x(1))*xm + xb;
+      axis(2) = ((y(0) < y(1)) ? y(1) : y(0))*ym + yb;
+      axis(3) = ((y(0) < y(1)) ? y(0) : y(1))*ym + yb;
+
+      /* Send gnuplot commands */
+      axis_args(0) = axis;
+      feval ("axis", axis_args, 0);
+      feval ("eval", replot_args, 0);
+      break;
+      
+    case 2:
+      /* Middle button */
+      close_gwindow (gw);
+      return octave_value();
+      break;
+
+    case 3:
+      /* Right button */
+
+      xdiff = axis(1)-axis(0);
+      ydiff = axis(3)-axis(2);
+
+      /* Choice axis */
+      axis(0) = x(0)*xm + xb - xdiff;
+      axis(1) = x(0)*xm + xb + xdiff;
+      axis(2) = y(0)*ym + yb - ydiff;
+      axis(3) = y(0)*ym + yb + ydiff;
+
+      /* Send gnuplot commands */
+      axis_args(0) = axis;
+      feval ("axis", axis_args, 0);
+      feval ("eval", replot_args, 0);
+      break;
+    }
+  }
+}
Binary file main/plot/gzoom.oct has changed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/legend.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,211 @@
+## Copyright (C) 2001 Laurent Mazet
+##
+## This program is free software; it is distributed in the hope that it
+## will be useful, but WITHOUT ANY WARRANTY; without even the implied
+## warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See
+## the GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this file; see the file COPYING.  If not, write to the
+## Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## usage: legend (string1, string2, string3, ..., [pos])
+##        legend ([string1; string2; string3; ...], [pos])
+##        legend ("off")
+##
+## Legend puts a legend on the current plot using the specified strings
+## as labels. Legend works on line graphs, bar graphs, etc...
+##
+## pos: places the legend in the specified location:
+##      0 = Don't move the legend box (default)
+##      1 = Upper right-hand corner
+##      2 = Upper left-hand corner
+##      3 = Lower left-hand corner
+##      4 = Lower right-hand corner
+##      -1 = To the right of the plot
+##
+## off will switch off legends from the plot
+##
+## REQUIRES: unix piping functionality, grep, sed and awk
+
+## 2001-03-31 Paul Kienzle
+##   * use tmpnam for temporary file name; unlink to remove
+
+function legend (...)
+
+  gset key;
+  
+  ## Data type
+
+  data_type = 0;
+  va_start();
+  str = "";
+  if (nargin > 0)
+    str = va_arg();
+  endif;
+      
+  ## Test for off
+
+  if ((isstr(str)) && (strcmp(tolower(deblank(str)),"off")) && (nargin == 1))
+    gset nokey;
+    replot;
+    return;
+  endif;
+
+  ## Test for data type (0 -> list of string, 1 -> array of string)
+  
+  if (length(str) != 0) && (isstr(str(1,:))) && (rows(str) != 1)
+    data_type = 1;
+    va_start();
+    data = va_arg();
+    nb_data = rows(data);
+    nargin--;
+  endif;
+
+  pos_leg = 0;
+  
+  ## Get the original plotting command
+  
+  tmpfilename=tmpnam;
+  command=["save \"",tmpfilename,"\"\n"];
+  graw(command);
+
+  awk_prog= \
+      "BEGIN { \
+        dq = 0; \
+        format = \"%s\\n\"; \
+       } \
+       NF != 0 { \
+        for (i=1;i<=NF;i++) { \
+         if ($(i) == \"\\\"\") { \
+          if (dp == 0) { \
+           dp = 1; \
+           if ($(i+1) != \"\\\"\") { \
+            i++; \
+            printf (\"%s\", $(i)); \
+           } \
+          format = \" %s\"; \
+          } else { \
+           dp = 0; \
+           format = \"%s\\n\"; \
+           printf (\"\\n\"); \
+          } \
+         } else { \
+          printf (format, $(i)); \
+         } \
+        } \
+       }";
+            
+  shell_cmd=["grep \"^pl \" " tmpfilename " | " \
+             "sed -e 's/,/ , /g' -e 's/\"/ \" /g'" " | " \
+             "awk '" awk_prog "'"];
+  plot_cmd = split(system(shell_cmd),"\n");
+  if (~length(deblank(plot_cmd(rows(plot_cmd), :))))
+    plot_cmd = plot_cmd ([1:rows(plot_cmd)-1],:);
+  endif;
+  unlink(tmpfilename);
+  
+  ## Look for the number of graph
+
+  nb_graph = 0;
+  i = 0;
+  while (i++ < rows(plot_cmd))
+    line = deblank(plot_cmd(i,:));
+    if ((strcmp(line, "pl")) || (strcmp(line, ",")))
+      nb_graph++;
+    endif;
+  endwhile;
+
+  ## Change the legend of each graph
+  
+  new_plot = [];
+  if (data_type == 0)
+    va_start();
+  endif;
+  fig = 0;
+  i = 1;
+  while (fig < nb_graph)
+
+    ## Get the legend string
+
+    if (((data_type == 0) && (nargin <= 0)) || \
+        ((data_type == 1) && (fig >= nb_data)))
+      leg = "\"\"";
+    else
+      if (data_type == 0)
+        leg = va_arg () ;
+        nargin--;
+      else
+        leg = data(fig+1,:);
+      endif;
+      if (!isstr(leg))
+        pos_leg = leg;
+        leg = "\"\"";
+      elseif (length(deblank(leg)) == 0)
+        leg = "\"\"";
+      else
+        leg=["\"" leg "\""];
+      endif;
+    endif;
+
+    ## look for the end of the graph command i.e. ","
+
+    new_line = [deblank(plot_cmd(i++,:)) " \"" deblank(plot_cmd(i++,:)) "\""];
+    while ((i <= rows(plot_cmd)) && (!strcmp(deblank(plot_cmd(i,:)), ",")))
+      if (strcmp(deblank(plot_cmd(i,:)), "t"))
+        new_line = [new_line " t " leg];
+        i++;
+      else
+        new_line = [new_line " " deblank(plot_cmd(i,:))];
+      endif;
+      i++;
+    endwhile;
+
+    if (length(new_plot))
+      new_plot = [ new_plot new_line];
+    else
+      new_plot = new_line;
+    endif;
+    
+    fig++;
+  endwhile;
+
+  ## Create a new ploting command
+
+  new_plot = [new_plot "\n"];  
+  graw(new_plot);
+
+  ## Check for the last argument if we don't already get it
+  
+  while (nargin-- > 0)
+    pos_leg = va_arg () ;
+    if (isstr(pos_leg))
+      pos_leg = 0;
+    endif;
+  endwhile;
+  
+  ## Change the legend position
+
+  if ((is_scalar (pos_leg)) && (isreal(pos_leg)))
+    switch (pos_leg)
+      case 1
+        gset key right top;
+      case 2
+        gset key left top;
+      case 3
+        gset key left bottom;
+      case 4
+        gset key right bottom;
+      case -1
+        gset key right top outside;
+    endswitch;
+  else
+    warning ("pos must be a scalar");
+  endif;
+
+  ## Regenerate the plot
+  
+  replot;
+  
+endfunction;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/meshc.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,117 @@
+## Copyright (C) 1996, 1997 John W. Eaton
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING.  If not, write to the
+## Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} meshc (@var{x}, @var{y}, @var{z})
+## Plot a mesh given matrices @var{x}, and @var{y} from @code{meshdom} and
+## a matrix @var{z} corresponding to the @var{x} and @var{y} coordinates of
+## the mesh.  If @var{x} and @var{y} are vectors, then a typical vertex
+## is (@var{x}(j), @var{y}(i), @var{z}(i,j)).  Thus, columns of @var{z}
+## correspond to different @var{x} values and rows of @var{z} correspond
+## to different @var{y} values.
+## @end deftypefn
+## @seealso{plot, semilogx, semilogy, loglog, polar, meshgrid, meshdom,
+## contour, bar, stairs, gplot, gsplot, replot, xlabel, ylabel, and title}
+
+## Author: jwe
+## Modified: 2000-11-17 Paul Kienzle <kienzle.powernet.co.uk>
+##   copied from Octave 2.1.31 mesh.m, with contours turned on
+##   if added to octave, make __mesh__.m which takes the usual paramters
+##   in addition to 'surface' and 'contour' so that this code gets reused.
+
+function meshc (x, y, z)
+
+  ## XXX FIXME XXX -- the plot states should really just be set
+  ## temporarily, probably inside an unwind_protect block, but there is
+  ## no way to determine their current values.
+
+  if (nargin == 1)
+    z = x;
+    if (is_matrix (z))
+      gset hidden3d;
+      gset data style lines;
+      gset surface;
+      gset contour;
+      gset noparametric;
+      gset view 60, 30, 1, 1
+      gsplot (z');
+    else
+      error ("mesh: argument must be a matrix");
+    endif
+  elseif (nargin == 3)
+    if (is_vector (x) && is_vector (y) && is_matrix (z))
+      xlen = length (x);
+      ylen = length (y);
+      if (xlen == columns (z) && ylen == rows (z))
+        if (rows (y) == 1)
+          y = y';
+        endif
+        len = 3 * xlen;
+        zz = zeros (ylen, len);
+        k = 1;
+        for i = 1:3:len
+          zz(:,i)   = x(k) * ones (ylen, 1);
+          zz(:,i+1) = y;
+          zz(:,i+2) = z(:,k);
+          k++;
+        endfor
+        gset hidden3d;
+        gset data style lines;
+        gset surface;
+        gset contour;
+        gset parametric;
+        gset view 60, 30, 1, 1
+        gsplot (zz);
+        gset noparametric;
+      else
+        msg = "mesh: rows (z) must be the same as length (y) and";
+        msg = sprintf ("%s\ncolumns (z) must be the same as length (x)", msg);
+        error (msg);
+      endif
+    elseif (is_matrix (x) && is_matrix (y) && is_matrix (z))
+      xlen = columns (z);
+      ylen = rows (z);
+      if (xlen == columns (x) && xlen == columns (y) &&
+        ylen == rows (x) && ylen == rows(y))
+        len = 3 * xlen;
+        zz = zeros (ylen, len);
+        k = 1;
+        for i = 1:3:len
+          zz(:,i)   = x(:,k);
+          zz(:,i+1) = y(:,k);
+          zz(:,i+2) = z(:,k);
+          k++;
+        endfor
+        gset hidden3d;
+        gset data style lines;
+        gset surface;
+        gset contour;
+        gset parametric;
+        gset view 60, 30, 1, 1
+        gsplot (zz);
+        gset noparametric;
+      else
+        error ("mesh: x, y, and z must have same dimensions");
+      endif
+    else
+      error ("mesh: x and y must be vectors and z must be a matrix");
+    endif
+  else
+    usage ("mesh (z)");
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/orient.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,44 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## orient("landscape"|"portrait")
+##    Set default print orientation
+##
+## ret = orient
+##    Return default print orientation
+
+function ret = orient(orientation)
+
+  static __print_orientation = "landscape";
+
+  if (nargin == 0)
+    ret = __print_orientation;
+
+  elseif (nargin == 1)
+
+    if strcmp(orientation,"landscape") || strcmp(orienation,"portrait")
+      __print_orientation = orientation;
+    else
+      error ("orient: unknown orientation");
+    endif
+
+  else
+
+    usage("orient(['portrait' | 'landscape'])  OR  ret=orient");
+
+  endif
+
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/patch.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,71 @@
+## Copyright (C) 1999 Daniel Heiserer
+##
+## This program is free software. It is distributed in the hope that it
+## will be useful, but WITHOUT ANY WARRANTY; without even the implied
+## warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See
+## the GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this file; see the file COPYING.  If not, write to the
+## Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## patch creates a pseudo-shaded patch with a black boundary
+## USAGE: 
+##     PATCH(X,Y,Z,C) 
+##     X x-coordinates of the patch
+##     Y y-coordinates of the patch
+##     Z z-coordinates of the patch
+## 
+##    See also FILL, FILL3.
+
+## AUTHOR: Daniel Heiserer <Daniel.heiserer@physik.tu-muenchen.de>
+## 2001-01-16 Paul Kienzle
+## * handle 2d and 3d, reformatting, unwind protect
+
+function patch(x,y,z,c)
+
+  if nargin==3
+    c=z;
+  end
+
+  if nargin<3 || nargin>4
+    usage("patch (x, y [, z], c)");
+  end
+  c=[c(1),';;'];
+  borderc=['k;;'];
+
+  if nargin == 3
+    if any (size(x) != size(y))
+      error('x and y must have the same size');
+    end
+
+    fill(x,y,c);
+    held = ishold;
+    unwind_protect
+      hold on
+      X=[x,x(1)];
+      Y=[y,y(1)];
+      plot(X,Y,borderc);
+    unwind_protect_cleanup
+      if (!held) hold off; endif
+    end_unwind_protect
+  else
+    if any (size(x) != size(y)) || any (size(x) != size(z))
+      error('x, y and z must have the same size');
+    end
+      
+    fill3(x,y,z,c);
+    held = ishold;
+    unwind_protect
+      hold on
+      X=[x,x(1)];
+      Y=[y,y(1)];
+      Z=[z,z(1)];
+      plot3(X,Y,Z,borderc);
+    unwind_protect_cleanup
+      if (!held) hold off; endif
+    end_unwind_protect
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/pcolor.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,19 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## pcolor([x, y,] z)
+function pcolor(...)
+  imagesc(all_va_args);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/pie.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,69 @@
+## Copyright (C) 1999 Daniel Heiserer
+##
+## This program is free software.
+##
+## This file is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this file; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## pie(Y)
+##    Produce pie graph 
+##
+## pie(Y,['label1';'label2';...;'labeln']);
+##    Produce labelled pie graph
+
+## AUTHOR: Daniel Heiserer <Daniel.heiserer@physik.tu-muenchen.de>
+function pie(Y,desc)
+
+  refinement=20;
+  ##refinement=5;
+  phi=0:refinement:360;
+  Yphi=abs(Y)/sum(abs(Y))*360;
+  Yphi=cumsum(Yphi);
+  
+  Yn=0:360/refinement:Yphi(1);
+  if Yn(length(Yn))~=Yphi(1)
+    Yn=[Yn,Yphi(1)];
+  end
+
+  held = ishold;
+  unwind_protect
+    patch([0,cos(Yn*2*pi/360)],[0,sin(Yn*2*pi/360)],num2str(1));
+    hold on;
+    for jj=2:length(Y)
+      ## find how many degrees are inside the jj-th pie
+      ## which degrees
+      Yn=Yphi(jj-1):360/refinement:Yphi(jj);
+      if length(Yn)>0
+      	if Yn(length(Yn))~=Yphi(jj)
+    	  Yn=[Yn,Yphi(jj)];
+      	end
+      	patch([0,cos(Yn*2*pi/360)],[0,sin(Yn*2*pi/360)],num2str(jj));
+      else
+      	
+      end
+    end
+  
+    ## reserve some place for a legend
+    axis([-1 2 -1 1])
+  
+    ## ok assume we have some text here:
+    if nargin==2
+      if length(Y)~=size(desc,1)
+      	error('pie-data and pie-string mismatch');
+      end
+      for jj=1:size(desc,1)
+      	plot(0,0,[num2str(jj),';',desc(jj,:),';']);
+      end
+    end
+  unwind_protect_cleanup
+    if !held, hold off; end
+  end_unwind_protect
+end
+  
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/plot3.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,109 @@
+## Copyright (C) 1996 John W. Eaton
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## usage: plot3 (x, y, z)
+##        plot3 (x1, y1, z1, x2, y2, z2, ...)
+##        plot3 (x, y, z, fmt)
+##
+## If all arguments are vectors of the same length, a single line is
+## drawn in three space.
+##
+## If all arguments are matrices, each column is drawn as a separate
+## line. In this case, all matrices must have the same number of rows
+## and columns and no attempt is made to transpose the arguments to make
+## the number of rows match.
+##
+## To see possible options for FMT please see __pltopt__.
+##
+## Example
+##
+##    z = [0:0.05:5];
+##    plot3(cos(2*pi*z), sin(2*pi*z), z, ";helix;");
+
+## Author: Paul Kienzle (modified from __plt__.m)
+
+function plot3(...)
+
+  hold_state = ishold ();
+  
+  unwind_protect
+
+    x_set = 0;
+    y_set = 0;
+    z_set = 0;
+    
+    ## Gather arguments, decode format, and plot lines.
+    
+    while (nargin-- > 0)
+      
+      new = va_arg ();
+      
+      if (isstr (new))
+	if (! z_set)
+	  error ("plot3: needs x, y, z");
+	endif
+	fmt = __pltopt__ ("plot3", new);
+	__plt3__(x, y, z, fmt);
+	hold on;
+	x_set = 0;
+	y_set = 0;
+	z_set = 0;
+      elseif (!x_set)
+	x = new;
+	x_set = 1;
+      elseif (!y_set)
+	y = new;
+	y_set = 1;
+      elseif (!z_set)
+	z = new;
+	z_set = 1;
+      else
+	__plt3__ (x, y, z, "");
+	hold on;
+	x = new;
+	y_set = 0;
+	z_set = 0;
+      endif
+ 
+### Code copied from __plt__; don't know if it is needed     
+###
+###   ## Something fishy is going on.  I don't think this should be
+###   ## necessary, but without it, sometimes not all the lines from a
+###   ## given plot command appear on the screen.  Even with it, the
+###   ## delay might not be long enough for some systems...
+###     
+###   usleep (1e5);
+      
+    endwhile
+    
+    ## Handle last plot.
+    
+    if  (z_set)
+      __plt3__ (x, y, z, "");
+    elseif (x_set)
+      error ("plot3: needs x, y, z");
+    endif
+    
+  unwind_protect_cleanup
+    
+    if (! hold_state)
+      hold off;
+    endif
+    
+  end_unwind_protect
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/print.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,321 @@
+## Copyright (C) 1999 Daniel Heiserer, Copyright (C) 2001 Laurent Mazet
+##
+## This program is free software; it is distributed in the hope that it
+## will be useful, but WITHOUT ANY WARRANTY; without even the implied
+## warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See
+## the GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this file; see the file COPYING.  If not, write to the
+## Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## usage: print (filename, options)
+##
+## Print a graph, or save it to a file
+##
+## filename: 
+##   File to receive output.  If no filename is specified, output is
+##   sent to the printer.
+##
+## options:
+##   -Pprinter
+##      Printer to which the graph is sent if no filename is specified.
+##
+##   -color | -mono
+##      Monochrome or colour lines.
+##
+##   -solid | -dashed
+##      Solid or dashed lines.
+##
+##   -portrait | -landscape
+##      Plot orientation, as returned by "orient".
+##
+##   -dDEVICE
+##      Output device, where DEVICE is one of:
+##
+##        ps,ps2,psc,psc2      
+##             Postscript (level 1 and 2, mono and color)
+##        eps,eps2,epsc,epsc2  
+##             Encapsulated postscript (level 1 and 2, mono and color)
+##        ill,aifm 
+##             Adobe Illustrator
+##        cdr,corel
+##             CorelDraw
+##        hpgl HP plotter language
+##        fig  XFig
+##        dxf  AutoCAD
+##        mf   Metafont
+##        png  Portable network graphics
+##        pbm  PBMplus
+##
+##      Other devices are supported by "convert" from ImageMagick.  Type
+##      system("convert") to see what formats are available.
+##
+##      If the device is omitted, it is inferred from the file extension,
+##      or if there is no filename it is sent to the printer as postscript.
+##
+##   -Ffontname, -Ffontname:size, -F:size
+##      Postscript font (for use with postscript, aifm, corel and fig)
+##      "Helvetica" by default for PS/Aifm, "SwitzerlandLight" for Corel
+##      Can also be "Times-Roman".  The font size is given in points.
+##      The fontname is ignored for the fig device.
+##
+## The filename and options can be given in any order.
+##
+## If you are using Octave 2.1.x or above, command("print") will change 
+## print from a function to a command, so instead of typing
+##    print("-FTimes-Roman:14", "-dashed", "-depsc", "out.ps")
+## you can type
+##    print -FTimes-Roman:14 -dashed -depsc out.ps
+##
+## See also: orient, command
+
+## Author: Daniel Heiserer <Daniel.heiserer@physik.tu-muenchen.de>
+## 2001-03-23  Laurent Mazet <mazet@crm.mot.com>
+##     * simplified interface: guess the device from the extension
+##     * font support
+## 2001-03-25  Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##     * add unwind_protect
+##     * use tmpnam to generate temporary name
+##     * move "set term" before "set output" as required by gnuplot
+##     * more options, and flexible options
+## 2001-03-29  Laurent Mazet <mazet@crm.mot.com>
+##     * add solid and dashed options
+##     * change PBMplus device
+##     * add Corel device
+##     * take care of the default terminal settings to restore them.
+##     * add color, mono, dashed and solid support for printing and convert.
+##     * add orientation for printing.
+##     * create a .ps for printing (avoid some filtering problems).
+##     * default printing is mono, default convert is color.
+##     * add font size support.
+## 2001-03-30  Laurent Mazet <mazet@crm.mot.com>
+##     * correct correl into corel
+##     * delete a irrelevant test
+##     * check for convert before choosing the ouput device
+## 2001-03-31  Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##     * use -Ffontname:size instead of -F"fontname size"
+##     * add font size support to fig option
+##     * update documentation
+
+function print(...)
+
+  ## take care of the settings we had before
+  origterm = gget("terminal");
+  origout = gget("output");
+  _automatic_replot = automatic_replot;
+
+  ## take care of the default terminal settings to restore them.
+  terminal_default = "";
+  
+  orientation = orient;
+  use_color = 0; # 0=default, -1=mono, +1=color
+  force_solid = 0; # 0=default, -1=dashed, +1=solid
+  fontsize = font = name = devopt = printer = "";
+  
+  va_start();
+  for i=1:nargin
+    arg = va_arg();
+    if isstr(arg)
+      if strcmp(arg, "-color")
+	use_color = 1;
+      elseif strcmp(arg, "-mono")
+	use_color = -1;
+      elseif strcmp(arg, "-solid")
+        force_solid = 1;
+      elseif strcmp(arg, "-dashed")
+        force_solid = -1;
+      elseif strcmp(arg, "-portrait")
+	orientation = "portrait";
+      elseif strcmp(arg, "-landscape")
+	orientation = "landscape";
+      elseif length(arg) > 2 && arg(1:2) == "-d"
+	devopt = arg(3:length(arg));
+      elseif length(arg) > 2 && arg(1:2) == "-P"
+	printer = arg;
+      elseif length(arg) > 2 && arg(1:2) == "-F"
+	idx = rindex(arg, ":");
+	if (idx)
+	  font = arg(3:idx-1);
+	  fontsize = arg(idx+1:length(arg));
+	else
+	  font = arg(3:length(arg));
+	endif
+      elseif length(arg) >= 1 && arg(1) == "-"
+	error([ "print: unknown option ", arg ]);
+      elseif length(arg) > 0
+	name = arg;
+      endif
+    else
+      error("print: expects string options");
+    endif
+  endfor
+
+  doprint = isempty(name);
+  if doprint
+    if isempty(devopt)
+      printname = [ tmpnam, ".ps" ]; 
+    else
+      printname = [ tmpnam, ".", devopt ];
+    endif
+    name = printname;
+  endif
+
+  if isempty(devopt)
+    dot = rindex(name, ".");
+    if (dot == 0) 
+      error ("print: no format specified");
+    else
+      dev = tolower(name(dot+1:length(name)));
+    endif
+  else
+    dev = devopt;
+  endif
+
+  if strcmp(dev, "ill")
+    dev = "aifm";
+  elseif strcmp(dev, "cdr")
+    dev = "corel";
+  endif
+
+  ## check if we have to use convert
+  dev_list = [" aifm corel fig png pbm dxf mf hpgl", ...
+	      " ps ps2 psc psc2 eps eps2 epsc epsc2 " ];
+  convertname = "";
+  if isempty(findstr(dev_list , [ " ", dev, " " ]))
+    if !isempty(devopt)
+      convertname = [ devopt ":" name ];
+    else
+      convertname = name;
+    endif
+    dev = "epsc";
+    name = [ tmpnam, ".eps" ];
+  endif
+  
+  unwind_protect
+    automatic_replot = 0;
+
+    if strcmp(dev, "ps") || strcmp(dev, "ps2") ...
+	  || strcmp(dev, "psc")  || strcmp(dev, "psc2") ...
+	  || strcmp(dev, "epsc") || strcmp(dev, "epsc2") ... 
+	  || strcmp(dev, "eps")  || strcmp(dev, "eps2")
+      ## Various postscript options
+      gset term postscript;
+      terminal_default = gget ("terminal");
+      
+      if dev(1) == "e"
+	options = "eps ";
+      else
+	options = [ orientation, " " ];
+      endif
+      options = [ options, "enhanced " ];
+      
+      if any( dev == "c" ) || use_color > 0
+        if force_solid < 0
+	  options = [ options, "color dashed " ];
+	else
+          options = [ options, "color solid " ];
+        endif
+      else
+        if force_solid > 0
+	  options = [ options, "mono solid " ];
+	else
+	  options = [ options, "mono dashed " ];
+        endif
+      endif
+
+      if !isempty(font)
+	options = [ options, "\"", font, "\" " ];
+      endif
+      if !isempty(fontsize)
+	options = [ options, " ", fontsize ];
+      endif
+
+      eval (sprintf ("gset term postscript %s;", options));
+
+
+    elseif strcmp(dev, "aifm") || strcmp(dev, "corel")
+      ## Adobe Illustrator, CorelDraw
+      eval(sprintf ("gset term %s;", dev));
+      terminal_default = gget ("terminal");
+      if (use_color >= 0)
+	options = " color";
+      else
+	options = " mono";
+      endif
+      if !isempty(font)
+	options = [ options, " \"" , font, "\"" ];
+      endif
+      if !isempty(fontsize)
+	options = [ options, " ", fontsize ];
+      endif
+
+      eval (sprintf ("gset term %s %s;", dev, options));
+
+    elseif strcmp(dev, "fig")
+      ## XFig
+      gset term fig;
+      terminal_default = gget ("terminal");
+      options = orientation;
+      if (use_color >= 0)
+	options = " color";
+      else
+	options = " mono";
+      endif
+      if !isempty(fontsize)
+	options = [ options, " fontsize ", fontsize ];
+      endif
+      eval (sprintf ("gset term fig %s;", option));
+
+    elseif strcmp(dev, "png") || strcmp(dev, "pbm")
+      ## Portable network graphics, PBMplus
+      eval(sprintf ("gset term %s;", dev));
+      terminal_default = gget ("terminal");
+      if (use_color >= 0)
+      	eval (sprintf ("gset term %s color medium;", dev));
+      else
+	eval (sprintf ("gset term %s mono medium;", dev));
+      endif
+
+    elseif strcmp(dev,"dxf") || strcmp(dev,"mf") || strcmp(dev, "hpgl")
+      ## AutoCad DXF, METAFONT, HPGL
+      eval (sprintf ("gset terminal %s;", dev));
+            
+    endif;
+    
+    eval (sprintf ("gset output \"%s\";", name));
+    replot;
+    
+  unwind_protect_cleanup
+
+    ## Restore init state
+    if isempty (origout)
+      gset output;
+    else
+      eval (sprintf ("gset output %s;", origout));
+    end
+    if ! isempty (terminal_default)
+      eval (sprintf ("gset terminal %s;", terminal_default));
+    endif
+    eval (sprintf ("gset terminal %s;", origterm));
+    replot;
+    
+    automatic_replot = _automatic_replot ;
+
+  end_unwind_protect
+
+  if !isempty(convertname)
+    command = [ "convert ", name, " ", convertname ];
+    [output, errcode] = system (command);
+    unlink (name);
+    if (errcode)
+      error ("print: could not convert");
+    endif
+  endif
+  if doprint
+    system(sprintf ("lpr %s %s", printer, printname));
+    unlink(printname);
+  endif
+  
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/quiver.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,95 @@
+## Copyright (C) 2000 John W. Eaton
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## usage: quiver (x, y, u, v)
+## usage: quiver (u, v)
+##
+## Plot the (u,v) components of a vector field in a (x,y) meshgrid.
+##
+## You can try:
+##
+##   a = b = 1:10;
+##   [x,y] = meshgrid(a,b);
+##   u = rand (10,10);
+##   v = rand (10,10);
+##   quiver(x,y,u,v)
+##
+## See also: plot, semilogx, semilogy, loglog, polar, mesh, contour,
+##           bar, stairs, gplot, gsplot, replot, xlabel, ylabel, title
+
+## Author: Roberto A. F. Almeida (roberto@calvin.ocfis.furg.br)
+## 2001-02-25 Paul Kienzle
+##     * change parameter order to correspond to matlab
+##     * allow vector x,y,  defaulting to 1:n, 1:m for mxn u
+##     * vectorize
+
+## TODO: use gnuplot 'vector' style instead of setting arrows one at a time
+function quiver (x, y, u, v)
+
+  if (nargin != 2 && nargin != 4)
+    usage ("quiver (x, y, u, v)");
+  endif
+
+  if (nargin == 2)
+    u = x; v = y; x = 1:columns(u); y= 1:rows(u);
+  endif
+
+  if (any(size(u)!=size(v)))
+    error ("quiver: u, v must have the same shape.");
+  endif
+
+  if is_vector(x) && is_vector(y)
+    [nr, nc] = size(u);
+    if (length(x) != nc || length(y) != nr)
+      error ("quiver: x, y vectors must have correct length");
+    endif
+    [x,y] = meshgrid(x,y);
+  endif
+
+  if (any (size(x) != size(u) | size(y) != size(u)))
+    error ("quiver: x, y must have the same shape as u, v");
+  endif
+
+
+  ## Calculating the grid limits.
+  
+  minx = min (min (x));
+  maxx = max (max (x));
+  miny = min (min (y));
+  maxy = max (max (y));
+  
+  max_arrow = max ( [max(max (u)) , max(max (v)) , ...
+		     abs(min (min (u))) , abs(min (min (v)))] );
+  border = max_arrow * 1.2;
+  
+  limits = [ minx - border, maxx + border, miny - border, maxy + border ];
+
+  axis (limits);
+  
+  
+  ## Ok, now plot the arrows.
+  
+  gset noarrow;
+  gplot 0 title "";
+  
+  command = sprintf ("gset arrow from %f,%f to %f,%f\n", \
+		     [ x(:)'; y(:)'; x(:)'+u(:)'; y(:)'+v(:)' ]);
+  eval ( [ "if 1\n", command, "\nendif" ] );
+  
+  replot;
+      
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/stem.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,79 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: stem(x, [,y] [, linetype])
+##
+## Draws struts for each point, overlaid on another line type. This is
+## just:
+##     plot(x, y, linetype, x, y, "^;;")
+## but with the pointsize increased so that you can see the symbols
+## clearly.  By default, linetype is "o;;" so that circles are
+## connected to the x-axis with struts.
+##
+## Note that a plot can only support one point size, so if you are
+## plotting multiple plots, do stem last to keep large points.
+##
+## Example
+##    t=0:0.1:2*pi; x=sin(t); idx=1:4:length(t);
+##    plot(t,x,"r-+;sin(x);"); hold on
+##    stem(t(idx), x(idx),"bo;struts;"); hold off
+
+function stem(x, y, linetype)
+  if nargin < 1 || nargin > 3
+    usage("stem(x [, y] [, linetype])");
+  endif
+  if nargin < 2, linetype=y=[]; endif
+  if nargin < 3, linetype=[]; endif
+  if isstr(y)
+    linetype = y;
+    y = [];
+  endif
+  if isempty(linetype), linetype="o;;"; endif
+
+  ## scan the linetype parameter to see if a colour has been specified
+  colour = '1'; title=0; ignoredigit=0;
+  for i=1:length(linetype)
+    if linetype(i) == ';'
+      title = 1-title;
+    elseif !title
+      if !isempty(findstr("rgbmcw",linetype(i)))
+	colour = linetype(i);
+	ignoredigit=1;
+      elseif !isempty(findstr("0123456789",linetype(i)))
+	if !ignoredigit, colour = linetype(i); endif
+	ignoredigit=1;
+      endif
+    endif
+  endfor
+
+  unwind_protect
+    eval(sprintf("gset pointsize %d",2-min(2,fix(length(x)/100))));
+    gset xzeroaxis
+    if isempty(y)
+      plot(x, linetype, x, [colour, "^;;"]);
+    else
+      plot(x, y, linetype, x, y, [colour, "^;;"]);
+    endif
+  unwind_protect_cleanup
+    gset pointsize 1
+    gset noxzeroaxis
+  end_unwind_protect
+endfunction
+
+%!demo
+%! t=0:0.1:2*pi; x=sin(t); idx=1:4:length(t);
+%! plot(t,x,"+r-;sin(x);"); hold on;
+%! stem(t(idx), x(idx),"bo;struts;"); hold off;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/surf.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,18 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+function surf(...)
+   mesh(all_va_args);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/surfc.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,18 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+function surfc(...)
+  meshc(all_va_args);
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/text.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,211 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## text(x,y[,z],'text','property',value,...)
+##    Add 'text' to the plot at position (x,y,z). 
+##
+## text('property',value,...)
+##    Property controls the features of the text:
+##    'HorizontalAlignment': value is 'left' (default), 'right' or 'center'
+##        where to locate the text relative to (x,y)
+##    'Units': value is 'data' (default), 'normalized' or 'screen'
+##        data uses the coordinate system of the axes.
+##        normalized uses x,y,z values in the range [0,1] for the axes.
+##        screen uses x,y values in the range [0,1] for the window/page.
+##            note that this only works if called after the last subplot.
+##    'Rotation' : value is degrees
+##    'FontName' : value is the name of the font (terminal dependent)
+##    'FontSize' : value is the size of the font (terminal dependent)
+##    'Position' : value is [x, y] or [x, y, z]
+##    'String': value is 'text'
+##
+## text();
+##    Clear all text from the plot (must be used before the next plot
+##    since the labels persist from plot to plot).
+##
+##
+## Example
+##    text(0.5,0.50,'Graph center',...
+##         'HorizontalAlignment','center','Units','normalized');
+##    plot(linspace(-pi,pi),linspace(0,e));
+
+## TODO: label property should be automatically cleared in plot
+## TODO:   if hold is not on.  Same for title, xlabel, ylable, etc.,
+## TODO:   so handle text in the same way, by requiring text with no
+## TODO:   to clear all the labels for the next graph.
+## TODO: several properties missing
+## TODO: permit text(blah,'units','screen') before subplot as well as after
+function text(...)
+  usage_str = "text(x,y[,z],'text', 'property',value...)";
+  if nargin == 0, gset nolabel; return; endif
+
+  position=[0, 0, 0];
+  text="";
+  rotate="norotate";
+  align="left";
+  fontname=fontsize=[];
+  units="first";
+
+  ## Process text(x,y[,z],'text') forms
+  va_start(); n=1;
+  arg = va_arg(); n=n+1;
+  if is_scalar(arg),
+    position(1) = arg;
+    if nargin < 2, usage(usage_str); endif
+    arg = va_arg(); n=n+1;
+    if !is_scalar(arg), usage(usage_str); endif
+    position(2) = arg;
+
+    if nargin < 3, usage(usage_str); endif
+    arg = va_arg(); n=n+1;
+    if isstr(arg)
+      text=arg;
+    else
+      position(3) = arg;
+      if nargin < 4, usage(usage_str); endif
+      text=va_arg(); n=n+1; 
+    endif
+    if !isstr(text), usage(usage_str); endif
+  endif
+
+  ## Process text('property',value) forms
+  if rem(nargin-n+1, 2) != 0, error(usage_str); endif
+  for i=n:2:nargin
+    prop=va_arg(); val=va_arg();
+    if !isstr(prop), error(usage_str); endif
+    prop = tolower(prop);
+    if strcmp(prop, "fontname"),
+      if !isstr(val), 
+	error("text 'FontName' expects a string"); endif
+      fontname = val;
+    elseif strcmp(prop, "fontsize"),
+      if !is_scalar(val), 
+	error("text 'FontSize' expects a scalar"); endif
+      fontsize = val;
+    elseif strcmp(prop, "horizontalalignment"),
+      if isstr(val), val=tolower(val); endif
+      if !isstr(val) || ...
+	    !(strcmp(val,"left")||strcmp(val,"right")||strcmp(val,"center"))
+	error("text 'HorizontalAlignment' expects 'right','left' or 'center'");
+      endif
+      align = val;
+    elseif strcmp(prop, "units")
+      if isstr(val), val=tolower(val); endif
+      if !isstr(val)
+	error("text 'Units' expects 'data' or 'normalized'");
+      elseif strcmp(val,"data")
+	units="first";
+      elseif strcmp(val,"normalized")
+	units="graph";
+      elseif strcmp(val,"screen")
+	units="screen";
+      else
+	warning(["text('Units','", val, "') ignored"]);
+      endif
+    elseif strcmp(prop, "position")
+      if is_vector(val) || !(length(val)>=2 && length(val)<=3)
+	error("text 'Position' expects vector of x,y and maybe z"); 
+      elseif length(val)==2, position=postpad(val,3);
+      else position = val;
+      endif
+    elseif strcmp(prop, "rotation")
+      if !is_scalar(val), error("text 'Rotation' expects scalar"); endif
+      if mod(val+45,180)<=90
+	rotate="norotate";
+      else
+	rotate="rotate";
+      endif
+    elseif strcmp(prop, "string")
+      if !isstr(val), error("text 'String' expects a string"); endif
+      text = val;
+    else
+      warning(["ignoring property ", prop]);
+    endif
+  endfor
+  if !isempty(fontname) || !isempty(fontsize)
+    font = sprintf(' font "%s,%d"', fontname, fontsize);
+  else
+    font = "";
+  endif
+  if position(3)!=0,
+    atstr = sprintf("%f,%f,%f", position(1),position(2),position(3));
+  else
+    atstr = sprintf("%f,%f", position(1),position(2));
+  endif
+  command = sprintf('gset label "%s" at %s %s %s %s%s',
+		    text, units, atstr, align, rotate, font);
+  eval(command);
+
+endfunction
+
+%!demo
+%! subplot(211);
+%! title("Data coordinates");
+%! text( 0,1,'bl');
+%! text( 5,1,'bc','HorizontalAlignment','center');
+%! text(10,1,'br','HorizontalAlignment','right');
+%! text( 0,5,'ml');
+%! text( 5,5,'mc','HorizontalAlignment','center');
+%! text(10,5,'mr','HorizontalAlignment','right');
+%! text( 0,9,'tl');
+%! text( 5,9,'tc','HorizontalAlignment','center');
+%! text(10,9,'tr','HorizontalAlignment','right');
+%! text( 2,4,'rotated','Rotation',90);
+%! plot(0:10,0:10,";;");
+%! text; title("");
+%!
+%! subplot(212);
+%! title("Normalized coordinates");
+%! text(0.0,0.05,'bl','Units','normalized');
+%! text(0.5,0.05,'bc','Units','normalized','HorizontalAlignment','center');
+%! text(1.0,0.05,'br','Units','normalized','HorizontalAlignment','right');
+%! text(0.0,0.50,'ml','Units','normalized');
+%! text(0.5,0.50,'mc','Units','normalized','HorizontalAlignment','center');
+%! text(1.0,0.50,'mr','Units','normalized','HorizontalAlignment','right');
+%! text(0.0,0.95,'tl','Units','normalized');
+%! text(0.5,0.95,'tc','Units','normalized','HorizontalAlignment','center');
+%! text(1.0,0.95,'tr','Units','normalized','HorizontalAlignment','right');
+%! text(0.2,0.40,'rotated','Rotation',90,'units','normalized');
+%! plot(linspace(-pi,pi),linspace(0,e),";;");
+%! text; title("");
+%! oneplot();
+%! %----------------------------------------------------------------
+%! % graph will show labels inserted at various points with various
+%! % justifications. b=bottom,m=middle,t=top,l=left,c=center,r=right
+%! % The rotated text will not show up as rotated on x11 gnuplot
+
+%!demo
+%! subplot(211); title("graph 1"); 
+%! plot(0:10,0:10,";;"); title("");
+%! subplot(212); title("graph 2"); 
+%! text(0.0,0.05,'bl','Units','screen');
+%! text(0.5,0.05,'bc','Units','screen','HorizontalAlignment','center');
+%! text(1.0,0.05,'br','Units','screen','HorizontalAlignment','right');
+%! text(0.0,0.50,'ml','Units','screen');
+%! text(0.5,0.50,'mc','Units','screen','HorizontalAlignment','center');
+%! text(1.0,0.50,'mr','Units','screen','HorizontalAlignment','right');
+%! text(0.0,0.95,'tl','Units','screen');
+%! text(0.5,0.95,'tc','Units','screen','HorizontalAlignment','center');
+%! text(1.0,0.95,'tr','Units','screen','HorizontalAlignment','right');
+%! text(0.2,0.40,'rotated','Rotation',90,'units','screen');
+%! plot(linspace(-pi,pi),linspace(0,e),";;"); title("");
+%! text;
+%! oneplot();
+%! %----------------------------------------------------------------
+%! % graph will show labels inserted at various points with various
+%! % justifications. b=bottom,m=middle,t=top,l=left,c=center,r=right
+%! % The rotated text will not show up as rotated on x11 gnuplot
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/plot/view.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,57 @@
+## Copyright (C) 1998 Ariel Tankus
+## 
+## This program is free software.
+## This file is part of the Image Processing Toolbox for Octave
+##
+## This program is free software; you can redistribute it and/or
+## modify it under the terms of the GNU General Public License
+## as published by the Free Software Foundation; either version 2
+## of the License, or (at your option) any later version.
+## 
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+## 
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+##
+
+## view    Change the viewing angle for a 3-D plot.
+##
+##         view(az, el)
+##         az - horizontal viewing angle (azimuth) [degrees].
+##         el - vertical viewing angle (elevation) [degrees].
+##
+
+## Author: Ariel Tankus <arielt@math.tau.ac.il>
+## Created: 14.8.98.
+## Version: 1.0
+
+function view(az, el)
+
+  ## azimuth is the same as rotation around the z-axis,
+  ## so gnuplot's z_axis == az.
+  az = rem(az, 360);                  # set az in range: [-360, 360].
+  az = az + 360*(az < 0);             # set az in range: [0, 360].
+
+  ## elevation:  0 deg - equator,     90 deg - north pole.
+  ## in gnuplot: 0 deg - north pole,  90 deg - equator.
+  rot_x = 90 - el;
+
+  ## elevation is in gnuplot coordinates
+
+  rot_x = rem(rot_x, 360);              # set rot_x in range: [-360, 360].
+  rot_x = rot_x + 360*(rot_x < 0);      # set rot_x in range: [0, 360].
+
+  if (rot_x > 180)
+    ## elevation greater than 180 degs is
+    az = rem(az + 180, 360);
+    rot_x = 360 - rot_x;
+  end
+
+  gset('view', num2str(rot_x), ',', num2str(az));
+  replot;
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/set/intersect.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,49 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} intersect(@var{a}, @var{b})
+##
+## Return the elements in both @var{a} and @var{b}, sorted in ascending
+## order. If @var{a} and @var{b} are both column vectors return a column
+## vector, otherwise return a row vector.
+##
+## @end deftypefn
+## @seealso{unique, union, setxor, setdiff, ismember}
+
+function c = intersect(a,b)
+  if ( nargin != 2 )
+    usage ("intersect (a, b)");
+  endif
+
+  if ( isempty (a) || isempty (b) )
+    c = [];
+  else
+
+    ## form a and b into sets
+    a = unique (a);
+    b = unique (b);
+    
+    ## keep duplicates
+    c = sort ([ a(:) ; b(:) ]);
+    n = length(c);
+    c = c (find (c(1:n-1) == c(2:n)));
+    if ( size (b, 1) == 1 || size (a, 1) == 1 )
+      c = c.';
+    endif
+
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/set/ismember.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,78 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} ismember(@var{A}, @var{S})
+##
+## Return a matrix the same shape as @var{A} which has 1 if
+## @code{A(i,j)} is in @var{S} or 0 if it isn't.
+##
+## @end deftypefn
+## @seealso{unique, union, intersect, setxor, setdiff}
+
+function c = ismember(a,S)
+  if nargin != 2
+    usage("ismember(A,S)");
+  endif
+
+  [ra, ca] = size(a);
+  if isempty(a) || isempty(S)
+    c = zeros(ra, ca);
+  else
+    S = unique(S(:));
+    lt = length(S);
+    if lt == 1
+      c = ( a == S );
+    elseif ra*ca == 1
+      c = any (a == S);
+    else
+      ## Magic : the following code determines for each a, the index i
+      ## such that S(i)<= a < S(i+1).  It does this by sorting the a
+      ## into S and remembering the source index where each element came
+      ## from.  Since all the a's originally came after all the S's, if 
+      ## the source index is less than the length of S, then the element
+      ## came from S.  We can then do a cumulative sum on the indices to
+      ## figure out which element of S each a comes after.
+      ## E.g., S=[2 4 6], a=[1 2 3 4 5 6 7]
+      ##    unsorted [S a]  = [ 2 4 6 1 2 3 4 5 6 7 ]
+      ##    sorted [ S a ]  = [ 1 2 2 3 4 4 5 6 6 7 ] 
+      ##    source index p  = [ 4 1 5 6 2 7 8 3 9 10 ]
+      ##    boolean p<=l(S) = [ 0 1 0 0 1 0 0 1 0 0 ]
+      ##    cumsum(p<=l(S)) = [ 0 1 1 1 2 2 2 3 3 3 ]
+      ## Note that this leaves a(1) coming after S(0) which doesn't
+      ## exist.  So arbitrarily, we will dump all elements less than
+      ## S(1) into the interval after S(1).  We do this by dropping S(1)
+      ## from the sort!  E.g., S=[2 4 6], a=[1 2 3 4 5 6 7]
+      ##    unsorted [S(2:3) a] =[4 6 1 2 3 4 5 6 7 ]
+      ##    sorted [S(2:3) a] = [ 1 2 3 4 4 5 6 6 7 ]
+      ##    source index p    = [ 3 4 5 1 6 7 2 8 9 ]
+      ##    boolean p<=l(S)-1 = [ 0 0 0 1 0 0 1 0 0 ]
+      ##    cumsum(p<=l(S)-1) = [ 0 0 0 1 1 1 2 2 2 ]
+      ## Now we can use Octave's lvalue indexing to "invert" the sort,
+      ## and assign all these indices back to the appropriate A and S,
+      ## giving S_idx = [ -- 1 2], a_idx = [ 0 0 0 1 1 2 2 ].  Add 1 to
+      ## a_idx, and we know which interval S(i) contains a.  It is
+      ## easy to now check membership by comparing S(a_idx) == a.  This
+      ## magic works because S starts out sorted, and because sort
+      ## preserves the relative order of identical elements.
+      [v, p] = sort ( [ S(2:lt) ; a(:) ] );
+      idx(p) = cumsum (p <= lt-1) + 1;
+      idx = idx (lt : lt+ra*ca-1);
+      c = ( a == reshape (S (idx), size (a)) );
+    endif
+  endif
+endfunction
+  
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/set/setdiff.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,46 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} setdiff(@var{a}, @var{b})
+##
+## Return the elements in @var{a} but not in @var{b}, sorted in ascending
+## order. If @var{a} and @var{b} are both column vectors return a column
+## vector, otherwise return a row vector.
+##
+## @end deftypefn
+## @seealso{unique, union, intersect, setxor, ismember}
+
+function c = setdiff(a,b)
+  if nargin != 2
+    usage("setdiff(a,b)");
+  endif
+
+  c = unique(a);
+  if !isempty(c) && !isempty(b)
+    ## form a and b into combined set
+    b = unique(b);
+    [dummy, idx] = sort([ c(:) ; b(:)]);
+    ## eliminate those elements of a that are the same as in b
+    n = length(dummy);
+    c(idx(find(dummy(1:n-1) == dummy(2:n)))) = [];
+    ## reshape if necessary
+    if ( size(c,1) != 1 && size(b,1) == 1 )
+      c = c.';
+    endif
+  endif
+endfunction
+  
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/set/setxor.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,53 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} setxor(@var{a}, @var{b})
+##
+## Return the elements exclusive to @var{a} or @var{b}, sorted in ascending
+## order. If @var{a} and @var{b} are both column vectors return a column
+## vector, otherwise return a row vector.
+##
+## @end deftypefn
+## @seealso{unique, union, intersect, setdiff, ismember}
+
+function c = setxor(a,b)
+  if nargin != 2
+    usage("setxor(a,b)");
+  endif
+
+  ## form a and b into sets
+  a = unique(a);
+  b = unique(b);
+
+  if isempty(a)
+    c = b;
+  elseif isempty(b)
+    c = a;
+  else
+    ## reject duplicates
+    c = sort([a(:) ; b(:)]);
+    n = length(c);
+    idx = find(c(1:n-1) == c(2:n));
+    if !isempty(idx)
+      c([idx, idx+1]) = [];
+    endif
+    if size(a,1) == 1 ||  size(b,1) == 1
+      c = c.';
+    endif
+  endif
+endfunction
+  
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/set/union.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,45 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} union(@var{a}, @var{b})
+##
+## Return the elements in both @var{a} and @var{b}, sorted in ascending
+## order. If @var{a} and @var{b} are both column vectors return a column
+## vector, otherwise return a row vector.
+##
+## @end deftypefn
+## @seealso{unique, intersect, setdiff, setxor, ismember}
+
+function c = union(a,b)
+  if nargin != 2
+    usage("union(a,b)");
+  endif
+
+  if isempty(a)
+    c = unique(b);
+  elseif isempty(b)
+    c = unique(a);
+  else
+    ## concatenate the two sets (even if they have a different shape)
+    c = unique([a(:) ; b(:)]);
+    if size(a,1) == 1 || size(b,1) == 1
+      c = c.';
+    endif
+
+  endif
+endfunction
+  
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/set/unique.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,82 @@
+## Copyright (C) 2000-2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} unique (@var{x})
+##
+## Return the unique elements of @var{x}, sorted in ascending order.
+## If @var{x} is a row vector, return a row vector, but if @var{x}
+## is a column vector or a matrix return a column vector.
+##
+## @deftypefnx {Function File} {} unique (@var{A}, 'rows')
+##
+## Return the unique rows of @var{A}, sorted in ascending order.
+##
+## @deftypefnx {Function File} {[@var{y}, @var{i}, @var{j}] = } unique (@var{x})
+##
+## Return index vectors @var{i} and @var{j} such that @code{x(i)==y} and
+## @code{y(i)==x}.
+##
+## @end deftypefn
+## @seealso{union, intersect, setdiff, setxor, ismember}
+
+function [y, i, j] = unique (x, r)
+
+  if ( nargin < 1 || nargin > 2 || (nargin == 2 && !strcmp(r,"rows")) )
+    usage ("unique (x) or unique (x, 'rows')");
+  endif
+
+  if (nargin == 1)
+    n = prod(size(x));
+  else
+    n = rows(x);
+  endif
+
+  y = x; 
+  if (n < 1)
+    i = j = [];
+    return
+  elseif (n < 2)
+    i = j = 1;
+    return
+  endif
+
+  if isstr(x), y = toascii(y); endif
+
+  if nargin == 2
+    [y, i] = sortrows(y);
+    match = all( [ y(1:n-1,:) == y(2:n,:) ]' );
+    idx = find (match);
+    y (idx, :) = [];
+  else
+    if (rows(y) != 1) y = y(:); endif
+    [y, i] = sort(y);
+    match = [ y(1:n-1) == y(2:n) ];
+    idx = find (match);
+    y (idx) = [];
+  endif
+
+  ## I don't know why anyone would need reverse indices, but it
+  ## was an interesting challenge.  I welcome cleaner solutions.
+  if (nargout >= 3)
+    j = i;
+    j (i) = cumsum ( prepad ( ~match, n, 1 ) );
+  endif
+  i (idx) = [];
+
+  if isstr(x), y = setstr(y); endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,6 @@
+include ../../Makeconf
+
+all: remez.oct medfilt1.oct
+
+clean:
+	$(RM) *.oct *.o core octave-core *~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/__power.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,83 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage:  [P, w] = __power (b, a, [, nfft [, Fs]] [, range] [, units])
+## 
+## Plot the power spectrum of the given filter.
+##
+## b, a: filter coefficients (b=numerator, a=denominator)
+## nfft is number of points at which to sample the power spectrum
+## Fs is the sampling frequency of x
+## range is 'half' (default) or 'whole'
+## units is  'squared' or 'db' (default)
+## range and units may be specified any time after the filter, in either
+## order
+##
+## Returns P, the magnitude vector, and w, the frequencies at which it
+## is sampled.  If there are no return values requested, then plot the power
+## spectrum and don't return anything.
+
+## TODO: consider folding this into freqz --- just one more parameter to
+## TODO:    distinguish between 'linear', 'log', 'logsquared' and 'squared'
+
+function [...] = __power (b, a, ...)
+  usagestr = "[P w] = __power(b, a [,nfft [,Fs]] [,range] [, units])";
+  if (nargin < 2 || nargin > 6) usage(usagestr); endif
+
+  nfft = [];
+  Fs = [];
+  range = [];
+  units = [];
+
+  pos = 0;
+  va_start();
+  for i=3:nargin
+    arg = va_arg();
+    if strcmp(arg, 'squared') || strcmp(arg, 'db')
+      units = arg;
+    elseif strcmp(arg, 'whole') || strcmp(arg, 'half')
+      range = arg;
+    elseif isstr(arg)
+      usage(usagestr);
+    elseif pos == 0
+      nfft = arg;
+      pos++;
+    elseif pos == 1
+      Fs = arg;
+      pos++;
+    else
+      usage(usagestr);
+    endif
+  endfor
+  
+  if isempty(nfft); nfft = 256; endif
+  if isempty(Fs); Fs = 2; endif
+  if isempty(range) range = 'half'; endif
+  
+  [P, w] = freqz(b, a, nfft, range, Fs);
+
+  if strcmp(units, 'squared') 
+    P = abs(P).^2;
+  else
+    P = 20.0*log10(abs(P));
+  endif
+
+  if nargout == 0, plot(w, P, ";;"); endif
+  if nargout >= 1, vr_val(P); endif
+  if nargout >= 2, vr_val(w); endif
+
+endfunction
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/arburg.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,114 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+
+## usage:  [a, v, k] = arburg (x, p)
+## 
+## fits an AR (p)-model using Burg method (a so called maximum entropy model).
+## x = data vector to estimate
+## a: AR coefficients
+## v: variance of white noise
+## k: reflection coeffients for use in lattice filter 
+##
+## The power spectrum of the resulting filter can be plotted with
+## pburg(x, p), or you can plot it directly with power(sqrt(v), a).
+##
+## Example
+##   ## Target system
+##   pw=[0.2, 0.4, 0.45, 0.95];   # pole angle (nyquist freq. is 1.0)
+##   pr=[0.98, 0.98, 0.98, 0.96]; # pole distance (0.0<=x<1.0)
+##   sys_a = real(poly([pr, pr].*exp(1i*pi*[pw, -pw])));
+##   order = 2*length(pw);
+##   ## Filter impulse+random gaussian noise to produce signal
+##   n = 1024;
+##   s = [1 ; 0.1*randn(n-1,1)];
+##   x = filter(1,sys_a,s); % AR system output
+##   ## Determine system from signal
+##   [a, v] = arburg(x, order);
+##   ## Plot magnitude response of signal and matched system
+##   figure(0);
+##   mag = abs(fft(x))/sqrt(n);
+##   [h, w] = freqz(sqrt(v), a, [], 2);
+##   semilogy(2*[0:n/2-1]/n,mag(1:(n/2)),'1;spectrum;');
+##   hold on;
+##   semilogy(w,abs(h),sprintf('2;order %d burg;', order));
+##   hold off;
+##   ## Plot zero-pole graph of target system and matched system
+##   figure(1); 
+##   axis("square"); gset pointsize 2; grid;
+##   r = exp(2i*pi*[0:100]/100); plot(real(r), imag(r), "0;;");
+##   hold on;
+##   r = roots(sys_a); plot(real(r), imag(r), "1x;system;");
+##   r = roots(a); plot(real(r), imag(r), "2x;arburg;");
+##   hold off;
+##   axis("normal"); gset pointsize 1; grid('off');
+##
+## See also:
+## pburg, power, freqz, impz for measuring the characteristics 
+##    of the resulting filter
+## aryule for alternative spectral estimators
+##
+## Note: Orphanidis '85 claims lattice filters are more tolerant of 
+## truncation errors, which is why you might want to use them.  However,
+## lacking a lattice filter processor, I haven't tested that the lattice
+## filter coefficients are reasonable.
+##
+## Algorithm derived from:
+##    Sophocles J. Orfanidis (1985).
+##    Optimum signal processing: An introduction.
+##    New York: Macmillan.
+
+function [a, v, k] = arburg (x, p)
+
+  if (nargin != 2) usage("[a, v, k] = arburg(x,p)"); end
+
+  k = zeros(1,p);
+  n = length(x);
+  v = sumsq(x);
+
+  ## f and b are the forward and backward error sequences
+  f = x(2:n);
+  b = x(1:n-1);
+
+  ## remaining stages i=2 to p
+  for i=1:p
+
+    ## get the i-th reflection coefficient
+    g = 2 * sum(f.*b)/(sumsq(f)+sumsq(b));
+    k(i) = g;
+
+    ## generate next filter order
+    if i==1
+      a = [ g ] ;
+    else
+      a = [ g, a-g*a(i-1:-1:1) ];
+    endif
+
+    ## keep track of the error
+    v = v*(1-g^2);
+
+    ## update the prediction error sequences
+    oldf = f;
+    f = oldf(2:n-i) - g*b(2:n-i);
+    b = b(1:n-i-1) - g*oldf(1:n-i-1);
+
+  endfor
+  a = [ 1, -a(p:-1:1) ] ;
+
+endfunction
+
+%!demo
+%! % use demo('pburg');
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/aryule.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,58 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+
+## usage:  [a, v, k] = aryule (x, p)
+## 
+## fits an AR (p)-model with Yule-Walker estimates.
+## x = data vector to estimate
+## a: AR coefficients
+## v: variance of white noise
+## k: reflection coeffients for use in lattice filter 
+##
+## The power spectrum of the resulting filter can be plotted with
+## pyulear(x, p), or you can plot it directly with power(sqrt(v), a).
+##
+## See also:
+## pyulear, power, freqz, impz for measuring the characteristics 
+##    of the resulting
+## arburg for alternative spectral estimators
+##
+## Example: Use example from arburg, but substitute aryule for arburg.
+##
+## Note: Orphanidis '85 claims lattice filters are more tolerant of 
+## truncation errors, which is why you might want to use them.  However,
+## lacking a lattice filter processor, I haven't tested that the lattice
+## filter coefficients are reasonable.
+
+
+function [a, v, k] = aryule (x, p)
+
+  if (nargin != 2) usage("[a, v, k] = aryule(x,p)"); end
+
+  c = xcorr(x, p+1, 'unbiased');
+  c(1:p+1) = [];
+  if nargout == 1
+    a = levinson(c, p);
+  elseif nargout == 2
+    [a, v] = levinson(c, p);
+  else
+    [a, v, k] = levinson(c, p);
+  endif
+endfunction
+
+%!demo
+%! % use demo('pyulear')
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/bilinear.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,103 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T)
+##        [Zb, Za] = bilinear(Sb, Sa, T)
+##
+## Transform a s-plane filter specification into a z-plane
+## specification. Filters can be specified in either zero-pole-gain or
+## transfer function form. The input form does not have to match the
+## output form. T is the sampling frequency represented in the z plane.
+##
+## Theory: Given a piecewise flat filter design, you can transform it
+## from the s-plane to the z-plane while maintaining the band edges by
+## means of the bilinear transform.  This maps the left hand side of the
+## s-plane into the interior of the unit circle.  The mapping is highly
+## non-linear, so you must design your filter with band edges in the
+## s-plane positioned at 2/T tan(w*T/2) so that they will be positioned
+## at w after the bilinear transform is complete.
+##
+## The following table summarizes the transformation:
+##
+## Transform         Zero at x                  Pole at x
+## ----------------  -------------------------  ------------------------
+## Bilinear          zero: (2+xT)/(2-xT)        pole: (2+xT)/(2-xT)
+##      2 z-1        pole: -1                   zero: -1
+## S -> - ---        gain: (2-xT)/T             gain: (2-xT)/T
+##      T z+1
+## ----------------  -------------------------  ------------------------
+##
+## With tedious algebra, you can derive the above formulae yourself by
+## substituting the transform for S into H(S)=S-x for a zero at x or
+## H(S)=1/(S-x) for a pole at x, and converting the result into the
+## form:
+##
+##    H(Z)=g prod(Z-Xi)/prod(Z-Xj)
+##
+## Please note that a pole and a zero at the same place exactly cancel.
+## This is significant since the bilinear transform creates numerous
+## extra poles and zeros, most of which cancel. Those which do not
+## cancel have a "fill-in" effect, extending the shorter of the sets to
+## have the same number of as the longer of the sets of poles and zeros
+## (or at least split the difference in the case of the band pass
+## filter). There may be other opportunistic cancellations but I will
+## not check for them.
+##
+## Also note that any pole on the unit circle or beyond will result in
+## an unstable filter.  Because of cancellation, this will only happen
+## if the number of poles is smaller than the number of zeros.  The
+## analytic design methods all yield more poles than zeros, so this will
+## not be a problem.
+##
+## References:
+##
+## Proakis & Manolakis (1992). Digital Signal Processing. New York:
+## Macmillan Publishing Company.
+
+## Author: pkienzle@cs.indiana.edu
+
+function [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T)
+
+  if nargin==3
+    T = Sg;
+    [Sz, Sp, Sg] = tf2zp(Sz, Sp);
+  elseif nargin!=4
+    usage("[Zz, Zp, Zg]=bilinear(Sz,Sp,Sg,T) or [Zb, Za]=blinear(Sb,Sa,T)");
+  end;
+
+  p = length(Sp);
+  z = length(Sz);
+  if z > p || p==0
+    error("bilinear: must have at least as many poles as zeros in s-plane");
+  end
+
+## ----------------  -------------------------  ------------------------
+## Bilinear          zero: (2+xT)/(2-xT)        pole: (2+xT)/(2-xT)
+##      2 z-1        pole: -1                   zero: -1
+## S -> - ---        gain: (2-xT)/T             gain: (2-xT)/T
+##      T z+1
+## ----------------  -------------------------  ------------------------
+  Zg = real(Sg * prod((2-Sz*T)/T) / prod((2-Sp*T)/T));
+  Zp = (2+Sp*T)./(2-Sp*T);
+  if isempty(Sz)
+    Zz = -ones(size(Zp));
+  else
+    Zz = [(2+Sz*T)./(2-Sz*T)];
+    Zz = postpad(Zz, p, -1);
+  end
+
+  if nargout==2, [Zz, Zp] = zp2tf(Zz, Zp, Zg); endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/boxcar.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,33 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage:  w = boxcar (n)
+##
+## Returns the filter coefficients of a rectangular window of length n.
+
+function w = boxcar (n)
+  
+  if (nargin != 1)
+    usage ("w = boxcar(n)");
+  endif
+  
+  if !is_scalar(n) || n != floor(n) || n <= 0
+    error ("boxcar:  n must be an integer > 0");
+  endif
+
+  w = ones(n, 1);
+  
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/butter.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,88 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Generate a butterworth filter.
+## 
+## [b,a] = butter(n, Wc)
+##    low pass filter with cutoff pi*Wc radians
+##
+## [b,a] = butter(n, Wc, 'high')
+##    high pass filter with cutoff pi*Wc radians
+##
+## [b,a] = butter(n, [Wl, Wh])
+##    band pass filter with edges pi*Wl and pi*Wh radians
+##
+## [b,a] = butter(n, [Wl, Wh], 'stop')
+##    band reject filter with edges pi*Wl and pi*Wh radians
+##
+## [z,p,g] = butter(...)
+##    return filter as zero-pole-gain rather than coefficients of the
+##    numerator and denominator polynomials.
+## 
+## References: 
+##
+## Proakis & Manolakis (1992). Digital Signal Processing. New York:
+## Macmillan Publishing Company.
+
+## Author: pkienzle@cs.indiana.edu
+
+function [Zz, Zp, Zg] = butter(n, W, stype)
+
+  if (nargin>3 || nargin<2) || (nargout>3 || nargout<2)
+    usage ("[b, a] or [z, p, g] = butter (n, W, [, 'ftype'])");
+  end
+
+  ## interpret the input parameters
+  if (!(length(n)==1 && n == round(n) && n > 0))
+    error ("butter: filter order n must be a positive integer");
+  end
+
+  stop = nargin==3;
+  if stop && !(strcmp(stype, 'high') || strcmp(stype, 'stop'))
+    error ("butter: ftype must be 'high' or 'stop'");
+  end
+
+  [r, c]=size(W);
+  if (!(length(W)<=2 && (r==1 || c==1)))
+    error ("butter: frequency must be given as w0 or [w0, w1]");
+  elseif (!all(W >= 0 & W <= 1))
+    error ("butter: critical frequencies must be in (0 1)");
+  elseif (!(length(W)==1 || length(W) == 2))
+    error ("butter: only one filter band allowed");
+  elseif (length(W)==2 && !(W(1) < W(2)))
+    error ("butter: first band edge must be smaller than second");
+  endif
+
+  ## Prewarp to the band edges to s plane
+  T = 2;       # sampling frequency of 2 Hz
+  Ws = 2/T*tan(pi*W/T);
+
+  ## Generate splane poles for the prototype butterworth filter
+  ## source: Kuc
+  C = 1; # default cutoff frequency
+  Sp = C*exp(1i*pi*(2*[1:n] + n - 1)/(2*n));
+  Sz = [];
+  Sg = C^n;
+
+  ## splane frequency transform
+  [Sz, Sp, Sg] = sftrans(Sz, Sp, Sg, Ws, stop);
+
+  ## Use bilinear transform to convert poles to the z plane
+  [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T);
+
+  if nargout==2, [Zz, Zp] = zp2tf(Zz, Zp, Zg); endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/buttord.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,88 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Compute butterworth filter order and cutoff for the desired response
+## characteristics. Rp is the allowable decibels of ripple in the pass 
+## band. Rs is the minimum attenuation in the stop band.
+##
+## [n, Wc] = buttord(Wp, Ws, Rp, Rs)
+##     Low pass (Wp<Ws) or high pass (Wp>Ws) filter design.  Wp is the
+##     pass band edge and Ws is the stop band edge.  Frequencies are
+##     normalized to [0,1], corresponding to the range [0,Fs/2].
+## 
+## [n, Wc] = buttord([Wp1, Wp2], [Ws1, Ws2], Rp, Rs)
+##     Band pass (Ws1<Wp1<Wp2<Ws2) or band reject (Wp1<Ws1<Ws2<Wp2)
+##     filter design. Wp gives the edges of the pass band, and Ws gives
+##     the edges of the stop band.
+##
+## Theory: |H(W)|^2 = 1/[1+(W/Wc)^(2N)] = 10^(-R/10)
+## With some algebra, you can solve simultaneously for Wc and N given
+## Ws,Rs and Wp,Rp.  For high pass filters, subtracting the band edges
+## from Fs/2, performing the test, and swapping the resulting Wc back
+## works beautifully.  For bandpass and bandstop filters this process
+## significantly overdesigns.  Artificially dividing N by 2 in this case
+## helps a lot, but it still overdesigns.
+##
+## See also: butter
+
+function [n, Wc] = buttord(Wp, Ws, Rp, Rs)
+  if nargin != 4
+    usage("[n, Wn] = buttord(Wp, Ws, Rp, Rs)");
+  end
+  if length(Wp) != length(Ws)
+    error("buttord: Wp and Ws must have the same length");
+  end
+  if length(Wp) != 1 && length(Wp) != 2
+    error("buttord: Wp,Ws must have length 1 or 2");
+  end
+  if length(Wp) == 2 
+    && (all(Wp>Ws) || all(Ws>Wp) || diff(Wp)<=0 || diff(Ws)<=0)
+    error("buttord: Wp(1)<Ws(1)<Ws(2)<Wp(2) or Ws(1)<Wp(1)<Wp(2)<Ws(2)");
+  end
+
+  if length(Wp) == 2
+    warning("buttord: seems to overdesign bandpass and bandreject filters");
+  end
+
+  T = 2;
+  
+  ## if high pass, reverse the sense of the test
+  stop = find(Wp > Ws);
+  Wp(stop) = 1-Wp(stop); # stop will be at most length 1, so no need to
+  Ws(stop) = 1-Ws(stop); # subtract from ones(1,length(stop))
+  
+  ## warp the target frequencies according to the bilinear transform
+  Ws = (2/T)*tan(pi*Ws./T);
+  Wp = (2/T)*tan(pi*Wp./T);
+  
+  ## compute minimum n which satisfies all band edge conditions
+  ## the factor 1/length(Wp) is an artificial correction for the
+  ## band pass/stop case, which otherwise significantly overdesigns.
+  qs = log(10^(Rs/10) - 1);
+  qp = log(10^(Rp/10) - 1);
+  n = ceil(max(0.5*(qs - qp)./log(Ws./Wp))/length(Wp));
+
+  ## compute -3dB cutoff given Wp, Rp and n
+  Wc = exp(log(Wp) - qp/2/n);
+
+  ## unwarp the returned frequency
+  Wc = atan(T/2*Wc)*T/pi;
+  
+  ## if high pass, reverse the sense of the test
+  Wc(stop) = 1-Wc(stop);
+    
+endfunction
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/cceps.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,76 @@
+## Copyright (C) 1994 Dept of Probability Theory and Statistics TU Wien
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage:  cceps (x [, correct])
+##
+## Returns the complex cepstrum of the vector x.
+## If the optional argument correct has the value 1, a correction
+## method is applied.  The default is not to do this.
+
+## Author: AW (Andreas.Weingessel@ci.tuwien.ac.at) on Apr 1, 1994
+## Last modifified by AW on Nov 8, 1994
+  
+function cep = cceps (x, c)
+
+  if (nargin == 1)
+    c = 0;
+  elseif (nargin != 2)
+    error ("usage: cceps (x [, correct])");
+  endif
+
+  [nr, nc] = size (x);
+  if (nc != 1)
+    if (nr == 1)
+      x = x';
+      nr = nc;
+    else
+      error ("cceps: x must be a vector");
+    endif
+  endif
+
+  bad_signal_message = ["cceps:  bad signal x, ", ...
+      "some Fourier coefficients are zero."];
+  
+  F = fft (x);
+  if (min (abs (F)) == 0)
+    error (bad_signal_message);
+  endif
+
+  # determine if correction necessary
+  half = fix (nr / 2);
+  cor = 0;
+  if (2 * half == nr)
+    cor = (c && (real (F (half + 1)) < 0));
+    if (cor)
+      F = fft (x(1:nr-1))
+      if (min (abs (F)) == 0)
+	error (bad_signal_message);
+      endif
+    endif
+  endif
+
+  cep = fftshift (ifft (log (F)));
+
+  # make result real
+  if (c)
+    cep = real (cep);
+    if (cor)      
+      # make cepstrum of same length as input vector
+      cep (nr) = 0;
+    endif
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/cheb1ord.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,149 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+##
+## Completed by: Laurent S. Mazet
+
+## Compute chebyshev type I filter order and cutoff for the desired response
+## characteristics. Rp is the allowable decibels of ripple in the pass 
+## band. Rs is the minimum attenuation in the stop band.
+##
+## [n, Wc] = cheb1ord(Wp, Ws, Rp, Rs)
+##     Low pass (Wp<Ws) or high pass (Wp>Ws) filter design.  Wp is the
+##     pass band edge and Ws is the stop band edge.  Frequencies are
+##     normalized to [0,1], corresponding to the range [0,Fs/2].
+## 
+## [n, Wc] = cheb1ord([Wp1, Wp2], [Ws1, Ws2], Rp, Rs)
+##     Band pass (Ws1<Wp1<Wp2<Ws2) or band reject (Wp1<Ws1<Ws2<Wp2)
+##     filter design. Wp gives the edges of the pass band, and Ws gives
+##     the edges of the stop band.
+##
+## See also: cheby1
+
+function [n, Wc] = cheb1ord(Wp, Ws, Rp, Rs)
+
+  if nargin != 4
+    usage("[n, Wn] = cheb1ord(Wp, Ws, Rp, Rs)");
+  elseif length(Wp) != length(Ws)
+    error("cheb1ord: Wp and Ws must have the same length");
+  elseif length(Wp) != 1 && length(Wp) != 2
+    error("cheb1ord: Wp,Ws must have length 1 or 2");
+  elseif length(Wp) == 2 && ...
+	(all(Wp>Ws) || all(Ws>Wp) || diff(Wp)<=0 || diff(Ws)<=0)
+    error("cheb1ord: Wp(1)<Ws(1)<Ws(2)<Wp(2) or Ws(1)<Wp(1)<Wp(2)<Ws(2)");
+  end
+
+  T = 2;
+
+  ## returned frequency is the same as the input frequency
+  Wc = Wp;
+
+  ## warp the target frequencies according to the bilinear transform
+  Ws = (2/T)*tan(pi*Ws./T);
+  Wp = (2/T)*tan(pi*Wp./T);
+
+  if (Wp(1) < Ws(1))
+    ## low pass
+    if (length(Wp) == 1)
+      Wa = Ws/Wp;
+    else
+      ## band reject
+      error ("band reject is not implement yet.");
+    endif;
+  else
+   ## if high pass, reverse the sense of the test
+   if (length(Wp) == 1)
+      Wa = Wp/Ws;
+    else
+      ## band pass 
+      Wa=(Ws.^2 - Wp(1)*Wp(2))./(Ws*(Wp(1)-Wp(2)));
+    endif;
+  endif;
+  Wa = min(abs(Wa));
+  
+  ## compute minimum n which satisfies all band edge conditions
+  stop_atten = 10^(abs(Rs)/10);
+  pass_atten = 10^(abs(Rp)/10);
+  n = ceil(acosh(sqrt((stop_atten-1)/(pass_atten-1)))/acosh(Wa));
+
+endfunction
+
+%!demo
+%! Fs = 10000; 
+%! [n, Wc] = cheb1ord (1000/(Fs/2), 1200/(Fs/2), 0.5, 29);
+%!
+%! subplot (221);
+%! axis ([ 0, 1500, -1, 0]);
+%! title("Pass band Wp=1000 Rp=0.5");
+%! xlabel("Frequency (Hz)");
+%! ylabel("Attenuation (dB)");
+%! grid;
+%! plot ([0, 1000, 1000, 0, 0], [0, 0, -0.5, -0.5, 0], ";;");
+%! hold on;
+%! [b, a] = cheby1 (n, 0.5, Wc);
+%! [h, w] = freqz (b, a, [], Fs);
+%! plot (w, 20*log10(abs(h)), ";;");
+%! hold off;
+%!
+%! subplot (222);
+%! axis ([ 0, Fs/2, -250, 0]);
+%! title("Stop band Ws=1200 Rs=29");
+%! xlabel("Frequency (Hz)");
+%! ylabel("Attenuation (dB)");
+%! grid;
+%! plot ([1200, Fs/2, Fs/2, 1200, 1200], [-29, -29, -500, -500, -29], ";;");
+%! hold on;
+%! [b, a] = cheby1 (n, 0.5, Wc);
+%! [h, w] = freqz (b, a, [], Fs);
+%! plot (w, 20*log10(abs(h)), ";;");
+%! hold off;
+%!
+%! subplot (223);
+%! axis ([ 990, 1010, -0.6, -0.4]);
+%! title("Pass band detail Wp=1000 Rp=0.5");
+%! xlabel("Frequency (Hz)");
+%! ylabel("Attenuation (dB)");
+%! grid;
+%! plot ([0, 1000, 1000, 0, 0], [0, 0, -0.5, -0.5, 0], ";;");
+%! hold on;
+%! [b, a] = cheby1 (n, 0.5, Wc);
+%! [h, w] = freqz (b, a, [990:1010], Fs);
+%! plot (w, 20*log10(abs(h)), ";filter n;");
+%! [b, a] = cheby1 (n-1, 0.5, Wc);
+%! [h, w] = freqz (b, a, [990:1010], Fs);
+%! plot (w, 20*log10(abs(h)), ";filter n-1;");
+%! [b, a] = cheby1 (n+1, 0.5, Wc);
+%! [h, w] = freqz (b, a, [990:1010], Fs);
+%! plot (w, 20*log10(abs(h)), ";filter n+1;");
+%! hold off;
+%!
+%! subplot (224);
+%! axis ([ 1190, 1210, -40, -20]);
+%! title("Stop band detail Wp=1200 Rp=29");
+%! xlabel("Frequency (Hz)");
+%! ylabel("Attenuation (dB)");
+%! grid;
+%! plot ([1200, Fs/2, Fs/2, 1200, 1200], [-29, -29, -500, -500, -29], ";;");
+%! hold on;
+%! [b, a] = cheby1 (n, 0.5, Wc);
+%! [h, w] = freqz (b, a, [1190:1210], Fs);
+%! plot (w, 20*log10(abs(h)), ";filter n;");
+%! [b, a] = cheby1 (n-1, 0.5, Wc);
+%! [h, w] = freqz (b, a, [1190:1210], Fs);
+%! plot (w, 20*log10(abs(h)), ";filter n-1;");
+%! [b, a] = cheby1 (n+1, 0.5, Wc);
+%! [h, w] = freqz (b, a, [1190:1210], Fs);
+%! plot (w, 20*log10(abs(h)), ";filter n+1;");
+%! hold off;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/cheb2ord.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,151 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Compute chebyshev type II filter order and cutoff for the desired response
+## characteristics. Rp is the allowable decibels of ripple in the pass 
+## band. Rs is the minimum attenuation in the stop band.
+##
+## [n, Wc] = cheb2ord(Wp, Ws, Rp, Rs)
+##     Low pass (Wp<Ws) or high pass (Wp>Ws) filter design.  Wp is the
+##     pass band edge and Ws is the stop band edge.  Frequencies are
+##     normalized to [0,1], corresponding to the range [0,Fs/2].
+## 
+## [n, Wc] = cheb2ord([Wp1, Wp2], [Ws1, Ws2], Rp, Rs)
+##     Band pass (Ws1<Wp1<Wp2<Ws2) or band reject (Wp1<Ws1<Ws2<Wp2)
+##     filter design. Wp gives the edges of the pass band, and Ws gives
+##     the edges of the stop band.
+##
+## Theory: 
+##
+## See also: cheby2
+
+function [n, Wc] = cheb2ord(Wp, Ws, Rp, Rs)
+
+  error("cheb2ord: not implemented yet");
+
+  if nargin != 4
+    usage("[n, Wn] = cheb2ord(Wp, Ws, Rp, Rs)");
+  elseif length(Wp) != length(Ws)
+    error("cheb2ord: Wp and Ws must have the same length");
+  elseif length(Wp) != 1 && length(Wp) != 2
+    error("cheb2ord: Wp,Ws must have length 1 or 2");
+  elseif length(Wp) == 2 && ...
+    	(all(Wp>Ws) || all(Ws>Wp) || diff(Wp)<=0 || diff(Ws)<=0)
+    error("cheb2ord: Wp(1)<Ws(1)<Ws(2)<Wp(2) or Ws(1)<Wp(1)<Wp(2)<Ws(2)");
+  end
+
+  T = 2;
+
+  ## returned frequency is the same as the input frequency
+  Wc = Ws;
+
+  ## warp the target frequencies according to the bilinear transform
+  Ws = (2/T)*tan(pi*Ws./T);
+  Wp = (2/T)*tan(pi*Wp./T);
+
+  if (Wp(1) < Ws(1))
+    ## low pass
+    if (length(Wp) == 1)
+      Wa = Wp/Ws;
+    else
+      ## band reject
+      error ("band reject is not implement yet.");
+    endif;
+  else
+   ## if high pass, reverse the sense of the test
+   if (length(Wp) == 1)
+      Wa = Ws/Wp;
+    else
+      ## band pass 
+      Wa=(Wp.^2 - Ws(1)*Ws(2))./(Wp*(Ws(1)-Ws(2)));
+    endif;
+  endif;
+  Wa = min(abs(Wa));
+
+  ## compute minimum n which satisfies all band edge conditions
+  stop_atten = 10^(abs(Rs)/10);
+  pass_atten = 10^(abs(Rp)/10);
+  n = ceil(acosh(sqrt((stop_atten-1)/(pass_atten-1)))/acosh(1/Wa));
+    
+endfunction
+
+%!demo
+%! Fs = 10000; 
+%! [n, Wc] = cheb2ord (1000/(Fs/2), 1200/(Fs/2), 0.5, 29);
+%!
+%! subplot (221);
+%! axis ([ 0, 1500, -1, 0]);
+%! title("Pass band Wp=1000 Rp=0.5");
+%! xlabel("Frequency (Hz)");
+%! ylabel("Attenuation (dB)");
+%! grid;
+%! plot ([0, 1000, 1000, 0, 0], [0, 0, -0.5, -0.5, 0], ";;");
+%! hold on;
+%! [b, a] = cheby2 (n, 0.5, Wc);
+%! [h, w] = freqz (b, a, [], Fs);
+%! plot (w, 20*log10(abs(h)), ";;");
+%! hold off;
+%!
+%! subplot (222);
+%! axis ([ 0, Fs/2, -250, 0]);
+%! title("Stop band Ws=1200 Rs=29");
+%! xlabel("Frequency (Hz)");
+%! ylabel("Attenuation (dB)");
+%! grid;
+%! plot ([1200, Fs/2, Fs/2, 1200, 1200], [-29, -29, -500, -500, -29], ";;");
+%! hold on;
+%! [b, a] = cheby2 (n, 0.5, Wc);
+%! [h, w] = freqz (b, a, [], Fs);
+%! plot (w, 20*log10(abs(h)), ";;");
+%! hold off;
+%!
+%! subplot (223);
+%! axis ([ 990, 1010, -0.6, -0.4]);
+%! title("Pass band detail Wp=1000 Rp=0.5");
+%! xlabel("Frequency (Hz)");
+%! ylabel("Attenuation (dB)");
+%! grid;
+%! plot ([0, 1000, 1000, 0, 0], [0, 0, -0.5, -0.5, 0], ";;");
+%! hold on;
+%! [b, a] = cheby2 (n, 0.5, Wc);
+%! [h, w] = freqz (b, a, [990:1010], Fs);
+%! plot (w, 20*log10(abs(h)), ";filter n;");
+%! [b, a] = cheby2 (n-1, 0.5, Wc);
+%! [h, w] = freqz (b, a, [990:1010], Fs);
+%! plot (w, 20*log10(abs(h)), ";filter n-1;");
+%! [b, a] = cheby2 (n+1, 0.5, Wc);
+%! [h, w] = freqz (b, a, [990:1010], Fs);
+%! plot (w, 20*log10(abs(h)), ";filter n+1;");
+%! hold off;
+%!
+%! subplot (224);
+%! axis ([ 1190, 1210, -40, -20]);
+%! title("Stop band detail Wp=1200 Rp=29");
+%! xlabel("Frequency (Hz)");
+%! ylabel("Attenuation (dB)");
+%! grid;
+%! plot ([1200, Fs/2, Fs/2, 1200, 1200], [-29, -29, -500, -500, -29], ";;");
+%! hold on;
+%! [b, a] = cheby2 (n, 0.5, Wc);
+%! [h, w] = freqz (b, a, [1190:1210], Fs);
+%! plot (w, 20*log10(abs(h)), ";filter n;");
+%! [b, a] = cheby2 (n-1, 0.5, Wc);
+%! [h, w] = freqz (b, a, [1190:1210], Fs);
+%! plot (w, 20*log10(abs(h)), ";filter n-1;");
+%! [b, a] = cheby2 (n+1, 0.5, Wc);
+%! [h, w] = freqz (b, a, [1190:1210], Fs);
+%! plot (w, 20*log10(abs(h)), ";filter n+1;");
+%! hold off;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/cheby1.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,96 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Generate an Chebyshev type I filter with Rp dB of pass band ripple.
+## 
+## [b, a] = cheby1(n, Rp, Wc)
+##    low pass filter with cutoff pi*Wc radians
+##
+## [b, a] = cheby1(n, Rp, Wc, 'high')
+##    high pass filter with cutoff pi*Wc radians
+##
+## [b, a] = cheby1(n, Rp, [Wl, Wh])
+##    band pass filter with edges pi*Wl and pi*Wh radians
+##
+## [b, a] = cheby1(n, Rp, [Wl, Wh], 'stop')
+##    band reject filter with edges pi*Wl and pi*Wh radians
+##
+## [z, p, g] = cheby1(...)
+##    return filter as zero-pole-gain rather than coefficients of the
+##    numerator and denominator polynomials.
+## 
+## References: 
+##
+## Parks & Burrus (1987). Digital Filter Design. New York:
+## John Wiley & Sons, Inc.
+
+## Author: pkienzle@cs.indiana.edu
+
+function [Zz, Zp, Zg] = cheby1(n, Rp, W, stype)
+
+  if (nargin>4 || nargin<3) || (nargout>3 || nargout<2)
+    usage ("[b, a] or [z, p, g] = cheby1 (n, Rp, W, [, 'ftype'])");
+  end
+
+  stop = nargin==4;
+  if stop && !(strcmp(stype, 'high') || strcmp(stype, 'stop'))
+    error ("cheby1: ftype must be 'high' or 'stop'");
+  end
+
+  [r, c]=size(W);
+  if (!(length(W)<=2 && (r==1 || c==1)))
+    error ("cheby1: frequency must be given as w0 or [w0, w1]");
+  elseif (!all(W >= 0 & W <= 1))
+    error ("cheby1: critical frequencies must be in (0, 1)");
+  elseif (!(length(W)==1 || length(W) == 2))
+    error ("cheby1: only one filter band allowed");
+  elseif (length(W)==2 && !(W(1) < W(2)))
+    error ("cheby1: first band edge must be smaller than second");
+  endif
+
+  if (Rp < 0)
+    error("cheby1: passband ripple must be positive decibels");
+  end
+
+  ## Prewarp to the band edges to s plane
+  T = 2;       # sampling frequency of 2 Hz
+  Ws = 2/T*tan(pi*W/T);
+
+  ## Generate splane poles and zeros for the chebyshev type 1 filter
+  C = 1; # default cutoff frequency
+  epsilon = sqrt(10^(Rp/10) - 1);
+  v0 = asinh(1/epsilon)/n;
+  Sp = exp(1i*pi*[-(n-1):2:(n-1)]/(2*n));
+  Sp = -sinh(v0)*real(Sp) + 1i*cosh(v0)*imag(Sp);
+  Sz = [];
+
+  ## compensate for amplitude at s=0
+  Sg = prod(-Sp);
+  ## if n is even, the ripple starts low, but if n is odd the ripple
+  ## starts high. We must adjust the s=0 amplitude to compensate.
+  if (rem(n,2)==0)
+    Sg = Sg/10^(Rp/20);
+  end
+
+  ## splane frequency transform
+  [Sz, Sp, Sg] = sftrans(Sz, Sp, Sg, Ws, stop);
+
+  ## Use bilinear transform to convert poles to the z plane
+  [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T);
+
+  if nargout==2, [Zz, Zp] = zp2tf(Zz, Zp, Zg); endif
+
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/cheby2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,96 @@
+## Copyright (C) 1999-2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Generate a chebyshev filter with Rp dB of stop band ripple (type II).
+## 
+## [b,a] = cheby2(n, Rs, Wc)
+##    low pass filter with stop band cut-off of -Rs dB at pi*Wc radians
+##
+## [b,a] = cheby2(n, Rs, Wc, 'high')
+##    high pass filter with stop band cutoff of -Rs dB at pi*Wc radians
+##
+## [b,a] = cheby2(n, Rs, [Wl, Wh])
+##    band pass filter with stop band edges at pi*Wl and pi*Wh radians
+##
+## [b,a] = cheby2(n, Rs, [Wl, Wh], 'stop')
+##    band reject filter with pass band edges at pi*Wl and pi*Wh radians
+##
+## [z,p,g] = cheby2(...)
+##    return filter as zero-pole-gain rather than coefficients of the
+##    numerator and denominator polynomials.
+
+## Author: pkienzle@cs.indiana.edu
+## 2001-03-09 pkienzle@kienzle.powernet.co.uk
+##     * for odd n, skip zero at infinity for theta==pi/2
+
+function [Zz, Zp, Zg] = cheby2(n, Rs, W, stype)
+
+  if (nargin>4 || nargin<3) || (nargout>3 || nargout<2)
+    usage ("[b, a] or [z, p, g] = cheby2 (n, Rs, W, [, 'ftype'])");
+  end
+
+  stop = nargin==4;
+  if stop && !(strcmp(stype, 'high') || strcmp(stype, 'stop'))
+    error ("cheby2: ftype must be 'high' or 'stop'");
+  end
+  
+  [r, c]=size(W);
+  if (!(length(W)<=2 && (r==1 || c==1)))
+    error ("cheby2: frequency must be given as w0 or [w0, w1]");
+  elseif (!all(W >= 0 & W <= 1))
+    error ("cheby2: critical frequencies must be in (0, 1)");
+  elseif (!(length(W)==1 || length(W) == 2))
+    error ("cheby2: only one filter band allowed");
+  elseif (length(W)==2 && !(W(1) < W(2)))
+    error ("cheby2: first band edge must be smaller than second");
+  endif
+  if (Rs < 0)
+    error("cheby2: passband ripple must be positive decibels");
+  end
+
+  ## Prewarp to the band edges to s plane
+  T = 2;       # sampling frequency of 2 Hz
+  Ws = 2/T*tan(pi*W/T);
+
+  ## Generate splane poles and zeros for the chebyshev type 2 filter
+  ## From: Stearns, SD; David, RA; (1988). Signal Processing Algorithms. 
+  ##       New Jersey: Prentice-Hall.
+  C = 1;			# default cutoff frequency
+  lambda = 10^(Rs/20);
+  phi = log(lambda + sqrt(lambda^2-1))/n;
+  theta = pi*([1:n]-0.5)/n;
+  alpha = -sinh(phi)*sin(theta);
+  beta = cosh(phi)*cos(theta);
+  if (rem(n,2))
+    ## drop theta==pi/2 since it results in a zero at infinity
+    Sz = 1i*C./cos(theta([1:(n-1)/2, (n+3)/2:n]));
+  else
+    Sz = 1i*C./cos(theta);
+  endif
+  Sp = C./(alpha.^2+beta.^2).*(alpha-1i*beta);
+
+  ## compensate for amplitude at s=0
+  Sg = real(prod(Sp)/prod(Sz));
+
+  ## splane frequency transform
+  [Sz, Sp, Sg] = sftrans(Sz, Sp, Sg, Ws, stop);
+
+  ## Use bilinear transform to convert poles to the z plane
+  [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T);
+
+  if nargout==2, [Zz, Zp] = zp2tf(Zz, Zp, Zg); endif
+
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/chirp.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,98 @@
+## Copyright (C) 1999-2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: y = chirp(t [, f0 [, t1 [, f1 [, form [, phase]]]]])
+##
+## Evaluate a chirp signal at time t.  A chirp signal is a frequency
+## swept cosine wave.
+##
+## t: vector of times to evaluate the chirp signal
+## f0: frequency at time t=0 [ 0 Hz ]
+## t1: time t1 [ 1 sec ]
+## f1: frequency at time t=t1 [ 100 Hz ]
+## form: shape of frequency sweep
+##    'linear'      f(t) = (f1-f0)*(t/t1) + f0
+##    'quadratic'   f(t) = (f1-f0)*(t/t1)^2 + f0
+##    'logarithmic' f(t) = (f1-f0)^(t/t1) + f0
+## phase: phase shift at t=0
+##
+## Example
+##    specgram(chirp([0:0.001:5])); # linear, 0-100Hz in 1 sec
+##    specgram(chirp([-2:0.001:15], 400, 10, 100, 'quadratic'));
+##    soundsc(chirp([0:1/8000:5], 200, 2, 500, "logarithmic"),8000);
+##
+## If you want a different sweep shape f(t), use the following:
+##    y = cos(2*pi*integral(f(t)) + 2*pi*f0*t + phase);
+
+## 2001-08-31 Paul Kienzle <pkienzle@users.sf.net>
+## * Fix documentation for quadratic case
+
+function y = chirp(t, f0, t1, f1, form, phase)
+
+  if nargin < 1 || nargin > 6
+    usage("y = chirp(t [, f0 [, t1 [, f1 [, form [, phase]]]]])");
+  endif
+  if nargin < 2, f0 = []; endif
+  if nargin < 3, t1 = []; endif
+  if nargin < 4, f1 = []; endif
+  if nargin < 5, form = []; endif
+  if nargin < 6, phase = []; endif
+
+  if isempty(f0), f0 = 0; endif
+  if isempty(t1), t1 = 1; endif
+  if isempty(f1), f1 = 100; endif
+  if isempty(form), form = "linear"; endif
+  if isempty(phase), phase = 0; endif
+
+  phase = 2*pi*phase/360;
+
+  if strcmp(form, "linear")
+    a = pi*(f1 - f0)/t1;
+    b = 2*pi*f0;
+    y = cos(a*t.^2 + b*t + phase);
+  elseif strcmp(form, "quadratic")
+    a = (2/3*pi*(f1-f0)/t1/t1);
+    b = 2*pi*f0;
+    y = cos(a*t.^3 + b*t + phase);
+  elseif strcmp(form, "logarithmic")
+    a = 2*pi*t1/log(f1-f0);
+    b = 2*pi*f0;
+    x = (f1-f0)^(1/t1);
+    y = cos(a*x.^t + b*t + phase);
+  else
+    error("chirp doesn't understand '%s'",form);
+  endif
+
+endfunction
+
+%!demo
+%! specgram(chirp([0:0.001:5]),[],1000); # linear, 0-100Hz in 1 sec
+%! %------------------------------------------------------------
+%! % Shows linear sweep of 100 Hz/sec starting at zero for 5 sec
+%! % since the sample rate is 1000 Hz, this should be a diagonal
+%! % from bottom left to top right.
+
+%!demo
+%! specgram(chirp([-2:0.001:15], 400, 10, 100, 'quadratic'));
+%! %------------------------------------------------------------
+%! % Shows a quadratic chirp of 400 Hz at t=0 and 100 Hz at t=10
+%! % Time goes from -2 to 15 seconds.
+
+%!demo
+%! specgram(chirp([0:1/8000:5], 200, 2, 500, "logarithmic"),[],8000);
+%! %------------------------------------------------------------
+%! % Shows a logarithmic chirp of 200 Hz at t=0 and 500 Hz at t=2
+%! % Time goes from 0 to 5 seconds at 8000 Hz.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/cohere.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,38 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [Cxy, w] = cohere(x, y, ...)
+##
+## Estimate coherence between two signals.
+## This is simply Cxy = |Pxy|^2/(PxxPxy).
+##
+## See pwelch for an explanation of the available parameters.
+
+function [...] = cohere(...)
+  if nargin < 2
+    usage("Cxy=cohere(x,y,...)  [see pwelch for details]"); 
+  endif
+  if nargout==0, 
+    pwelch('cohere',all_va_args);
+  elseif nargout==1
+    Cxy=pwelch('cohere',all_va_args);
+    vr_val(Cxy);
+  elseif nargout==2
+    [Cxy, w]=pwelch('cohere',all_va_args);
+    vr_val(Cxy);
+    vr_val(w);
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/csd.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,49 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [Pxy, w] = csd(x, y, ...)
+##        [Pxy, Pci, w] = csd(x, y, ...)
+##
+## Estimate cross spectrum density of a pair of signals. This chops the 
+## signals into overlapping slices, windows each slice and applies a Fourier
+## transform to determine the frequency components at that slice. The
+## magnitudes of these slices are then averaged to produce the estimate Pxy.
+## The confidence interval around the estimate is returned in Pci.
+##
+## See pwelch for an explanation of the available parameters.
+##
+## See also: tfe, cohere
+
+function [...] = csd(...)
+  if nargin < 2
+    usage("Pxy=csd(x,y,...)  [see pwelch for details]"); 
+  endif
+  if nargout==0, 
+    pwelch('csd',all_va_args);
+  elseif nargout==1
+    Pxy=pwelch('csd',all_va_args);
+    vr_val(Pxy);
+  elseif nargout==2
+    [Pxy, w]=pwelch('csd',all_va_args);
+    vr_val(Pxy);
+    vr_val(w);
+  else
+    [Pxy, Pci, w]=pwelch('csd',all_va_args);
+    vr_val(Pxx);
+    vr_val(Pci);
+    vr_val(w);
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/czt.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,59 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage y=czt(x, m, w, a)
+##
+## Chirp z-transform.  Compute the frequency response starting at a and
+## stepping by w for m steps.  a is a point in the complex plane, and
+## w is the ratio between points in each step (i.e., radius increases
+## exponentially, and angle increases linearly).
+##
+## To evaluate the frequency response for the range f1 to f2 in a signal
+## with sampling frequency Fs, use the following:
+##     m = 32;                          ## number of points desired
+##     w = exp(-2i*pi*(f2-f1)/(m*Fs));  ## freq. step of f2-f1/m
+##     a = exp(2i*pi*f1/Fs);            ## starting at frequency f1
+##     y = czt(x, m, w, a);
+##
+## If you don't specify them, then the parameters default to a fourier 
+## transform:
+##     m=length(x), w=exp(2i*pi/m), a=1
+## Because it is computed with three FFTs, this will be faster than
+## computing the fourier transform directly for large m (which is
+## otherwise the best you can do with fft(x,n) for n prime).
+
+## TODO: More testing---particularly when m+N-1 approaches a power of 2
+## TODO: Consider treating w,a as f1,f2 expressed in radians if w is real
+function y = czt(x, m, w, a)
+  if nargin < 1 || nargin > 4, usage("y=czt(x, m, w, a)"); endif
+  if nargin < 2 || isempty(m), m = length(x); endif
+  if nargin < 3 || isempty(w), w = exp(2i*pi/m); endif
+  if nargin < 4 || isempty(a), a = 1; endif
+
+  N = length(x);
+  if (columns(x) == 1)
+    k = [0:m-1]';
+    Nk = [-(N-1):m-2]';
+  else
+    k = [0:m-1];
+    Nk = [-(N-1):m-2];
+  endif
+  nfft = 2^nextpow2(min(m,N)+length(Nk)-1); 
+  Wk2 = w.^(-(Nk.^2)/2);
+  AWk2 = (a.^-k) .* (w.^((k.^2)/2));
+  y = ifft(fft(postpad(Wk2,nfft)).*fft(postpad(x,nfft).*postpad(AWk2,nfft)));
+  y = w.^((k.^2)/2).*y(1+N:m+N);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/dct.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,95 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## y = dct (x, n)
+##    Computes the disrete cosine transform of x.  If n is given, then
+##    x is padded or trimmed to length n before computing the transform.
+##    If x is a matrix, compute the transform along the columns of the
+##    the matrix. The transform is faster if x is real-valued and even
+##    length.
+##
+## The discrete cosine transform X of x can be defined as follows:
+##
+##               N-1
+##   X[k] = w(k) sum x[n] cos (pi (2n-1) k / 2N ),  k = 0, ..., N-1
+##               n=0
+##
+## with w(0) = sqrt(1/N) and w(k) = sqrt(2/N), k = 1, ..., N-1.  There
+## are other definitions with different scaling of X[k], but this form
+## is common in image processing.
+##
+## See also: idct, dct2, idct2, dctmtx
+
+## From Discrete Cosine Transform notes by Brian Evans at UT Austin,
+## http://www.ece.utexas.edu/~bevans/courses/ee381k/lectures/09_DCT/lecture9/
+## the discrete cosine transform of x at k is as follows:
+##
+##          N-1
+##   X[k] = sum 2 x[n] cos (pi (2n-1) k / 2N )
+##          n=0
+##
+## which can be computed using:
+##
+##   y = [ x ; flipud (x) ]
+##   Y = fft(y)
+##   X = exp( -j pi [0:N-1] / 2N ) .* Y
+##
+## or for real, even length x
+##
+##   y = [ even(x) ; flipud(odd(x)) ]
+##   Y = fft(y)
+##   X = 2 real { exp( -j pi [0:N-1] / 2N ) .* Y }
+##
+## Scaling the result by w(k)/2 will give us the desired output.
+
+## Author: Paul Kienzle
+## 2001-02-08
+##   * initial release
+function y = dct (x, n)
+
+  if (nargin < 1 || nargin > 2)
+    usage ("y = dct(x [, n])");
+  endif
+
+  realx = isreal(x);
+  transpose = (rows (x) == 1);
+
+  if transpose, x = x (:); endif
+  [nr, nc] = size (x);
+  if nargin == 1
+    n = nr;
+  elseif n > nr
+    x = [ x ; zeros(n-nr,nc) ];
+  elseif n < nr
+    x (nr-n+1 : n, :) = [];
+  endif
+
+  if n == 1
+    w = 1/2;
+  else
+    w = [ sqrt(1/4/n); sqrt(1/2/n)*exp((-1i*pi/2/n)*[1:n-1]') ] * ones (1, nc);
+  endif
+  if ( realx && rem (n, 2) == 0 )
+    y = fft([ x(1:2:n,:) ; x(n:-2:1,:) ]);
+    y = 2 * real( w .* y );
+  else
+    y = fft ([ x ; flipud (x) ]);
+    y = w .* y (1:n, :);
+    if (realx) y = real (y); endif
+  endif
+  if transpose, y = y.'; endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/dct2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,49 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## y = dct2 (x)
+##   Computes the 2-D discrete cosine transform of matrix x
+##
+## y = dct2 (x, m, n) or y = dct2 (x, [m n])
+##   Computes the 2-D DCT of x after padding or trimming rows to m and
+##   columns to n.
+
+## Author: Paul Kienzle
+## 2001-02-08
+##   * initial revision
+
+function y = dct2 (x, m, n)
+
+  if (nargin < 1 || nargin > 3)
+    usage("dct (x) or dct (x, m, n) or dct (x, [m n])");
+  endif
+
+  if nargin == 1
+    [m, n] = size(x);
+  elseif (nargin == 2)
+    n = m(2);
+    m = m(1);
+  endif
+
+  if m == 1
+    y = dct (x.', n).';
+  elseif n == 1
+    y = dct (x, m);
+  else
+    y = dct (dct (x, m).', n).';
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/dctmtx.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,51 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## T = dctmtx (n)
+##	Return the DCT transformation matrix of size n x n.
+##
+## If A is an n x n matrix, then the following are true:
+##     T*A    == dct(A),  T'*A   == idct(A)
+##     T*A*T' == dct2(A), T'*A*T == idct2(A)
+##
+## A dct transformation matrix is useful for doing things like jpeg
+## image compression, in which an 8x8 dct matrix is applied to
+## non-overlapping blocks throughout an image and only a subblock on the
+## top left of each block is kept.  During restoration, the remainder of
+## the block is filled with zeros and the inverse transform is applied
+## to the block.
+##
+## See also: dct, idct, dct2, idct2
+
+## Author: Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+## 2001-02-08
+##    * initial release
+
+function T = dctmtx(n)
+  if nargin != 1
+    usage("T = dctmtx(n)")
+  endif
+
+  if n > 1
+    T = [ sqrt(1/n)*ones(1,n) ; \
+	 sqrt(2/n)*cos((pi/2/n)*([1:n-1]'*[1:2:2*n])) ];
+  elseif n == 1
+    T = 1;
+  else
+    error ("dctmtx: n must be at least 1");
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/decimate.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,83 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: y = decimate(x, q [, n] [, ftype])
+##
+## Downsample the signal x by a factor of q, using an order n filter
+## of ftype 'fir' or 'iir'.  By default, an order 8 Chebyshev type I
+## filter is used or a 30 point FIR filter if ftype is 'fir'.  Note
+## that q must be an integer for this rate change method.
+##
+## Example
+##    ## Generate a signal that starts away from zero, is slowly varying
+##    ## at the start and quickly varying at the end, decimate and plot.
+##    ## Since it starts away from zero, you will see the boundary
+##    ## effects of the antialiasing filter clearly.  Next you will see
+##    ## how it follows the curve nicely in the slowly varying early
+##    ## part of the signal, but averages the curve in the quickly
+##    ## varying late part of the signal.
+##    t=0:0.01:2; x=chirp(t,2,.5,10,'quadratic')+sin(2*pi*t*0.4); 
+##    y = decimate(x,4);   # factor of 4 decimation
+##    stem(t(1:121)*1000,x(1:121),"-g;Original;"); hold on; # plot original
+##    stem(t(1:4:121)*1000,y(1:31),"-r;Decimated;"); hold off; # decimated
+
+function y = decimate(x, q, n, ftype)
+
+  if nargin < 1 || nargin > 4, 
+    usage("y=decimate(x, q [, n] [, ftype])"); 
+  endif
+  if q != fix(q), error("decimate only works with integer q."); endif
+
+  if nargin<3
+    ftype='iir';
+    n=[];
+  elseif nargin==3
+    if isstr(n)
+      ftype=n; 
+      n=[];
+    else 
+      ftype='iir';
+    endif
+  endif
+
+  fir = strcmp(ftype, 'fir');
+  if isempty(n)
+    if fir, n=30; else n=8; endif
+  endif
+
+  if fir
+    b = fir1(n, 1/q);
+    y=fftfilt(b, x);
+  else
+    [b, a] = cheby1(n, 0.05, 1/q);
+    y=filtfilt(b,a,x);
+  endif
+  y = y(1:q:length(x));
+endfunction
+
+%!demo
+%! t=0:0.01:2; x=chirp(t,2,.5,10,'quadratic')+sin(2*pi*t*0.4); 
+%! y = decimate(x,4);   # factor of 4 decimation
+%! stem(t(1:121)*1000,x(1:121),"-g;Original;"); hold on; # plot original
+%! stem(t(1:4:121)*1000,y(1:31),"-r;Decimated;"); hold off; # decimated
+%! %------------------------------------------------------------------
+%! % The signal to decimate starts away from zero, is slowly varying
+%! % at the start and quickly varying at the end, decimate and plot.
+%! % Since it starts away from zero, you will see the boundary
+%! % effects of the antialiasing filter clearly.  You will also see
+%! % how it follows the curve nicely in the slowly varying early
+%! % part of the signal, but averages the curve in the quickly
+%! % varying late part of the signal.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/filter2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,45 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Y = filter2 (B, X)
+##	Apply the 2-D FIR filter B to the matrix X.
+## Y = filter2 (B, X, 'shape')
+##      Apply the 2-D FIR filter B to the matrix X, returning the
+##      desired shape:
+##          full  - pad X with zeros on all sides before filtering
+##          same  - unpadded X (default)
+##          valid - trim X after filtering so edge effects are no included
+##
+## Note this is just a variation on convolution, with the parameters
+## reversed and B rotated 180 degrees.
+
+## Author: Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+## 2001-02-08 
+##    * initial release
+
+function Y = filter2 (B, X, shape)
+
+  if (nargin < 2 || nargin > 3)
+    usage ("Y = filter2 (B, X [, 'shape'])");
+  endif
+  if nargin < 3
+    shape = "same";
+  endif
+
+  [nr, nc] = size(B);
+  Y = conv2 (X, B(nr:-1:1, nc:-1:1), shape);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/filtfilt.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,72 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: y = filtfilt(b, a, x)
+##
+## Forward and reverse filter the signal. This corrects for phase
+## distortion introduced by a one-pass filter, though it does square the
+## magnitude response in the process. That's the theory at least.  In
+## practice the phase correction is not perfect, and magnitude response
+## is distorted, particularly in the stop band.
+##
+## In this version, I zero-pad the end of the signal to give the reverse
+## filter time to ramp up to the level at the end of the signal.
+## Unfortunately, the degree of padding required is dependent on the
+## nature of the filter and not just its order, so this function needs
+## some work yet.
+##
+## Example
+##    [b, a]=butter(3, 0.1);                   % 10 Hz low-pass filter
+##    t = 0:0.01:1.0;                         % 1 second sample
+##    x=sin(2*pi*t*2.3)+0.25*randn(size(t));  % 2.3 Hz sinusoid+noise
+##    y = filtfilt(b,a,x); z = filter(b,a,x); % apply filter
+##    plot(t,x,';data;',t,y,';filtfilt;',t,z,';filter;')
+
+## Changelog:
+## 2000 02 pkienzle@kienzle.powernet.co.uk
+##      - pad with zeros to load up the state vector on filter reverse.
+##      - add example
+
+## TODO: In Matlab filtfilt `reduces filter startup transients by carefully
+## TODO:    choosing initial conditions, and by prepending onto the input
+## TODO:    sequence a short, reflected piece of the input sequence'.
+## TODO:    Once filtic is written, use that here.
+## TODO: My version seems to have similar quality to matlab, but both are
+## TODO:    pretty bad.  They do remove gross lag errors, though.
+## TODO: Note that if x is really long, it might be worth doing
+## TODO:   the zero padding as a separate call to filter so that the
+## TODO:   vector never has to be copied. E.g.,
+## TODO:      [y, state] = filter(b,a,x); 
+## TODO:      tail = filter(b,a,zeros(1,max(length(b),length(a))),state);
+## TODO:      [tail, state] = filter(b,a,flipXX(tail));
+## TODO:      y = flipXX(filter(b,a,flipXX(y), state));
+## TODO:   Don't know for what n this would be faster, if any, but the
+## TODO:   memory saving might be nice.
+
+function y = filtfilt(b, a, x)
+  if (nargin != 3)
+    usage("y=filtfilt(b,a,x)");
+  end
+
+  if (rows(x) == 1)
+    y = filter(b,a,[x, zeros(1,2*max(length(a),length(b)))]);
+    y = fliplr(filter(b,a,fliplr(y))); 
+  else
+    y = filter(b,a,[x ; zeros(2*max(length(a),length(b)), 1)]);
+    y = flipud(filter(b,a,flipud(y))); 
+  endif
+  y = y(1:length(x));
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/fir1.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,145 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: b = fir1(n, w [, type] [, window] [, noscale])
+##
+## Produce an order n FIR filter with the given frequency cutoff,
+## returning the n+1 filter coefficients in b.  
+##
+## n: order of the filter (1 less than the length of the filter)
+## w: band edges
+##    strictly increasing vector in range [0, 1]
+##    singleton for highpass or lowpass, vector pair for bandpass or
+##    bandstop, or vector for alternating pass/stop filter.
+## type: choose between pass and stop bands
+##    'high' for highpass filter, cutoff at w
+##    'stop' for bandstop filter, edges at w = [lo, hi]
+##    'DC-0' for bandstop as first band of multiband filter
+##    'DC-1' for bandpass as first band of multiband filter
+## window: smoothing window
+##    defaults to hamming(n+1) row vector
+##    returned filter is the same shape as the smoothing window
+## noscale: choose whether to normalize or not
+##    'scale': set the magnitude of the center of the first passband to 1
+##    'noscale': don't normalize
+##
+## To apply the filter, use the return vector b:
+##       y=filter(b,1,x);
+##
+## Examples:
+##   freqz(fir1(40,0.3));
+##   freqz(fir1(15,[0.2, 0.5], 'stop'));  # note the zero-crossing at 0.1
+##   freqz(fir1(15,[0.2, 0.5], 'stop', 'noscale'));
+
+## TODO: Consider using exact expression (in terms of sinc) for the
+## TODO:    impulse response rather than relying on fir2.
+## TODO: Find reference to the requirement that order be even for
+## TODO:    filters that end high.  Figure out what to do with the
+## TODO:    window in these cases---duplicating the central value
+## TODO:    like I currently do seems very reasonable.
+function b = fir1(n, w, ftype, window, scale)
+
+  if nargin < 2 || nargin > 5
+    usage("b = fir1(n, w [, type] [, window] [, noscale])");
+  endif
+  
+  ## interpret arguments
+  if nargin==2
+    ftype=[]; window=[]; scale=[];
+  elseif nargin==3
+    window=[]; scale=[];
+    if !isstr(ftype), window=ftype; ftype=[]; endif
+  elseif nargin==4
+    scale=[];
+    if isstr(window), scale=window; window=[]; endif
+    if !isstr(ftype), window=ftype; ftype=[]; endif
+  endif
+
+  ## If single band edge, the first band defaults to a pass band
+  ## to create a lowpass filter.  If multiple band edges, assume
+  ## the first band is a stop band, so that the two band case defaults
+  ## to a band pass filter.  Ick.
+  ftype = tolower(ftype);
+  if isempty(ftype), ftype = length(w)==1;
+  elseif strcmp(ftype, 'low'), ftype = 1;
+  elseif strcmp(ftype, 'high'), ftype = 0;
+  elseif strcmp(ftype, 'pass'), ftype = 0;
+  elseif strcmp(ftype, 'stop'), ftype = 1;
+  elseif strcmp(ftype, 'dc-0'), ftype = 0;
+  elseif strcmp(ftype, 'dc-1'), ftype = 1;
+  elseif isstr(ftype)
+    error(["fir1 invalid filter type ", ftype]);
+  else
+    error("fir1 filter type should be a string");
+  endif
+
+  ## scale the magnitude by default
+  if isempty(scale) || strcmp(scale, 'scale'), scale = 1; 
+  elseif strcmp(scale, 'noscale'), scale=0;
+  else error("fir1 scale must be 'scale' or 'noscale'");
+  endif
+
+  ## use fir2 default filter
+  if isempty(window) && isempty(scale), window = []; endif
+
+  ## build response function according to fir2 requirements
+  bands = length(w)+1;
+  f = zeros(1,2*bands);
+  f(1) = 0; f(2*bands)=1;
+  f(2:2:2*bands-1) = w;
+  f(3:2:2*bands-1) = w;
+  m = zeros(1,2*bands);
+  m(1:2:2*bands) = rem([1:bands]-(1-ftype),2);
+  m(2:2:2*bands) = m(1:2:2*bands);
+
+  ## Increment the order if the final band is a pass band.  Something
+  ## about having a nyquist frequency of zero causing problems.
+  if rem(n,2)==1 && m(2*bands)==1, 
+    warning("n must be even for highpass and bandstop filters. Incrementing.");
+    n=n+1; 
+    if !isempty(window), 
+      if rows(window) == 1
+      	window = [window(1:n/2), window(n/2:n-1)];
+      else
+	window = [window(1:n/2); window(n/2:n-1)];
+      endif
+    endif
+  endif
+
+  ## compute the filter
+  b = fir2(n, f, m, 512, 2, window);
+
+  ## normalize filter magnitude
+  if scale == 1
+    ## find the middle of the first band edge
+    if m(1) == 1, w_o = (f(2)-f(1))/2;
+    else w_o = f(3) + (f(4)-f(3))/2;
+    endif
+
+    ## compute |h(w_o)|^-1
+    renorm = 1/abs(polyval(b, exp(-1i*pi*w_o)));
+
+    ## normalize the filter
+    b = renorm*b;
+  endif
+endfunction
+
+%!demo
+%! freqz(fir1(40,0.3));
+%!demo
+%! freqz(fir1(15,[0.2, 0.5], 'stop'));  # note the zero-crossing at 0.1
+%!demo
+%! freqz(fir1(15,[0.2, 0.5], 'stop', 'noscale'));
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/fir2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,175 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: b = fir2(n, f, m [, grid_n [, ramp_n]] [, window])
+##
+## Produce an FIR filter of order n with arbitrary frequency response, 
+## returning the n+1 filter coefficients in b.  
+##
+## n: order of the filter (1 less than the length of the filter)
+## f: frequency at band edges
+##    f is a vector of nondecreasing elements in [0,1]
+##    the first element must be 0 and the last element must be 1
+##    if elements are identical, it indicates a jump in freq. response
+## m: magnitude at band edges
+##    m is a vector of length(f)
+## grid_n: length of ideal frequency response function
+##    defaults to 512, should be a power of 2 bigger than n
+## ramp_n: transition width for jumps in filter response
+##    defaults to grid_n/20; a wider ramp gives wider transitions
+##    but has better stopband characteristics.
+## window: smoothing window
+##    defaults to hamming(n+1) row vector
+##    returned filter is the same shape as the smoothing window
+##
+## To apply the filter, use the return vector b:
+##       y=filter(b,1,x);
+## Note that plot(f,m) shows target response.
+##
+## Example:
+##   f=[0, 0.3, 0.3, 0.6, 0.6, 1]; m=[0, 0, 1, 1/2, 0, 0];
+##   [h, w] = freqz(fir2(100,f,m));
+##   plot(f,m,';target response;',w/pi,abs(h),';filter response;');
+
+## Feb 27, 2000 PAK
+##     use ramping on any transition less than ramp_n units
+##     use 2^nextpow2(n+1) for expanded grid size if grid is too small
+## 2001-01-30 PAK
+##     set default ramp length to grid_n/20 (i.e., pi/20 radians)
+##     use interp1 to interpolate the grid points
+##     better(?) handling of 0 and pi frequency points.
+##     added some demos
+
+function b = fir2(n, f, m, grid_n, ramp_n, window)
+
+  if nargin < 3 || nargin > 6
+    usage("b = fir2(n, f, m [, grid_n [, ramp_n]] [, window])");
+  endif
+
+  ## verify frequency and magnitude vectors are reasonable
+  t = length(f);
+  if t<2 || f(1)!=0 || f(t)!=1 || any(diff(f)<0)
+    usage("frequency must be nondecreasing starting from 0 and ending at 1");
+  endif
+  if t != length(m)
+    usage("frequency and magnitude vectors must be the same length");
+  endif
+
+  ## find the grid spacing and ramp width
+  if (nargin>4 && length(grid_n)>1) || \
+	(nargin>5 && (length(grid_n)>1 || length(ramp_n)>1))
+    usage("grid_n and ramp_n must be integers");
+  endif
+  if nargin < 4, grid_n=512; endif
+  if nargin < 5, ramp_n=grid_n/20; endif
+
+  ## find the window parameter, or default to hamming
+  w=[];
+  if length(grid_n)>1, w=grid_n; grid_n=512; endif
+  if length(ramp_n)>1, w=ramp_n; ramp_n=grid_n/20; endif
+  if nargin < 6, window=w; endif
+  if isempty(window), window=hamming(n+1); endif
+  if length(window) != n+1, usage("window must be of length n+1"); endif
+
+  ## make sure grid is big enough for the window
+  if 2*grid_n < n+1, grid_n = 2^nextpow2(n+1); endif
+
+  ## Apply ramps to discontinuities
+  if (ramp_n > 0)
+    ## remember original frequency points prior to applying ramps
+    basef = f; basem = m;
+    
+    ## separate identical frequencies
+    idx = find (diff(f) == 0);
+    f(idx) = f(idx) - ramp_n/grid_n/2;
+    f(idx+1) = f(idx+1) + ramp_n/grid_n/2;
+    
+    ## make sure the grid points stay monotonic
+    idx = find (diff(f) < 0);
+    f(idx) = f(idx+1) = (basef(idx) + basef(idx+1))/2;
+    
+    ## preserve window shape even though f may have changed
+    m = interp1(basef, basem, f);
+
+    % plot(f,m,';ramped;',basef,basem,';original;'); pause;
+  endif
+
+  ## interpolate between grid points
+  grid = interp1(f,m,linspace(0,1,grid_n+1)');
+
+  ## Transform frequency response into time response and
+  ## center the response about n/2, truncating the excess
+  b = ifft([grid ; grid(grid_n:-1:2)]);
+  mid = (n+1)/2;
+  b = real ([ b([2*grid_n-floor(mid)+1:2*grid_n]) ; b(1:ceil(mid)) ]);
+
+  ## Multiplication in the time domain is convolution in frequency,
+  ## so multiply by our window now to smooth the frequency response.
+  if rows(window) > 1
+    b = b .* window;
+  else
+    b = b' .* window;
+  endif
+endfunction
+
+%!demo
+%! f=[0, 0.3, 0.3, 0.6, 0.6, 1]; m=[0, 0, 1, 1/2, 0, 0];
+%! [h, w] = freqz(fir2(100,f,m));
+%! subplot(121);
+%! plot(f,m,';target response;',w/pi,abs(h),';filter response;');
+%! subplot(122);
+%! plot(f,20*log10(m+1e-5),';target response (dB);',...
+%!      w/pi,20*log10(abs(h)),';filter response (dB);');
+%! oneplot;
+
+%!demo
+%! f=[0, 0.3, 0.3, 0.6, 0.6, 1]; m=[0, 0, 1, 1/2, 0, 0];
+%! plot(f,20*log10(m+1e-5),';target response;');
+%! hold on;
+%! [h, w] = freqz(fir2(50,f,m,512,0));
+%! plot(w/pi,20*log10(abs(h)),';filter response (ramp=0);');
+%! [h, w] = freqz(fir2(50,f,m,512,25.6));
+%! plot(w/pi,20*log10(abs(h)),';filter response (ramp=pi/20 rad);');
+%! [h, w] = freqz(fir2(50,f,m,512,51.2));
+%! plot(w/pi,20*log10(abs(h)),';filter response (ramp=pi/10 rad);');
+%! hold off;
+
+%!demo
+%! % Classical Jakes spectrum
+%! % X represents the normalized frequency from 0
+%! % to the maximum Doppler frequency
+%! asymptote = 2/3;
+%! X = linspace(0,asymptote-0.0001,200);
+%! Y = (1 - (X./asymptote).^2).^(-1/4);
+%!
+%! % The target frequency response is 0 after the asymptote
+%! X = [X, asymptote, 1];
+%! Y = [Y, 0, 0];
+%!
+%! title('Theoretical/Synthesized CLASS spectrum');
+%! xlabel('Normalized frequency (Fs=2)');
+%! ylabel('Magnitude');
+%!
+%! plot(X,Y,'b;Target spectrum;'); 
+%! hold on;
+%! [H,F]=freqz(fir2(20, X, Y));  
+%! plot(F/pi,abs(H),'c;Synthesized spectrum (n=20);');
+%! [H,F]=freqz(fir2(50, X, Y));  
+%! plot(F/pi,abs(H),'r;Synthesized spectrum (n=50);');
+%! [H,F]=freqz(fir2(200, X, Y)); 
+%! plot(F/pi,abs(H),'g;Synthesized spectrum (n=200);');
+%! hold off;
+%! xlabel(''); ylabel(''); title('');
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/gaussian.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,30 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: window = gaussian(n, width)
+##
+## Generate an n-point gaussian convolution window of the given
+## width as measured in frequency units (sample rate/num samples). 
+## Should be f when multiplying in the time domain, but 1/f when 
+## multiplying in the frequency domain (for use in convolutions).
+function x = gaussian(n, w)
+
+  if nargin != 2
+    usage("x = gaussian(n, w)");
+  end
+  x = exp(-0.5*(([1:n]'-n/2)*w).^2);
+
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/grpdelay.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,240 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+##
+## Based on freqz.m, Copyright (C) 1996, 1997 John W. Eaton
+
+## Compute the group delay of a filter.
+##
+## [g, w] = grpdelay(b)
+##   returns the group delay g of the FIR filter with coefficients b.
+##   The response is evaluated at 512 angular frequencies between 0 and
+##   pi. w is a vector containing the 512 frequencies.
+##
+## [g, w] = grpdelay(b,a)
+##   returns the group delay of the rational IIR filter whose numerator
+##   has coefficients b and denominator coefficients a.
+##
+## [g, w] = grpdelay(b,a,n)
+##   returns the group delay evaluated at n angular frequencies.  For fastest
+##   computation n should factor into a small number of small primes.
+##
+## [g, w] = grpdelay(b,a,n,"whole")
+##   evaluates the group delay at n frequencies between 0 and 2*pi.
+##
+## [g, w] = grpdelay(b,a,n,Fs)
+##   evaluates the group delay at n frequencies between 0 and Fs/2.
+##
+## [g, w] = grpdelay(b,a,n,"whole",Fs)
+##   evaluates the group delay at n frequencies between 0 and Fs.
+##
+## grpdelay(...)
+##   plots the group delay vs. frequency.
+##
+## This computation is unstable since it involves cancellation of very
+## small values.  If the denominator becomes too small, the group delay
+## is artificially set to 0.  The computation is also unstable since the
+## group delay can go to infinity for some filters.  These points are
+## set to zero as well so that the graph looks reasonable.
+##
+## Theory: group delay, g(w) = -d/dw [arg{H(e^jw)}],  is the rate of change of
+## phase with respect to frequency.  It can be computed as:
+##
+##               d/dw H(e^-jw)
+##        g(w) = -------------
+##                 H(e^-jw)
+##
+## where
+##         H(z) = B(z)/A(z) = sum(b_k z^k)/sum(a_k z^k).
+##
+## By the quotient rule,
+##                    A(z) d/dw B(z) - B(z) d/dw A(z)
+##        d/dw H(z) = -------------------------------
+##                               A(z) A(z)
+## Substituting into the expression above yields:
+##                A dB - B dA 
+##        g(w) =  ----------- = dB/B - dA/A
+##                    A B
+##
+## Note that,
+##        d/dw B(e^-jw) = sum(k b_k e^-jwk)
+##        d/dw A(e^-jw) = sum(k a_k e^-jwk)
+## which is just the FFT of the coefficients multiplied by a ramp.
+
+## TODO: demo("grpdelay",4) seems wrong.  The delays in the detail plot
+## TODO:    are opposite those in the overall plot.
+## TODO: combine with freqz since the two are almost identical
+## TODO: don't reset graph state before exiting since the user may
+## TODO:    want to further decorate the graph.
+function [g_r, w_r] = grpdelay(b, a, n, region, Fs)
+
+  if (nargin<1 || nargin>5)
+    usage("[g, w]=grpdelay(b [, a [, n [, 'whole' [, Fs]]]])");
+  elseif (nargin == 1)
+    ## Response of an FIR filter.
+    a=[]; n=[]; region=[]; Fs=[];
+  elseif (nargin == 2)
+    ## Response of an IIR filter
+    n=[]; region=[]; Fs=[];
+  elseif (nargin == 3)
+    region=[]; Fs=[];
+  elseif (nargin == 4)
+    Fs=[];
+    if !isstr(region) && !isempty(region)
+      Fs = region; region=[];
+    endif
+  endif
+
+  if isempty(a) a=1; endif
+  if isempty(n) n=512; endif
+  if isempty(region) 
+    if isreal(b) && isreal(a)
+      region = "half"; 
+    else
+      region = "whole";
+    endif
+  endif
+  if isempty(Fs) 
+    if (nargout==0) Fs = 2; else Fs = 2*pi; endif
+  endif
+
+  if !is_scalar(n)
+    if nargin==4 ## Fs was specified
+      w = 2*pi*n/Fs;
+    else
+      w = n;
+    endif
+    n = length(n);
+    extent = 0;
+  elseif (strcmp(region,"whole"))
+    w = 2*pi*[0:(n-1)]/n;
+    extent = n;
+  else
+    w = pi*[0:(n-1)]/n;
+    extent = 2*n;
+  endif
+
+  la = length(a);
+  a = reshape(a,1,la);
+  lb = length(b);
+  b = reshape(b,1,lb);
+  k = max([la, lb]);
+
+  if (length(b) == 1 && length(a)>1)
+    hb = 1;
+    if length(a) == 1
+      dhb = zeros(1,n);
+    else
+      dhb = 0;
+    endif
+  elseif( extent >= k)
+    hb = fft(postpad(b,extent));
+    dhb = fft(postpad(b,extent).*[0:extent-1]);
+  else
+    hb = polyval(postpad(b,k),exp(j*w));
+    dhb = polyval(postpad(b,k).*[0:k-1],exp(j*w));
+  endif
+  if (length(a) == 1)
+    ha = a;
+    dha = 0;
+  elseif( extent >= k)
+    ha = fft(postpad(a,extent));
+    dha = fft(postpad(a,extent).*[0:extent-1]);
+  else
+    ha = polyval(postpad(a,k),exp(j*w));
+    dha = polyval(postpad(a,k).*[0:k-1],exp(j*w));
+  endif
+
+  g = dhb./hb - dha./ha;
+  idx = find(abs(hb.*ha)<100*eps); 
+  g(idx)=zeros(size(idx));
+  w = Fs*w/(2*pi);
+
+  if nargout >= 1 # return values but don't plot
+    g_r = g(1:n);
+    w_r = w(1:n);
+  else            # plot but don't return values
+    unwind_protect
+      grid;
+      xlabel(["Frequency (Fs=", num2str(Fs), ")"]);
+      ylabel("Group delay (samples)");
+      plot(w(1:n), real(g(1:n)), ";;");
+    unwind_protect_cleanup
+      grid("off");
+      xlabel("");
+      ylabel("");
+    end_unwind_protect
+  endif
+
+endfunction
+
+
+%!demo
+%! subplot(211); 
+%! title ("zero at .9");
+%! grpdelay (poly (0.9 * exp(1i*pi)));
+%! hold on; grid("on"); 
+%! stem (1, -9, "bo;target;"); 
+%! hold off;
+%!
+%! subplot(212); axis ([.9, 1.1, -9, 0]); 
+%! grpdelay (poly(0.9*exp(1i*pi)),[],[.9:.0001:1.1]*pi);
+%! hold on; grid("on"); 
+%! stem(1,-9,"bo;target;"); 
+%! hold off;
+%! axis(); oneplot();
+%! %--------------------------------------------------------------
+%! % From Oppenheim and Schafer, a single zero of radius r=0.9 at
+%! % angle pi should have a group delay of about -9 at 1 and 1/2
+%! % at zero and 2*pi.
+
+%!demo
+%! grpdelay(poly([1/0.9*exp(1i*pi*0.2), 0.9*exp(1i*pi*0.6)]), ...
+%!	    poly([0.9*exp(-1i*pi*0.6), 1/0.9*exp(-1i*pi*0.2)])); grid('on');
+%! hold on; stem([0.2, 0.6, 1.4, 1.8], [9, -9, 9, -9],"bo;target;"); hold off;
+%! %--------------------------------------------------------------
+%! % confirm the group delays approximately meet the targets
+%! % don't worry that it is not exact, as I have not entered
+%! % the exact targets.
+
+%!test
+%! Fs = 8000;
+%! [b, a] = cheby1(3, 3, 2*[1000, 3000]/Fs, 'stop');
+%! [h, w] = grpdelay(b, a, 256, "half", Fs);
+%! [h2, w2] = grpdelay(b, a, 512, "whole", Fs);
+%! assert (size(h), size(w));
+%! assert (length(h), 256); 
+%! assert (size(h2), size(w2));
+%! assert (length(h2), 512); 
+%! assert (h, h2(1:256));
+%! assert (w, w2(1:256));
+
+%!demo
+%! Fs = 8000;
+%! [b, a] = cheby1(3, 3, 2*[1000, 3000]/Fs, 'stop');
+%! grpdelay(b,a,[],Fs);
+%! %--------------------------------------------------------------
+%! % IIR bandstop filter has delays at [1000, 3000]
+
+%!demo
+%! subplot(211);
+%! b = fir1(40,0.3);
+%! grpdelay(b);
+%! subplot(212); axis([0.3, 0.5]);
+%! grpdelay(b,[],pi*[.3:.0001:.5]); axis(); oneplot();
+%! %--------------------------------------------------------------
+%! % fir lowpass order 40 with cutoff at w=0.3 and details of
+%! % the transition band [.3, .5]
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/hilbert.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,34 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: y = hilbert(x)
+##
+## real(y) contains the original signal x (x must be a real-valued)
+## imag(y) contains the hilbert transform of x
+## if x is a matrix, computes the hilbert transform on each row
+function y = hilbert(x)
+  if nargin != 1, usage("y = hilbert(x)"); endif
+  if !isreal(x), error("hilbert: requires real input vector"); endif
+  transpose = rows(x)==1;
+  if transpose, x=x.'; endif
+  [r, c] = size(x);
+  n=2^nextpow2(r);
+  if r < n, x = [ x ; zeros(n-r, c) ]; endif
+  y = fft(x);
+  y = ifft([y(1,:) ; 2*y(2:n/2,:) ; y(n/2+1,:) ; zeros(n/2-1,columns(y))]);
+  if r < n, y(r+1:n,:) = []; endif
+  if transpose, y = y.'; endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/idct.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,78 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## y = dct (x, n)
+##    Computes the inverse discrete cosine transform of x.  If n is
+##    given, then x is padded or trimmed to length n before computing
+##    the transform. If x is a matrix, compute the transform along the
+##    columns of the the matrix. The transform is faster if x is
+##    real-valued and even length.
+##
+## The inverse discrete cosine transform x of X can be defined as follows:
+##
+##          N-1
+##   x[n] = sum w(k) X[k] cos (pi (2n-1) k / 2N ),  k = 0, ..., N-1
+##          k=0
+##
+## with w(0) = sqrt(1/N) and w(k) = sqrt(2/N), k = 1, ..., N-1
+##
+## See also: idct, dct2, idct2, dctmtx
+
+## Author: Paul Kienzle
+## 2001-02-08
+##   * initial release
+function y = idct (x, n)
+
+  if (nargin < 1 || nargin > 2)
+    usage ("y = dct(x [, n])");
+  endif
+
+  realx = isreal(x);
+  transpose = (rows (x) == 1);
+
+  if transpose, x = x (:); endif
+  [nr, nc] = size (x);
+  if nargin == 1
+    n = nr;
+  elseif n > nr
+    x = [ x ; zeros(n-nr,nc) ];
+  elseif n < nr
+    x (n-nr+1 : n, :) = [];
+  endif
+
+  if ( realx && rem (n, 2) == 0 )
+    w = [ sqrt(n/4); sqrt(n/2)*exp((1i*pi/2/n)*[1:n-1]') ] * ones (1, nc);
+    y = ifft (w .* x);
+    y([1:2:n, n:-2:1], :) = 2*real(y);
+  elseif n == 1
+    y = x;
+  else
+    ## reverse the steps of dct using inverse operations
+    ## 1. undo post-fft scaling
+    w = [ sqrt(4*n); sqrt(2*n)*exp((1i*pi/2/n)*[1:n-1]') ] * ones (1, nc);
+    y = x.*w;
+
+    ## 2. reconstruct fft result and invert it
+    w = exp(-1i*pi*[n-1:-1:1]'/n) * ones(1,nc);
+    y = ifft ( [ y ; zeros(1,nc); y(n:-1:2,:).*w ] );
+
+    ## 3. keep only the original data; toss the reversed copy
+    y = y(1:n, :);
+    if (realx) y = real (y); endif
+  endif
+  if transpose, y = y.'; endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/idct2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,49 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## y = idct2 (x)
+##   Computes the inverse 2-D discrete cosine transform of matrix x
+##
+## y = idct2 (x, m, n) or y = idct2 (x, [m n])
+##   Computes the 2-D inverse DCT of x after padding or trimming rows to m and
+##   columns to n.
+
+## Author: Paul Kienzle
+## 2001-02-08
+##   * initial revision
+
+function y = idct2 (x, m, n)
+
+  if (nargin < 1 || nargin > 3)
+    usage("idct (x) or idct (x, m, n) or idct (x, [m n])");
+  endif
+
+  if nargin == 1
+    [m, n] = size (x);
+  elseif (nargin == 2)
+    n = m (2); 
+    m = m (1);
+  endif
+
+  if m == 1
+    y = idct (x.', n).';
+  elseif n == 1
+    y = idct (x, m);
+  else
+    y = idct (idct (x, m).', n).';
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/impz.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,106 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [x, t] = impz(b [, a, n, fs])
+##
+## Generate impulse-response characteristics of the filter. The filter
+## coefficients correspond to the the z-plane rational function with
+## numerator b and denominator a.  If a is not specified, it defaults to
+## 1. If n is not specified, or specified as [], it will be chosen such
+## that the signal has a chance to die down to -120dB, or to not explode
+## beyond 120dB, or to show five periods if there is no significant
+## damping. If no return arguments are requested, plot the results.
+##
+## See also: freqz, zplane
+
+## 1999 pkienzle@kienzle.powernet.co.uk
+##      - if nargout=0, produce plot and don't set return values
+
+## TODO: Call equivalent function from control toolbox since it is
+## TODO:    probably more sophisticated than this one, and since it
+## TODO:    is silly to maintain two different versions of essentially
+## TODO:    the same thing.
+function [x_r, t_r] = impz(b, a, n, fs)
+
+  if nargin == 0 || nargin > 4
+    usage("impz(b [, a, n, fs])");
+  end
+  if nargin < 2, a = [1]; end
+  if nargin < 3, n = []; end
+  if nargin < 4, fs = 1; end
+
+  if isempty(n) && length(a) > 1
+    precision = 1e-6;
+    r = roots(a);
+    maxpole = max(abs(r));
+    if (maxpole > 1+precision)     # unstable -- cutoff at 120 dB
+      n = floor(6/log10(maxpole));
+    elseif (maxpole < 1-precision) # stable -- cutoff at -120 dB
+      n = floor(-6/log10(maxpole));
+    else                        # periodic -- cutoff after 5 cycles
+      n = 30;
+      
+				# find longest period less than infinity
+				# cutoff after 5 cycles (w=10*pi)
+      rperiodic = r(find(abs(r)>=1-precision & abs(arg(r))>0));
+      if !isempty(rperiodic)
+	n_periodic = ceil(10*pi./min(abs(arg(rperiodic))));
+	if (n_periodic > n)
+	  n = n_periodic;
+	end
+      end
+      
+				# find most damped pole
+				# cutoff at -60 dB
+      rdamped = r(find(abs(r)<1-precision));
+      if !isempty(rdamped)
+	n_damped = floor(-3/log10(max(abs(rdamped))));
+	if (n_damped > n)
+	  n = n_damped;
+	end
+      end
+    end
+    n = n + length(b);
+  elseif isempty(n)
+    n = length(b);
+  end
+
+  if length(a) == 1
+    x = fftfilt(b/a, [1, zeros(1,n-1)]);
+  else
+    x = filter(b, a, [1, zeros(1,n-1)]);
+  end
+  t = [0:n-1]/fs;
+
+  if nargout >= 1 x_r = x; end;
+  if nargout >= 2 t_r = t; end;
+  if nargout == 0
+    unwind_protect
+      title "Impulse Response";
+      if (fs > 1000)
+      	t = t * 1000;
+      	xlabel("Time (msec)");
+      else
+      	xlabel("Time (sec)");
+      end
+      plot(t, x, "^r;;");
+    unwind_protect_cleanup
+      title ("")
+      xlabel ("")
+    end_unwind_protect
+  end
+
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/interp.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,65 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: y = interp(x, q [, n [, Wc]])
+##
+## Upsample the signal x by a factor of q, using an order 2*q*n+1 FIR
+## filter. Note that q must be an integer for this rate change method.
+## n defaults to 4 and Wc defaults to 0.5.
+##
+## Example
+##                                          # Generate a signal.
+##    t=0:0.01:2; x=chirp(t,2,.5,10,'quadratic')+sin(2*pi*t*0.4); 
+##    y = interp(x(1:4:length(x)),4,4,1);   # interpolate a sub-sample
+##    stem(t(1:121)*1000,x(1:121),"-g;Original;"); hold on;
+##    stem(t(1:121)*1000,y(1:121),"-r;Interpolated;");
+##    stem(t(1:4:121)*1000,x(1:4:121),"-b;Subsampled;"); hold off;
+##
+## See also: decimate, resample
+
+function y = interp(x, q, n, Wc)
+
+  if nargin < 1 || nargin > 4, 
+    usage("y=interp(x, q [, n [, Wc]])"); 
+  endif
+  if q != fix(q), error("decimate only works with integer q."); endif
+
+  if nargin<3
+    n=4; Wc=0.5;
+  elseif nargin<4
+    Wc=0.5;
+  endif
+
+  if rows(x)>1
+    y = zeros(length(x)*q+q*n+1,1);
+  else
+    y = zeros(1,length(x)*q+q*n+1);
+  endif
+  y(1:q:length(x)*q) = x;
+  b = fir1(2*q*n+1, Wc/q);
+  y=q*fftfilt(b, y);
+  y(1:q*n+1) = [];  # adjust for zero filter delay
+endfunction
+
+%!demo
+%! ## Generate a signal.
+%! t=0:0.01:2; x=chirp(t,2,.5,10,'quadratic')+sin(2*pi*t*0.4); 
+%! y = interp(x(1:4:length(x)),4,4,1);   # interpolate a sub-sample
+%! plot(t(1:121)*1000,y(1:121),"r-+;Interpolated;"); hold on;
+%! stem(t(1:4:121)*1000,x(1:4:121),"ob;Original;"); hold off;
+%!
+%! % graph shows interpolated signal following through the
+%! % sample points of the original signal.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/kaiser.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,67 @@
+## Copyright (C) 1995, 1996, 1997  Kurt Hornik
+## 
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+## 
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details. 
+## 
+## You should have received a copy of the GNU General Public License
+## along with this file.  If not, write to the Free Software Foundation,
+## 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+## usage:  kaiser (n, beta)
+##
+## Returns the filter coefficients of the n-point Kaiser window with
+## parameter beta.
+##
+## For the definition of the Kaiser window, see A. V. Oppenheim &
+## R. W. Schafer, "Discrete-Time Signal Processing".
+##
+## The continuous version of width n centered about x=0 is:
+##
+##         besseli(0, beta * sqrt(1-(2*x/n).^2))
+## k(x) =  -------------------------------------,  n/2 <= x <= n/2
+##                besseli(0, beta)
+##
+## See also: kaiserord
+  
+## Author:  KH <Kurt.Hornik@ci.tuwien.ac.at>
+## Description:  Coefficients of the Kaiser window
+
+## 2000-02 Paul Kienzle (pkienzle@kienzle.powernet.co.uk)
+##    use besseli rather than jybess
+##    note, although Oppenheim & Schafer, 2nd edition has a formula
+##    which looks completely different than the one herein, it gives
+##    identical results
+  
+function w = kaiser (n, beta)
+  
+  if (nargin != 2)
+    usage ("kaiser (n, beta)");
+  endif
+  
+  if !(is_scalar (n) && (n == round (n)) && (n > 0))
+    error ("kaiser:  n has to be a positive integer");
+  endif
+  if !(is_scalar (beta) && (beta == real (beta)))
+    error ("kaiser:  beta has to be a real scalar");
+  endif
+  
+  if (n == 1)
+    w = 1;
+  else
+    m = n - 1;
+    k = (0 : m)';
+    k = 2 * beta / m * sqrt (k .* (m - k));
+    w = besseli (0, k) / besseli (0, beta);
+  endif
+    
+endfunction
+
+%!demo
+%! % use demo("kaiserord");
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/kaiserord.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,148 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [n, Wn, beta, ftype] = kaiserord(f, m, dev [, fs])
+##
+## Returns the parameters needed for fir1 to produce a filter of the
+## desired specification from a kaiser window:
+##       n: order of the filter (length of filter minus 1)
+##       Wn: band edges for use in fir1
+##       beta: parameter for kaiser window of length n+1
+##       ftype: choose between pass and stop bands
+##       b = fir1(n,Wn,kaiser(n+1,beta),ftype,'noscale');
+##
+## f: frequency bands, given as pairs, with the first half of the
+##    first pair assumed to start at 0 and the last half of the last
+##    pair assumed to end at 1.  It is important to separate the
+##    band edges, since narrow transition regions require large order
+##    filters.
+## m: magnitude within each band.  Should be non-zero for pass band
+##    and zero for stop band.  All passbands must have the same
+##    magnitude, or you will get the error that pass and stop bands
+##    must be strictly alternating.
+## dev: deviation within each band.  Since all bands in the resulting
+##    filter have the same deviation, only the minimum deviation is
+##    used.  In this version, a single scalar will work just as well.
+## fs: sampling rate.  Used to convert the frequency specification into
+##    the [0, 1], where 1 corresponds to the Nyquist frequency, fs/2.
+##
+## The Kaiser window parameters n and beta are computed from the
+## relation between ripple (A=-20*log10(dev)) and transition width 
+## (dw in radians) discovered empirically by Kaiser:
+##
+##           / 0.1102(A-8.7)                        A > 50
+##    beta = | 0.5842(A-21)^0.4 + 0.07886(A-21)     21 <= A <= 50
+##           \ 0.0                                  A < 21
+##
+##    n = (A-8)/(2.285 dw)
+##
+## Example
+##    [n, w, beta, ftype] = kaiserord([1000,1200], [1,0], [0.05,0.05], 11025);
+##    freqz(fir1(n,w,kaiser(n+1,beta),ftype,'noscale'),1,[],11025);
+
+## TODO: order is underestimated for the final test case: 2 stop bands.
+## TODO:     octave> ftest("kaiserord") # shows test cases
+
+function [n, w, beta, ftype] = kaiserord(f, m, dev, fs)
+
+  if (nargin<2 || nargin>4)
+    usage("[n, w, beta, ftype] = kaiserord(f, m, dev [, fs])");
+  endif
+
+  ## default sampling rate parameter
+  if nargin<4, fs=2; endif
+
+  ## parameter checking
+  if length(f)!=2*length(m)-2 
+    error("kaiserord must have one magnitude for each frequency band");
+  endif
+  if any(m(1:length(m)-2)!=m(3:length(m)))
+    error("kaiserord pass and stop bands must be strictly alternating");
+  endif
+  if length(dev)!=length(m) && length(dev)!=1
+    error("kaiserord must have one deviation for each frequency band");
+  endif
+  dev = min(dev);
+  if dev <= 0, error("kaiserord must have dev>0"); endif
+
+  ## use midpoints of the transition region for band edges
+  w = (f(1:2:length(f))+f(2:2:length(f)))/fs;
+
+  ## determine ftype
+  if length(w) == 1
+    if m(1)>m(2), ftype='low'; else ftype='high'; endif
+  elseif length(w) == 2
+    if m(1)>m(2), ftype='stop'; else ftype='pass'; endif
+  else
+    if m(1)>m(2), ftype='DC-1'; else ftype='DC-0'; endif
+  endif
+
+  ## compute beta from dev
+  A = -20*log10(dev);
+  if (A > 50)
+    beta = 0.1102*(A-8.7);
+  elseif (A >= 21)
+    beta = 0.5842*(A-21)^0.4 + 0.07886*(A-21);
+  else
+    beta = 0.0;
+  endif
+
+  ## compute n from beta and dev
+  dw = 2*pi*min(f(2:2:length(f))-f(1:2:length(f)))/fs;
+  n = max(1,ceil((A-8)/(2.285*dw)));
+
+  ## if last band is high, make sure the order of the filter is even.
+  if ((m(1)>m(2)) == (rem(length(w),2)==0)) && rem(n,2)==1, n = n+1; endif
+endfunction
+
+%!demo
+%! Fs = 11025;
+%! for i=1:4
+%!   if i==1,
+%!     subplot(221); bands=[1200, 1500]; mag=[1, 0]; dev=[0.1, 0.1];
+%!   elseif i==2
+%!     subplot(222); bands=[1000, 1500]; mag=[0, 1]; dev=[0.1, 0.1];
+%!   elseif i==3
+%!     subplot(223); bands=[1000, 1200, 3000, 3500]; mag=[0, 1, 0]; dev=0.1;
+%!   elseif i==4
+%!     subplot(224); bands=100*[10, 13, 15, 20, 30, 33, 35, 40]; 
+%!     mag=[1, 0, 1, 0, 1]; dev=0.05;
+%!   endif
+%!   [n, w, beta, ftype] = kaiserord(bands, mag, dev, Fs);
+%!   d=max(1,fix(n/10)); 
+%!   if mag(length(mag))==1 && rem(d,2)==1, d=d+1; endif
+%!   [h, f] = freqz(fir1(n,w,ftype,kaiser(n+1,beta),'noscale'),1,[],Fs);
+%!   hm = freqz(fir1(n-d,w,ftype,kaiser(n-d+1,beta),'noscale'),1,[],Fs);
+%!   plot(f,abs(hm),sprintf("r;order %d;",n-d), ...
+%!	  f,abs(h), sprintf("b;order %d;",n));
+%!   b = [0, bands, Fs/2]; hold on;
+%!   for i=2:2:length(b), 
+%!     hi=mag(i/2)+dev(1); lo=max(mag(i/2)-dev(1),0);
+%!     plot([b(i-1), b(i), b(i), b(i-1), b(i-1)],[hi, hi, lo, lo, hi],"c;;");
+%!   endfor; hold off;
+%! endfor
+%! oneplot();
+%! %--------------------------------------------------------------
+%! % A filter meets the specifications if its frequency response
+%! % passes through the ends of the criteria boxes, and fails if
+%! % it passes through the top or the bottom.  The criteria are
+%! % met precisely if the frequency response only passes through
+%! % the corners of the boxes.  The blue line is the filter order
+%! % returned by kaiserord, and the red line is some lower filter
+%! % order.  Confirm that the blue filter meets the criteria and
+%! % the red line fails.
+
+%!test error("extend demo to show detail at criteria box corners");
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/levinson.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,73 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+##
+## Based on:
+##    yulewalker.m
+##    Copyright (C) 1995 (GPL)
+##    Friedrich Leisch <Friedrich.Leisch@ci.tuwien.ac.at>
+
+## usage:  [a, v, ref] = levinson (acf [, p])
+##
+## Use the Durbin-Levinson algorithm to solve:
+##    toeplitz(acf(1:p)) * x = -acf(2:p+1).
+## The solution [1, x'] is the denominator of an all pole filter
+## approximation to the signal x which generated the autocorrelation
+## function acf.  
+##
+## acf is the autocorrelation function for lags 0 to p.
+## p defaults to length(acf)-1.
+## Returns 
+##   a=[1, x'] the denominator filter coefficients. 
+##   v= variance of the white noise = square of the numerator constant
+##   ref = reflection coefficients = coefficients of the lattice
+##         implementation of the filter
+## Use freqz(sqrt(v),a) to plot the power spectrum.
+   
+## Author:  PAK <pkienzle@kienzle.powernet.co.uk>
+
+## TODO: Matlab doesn't return reflection coefficients and 
+## TODO:    errors in addition to the polynomial a.
+## TODO: What is the difference between aryule, levinson, 
+## TODO:    ac2poly, ac2ar, lpc, etc.?
+  
+function [a, v, ref] = levinson (acf, p)
+  
+  if( columns (acf) > 1 ) acf=acf'; endif
+  if (nargin == 1) p = length(acf) - 1; endif
+
+  if nargout < 3 && p < 100
+    ## direct solution [O(p^3), but no loops so slightly faster for small p]
+    R = toeplitz(acf(1:p), conj(acf(1:p)));
+    a = R \ -acf(2:p+1);
+    a = [ 1, a' ];
+    v = sum(a'.*acf(1:p+1));
+  else
+    ## durbin-levinson [O(p^2), so significantly faster for large p]
+    ref = zeros (1, p);
+    g = acf(2) / acf(1);
+    a = [ g ];
+    v = ( 1 - g^2 ) * acf(1);
+    ref(1) = g;
+    for t = 2 : p
+      g = (acf(t+1) - a * acf(2:t)) / v;
+      a = [ g,  a-g*a(t-1:-1:1) ];
+      v = v * ( 1 - g^2 ) ;
+      ref(t) = g;
+    endfor
+    a = [1, -a(p:-1:1)];
+  endif
+    
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/medfilt1.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,228 @@
+/*
+ * Copyright 2000 Paul Kienzle, <pkienzle@kienzle.powernet.co.uk>
+ * This source code is freely redistributable and may be used for
+ * any purpose.  This copyright notice must be maintained. 
+ * Paul Kienzle is not responsible for the consequences of using
+ * this software.
+ *
+ * Mar 2000 - Kai Habel (kahacjde@linux.zrz.tu-berlin.de)
+ *      Change: ColumnVector x=arg(i).vector_value();
+ *      to: ColumnVector x=ColumnVector(arg(i).vector_value());
+ * Oct 2000 - Paul Kienzle (pkienzle@kienzle.powernet.co.uk)
+ *      rewrite to ignore NaNs rather than replacing them with zero
+ *      extend to handle matrix arguments
+ */
+
+#include <octave/oct.h>
+#include <octave/lo-ieee.h>
+#include <octave/lo-mappers.h>
+#include <math.h>
+
+// The median class holds a sorted data window.  This window is
+// intended to slide over the data, so when the window shifts
+// by one position, the old value from the start of the window must
+// be removed and the new value from the end of the window must
+// be added.  Since removals and additions generally occur in pairs,
+// a hole is left in the sorted window when the value is removed so
+// that on average, fewer values need to be shifted to close the
+// hole and open a new one in the sorted position.
+class Median {
+private:
+  double *window; // window data 
+  int max;        // length of window used
+  int hole;       // position of hole, or max if no hole
+  void close_hole() // close existing hole
+  {
+    // move hole to the end of the window
+    while (hole < max-1) {
+      window[hole] = window[hole+1];
+      hole++;
+    }
+    // shorten window (if no hole, then hole==max)
+    if (hole == max-1) max--;
+  }
+  void print();
+
+public:
+  Median(int n) { max=hole=0; window = new double[n]; }
+  void add(double v);          // add a new value
+  void remove(double v);       // remove an existing value
+  void clear() { max=hole=0; } // clear the window
+  double operator() ();        // find the median in the window
+} ;
+
+// Print the sorted window, and indicate any hole
+void Median::print()
+{
+  cout << "[ ";
+  for (int i=0; i < max; i++)
+    {
+      if (i == hole)
+	cout << "x ";
+      else
+	cout << window[i] << " ";
+    }
+  cout << " ]";
+}
+
+    
+// Remove a value from the sorted window, leaving a hole.  The caller
+// must promise to only remove values that they have added.
+void Median::remove(double v)
+{
+  // NaN's are not added or removed
+  if (xisnan(v)) return;
+
+  //  cout << "Remove " << v << " from "; print();
+
+  // only one hole allowed, so close pre-existing ones
+  close_hole();
+
+  // binary search to find the value to remove
+  int lo = 0, hi=max-1;
+  hole = hi/2;
+  while (lo <= hi) {
+    if (v > window[hole]) lo = hole+1;
+    else if (v < window[hole]) hi = hole-1;
+    else break;
+    hole = (lo+hi)/2;
+  }
+
+  // Verify that it is the correct value to replace
+  // Note that we shouldn't need this code since we are always replacing
+  // a value that is already in the window, but for some reason
+  // v==window[hole] occasionally doens't work.
+  if (v != window[hole]) {
+    for (hole = 0; hole < max-1; hole++)
+      if (fabs(v-window[hole]) < fabs(v-window[hole+1])) break;
+    warning ("medfilt1: value %f not found---removing %f instead", 
+	     v, window[hole]);
+    print(); cout << endl;
+  }
+
+  //  cout << " gives "; print(); cout << endl;
+}
+
+// Insert a new value in the sorted window, plugging any holes, or
+// extending the window as necessary.  The caller must promise not
+// to add more values than median was created with, without
+// removing some beforehand.
+void Median::add(double v)
+{
+  // NaN's are not added or removed
+  if (xisnan(v)) return;
+
+  //  cout << "Add " << v << " to "; print();
+
+  // If no holes, extend the array
+  if (hole == max) max++;
+
+  // shift the hole up to the beginning as far as it can go.
+  while (hole > 0 && window[hole-1] > v) {
+    window[hole] = window[hole-1];
+    hole--;
+  }
+
+  // or shift the hole down to the end as far as it can go.
+  while (hole < max-1 && window[hole+1] < v) {
+    window[hole] = window[hole+1];
+    hole++;
+  }
+
+  // plug in the replacement value
+  window[hole] = v;
+
+  // close the hole
+  hole = max;
+
+  //  cout << " gives "; print(); cout << endl;
+}
+
+// Compute the median value from the sorted window
+// Return the central value if there is one or the average of the 
+// two central values.  Return NaN if there are no values.
+double Median::operator()() 
+{
+  close_hole();
+
+  if (max % 2 == 1)
+    return window[(max-1)/2];
+  else if (max == 0)
+    return octave_NaN;
+  else
+    return (window[max/2-1]+window[max/2])/2.0;
+}
+
+DEFUN_DLD (medfilt1, args, ,
+  "y = medfilt1(x [, n])\n\
+\n\
+Apply a median filter of length n to the signal x.  A sliding window is\n\
+applied to the data, and for each step the median value in the window is\n\
+returned.  If n is odd then the window for y(i) is x(i-(n-1)/2:i+(n-1)/2).\n\
+If n is even then the window is x(i-n/2:i+n/2-1) and the two values in the\n\
+center of the sorted window are averaged. If n is not given, then 3 is used.\n\
+NaNs are ignored, as are values beyond the ends, by taking the median of\n\
+the remaining values.")
+{
+  octave_value_list retval;
+
+  int nargin = args.length();
+  if (nargin < 1 || nargin > 3) 
+    {
+      print_usage ("medfilt1");
+      return retval;
+    }
+
+  if (args(0).is_complex_type()) 
+    {
+      error("medfilt1 cannot process complex vectors");
+      return retval;
+    }
+
+  int n=3;    // length of the filter (default 3)
+  if (nargin > 1) n = NINT(args(1).double_value());
+  if (n < 1) 
+    {
+      error ("medfilt1 filter length must be at least 1");
+      return retval;
+    }
+
+  // Create a window to hold the sorted median values
+  Median median(n);
+  int mid = n/2;             // mid-point of the window
+
+  Matrix signal(args(0).matrix_value()); 
+  int nr = signal.rows();    // number of points to process
+  int nc = signal.columns(); // number of points to process
+  Matrix filter(nr,nc);      // filtered signal to return
+
+  if (nr == 1) // row vector
+    {
+      int start = -n, end = 0, pos=-(n-mid)+1;
+      while (pos < nc) 
+	{
+	  if (start >= 0) median.remove(signal(0,start));
+	  if (end < nc)   median.add(signal(0,end));
+	  if (pos >= 0)   filter(0,pos) = median();
+	  start++, end++, pos++;
+	}
+    }
+  else // column vector or matrix
+    {
+      for (int column=0; column < nc; column++)
+	{
+	  median.clear();
+	  int start = -n, end = 0, pos=-(n-mid)+1;
+	  while (pos < nr) 
+	    {
+	      if (start >= 0) median.remove(signal(start,column));
+	      if (end < nr)   median.add(signal(end,column));
+	      if (pos >= 0)   filter(pos,column) = median();
+	      start++, end++, pos++;
+	    }
+	}
+    }
+
+  retval(0) = filter;
+  return retval;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/pburg.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,92 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage:  [P, f] = pburg (x, p [, nfft [, Fs [, range]]] [, units])
+## 
+## Fits x with an AR (p)-model with Burg's method, and computes
+## the power spectrum.
+##
+## x = signal to estimate
+## nfft is number of points at which to sample the power spectrum
+## Fs is the sampling frequency of x
+## range is 'half' or 'whole'
+## units is  'squared' for magnitude squared, or 'db' for decibels (default)
+##
+## Returns P, the magnitude vector, and f, the frequencies at which it
+## is sampled.  If there are no return values requested, then plot the power
+## spectrum and don't return anything.
+##
+function [P, w] = pburg (x, p, ...)
+  
+  if (nargin < 2 || nargin > 6) 
+    usage("[P, f] = pburg(x, p [,nfft [,Fs [,range]]] [, units])");
+  endif
+  
+  [a, v] = arburg(x, p);
+  if (nargout == 0)
+    __power(sqrt(v), a, all_va_args);
+  else
+    [P, w] = __power(sqrt(v), a, all_va_args);
+  endif
+
+endfunction
+
+%!demo
+%! ## construct target system:
+%! ##   symmetric zero-pole pairs at r*exp(iw),r*exp(-iw)
+%! ##   zero-pole singletons at s
+%! pw=[0.2, 0.4, 0.45, 0.95];   #pw = [0.4];
+%! pr=[0.98, 0.98, 0.98, 0.96]; #pr = [0.85];
+%! ps=[];
+%! zw=[0.3];  # zw=[];
+%! zr=[0.95]; # zr=[];
+%! zs=[];
+%! 
+%! save_empty_list_elements_ok = empty_list_elements_ok;
+%! unwind_protect
+%!   empty_list_elements_ok = 1;
+%!   ## system function for target system
+%!   p=[[pr, pr].*exp(1i*pi*[pw, -pw]), ps];
+%!   z=[[zr, zr].*exp(1i*pi*[zw, -zw]), zs];
+%! unwind_protect_cleanup
+%!   empty_list_elements_ok = save_empty_list_elements_ok;
+%! end_unwind_protect
+%! sys_a = real(poly(p));
+%! sys_b = real(poly(z));
+%! order = length(p)+length(z);
+%!
+%! ## simulation
+%! n=512;
+%! var=0.05;  #var=0;
+%! s = [1; sqrt(var)*randn(n-1,1)]; var=(1+var*(n-1))/n;
+%! x = filter(sys_b,sys_a,s); % AR system output
+%!
+%! ## test
+%! subplot(211);
+%! title("magnitude squared spectral estimate (pburg)");
+%! p = abs(fft(x)).^2;
+%! plot(linspace(0,1,n/2),p(1:n/2),';FFT spectrum;');
+%! hold on; pburg(x, order, 'squared'); hold off;
+%!
+%! subplot(212);
+%! title("log-magnitude-squared spectral estimate (pburg)");
+%! p = 20*log10(abs(fft(x)));
+%! plot(linspace(0,1,n/2),p(1:n/2),';FFT spectrum;');
+%! hold on; pburg(x, order); hold off;
+%!
+%! oneplot();
+%! %------------------------------------------------
+%! % Confirm that the power spectrum matches the FFT
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/polystab.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,25 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+function b = polystab(a)
+
+   r = roots(a);
+   v = find(abs(r)>1);
+   r(v) = 1./conj(r(v));
+   b = a(1) * poly ( r );
+   if isreal(a), b = real(b); endif
+
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/pulstran.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,150 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: y=pulstran(t,d,'func',...)
+##        y=pulstran(t,d,p,Fs,'interp')
+##
+## Generate the signal y=sum(func(t+d,...)) for each d.  If d is a
+## matrix of two columns, the first column is the delay d and the second
+## column is the amplitude a, and y=sum(a*func(t+d)) for each d,a.
+## Clearly, func must be a function which accepts a vector of times.
+## Any extra arguments needed for the function must be tagged on the end.
+##
+## Example
+##   fs = 11025;  # arbitrary sample rate
+##   f0 = 100;    # pulse train sample rate
+##   w = 0.001;   # pulse width of 1 millisecond
+##   auplot(pulstran(0:1/fs:0.1, 0:1/f0:0.1, 'rectpuls', w), fs);
+##
+## If instead of a function name you supply a pulse shape sampled at
+## frequency Fs (default 1 Hz),  an interpolated version of the pulse
+## is added at each delay d.  The interpolation stays within the the
+## time range of the delayed pulse.  The interpolation method defaults
+## to linear, but it can be any interpolation method accepted by the
+## function interp1.
+##
+## Example
+##   fs = 11025;  # arbitrary sample rate
+##   f0 = 100;    # pulse train sample rate
+##   w = boxcar(10);  # pulse width of 1 millisecond at 10 kHz
+##   auplot(pulstran(0:1/fs:0.1, 0:1/f0:0.1, w, 10000), fs);
+
+## TODO: Make it faster.  It is currently unusable for anything real.
+## TODO: It may not be possible to speed it up with the present interface.
+## TODO: See speech/voice.m for a better way.
+
+## Note that pulstran can be used for some pretty strange things such
+## as simple band-limited interpolation:
+##     xf = 0:0.05:10; yf = sin(2*pi*xf/5);
+##     xp = 0:10; yp = sin(2*pi*xp/5); # .2 Hz sine sampled every second
+##     s = pulstran(xf, [xp, yp],'sinc'); 
+##     plot(f, yf, ";original;", xf, s, ";sinc;",xp,yp,"*;;");
+## You wouldn't want to do this in practice since it is expensive, and
+## since it works much better with a windowed sinc function, at least
+## for short samples.
+
+function y = pulstran(t, d, pulse, ...) ##<oct
+##<mat function y = pulstran(t, d, pulse, varargin)
+
+  if nargin<3 || (!isstr(pulse) && nargin>5)
+    error("y=pulstran(t,d,'func',...) or y==pulstran(t,d,p,Fs,'interp')");
+  endif
+  y = zeros(size(t));
+  if isempty(y), return; endif
+  if rows(d) == 1, d=d'; endif
+  if columns(d) == 2, 
+    a=d(:,2);
+  else
+    a=ones(rows(d),1);
+  endif
+  if isstr(pulse) 
+    ## apply function t+d for all d
+    for i=1:rows(d)
+      y = y+a(i)*feval(pulse,t-d(i,1),all_va_args); ##<oct
+      ##<mat y = y+a(i)*feval(pulse,t-d(i,1),varargin{:});
+    endfor
+  else
+    ## interpolate each pulse at the specified times
+    Fs = 1; method = 'linear';
+    if nargin==4
+      arg = va_arg();  ##<oct
+      ##<mat arg=varargin{1};
+      if isstr(arg), 
+	method=arg;
+      else
+	Fs = arg;
+      endif
+    elseif nargin==5
+      Fs=va_arg();     ##<oct
+      method=va_arg(); ##<oct
+      ##<mat Fs = varargin{1};
+      ##<mat method = varargin{2};
+    endif
+    span = (length(pulse)-1)/Fs;
+    t_pulse = (0:length(pulse)-1)/Fs;
+    for i=1:rows(d)
+      dt = t-d(i,1);
+      idx = find(dt>=0 & dt<=span);
+      y(idx) = y(idx) + a(i)*interp1(t_pulse, pulse, dt(idx), method);
+    endfor
+  endif
+endfunction
+
+%!error pulstran
+%!error pulstran(1,2,3,4,5,6)
+
+%!## parameter size and shape checking
+%!shared t,d
+%! t = 0:0.01:1; d=0:0.1:1;
+%!assert (isempty(pulstran([], d, 'sin')));
+%!assert (pulstran(t, [], 'sin'), zeros(size(t)));
+%!assert (isempty(pulstran([], d, boxcar(5))));
+%!assert (pulstran(t, [], boxcar(5)), zeros(size(t)));
+%!assert (size(pulstran(t,d,'sin')), size(t));
+%!assert (size(pulstran(t,d','sin')), size(t));
+%!assert (size(pulstran(t',d,'sin')), size(t'));
+%!assert (size(pulstran(t,d','sin')), size(t));
+
+%!demo
+%! fs = 11025;                   # arbitrary sample rate
+%! f0 = 100;                     # pulse train sample rate
+%! w = 0.003;                    # pulse width of 3 milliseconds
+%! t = 0:1/fs:0.1; d=0:1/f0:0.1; # define sample times and pulse times 
+%! a = hanning(length(d));       # define pulse amplitudes
+%!
+%! subplot(221); title("rectpuls");
+%! auplot(pulstran(t', d', 'rectpuls', w), fs);
+%! hold on; plot(d*1000,ones(size(d)),'g*;pulse;'); hold off;
+%!
+%! subplot(223); title("sinc => band limited interpolation");
+%! auplot(pulstran(f0*t, [f0*d', a], 'sinc'), fs);
+%! hold on; plot(d*1000,a,'g*;pulse;'); hold off;
+%!
+%! subplot(222); title("interpolated boxcar");
+%! pulse = boxcar(30);  # pulse width of 3 ms at 10 kHz
+%! auplot(pulstran(t, d', pulse, 10000), fs);
+%! hold on; plot(d*1000,ones(size(d)),'g*;pulse;'); hold off;
+%!
+%! subplot(224); title("interpolated asymmetric sin");
+%! pulse = sin(2*pi*[0:0.0001:w]/w).*[w:-0.0001:0];
+%! auplot(pulstran(t', [d', a], pulse', 10000), fs);
+%! hold on; plot(d*1000,a*w,'g*;pulse;'); hold off; title("");
+%! oneplot();
+%! %----------------------------------------------------------
+%! % Should see (1) rectangular pulses centered on *,
+%! %            (2) rectangular pulses to the right of *,
+%! %            (3) smooth interpolation between the *'s, and
+%! %            (4) asymetric sines to the right of *
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/pwelch.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,363 @@
+## Copyright (C) 1999-2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [Pxx, w] = pwelch(x,n,Fs,window,overlap,ci,range,units,trend)
+##        [Pxx, Pci, w] = pwelch(x,n,Fs,window,overlap,ci,range,units,trend)
+##
+## Estimate power spectrum of a stationary signal. This chops the signal
+## into overlapping slices, windows each slice and applies a Fourier
+## transform to determine the frequency components at that slice. The
+## magnitudes of these slices are then averaged to produce the estimate Pxx.
+## The confidence interval around the estimate is returned in Pci.
+##
+## x: vector of samples
+## n: size of fourier transform window, or [] for default=256
+## Fs: sample rate, or [] for default=2 Hz
+## window: shape of the fourier transform window, or [] for default=hanning(n)
+##    Note: window length can be specified instead, in which case
+##    window=hanning(length)
+## overlap: overlap with previous window, or [] for default=length(window)/2
+## ci: confidence interval, or [] for default=0.95
+##    ci must be between 0 and 1; if ci is not passed, or if it is
+##    passed as 0, then no confidence intervals will be computed.
+## range: 'whole',  or [] for default='half'
+##    show all frequencies, or just half of the frequencies
+## units: 'squared', or [] for default='db'
+##    show results as magnitude squared or as log magnitude squared
+## trend: 'mean', 'linear', or [] for default='none'
+##    remove trends from the data slices before computing spectral estimates
+##
+## Example
+##    [b,a] = cheby1(4,3,[0.2, 0.4]);     ## define noise colour
+##    pwelch(filter(b,a,randn(2^12,1))); ## estimate noise colour
+
+## 2001-04-02 Paul Kienzle
+##    * return nfft/2+1 elements rather than nfft/2 for even nfft.
+##    * use more accurate (and faster) computation of confidence intervals
+
+## TODO: Should be extended to accept a vector of frequencies at which to
+## TODO:    evaluate the fourier transform (via filterbank or chirp
+## TODO:    z-transform).
+## TODO: What should happen with the final window when it isn't full?
+## TODO:    currently I dump it, but I should probably zero pad and add
+## TODO:    it in.
+## TODO: Consider returning the whole gamit of Pxx, Pyy, Pxy, Cxy, Txy
+## TODO:    as well as confidence intervals for each;  if users tend
+## TODO:    only to use one of these don't bother, but if they ever need
+## TODO:    more than one, then it's free.  Alternatively, break out the
+## TODO:    compute engine into a function that the user can call directly.
+## TODO: Check if Cxy, Txy are computed frame-by-frame or on the average
+## TODO:    of the frames.  SpcTools and I do it on the average, 
+## TODO:    wdkirby@ix.netcom.com (1998-04-29 octave-sources) computes 
+## TODO:    them frame-by-frame.
+function [...] = pwelch(x, ...)
+  ## sort out parameters
+  if nargin < 1, 
+    usage("[Pxx, w] = pwelch(x,nfft,Fs,window,overlap,pc,range,units,trend)");
+  endif
+  va_start(); 
+
+  ## Determine if we are called as pwelch, csd, cohere or tfe
+  if isstr(x)
+    calledby = x;
+  else
+    calledby = "pwelch";
+  endif
+  if !isstr(x)
+    ftype = 1;
+  elseif strcmp(x, 'csd')
+    ftype = 2;
+  elseif strcmp(x, 'cohere')
+    ftype = 3;
+  elseif strcmp(x, 'tfe')
+    ftype = 4;
+  endif
+
+  ## Sort out x and y vectors
+  if ftype!=1 
+    x=va_arg(); y=va_arg(); 
+    first = 4;
+  else
+    y=[];
+    first = 2;
+  endif
+  if (columns(x) != 1 && rows(x) != 1) || ...
+    (!isempty(y) && columns(y) != 1 && rows(y) != 1)
+    error ([calledby, " data must be a vector"]);
+  end
+  if columns(x) != 1, x = x'; end
+  if columns(y) != 1, y = y'; end
+  if !isempty(y) && rows(x)!=rows(y)
+    error ([calledby, " x and y vectors must be the same length"]);
+  endif
+
+  ## interpret remaining arguments
+  trend=nfft=Fs=window=overlap=whole=use_dB=[];
+  ci=-1; ## need to do stupid things with ci
+  pos=0; ## no positional parameters yet interpreted.
+  for i=first:nargin
+    arg = va_arg();
+    if isstr(arg), 
+      arg=tolower(arg); 
+      if strcmp(arg, 'squared')
+      	use_dB = 0;
+      elseif strcmp(arg, 'db')
+	use_dB = 1;
+      elseif strcmp(arg, 'whole')
+	whole = 1;
+      elseif strcmp(arg, 'half')
+	whole = 0;
+      elseif strcmp(arg, 'none')
+      	trend = -1;
+      elseif strcmp(arg, 'mean')
+      	trend = 0;
+      elseif strcmp(arg, 'linear')
+      	trend = 1;
+      else
+      	error([calledby, " doesn't understand '", arg, "'"]);
+      endif
+    elseif pos == 0
+      nfft = arg;
+      pos++;
+    elseif pos == 1
+      Fs = arg;
+      pos++;
+    elseif pos == 2
+      window = arg;
+      pos++;
+    elseif pos == 3
+      overlap = arg;
+      pos++;
+    elseif pos == 4
+      ci = arg;
+      pos++;
+    else
+      usage(usagestr);
+    endif
+  endfor
+
+  ## Fill in defaults for arguments that aren't specified
+  if isempty(nfft), nfft = min(256, length(x)); endif
+  if isempty(Fs), Fs = 2; endif
+  if isempty(window), window = hanning(nfft); endif
+  if isempty(overlap), overlap = length(window)/2; endif
+  if isempty(whole), whole = !isreal(x)||(!isempty(y)&&!isreal(y)); endif
+  if isempty(trend), trend=-1; endif
+  if isempty(use_dB), 
+    ## don't default to db for cohere, or for returned values
+    use_dB = (ftype!=3 && nargout == 0); 
+  endif 
+  if isempty(ci), ci=0.95; endif # if ci was not passed in, it would be 0
+
+  ## sort out default confidence intervals
+  if (ci < 0) # ci was not passed in
+    if nargout > 2
+      ci = 0.95;
+    else
+      ci = 0.0;
+    endif
+  endif
+  if (ftype > 2 && ci > 0)
+    error([ calledby, " can't compute confidence intervals" ]);
+  elseif (ci < 0 || ci > 1)
+    error([ calledby, " confidence interval must be between 0 and 1" ]);
+  endif
+
+  ## if only the window length is given, generate hanning window
+  if length(window) == 1, window = hanning(window); endif
+  if rows(window)==1, window = window.'; endif
+
+  ## Normalize the window
+  window = window / norm(window);
+
+  ## compute window offsets
+  win_size = length(window);
+  if (win_size > nfft)
+    nfft = win_size;
+    warning (sprintf("%s fft size adjusted to %d", calledby, n));
+  end
+  step = win_size - overlap;
+
+  ## Determine which correlations to compute
+  Pxx = Pyy = Pxy = [];
+  if ftype!=2, Pxx = zeros(nfft,1); endif # Not needed for csd
+  if ftype==3, Pyy = zeros(nfft,1); endif # Only needed for cohere
+  if ftype!=1, Pxy = zeros(nfft,1); endif # Not needed for psd
+
+  ## Average the slices
+  offset = 1:step:length(x)-win_size+1;
+  N = length(offset);
+  for i=1:N
+    a = x(offset(i):offset(i)+win_size-1);
+    if trend>=0, a=detrend(a,trend); endif
+    a = fft(postpad(a.*window, nfft));
+    if !isempty(Pxx), Pxx = Pxx + a.*conj(a);  endif
+    if !isempty(Pxy)
+      b = y(offset(i):offset(i)+win_size-1);
+      if trend>=0, b=detrend(b,trend); endif
+      b = fft(postpad(b.*window, nfft));
+      Pxy = Pxy + a .*conj(b);
+      if !isempty(Pyy), Pyy = Pyy + b.*conj(b); endif
+    endif
+  endfor
+  if (ftype <= 2)
+    ## the factors of N cancel when computing cohere and tfe
+    if !isempty(Pxx), Pxx = Pxx / N; endif
+    if !isempty(Pxy), Pxy = Pxy / N; endif
+    if !isempty(Pyy), Pyy = Pyy / N; endif
+  endif
+
+  ## Compute confidence intervals
+  if ci > 0, Pci = zeros(nfft,1); endif
+  if (ci > 0 && N > 1)
+    if ftype>2
+      error([calledby, ": internal error -- shouldn't compute Pci"]); 
+    end
+
+    ## c.i. = mean +/- dev
+    ## dev = z_ci*std/sqrt(n)
+    ## std = sqrt(sumsq(P-mean(P))/(N-1))
+    ## z_ci = normal_inv( 1-(1-ci)/2 ) = normal_inv( (1+ci)/2 );
+    ## normal_inv(x) = sqrt(2) * erfinv(2*x-1)
+    ##    => z_ci = sqrt(2)*erfinv(2*(1+ci)/2-1) = sqrt(2)*erfinv(ci)
+    for i=1:N
+      a=x(offset(i):offset(i)+win_size-1);
+      if trend>=0, a=detrend(a,trend); endif
+      a=fft(postpad(a.*window, nfft));
+      if ftype == 1 # psd
+      	P = a.*conj(a) - Pxx;
+      	Pci = Pci + P.*conj(P);
+      else          # csd
+      	b=y(offset(i):offset(i)+win_size-1);
+      	if trend>=0, b=detrend(b,trend); endif
+      	b=fft(postpad(b.*window, nfft));
+      	P = a.*conj(b) - Pxy;
+      	Pci = Pci + P.*conj(P);
+      endif
+    endfor
+      
+    Pci = ( erfinv(ci) * sqrt( 2/N/(N-1) ) ) * sqrt ( Pci );
+  endif
+
+  switch (ftype)
+    case 1, # psd
+      P = Pxx / Fs;
+      if ci > 0, Pci = Pci / Fs; endif
+    case 2, # csd
+      P = Pxy;
+    case 3, # cohere
+      P = Pxy.*conj(Pxy)./Pxx./Pyy;
+    case 4, # tfe
+      P = Pxy./Pxx;
+  endswitch
+
+  ## compute confidence intervals
+  if ci > 0, Pci = [ P - Pci, P + Pci ]; endif
+    
+  if use_dB
+    P = 10.0*log10(P); 
+    if ci > 0, Pci = 10.0*log10(Pci); endif
+  endif
+
+  ## extract the positive frequency components
+  if whole
+    ret_n = nfft;
+  elseif rem(nfft,2)==1
+    ret_n = (nfft+1)/2;
+  else
+    ret_n = nfft/2 + 1;
+  end
+  P = P(1:ret_n, :);
+  if ci > 0, Pci = Pci(1:ret_n, :); endif
+  f = [0:ret_n-1]*Fs/nfft;
+
+  ## Plot if there is no 
+  if nargout==0, 
+    unwind_protect
+      if Fs==2
+      	xlabel("Frequency (rad/pi)");
+      else
+      	xlabel("Frequency (Hz)");
+      endif
+      if ftype==1
+      	title ("Welch's Spectral Estimate Pxx/Fs");
+      	ytext="Power Spectral Density";
+      elseif ftype==2
+      	title ("Cross Spectral Estimate Pxy");
+      	ytext="Cross Spectral Density";
+      elseif ftype==3
+      	title ("Coherence Function Estimate |Pxy|^2/(PxxPyy)");
+      	ytext="Coherence ";
+      else
+      	title ("Transfer Function Estimate Pxy/Pxx");
+      	ytext="Transfer";
+      endif
+      if use_dB,
+      	ylabel(strcat(ytext, " (dB)"));
+      else
+      	ylabel(ytext);
+      endif
+      grid("on");
+      if ci>0
+      	plot(f, [P, Pci], ";;"); 
+      else
+      	plot(f, P, ";;");
+      endif
+    unwind_protect_cleanup
+      grid("off");
+      title("");
+      xlabel("");
+      ylabel("");
+    end_unwind_protect
+  endif
+	   
+  if nargout>=1, vr_val(P); endif
+  if nargout>=2 && ci>0, vr_val(Pci); endif
+  if nargout>=2 && ci==0, vr_val(f); endif
+  if nargout>=3 && ci>0, vr_val(f); endif
+
+endfunction
+
+%!demo
+%! Fs=8000;
+%! [b,a] = cheby1(4,3,2*[500, 1000]/Fs);    ## define spectral envelope
+%! s=0.05*randn(2^11,1);                    ## define noise
+%! idx=fix(1:Fs/70:length(s))'; 
+%! s(idx)=s(idx)+ones(size(idx));           ## add 70 Hz excitation
+%! x=filter(b,a,s);                         ## generate signal
+%!
+%! figure(1); subplot(221); 
+%! text(0,0.9,'basic estimate','Units','Normalized'); 
+%! pwelch(x',[],Fs); text;   # slip in a test for row vs. column vector
+%! subplot(222); 
+%! text(0,0.9,'nfft=1024 instead of 256','Units','Normalized'); 
+%! pwelch(x,1024); text;
+%! subplot(223); 
+%! text(0,0.9,'boxcar instead of hanning','Units','Normalized');
+%! pwelch(x,[],[],boxcar(256)); text;
+%! subplot(224); 
+%! text(0,0.9,'no overlap','Units','Normalized'); 
+%! pwelch(x,[],[],[],0); text;
+%!
+%! figure(2); subplot(121);
+%! text(0,0.9,'magnitude units, whole range','Units','Normalized'); 
+%! pwelch(x,'whole','squared'); text;
+%! subplot(122);
+%! text(0,0.9,'90% confidence intervals','Units','Normalized'); 
+%! pwelch(x,[],[],[],[],0.9); text;
+%! oneplot();
+%! %----------------------------------------------------------
+%! % plots should show a chebyshev bandpass filter shape
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/pyulear.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,93 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage:  [P, f] = pyulear (x, p [, nfft [, Fs [, range]]] [, units])
+## 
+## Fits x with an AR (p)-model with Yule-Walker estimates, and computes
+## the power spectrum.
+##
+## x = signal to estimate
+## nfft is number of points at which to sample the power spectrum
+## Fs is the sampling frequency of x
+## range is 'half' or 'whole'
+## units is  'squared' for magnitude squared, or 'db' for decibels (default)
+##
+## Returns P, the magnitude vector, and f, the frequencies at which it
+## is sampled.  If there are no return values requested, then plot the power
+## spectrum and don't return anything.
+##
+function [P, w] = pyulear (x, p, ...)
+  
+  if (nargin < 2 || nargin > 6) 
+    usage("[P, f] = pyulear(x, p [,nfft [,Fs [,range]]] [, units])");
+  endif
+  
+  [a, v] = aryule(x, p);
+  if (nargout == 0)
+    __power(sqrt(v), a, all_va_args);
+  else
+    [P, w] = __power(sqrt(v), a, all_va_args);
+  endif
+
+endfunction
+
+%!demo
+%! ## construct target system:
+%! ##   symmetric zero-pole pairs at r*exp(iw),r*exp(-iw)
+%! ##   zero-pole singletons at s
+%! pw=[0.2, 0.4, 0.45, 0.95];   #pw = [0.4];
+%! pr=[0.98, 0.98, 0.98, 0.96]; #pr = [0.85];
+%! ps=[];
+%! zw=[0.3];  # zw=[];
+%! zr=[0.95]; # zr=[];
+%! zs=[];
+%! 
+%! save_empty_list_elements_ok = empty_list_elements_ok;
+%! unwind_protect
+%!   empty_list_elements_ok = 1;
+%!   ## system function for target system
+%!   p=[[pr, pr].*exp(1i*pi*[pw, -pw]), ps];
+%!   z=[[zr, zr].*exp(1i*pi*[zw, -zw]), zs];
+%! unwind_protect_cleanup
+%!   empty_list_elements_ok = save_empty_list_elements_ok;
+%! end_unwind_protect
+%! sys_a = real(poly(p));
+%! sys_b = real(poly(z));
+%! order = length(p)+length(z);
+%!
+%! ## simulation
+%! n=512;
+%! var=0.05;  #var=0;
+%! s = [1; sqrt(var)*randn(n-1,1)]; var=(1+var*(n-1))/n;
+%! x = filter(sys_b,sys_a,s); % AR system output
+%!
+%! ## test
+%! subplot(211);
+%! title("magnitude squared spectral estimate (pyulear)");
+%! p = abs(fft(x)).^2;
+%! plot(linspace(0,1,n/2),p(1:n/2),';FFT spectrum;');
+%! hold on;
+%! pyulear(x, order, 'squared');
+%! hold off;
+%!
+%! subplot(212);
+%! title("log-magnitude-squared spectral estimate (pyulear)");
+%! p = 20*log10(abs(fft(x)));
+%! plot(linspace(0,1,n/2),p(1:n/2),';FFT spectrum;');
+%! hold on;
+%! pyulear(x, order);
+%! hold off;
+%! oneplot();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/rceps.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,116 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [y, xm] = rceps(x)
+##   Produce the cepstrum of the signal x, and if desired, the minimum
+##   phase reconstruction of the signal x.  If x is a matrix, do so
+##   for each column of the matrix.
+##
+## Example
+##   f0=70; Fs=10000;           # 100 Hz fundamental, 10kHz sampling rate
+##   a=poly(0.985*exp(1i*pi*[0.1, -0.1, 0.3, -0.3])); # two formants
+##   s=0.005*randn(1024,1);      # Noise excitation signal
+##   s(1:Fs/f0:length(s)) = 1;   # Impulse glottal wave
+##   x=filter(1,a,s);            # Speech signal in x
+##   [y, xm] = rceps(x.*hanning(1024)); # cepstrum and min phase reconstruction
+##
+## Reference
+##    Programs for digital signal processing. IEEE Press.
+##    New York: John Wiley & Sons. 1979.
+
+function [y, ym] = rceps(x)
+  if (nargin != 1)
+    usage("y = rceps(x)");
+  end
+  y = real(ifft(log(abs(fft(x)))));
+  if nargout == 2
+    n=length(x);
+    if rows(x)==1
+      if rem(n,2)==1
+      	ym = [y(1), 2*y(2:n/2), zeros(1,n/2-1)];
+      else
+	ym = [y(1), 2*y(2:n/2), y(n/2+1), zeros(1,n/2-1)];
+      endif
+    else
+      if rem(n,2)==1
+	ym = [y(1,:); 2*y(2:n/2,:); zeros(n/2-1,columns(y))];
+      else
+	ym = [y(1,:); 2*y(2:n/2,:); y(n/2+1,:); zeros(n/2-1,columns(y))];
+      endif
+    endif
+    ym = real(ifft(exp(fft(ym))));
+  endif
+endfunction
+
+%!error rceps
+%!error rceps(1,2)  # too many arguments
+
+%!test
+%! ## accepts matrices
+%! x=randn(32,3);
+%! [y, xm] = rceps(x);
+%! ## check the mag-phase response of the reproduction
+%! hx = fft(x);
+%! hxm = fft(xm);
+%! assert(abs(hx), abs(hxm), 200*eps); # good magnitude response match
+%! assert(arg(hx) != arg(hxm));        # phase mismatch
+
+%!test
+%! ## accepts column and row vectors
+%! x=randn(256,1);
+%! [y, xm] = rceps(x);
+%! [yt, xmt] = rceps(x.');
+%! assert(yt.', y); 
+%! assert(xmt.', xm);
+
+%!demo
+%! f0=70; Fs=10000;           # 100 Hz fundamental, 10kHz sampling rate
+%! a=real(poly(0.985*exp(1i*pi*[0.1, -0.1, 0.3, -0.3]))); # two formants
+%! s=0.05*randn(1024,1);      # Noise excitation signal
+%! s(1:Fs/f0:length(s)) = 1;  # Impulse glottal wave
+%! x=filter(1,a,s);           # Speech signal in x
+%! isreal(x)
+%! [y, xm] = rceps(x);        # cepstrum and minimum phase x
+%! [hx, w] = freqz(x,1,[],Fs); hxm = freqz(xm);
+%! figure(1);
+%! subplot(311);
+%!    gset tmargin 3;
+%!    gset lmargin 10;
+%!    auplot(x,Fs,'b',';signal;');
+%!    hold on; auplot(xm,Fs,'g',';reconstruction;'); 
+%!    hold off;
+%! subplot(312);
+%!    gset lmargin 10;
+%!    gset bmargin 0;
+%!    axis("ticy");
+%!    plot(w,log(abs(hx)), ";magnitude;", ...
+%!         w,log(abs(hxm)),";reconstruction;");
+%! subplot(313);
+%!    gset lmargin 10;
+%!    gset tmargin 0;
+%!    gset bmargin 3;
+%!    axis("on");
+%!    plot(w,unwrap(arg(hx))/(2*pi), ";phase;",...
+%!	   w,unwrap(arg(hxm))/(2*pi),";reconstruction;");
+%!    gset tmargin;
+%!    gset bmargin;
+%!    gset lmargin;
+%! oneplot();
+%! figure(2); auplot(y,Fs,';cepstrum;');
+%! %-------------------------------------------------------------
+%! % confirm the magnitude spectrum is identical in the signal
+%! % and the reconstruction and that there are peaks in the
+%! % cepstrum at 14 ms intervals corresponding to an F0 of 70 Hz.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/rectpuls.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,58 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: y = rectpuls(t, w)
+##
+## Generate a rectangular pulse over the interval [-w/2,w/2), sampled at
+## times t.  This is useful with the function pulstran for generating a
+## series pulses.
+##
+## Example
+##   fs = 11025;  # arbitrary sample rate
+##   f0 = 100;    # pulse train sample rate
+##   w = 0.3/f0;  # pulse width 3/10th the distance between pulses
+##   auplot(pulstran(0:1/fs:4/f0, 0:1/f0:4/f0, 'rectpuls', w), fs);
+##
+## See also: pulstran
+function y = rectpuls(t, w)
+
+  if nargin<1 || nargin>2,
+    usage("y = rectpuls(t [, w])");
+  endif
+
+  if nargin < 2, w = 1; endif
+
+  y = zeros(size(t));
+  idx = find(t>=-w/2 & t < w/2);
+  dfi = do_fortran_indexing;
+  unwind_protect
+    do_fortran_indexing = 1;
+    y(idx) = ones(size(idx));
+  unwind_protect_cleanup
+    do_fortran_indexing = dfi;
+  end_unwind_protect
+endfunction
+
+%!assert(rectpuls(0:1/100:0.3,.1), rectpuls([0:1/100:0.3]',.1)');
+%!assert(isempty(rectpuls([],.1)));
+%!demo
+%! fs = 11025;  # arbitrary sample rate
+%! f0 = 100;    # pulse train sample rate
+%! w = 0.3/f0;  # pulse width 1/10th the distance between pulses
+%! oneplot(); ylabel("amplitude"); xlabel("time (ms)");
+%! title("graph shows 3 ms pulses at 0,10,20,30 and 40 ms");
+%! auplot(pulstran(0:1/fs:4/f0, 0:1/f0:4/f0, 'rectpuls', w), fs); 
+%! title(""); xlabel(""); ylabel("");
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/remez.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,885 @@
+/**************************************************************************
+ * Parks-McClellan algorithm for FIR filter design (C version)
+ *-------------------------------------------------
+ *  Copyright (c) 1995,1998  Jake Janovetz (janovetz@uiuc.edu)
+ *
+ *  This library is free software; you can redistribute it and/or
+ *  modify it under the terms of the GNU Library General Public
+ *  License as published by the Free Software Foundation; either
+ *  version 2 of the License, or (at your option) any later version.
+ *
+ *  This library is distributed in the hope that it will be useful,
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ *  Library General Public License for more details.
+ *
+ *  You should have received a copy of the GNU Library General Public
+ *  License along with this library; if not, write to the Free
+ *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *
+ *
+ *  Sep 1999 - Paul Kienzle (pkienzle@cs.indiana.edu)
+ *      Modified for use in octave as a replacement for the matlab function
+ *      remez.mex.  In particular, magnitude responses are required for all
+ *      band edges rather than one per band, griddensity is a parameter,
+ *      and errors are returned rather than printed directly.
+ *  Mar 2000 - Kai Habel (kahacjde@linux.zrz.tu-berlin.de)
+ *      Change: ColumnVector x=arg(i).vector_value();
+ *      to: ColumnVector x(arg(i).vector_value());
+ *  There appear to be some problems with the routine Search. See comments
+ *  therein [search for PAK:].  I haven't looked closely at the rest
+ *  of the code---it may also have some problems.
+ *************************************************************************/
+
+#include <octave/oct.h>
+#include <math.h>
+
+#define CONST const
+#define BANDPASS       1
+#define DIFFERENTIATOR 2
+#define HILBERT        3
+
+#define NEGATIVE       0
+#define POSITIVE       1
+
+#define Pi             3.1415926535897932
+#define Pi2            6.2831853071795865
+
+#define GRIDDENSITY    16
+#define MAXITERATIONS  40
+
+/*******************
+ * CreateDenseGrid
+ *=================
+ * Creates the dense grid of frequencies from the specified bands.
+ * Also creates the Desired Frequency Response function (D[]) and
+ * the Weight function (W[]) on that dense grid
+ *
+ *
+ * INPUT:
+ * ------
+ * int      r        - 1/2 the number of filter coefficients
+ * int      numtaps  - Number of taps in the resulting filter
+ * int      numband  - Number of bands in user specification
+ * double   bands[]  - User-specified band edges [2*numband]
+ * double   des[]    - Desired response per band [2*numband]
+ * double   weight[] - Weight per band [numband]
+ * int      symmetry - Symmetry of filter - used for grid check
+ * int      griddensity
+ *
+ * OUTPUT:
+ * -------
+ * int    gridsize   - Number of elements in the dense frequency grid
+ * double Grid[]     - Frequencies (0 to 0.5) on the dense grid [gridsize]
+ * double D[]        - Desired response on the dense grid [gridsize]
+ * double W[]        - Weight function on the dense grid [gridsize]
+ *******************/
+
+void CreateDenseGrid(int r, int numtaps, int numband, const double bands[],
+                     const double des[], const double weight[], int gridsize,
+                     double Grid[], double D[], double W[],
+                     int symmetry, int griddensity)
+{
+   int i, j, k, band, band0_override;
+   double delf, lowf, highf, grid0;
+
+   delf = 0.5/(griddensity*r);
+
+/*
+ * For differentiator, hilbert,
+ *   symmetry is odd and Grid[0] = max(delf, bands[0])
+ */
+   grid0 = (symmetry == NEGATIVE) && (delf > bands[0]) ? delf : bands[0];
+
+   j=0;
+   for (band=0; band < numband; band++)
+   {
+      lowf = (band==0 ? grid0 : bands[2*band]);
+      highf = bands[2*band + 1];
+      k = (int)((highf - lowf)/delf + 0.5);   /* .5 for rounding */
+      for (i=0; i<k; i++)
+      {
+         D[j] = des[2*band] + i*(des[2*band+1]-des[2*band])/(k-1);
+         W[j] = weight[band];
+         Grid[j] = lowf;
+         lowf += delf;
+         j++;
+      }
+      Grid[j-1] = highf;
+   }
+
+/*
+ * Similar to above, if odd symmetry, last grid point can't be .5
+ *  - but, if there are even taps, leave the last grid point at .5
+ */
+   if ((symmetry == NEGATIVE) &&
+       (Grid[gridsize-1] > (0.5 - delf)) &&
+       (numtaps % 2))
+   {
+      Grid[gridsize-1] = 0.5-delf;
+   }
+}
+
+
+/********************
+ * InitialGuess
+ *==============
+ * Places Extremal Frequencies evenly throughout the dense grid.
+ *
+ *
+ * INPUT: 
+ * ------
+ * int r        - 1/2 the number of filter coefficients
+ * int gridsize - Number of elements in the dense frequency grid
+ *
+ * OUTPUT:
+ * -------
+ * int Ext[]    - Extremal indexes to dense frequency grid [r+1]
+ ********************/
+
+void InitialGuess(int r, int Ext[], int gridsize)
+{
+   int i;
+
+   for (i=0; i<=r; i++)
+      Ext[i] = i * (gridsize-1) / r;
+}
+
+
+/***********************
+ * CalcParms
+ *===========
+ *
+ *
+ * INPUT:
+ * ------
+ * int    r      - 1/2 the number of filter coefficients
+ * int    Ext[]  - Extremal indexes to dense frequency grid [r+1]
+ * double Grid[] - Frequencies (0 to 0.5) on the dense grid [gridsize]
+ * double D[]    - Desired response on the dense grid [gridsize]
+ * double W[]    - Weight function on the dense grid [gridsize]
+ *
+ * OUTPUT:
+ * -------
+ * double ad[]   - 'b' in Oppenheim & Schafer [r+1]
+ * double x[]    - [r+1]
+ * double y[]    - 'C' in Oppenheim & Schafer [r+1]
+ ***********************/
+
+void CalcParms(int r, int Ext[], double Grid[], double D[], double W[],
+                double ad[], double x[], double y[])
+{
+   int i, j, k, ld;
+   double sign, xi, delta, denom, numer;
+
+/*
+ * Find x[]
+ */
+   for (i=0; i<=r; i++)
+      x[i] = cos(Pi2 * Grid[Ext[i]]);
+
+/*
+ * Calculate ad[]  - Oppenheim & Schafer eq 7.132
+ */
+   ld = (r-1)/15 + 1;         /* Skips around to avoid round errors */
+   for (i=0; i<=r; i++)
+   {
+       denom = 1.0;
+       xi = x[i];
+       for (j=0; j<ld; j++)
+       {
+          for (k=j; k<=r; k+=ld)
+             if (k != i)
+                denom *= 2.0*(xi - x[k]);
+       }
+       if (fabs(denom)<0.00001)
+          denom = 0.00001;
+       ad[i] = 1.0/denom;
+   }
+
+/*
+ * Calculate delta  - Oppenheim & Schafer eq 7.131
+ */
+   numer = denom = 0;
+   sign = 1;
+   for (i=0; i<=r; i++)
+   {
+      numer += ad[i] * D[Ext[i]];
+      denom += sign * ad[i]/W[Ext[i]];
+      sign = -sign;
+   }
+   delta = numer/denom;
+   sign = 1;
+
+/*
+ * Calculate y[]  - Oppenheim & Schafer eq 7.133b
+ */
+   for (i=0; i<=r; i++)
+   {
+      y[i] = D[Ext[i]] - sign * delta/W[Ext[i]];
+      sign = -sign;
+   }
+}
+
+
+/*********************
+ * ComputeA
+ *==========
+ * Using values calculated in CalcParms, ComputeA calculates the
+ * actual filter response at a given frequency (freq).  Uses
+ * eq 7.133a from Oppenheim & Schafer.
+ *
+ *
+ * INPUT:
+ * ------
+ * double freq - Frequency (0 to 0.5) at which to calculate A
+ * int    r    - 1/2 the number of filter coefficients
+ * double ad[] - 'b' in Oppenheim & Schafer [r+1]
+ * double x[]  - [r+1]
+ * double y[]  - 'C' in Oppenheim & Schafer [r+1]
+ *
+ * OUTPUT:
+ * -------
+ * Returns double value of A[freq]
+ *********************/
+
+double ComputeA(double freq, int r, double ad[], double x[], double y[])
+{
+   int i;
+   double xc, c, denom, numer;
+
+   denom = numer = 0;
+   xc = cos(Pi2 * freq);
+   for (i=0; i<=r; i++)
+   {
+      c = xc - x[i];
+      if (fabs(c) < 1.0e-7)
+      {
+         numer = y[i];
+         denom = 1;
+         break;
+      }
+      c = ad[i]/c;
+      denom += c;
+      numer += c*y[i];
+   }
+   return numer/denom;
+}
+
+
+/************************
+ * CalcError
+ *===========
+ * Calculates the Error function from the desired frequency response
+ * on the dense grid (D[]), the weight function on the dense grid (W[]),
+ * and the present response calculation (A[])
+ *
+ *
+ * INPUT:
+ * ------
+ * int    r      - 1/2 the number of filter coefficients
+ * double ad[]   - [r+1]
+ * double x[]    - [r+1]
+ * double y[]    - [r+1]
+ * int gridsize  - Number of elements in the dense frequency grid
+ * double Grid[] - Frequencies on the dense grid [gridsize]
+ * double D[]    - Desired response on the dense grid [gridsize]
+ * double W[]    - Weight function on the desnse grid [gridsize]
+ *
+ * OUTPUT:
+ * -------
+ * double E[]    - Error function on dense grid [gridsize]
+ ************************/
+
+void CalcError(int r, double ad[], double x[], double y[],
+               int gridsize, double Grid[],
+               double D[], double W[], double E[])
+{
+   int i;
+   double A;
+
+   for (i=0; i<gridsize; i++)
+   {
+      A = ComputeA(Grid[i], r, ad, x, y);
+      E[i] = W[i] * (D[i] - A);
+   }
+}
+
+/************************
+ * Search
+ *========
+ * Searches for the maxima/minima of the error curve.  If more than
+ * r+1 extrema are found, it uses the following heuristic (thanks
+ * Chris Hanson):
+ * 1) Adjacent non-alternating extrema deleted first.
+ * 2) If there are more than one excess extrema, delete the
+ *    one with the smallest error.  This will create a non-alternation
+ *    condition that is fixed by 1).
+ * 3) If there is exactly one excess extremum, delete the smaller
+ *    of the first/last extremum
+ *
+ *
+ * INPUT:
+ * ------
+ * int    r        - 1/2 the number of filter coefficients
+ * int    Ext[]    - Indexes to Grid[] of extremal frequencies [r+1]
+ * int    gridsize - Number of elements in the dense frequency grid
+ * double E[]      - Array of error values.  [gridsize]
+ * OUTPUT:
+ * -------
+ * int    Ext[]    - New indexes to extremal frequencies [r+1]
+ ************************/
+int Search(int r, int Ext[],
+            int gridsize, double E[])
+{
+   int i, j, k, l, extra;     /* Counters */
+   int up, alt;
+   int *foundExt;             /* Array of found extremals */
+
+/*
+ * Allocate enough space for found extremals.
+ */
+   foundExt = (int *)malloc((2*r) * sizeof(int));
+   k = 0;
+
+/*
+ * Check for extremum at 0.
+ */
+   if (((E[0]>0.0) && (E[0]>E[1])) ||
+       ((E[0]<0.0) && (E[0]<E[1])))
+      foundExt[k++] = 0;
+
+/*
+ * Check for extrema inside dense grid
+ */
+   for (i=1; i<gridsize-1; i++)
+   {
+      if (((E[i]>=E[i-1]) && (E[i]>E[i+1]) && (E[i]>0.0)) ||
+          ((E[i]<=E[i-1]) && (E[i]<E[i+1]) && (E[i]<0.0))) {
+	// PAK: we sometimes get too many extremal frequencies
+	if (k >= 2*r) return -3;
+	foundExt[k++] = i;
+      }
+   }
+
+/*
+ * Check for extremum at 0.5
+ */
+   j = gridsize-1;
+   if (((E[j]>0.0) && (E[j]>E[j-1])) ||
+       ((E[j]<0.0) && (E[j]<E[j-1]))) {
+     if (k >= 2*r) return -3;
+     foundExt[k++] = j;
+   }
+
+   // PAK: we sometimes get not enough extremal frequencies
+   if (k < r+1) return -2;
+
+
+/*
+ * Remove extra extremals
+ */
+   extra = k - (r+1);
+   assert(extra >= 0);
+
+   while (extra > 0)
+   {
+      if (E[foundExt[0]] > 0.0)
+         up = 1;                /* first one is a maxima */
+      else
+         up = 0;                /* first one is a minima */
+
+      l=0;
+      alt = 1;
+      for (j=1; j<k; j++)
+      {
+         if (fabs(E[foundExt[j]]) < fabs(E[foundExt[l]]))
+            l = j;               /* new smallest error. */
+         if ((up) && (E[foundExt[j]] < 0.0))
+            up = 0;             /* switch to a minima */
+         else if ((!up) && (E[foundExt[j]] > 0.0))
+            up = 1;             /* switch to a maxima */
+         else
+	 { 
+            alt = 0;
+	    // PAK: break now and you will delete the smallest overall
+	    // extremal.  If you want to delete the smallest of the
+	    // pair of non-alternating extremals, then you must do:
+            //
+	    // if (fabs(E[foundExt[j]]) < fabs(E[foundExt[j-1]])) l=j;
+	    // else l=j-1;
+            break;              /* Ooops, found two non-alternating */
+         }                      /* extrema.  Delete smallest of them */
+      }  /* if the loop finishes, all extrema are alternating */
+
+/*
+ * If there's only one extremal and all are alternating,
+ * delete the smallest of the first/last extremals.
+ */
+      if ((alt) && (extra == 1))
+      {
+         if (fabs(E[foundExt[k-1]]) < fabs(E[foundExt[0]]))
+	   /* Delete last extremal */
+	   l = k-1;
+	   // PAK: changed from l = foundExt[k-1]; 
+         else
+	   /* Delete first extremal */
+	   l = 0;
+	   // PAK: changed from l = foundExt[0];     
+      }
+
+      for (j=l; j<k-1; j++)        /* Loop that does the deletion */
+      {
+         foundExt[j] = foundExt[j+1];
+	 assert(foundExt[j]<gridsize);
+      }
+      k--;
+      extra--;
+   }
+
+   for (i=0; i<=r; i++)
+   {
+      assert(foundExt[i]<gridsize);
+      Ext[i] = foundExt[i];       /* Copy found extremals to Ext[] */
+   }
+
+   free(foundExt);
+   return 0;
+}
+
+
+/*********************
+ * FreqSample
+ *============
+ * Simple frequency sampling algorithm to determine the impulse
+ * response h[] from A's found in ComputeA
+ *
+ *
+ * INPUT:
+ * ------
+ * int      N        - Number of filter coefficients
+ * double   A[]      - Sample points of desired response [N/2]
+ * int      symmetry - Symmetry of desired filter
+ *
+ * OUTPUT:
+ * -------
+ * double h[] - Impulse Response of final filter [N]
+ *********************/
+void FreqSample(int N, double A[], double h[], int symm)
+{
+   int n, k;
+   double x, val, M;
+
+   M = (N-1.0)/2.0;
+   if (symm == POSITIVE)
+   {
+      if (N%2)
+      {
+         for (n=0; n<N; n++)
+         {
+            val = A[0];
+            x = Pi2 * (n - M)/N;
+            for (k=1; k<=M; k++)
+               val += 2.0 * A[k] * cos(x*k);
+            h[n] = val/N;
+         }
+      }
+      else
+      {
+         for (n=0; n<N; n++)
+         {
+            val = A[0];
+            x = Pi2 * (n - M)/N;
+            for (k=1; k<=(N/2-1); k++)
+               val += 2.0 * A[k] * cos(x*k);
+            h[n] = val/N;
+         }
+      }
+   }
+   else
+   {
+      if (N%2)
+      {
+         for (n=0; n<N; n++)
+         {
+            val = 0;
+            x = Pi2 * (n - M)/N;
+            for (k=1; k<=M; k++)
+               val += 2.0 * A[k] * sin(x*k);
+            h[n] = val/N;
+         }
+      }
+      else
+      {
+          for (n=0; n<N; n++)
+          {
+             val = A[N/2] * sin(Pi * (n - M));
+             x = Pi2 * (n - M)/N;
+             for (k=1; k<=(N/2-1); k++)
+                val += 2.0 * A[k] * sin(x*k);
+             h[n] = val/N;
+          }
+      }
+   }
+}
+
+/*******************
+ * isDone
+ *========
+ * Checks to see if the error function is small enough to consider
+ * the result to have converged.
+ *
+ * INPUT:
+ * ------
+ * int    r     - 1/2 the number of filter coeffiecients
+ * int    Ext[] - Indexes to extremal frequencies [r+1]
+ * double E[]   - Error function on the dense grid [gridsize]
+ *
+ * OUTPUT:
+ * -------
+ * Returns 1 if the result converged
+ * Returns 0 if the result has not converged
+ ********************/
+
+int isDone(int r, int Ext[], double E[])
+{
+   int i;
+   double min, max, current;
+
+   min = max = fabs(E[Ext[0]]);
+   for (i=1; i<=r; i++)
+   {
+      current = fabs(E[Ext[i]]);
+      if (current < min)
+         min = current;
+      if (current > max)
+         max = current;
+   }
+   return (((max-min)/max) < 0.0001);
+}
+
+/********************
+ * remez
+ *=======
+ * Calculates the optimal (in the Chebyshev/minimax sense)
+ * FIR filter impulse response given a set of band edges,
+ * the desired reponse on those bands, and the weight given to
+ * the error in those bands.
+ *
+ * INPUT:
+ * ------
+ * int     numtaps     - Number of filter coefficients
+ * int     numband     - Number of bands in filter specification
+ * double  bands[]     - User-specified band edges [2 * numband]
+ * double  des[]       - User-specified band responses [numband]
+ * double  weight[]    - User-specified error weights [numband]
+ * int     type        - Type of filter
+ *
+ * OUTPUT:
+ * -------
+ * double h[]      - Impulse response of final filter [numtaps]
+ * returns         - true on success, false on failure to converge
+ ********************/
+
+int remez(double h[], int numtaps,
+	  int numband, const double bands[], 
+	  const double des[], const double weight[],
+	  int type, int griddensity)
+{
+   double *Grid, *W, *D, *E;
+   int    i, iter, gridsize, r, *Ext;
+   double *taps, c;
+   double *x, *y, *ad;
+   int    symmetry;
+
+   if (type == BANDPASS)
+      symmetry = POSITIVE;
+   else
+      symmetry = NEGATIVE;
+
+   r = numtaps/2;                  /* number of extrema */
+   if ((numtaps%2) && (symmetry == POSITIVE))
+      r++;
+
+/*
+ * Predict dense grid size in advance for memory allocation
+ *   .5 is so we round up, not truncate
+ */
+   gridsize = 0;
+   for (i=0; i<numband; i++)
+   {
+      gridsize += (int)(2*r*griddensity*(bands[2*i+1] - bands[2*i]) + .5);
+   }
+   if (symmetry == NEGATIVE)
+   {
+      gridsize--;
+   }
+
+/*
+ * Dynamically allocate memory for arrays with proper sizes
+ */
+   Grid = (double *)malloc(gridsize * sizeof(double));
+   D = (double *)malloc(gridsize * sizeof(double));
+   W = (double *)malloc(gridsize * sizeof(double));
+   E = (double *)malloc(gridsize * sizeof(double));
+   Ext = (int *)malloc((r+1) * sizeof(int));
+   taps = (double *)malloc((r+1) * sizeof(double));
+   x = (double *)malloc((r+1) * sizeof(double));
+   y = (double *)malloc((r+1) * sizeof(double));
+   ad = (double *)malloc((r+1) * sizeof(double));
+
+/*
+ * Create dense frequency grid
+ */
+   CreateDenseGrid(r, numtaps, numband, bands, des, weight,
+                   gridsize, Grid, D, W, symmetry, griddensity);
+   InitialGuess(r, Ext, gridsize);
+
+/*
+ * For Differentiator: (fix grid)
+ */
+   if (type == DIFFERENTIATOR)
+   {
+      for (i=0; i<gridsize; i++)
+      {
+/* D[i] = D[i]*Grid[i]; */
+         if (D[i] > 0.0001)
+            W[i] = W[i]/Grid[i];
+      }
+   }
+
+/*
+ * For odd or Negative symmetry filters, alter the
+ * D[] and W[] according to Parks McClellan
+ */
+   if (symmetry == POSITIVE)
+   {
+      if (numtaps % 2 == 0)
+      {
+         for (i=0; i<gridsize; i++)
+         {
+            c = cos(Pi * Grid[i]);
+            D[i] /= c;
+            W[i] *= c; 
+         }
+      }
+   }
+   else
+   {
+      if (numtaps % 2)
+      {
+         for (i=0; i<gridsize; i++)
+         {
+            c = sin(Pi2 * Grid[i]);
+            D[i] /= c;
+            W[i] *= c;
+         }
+      }
+      else
+      {
+         for (i=0; i<gridsize; i++)
+         {
+            c = sin(Pi * Grid[i]);
+            D[i] /= c;
+            W[i] *= c;
+         }
+      }
+   }
+
+/*
+ * Perform the Remez Exchange algorithm
+ */
+   for (iter=0; iter<MAXITERATIONS; iter++)
+   {
+      CalcParms(r, Ext, Grid, D, W, ad, x, y);
+      CalcError(r, ad, x, y, gridsize, Grid, D, W, E);
+      int err = Search(r, Ext, gridsize, E);
+      if (err) return err;
+      for(int i=0; i <= r; i++) assert(Ext[i]<gridsize);
+      if (isDone(r, Ext, E))
+         break;
+   }
+
+   CalcParms(r, Ext, Grid, D, W, ad, x, y);
+
+/*
+ * Find the 'taps' of the filter for use with Frequency
+ * Sampling.  If odd or Negative symmetry, fix the taps
+ * according to Parks McClellan
+ */
+   for (i=0; i<=numtaps/2; i++)
+   {
+      if (symmetry == POSITIVE)
+      {
+         if (numtaps%2)
+            c = 1;
+         else
+            c = cos(Pi * (double)i/numtaps);
+      }
+      else
+      {
+         if (numtaps%2)
+            c = sin(Pi2 * (double)i/numtaps);
+         else
+            c = sin(Pi * (double)i/numtaps);
+      }
+      taps[i] = ComputeA((double)i/numtaps, r, ad, x, y)*c;
+   }
+
+/*
+ * Frequency sampling design with calculated taps
+ */
+   FreqSample(numtaps, taps, h, symmetry);
+
+/*
+ * Delete allocated memory
+ */
+   free(Grid);
+   free(W);
+   free(D);
+   free(E);
+   free(Ext);
+   free(x);
+   free(y);
+   free(ad);
+   return iter<MAXITERATIONS?0:-1;
+}
+
+
+/* == Octave interface starts here ====================================== */
+
+DEFUN_DLD (remez, args, ,
+  "b = remez(n, f, a [, w] [, ftype] [, griddensity])\n\
+\n\
+n gives the number of taps in the returned filter\n\
+f gives frequency at the band edges [ b1 e1 b2 e2 b3 e3 ...]\n\
+a gives amplitude at the band edges [ a(b1) a(e1) a(b2) a(e2) ...]\n\
+w gives weighting applied to each band\n\
+ftype is 'bandpass', 'hilbert' or 'differentiator'\n\
+griddensity determines how accurately the filter will be\n\
+    constructed. The minimum value is 16, but higher numbers are\n\
+    slower to compute.\n\
+\n\
+Frequency is in the range (0, 1), with 1 being the nyquist frequency")
+{
+  octave_value_list retval;
+  int i;
+
+  int nargin = args.length();
+  if (nargin < 3 || nargin > 6) {
+    print_usage("remez");
+    return retval;
+  }
+
+  int numtaps = NINT (args(0).double_value()) + 1; // #coeff = filter order+1
+  if (numtaps < 4) {
+    error("remez: number of taps must be an integer greater than 3");
+    return retval;
+  }
+
+  ColumnVector o_bands(args(1).vector_value());
+  int numbands = o_bands.length()/2;
+  double bands[numbands*2];
+  if (numbands < 1 || o_bands.length()%2 == 1) {
+    error("remez: must have an even number of band edges");
+    return retval;
+  }
+  for (i=1; i < o_bands.length(); i++) {
+    if (o_bands(i)<o_bands(i-1)) {
+      error("band edges must be nondecreasing");
+      return retval;
+    }
+  }
+  if (o_bands(0) < 0 || o_bands(1) > 1) {
+    error("band edges must be in the range [0,1]");
+    return retval;
+  }
+  for(i=0; i < 2*numbands; i++) bands[i] = o_bands(i)/2.0;
+
+  ColumnVector o_response(args(2).vector_value());
+  double response[numbands*2];
+  if (o_response.length() != o_bands.length()) {
+    error("remez: must have one response magnitude for each band edge");
+    return retval;
+  }
+  for(i=0; i < 2*numbands; i++) response[i] = o_response(i);
+
+  string stype = string("bandpass");
+  int density = 16;
+  double weight[numbands];
+  for (i=0; i < numbands; i++) weight[i] = 1.0;
+  if (nargin > 3) {
+    if (args(3).is_real_matrix()) {
+      ColumnVector o_weight(args(3).vector_value());
+      if (o_weight.length() != numbands) {
+	error("remez: need one weight for each band [=length(band)/2]");
+	return retval;
+      }
+      for (i=0; i < numbands; i++) weight[i] = o_weight(i);
+    }
+    else if (args(3).is_string())
+      stype = args(3).string_value();
+    else if (args(3).is_real_scalar())
+      density = NINT(args(3).double_value());
+    else {
+      error("remez: incorrect argument list");
+      return retval;
+    }
+  }
+  if (nargin > 4) {
+    if (args(4).is_string() && !args(3).is_string())
+      stype = args(4).string_value();
+    else if (args(4).is_real_scalar() && !args(3).is_real_scalar())
+      density = NINT(args(4).double_value());
+    else {
+      error("remez: incorrect argument list");
+      return retval;
+    }
+  }
+  if (nargin > 5) {
+    if (args(5).is_real_scalar() 
+	&& !args(4).is_real_scalar() 
+	&& !args(3).is_real_scalar())
+      density = NINT(args(4).double_value());
+    else {
+      error("remez: incorrect argument list");
+      return retval;
+    }
+  }
+
+  int itype;
+  if (stype == "bandpass") 
+    itype = BANDPASS;
+  else if (stype == "differentiator") 
+    itype = DIFFERENTIATOR;
+  else if (stype == "hilbert") 
+    itype = HILBERT;
+  else {
+    error("remez: unknown ftype '%s'", stype.data());
+    return retval;
+  }
+
+  if (density < 16) {
+    error("remez: griddensity is too low; must be greater than 16");
+    return retval;
+  }
+
+  double coeff[numtaps+5];
+  int err = remez(coeff,numtaps,numbands,bands,response,weight,itype,density);
+
+  if (err == -1)
+    warning("remez: -- failed to converge -- returned filter may be bad.");
+  else if (err == -2) {
+    error("remez: insufficient extremals--cannot continue");
+    return retval;
+  }
+  else if (err == -3) {
+    error("remez: too many extremals--cannot continue");
+    return retval;
+  }
+
+  ColumnVector h(numtaps);
+  while(numtaps--) h(numtaps) = coeff[numtaps];
+
+  return octave_value(h);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/resample.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,118 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: y=resample(x,p,q,d)
+##
+## Change the sample rate of x by a factor of p/q.  Note that p and q do
+## not need to be integers since this routine does not use a polyphase
+## rate change algorithm, but instead uses bandlimited interpolation,
+## wherein the continous time signal is estimated by summing the sinc
+## functions of the nearest neighbouring points up to distance d.
+##
+## This is discussed in:
+##     J. O. Smith and P. Gossett (1984). A flexible sampling-rate
+##     conversion method. In ICASSP-84, Volume II, pp. 19.4.1-19.4.2. 
+##     New York: IEEE Press.
+## See the authors page at: http://www-ccrma.stanford.edu/~jos/resample/
+##
+## Note that the resampling is not yet very fast or very good, but it is
+## very flexible.
+##
+## Example
+##    ## Speech example
+##    [x, fs] = auload(file_in_loadpath("sample.wav"));
+##    sound(resample(x,16000,fs), 16000);  # resample at 16 kHz
+##
+##    ## Example from interp1
+##    xf=0:0.05:10.95; yf = sin(2*pi*xf/5);
+##    xp=0:10;         yp = sin(2*pi*xp/5);
+##    r = resample(yp,xp(2),xf(2));
+##    plot(xf,yf,';original;',xf,r,';resample;',xp,yp,'*;;');
+##
+## Note that resample computes all samples up to but not including time
+## n+1. If you are increasing the sample rate, this means that it will
+## generate samples beyond the end of the time range of the original
+## signal. That is why xf must goes all the way to 10.95 in the example.
+ 
+## TODO: Fix so that audible clicking goes away.
+## TODO: Change to a faster algorithm.
+## TODO: Test on a chirp signal.
+   
+function y=resample(x,p,q,order,beta)
+  if (nargin < 2 || nargin > 5)
+    usage("y=resample(x,p,q,order)");
+  endif
+
+  if (nargin < 3), q=1; endif
+  if (nargin < 4), order = 5; endif
+
+  ##  ## chain to decimate/interpolate if appropriate
+  ##  if p==1 && q==fix(q)
+  ##    y=decimate(x,q); order?
+  ##    return;
+  ##  elseif q==1 && p==fix(p)
+  ##    y=interp(x,q); order?
+  ##    return;
+  ##  endif
+
+  transpose = rows(x)==1;
+  if transpose, x = x.'; endif
+
+  ## if rate reduction, apply antialiasing filter first
+  r=p/q;
+  if (r < 1)                 
+    b = fir1(2*order+1, r);
+    x = fftfilt(b, x);
+  endif
+
+  ## Determine the new sampling times, and their distance to the old
+  ## ones.  Note that the new series should be the maximum that can
+  ## be contained in the old series without going over the time
+  ## allotted to the old series.  In short, you have to go a little
+  ## beyond the last sample of the old series if your new sampling
+  ## rate is higher.
+  t=[1:1/r:length(x)+1-1/r]';   # the sampling points of the new series
+  idx = fix(t);                 # the nearest old point
+  t = t-idx;                    # distance to the nearest old point
+
+  ## generate the new series by summing the sinc functions of the
+  ## nearest neighbour points implicit in the continuous time
+  ## expansion of the old series.  This new series is truncated
+  ## to +/- order nearest neighbours.  For convenience, the original
+  ## series is zero-padded before and after, implicitly setting the
+  ## neighbours at the start of the signal to zero.
+  x = [zeros(order,columns(x)) ; x ; zeros(order,columns(x))];
+  y = zeros(length(idx),columns(x));        # the new series
+  for i=-order:order
+    w = sinc(t-i).*(0.5+0.5*cos(pi*(t-i)/(order+0.5))); # hanning window
+    y=y + x(idx+i+order,:).*w(:,ones(size(x,2),1));
+  endfor
+
+  if transpose, y=y.'; endif
+endfunction
+
+%!demo
+%! xf=0:0.05:10.95; yf = sin(2*pi*xf/5);
+%! xp=0:10;      yp = sin(2*pi*xp/5);
+%! r = resample(yp,xp(2),xf(2));
+%! oneplot();
+%! title("confirm that the resampled function matches the original");
+%! plot(xf,yf,';original;',...
+%!    xf,r(1:length(xf)),';resample;',...
+%!    xp,yp,'*;;');
+%! title("");
+%! [x, fs] = auload(file_in_loadpath("sample.wav"));
+%! sound(resample(x,16000,fs), 16000);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/sftrans.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,182 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [Sz, Sp, Sg] = sftrans(Sz, Sp, Sg, W, stop)
+##
+## Transform band edges of a generic lowpass filter (cutoff at W=1)
+## represented in splane zero-pole-gain form.  W is the edge of the
+## target filter (or edges if band pass or band stop). Stop is true for
+## high pass and band stop filters or false for low pass and band pass
+## filters. Filter edges are specified in radians, from 0 to pi (the
+## nyquist frequency).
+##
+## Theory: Given a low pass filter represented by poles and zeros in the
+## splane, you can convert it to a low pass, high pass, band pass or 
+## band stop by transforming each of the poles and zeros individually.
+## The following table summarizes the transformation:
+##
+## Transform         Zero at x                  Pole at x
+## ----------------  -------------------------  ------------------------
+## Low Pass          zero: Fc x/C               pole: Fc x/C
+## S -> C S/Fc       gain: C/Fc                 gain: Fc/C 
+## ----------------  -------------------------  ------------------------
+## High Pass         zero: Fc C/x               pole: Fc C/x
+## S -> C Fc/S       pole: 0                    zero: 0
+##                   gain: -x                   gain: -1/x
+## ----------------  -------------------------  ------------------------
+## Band Pass         zero: b ± sqrt(b^2-FhFl)   pole: b ± sqrt(b^2-FhFl)
+##        S^2+FhFl   pole: 0                    zero: 0
+## S -> C --------   gain: C/(Fh-Fl)            gain: (Fh-Fl)/C
+##        S(Fh-Fl)   b=x/C (Fh-Fl)/2            b=x/C (Fh-Fl)/2
+## ----------------  -------------------------  ------------------------
+## Band Stop         zero: b ± sqrt(b^2-FhFl)   pole: b ± sqrt(b^2-FhFl)
+##        S(Fh-Fl)   pole: ±sqrt(-FhFl)         zero: ±sqrt(-FhFl)
+## S -> C --------   gain: -x                   gain: -1/x
+##        S^2+FhFl   b=C/x (Fh-Fl)/2            b=C/x (Fh-Fl)/2
+## ----------------  -------------------------  ------------------------
+## Bilinear          zero: (2+xT)/(2-xT)        pole: (2+xT)/(2-xT)
+##      2 z-1        pole: -1                   zero: -1
+## S -> - ---        gain: (2-xT)/T             gain: (2-xT)/T
+##      T z+1
+## ----------------  -------------------------  ------------------------
+##
+## where C is the cutoff frequency of the initial lowpass filter, Fc is
+## the edge of the target low/high pass filter and [Fl,Fh] are the edges
+## of the target band pass/stop filter.  With abundant tedious algebra,
+## you can derive the above formulae yourself by substituting the
+## transform for S into H(S)=S-x for a zero at x or H(S)=1/(S-x) for a
+## pole at x, and converting the result into the form:
+##
+##    H(S)=g prod(S-Xi)/prod(S-Xj)
+##
+## The transforms are from the references.  The actual pole-zero-gain
+## changes I derived myself.
+##
+## Please note that a pole and a zero at the same place exactly cancel.
+## This is significant for High Pass, Band Pass and Band Stop filters
+## which create numerous extra poles and zeros, most of which cancel.
+## Those which do not cancel have a "fill-in" effect, extending the 
+## shorter of the sets to have the same number of as the longer of the
+## sets of poles and zeros (or at least split the difference in the case
+## of the band pass filter).  There may be other opportunistic
+## cancellations but I will not check for them.
+##
+## Also note that any pole on the unit circle or beyond will result in
+## an unstable filter.  Because of cancellation, this will only happen
+## if the number of poles is smaller than the number of zeros and the
+## filter is high pass or band pass.  The analytic design methods all
+## yield more poles than zeros, so this will not be a problem.
+## 
+## References: 
+##
+## Proakis & Manolakis (1992). Digital Signal Processing. New York:
+## Macmillan Publishing Company.
+
+## Author: pkienzle@cs.indiana.edu
+
+## 2000-03-01 pkienzle@kienzle.powernet.co.uk
+##       leave transformed Sg as a complex value since cheby2 blows up
+##       otherwise (but only for odd-order low-pass filters).  bilinear
+##       will return Zg as real, so there is no visible change to the
+##       user of the IIR filter design functions.
+## 2001-03-09 pkienzle@kienzle.powernet.co.uk
+##       return real Sg; don't know what to do for imaginary filters
+function [Sz, Sp, Sg] = sftrans(Sz, Sp, Sg, W, stop)
+
+  if (nargin != 5)
+    usage("[Sz, Sp, Sg] = sftrans(Sz, Sp, Sg, W, stop)");
+  end;
+
+  C = 1;
+  p = length(Sp);
+  z = length(Sz);
+  if z > p || p == 0
+    error("sftrans: must have at least as many poles as zeros in s-plane");
+  end
+
+  if length(W)==2
+    Fl = W(1);
+    Fh = W(2);
+    if stop
+## ----------------  -------------------------  ------------------------
+## Band Stop         zero: b ± sqrt(b^2-FhFl)   pole: b ± sqrt(b^2-FhFl)
+##        S(Fh-Fl)   pole: ±sqrt(-FhFl)         zero: ±sqrt(-FhFl)
+## S -> C --------   gain: -x                   gain: -1/x
+##        S^2+FhFl   b=C/x (Fh-Fl)/2            b=C/x (Fh-Fl)/2
+## ----------------  -------------------------  ------------------------
+      Sg = Sg * real(prod(-Sz)/prod(-Sp));
+      b = (C*(Fh-Fl)/2)./Sp;
+      Sp = [b+sqrt(b.^2-Fh*Fl), b-sqrt(b.^2-Fh*Fl)];
+      extend = [sqrt(-Fh*Fl), -sqrt(-Fh*Fl)];
+      if isempty(Sz)
+	Sz = [extend(1+rem([1:2*p],2))];
+      else
+      	b = (C*(Fh-Fl)/2)./Sz;
+      	Sz = [b+sqrt(b.^2-Fh*Fl), b-sqrt(b.^2-Fh*Fl)];
+	if (p > z)
+	  Sz = [Sz, extend(1+rem([1:2*(p-z)],2))];
+	end
+      end
+    else
+## ----------------  -------------------------  ------------------------
+## Band Pass         zero: b ± sqrt(b^2-FhFl)   pole: b ± sqrt(b^2-FhFl)
+##        S^2+FhFl   pole: 0                    zero: 0
+## S -> C --------   gain: C/(Fh-Fl)            gain: (Fh-Fl)/C
+##        S(Fh-Fl)   b=x/C (Fh-Fl)/2            b=x/C (Fh-Fl)/2
+## ----------------  -------------------------  ------------------------
+      Sg = Sg * (C/(Fh-Fl))^(z-p);
+      b = Sp*((Fh-Fl)/(2*C));
+      Sp = [b+sqrt(b.^2-Fh*Fl), b-sqrt(b.^2-Fh*Fl)];
+      if isempty(Sz)
+	Sz = zeros(1,p);
+      else
+      	b = Sz*((Fh-Fl)/(2*C));
+      	Sz = [b+sqrt(b.^2-Fh*Fl), b-sqrt(b.^2-Fh*Fl)];
+ 	if (p>z)
+	  Sz = [Sz, zeros(1, (p-z))];
+	end
+      end
+    end
+  else
+    Fc = W;
+    if stop
+## ----------------  -------------------------  ------------------------
+## High Pass         zero: Fc C/x               pole: Fc C/x
+## S -> C Fc/S       pole: 0                    zero: 0
+##                   gain: -x                   gain: -1/x
+## ----------------  -------------------------  ------------------------
+      Sg = Sg * real(prod(-Sz)/prod(-Sp));
+      Sp = C * Fc ./ Sp;
+      if isempty(Sz)
+	Sz = zeros(1,p);
+      else
+      	Sz = [C * Fc ./ Sz];
+  	if (p > z)
+	  Sz = [Sz, zeros(1,p-z)];
+	end
+      end
+    else
+## ----------------  -------------------------  ------------------------
+## Low Pass          zero: Fc x/C               pole: Fc x/C
+## S -> C S/Fc       gain: C/Fc                 gain: Fc/C 
+## ----------------  -------------------------  ------------------------
+      Sg = Sg * (C/Fc)^(z-p);
+      Sp = Fc * Sp / C;
+      Sz = Fc * Sz / C;
+    end
+  end
+endfunction
+      
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/sgolay.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,65 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## F = sgolay (p, n)
+##   Computes the filter coefficients for all Savitzsky-Golay smoothing
+##   filters of order p for length n (odd).
+##
+## The early rows of F smooth based on future values and later rows
+## smooth based on past values, with the middle row using half future
+## and half past.  In particular, you can use row i to estimate x(k)
+## based on the i-1 preceding values and the n-i following values of x
+## values as y(k) = F(i,:) * x(k-i+1:k+n-i).
+##
+## Normally, you would apply the first (n-1)/2 rows to the first k
+## points of the vector, the last k rows to the last k points of the
+## vector and middle row to the remainder, but for example if you were
+## running on a realtime system where you wanted to smooth based on the
+## all the data collected up to the current time, with a lag of five
+## samples, you could apply just the filter on row n-5 to your window
+## of length n each time you added a new sample.
+##
+## Reference: Numerical recipes in C. p 650
+##
+## See also: sgolayfilt
+
+## Author: Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+## Based on smooth.m by E. Farhi <manuf@ldv.univ-montp2.fr>
+
+## TODO: Doesn't accept "weight vector" as fourth parameter since
+## TODO: Should be able to estimate derivatives using second and
+## TODO: subsequent columns of A, but they seem to have the wrong
+## TODO: sign and the wrong scale, so I won't put that in.
+
+function F = sgolay (p, n)
+
+  if (nargin < 2 || nargin > 3)
+    usage ("F = sgolay (p, n)");
+  elseif rem(n,2) != 1
+    error ("sgolay needs an odd filter length n");
+  elseif p >= n
+    error ("sgolay needs filter length n larger than polynomial order p");
+  else 
+    k = floor (n/2);
+    F = zeros (n, n);
+    for row = 1:k+1
+      A = pinv( ( [(1:n)-row]'*ones(1,p+1) ) .^ ( ones(n,1)*[0:p] ) );
+      F(row,:) = A(1,:);
+    end
+    F(k+2:n,:) = F(k:-1:1,n:-1:1);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/sgolayfilt.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,119 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## y = sgolayfilt (x, p, n)
+##    Smooth the data in x with a Savitsky-Golay smoothing filter of 
+##    polynomial order p and length n, n odd, n > p.  By default, p=3
+##    and n=p+2 or n=p+3 if p is even.
+##
+## y = sgolayfilt (x, F)
+##    Smooth the data in x with smoothing filter F computed by sgolay.
+##
+## These filters are particularly good at preserving lineshape while
+## removing high frequency squiggles. Particularly, compare a 5 sample
+## averager, an order 5 butterworth lowpass filter (cutoff 1/3) and
+## sgolayfilt(x, 3, 5), the best cubic estimated from 5 points:
+##
+##    [b, a] = butter(5,1/3);
+##    x=[zeros(1,15), 10*ones(1,10), zeros(1,15)];
+##    plot(sgolayfilt(x),"r;sgolayfilt;",...
+##         filtfilt(ones(1,5)/5,1,x),"g;5 sample average;",...
+##         filtfilt(b,a,x),"c;order 5 butterworth;",...
+##         x,"+b;original data;");
+##
+## See also: sgolay
+
+## TODO: Doesn't accept "weight vector" as fourth parameter.
+## TODO: Patch filter.cc so that it accepts matrix arguments
+
+function y = sgolayfilt (x, p, n)
+
+  if nargin < 1 || nargin > 3 
+    usage("y = sgolayfilt(x,p,n) or y = sgolayfilt(x,F)"); 
+  endif
+
+  if (nargin < 2)
+    p = 3;
+  endif
+  if (nargin == 3)
+    F = sgolay(p, n);
+  elseif (prod(size(p)) == 1)
+    n = p+3-rem(p,2);
+    F = sgolay(p, n);
+  else
+    F = p;
+    n = size(F,1);
+    if (size(F,1) != size(F,2))
+      error("sgolayfilt(x,F): F is not a Savitzsky-Golay filter set");
+    endif
+  endif
+
+  transpose = (size(x,1) == 1);
+  if (transpose) x = x.'; endif;
+  len = size(x,1);
+  if (len < n)
+    error("sgolayfilt: insufficient data for filter");
+  endif
+
+  ## The first k rows of F are used to filter the first k points
+  ## of the data set based on the first n points of the data set.
+  ## The last k rows of F are used to filter the last k points
+  ## of the data set based on the last n points of the dataset.
+  ## The remaining data is filtered using the central row of F.
+  k = floor(n/2);
+  z = filter(F(k+1,:), 1, x);
+  y = [ F(1:k,:)*x(1:n,:) ; z(n:len,:) ; F(k+2:n,:)*x(len-n+1:len,:) ];
+
+  if (transpose) y = y.'; endif
+
+endfunction
+
+%!demo
+%! [b, a] = butter(5,1/3);
+%! x=[zeros(1,15), 10*ones(1,10), zeros(1,15)];
+%! subplot(121); title("boxcar");
+%! axis([1 40 -2 15]);
+%! plot(sgolayfilt(x),"r;sgolay(3,5);",...
+%!      filtfilt(ones(1,5)/5,1,x),"g;5 sample average;",...
+%!      filtfilt(b,a,x),"c;order 5 butterworth;",...
+%!      x,"+b;original data;"); title("");
+%!
+%! x=x+randn(size(x))/2;
+%! subplot(122); title("boxcar+noise");
+%! plot(sgolayfilt(x,3,5),"r;sgolay(3,5);",...
+%!      filtfilt(ones(1,5)/5,1,x),"g;5 sample average;",...
+%!      filtfilt(b,a,x),"c;order 5 butterworth;",...
+%!      x,"+b;original data;"); title("");
+
+%!demo
+%! [b, a] = butter(5,1/3);
+%! t = 0:0.01:1.0;                         % 1 second sample
+%! x=cos(2*pi*t*3);                        % 3 Hz sinusoid
+%! subplot(121); title("sinusoid");
+%! axis([0 1 -1.5 2.5]);
+%! plot(t,sgolayfilt(x,3,5),"r;sgolay(3,5);",...
+%!      t,filtfilt(ones(1,5)/5,1,x),"g;5 sample average;",...
+%!      t,filtfilt(b,a,x),"c;order 5 butterworth;",...
+%!      t,x,"+b;original data;"); title("");
+%!
+%! x=x+0.2*randn(size(x));                % signal+noise
+%! subplot(122); title("sinusoid+noise");
+%! plot(t,sgolayfilt(x',3,5),"r;sgolay(3,5);",...
+%!      t,filtfilt(ones(1,5)/5,1,x),"g;5 sample average;",...
+%!      t,filtfilt(b,a,x),"c;order 5 butterworth;",...
+%!      t,x,"+b;original data;"); title("");
+%!
+%! oneplot();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/specgram.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,228 @@
+## Copyright (C) 1999-2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [S [, f [, t]]] = specgram(x [, n [, Fs [, window [, overlap]]]])
+##
+## Generate a spectrogram for the signal. This chops the signal into
+## overlapping slices, windows each slice and applies a Fourier
+## transform to determine the frequency components at that slice.
+##
+## x: vector of samples
+## n: size of fourier transform window, or [] for default=256
+## Fs: sample rate, or [] for default=2 Hz
+## window: shape of the fourier transform window, or [] for default=hanning(n)
+##    Note: window length can be specified instead, in which case
+##    window=hanning(length)
+## overlap: overlap with previous window, or [] for default=length(window)/2
+##
+## Return values
+##    S is complex output of the FFT, one row per slice
+##    f is the frequency indices corresponding to the rows of S.
+##    t is the time indices corresponding to the columns of S.
+##    If no return value is requested, the spectrogram is displayed instead.
+##
+## Example
+##    x = chirp([0:0.001:2],0,2,500);  # freq. sweep from 0-500 over 2 sec.
+##    Fs=1000;                  # sampled every 0.001 sec so rate is 1 kHz
+##    step=ceil(20*Fs/1000);    # one spectral slice every 20 ms
+##    window=ceil(100*Fs/1000); # 100 ms data window
+##    specgram(x, 2^nextpow2(window), Fs, window, window-step);
+##
+##    ## Speech spectrogram
+##    [x, Fs] = auload(file_in_loadpath("sample.wav")); # audio file
+##    step = fix(5*Fs/1000);     # one spectral slice every 5 ms
+##    window = fix(40*Fs/1000);  # 40 ms data window
+##    fftn = 2^nextpow2(window); # next highest power of 2
+##    [S, f, t] = specgram(x, fftn, Fs, window, window-step);
+##    S = abs(S(2:fftn*4000/Fs,:)); # magnitude in range 0<f<=4000 Hz.
+##    S = S/max(S(:));           # normalize magnitude so that max is 0 dB.
+##    S = max(S, 10^(-40/10));   # clip below -40 dB.
+##    S = min(S, 10^(-3/10));    # clip above -3 dB.
+##    imagesc(flipud(log(S)));   # display in log scale
+##
+## The choice of window defines the time-frequency resolution.  In
+## speech for example, a wide window shows more harmonic detail while a
+## narrow window averages over the harmonic detail and shows more
+## formant structure. The shape of the window is not so critical so long
+## as it goes gradually to zero on the ends.
+##
+## Step size (which is window length minus overlap) controls the
+## horizontal scale of the spectrogram. Decrease it to stretch, or
+## increase it to compress. Increasing step size will reduce time
+## resolution, but decreasing it will not improve it much beyond the
+## limits imposed by the window size (you do gain a little bit,
+## depending on the shape of your window, as the peak of the window
+## slides over peaks in the signal energy).  The range 1-5 msec is good
+## for speech.
+##
+## FFT length controls the vertical scale.  Selecting an FFT length
+## greater than the window length does not add any information to the
+## spectrum, but it is a good way to interpolate between frequency
+## points which can make for prettier spectrograms.
+##
+## After you have generated the spectral slices, there are a number of
+## decisions for displaying them.  First the phase information is
+## discarded and the energy normalized:
+##
+##     S = abs(S); S = S/max(S(:));
+##
+## Then the dynamic range of the signal is chosen.  Since information in
+## speech is well above the noise floor, it makes sense to eliminate any
+## dynamic range at the bottom end.  This is done by taking the max of
+## the magnitude and some minimum energy such as minE=-40dB. Similarly,
+## there is not much information in the very top of the range, so
+## clipping to a maximum energy such as maxE=-3dB makes sense:
+##
+##     S = max(S, 10^(minE/10)); S = min(S, 10^(maxE/10));
+##
+## The frequency range of the FFT is from 0 to the Nyquist frequency of
+## one half the sampling rate.  If the signal of interest is band
+## limited, you do not need to display the entire frequency range. In
+## speech for example, most of the signal is below 4 kHz, so there is no
+## reason to display up to the Nyquist frequency of 10 kHz for a 20 kHz
+## sampling rate.  In this case you will want to keep only the first 40%
+## of the rows of the returned S and f.  More generally, to display the
+## frequency range [minF, maxF], you could use the following row index:
+##
+##     idx = (f >= minF & f <= maxF);
+##
+## Then there is the choice of colormap.  A brightness varying colormap
+## such as copper or bone gives good shape to the ridges and valleys. A
+## hue varying colormap such as jet or hsv gives an indication of the
+## steepness of the slopes.  The final spectrogram is displayed in log
+## energy scale and by convention has low frequencies on the bottom of
+## the image:
+##
+##     imagesc(flipud(log(S(idx,:))));
+
+## 2001-07-05 Paul Kienzle <pkienzle@users.sf.net>
+## * remove "See also spectrogram"
+## * add notes on selecting parameters for the spectrogram
+
+function [S_r, f_r, t_r] = specgram(x, n, Fs, window, overlap)
+  if nargin < 1 || nargin > 5
+    usage ("[Y [, f [, t]]] = ", ...
+	   "specgram(x [, n [, Fs [, window [, overlap]]]])");
+  end
+
+  ## assign defaults
+  if nargin < 2 || isempty(n), n = min(256, length(x)); end
+  if nargin < 3 || isempty(Fs), Fs = 2; end
+  if nargin < 4 || isempty(window), window = hanning(n); end
+  if nargin < 5 || isempty(overlap), overlap = length(window)/2; end
+
+  ## make sure x is a vector
+  if columns(x) != 1 && rows(x) != 1
+    error ("specgram data must be a vector");
+  end
+  if columns(x) != 1, x = x'; end
+
+  ## if only the window length is given, generate hanning window
+  if length(window) == 1, window = hanning(window); end
+
+  ## should be extended to accept a vector of frequencies at which to
+  ## evaluate the fourier transform (via filterbank or chirp
+  ## z-transform)
+  if length(n)>1, 
+    error("specgram doesn't handle frequency vectors yet"); 
+  endif
+
+  ## compute window offsets
+  win_size = length(window);
+  if (win_size > n)
+    n = win_size;
+    warning ("specgram fft size adjusted to %d", n);
+  end
+  step = win_size - overlap;
+
+  ## build matrix of windowed data slices
+  offset = [ 1 : step : length(x)-win_size ];
+  S = zeros (n, length(offset));
+  for i=1:length(offset)
+    S(1:win_size, i) = x(offset(i):offset(i)+win_size-1) .* window;
+  endfor
+
+  ## compute fourier transform
+  S = fft (S);
+
+  ## extract the positive frequency components
+  if rem(n,2)==1
+    ret_n = (n+1)/2;
+  else
+    ret_n = n/2;
+  end
+  S = S(1:ret_n, :);
+
+  f = [0:ret_n-1]*Fs/n;
+  t = offset/Fs;
+  if nargout==0, imagesc(20*log10(flipud(abs(S)))); endif
+  if nargout>0, S_r = S; endif
+  if nargout>1, f_r = f; endif
+  if nargout>2, t_r = t; endif
+
+endfunction
+
+
+%!shared S,f,t,x
+%! Fs=1000;
+%! x = chirp([0:1/Fs:2],0,2,500);  # freq. sweep from 0-500 over 2 sec.
+%! step=ceil(20*Fs/1000);    # one spectral slice every 20 ms
+%! window=ceil(100*Fs/1000); # 100 ms data window
+%! [S, f, t] = specgram(x);
+
+%! ## test of returned shape
+%!assert (rows(S), 128)
+%!assert (columns(f), rows(S))
+%!assert (columns(t), columns(S))
+%!test [S, f, t] = specgram(x');
+%!assert (rows(S), 128)
+%!assert (columns(f), rows(S));
+%!assert (columns(t), columns(S));
+%!error (isempty(specgram([])));
+%!error (isempty(specgram([1, 2 ; 3, 4])));
+%!error (specgram)
+
+%!demo
+%! Fs=1000;
+%! x = chirp([0:1/Fs:2],0,2,500);  # freq. sweep from 0-500 over 2 sec.
+%! step=ceil(20*Fs/1000);    # one spectral slice every 20 ms
+%! window=ceil(100*Fs/1000); # 100 ms data window
+%!
+%! ## test of automatic plot
+%! [S, f, t] = specgram(x);
+%! specgram(x, 2^nextpow2(window), Fs, window, window-step);
+%! disp("shows a diagonal from bottom left to top right");
+%! input("press enter:","s");
+%!
+%! ## test of returned values
+%! S = specgram(x, 2^nextpow2(window), Fs, window, window-step);
+%! imagesc(20*log10(flipud(abs(S))));
+%! disp("same again, but this time using returned value");
+
+%!demo
+%! ## Speech spectrogram
+%! [x, Fs] = auload(file_in_loadpath("sample.wav")); # audio file
+%! step = fix(5*Fs/1000);     # one spectral slice every 5 ms
+%! window = fix(40*Fs/1000);  # 40 ms data window
+%! fftn = 2^nextpow2(window); # next highest power of 2
+%! [S, f, t] = specgram(x, fftn, Fs, window, window-step);
+%! S = abs(S(2:fftn*4000/Fs,:)); # magnitude in range 0<f<=4000 Hz.
+%! S = S/max(max(S));         # normalize magnitude so that max is 0 dB.
+%! S = max(S, 10^(-40/10));   # clip below -40 dB.
+%! S = min(S, 10^(-3/10));    # clip above -3 dB.
+%! imagesc(flipud(20*log10(S)));
+%!
+%! % The image contains a spectrogram of 'sample.wav'
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/tfe.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,40 @@
+## Copyright (C) 2000 Paul Kienzle.
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [Txy, w] = tfe(x, y, ...)
+##
+## Estimate transfer function from input signal x to output signal y.
+## This is simply Txy = Pxy/Pxx.
+##
+## See pwelch for an explanation of the available parameters.
+##
+## See also: csd, cohere
+
+function [...] = tfe(...)
+  if nargin < 2
+    usage("Pxy=tfe(x,y,...)  [see pwelch for details]"); 
+  endif
+  if nargout==0, 
+    pwelch('tfe',all_va_args);
+  elseif nargout==1
+    Txy=pwelch('tfe',all_va_args);
+    vr_val(Txy);
+  elseif nargout==2
+    [Txy, w]=pwelch('tfe',all_va_args);
+    vr_val(Txy);
+    vr_val(w);
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/triang.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,77 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage:  w = triang (n)
+##
+## Returns the filter coefficients of a triangular window of length n.
+## Unlike the bartlett window, triang does not go to zero at the edges
+## of the window.  For odd n, triang(n) is equal to bartlett(n+2) except
+## for the zeros at the edges of the window.
+##
+## Note that the definition of triang for even values and odd values is
+## different.  For odd values, it samples the continous function
+## y=1-|x| at equally spaced points in the range (-1,1) whereas
+## for even values it samples from y=1+1/n-|x|.
+
+## 2001-04-07  Paul Kienzle
+##    * return column vector like other window functions.
+
+function w = triang(n)
+  if (nargin != 1) 
+    usage("w = triang(n)"); 
+  endif
+  if (n != fix (n) || n < 1)
+    error("triang(n): n hast to be an integer > 0"); 
+  endif
+  k=(n-1)/2;
+  if rem(n,2)
+    w = 1-abs([-k:k]')/(k+1);
+  else
+    w = (k+1-abs([-k:k]'))/(k+1/2);
+  endif
+endfunction
+
+%!error triang
+%!error triang(1,2)
+%!error triang([1,2]);
+%!assert (triang(1), 1)
+%!assert (triang(2), [1, 1])
+%!test
+%! x = bartlett(5);
+%! assert (triang(3), x(2:4));
+
+%!demo
+%! subplot(221); axis([-1, 1, 0, 1.3]); grid("on");
+%! title("comparison with continuous for odd n");
+%! n=7; k=(n-1)/2; t=[-k:0.1:k]/(k+1); 
+%! plot(t,1-abs(t),";continuous;",[-k:k]/(k+1),triang(n),"g*;discrete;");
+%!
+%! subplot(222); axis([-1, 1, 0, 1.3]); grid("on");
+%! n=8; k=(n-1)/2; t=[-k:0.1:k]/(k+1/2); 
+%! title("note the higher peak for even n");
+%! plot(t,1+1/n-abs(t),";continuous;",[-k:k]/(k+1/2),triang(n),"g*;discrete;");
+%!
+%! subplot(223); axis; grid("off");
+%! title("n odd, triang(n)==bartlett(n+2)");
+%! n=7;
+%! plot(0:n+1,bartlett(n+2),"g-*;bartlett;",triang(n),"r-+;triang;");
+%!
+%! subplot(224); axis; grid("off");
+%! title("n even, triang(n)!=bartlett(n+2)");
+%! n=8;
+%! plot(0:n+1,bartlett(n+2),"g-*;bartlett;",triang(n),"r-+;triang;");
+%!
+%! oneplot; title("");
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/tripuls.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,70 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: y = tripuls(t, w, skew)
+##
+## Generate a triangular pulse over the interval [-w/2,w/2), sampled at
+## times t.  This is useful with the function pulstran for generating a
+## series pulses.
+##
+## skew is a value between -1 and 1, indicating the relative placement
+## of the peak within the width.  -1 indicates that the peak should be
+## at -w/2, and 1 indicates that the peak should be at w/2.
+##
+## Example
+##   fs = 11025;  # arbitrary sample rate
+##   f0 = 100;    # pulse train sample rate
+##   w = 0.3/f0;  # pulse width 3/10th the distance between pulses
+##   auplot(pulstran(0:1/fs:4/f0, 0:1/f0:4/f0, 'tripuls', w), fs);
+##
+## See also: pulstran
+function y = tripuls(t, w, skew)
+
+  if nargin<1 || nargin>3,
+    usage("y = tripuls(t [, w [, skew]])");
+  endif
+
+  if nargin < 2, w = 1; endif
+  if nargin < 3, skew = 0; endif
+
+  y = zeros(size(t));
+  peak = skew*w/2;
+  dfi = do_fortran_indexing;
+  unwind_protect
+    do_fortran_indexing = 1;
+    idx = find(t>=-w/2 & t <= peak);
+    if (idx) y(idx) = ( t(idx) + w/2 ) / ( peak + w/2 ); endif
+    idx = find(t>peak & t < w/2);
+    if (idx) y(idx) = ( t(idx) - w/2 ) / ( peak - w/2 ); endif 
+  unwind_protect_cleanup
+    do_fortran_indexing = dfi;
+  end_unwind_protect
+endfunction
+
+%!assert(tripuls(0:1/100:0.3,.1), tripuls([0:1/100:0.3]',.1)');
+%!assert(isempty(tripuls([],.1)));
+%!demo
+%! fs = 11025;  # arbitrary sample rate
+%! f0 = 100;    # pulse train sample rate
+%! w = 0.5/f0;  # pulse width 1/10th the distance between pulses
+%! subplot(211); ylabel("amplitude"); xlabel("time (ms)");
+%! title("graph shows 5 ms pulses at 0,10,20,30 and 40 ms");
+%! auplot(pulstran(0:1/fs:4/f0, 0:1/f0:4/f0, 'tripuls', w), fs); 
+%! subplot(212);
+%! title("graph shows 5 ms pulses at 0,10,20,30 and 40 ms, skew -0.5");
+%! auplot(pulstran(0:1/fs:4/f0, 0:1/f0:4/f0, 'tripuls', w, -0.5), fs); 
+%! oneplot(); title(""); xlabel(""); ylabel("");
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/xcorr.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,206 @@
+## Copyright (C) 1999-2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [R, lag] = xcorr (X [, Y] [, maxlag] [, scale])
+##
+## Compute correlation of X and Y for various lags.  
+## Returns R(m+maxlag+1)=Rxy(m) for lag m=[-maxlag:maxlag].
+## Scale is one of:
+##    'biased'   for correlation=raw/N, 
+##    'unbiased' for correlation=raw/(N-|lag|), 
+##    'coeff'    for correlation=raw/(correlation at lag 0),
+##    'none'     for correlation=raw
+## If Y is omitted, compute autocorrelation.  
+## If maxlag is omitted, use N-1 where N=max(length(X),length(Y)).
+## If scale is omitted, use 'none'.
+##
+## If X is a matrix, computes the cross correlation of each column
+## against every other column for every lag.  The resulting matrix has
+## 2*maxlag+1 rows and P^2 columns where P is columns(X). That is,
+##    R(m+maxlag+1,P*(i-1)+j) == Rij(m) for lag m=[-maxlag:maxlag],
+## so
+##    R(:,P*(i-1)+j) == xcorr(X(:,i),X(:,j))
+## and
+##    reshape(R(m,:),P,P) is the cross-correlation matrix for X(m,:).
+##
+## Ref: Stearns, SD and David, RA (1988). Signal Processing Algorithms.
+##      New Jersey: Prentice-Hall.
+
+## 2000-03 pkienzle@kienzle.powernet.co.uk
+##     - use fft instead of brute force to compute correlations
+##     - allow row or column vectors as input, returning same
+##     - compute cross-correlations on columns of matrix X
+##     - compute complex correlations consitently with matlab
+## 2000-04 pkienzle@kienzle.powernet.co.uk
+##     - fix test for real return value
+## 2001-02-24 Paul Kienzle
+##     - remove all but one loop
+
+function [R, lags] = xcorr (X, Y, maxlag, scale)
+  
+  if (nargin < 1 || nargin > 4)
+    usage ("[c, lags] = xcorr(x [, y] [, h] [, scale])");
+  endif
+
+  ## assign arguments from list
+  if nargin==1
+    Y=[]; maxlag=[]; scale=[];
+  elseif nargin==2
+    maxlag=[]; scale=[];
+    if isstr(Y), scale=Y; Y=[];
+    elseif is_scalar(Y), maxlag=Y; Y=[];
+    endif
+  elseif nargin==3
+    scale=[];
+    if isstr(maxlag), scale=maxlag; scale=[]; endif
+    if is_scalar(Y), maxlag=Y; Y=[]; endif
+  endif
+
+  ## assign defaults to arguments which were not passed in
+  if is_vector(X) 
+    if isempty(Y), Y=X; endif
+    N = max(length(X),length(Y));
+  else
+    N = rows(X);
+  endif
+  if isempty(maxlag), maxlag=N-1; endif
+  if isempty(scale), scale='none'; endif
+
+  ## check argument values
+  if is_scalar(X) || isstr(X) || isempty(X)
+    error("xcorr: X must be a vector or matrix"); 
+  endif
+  if is_scalar(Y) || isstr(Y) || (!isempty(Y) && !is_vector(Y))
+    error("xcorr: Y must be a vector");
+  endif
+  if !is_vector(X) && !isempty(Y)
+    error("xcorr: X must be a vector if Y is specified");
+  endif
+  if !is_scalar(maxlag) && !isempty(maxlag) 
+    error("xcorr: maxlag must be a scalar"); 
+  endif
+  if maxlag>N-1, 
+    error("xcorr: maxlag must be less than length(X)"); 
+  endif
+  if is_vector(X) && is_vector(Y) && length(X) != length(Y) && \
+	!strcmp(scale,'none')
+    error("xcorr: scale must be 'none' if length(X) != length(Y)")
+  endif
+    
+  P = columns(X);
+  M = 2^nextpow2(N + maxlag);
+  if !is_vector(X) 
+    ## For matrix X, compute cross-correlation of all columns
+    R = zeros(2*maxlag+1,P^2);
+
+    ## Precompute the padded and transformed `X' vectors
+    pre = fft (postpad (prepad (X, N+maxlag), M) ); 
+    post = conj (fft (postpad (X, M)));
+
+    ## For diagonal (i==j)
+    cor = ifft (post .* pre);
+    R(:, 1:P+1:P^2) = conj (cor (1:2*maxlag+1,:));
+
+    ## For remaining i,j generate xcorr(i,j) and by symmetry xcorr(j,i).
+    for i=1:P-1
+      j = i+1:P;
+      cor = ifft (post(:,i*ones(length(j),1)) .* pre(:,j));
+      R(:,(i-1)*P+j) = conj (cor (1:2*maxlag+1, :));
+      R(:,(j-1)*P+i) = flipud (cor (1:2*maxlag+1, :));
+    endfor
+  elseif isempty(Y)
+    ## compute autocorrelation of a single vector
+    post = fft (postpad(X,M));
+    cor = ifft (conj(post(:)) .* post(:));
+    R = [ conj(cor(maxlag+1:-1:2)) ; cor(1:maxlag+1) ];
+  else 
+    ## compute cross-correlation of X and Y
+    post = fft (postpad(X,M));
+    pre = fft (postpad(prepad(Y,N+maxlag),M));
+    cor = conj (ifft (conj(post(:)) .* pre(:)));
+    R = cor(1:2*maxlag+1);
+  endif
+
+  ## if inputs are real, outputs should be real, so ignore the
+  ## insignificant complex portion left over from the FFT
+  if isreal(X) && (isempty(Y) || isreal(Y))
+    R=real(R); 
+  endif
+
+  ## correct for bias
+  if strcmp(scale, 'biased')
+    R = R ./ N;
+  elseif strcmp(scale, 'unbiased')
+    R = R ./ ( [ N-maxlag:N-1, N, N-1:-1:N-maxlag ]' * ones(1,columns(R)) );
+  elseif strcmp(scale, 'coeff')
+    R = R ./ ( ones(rows(R),1) * R(maxlag+1, :) );
+  elseif !strcmp(scale, 'none')
+    error("xcorr: scale must be 'biased', 'unbiased', 'coeff' or 'none'");
+  endif
+    
+  ## correct the shape so that it is the same as the input vector
+  if is_vector(X) && P > 1
+    R = R'; 
+  endif
+  
+  ## return the lag indices if desired
+  if nargout == 2
+    lags = -maxlag:maxlag;
+  endif
+
+endfunction
+
+##------------ Use brute force to compute the correlation -------
+##if !is_vector(X) 
+##  ## For matrix X, compute cross-correlation of all columns
+##  R = zeros(2*maxlag+1,P^2);
+##  for i=1:P
+##    for j=i:P
+##      idx = (i-1)*P+j;
+##      R(maxlag+1,idx) = X(i)*X(j)';
+##      for k = 1:maxlag
+##  	    R(maxlag+1-k,idx) = X(k+1:N,i) * X(1:N-k,j)';
+##  	    R(maxlag+1+k,idx) = X(k:N-k,i) * X(k+1:N,j)';
+##      endfor
+##	if (i!=j), R(:,(j-1)*P+i) = conj(flipud(R(:,idx))); endif
+##    endfor
+##  endfor
+##elseif isempty(Y)
+##  ## reshape X so that dot product comes out right
+##  X = reshape(X, 1, N);
+##    
+##  ## compute autocorrelation for 0:maxlag
+##  R = zeros (2*maxlag + 1, 1);
+##  for k=0:maxlag
+##  	R(maxlag+1+k) = X(1:N-k) * X(k+1:N)';
+##  endfor
+##
+##  ## use symmetry for -maxlag:-1
+##  R(1:maxlag) = conj(R(2*maxlag+1:-1:maxlag+2));
+##else
+##  ## reshape and pad so X and Y are the same length
+##  X = reshape(postpad(X,N), 1, N);
+##  Y = reshape(postpad(Y,N), 1, N)';
+##  
+##  ## compute cross-correlation
+##  R = zeros (2*maxlag + 1, 1);
+##  R(maxlag+1) = X*Y;
+##  for k=1:maxlag
+##  	R(maxlag+1-i) = X(k+1:N) * Y(1:N-k);
+##  	R(maxlag+1+i) = X(k:N-i) * Y(k+1:N);
+##  endfor
+##endif
+##--------------------------------------------------------------
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/xcorr2.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,83 @@
+## Copyright (C) 2000 Dave Cogdell
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## C = xcorr2 (A, B)
+##	Compute the 2D cross-correlation of matrices A and B.
+## C = xcorr2 (A)
+##      Compute two-dimensional autocorrelation of matrix A.
+## C = xcorr2 (..., 'scale')
+##      biased   - scales the raw cross-correlation by the maximum number
+##                 of elements of A and B involved in the generation of 
+##                 any element of C
+##      unbiased - scales the raw correlation by dividing each element 
+##                 in the cross-correlation matrix by the number of
+##                 products A and B used to generate that element 
+##      coeff    - normalizes the sequence so that the largest 
+##                 cross-correlation element is identically 1.0.
+##      none     - no scaling (this is the default).
+
+## Author: Dave Cogdell <cogdelld@asme.org>
+## 2000-05-02 Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##    * joined R. Johnson's xcorr2f.m and Dave Cogdell's xcorr2x.m
+##    * adapted for Octave
+## 2001-01-15 Paul Kienzle
+##    * vectorized code for 'unbiased' correction
+## 2001-02-06 Paul Kienzle
+##    * replaced R. Johnson's xcorr2f code with code based on conv2
+
+function c = xcorr2(a,b,biasflag)
+
+  if (nargin < 1 || nargin > 3)
+    usage ("c = xcorr2(A [, B] [, 'scale'])");
+  endif
+  if nargin == 1
+    b = a; 
+    biasflag = 'none'; 
+  elseif nargin == 2
+    if isstr (b) 
+      biasflag = b; 
+      b = a;
+    else 
+      biasflag = 'none';
+    endif
+  endif
+
+  ## compute correlation
+  [ma,na] = size(a);
+  [mb,nb] = size(b);
+  c = conv2 (a, conj (b (mb:-1:1, nb:-1:1)));
+
+  ## bias routines by Dave Cogdell (cogdelld@asme.org)
+  ## optimized by Paul Kienzle (pkienzle@kienzle.powernet.co.uk)
+  if strcmp(lower(biasflag), 'biased'),
+    c = c / ( min ([ma, mb]) * min ([na, nb]) );
+  elseif strcmp(lower(biasflag), 'unbiased'), 
+    eleo = empty_list_elements_ok;
+    unwind_protect
+      lo = min ([na,nb]); hi = max ([na, nb]);
+      row = [ 1:(lo-1), lo*ones(1,hi-lo+1), (lo-1):-1:1 ];
+      lo = min ([ma,mb]); hi = max ([ma, mb]);
+      col = [ 1:(lo-1), lo*ones(1,hi-lo+1), (lo-1):-1:1 ]';
+      empty_list_elements_ok = 1;
+    unwind_protect_cleanup
+      empty_list_elements_ok = eleo;
+    end_unwind_protect
+    bias = col*row;
+    c = c./bias;
+  elseif strcmp(lower(biasflag),'coeff'),
+    c = c/max(c(:))';
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/xcov.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,64 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+
+## usage: [c, lag] = xcov (X [, Y] [, maxlag] [, scale])
+##
+## Compute covariance at various lags [=correlation(x-mean(x),y-mean(y))].
+##
+## X: input vector
+## Y: if specified, compute cross-covariance between X and Y,
+## otherwise compute autocovariance of X.
+## maxlag: is specified, use lag range [-maxlag:maxlag], 
+## otherwise use range [-n+1:n-1].
+## Scale:
+##    'biased'   for covariance=raw/N, 
+##    'unbiased' for covariance=raw/(N-|lag|), 
+##    'coeff'    for covariance=raw/(covariance at lag 0),
+##    'none'     for covariance=raw
+## 'none' is the default.
+##
+## Returns the covariance for each lag in the range, plus an 
+## optional vector of lags.
+
+function [retval, lags] = xcov (X, Y, maxlag, scale)
+
+  if (nargin < 1 || nargin > 4)
+    usage ("[c, lags] = xcov(x [, y] [, h] [, scale])");
+  endif
+
+  if nargin==1
+    Y=[]; maxlag=[]; scale=[];
+  elseif nargin==2
+    maxlag=[]; scale=[];
+    if isstr(Y), scale=Y; Y=[];
+    elseif is_scalar(Y), maxlag=Y; Y=[];
+    endif
+  elseif nargin==3
+    scale=[];
+    if isstr(maxlag), scale=maxlag; scale=[]; endif
+    if is_scalar(Y), maxlag=Y; Y=[]; endif
+  endif
+
+  ## XXX FIXME XXX --- should let center(Y) deal with []
+  ## [retval, lags] = xcorr(center(X), center(Y), maxlag, scale);
+  if (!isempty(Y))
+    [retval, lags] = xcorr(center(X), center(Y), maxlag, scale);
+  else
+    [retval, lags] = xcorr(center(X), maxlag, scale);
+  endif
+  
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/signal/zplane.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,147 @@
+## Copyright (C) 1999 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: zplane(b [, a]) or zplane(z [, p])
+##
+## Plot the poles and zeros.  If the arguments are row vectors then they
+## represent filter coefficients (numerator polynomial b and denominator
+## polynomial a), but if they are column vectors or matrices then they
+## represent poles and zeros.
+##
+## This is a horrid interface, but I didn't choose it; better would be
+## to accept b,a or z,p,g like other functions.  The saving grace is
+## that poly(x) always returns a row vector and roots(x) always returns
+## a column vector, so it is usually right.  You must only be careful
+## when you are creating filters by hand.
+##
+## Note that due to the nature of the roots() function, poles and zeros
+## may be displayed as occurring around a circle rather than at a single
+## point.
+##
+## The denominator a defaults to 1, and the poles p defaults to [].
+## Either way no poles are displayed.
+
+## 2001-03-17 Paul Kienzle
+##     * extend axes to include all points outside the unit circle
+
+## TODO: Give some indication of the number of poles or zeros at a 
+## TODO:    specific point.  Affixing a x3 or something similar beside 
+## TODO:    three identical poles for example would be useful.
+## TODO: Use different colors for different columns of the matrix for
+## TODO:    compatibility if no other reason
+## TODO: Consider a plot-like interface:
+## TODO:       zplane(x1,y1,fmt1,x2,y2,fmt2,...)
+## TODO:    with y_i or fmt_i optional as usual.  This would allow
+## TODO:    legends and control over point colour and filters of
+## TODO:    different orders.
+function zplane(z, p)
+
+  if (nargin < 1 || nargin > 2)
+    usage("zplane(b [, a]) or zplane(z [, p])");
+  end
+  if nargin < 2, p=[]; endif
+  if columns(z)>1 || columns(p)>1
+    if rows(z)>1 || rows(p)>1
+      ## matrix form: columns are already zeros/poles
+    else
+      if isempty(z), z=1; endif
+      if isempty(p), p=1; endif
+      [z, p, g] = tf2zp(z, p);
+    endif
+  endif
+
+  eleo = empty_list_elements_ok;          ##<oct
+  unwind_protect                          ##<oct
+    empty_list_elements_ok = 1;           ##<oct
+
+    xmin = min([-1; real(z(:)); real(p(:))]);
+    xmax = max([ 1; real(z(:)); real(p(:))]);
+    ymin = min([-1; imag(z(:)); imag(p(:))]);
+    ymax = max([ 1; imag(z(:)); imag(p(:))]);
+    xfluff = max([0.05*(xmax-xmin), (1.05*(ymax-ymin)-(xmax-xmin))/10]);
+    yfluff = max([0.05*(ymax-ymin), (1.05*(xmax-xmin)-(ymax-ymin))/10]);
+    xmin = xmin - xfluff;
+    xmax = xmax + xfluff;
+    ymin = ymin - yfluff;
+    ymax = ymax + yfluff;
+  
+    gset pointsize 2                      ##<oct
+    axis('equal');                        ##<oct
+    axis([xmin, xmax, ymin, ymax]);       ##<oct
+    grid('on');                           ##<oct
+    r = exp(2i*pi*[0:100]/100);           ##<oct
+    plot(real(r), imag(r),";;");          ##<oct
+    hold on;                              ##<oct
+    if !isempty(z),                       ##<oct
+      plot(real(z), imag(z), "bo;;");     ##<oct
+    endif                                 ##<oct
+    if !isempty(p),                       ##<oct
+      plot(real(p), imag(p), "bx;;");     ##<oct
+    endif                                 ##<oct
+  unwind_protect_cleanup                  ##<oct
+    empty_list_elements_ok = eleo;        ##<oct
+    hold off;                             ##<oct
+    grid("off");                          ##<oct
+    axis();                               ##<oct
+    gset pointsize 1                      ##<oct
+    axis('normal');                       ##<oct
+  end_unwind_protect                      ##<oct
+  ##<mat r = exp(2i*pi*[0:100]/100);
+  ##<mat plot(real(r), imag(r),'k'); hold on;
+  ##<mat axis equal;
+  ##<mat grid on;
+  ##<mat axis(1.05*[xmin, xmax, ymin, ymax]);
+  ##<mat if !isempty(p), plot(real(p), imag(p), "bx", 'MarkerSize', 10); end
+  ##<mat if !isempty(z), plot(real(z), imag(z), "bo", 'MarkerSize', 10); end
+  ##<mat hold off;
+endfunction
+
+%!demo
+%! ## construct target system:
+%! ##   symmetric zero-pole pairs at r*exp(iw),r*exp(-iw)
+%! ##   zero-pole singletons at s
+%! pw=[0.2, 0.4, 0.45, 0.95];   #pw = [0.4];
+%! pr=[0.98, 0.98, 0.98, 0.96]; #pr = [0.85];
+%! ps=[];
+%! zw=[0.3];  # zw=[];
+%! zr=[0.95]; # zr=[];
+%! zs=[];
+%! 
+%! save_empty_list_elements_ok = empty_list_elements_ok;      ##<oct
+%! unwind_protect
+%!   empty_list_elements_ok = 1;                              ##<oct
+%!   ## system function for target system
+%!   p=[[pr, pr].*exp(1i*pi*[pw, -pw]), ps]';
+%!   z=[[zr, zr].*exp(1i*pi*[zw, -zw]), zs]';
+%! unwind_protect_cleanup
+%!   empty_list_elements_ok = save_empty_list_elements_ok;    ##<oct
+%! end_unwind_protect
+%! sys_a = real(poly(p));
+%! sys_b = real(poly(z));
+
+%! disp("The first two graphs should be identical, with poles at (r,w)=");
+%! disp(sprintf(" (%.2f,%.2f)", [pr ; pw]));
+%! disp("and zeros at (r,w)=");
+%! disp(sprintf(" (%.2f,%.2f)", [zr ; zw]));
+%! disp("with reflection across the horizontal plane");
+%! subplot(231); title("transfer function form"); zplane(sys_b, sys_a);
+%! subplot(232); title("pole-zero form"); zplane(z,p);
+
+%! subplot(233); title("empty p"); zplane(z); 
+%! subplot(234); title("empty a"); zplane(sys_b);
+%! disp("The matrix plot has 2 sets of points, one inside the other");
+%! subplot(235); title("matrix"); zplane([z, 0.7*z], [p, 0.7*p]);
+%! oneplot();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/ChangeLog	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,18 @@
+10 nov 2000   Andy Adler <adler@ncf.ca>
+
+    * added directories for sparse functions
+
+17 dec 2000   Andy Adler <adler@ncf.ca>
+
+    * added support for sparse inverse
+    * added support for sparse \ sparse
+    * broke code into multiple *.cc files
+
+ 8 apr 2001   Andy Adler <adler@ncf.ca>
+
+    * added support for complex sparse matrices
+    * modified sparse to support default numeric conversion
+    * moved most sparse_ops into "templates" in sparse_ops.h
+    * expanded test cases
+    * added dmalloc support - fixed many memory leaks
+       mostly in inv and lu code - not using the right destructor
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,218 @@
+# Makefile and README for octave SuperLU routines
+# $Id$
+#
+# $Log$
+# Revision 1.1  2001/10/10 19:54:49  pkienzle
+# Initial revision
+#
+# Revision 1.7  2001/04/04 02:13:46  aadler
+# complete complex_sparse, templates, fix memory leaks
+#
+# Revision 1.6  2001/03/30 04:36:30  aadler
+# added multiply, solve, and sparse creation
+#
+# Revision 1.5  2001/03/15 15:47:58  aadler
+# cleaned up duplicated code by using "defined" templates.
+# used default numerical conversions
+#
+# Revision 1.4  2001/03/06 03:20:12  aadler
+# added automatic numeric_conversion_function
+#
+# Revision 1.3  2001/02/27 03:01:51  aadler
+# added rudimentary complex matrix support
+#
+# Revision 1.2  2000/12/18 03:31:16  aadler
+# Split code to multiple files
+# added sparse inverse
+#
+# Revision 1.1  2000/11/11 02:47:11  aadler
+# DLD functions for sparse support in octave
+#
+# Revision 1.2  2000/05/02 00:10:34  andy
+# mods to work with 2.1.30
+#
+#
+# INSTRUCTIONS
+#
+# 0. Check that you have the following files:
+#   a Makefile
+#   b make_sparse.cc
+#   c make_sparse.h
+#   d sp_test.m
+#   e fem_test.m
+#   f superlu2.0patch.diff
+#   
+# 0a. This is tested to work with octave-2.1.32
+#     It works with >2.1.30 if you apply the mkoctfile patch
+#     at
+# 
+# 0b. If you already have a SuperLU subdirectory with
+#     SuperLU/SRC and SuperLU/CBLAS then ignore 
+#     steps 1-3
+# 
+# 1. Download SuperLU from one of the following sites
+#                          http://www.netlib.org/scalapack/prototype
+#                          ftp://ftp.cs.berkeley/pub/src/lapack/SuperLU
+#                          http://www.nersc.gov/~xiaoye/SuperLU/
+#
+# 2. Unpack SuperLU into the directory you'll be building the
+#     octave sparse functions from
+#
+# 3. Apply the patch
+#           patch -p0 < superlu2.0patch.diff
+#
+# 4. Build the octave sparse functions
+#           make    in the octave sparse functions directory
+#           NOTE: do not run the SuperLU makefiles - 
+#                it doesn't build the right objects into the library
+#
+# This makefile assumes that the SuperLU package has been unpacked
+#  in this directory. It compiles files directly from their locations
+#  in the SuperLU source. You do not need to use SuperLU makefiles.
+#
+# SuperLU is available from http://www.netlib.org/scalapack/prototype
+#                           ftp://ftp.cs.berkeley/pub/src/lapack/SuperLU
+#
+# 
+# AUTHOR:  Andy Adler <adler@ncf.ca>
+# 
+# COPYRIGHT:
+# Copyright (C) 1998-2000 Andy Adler
+# 
+#    This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License as
+# published by the Free Software Foundation; either version 2 of
+# the License, or (at your option) any later version.
+#    This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#    You should have received a copy of the GNU General Public
+# License along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+sinclude ../../Makeconf
+
+NAME     =   make_sparse
+OBJLINKS =   spfind.oct sparse.oct full.oct splu.oct nnz.oct spinv.oct
+SUPERLU  =   SuperLU
+OCTVER   =   -2.1.32
+OCTAVE   =   octave$(OCTVER)
+ifndef MKOCTFILE
+MKOCTFILE=   mkoctfile$(OCTVER)
+endif
+
+AR       =   ar
+CPP      =   c++
+CC       =   gcc
+STRIP    =  strip
+
+S_INC=   -I$(SUPERLU)/SRC/ \
+         -I$(SUPERLU)/CBLAS
+
+# CCDEFS = -DVERBOSE 
+# CCDEFS = -DVERBOSE -DUSE_DMALLOC -DANDYS_SEGFAULT_OVERRIDE -DVERBOSE
+# DLIBS = -ldmallocxx -ldmalloc
+# CCDEFS = -DVERBOSE -v
+# CCDEFS = -v
+# CCDEFS = -DANDYS_SEGFAULT_OVERRIDE -DVERBOSE
+
+
+
+# Special defines for SuperLU
+# 1. we need to define Add_ so that blas links up with the
+#     octave definitions
+# 2. we need to override USER_ABORT(msg), USER_MALLOC(size)
+#         and USER_FREE(addr) to provide our own implemetations
+SUPERLU_DEFS = -DAdd_ -O3  \
+               -D"USER_MALLOC(size)=oct_sparse_malloc(size)" \
+               -D"USER_ABORT(msg)=oct_sparse_fatalerr(msg)" \
+               -D"USER_FREE(addr)=oct_sparse_free(addr)"
+
+#use these defs when testing with dmalloc
+#SUPERLU_DEFS = -DAdd_ -O3  \
+#               -D"USER_MALLOC(size)=_malloc_leap(__FILE__, __LINE__, size)" \
+#               -D"USER_ABORT(msg)=oct_sparse_fatalerr(msg)" \
+#               -D"USER_FREE(addr)=if(addr) _free_leap(__FILE__, __LINE__, addr)"
+
+OCTOBJ= sparse_ops.o make_sparse.o sparse_full.o sparse_inv.o \
+        complex_sparse_ops.o
+
+LIBSUPERLU = libsuperlu.a
+
+S_SRC  = $(SUPERLU)/SRC
+S_CBLAS= $(SUPERLU)/CBLAS
+
+ALLAUX = $(S_SRC)/superlu_timer.o   $(S_SRC)/lsame.o \
+         $(S_SRC)/util.o            $(S_SRC)/memory.o \
+         $(S_SRC)/get_perm_c.o      $(S_SRC)/mmd.o \
+         $(S_SRC)/sp_coletree.o     $(S_SRC)/sp_preorder.o \
+         $(S_SRC)/sp_ienv.o         $(S_SRC)/relax_snode.o \
+         $(S_SRC)/xerbla.o          $(S_SRC)/colamd.o
+
+DZLAUX = $(S_SRC)/dlamch.o \
+         $(S_CBLAS)/dmyblas2.o $(S_CBLAS)/zmyblas2.o
+
+DLUSRC = $(S_SRC)/dgssv.o           $(S_SRC)/dgssvx.o \
+         $(S_SRC)/dsp_blas2.o       $(S_SRC)/dsp_blas3.o \
+         $(S_SRC)/dgscon.o          $(S_SRC)/dlacon.o \
+         $(S_SRC)/dlangs.o          $(S_SRC)/dgsequ.o \
+         $(S_SRC)/dlaqgs.o          $(S_SRC)/dpivotgrowth.o \
+         $(S_SRC)/dgsrfs.o          $(S_SRC)/dgstrf.o \
+         $(S_SRC)/dgstrs.o          $(S_SRC)/dcopy_to_ucol.o \
+         $(S_SRC)/dsnode_dfs.o      $(S_SRC)/dsnode_bmod.o \
+         $(S_SRC)/dpanel_dfs.o      $(S_SRC)/dpanel_bmod.o \
+         $(S_SRC)/dreadhb.o         $(S_SRC)/dcolumn_dfs.o \
+         $(S_SRC)/dcolumn_bmod.o    $(S_SRC)/dpivotL.o \
+         $(S_SRC)/dpruneL.o         $(S_SRC)/dmemory.o \
+         $(S_SRC)/dutil.o
+
+ZLUSRC = $(S_SRC)/zgssv.o           $(S_SRC)/zgssvx.o \
+         $(S_SRC)/zsp_blas2.o       $(S_SRC)/zsp_blas3.o \
+         $(S_SRC)/zgscon.o          $(S_SRC)/zlacon.o \
+         $(S_SRC)/zlangs.o          $(S_SRC)/zgsequ.o \
+         $(S_SRC)/zlaqgs.o          $(S_SRC)/zpivotgrowth.o \
+         $(S_SRC)/zgsrfs.o          $(S_SRC)/zgstrf.o \
+         $(S_SRC)/zgstrs.o          $(S_SRC)/zcopy_to_ucol.o \
+         $(S_SRC)/zsnode_dfs.o      $(S_SRC)/zsnode_bmod.o \
+         $(S_SRC)/zpanel_dfs.o      $(S_SRC)/zpanel_bmod.o \
+         $(S_SRC)/zreadhb.o         $(S_SRC)/zcolumn_dfs.o \
+         $(S_SRC)/zcolumn_bmod.o    $(S_SRC)/zpivotL.o \
+         $(S_SRC)/zpruneL.o         $(S_SRC)/zmemory.o \
+         $(S_SRC)/zutil.o           $(S_SRC)/dcomplex.o
+
+S_DOUBLE= $(DLUSRC) $(ALLAUX) $(DZLAUX) $(ZLUSRC)
+
+all: $(NAME).oct # test
+
+$(S_DOUBLE):%.o:%.c
+	$(CC) $(S_INC) $(CDEFS) $(SUPERLU_DEFS) -c $< -o $@
+
+$(OCTOBJ): make_sparse.h
+sparse_ops.o complex_sparse_ops.o: sparse_ops.h
+
+$(OCTOBJ): %.o: %.cc
+	$(MKOCTFILE) -c $< $(S_INC) $(CCDEFS) -o $@
+
+$(LIBSUPERLU): $(S_DOUBLE)
+	$(AR) -r $(LIBSUPERLU) $(S_DOUBLE)
+
+$(NAME).oct: $(OCTOBJ) $(LIBSUPERLU)
+	$(MKOCTFILE)  $(OCTOBJ) -o $(NAME).oct  -lsuperlu -L. $(DLIBS)
+	$(STRIP) $(NAME).oct
+	for i in $(OBJLINKS); do ln -sf $(NAME).oct $$i ; done
+
+test: $(NAME).oct
+	export DMALLOC_OPTIONS=debug=0x4f47d03,inter=100,log=logfile
+	@echo 
+	@echo "Testing sparse functions ..."
+	@echo 
+	$(OCTAVE) -qf sp_test.m 2>/dev/null
+	@echo 
+	@echo "Testing sparse solution for a Finite Element Model ..." 
+	@echo 
+	$(OCTAVE) -qf fem_test.m
+
+clean:
+	-$(RM) $(NAME).oct $(OBJLINKS) $(OCTOBJ) $(S_DOUBLE) $(LIBSUPERLU) octave-core core *~
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/README	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,202 @@
+This is a sparse matrix toolkit for octave based
+on the SuperLU package.
+
+ID: $Id$
+
+AUTHOR:  Andy Adler <adler@ncf.ca>
+
+INSTRUCTIONS
+
+0. Check that you have the following files:
+  a Makefile
+  b make_sparse.cc
+  c make_sparse.h
+  d sp_test.m
+  e fem_test.m
+  f superlu2.0patch.diff
+  
+0a. This is tested to work with octave-2.1.32
+    It works with >2.1.30 if you apply the mkoctfile patch
+    at www.octave.org/mailing-lists/octave-maintainers/2000/175
+
+0b. If you already have a SuperLU subdirectory with
+    SuperLU/SRC and SuperLU/CBLAS then ignore 
+    steps 1-3
+
+1. Download SuperLU from one of the following sites
+                         http://www.netlib.org/scalapack/prototype
+                         ftp://ftp.cs.berkeley/pub/src/lapack/SuperLU
+                         http://www.nersc.gov/~xiaoye/SuperLU/
+
+2. Unpack SuperLU into the directory you'll be building the
+    octave sparse functions from
+
+3. Apply the patch
+          patch -p0 < superlu2.0patch.diff
+
+4. Build the octave sparse functions
+          make    in the octave sparse functions directory
+          NOTE: do not run the SuperLU makefiles - 
+               it doesn't build the right objects into the library
+
+This makefile assumes that the SuperLU package has been unpacked
+ in this directory. It compiles files directly from their locations
+ in the SuperLU source. You do not need to use SuperLU makefiles.
+
+SuperLU is available from http://www.netlib.org/scalapack/prototype
+                          ftp://ftp.cs.berkeley/pub/src/lapack/SuperLU
+
+
+AUTHOR:  Andy Adler <en254@ncf.ca>
+
+COPYRIGHT:
+Copyright (C) 1998-00 Andy Adler
+
+   This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License as
+published by the Free Software Foundation; either version 2 of
+the License, or (at your option) any later version.
+   This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+   You should have received a copy of the GNU General Public
+License along with this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+SUPERLU COPYRIGHT:
+The following copyright is taken from any of the
+files in the SuperLU/SRC directory
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/ 
+
+USAGE:
+   sparse functions are provided for
+
+   sparse -> create sparse matrices
+   full   -> create full matrices from sparse
+   splu   -> spare lu decomposition
+   spfind -> find elements of sparse matrices
+   nnz    -> number of non zero elements
+
+   Unitary operators
+
+   S'    S.'   -S    ~S
+
+   Binary operators
+   ==  +   -   *   .*   \ 
+
+   Selection
+   A( fortran_vec ) ,   A( idx1, idx2 )
+
+
+MISSING FEATURES (TODO FILE)
+(This is more or less in the order of importance, and
+ probability of accomplishment)
+
+1.  Sparse solution: there is no code for
+    sparse(index1,index2) = submatrix
+    [ sparse , sparse ]
+
+2.  More efficient code for:
+    sparse \ sparse
+    spinv
+    splu
+
+3.  More "sophisticated" matrix operations on sparse
+    eigenvectors
+    chol
+    SVD
+    etc.
+
+KNOWN AND PREDICTED BUGS AND FEATURES:
+
+1.  It probably leaks memory. I'll try to test this more carefully
+    after I stop adding features.
+
+2.  It does not support empty matrices properly.
+    It does not support completely sparse (all zero) matricies either.
+
+3.  The attempt here is to provide compatability to the main MATLAB
+    sparse matrix entry points. The SuperLU provides slightly different
+    fuctionality to MATLAB, and, therefore this toolkit provides
+    different features.
+
+    For example, the column permutation algorithm (and approach) is
+    different.
+
+    Additionally, I don't intend to provide replacements for the
+    MATLAB sparse functions I consider frills. eg sprand.m, treeplot.m
+
+4.  SuperLU uses the int data type as indices. Since ints are normally
+    4 bytes (at least on i386 machines), this is not a great problem.
+    There may be still a few places where an int is used to refer
+    to i+j*m, which means that sparse operations on matrices where
+    m*n > maxint/2 may be buggy. I've tried to fix this, but there
+    may be some left.  Email me if you find any.
+
+5.  Sparse solve is a little faster than the MATLAB equivalent, except
+    it seems not to choose the factoring as well. Using a perm_c spec of
+    2 for symetric matrices will get speed improvements of ~ 1.5.
+    (For the FEM problems I use it for)
+
+TODO:
+
+add complex test cases 
+
+add tests for failures (matrix size mismatch)
+
+go though sparse_ops.h and support all zero matrices
+
+test code for all zero and empty matrices
+
+more efficient code for sparse \ sparse
+  - fix casting spagetti
+
+support sparse \ sparse for complex
+
+move code to c++ operators - so we can use sparse from liboctave
+
+fix error for sparse(1)\1
+   DEBUG:sparse - matrix_to_sparse
+   DEBUG:sparse( SuperMatrix A)
+   DEBUG:sparse - numeric_conversion_function
+   DEBUG:sparse - default_numeric_conversion_function
+   DEBUG:sparse - matrix_value
+   DEBUG:sparse - sparse_to_full
+   error: operator \: nonconformant arguments (op1 is 1x1, op2 is 1x1)
+
+   #include <octave/oct.h>
+   defun_dld (jnk, args, , "jnk" ) {
+     matrix x(1,1); x(0,0)= 1; octave_value o1(x);
+     octave_value o2(2.0);
+     octave_value_list retval; retval(0)= o1/(o2);
+     return retval;
+   }
+
+complex sparse constructor will create real sparse if matrix
+is actually real
+
+make debug constructor which sanity checks matrices
+ - option which checks if no nonzero elems isist
+
+complex sparse functions for splu - spinv 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/CBLAS/dmyblas2.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,225 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:		dmyblas2.c
+ * Purpose:
+ *     Level 2 BLAS operations: solves and matvec, written in C.
+ * Note:
+ *     This is only used when the system lacks an efficient BLAS library.
+ */
+
+/*
+ * Solves a dense UNIT lower triangular system. The unit lower 
+ * triangular matrix is stored in a 2D array M(1:nrow,1:ncol). 
+ * The solution will be returned in the rhs vector.
+ */
+void dlsolve ( int ldm, int ncol, double *M, double *rhs )
+{
+    int k;
+    double x0, x1, x2, x3, x4, x5, x6, x7;
+    double *M0;
+    register double *Mki0, *Mki1, *Mki2, *Mki3, *Mki4, *Mki5, *Mki6, *Mki7;
+    register int firstcol = 0;
+
+    M0 = &M[0];
+
+    while ( firstcol < ncol - 7 ) { /* Do 8 columns */
+      Mki0 = M0 + 1;
+      Mki1 = Mki0 + ldm + 1;
+      Mki2 = Mki1 + ldm + 1;
+      Mki3 = Mki2 + ldm + 1;
+      Mki4 = Mki3 + ldm + 1;
+      Mki5 = Mki4 + ldm + 1;
+      Mki6 = Mki5 + ldm + 1;
+      Mki7 = Mki6 + ldm + 1;
+
+      x0 = rhs[firstcol];
+      x1 = rhs[firstcol+1] - x0 * *Mki0++;
+      x2 = rhs[firstcol+2] - x0 * *Mki0++ - x1 * *Mki1++;
+      x3 = rhs[firstcol+3] - x0 * *Mki0++ - x1 * *Mki1++ - x2 * *Mki2++;
+      x4 = rhs[firstcol+4] - x0 * *Mki0++ - x1 * *Mki1++ - x2 * *Mki2++
+	                   - x3 * *Mki3++;
+      x5 = rhs[firstcol+5] - x0 * *Mki0++ - x1 * *Mki1++ - x2 * *Mki2++
+	                   - x3 * *Mki3++ - x4 * *Mki4++;
+      x6 = rhs[firstcol+6] - x0 * *Mki0++ - x1 * *Mki1++ - x2 * *Mki2++
+	                   - x3 * *Mki3++ - x4 * *Mki4++ - x5 * *Mki5++;
+      x7 = rhs[firstcol+7] - x0 * *Mki0++ - x1 * *Mki1++ - x2 * *Mki2++
+	                   - x3 * *Mki3++ - x4 * *Mki4++ - x5 * *Mki5++
+			   - x6 * *Mki6++;
+
+      rhs[++firstcol] = x1;
+      rhs[++firstcol] = x2;
+      rhs[++firstcol] = x3;
+      rhs[++firstcol] = x4;
+      rhs[++firstcol] = x5;
+      rhs[++firstcol] = x6;
+      rhs[++firstcol] = x7;
+      ++firstcol;
+    
+      for (k = firstcol; k < ncol; k++)
+	rhs[k] = rhs[k] - x0 * *Mki0++ - x1 * *Mki1++
+	                - x2 * *Mki2++ - x3 * *Mki3++
+                        - x4 * *Mki4++ - x5 * *Mki5++
+			- x6 * *Mki6++ - x7 * *Mki7++;
+ 
+      M0 += 8 * ldm + 8;
+    }
+
+    while ( firstcol < ncol - 3 ) { /* Do 4 columns */
+      Mki0 = M0 + 1;
+      Mki1 = Mki0 + ldm + 1;
+      Mki2 = Mki1 + ldm + 1;
+      Mki3 = Mki2 + ldm + 1;
+
+      x0 = rhs[firstcol];
+      x1 = rhs[firstcol+1] - x0 * *Mki0++;
+      x2 = rhs[firstcol+2] - x0 * *Mki0++ - x1 * *Mki1++;
+      x3 = rhs[firstcol+3] - x0 * *Mki0++ - x1 * *Mki1++ - x2 * *Mki2++;
+
+      rhs[++firstcol] = x1;
+      rhs[++firstcol] = x2;
+      rhs[++firstcol] = x3;
+      ++firstcol;
+    
+      for (k = firstcol; k < ncol; k++)
+	rhs[k] = rhs[k] - x0 * *Mki0++ - x1 * *Mki1++
+	                - x2 * *Mki2++ - x3 * *Mki3++;
+ 
+      M0 += 4 * ldm + 4;
+    }
+
+    if ( firstcol < ncol - 1 ) { /* Do 2 columns */
+      Mki0 = M0 + 1;
+      Mki1 = Mki0 + ldm + 1;
+
+      x0 = rhs[firstcol];
+      x1 = rhs[firstcol+1] - x0 * *Mki0++;
+
+      rhs[++firstcol] = x1;
+      ++firstcol;
+    
+      for (k = firstcol; k < ncol; k++)
+	rhs[k] = rhs[k] - x0 * *Mki0++ - x1 * *Mki1++;
+ 
+    }
+    
+}
+
+/*
+ * Solves a dense upper triangular system. The upper triangular matrix is
+ * stored in a 2-dim array M(1:ldm,1:ncol). The solution will be returned
+ * in the rhs vector.
+ */
+void
+dusolve ( ldm, ncol, M, rhs )
+int ldm;	/* in */
+int ncol;	/* in */
+double *M;	/* in */
+double *rhs;	/* modified */
+{
+    double xj;
+    int jcol, j, irow;
+
+    jcol = ncol - 1;
+
+    for (j = 0; j < ncol; j++) {
+
+	xj = rhs[jcol] / M[jcol + jcol*ldm]; 		/* M(jcol, jcol) */
+	rhs[jcol] = xj;
+	
+	for (irow = 0; irow < jcol; irow++)
+	    rhs[irow] -= xj * M[irow + jcol*ldm];	/* M(irow, jcol) */
+
+	jcol--;
+
+    }
+}
+
+
+/*
+ * Performs a dense matrix-vector multiply: Mxvec = Mxvec + M * vec.
+ * The input matrix is M(1:nrow,1:ncol); The product is returned in Mxvec[].
+ */
+void dmatvec ( ldm, nrow, ncol, M, vec, Mxvec )
+
+int ldm;	/* in -- leading dimension of M */
+int nrow;	/* in */ 
+int ncol;	/* in */
+double *M;	/* in */
+double *vec;	/* in */
+double *Mxvec;	/* in/out */
+
+{
+    double vi0, vi1, vi2, vi3, vi4, vi5, vi6, vi7;
+    double *M0;
+    register double *Mki0, *Mki1, *Mki2, *Mki3, *Mki4, *Mki5, *Mki6, *Mki7;
+    register int firstcol = 0;
+    int k;
+
+    M0 = &M[0];
+    while ( firstcol < ncol - 7 ) {	/* Do 8 columns */
+
+	Mki0 = M0;
+	Mki1 = Mki0 + ldm;
+        Mki2 = Mki1 + ldm;
+        Mki3 = Mki2 + ldm;
+	Mki4 = Mki3 + ldm;
+	Mki5 = Mki4 + ldm;
+	Mki6 = Mki5 + ldm;
+	Mki7 = Mki6 + ldm;
+
+	vi0 = vec[firstcol++];
+	vi1 = vec[firstcol++];
+	vi2 = vec[firstcol++];
+	vi3 = vec[firstcol++];	
+	vi4 = vec[firstcol++];
+	vi5 = vec[firstcol++];
+	vi6 = vec[firstcol++];
+	vi7 = vec[firstcol++];	
+
+	for (k = 0; k < nrow; k++) 
+	    Mxvec[k] += vi0 * *Mki0++ + vi1 * *Mki1++
+		      + vi2 * *Mki2++ + vi3 * *Mki3++ 
+		      + vi4 * *Mki4++ + vi5 * *Mki5++
+		      + vi6 * *Mki6++ + vi7 * *Mki7++;
+
+	M0 += 8 * ldm;
+    }
+
+    while ( firstcol < ncol - 3 ) {	/* Do 4 columns */
+
+	Mki0 = M0;
+	Mki1 = Mki0 + ldm;
+	Mki2 = Mki1 + ldm;
+	Mki3 = Mki2 + ldm;
+
+	vi0 = vec[firstcol++];
+	vi1 = vec[firstcol++];
+	vi2 = vec[firstcol++];
+	vi3 = vec[firstcol++];	
+	for (k = 0; k < nrow; k++) 
+	    Mxvec[k] += vi0 * *Mki0++ + vi1 * *Mki1++
+		      + vi2 * *Mki2++ + vi3 * *Mki3++ ;
+
+	M0 += 4 * ldm;
+    }
+
+    while ( firstcol < ncol ) {		/* Do 1 column */
+
+ 	Mki0 = M0;
+	vi0 = vec[firstcol++];
+	for (k = 0; k < nrow; k++)
+	    Mxvec[k] += vi0 * *Mki0++;
+
+	M0 += ldm;
+    }
+	
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/CBLAS/zmyblas2.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,183 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:		zmyblas2.c
+ * Purpose:
+ *     Level 2 BLAS operations: solves and matvec, written in C.
+ * Note:
+ *     This is only used when the system lacks an efficient BLAS library.
+ */
+#include "dcomplex.h"
+
+/*
+ * Solves a dense UNIT lower triangular system. The unit lower 
+ * triangular matrix is stored in a 2D array M(1:nrow,1:ncol). 
+ * The solution will be returned in the rhs vector.
+ */
+void zlsolve ( int ldm, int ncol, doublecomplex *M, doublecomplex *rhs )
+{
+    int k;
+    doublecomplex x0, x1, x2, x3, temp;
+    doublecomplex *M0;
+    doublecomplex *Mki0, *Mki1, *Mki2, *Mki3;
+    register int firstcol = 0;
+
+    M0 = &M[0];
+
+
+    while ( firstcol < ncol - 3 ) { /* Do 4 columns */
+      	Mki0 = M0 + 1;
+      	Mki1 = Mki0 + ldm + 1;
+      	Mki2 = Mki1 + ldm + 1;
+      	Mki3 = Mki2 + ldm + 1;
+
+      	x0 = rhs[firstcol];
+      	zz_mult(&temp, &x0, Mki0); Mki0++;
+      	z_sub(&x1, &rhs[firstcol+1], &temp);
+      	zz_mult(&temp, &x0, Mki0); Mki0++;
+	z_sub(&x2, &rhs[firstcol+2], &temp);
+	zz_mult(&temp, &x1, Mki1); Mki1++;
+	z_sub(&x2, &x2, &temp);
+      	zz_mult(&temp, &x0, Mki0); Mki0++;
+	z_sub(&x3, &rhs[firstcol+3], &temp);
+	zz_mult(&temp, &x1, Mki1); Mki1++;
+	z_sub(&x3, &x3, &temp);
+	zz_mult(&temp, &x2, Mki2); Mki2++;
+	z_sub(&x3, &x3, &temp);
+
+ 	rhs[++firstcol] = x1;
+      	rhs[++firstcol] = x2;
+      	rhs[++firstcol] = x3;
+      	++firstcol;
+    
+      	for (k = firstcol; k < ncol; k++) {
+	    zz_mult(&temp, &x0, Mki0); Mki0++;
+	    z_sub(&rhs[k], &rhs[k], &temp);
+	    zz_mult(&temp, &x1, Mki1); Mki1++;
+	    z_sub(&rhs[k], &rhs[k], &temp);
+	    zz_mult(&temp, &x2, Mki2); Mki2++;
+	    z_sub(&rhs[k], &rhs[k], &temp);
+	    zz_mult(&temp, &x3, Mki3); Mki3++;
+	    z_sub(&rhs[k], &rhs[k], &temp);
+	}
+
+        M0 += 4 * ldm + 4;
+    }
+
+    if ( firstcol < ncol - 1 ) { /* Do 2 columns */
+        Mki0 = M0 + 1;
+        Mki1 = Mki0 + ldm + 1;
+
+        x0 = rhs[firstcol];
+	zz_mult(&temp, &x0, Mki0); Mki0++;
+	z_sub(&x1, &rhs[firstcol+1], &temp);
+
+      	rhs[++firstcol] = x1;
+      	++firstcol;
+    
+      	for (k = firstcol; k < ncol; k++) {
+	    zz_mult(&temp, &x0, Mki0); Mki0++;
+	    z_sub(&rhs[k], &rhs[k], &temp);
+	    zz_mult(&temp, &x1, Mki1); Mki1++;
+	    z_sub(&rhs[k], &rhs[k], &temp);
+	} 
+    }
+    
+}
+
+/*
+ * Solves a dense upper triangular system. The upper triangular matrix is
+ * stored in a 2-dim array M(1:ldm,1:ncol). The solution will be returned
+ * in the rhs vector.
+ */
+void
+zusolve ( ldm, ncol, M, rhs )
+int ldm;	/* in */
+int ncol;	/* in */
+doublecomplex *M;	/* in */
+doublecomplex *rhs;	/* modified */
+{
+    doublecomplex xj, temp;
+    int jcol, j, irow;
+
+    jcol = ncol - 1;
+
+    for (j = 0; j < ncol; j++) {
+
+	z_div(&xj, &rhs[jcol], &M[jcol + jcol*ldm]); /* M(jcol, jcol) */
+	rhs[jcol] = xj;
+	
+	for (irow = 0; irow < jcol; irow++) {
+	    zz_mult(&temp, &xj, &M[irow+jcol*ldm]); /* M(irow, jcol) */
+	    z_sub(&rhs[irow], &rhs[irow], &temp);
+	}
+
+	jcol--;
+
+    }
+}
+
+
+/*
+ * Performs a dense matrix-vector multiply: Mxvec = Mxvec + M * vec.
+ * The input matrix is M(1:nrow,1:ncol); The product is returned in Mxvec[].
+ */
+void zmatvec ( ldm, nrow, ncol, M, vec, Mxvec )
+int ldm;	/* in -- leading dimension of M */
+int nrow;	/* in */ 
+int ncol;	/* in */
+doublecomplex *M;	/* in */
+doublecomplex *vec;	/* in */
+doublecomplex *Mxvec;	/* in/out */
+{
+    doublecomplex vi0, vi1, vi2, vi3;
+    doublecomplex *M0, temp;
+    doublecomplex *Mki0, *Mki1, *Mki2, *Mki3;
+    register int firstcol = 0;
+    int k;
+
+    M0 = &M[0];
+
+    while ( firstcol < ncol - 3 ) {	/* Do 4 columns */
+	Mki0 = M0;
+	Mki1 = Mki0 + ldm;
+	Mki2 = Mki1 + ldm;
+	Mki3 = Mki2 + ldm;
+
+	vi0 = vec[firstcol++];
+	vi1 = vec[firstcol++];
+	vi2 = vec[firstcol++];
+	vi3 = vec[firstcol++];	
+	for (k = 0; k < nrow; k++) {
+	    zz_mult(&temp, &vi0, Mki0); Mki0++;
+	    z_add(&Mxvec[k], &Mxvec[k], &temp);
+	    zz_mult(&temp, &vi1, Mki1); Mki1++;
+	    z_add(&Mxvec[k], &Mxvec[k], &temp);
+	    zz_mult(&temp, &vi2, Mki2); Mki2++;
+	    z_add(&Mxvec[k], &Mxvec[k], &temp);
+	    zz_mult(&temp, &vi3, Mki3); Mki3++;
+	    z_add(&Mxvec[k], &Mxvec[k], &temp);
+	}
+
+	M0 += 4 * ldm;
+    }
+
+    while ( firstcol < ncol ) {		/* Do 1 column */
+ 	Mki0 = M0;
+	vi0 = vec[firstcol++];
+	for (k = 0; k < nrow; k++) {
+	    zz_mult(&temp, &vi0, Mki0); Mki0++;
+	    z_add(&Mxvec[k], &Mxvec[k], &temp);
+	}
+	M0 += ldm;
+    }
+	
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/Cnames.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,197 @@
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 1, 1997
+ *
+ */
+#ifndef __SUPERLU_CNAMES /* allow multiple inclusions */
+#define __SUPERLU_CNAMES
+
+/*
+ * These macros define how C routines will be called.  ADD_ assumes that
+ * they will be called by fortran, which expects C routines to have an
+ * underscore postfixed to the name (Suns, and the Intel expect this).
+ * NOCHANGE indicates that fortran will be calling, and that it expects
+ * the name called by fortran to be identical to that compiled by the C
+ * (RS6K's do this).  UPCASE says it expects C routines called by fortran
+ * to be in all upcase (CRAY wants this). 
+ */
+
+#define ADD_       0
+#define NOCHANGE   1
+#define UPCASE     2
+#define C_CALL     3
+
+#ifdef UpCase
+#define F77_CALL_C UPCASE
+#endif
+
+#ifdef NoChange
+#define F77_CALL_C NOCHANGE
+#endif
+
+#ifdef Add_
+#define F77_CALL_C ADD_
+#endif
+
+#ifndef F77_CALL_C
+#define F77_CALL_C ADD_
+#endif
+
+#if (F77_CALL_C == ADD_)
+/*
+ * These defines set up the naming scheme required to have a fortran 77
+ * routine call a C routine
+ * No redefinition necessary to have following Fortran to C interface:
+ *           FORTRAN CALL               C DECLARATION
+ *           call dgemm(...)           void dgemm_(...)
+ *
+ * This is the default.
+ */
+
+#endif
+
+#if (F77_CALL_C == UPCASE)
+/*
+ * These defines set up the naming scheme required to have a fortran 77
+ * routine call a C routine 
+ * following Fortran to C interface:
+ *           FORTRAN CALL               C DECLARATION
+ *           call dgemm(...)           void DGEMM(...)
+ */
+#define sasum_    SASUM
+#define isamax_   ISAMAX
+#define scopy_    SCOPY
+#define sscal_    SSCAL
+#define sger_     SGER
+#define snrm2_    SNRM2
+#define ssymv_    SSYMV
+#define sdot_     SDOT
+#define saxpy_    SAXPY
+#define ssyr2_    SSYR2
+#define srot_     SROT
+#define sgemv_    SGEMV
+#define strsv_    STRSV
+#define sgemm_    SGEMM
+#define strsm_    STRSM
+
+#define dasum_    SASUM
+#define idamax_   ISAMAX
+#define dcopy_    SCOPY
+#define dscal_    SSCAL
+#define dger_     SGER
+#define dnrm2_    SNRM2
+#define dsymv_    SSYMV
+#define ddot_     SDOT
+#define daxpy_    SAXPY
+#define dsyr2_    SSYR2
+#define drot_     SROT
+#define dgemv_    SGEMV
+#define dtrsv_    STRSV
+#define dgemm_    SGEMM
+#define dtrsm_    STRSM
+
+#define scasum_   SCASUM
+#define icamax_   ICAMAX
+#define ccopy_    CCOPY
+#define cscal_    CSCAL
+#define scnrm2_   SCNRM2
+#define caxpy_    CAXPY
+#define cgemv_    CGEMV
+#define ctrsv_    CTRSV
+#define cgemm_    CGEMM
+#define ctrsm_    CTRSM
+#define cgerc_    CGERC
+#define chemv_    CHEMV
+#define cher2_    CHER2
+
+#define dzasum_   SCASUM
+#define izamax_   ICAMAX
+#define zcopy_    CCOPY
+#define zscal_    CSCAL
+#define dznrm2_   SCNRM2
+#define zaxpy_    CAXPY
+#define zgemv_    CGEMV
+#define ztrsv_    CTRSV
+#define zgemm_    CGEMM
+#define ztrsm_    CTRSM
+#define zgerc_    CGERC
+#define zhemv_    CHEMV
+#define zher2_    CHER2
+
+#define c_bridge_dgssv_ C_BRIDGE_DGSSV
+#endif
+
+#if (F77_CALL_C == NOCHANGE)
+/*
+ * These defines set up the naming scheme required to have a fortran 77
+ * routine call a C routine 
+ * for following Fortran to C interface:
+ *           FORTRAN CALL               C DECLARATION
+ *           call dgemm(...)           void dgemm(...)
+ */
+#define sasum_    sasum
+#define isamax_   isamax
+#define scopy_    scopy
+#define sscal_    sscal
+#define sger_     sger
+#define snrm2_    snrm2
+#define ssymv_    ssymv
+#define sdot_     sdot
+#define saxpy_    saxpy
+#define ssyr2_    ssyr2
+#define srot_     srot
+#define sgemv_    sgemv
+#define strsv_    strsv
+#define sgemm_    sgemm
+#define strsm_    strsm
+
+#define dasum_    dasum
+#define idamax_   idamax
+#define dcopy_    dcopy
+#define dscal_    dscal
+#define dger_     dger
+#define dnrm2_    dnrm2
+#define dsymv_    dsymv
+#define ddot_     ddot
+#define daxpy_    daxpy
+#define dsyr2_    dsyr2
+#define drot_     drot
+#define dgemv_    dgemv
+#define dtrsv_    dtrsv
+#define dgemm_    dgemm
+#define dtrsm_    dtrsm
+
+#define scasum_   scasum
+#define icamax_   icamax
+#define ccopy_    ccopy
+#define cscal_    cscal
+#define scnrm2_   scnrm2
+#define caxpy_    caxpy
+#define cgemv_    cgemv
+#define ctrsv_    ctrsv
+#define cgemm_    cgemm
+#define ctrsm_    ctrsm
+#define cgerc_    cgerc
+#define chemv_    chemv
+#define cher2_    cher2
+
+#define dzasum_   dzasum
+#define izamax_   izamax
+#define zcopy_    zcopy
+#define zscal_    zscal
+#define dznrm2_   dznrm2
+#define zaxpy_    zaxpy
+#define zgemv_    zgemv
+#define ztrsv_    ztrsv
+#define zgemm_    zgemm
+#define ztrsm_    ztrsm
+#define zgerc_    zgerc
+#define zhemv_    zhemv
+#define zher2_    zher2
+
+#define c_bridge_dgssv_ c_bridge_dgssv
+#endif
+
+#endif /* __SUPERLU_CNAMES */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/colamd.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,2583 @@
+/* ========================================================================== */
+/* === colamd - a sparse matrix column ordering algorithm =================== */
+/* ========================================================================== */
+
+/*
+    colamd:  An approximate minimum degree column ordering algorithm.
+
+    Purpose:
+
+	Colamd computes a permutation Q such that the Cholesky factorization of
+	(AQ)'(AQ) has less fill-in and requires fewer floating point operations
+	than A'A.  This also provides a good ordering for sparse partial
+	pivoting methods, P(AQ) = LU, where Q is computed prior to numerical
+	factorization, and P is computed during numerical factorization via
+	conventional partial pivoting with row interchanges.  Colamd is the
+	column ordering method used in SuperLU, part of the ScaLAPACK library.
+	It is also available as user-contributed software for Matlab 5.2,
+	available from MathWorks, Inc. (http://www.mathworks.com).  This
+	routine can be used in place of COLMMD in Matlab.  By default, the \
+	and / operators in Matlab perform a column ordering (using COLMMD)
+	prior to LU factorization using sparse partial pivoting, in the
+	built-in Matlab LU(A) routine.
+
+    Authors:
+
+	The authors of the code itself are Stefan I. Larimore and Timothy A.
+	Davis (davis@cise.ufl.edu), University of Florida.  The algorithm was
+	developed in collaboration with John Gilbert, Xerox PARC, and Esmond
+	Ng, Oak Ridge National Laboratory.
+
+    Date:
+
+	August 3, 1998.  Version 1.0.
+
+    Acknowledgements:
+
+	This work was supported by the National Science Foundation, under
+	grants DMS-9504974 and DMS-9803599.
+
+    Notice:
+
+	Copyright (c) 1998 by the University of Florida.  All Rights Reserved.
+
+	THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+	EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+
+	Permission is hereby granted to use or copy this program for any
+	purpose, provided the above notices are retained on all copies.
+	User documentation of any code that uses this code must cite the
+	Authors, the Copyright, and "Used by permission."  If this code is
+	accessible from within Matlab, then typing "help colamd" or "colamd"
+	(with no arguments) must cite the Authors.  Permission to modify the
+	code and to distribute modified code is granted, provided the above
+	notices are retained, and a notice that the code was modified is
+	included with the above copyright notice.  You must also retain the
+	Availability information below, of the original version.
+
+	This software is provided free of charge.
+
+    Availability:
+
+	This file is located at
+
+		http://www.cise.ufl.edu/~davis/colamd/colamd.c
+
+	The colamd.h file is required, located in the same directory.
+	The colamdmex.c file provides a Matlab interface for colamd.
+	The symamdmex.c file provides a Matlab interface for symamd, which is
+	a symmetric ordering based on this code, colamd.c.  All codes are
+	purely ANSI C compliant (they use no Unix-specific routines, include
+	files, etc.).
+*/
+
+/* ========================================================================== */
+/* === Description of user-callable routines ================================ */
+/* ========================================================================== */
+
+/*
+    Each user-callable routine (declared as PUBLIC) is briefly described below.
+    Refer to the comments preceding each routine for more details.
+
+    ----------------------------------------------------------------------------
+    colamd_recommended:
+    ----------------------------------------------------------------------------
+
+	Usage:
+
+	    Alen = colamd_recommended (nnz, n_row, n_col) ;
+
+	Purpose:
+
+	    Returns recommended value of Alen for use by colamd.  Returns -1
+	    if any input argument is negative.
+
+	Arguments:
+
+	    int nnz ;		Number of nonzeros in the matrix A.  This must
+				be the same value as p [n_col] in the call to
+				colamd - otherwise you will get a wrong value
+				of the recommended memory to use.
+	    int n_row ;		Number of rows in the matrix A.
+	    int n_col ;		Number of columns in the matrix A.
+
+    ----------------------------------------------------------------------------
+    colamd_set_defaults:
+    ----------------------------------------------------------------------------
+
+	Usage:
+
+	    colamd_set_defaults (knobs) ;
+
+	Purpose:
+
+	    Sets the default parameters.
+
+	Arguments:
+
+	    double knobs [COLAMD_KNOBS] ;	Output only.
+
+		Rows with more than (knobs [COLAMD_DENSE_ROW] * n_col) entries
+		are removed prior to ordering.  Columns with more than
+		(knobs [COLAMD_DENSE_COL] * n_row) entries are removed
+		prior to ordering, and placed last in the output column
+		ordering.  Default values of these two knobs are both 0.5.
+		Currently, only knobs [0] and knobs [1] are used, but future
+		versions may use more knobs.  If so, they will be properly set
+		to their defaults by the future version of colamd_set_defaults,
+		so that the code that calls colamd will not need to change,
+		assuming that you either use colamd_set_defaults, or pass a
+		(double *) NULL pointer as the knobs array to colamd.
+
+    ----------------------------------------------------------------------------
+    colamd:
+    ----------------------------------------------------------------------------
+
+	Usage:
+
+	    colamd (n_row, n_col, Alen, A, p, knobs) ;
+
+	Purpose:
+
+	    Computes a column ordering (Q) of A such that P(AQ)=LU or
+	    (AQ)'AQ=LL' have less fill-in and require fewer floating point
+	    operations than factorizing the unpermuted matrix A or A'A,
+	    respectively.
+
+	Arguments:
+
+	    int n_row ;
+
+		Number of rows in the matrix A.
+		Restriction:  n_row >= 0.
+		Colamd returns FALSE if n_row is negative.
+
+	    int n_col ;
+
+		Number of columns in the matrix A.
+		Restriction:  n_col >= 0.
+		Colamd returns FALSE if n_col is negative.
+
+	    int Alen ;
+
+		Restriction (see note):
+		Alen >= 2*nnz + 6*(n_col+1) + 4*(n_row+1) + n_col + COLAMD_STATS
+		Colamd returns FALSE if these conditions are not met.
+
+		Note:  this restriction makes an modest assumption regarding
+		the size of the two typedef'd structures, below.  We do,
+		however, guarantee that
+		Alen >= colamd_recommended (nnz, n_row, n_col)
+		will be sufficient.
+
+	    int A [Alen] ;	Input argument, stats on output.
+
+		A is an integer array of size Alen.  Alen must be at least as
+		large as the bare minimum value given above, but this is very
+		low, and can result in excessive run time.  For best
+		performance, we recommend that Alen be greater than or equal to
+		colamd_recommended (nnz, n_row, n_col), which adds
+		nnz/5 to the bare minimum value given above.
+
+		On input, the row indices of the entries in column c of the
+		matrix are held in A [(p [c]) ... (p [c+1]-1)].  The row indices
+		in a given column c need not be in ascending order, and
+		duplicate row indices may be be present.  However, colamd will
+		work a little faster if both of these conditions are met
+		(Colamd puts the matrix into this format, if it finds that the
+		the conditions are not met).
+
+		The matrix is 0-based.  That is, rows are in the range 0 to
+		n_row-1, and columns are in the range 0 to n_col-1.  Colamd
+		returns FALSE if any row index is out of range.
+
+		The contents of A are modified during ordering, and are thus
+		undefined on output with the exception of a few statistics
+		about the ordering (A [0..COLAMD_STATS-1]):
+		A [0]:  number of dense or empty rows ignored.
+		A [1]:  number of dense or empty columns ignored (and ordered
+			last in the output permutation p)
+		A [2]:  number of garbage collections performed.
+		A [3]:  0, if all row indices in each column were in sorted
+			  order, and no duplicates were present.
+			1, otherwise (in which case colamd had to do more work)
+		Note that a row can become "empty" if it contains only
+		"dense" and/or "empty" columns, and similarly a column can
+		become "empty" if it only contains "dense" and/or "empty" rows.
+		Future versions may return more statistics in A, but the usage
+		of these 4 entries in A will remain unchanged.
+
+	    int p [n_col+1] ;	Both input and output argument.
+
+		p is an integer array of size n_col+1.  On input, it holds the
+		"pointers" for the column form of the matrix A.  Column c of
+		the matrix A is held in A [(p [c]) ... (p [c+1]-1)].  The first
+		entry, p [0], must be zero, and p [c] <= p [c+1] must hold
+		for all c in the range 0 to n_col-1.  The value p [n_col] is
+		thus the total number of entries in the pattern of the matrix A.
+		Colamd returns FALSE if these conditions are not met.
+
+		On output, if colamd returns TRUE, the array p holds the column
+		permutation (Q, for P(AQ)=LU or (AQ)'(AQ)=LL'), where p [0] is
+		the first column index in the new ordering, and p [n_col-1] is
+		the last.  That is, p [k] = j means that column j of A is the
+		kth pivot column, in AQ, where k is in the range 0 to n_col-1
+		(p [0] = j means that column j of A is the first column in AQ).
+
+		If colamd returns FALSE, then no permutation is returned, and
+		p is undefined on output.
+
+	    double knobs [COLAMD_KNOBS] ;	Input only.
+
+		See colamd_set_defaults for a description.  If the knobs array
+		is not present (that is, if a (double *) NULL pointer is passed
+		in its place), then the default values of the parameters are
+		used instead.
+
+*/
+
+
+/* ========================================================================== */
+/* === Include files ======================================================== */
+/* ========================================================================== */
+
+/* limits.h:  the largest positive integer (INT_MAX) */
+#include <limits.h>
+
+/* colamd.h:  knob array size, stats output size, and global prototypes */
+#include "colamd.h"
+
+/* ========================================================================== */
+/* === Scaffolding code definitions  ======================================== */
+/* ========================================================================== */
+
+/* Ensure that debugging is turned off: */
+#ifndef NDEBUG
+#define NDEBUG
+#endif
+
+/* assert.h:  the assert macro (no debugging if NDEBUG is defined) */
+#include <assert.h>
+
+/*
+   Our "scaffolding code" philosophy:  In our opinion, well-written library
+   code should keep its "debugging" code, and just normally have it turned off
+   by the compiler so as not to interfere with performance.  This serves
+   several purposes:
+
+   (1) assertions act as comments to the reader, telling you what the code
+	expects at that point.  All assertions will always be true (unless
+	there really is a bug, of course).
+
+   (2) leaving in the scaffolding code assists anyone who would like to modify
+	the code, or understand the algorithm (by reading the debugging output,
+	one can get a glimpse into what the code is doing).
+
+   (3) (gasp!) for actually finding bugs.  This code has been heavily tested
+	and "should" be fully functional and bug-free ... but you never know...
+
+    To enable debugging, comment out the "#define NDEBUG" above.  The code will
+    become outrageously slow when debugging is enabled.  To control the level of
+    debugging output, set an environment variable D to 0 (little), 1 (some),
+    2, 3, or 4 (lots).
+*/
+
+/* ========================================================================== */
+/* === Row and Column structures ============================================ */
+/* ========================================================================== */
+
+typedef struct ColInfo_struct
+{
+    int start ;		/* index for A of first row in this column, or DEAD */
+			/* if column is dead */
+    int length ;	/* number of rows in this column */
+    union
+    {
+	int thickness ;	/* number of original columns represented by this */
+			/* col, if the column is alive */
+	int parent ;	/* parent in parent tree super-column structure, if */
+			/* the column is dead */
+    } shared1 ;
+    union
+    {
+	int score ;	/* the score used to maintain heap, if col is alive */
+	int order ;	/* pivot ordering of this column, if col is dead */
+    } shared2 ;
+    union
+    {
+	int headhash ;	/* head of a hash bucket, if col is at the head of */
+			/* a degree list */
+	int hash ;	/* hash value, if col is not in a degree list */
+	int prev ;	/* previous column in degree list, if col is in a */
+			/* degree list (but not at the head of a degree list) */
+    } shared3 ;
+    union
+    {
+	int degree_next ;	/* next column, if col is in a degree list */
+	int hash_next ;		/* next column, if col is in a hash list */
+    } shared4 ;
+
+} ColInfo ;
+
+typedef struct RowInfo_struct
+{
+    int start ;		/* index for A of first col in this row */
+    int length ;	/* number of principal columns in this row */
+    union
+    {
+	int degree ;	/* number of principal & non-principal columns in row */
+	int p ;		/* used as a row pointer in init_rows_cols () */
+    } shared1 ;
+    union
+    {
+	int mark ;	/* for computing set differences and marking dead rows*/
+	int first_column ;/* first column in row (used in garbage collection) */
+    } shared2 ;
+
+} RowInfo ;
+
+/* ========================================================================== */
+/* === Definitions ========================================================== */
+/* ========================================================================== */
+
+#define MAX(a,b) (((a) > (b)) ? (a) : (b))
+#define MIN(a,b) (((a) < (b)) ? (a) : (b))
+
+#define ONES_COMPLEMENT(r) (-(r)-1)
+
+#define TRUE	(1)
+#define FALSE	(0)
+#define EMPTY	(-1)
+
+/* Row and column status */
+#define ALIVE	(0)
+#define DEAD	(-1)
+
+/* Column status */
+#define DEAD_PRINCIPAL		(-1)
+#define DEAD_NON_PRINCIPAL	(-2)
+
+/* Macros for row and column status update and checking. */
+#define ROW_IS_DEAD(r)			ROW_IS_MARKED_DEAD (Row[r].shared2.mark)
+#define ROW_IS_MARKED_DEAD(row_mark)	(row_mark < ALIVE)
+#define ROW_IS_ALIVE(r)			(Row [r].shared2.mark >= ALIVE)
+#define COL_IS_DEAD(c)			(Col [c].start < ALIVE)
+#define COL_IS_ALIVE(c)			(Col [c].start >= ALIVE)
+#define COL_IS_DEAD_PRINCIPAL(c)	(Col [c].start == DEAD_PRINCIPAL)
+#define KILL_ROW(r)			{ Row [r].shared2.mark = DEAD ; }
+#define KILL_PRINCIPAL_COL(c)		{ Col [c].start = DEAD_PRINCIPAL ; }
+#define KILL_NON_PRINCIPAL_COL(c)	{ Col [c].start = DEAD_NON_PRINCIPAL ; }
+
+/* Routines are either PUBLIC (user-callable) or PRIVATE (not user-callable) */
+#define PUBLIC
+#define PRIVATE static
+
+/* ========================================================================== */
+/* === Prototypes of PRIVATE routines ======================================= */
+/* ========================================================================== */
+
+PRIVATE int init_rows_cols
+(
+    int n_row,
+    int n_col,
+    RowInfo Row [],
+    ColInfo Col [],
+    int A [],
+    int p []
+) ;
+
+PRIVATE void init_scoring
+(
+    int n_row,
+    int n_col,
+    RowInfo Row [],
+    ColInfo Col [],
+    int A [],
+    int head [],
+    double knobs [COLAMD_KNOBS],
+    int *p_n_row2,
+    int *p_n_col2,
+    int *p_max_deg
+) ;
+
+PRIVATE int find_ordering
+(
+    int n_row,
+    int n_col,
+    int Alen,
+    RowInfo Row [],
+    ColInfo Col [],
+    int A [],
+    int head [],
+    int n_col2,
+    int max_deg,
+    int pfree
+) ;
+
+PRIVATE void order_children
+(
+    int n_col,
+    ColInfo Col [],
+    int p []
+) ;
+
+PRIVATE void detect_super_cols
+(
+#ifndef NDEBUG
+    int n_col,
+    RowInfo Row [],
+#endif
+    ColInfo Col [],
+    int A [],
+    int head [],
+    int row_start,
+    int row_length
+) ;
+
+PRIVATE int garbage_collection
+(
+    int n_row,
+    int n_col,
+    RowInfo Row [],
+    ColInfo Col [],
+    int A [],
+    int *pfree
+) ;
+
+PRIVATE int clear_mark
+(
+    int n_row,
+    RowInfo Row []
+) ;
+
+/* ========================================================================== */
+/* === Debugging definitions ================================================ */
+/* ========================================================================== */
+
+#ifndef NDEBUG
+
+/* === With debugging ======================================================= */
+
+/* stdlib.h: for getenv and atoi, to get debugging level from environment */
+#include <stdlib.h>
+
+/* stdio.h:  for printf (no printing if debugging is turned off) */
+#include <stdio.h>
+
+PRIVATE void debug_deg_lists
+(
+    int n_row,
+    int n_col,
+    RowInfo Row [],
+    ColInfo Col [],
+    int head [],
+    int min_score,
+    int should,
+    int max_deg
+) ;
+
+PRIVATE void debug_mark
+(
+    int n_row,
+    RowInfo Row [],
+    int tag_mark,
+    int max_mark
+) ;
+
+PRIVATE void debug_matrix
+(
+    int n_row,
+    int n_col,
+    RowInfo Row [],
+    ColInfo Col [],
+    int A []
+) ;
+
+PRIVATE void debug_structures
+(
+    int n_row,
+    int n_col,
+    RowInfo Row [],
+    ColInfo Col [],
+    int A [],
+    int n_col2
+) ;
+
+/* the following is the *ONLY* global variable in this file, and is only */
+/* present when debugging */
+
+PRIVATE int debug_colamd ;	/* debug print level */
+
+#define DEBUG0(params) { (void) printf params ; }
+#define DEBUG1(params) { if (debug_colamd >= 1) (void) printf params ; }
+#define DEBUG2(params) { if (debug_colamd >= 2) (void) printf params ; }
+#define DEBUG3(params) { if (debug_colamd >= 3) (void) printf params ; }
+#define DEBUG4(params) { if (debug_colamd >= 4) (void) printf params ; }
+
+#else
+
+/* === No debugging ========================================================= */
+
+#define DEBUG0(params) ;
+#define DEBUG1(params) ;
+#define DEBUG2(params) ;
+#define DEBUG3(params) ;
+#define DEBUG4(params) ;
+
+#endif
+
+/* ========================================================================== */
+
+
+/* ========================================================================== */
+/* === USER-CALLABLE ROUTINES: ============================================== */
+/* ========================================================================== */
+
+
+/* ========================================================================== */
+/* === colamd_recommended =================================================== */
+/* ========================================================================== */
+
+/*
+    The colamd_recommended routine returns the suggested size for Alen.  This
+    value has been determined to provide good balance between the number of
+    garbage collections and the memory requirements for colamd.
+*/
+
+PUBLIC int colamd_recommended	/* returns recommended value of Alen. */
+(
+    /* === Parameters ======================================================= */
+
+    int nnz,			/* number of nonzeros in A */
+    int n_row,			/* number of rows in A */
+    int n_col			/* number of columns in A */
+)
+{
+    /* === Local variables ================================================== */
+
+    int minimum ;		/* bare minimum requirements */
+    int recommended ;		/* recommended value of Alen */
+
+    if (nnz < 0 || n_row < 0 || n_col < 0)
+    {
+	/* return -1 if any input argument is corrupted */
+	DEBUG0 (("colamd_recommended error!")) ;
+	DEBUG0 ((" nnz: %d, n_row: %d, n_col: %d\n", nnz, n_row, n_col)) ;
+	return (-1) ;
+    }
+
+    minimum =
+	2 * (nnz)		/* for A */
+	+ (((n_col) + 1) * sizeof (ColInfo) / sizeof (int))	/* for Col */
+	+ (((n_row) + 1) * sizeof (RowInfo) / sizeof (int))	/* for Row */
+	+ n_col			/* minimum elbow room to guarrantee success */
+	+ COLAMD_STATS ;	/* for output statistics */
+
+    /* recommended is equal to the minumum plus enough memory to keep the */
+    /* number garbage collections low */
+    recommended = minimum + nnz/5 ;
+
+    return (recommended) ;
+}
+
+
+/* ========================================================================== */
+/* === colamd_set_defaults ================================================== */
+/* ========================================================================== */
+
+/*
+    The colamd_set_defaults routine sets the default values of the user-
+    controllable parameters for colamd:
+
+	knobs [0]	rows with knobs[0]*n_col entries or more are removed
+			prior to ordering.
+
+	knobs [1]	columns with knobs[1]*n_row entries or more are removed
+			prior to ordering, and placed last in the column
+			permutation.
+
+	knobs [2..19]	unused, but future versions might use this
+*/
+
+PUBLIC void colamd_set_defaults
+(
+    /* === Parameters ======================================================= */
+
+    double knobs [COLAMD_KNOBS]		/* knob array */
+)
+{
+    /* === Local variables ================================================== */
+
+    int i ;
+
+    if (!knobs)
+    {
+	return ;			/* no knobs to initialize */
+    }
+    for (i = 0 ; i < COLAMD_KNOBS ; i++)
+    {
+	knobs [i] = 0 ;
+    }
+    knobs [COLAMD_DENSE_ROW] = 0.5 ;	/* ignore rows over 50% dense */
+    knobs [COLAMD_DENSE_COL] = 0.5 ;	/* ignore columns over 50% dense */
+}
+
+
+/* ========================================================================== */
+/* === colamd =============================================================== */
+/* ========================================================================== */
+
+/*
+    The colamd routine computes a column ordering Q of a sparse matrix
+    A such that the LU factorization P(AQ) = LU remains sparse, where P is
+    selected via partial pivoting.   The routine can also be viewed as
+    providing a permutation Q such that the Cholesky factorization
+    (AQ)'(AQ) = LL' remains sparse.
+
+    On input, the nonzero patterns of the columns of A are stored in the
+    array A, in order 0 to n_col-1.  A is held in 0-based form (rows in the
+    range 0 to n_row-1 and columns in the range 0 to n_col-1).  Row indices
+    for column c are located in A [(p [c]) ... (p [c+1]-1)], where p [0] = 0,
+    and thus p [n_col] is the number of entries in A.  The matrix is
+    destroyed on output.  The row indices within each column do not have to
+    be sorted (from small to large row indices), and duplicate row indices
+    may be present.  However, colamd will work a little faster if columns are
+    sorted and no duplicates are present.  Matlab 5.2 always passes the matrix
+    with sorted columns, and no duplicates.
+
+    The integer array A is of size Alen.  Alen must be at least of size
+    (where nnz is the number of entries in A):
+
+	nnz			for the input column form of A
+	+ nnz			for a row form of A that colamd generates
+	+ 6*(n_col+1)		for a ColInfo Col [0..n_col] array
+				(this assumes sizeof (ColInfo) is 6 int's).
+	+ 4*(n_row+1)		for a RowInfo Row [0..n_row] array
+				(this assumes sizeof (RowInfo) is 4 int's).
+	+ elbow_room		must be at least n_col.  We recommend at least
+				nnz/5 in addition to that.  If sufficient,
+				changes in the elbow room affect the ordering
+				time only, not the ordering itself.
+	+ COLAMD_STATS		for the output statistics
+
+    Colamd returns FALSE is memory is insufficient, or TRUE otherwise.
+
+    On input, the caller must specify:
+
+	n_row			the number of rows of A
+	n_col			the number of columns of A
+	Alen			the size of the array A
+	A [0 ... nnz-1]		the row indices, where nnz = p [n_col]
+	A [nnz ... Alen-1]	(need not be initialized by the user)
+	p [0 ... n_col]		the column pointers,  p [0] = 0, and p [n_col]
+				is the number of entries in A.  Column c of A
+				is stored in A [p [c] ... p [c+1]-1].
+	knobs [0 ... 19]	a set of parameters that control the behavior
+				of colamd.  If knobs is a NULL pointer the
+				defaults are used.  The user-callable
+				colamd_set_defaults routine sets the default
+				parameters.  See that routine for a description
+				of the user-controllable parameters.
+
+    If the return value of Colamd is TRUE, then on output:
+
+	p [0 ... n_col-1]	the column permutation. p [0] is the first
+				column index, and p [n_col-1] is the last.
+				That is, p [k] = j means that column j of A
+				is the kth column of AQ.
+
+	A			is undefined on output (the matrix pattern is
+				destroyed), except for the following statistics:
+
+	A [0]			the number of dense (or empty) rows ignored
+	A [1]			the number of dense (or empty) columms.  These
+				are ordered last, in their natural order.
+	A [2]			the number of garbage collections performed.
+				If this is excessive, then you would have
+				gotten your results faster if Alen was larger.
+	A [3]			0, if all row indices in each column were in
+				sorted order and no duplicates were present.
+				1, if there were unsorted or duplicate row
+				indices in the input.  You would have gotten
+				your results faster if A [3] was returned as 0.
+
+    If the return value of Colamd is FALSE, then A and p are undefined on
+    output.
+*/
+
+PUBLIC int colamd		/* returns TRUE if successful */
+(
+    /* === Parameters ======================================================= */
+
+    int n_row,			/* number of rows in A */
+    int n_col,			/* number of columns in A */
+    int Alen,			/* length of A */
+    int A [],			/* row indices of A */
+    int p [],			/* pointers to columns in A */
+    double knobs [COLAMD_KNOBS]	/* parameters (uses defaults if NULL) */
+)
+{
+    /* === Local variables ================================================== */
+
+    int i ;			/* loop index */
+    int nnz ;			/* nonzeros in A */
+    int Row_size ;		/* size of Row [], in integers */
+    int Col_size ;		/* size of Col [], in integers */
+    int elbow_room ;		/* remaining free space */
+    RowInfo *Row ;		/* pointer into A of Row [0..n_row] array */
+    ColInfo *Col ;		/* pointer into A of Col [0..n_col] array */
+    int n_col2 ;		/* number of non-dense, non-empty columns */
+    int n_row2 ;		/* number of non-dense, non-empty rows */
+    int ngarbage ;		/* number of garbage collections performed */
+    int max_deg ;		/* maximum row degree */
+    double default_knobs [COLAMD_KNOBS] ;	/* default knobs knobs array */
+    int init_result ;		/* return code from initialization */
+
+#ifndef NDEBUG
+    debug_colamd = 0 ;		/* no debug printing */
+    /* get "D" environment variable, which gives the debug printing level */
+    if (getenv ("D")) debug_colamd = atoi (getenv ("D")) ;
+    DEBUG0 (("debug version, D = %d (THIS WILL BE SLOOOOW!)\n", debug_colamd)) ;
+#endif
+
+    /* === Check the input arguments ======================================== */
+
+    if (n_row < 0 || n_col < 0 || !A || !p)
+    {
+	/* n_row and n_col must be non-negative, A and p must be present */
+	DEBUG0 (("colamd error! %d %d %d\n", n_row, n_col, Alen)) ;
+	return (FALSE) ;
+    }
+    nnz = p [n_col] ;
+    if (nnz < 0 || p [0] != 0)
+    {
+	/* nnz must be non-negative, and p [0] must be zero */
+	DEBUG0 (("colamd error! %d %d\n", nnz, p [0])) ;
+	return (FALSE) ;
+    }
+
+    /* === If no knobs, set default parameters ============================== */
+
+    if (!knobs)
+    {
+	knobs = default_knobs ;
+	colamd_set_defaults (knobs) ;
+    }
+
+    /* === Allocate the Row and Col arrays from array A ===================== */
+
+    Col_size = (n_col + 1) * sizeof (ColInfo) / sizeof (int) ;
+    Row_size = (n_row + 1) * sizeof (RowInfo) / sizeof (int) ;
+    elbow_room = Alen - (2*nnz + Col_size + Row_size) ;
+    if (elbow_room < n_col + COLAMD_STATS)
+    {
+	/* not enough space in array A to perform the ordering */
+	DEBUG0 (("colamd error! elbow_room %d, %d\n", elbow_room,n_col)) ;
+	return (FALSE) ;
+    }
+    Alen = 2*nnz + elbow_room ;
+    Col  = (ColInfo *) &A [Alen] ;
+    Row  = (RowInfo *) &A [Alen + Col_size] ;
+
+    /* === Construct the row and column data structures ===================== */
+
+    init_result = init_rows_cols (n_row, n_col, Row, Col, A, p) ;
+    if (init_result == -1)
+    {
+	/* input matrix is invalid */
+	DEBUG0 (("colamd error! matrix invalid\n")) ;
+	return (FALSE) ;
+    }
+
+    /* === Initialize scores, kill dense rows/columns ======================= */
+
+    init_scoring (n_row, n_col, Row, Col, A, p, knobs,
+	&n_row2, &n_col2, &max_deg) ;
+
+    /* === Order the supercolumns =========================================== */
+
+    ngarbage = find_ordering (n_row, n_col, Alen, Row, Col, A, p,
+	n_col2, max_deg, 2*nnz) ;
+
+    /* === Order the non-principal columns ================================== */
+
+    order_children (n_col, Col, p) ;
+
+    /* === Return statistics in A =========================================== */
+
+    for (i = 0 ; i < COLAMD_STATS ; i++)
+    {
+	A [i] = 0 ;
+    }
+    A [COLAMD_DENSE_ROW] = n_row - n_row2 ;
+    A [COLAMD_DENSE_COL] = n_col - n_col2 ;
+    A [COLAMD_DEFRAG_COUNT] = ngarbage ;
+    A [COLAMD_JUMBLED_COLS] = init_result ;
+
+    return (TRUE) ;
+}
+
+
+/* ========================================================================== */
+/* === NON-USER-CALLABLE ROUTINES: ========================================== */
+/* ========================================================================== */
+
+/* There are no user-callable routines beyond this point in the file */
+
+
+/* ========================================================================== */
+/* === init_rows_cols ======================================================= */
+/* ========================================================================== */
+
+/*
+    Takes the column form of the matrix in A and creates the row form of the
+    matrix.  Also, row and column attributes are stored in the Col and Row
+    structs.  If the columns are un-sorted or contain duplicate row indices,
+    this routine will also sort and remove duplicate row indices from the
+    column form of the matrix.  Returns -1 on error, 1 if columns jumbled,
+    or 0 if columns not jumbled.  Not user-callable.
+*/
+
+PRIVATE int init_rows_cols	/* returns status code */
+(
+    /* === Parameters ======================================================= */
+
+    int n_row,			/* number of rows of A */
+    int n_col,			/* number of columns of A */
+    RowInfo Row [],		/* of size n_row+1 */
+    ColInfo Col [],		/* of size n_col+1 */
+    int A [],			/* row indices of A, of size Alen */
+    int p []			/* pointers to columns in A, of size n_col+1 */
+)
+{
+    /* === Local variables ================================================== */
+
+    int col ;			/* a column index */
+    int row ;			/* a row index */
+    int *cp ;			/* a column pointer */
+    int *cp_end ;		/* a pointer to the end of a column */
+    int *rp ;			/* a row pointer */
+    int *rp_end ;		/* a pointer to the end of a row */
+    int last_start ;		/* start index of previous column in A */
+    int start ;			/* start index of column in A */
+    int last_row ;		/* previous row */
+    int jumbled_columns ;	/* indicates if columns are jumbled */
+
+    /* === Initialize columns, and check column pointers ==================== */
+
+    last_start = 0 ;
+    for (col = 0 ; col < n_col ; col++)
+    {
+	start = p [col] ;
+	if (start < last_start)
+	{
+	    /* column pointers must be non-decreasing */
+	    DEBUG0 (("colamd error!  last p %d p [col] %d\n",last_start,start));
+	    return (-1) ;
+	}
+	Col [col].start = start ;
+	Col [col].length = p [col+1] - start ;
+	Col [col].shared1.thickness = 1 ;
+	Col [col].shared2.score = 0 ;
+	Col [col].shared3.prev = EMPTY ;
+	Col [col].shared4.degree_next = EMPTY ;
+	last_start = start ;
+    }
+    /* must check the end pointer for last column */
+    if (p [n_col] < last_start)
+    {
+	/* column pointers must be non-decreasing */
+	DEBUG0 (("colamd error!  last p %d p [n_col] %d\n",p[col],last_start)) ;
+	return (-1) ;
+    }
+
+    /* p [0..n_col] no longer needed, used as "head" in subsequent routines */
+
+    /* === Scan columns, compute row degrees, and check row indices ========= */
+
+    jumbled_columns = FALSE ;
+
+    for (row = 0 ; row < n_row ; row++)
+    {
+	Row [row].length = 0 ;
+	Row [row].shared2.mark = -1 ;
+    }
+
+    for (col = 0 ; col < n_col ; col++)
+    {
+	last_row = -1 ;
+
+	cp = &A [p [col]] ;
+	cp_end = &A [p [col+1]] ;
+
+	while (cp < cp_end)
+	{
+	    row = *cp++ ;
+
+	    /* make sure row indices within range */
+	    if (row < 0 || row >= n_row)
+	    {
+		DEBUG0 (("colamd error!  col %d row %d last_row %d\n",
+			 col, row, last_row)) ;
+		return (-1) ;
+	    }
+	    else if (row <= last_row)
+	    {
+		/* row indices are not sorted or repeated, thus cols */
+		/* are jumbled */
+		jumbled_columns = TRUE ;
+	    }
+	    /* prevent repeated row from being counted */
+	    if (Row [row].shared2.mark != col)
+	    {
+		Row [row].length++ ;
+		Row [row].shared2.mark = col ;
+		last_row = row ;
+	    }
+	    else
+	    {
+		/* this is a repeated entry in the column, */
+		/* it will be removed */
+		Col [col].length-- ;
+	    }
+	}
+    }
+
+    /* === Compute row pointers ============================================= */
+
+    /* row form of the matrix starts directly after the column */
+    /* form of matrix in A */
+    Row [0].start = p [n_col] ;
+    Row [0].shared1.p = Row [0].start ;
+    Row [0].shared2.mark = -1 ;
+    for (row = 1 ; row < n_row ; row++)
+    {
+	Row [row].start = Row [row-1].start + Row [row-1].length ;
+	Row [row].shared1.p = Row [row].start ;
+	Row [row].shared2.mark = -1 ;
+    }
+
+    /* === Create row form ================================================== */
+
+    if (jumbled_columns)
+    {
+	/* if cols jumbled, watch for repeated row indices */
+	for (col = 0 ; col < n_col ; col++)
+	{
+	    cp = &A [p [col]] ;
+	    cp_end = &A [p [col+1]] ;
+	    while (cp < cp_end)
+	    {
+		row = *cp++ ;
+		if (Row [row].shared2.mark != col)
+		{
+		    A [(Row [row].shared1.p)++] = col ;
+		    Row [row].shared2.mark = col ;
+		}
+	    }
+	}
+    }
+    else
+    {
+	/* if cols not jumbled, we don't need the mark (this is faster) */
+	for (col = 0 ; col < n_col ; col++)
+	{
+	    cp = &A [p [col]] ;
+	    cp_end = &A [p [col+1]] ;
+	    while (cp < cp_end)
+	    {
+		A [(Row [*cp++].shared1.p)++] = col ;
+	    }
+	}
+    }
+
+    /* === Clear the row marks and set row degrees ========================== */
+
+    for (row = 0 ; row < n_row ; row++)
+    {
+	Row [row].shared2.mark = 0 ;
+	Row [row].shared1.degree = Row [row].length ;
+    }
+
+    /* === See if we need to re-create columns ============================== */
+
+    if (jumbled_columns)
+    {
+
+#ifndef NDEBUG
+	/* make sure column lengths are correct */
+	for (col = 0 ; col < n_col ; col++)
+	{
+	    p [col] = Col [col].length ;
+	}
+	for (row = 0 ; row < n_row ; row++)
+	{
+	    rp = &A [Row [row].start] ;
+	    rp_end = rp + Row [row].length ;
+	    while (rp < rp_end)
+	    {
+		p [*rp++]-- ;
+	    }
+	}
+	for (col = 0 ; col < n_col ; col++)
+	{
+	    assert (p [col] == 0) ;
+	}
+	/* now p is all zero (different than when debugging is turned off) */
+#endif
+
+	/* === Compute col pointers ========================================= */
+
+	/* col form of the matrix starts at A [0]. */
+	/* Note, we may have a gap between the col form and the row */
+	/* form if there were duplicate entries, if so, it will be */
+	/* removed upon the first garbage collection */
+	Col [0].start = 0 ;
+	p [0] = Col [0].start ;
+	for (col = 1 ; col < n_col ; col++)
+	{
+	    /* note that the lengths here are for pruned columns, i.e. */
+	    /* no duplicate row indices will exist for these columns */
+	    Col [col].start = Col [col-1].start + Col [col-1].length ;
+	    p [col] = Col [col].start ;
+	}
+
+	/* === Re-create col form =========================================== */
+
+	for (row = 0 ; row < n_row ; row++)
+	{
+	    rp = &A [Row [row].start] ;
+	    rp_end = rp + Row [row].length ;
+	    while (rp < rp_end)
+	    {
+		A [(p [*rp++])++] = row ;
+	    }
+	}
+	return (1) ;
+    }
+    else
+    {
+	/* no columns jumbled (this is faster) */
+	return (0) ;
+    }
+}
+
+
+/* ========================================================================== */
+/* === init_scoring ========================================================= */
+/* ========================================================================== */
+
+/*
+    Kills dense or empty columns and rows, calculates an initial score for
+    each column, and places all columns in the degree lists.  Not user-callable.
+*/
+
+PRIVATE void init_scoring
+(
+    /* === Parameters ======================================================= */
+
+    int n_row,			/* number of rows of A */
+    int n_col,			/* number of columns of A */
+    RowInfo Row [],		/* of size n_row+1 */
+    ColInfo Col [],		/* of size n_col+1 */
+    int A [],			/* column form and row form of A */
+    int head [],		/* of size n_col+1 */
+    double knobs [COLAMD_KNOBS],/* parameters */
+    int *p_n_row2,		/* number of non-dense, non-empty rows */
+    int *p_n_col2,		/* number of non-dense, non-empty columns */
+    int *p_max_deg		/* maximum row degree */
+)
+{
+    /* === Local variables ================================================== */
+
+    int c ;			/* a column index */
+    int r, row ;		/* a row index */
+    int *cp ;			/* a column pointer */
+    int deg ;			/* degree (# entries) of a row or column */
+    int *cp_end ;		/* a pointer to the end of a column */
+    int *new_cp ;		/* new column pointer */
+    int col_length ;		/* length of pruned column */
+    int score ;			/* current column score */
+    int n_col2 ;		/* number of non-dense, non-empty columns */
+    int n_row2 ;		/* number of non-dense, non-empty rows */
+    int dense_row_count ;	/* remove rows with more entries than this */
+    int dense_col_count ;	/* remove cols with more entries than this */
+    int min_score ;		/* smallest column score */
+    int max_deg ;		/* maximum row degree */
+    int next_col ;		/* Used to add to degree list.*/
+#ifndef NDEBUG
+    int debug_count ;		/* debug only. */
+#endif
+
+    /* === Extract knobs ==================================================== */
+
+    dense_row_count = MAX (0, MIN (knobs [COLAMD_DENSE_ROW] * n_col, n_col)) ;
+    dense_col_count = MAX (0, MIN (knobs [COLAMD_DENSE_COL] * n_row, n_row)) ;
+    DEBUG0 (("densecount: %d %d\n", dense_row_count, dense_col_count)) ;
+    max_deg = 0 ;
+    n_col2 = n_col ;
+    n_row2 = n_row ;
+
+    /* === Kill empty columns =============================================== */
+
+    /* Put the empty columns at the end in their natural, so that LU */
+    /* factorization can proceed as far as possible. */
+    for (c = n_col-1 ; c >= 0 ; c--)
+    {
+	deg = Col [c].length ;
+	if (deg == 0)
+	{
+	    /* this is a empty column, kill and order it last */
+	    Col [c].shared2.order = --n_col2 ;
+	    KILL_PRINCIPAL_COL (c) ;
+	}
+    }
+    DEBUG0 (("null columns killed: %d\n", n_col - n_col2)) ;
+
+    /* === Kill dense columns =============================================== */
+
+    /* Put the dense columns at the end, in their natural order */
+    for (c = n_col-1 ; c >= 0 ; c--)
+    {
+	/* skip any dead columns */
+	if (COL_IS_DEAD (c))
+	{
+	    continue ;
+	}
+	deg = Col [c].length ;
+	if (deg > dense_col_count)
+	{
+	    /* this is a dense column, kill and order it last */
+	    Col [c].shared2.order = --n_col2 ;
+	    /* decrement the row degrees */
+	    cp = &A [Col [c].start] ;
+	    cp_end = cp + Col [c].length ;
+	    while (cp < cp_end)
+	    {
+		Row [*cp++].shared1.degree-- ;
+	    }
+	    KILL_PRINCIPAL_COL (c) ;
+	}
+    }
+    DEBUG0 (("Dense and null columns killed: %d\n", n_col - n_col2)) ;
+
+    /* === Kill dense and empty rows ======================================== */
+
+    for (r = 0 ; r < n_row ; r++)
+    {
+	deg = Row [r].shared1.degree ;
+	assert (deg >= 0 && deg <= n_col) ;
+	if (deg > dense_row_count || deg == 0)
+	{
+	    /* kill a dense or empty row */
+	    KILL_ROW (r) ;
+	    --n_row2 ;
+	}
+	else
+	{
+	    /* keep track of max degree of remaining rows */
+	    max_deg = MAX (max_deg, deg) ;
+	}
+    }
+    DEBUG0 (("Dense and null rows killed: %d\n", n_row - n_row2)) ;
+
+    /* === Compute initial column scores ==================================== */
+
+    /* At this point the row degrees are accurate.  They reflect the number */
+    /* of "live" (non-dense) columns in each row.  No empty rows exist. */
+    /* Some "live" columns may contain only dead rows, however.  These are */
+    /* pruned in the code below. */
+
+    /* now find the initial matlab score for each column */
+    for (c = n_col-1 ; c >= 0 ; c--)
+    {
+	/* skip dead column */
+	if (COL_IS_DEAD (c))
+	{
+	    continue ;
+	}
+	score = 0 ;
+	cp = &A [Col [c].start] ;
+	new_cp = cp ;
+	cp_end = cp + Col [c].length ;
+	while (cp < cp_end)
+	{
+	    /* get a row */
+	    row = *cp++ ;
+	    /* skip if dead */
+	    if (ROW_IS_DEAD (row))
+	    {
+		continue ;
+	    }
+	    /* compact the column */
+	    *new_cp++ = row ;
+	    /* add row's external degree */
+	    score += Row [row].shared1.degree - 1 ;
+	    /* guard against integer overflow */
+	    score = MIN (score, n_col) ;
+	}
+	/* determine pruned column length */
+	col_length = (int) (new_cp - &A [Col [c].start]) ;
+	if (col_length == 0)
+	{
+	    /* a newly-made null column (all rows in this col are "dense" */
+	    /* and have already been killed) */
+	    DEBUG0 (("Newly null killed: %d\n", c)) ;
+	    Col [c].shared2.order = --n_col2 ;
+	    KILL_PRINCIPAL_COL (c) ;
+	}
+	else
+	{
+	    /* set column length and set score */
+	    assert (score >= 0) ;
+	    assert (score <= n_col) ;
+	    Col [c].length = col_length ;
+	    Col [c].shared2.score = score ;
+	}
+    }
+    DEBUG0 (("Dense, null, and newly-null columns killed: %d\n",n_col-n_col2)) ;
+
+    /* At this point, all empty rows and columns are dead.  All live columns */
+    /* are "clean" (containing no dead rows) and simplicial (no supercolumns */
+    /* yet).  Rows may contain dead columns, but all live rows contain at */
+    /* least one live column. */
+
+#ifndef NDEBUG
+    debug_structures (n_row, n_col, Row, Col, A, n_col2) ;
+#endif
+
+    /* === Initialize degree lists ========================================== */
+
+#ifndef NDEBUG
+    debug_count = 0 ;
+#endif
+
+    /* clear the hash buckets */
+    for (c = 0 ; c <= n_col ; c++)
+    {
+	head [c] = EMPTY ;
+    }
+    min_score = n_col ;
+    /* place in reverse order, so low column indices are at the front */
+    /* of the lists.  This is to encourage natural tie-breaking */
+    for (c = n_col-1 ; c >= 0 ; c--)
+    {
+	/* only add principal columns to degree lists */
+	if (COL_IS_ALIVE (c))
+	{
+	    DEBUG4 (("place %d score %d minscore %d ncol %d\n",
+		c, Col [c].shared2.score, min_score, n_col)) ;
+
+	    /* === Add columns score to DList =============================== */
+
+	    score = Col [c].shared2.score ;
+
+	    assert (min_score >= 0) ;
+	    assert (min_score <= n_col) ;
+	    assert (score >= 0) ;
+	    assert (score <= n_col) ;
+	    assert (head [score] >= EMPTY) ;
+
+	    /* now add this column to dList at proper score location */
+	    next_col = head [score] ;
+	    Col [c].shared3.prev = EMPTY ;
+	    Col [c].shared4.degree_next = next_col ;
+
+	    /* if there already was a column with the same score, set its */
+	    /* previous pointer to this new column */
+	    if (next_col != EMPTY)
+	    {
+		Col [next_col].shared3.prev = c ;
+	    }
+	    head [score] = c ;
+
+	    /* see if this score is less than current min */
+	    min_score = MIN (min_score, score) ;
+
+#ifndef NDEBUG
+	    debug_count++ ;
+#endif
+	}
+    }
+
+#ifndef NDEBUG
+    DEBUG0 (("Live cols %d out of %d, non-princ: %d\n",
+	debug_count, n_col, n_col-debug_count)) ;
+    assert (debug_count == n_col2) ;
+    debug_deg_lists (n_row, n_col, Row, Col, head, min_score, n_col2, max_deg) ;
+#endif
+
+    /* === Return number of remaining columns, and max row degree =========== */
+
+    *p_n_col2 = n_col2 ;
+    *p_n_row2 = n_row2 ;
+    *p_max_deg = max_deg ;
+}
+
+
+/* ========================================================================== */
+/* === find_ordering ======================================================== */
+/* ========================================================================== */
+
+/*
+    Order the principal columns of the supercolumn form of the matrix
+    (no supercolumns on input).  Uses a minimum approximate column minimum
+    degree ordering method.  Not user-callable.
+*/
+
+PRIVATE int find_ordering	/* return the number of garbage collections */
+(
+    /* === Parameters ======================================================= */
+
+    int n_row,			/* number of rows of A */
+    int n_col,			/* number of columns of A */
+    int Alen,			/* size of A, 2*nnz + elbow_room or larger */
+    RowInfo Row [],		/* of size n_row+1 */
+    ColInfo Col [],		/* of size n_col+1 */
+    int A [],			/* column form and row form of A */
+    int head [],		/* of size n_col+1 */
+    int n_col2,			/* Remaining columns to order */
+    int max_deg,		/* Maximum row degree */
+    int pfree			/* index of first free slot (2*nnz on entry) */
+)
+{
+    /* === Local variables ================================================== */
+
+    int k ;			/* current pivot ordering step */
+    int pivot_col ;		/* current pivot column */
+    int *cp ;			/* a column pointer */
+    int *rp ;			/* a row pointer */
+    int pivot_row ;		/* current pivot row */
+    int *new_cp ;		/* modified column pointer */
+    int *new_rp ;		/* modified row pointer */
+    int pivot_row_start ;	/* pointer to start of pivot row */
+    int pivot_row_degree ;	/* # of columns in pivot row */
+    int pivot_row_length ;	/* # of supercolumns in pivot row */
+    int pivot_col_score ;	/* score of pivot column */
+    int needed_memory ;		/* free space needed for pivot row */
+    int *cp_end ;		/* pointer to the end of a column */
+    int *rp_end ;		/* pointer to the end of a row */
+    int row ;			/* a row index */
+    int col ;			/* a column index */
+    int max_score ;		/* maximum possible score */
+    int cur_score ;		/* score of current column */
+    unsigned int hash ;		/* hash value for supernode detection */
+    int head_column ;		/* head of hash bucket */
+    int first_col ;		/* first column in hash bucket */
+    int tag_mark ;		/* marker value for mark array */
+    int row_mark ;		/* Row [row].shared2.mark */
+    int set_difference ;	/* set difference size of row with pivot row */
+    int min_score ;		/* smallest column score */
+    int col_thickness ;		/* "thickness" (# of columns in a supercol) */
+    int max_mark ;		/* maximum value of tag_mark */
+    int pivot_col_thickness ;	/* number of columns represented by pivot col */
+    int prev_col ;		/* Used by Dlist operations. */
+    int next_col ;		/* Used by Dlist operations. */
+    int ngarbage ;		/* number of garbage collections performed */
+#ifndef NDEBUG
+    int debug_d ;		/* debug loop counter */
+    int debug_step = 0 ;	/* debug loop counter */
+#endif
+
+    /* === Initialization and clear mark ==================================== */
+
+    max_mark = INT_MAX - n_col ;	/* INT_MAX defined in <limits.h> */
+    tag_mark = clear_mark (n_row, Row) ;
+    min_score = 0 ;
+    ngarbage = 0 ;
+    DEBUG0 (("Ordering.. n_col2=%d\n", n_col2)) ;
+
+    /* === Order the columns ================================================ */
+
+    for (k = 0 ; k < n_col2 ; /* 'k' is incremented below */)
+    {
+
+#ifndef NDEBUG
+	if (debug_step % 100 == 0)
+	{
+	    DEBUG0 (("\n...       Step k: %d out of n_col2: %d\n", k, n_col2)) ;
+	}
+	else
+	{
+	    DEBUG1 (("\n----------Step k: %d out of n_col2: %d\n", k, n_col2)) ;
+	}
+	debug_step++ ;
+	debug_deg_lists (n_row, n_col, Row, Col, head,
+		min_score, n_col2-k, max_deg) ;
+	debug_matrix (n_row, n_col, Row, Col, A) ;
+#endif
+
+	/* === Select pivot column, and order it ============================ */
+
+	/* make sure degree list isn't empty */
+	assert (min_score >= 0) ;
+	assert (min_score <= n_col) ;
+	assert (head [min_score] >= EMPTY) ;
+
+#ifndef NDEBUG
+	for (debug_d = 0 ; debug_d < min_score ; debug_d++)
+	{
+	    assert (head [debug_d] == EMPTY) ;
+	}
+#endif
+
+	/* get pivot column from head of minimum degree list */
+	while (head [min_score] == EMPTY && min_score < n_col)
+	{
+	    min_score++ ;
+	}
+	pivot_col = head [min_score] ;
+	assert (pivot_col >= 0 && pivot_col <= n_col) ;
+	next_col = Col [pivot_col].shared4.degree_next ;
+	head [min_score] = next_col ;
+	if (next_col != EMPTY)
+	{
+	    Col [next_col].shared3.prev = EMPTY ;
+	}
+
+	assert (COL_IS_ALIVE (pivot_col)) ;
+	DEBUG3 (("Pivot col: %d\n", pivot_col)) ;
+
+	/* remember score for defrag check */
+	pivot_col_score = Col [pivot_col].shared2.score ;
+
+	/* the pivot column is the kth column in the pivot order */
+	Col [pivot_col].shared2.order = k ;
+
+	/* increment order count by column thickness */
+	pivot_col_thickness = Col [pivot_col].shared1.thickness ;
+	k += pivot_col_thickness ;
+	assert (pivot_col_thickness > 0) ;
+
+	/* === Garbage_collection, if necessary ============================= */
+
+	needed_memory = MIN (pivot_col_score, n_col - k) ;
+	if (pfree + needed_memory >= Alen)
+	{
+	    pfree = garbage_collection (n_row, n_col, Row, Col, A, &A [pfree]) ;
+	    ngarbage++ ;
+	    /* after garbage collection we will have enough */
+	    assert (pfree + needed_memory < Alen) ;
+	    /* garbage collection has wiped out the Row[].shared2.mark array */
+	    tag_mark = clear_mark (n_row, Row) ;
+#ifndef NDEBUG
+	    debug_matrix (n_row, n_col, Row, Col, A) ;
+#endif
+	}
+
+	/* === Compute pivot row pattern ==================================== */
+
+	/* get starting location for this new merged row */
+	pivot_row_start = pfree ;
+
+	/* initialize new row counts to zero */
+	pivot_row_degree = 0 ;
+
+	/* tag pivot column as having been visited so it isn't included */
+	/* in merged pivot row */
+	Col [pivot_col].shared1.thickness = -pivot_col_thickness ;
+
+	/* pivot row is the union of all rows in the pivot column pattern */
+	cp = &A [Col [pivot_col].start] ;
+	cp_end = cp + Col [pivot_col].length ;
+	while (cp < cp_end)
+	{
+	    /* get a row */
+	    row = *cp++ ;
+	    DEBUG4 (("Pivot col pattern %d %d\n", ROW_IS_ALIVE (row), row)) ;
+	    /* skip if row is dead */
+	    if (ROW_IS_DEAD (row))
+	    {
+		continue ;
+	    }
+	    rp = &A [Row [row].start] ;
+	    rp_end = rp + Row [row].length ;
+	    while (rp < rp_end)
+	    {
+		/* get a column */
+		col = *rp++ ;
+		/* add the column, if alive and untagged */
+		col_thickness = Col [col].shared1.thickness ;
+		if (col_thickness > 0 && COL_IS_ALIVE (col))
+		{
+		    /* tag column in pivot row */
+		    Col [col].shared1.thickness = -col_thickness ;
+		    assert (pfree < Alen) ;
+		    /* place column in pivot row */
+		    A [pfree++] = col ;
+		    pivot_row_degree += col_thickness ;
+		}
+	    }
+	}
+
+	/* clear tag on pivot column */
+	Col [pivot_col].shared1.thickness = pivot_col_thickness ;
+	max_deg = MAX (max_deg, pivot_row_degree) ;
+
+#ifndef NDEBUG
+	DEBUG3 (("check2\n")) ;
+	debug_mark (n_row, Row, tag_mark, max_mark) ;
+#endif
+
+	/* === Kill all rows used to construct pivot row ==================== */
+
+	/* also kill pivot row, temporarily */
+	cp = &A [Col [pivot_col].start] ;
+	cp_end = cp + Col [pivot_col].length ;
+	while (cp < cp_end)
+	{
+	    /* may be killing an already dead row */
+	    row = *cp++ ;
+	    DEBUG2 (("Kill row in pivot col: %d\n", row)) ;
+	    KILL_ROW (row) ;
+	}
+
+	/* === Select a row index to use as the new pivot row =============== */
+
+	pivot_row_length = pfree - pivot_row_start ;
+	if (pivot_row_length > 0)
+	{
+	    /* pick the "pivot" row arbitrarily (first row in col) */
+	    pivot_row = A [Col [pivot_col].start] ;
+	    DEBUG2 (("Pivotal row is %d\n", pivot_row)) ;
+	}
+	else
+	{
+	    /* there is no pivot row, since it is of zero length */
+	    pivot_row = EMPTY ;
+	    assert (pivot_row_length == 0) ;
+	}
+	assert (Col [pivot_col].length > 0 || pivot_row_length == 0) ;
+
+	/* === Approximate degree computation =============================== */
+
+	/* Here begins the computation of the approximate degree.  The column */
+	/* score is the sum of the pivot row "length", plus the size of the */
+	/* set differences of each row in the column minus the pattern of the */
+	/* pivot row itself.  The column ("thickness") itself is also */
+	/* excluded from the column score (we thus use an approximate */
+	/* external degree). */
+
+	/* The time taken by the following code (compute set differences, and */
+	/* add them up) is proportional to the size of the data structure */
+	/* being scanned - that is, the sum of the sizes of each column in */
+	/* the pivot row.  Thus, the amortized time to compute a column score */
+	/* is proportional to the size of that column (where size, in this */
+	/* context, is the column "length", or the number of row indices */
+	/* in that column).  The number of row indices in a column is */
+	/* monotonically non-decreasing, from the length of the original */
+	/* column on input to colamd. */
+
+	/* === Compute set differences ====================================== */
+
+	DEBUG1 (("** Computing set differences phase. **\n")) ;
+
+	/* pivot row is currently dead - it will be revived later. */
+
+	DEBUG2 (("Pivot row: ")) ;
+	/* for each column in pivot row */
+	rp = &A [pivot_row_start] ;
+	rp_end = rp + pivot_row_length ;
+	while (rp < rp_end)
+	{
+	    col = *rp++ ;
+	    assert (COL_IS_ALIVE (col) && col != pivot_col) ;
+	    DEBUG2 (("Col: %d\n", col)) ;
+
+	    /* clear tags used to construct pivot row pattern */
+	    col_thickness = -Col [col].shared1.thickness ;
+	    assert (col_thickness > 0) ;
+	    Col [col].shared1.thickness = col_thickness ;
+
+	    /* === Remove column from degree list =========================== */
+
+	    cur_score = Col [col].shared2.score ;
+	    prev_col = Col [col].shared3.prev ;
+	    next_col = Col [col].shared4.degree_next ;
+	    assert (cur_score >= 0) ;
+	    assert (cur_score <= n_col) ;
+	    assert (cur_score >= EMPTY) ;
+	    if (prev_col == EMPTY)
+	    {
+		head [cur_score] = next_col ;
+	    }
+	    else
+	    {
+		Col [prev_col].shared4.degree_next = next_col ;
+	    }
+	    if (next_col != EMPTY)
+	    {
+		Col [next_col].shared3.prev = prev_col ;
+	    }
+
+	    /* === Scan the column ========================================== */
+
+	    cp = &A [Col [col].start] ;
+	    cp_end = cp + Col [col].length ;
+	    while (cp < cp_end)
+	    {
+		/* get a row */
+		row = *cp++ ;
+		row_mark = Row [row].shared2.mark ;
+		/* skip if dead */
+		if (ROW_IS_MARKED_DEAD (row_mark))
+		{
+		    continue ;
+		}
+		assert (row != pivot_row) ;
+		set_difference = row_mark - tag_mark ;
+		/* check if the row has been seen yet */
+		if (set_difference < 0)
+		{
+		    assert (Row [row].shared1.degree <= max_deg) ;
+		    set_difference = Row [row].shared1.degree ;
+		}
+		/* subtract column thickness from this row's set difference */
+		set_difference -= col_thickness ;
+		assert (set_difference >= 0) ;
+		/* absorb this row if the set difference becomes zero */
+		if (set_difference == 0)
+		{
+		    DEBUG1 (("aggressive absorption. Row: %d\n", row)) ;
+		    KILL_ROW (row) ;
+		}
+		else
+		{
+		    /* save the new mark */
+		    Row [row].shared2.mark = set_difference + tag_mark ;
+		}
+	    }
+	}
+
+#ifndef NDEBUG
+	debug_deg_lists (n_row, n_col, Row, Col, head,
+		min_score, n_col2-k-pivot_row_degree, max_deg) ;
+#endif
+
+	/* === Add up set differences for each column ======================= */
+
+	DEBUG1 (("** Adding set differences phase. **\n")) ;
+
+	/* for each column in pivot row */
+	rp = &A [pivot_row_start] ;
+	rp_end = rp + pivot_row_length ;
+	while (rp < rp_end)
+	{
+	    /* get a column */
+	    col = *rp++ ;
+	    assert (COL_IS_ALIVE (col) && col != pivot_col) ;
+	    hash = 0 ;
+	    cur_score = 0 ;
+	    cp = &A [Col [col].start] ;
+	    /* compact the column */
+	    new_cp = cp ;
+	    cp_end = cp + Col [col].length ;
+
+	    DEBUG2 (("Adding set diffs for Col: %d.\n", col)) ;
+
+	    while (cp < cp_end)
+	    {
+		/* get a row */
+		row = *cp++ ;
+		assert(row >= 0 && row < n_row) ;
+		row_mark = Row [row].shared2.mark ;
+		/* skip if dead */
+		if (ROW_IS_MARKED_DEAD (row_mark))
+		{
+		    continue ;
+		}
+		assert (row_mark > tag_mark) ;
+		/* compact the column */
+		*new_cp++ = row ;
+		/* compute hash function */
+		hash += row ;
+		/* add set difference */
+		cur_score += row_mark - tag_mark ;
+		/* integer overflow... */
+		cur_score = MIN (cur_score, n_col) ;
+	    }
+
+	    /* recompute the column's length */
+	    Col [col].length = (int) (new_cp - &A [Col [col].start]) ;
+
+	    /* === Further mass elimination ================================= */
+
+	    if (Col [col].length == 0)
+	    {
+		DEBUG1 (("further mass elimination. Col: %d\n", col)) ;
+		/* nothing left but the pivot row in this column */
+		KILL_PRINCIPAL_COL (col) ;
+		pivot_row_degree -= Col [col].shared1.thickness ;
+		assert (pivot_row_degree >= 0) ;
+		/* order it */
+		Col [col].shared2.order = k ;
+		/* increment order count by column thickness */
+		k += Col [col].shared1.thickness ;
+	    }
+	    else
+	    {
+		/* === Prepare for supercolumn detection ==================== */
+
+		DEBUG2 (("Preparing supercol detection for Col: %d.\n", col)) ;
+
+		/* save score so far */
+		Col [col].shared2.score = cur_score ;
+
+		/* add column to hash table, for supercolumn detection */
+		hash %= n_col + 1 ;
+
+		DEBUG2 ((" Hash = %d, n_col = %d.\n", hash, n_col)) ;
+		assert (hash <= n_col) ;
+
+		head_column = head [hash] ;
+		if (head_column > EMPTY)
+		{
+		    /* degree list "hash" is non-empty, use prev (shared3) of */
+		    /* first column in degree list as head of hash bucket */
+		    first_col = Col [head_column].shared3.headhash ;
+		    Col [head_column].shared3.headhash = col ;
+		}
+		else
+		{
+		    /* degree list "hash" is empty, use head as hash bucket */
+		    first_col = - (head_column + 2) ;
+		    head [hash] = - (col + 2) ;
+		}
+		Col [col].shared4.hash_next = first_col ;
+
+		/* save hash function in Col [col].shared3.hash */
+		Col [col].shared3.hash = (int) hash ;
+		assert (COL_IS_ALIVE (col)) ;
+	    }
+	}
+
+	/* The approximate external column degree is now computed.  */
+
+	/* === Supercolumn detection ======================================== */
+
+	DEBUG1 (("** Supercolumn detection phase. **\n")) ;
+
+	detect_super_cols (
+#ifndef NDEBUG
+		n_col, Row,
+#endif
+		Col, A, head, pivot_row_start, pivot_row_length) ;
+
+	/* === Kill the pivotal column ====================================== */
+
+	KILL_PRINCIPAL_COL (pivot_col) ;
+
+	/* === Clear mark =================================================== */
+
+	tag_mark += (max_deg + 1) ;
+	if (tag_mark >= max_mark)
+	{
+	    DEBUG1 (("clearing tag_mark\n")) ;
+	    tag_mark = clear_mark (n_row, Row) ;
+	}
+#ifndef NDEBUG
+	DEBUG3 (("check3\n")) ;
+	debug_mark (n_row, Row, tag_mark, max_mark) ;
+#endif
+
+	/* === Finalize the new pivot row, and column scores ================ */
+
+	DEBUG1 (("** Finalize scores phase. **\n")) ;
+
+	/* for each column in pivot row */
+	rp = &A [pivot_row_start] ;
+	/* compact the pivot row */
+	new_rp = rp ;
+	rp_end = rp + pivot_row_length ;
+	while (rp < rp_end)
+	{
+	    col = *rp++ ;
+	    /* skip dead columns */
+	    if (COL_IS_DEAD (col))
+	    {
+		continue ;
+	    }
+	    *new_rp++ = col ;
+	    /* add new pivot row to column */
+	    A [Col [col].start + (Col [col].length++)] = pivot_row ;
+
+	    /* retrieve score so far and add on pivot row's degree. */
+	    /* (we wait until here for this in case the pivot */
+	    /* row's degree was reduced due to mass elimination). */
+	    cur_score = Col [col].shared2.score + pivot_row_degree ;
+
+	    /* calculate the max possible score as the number of */
+	    /* external columns minus the 'k' value minus the */
+	    /* columns thickness */
+	    max_score = n_col - k - Col [col].shared1.thickness ;
+
+	    /* make the score the external degree of the union-of-rows */
+	    cur_score -= Col [col].shared1.thickness ;
+
+	    /* make sure score is less or equal than the max score */
+	    cur_score = MIN (cur_score, max_score) ;
+	    assert (cur_score >= 0) ;
+
+	    /* store updated score */
+	    Col [col].shared2.score = cur_score ;
+
+	    /* === Place column back in degree list ========================= */
+
+	    assert (min_score >= 0) ;
+	    assert (min_score <= n_col) ;
+	    assert (cur_score >= 0) ;
+	    assert (cur_score <= n_col) ;
+	    assert (head [cur_score] >= EMPTY) ;
+	    next_col = head [cur_score] ;
+	    Col [col].shared4.degree_next = next_col ;
+	    Col [col].shared3.prev = EMPTY ;
+	    if (next_col != EMPTY)
+	    {
+		Col [next_col].shared3.prev = col ;
+	    }
+	    head [cur_score] = col ;
+
+	    /* see if this score is less than current min */
+	    min_score = MIN (min_score, cur_score) ;
+
+	}
+
+#ifndef NDEBUG
+	debug_deg_lists (n_row, n_col, Row, Col, head,
+		min_score, n_col2-k, max_deg) ;
+#endif
+
+	/* === Resurrect the new pivot row ================================== */
+
+	if (pivot_row_degree > 0)
+	{
+	    /* update pivot row length to reflect any cols that were killed */
+	    /* during super-col detection and mass elimination */
+	    Row [pivot_row].start  = pivot_row_start ;
+	    Row [pivot_row].length = (int) (new_rp - &A[pivot_row_start]) ;
+	    Row [pivot_row].shared1.degree = pivot_row_degree ;
+	    Row [pivot_row].shared2.mark = 0 ;
+	    /* pivot row is no longer dead */
+	}
+    }
+
+    /* === All principal columns have now been ordered ====================== */
+
+    return (ngarbage) ;
+}
+
+
+/* ========================================================================== */
+/* === order_children ======================================================= */
+/* ========================================================================== */
+
+/*
+    The find_ordering routine has ordered all of the principal columns (the
+    representatives of the supercolumns).  The non-principal columns have not
+    yet been ordered.  This routine orders those columns by walking up the
+    parent tree (a column is a child of the column which absorbed it).  The
+    final permutation vector is then placed in p [0 ... n_col-1], with p [0]
+    being the first column, and p [n_col-1] being the last.  It doesn't look
+    like it at first glance, but be assured that this routine takes time linear
+    in the number of columns.  Although not immediately obvious, the time
+    taken by this routine is O (n_col), that is, linear in the number of
+    columns.  Not user-callable.
+*/
+
+PRIVATE void order_children
+(
+    /* === Parameters ======================================================= */
+
+    int n_col,			/* number of columns of A */
+    ColInfo Col [],		/* of size n_col+1 */
+    int p []			/* p [0 ... n_col-1] is the column permutation*/
+)
+{
+    /* === Local variables ================================================== */
+
+    int i ;			/* loop counter for all columns */
+    int c ;			/* column index */
+    int parent ;		/* index of column's parent */
+    int order ;			/* column's order */
+
+    /* === Order each non-principal column ================================== */
+
+    for (i = 0 ; i < n_col ; i++)
+    {
+	/* find an un-ordered non-principal column */
+	assert (COL_IS_DEAD (i)) ;
+	if (!COL_IS_DEAD_PRINCIPAL (i) && Col [i].shared2.order == EMPTY)
+	{
+	    parent = i ;
+	    /* once found, find its principal parent */
+	    do
+	    {
+		parent = Col [parent].shared1.parent ;
+	    } while (!COL_IS_DEAD_PRINCIPAL (parent)) ;
+
+	    /* now, order all un-ordered non-principal columns along path */
+	    /* to this parent.  collapse tree at the same time */
+	    c = i ;
+	    /* get order of parent */
+	    order = Col [parent].shared2.order ;
+
+	    do
+	    {
+		assert (Col [c].shared2.order == EMPTY) ;
+
+		/* order this column */
+		Col [c].shared2.order = order++ ;
+		/* collaps tree */
+		Col [c].shared1.parent = parent ;
+
+		/* get immediate parent of this column */
+		c = Col [c].shared1.parent ;
+
+		/* continue until we hit an ordered column.  There are */
+		/* guarranteed not to be anymore unordered columns */
+		/* above an ordered column */
+	    } while (Col [c].shared2.order == EMPTY) ;
+
+	    /* re-order the super_col parent to largest order for this group */
+	    Col [parent].shared2.order = order ;
+	}
+    }
+
+    /* === Generate the permutation ========================================= */
+
+    for (c = 0 ; c < n_col ; c++)
+    {
+	p [Col [c].shared2.order] = c ;
+    }
+}
+
+
+/* ========================================================================== */
+/* === detect_super_cols ==================================================== */
+/* ========================================================================== */
+
+/*
+    Detects supercolumns by finding matches between columns in the hash buckets.
+    Check amongst columns in the set A [row_start ... row_start + row_length-1].
+    The columns under consideration are currently *not* in the degree lists,
+    and have already been placed in the hash buckets.
+
+    The hash bucket for columns whose hash function is equal to h is stored
+    as follows:
+
+	if head [h] is >= 0, then head [h] contains a degree list, so:
+
+		head [h] is the first column in degree bucket h.
+		Col [head [h]].headhash gives the first column in hash bucket h.
+
+	otherwise, the degree list is empty, and:
+
+		-(head [h] + 2) is the first column in hash bucket h.
+
+    For a column c in a hash bucket, Col [c].shared3.prev is NOT a "previous
+    column" pointer.  Col [c].shared3.hash is used instead as the hash number
+    for that column.  The value of Col [c].shared4.hash_next is the next column
+    in the same hash bucket.
+
+    Assuming no, or "few" hash collisions, the time taken by this routine is
+    linear in the sum of the sizes (lengths) of each column whose score has
+    just been computed in the approximate degree computation.
+    Not user-callable.
+*/
+
+PRIVATE void detect_super_cols
+(
+    /* === Parameters ======================================================= */
+
+#ifndef NDEBUG
+    /* these two parameters are only needed when debugging is enabled: */
+    int n_col,			/* number of columns of A */
+    RowInfo Row [],		/* of size n_row+1 */
+#endif
+    ColInfo Col [],		/* of size n_col+1 */
+    int A [],			/* row indices of A */
+    int head [],		/* head of degree lists and hash buckets */
+    int row_start,		/* pointer to set of columns to check */
+    int row_length		/* number of columns to check */
+)
+{
+    /* === Local variables ================================================== */
+
+    int hash ;			/* hash # for a column */
+    int *rp ;			/* pointer to a row */
+    int c ;			/* a column index */
+    int super_c ;		/* column index of the column to absorb into */
+    int *cp1 ;			/* column pointer for column super_c */
+    int *cp2 ;			/* column pointer for column c */
+    int length ;		/* length of column super_c */
+    int prev_c ;		/* column preceding c in hash bucket */
+    int i ;			/* loop counter */
+    int *rp_end ;		/* pointer to the end of the row */
+    int col ;			/* a column index in the row to check */
+    int head_column ;		/* first column in hash bucket or degree list */
+    int first_col ;		/* first column in hash bucket */
+
+    /* === Consider each column in the row ================================== */
+
+    rp = &A [row_start] ;
+    rp_end = rp + row_length ;
+    while (rp < rp_end)
+    {
+	col = *rp++ ;
+	if (COL_IS_DEAD (col))
+	{
+	    continue ;
+	}
+
+	/* get hash number for this column */
+	hash = Col [col].shared3.hash ;
+	assert (hash <= n_col) ;
+
+	/* === Get the first column in this hash bucket ===================== */
+
+	head_column = head [hash] ;
+	if (head_column > EMPTY)
+	{
+	    first_col = Col [head_column].shared3.headhash ;
+	}
+	else
+	{
+	    first_col = - (head_column + 2) ;
+	}
+
+	/* === Consider each column in the hash bucket ====================== */
+
+	for (super_c = first_col ; super_c != EMPTY ;
+	    super_c = Col [super_c].shared4.hash_next)
+	{
+	    assert (COL_IS_ALIVE (super_c)) ;
+	    assert (Col [super_c].shared3.hash == hash) ;
+	    length = Col [super_c].length ;
+
+	    /* prev_c is the column preceding column c in the hash bucket */
+	    prev_c = super_c ;
+
+	    /* === Compare super_c with all columns after it ================ */
+
+	    for (c = Col [super_c].shared4.hash_next ;
+		 c != EMPTY ; c = Col [c].shared4.hash_next)
+	    {
+		assert (c != super_c) ;
+		assert (COL_IS_ALIVE (c)) ;
+		assert (Col [c].shared3.hash == hash) ;
+
+		/* not identical if lengths or scores are different */
+		if (Col [c].length != length ||
+		    Col [c].shared2.score != Col [super_c].shared2.score)
+		{
+		    prev_c = c ;
+		    continue ;
+		}
+
+		/* compare the two columns */
+		cp1 = &A [Col [super_c].start] ;
+		cp2 = &A [Col [c].start] ;
+
+		for (i = 0 ; i < length ; i++)
+		{
+		    /* the columns are "clean" (no dead rows) */
+		    assert (ROW_IS_ALIVE (*cp1))  ;
+		    assert (ROW_IS_ALIVE (*cp2))  ;
+		    /* row indices will same order for both supercols, */
+		    /* no gather scatter nessasary */
+		    if (*cp1++ != *cp2++)
+		    {
+			break ;
+		    }
+		}
+
+		/* the two columns are different if the for-loop "broke" */
+		if (i != length)
+		{
+		    prev_c = c ;
+		    continue ;
+		}
+
+		/* === Got it!  two columns are identical =================== */
+
+		assert (Col [c].shared2.score == Col [super_c].shared2.score) ;
+
+		Col [super_c].shared1.thickness += Col [c].shared1.thickness ;
+		Col [c].shared1.parent = super_c ;
+		KILL_NON_PRINCIPAL_COL (c) ;
+		/* order c later, in order_children() */
+		Col [c].shared2.order = EMPTY ;
+		/* remove c from hash bucket */
+		Col [prev_c].shared4.hash_next = Col [c].shared4.hash_next ;
+	    }
+	}
+
+	/* === Empty this hash bucket ======================================= */
+
+	if (head_column > EMPTY)
+	{
+	    /* corresponding degree list "hash" is not empty */
+	    Col [head_column].shared3.headhash = EMPTY ;
+	}
+	else
+	{
+	    /* corresponding degree list "hash" is empty */
+	    head [hash] = EMPTY ;
+	}
+    }
+}
+
+
+/* ========================================================================== */
+/* === garbage_collection =================================================== */
+/* ========================================================================== */
+
+/*
+    Defragments and compacts columns and rows in the workspace A.  Used when
+    all avaliable memory has been used while performing row merging.  Returns
+    the index of the first free position in A, after garbage collection.  The
+    time taken by this routine is linear is the size of the array A, which is
+    itself linear in the number of nonzeros in the input matrix.
+    Not user-callable.
+*/
+
+PRIVATE int garbage_collection  /* returns the new value of pfree */
+(
+    /* === Parameters ======================================================= */
+
+    int n_row,			/* number of rows */
+    int n_col,			/* number of columns */
+    RowInfo Row [],		/* row info */
+    ColInfo Col [],		/* column info */
+    int A [],			/* A [0 ... Alen-1] holds the matrix */
+    int *pfree			/* &A [0] ... pfree is in use */
+)
+{
+    /* === Local variables ================================================== */
+
+    int *psrc ;			/* source pointer */
+    int *pdest ;		/* destination pointer */
+    int j ;			/* counter */
+    int r ;			/* a row index */
+    int c ;			/* a column index */
+    int length ;		/* length of a row or column */
+
+#ifndef NDEBUG
+    int debug_rows ;
+    DEBUG0 (("Defrag..\n")) ;
+    for (psrc = &A[0] ; psrc < pfree ; psrc++) assert (*psrc >= 0) ;
+    debug_rows = 0 ;
+#endif
+
+    /* === Defragment the columns =========================================== */
+
+    pdest = &A[0] ;
+    for (c = 0 ; c < n_col ; c++)
+    {
+	if (COL_IS_ALIVE (c))
+	{
+	    psrc = &A [Col [c].start] ;
+
+	    /* move and compact the column */
+	    assert (pdest <= psrc) ;
+	    Col [c].start = (int) (pdest - &A [0]) ;
+	    length = Col [c].length ;
+	    for (j = 0 ; j < length ; j++)
+	    {
+		r = *psrc++ ;
+		if (ROW_IS_ALIVE (r))
+		{
+		    *pdest++ = r ;
+		}
+	    }
+	    Col [c].length = (int) (pdest - &A [Col [c].start]) ;
+	}
+    }
+
+    /* === Prepare to defragment the rows =================================== */
+
+    for (r = 0 ; r < n_row ; r++)
+    {
+	if (ROW_IS_ALIVE (r))
+	{
+	    if (Row [r].length == 0)
+	    {
+		/* this row is of zero length.  cannot compact it, so kill it */
+		DEBUG0 (("Defrag row kill\n")) ;
+		KILL_ROW (r) ;
+	    }
+	    else
+	    {
+		/* save first column index in Row [r].shared2.first_column */
+		psrc = &A [Row [r].start] ;
+		Row [r].shared2.first_column = *psrc ;
+		assert (ROW_IS_ALIVE (r)) ;
+		/* flag the start of the row with the one's complement of row */
+		*psrc = ONES_COMPLEMENT (r) ;
+#ifndef NDEBUG
+		debug_rows++ ;
+#endif
+	    }
+	}
+    }
+
+    /* === Defragment the rows ============================================== */
+
+    psrc = pdest ;
+    while (psrc < pfree)
+    {
+	/* find a negative number ... the start of a row */
+	if (*psrc++ < 0)
+	{
+	    psrc-- ;
+	    /* get the row index */
+	    r = ONES_COMPLEMENT (*psrc) ;
+	    assert (r >= 0 && r < n_row) ;
+	    /* restore first column index */
+	    *psrc = Row [r].shared2.first_column ;
+	    assert (ROW_IS_ALIVE (r)) ;
+
+	    /* move and compact the row */
+	    assert (pdest <= psrc) ;
+	    Row [r].start = (int) (pdest - &A [0]) ;
+	    length = Row [r].length ;
+	    for (j = 0 ; j < length ; j++)
+	    {
+		c = *psrc++ ;
+		if (COL_IS_ALIVE (c))
+		{
+		    *pdest++ = c ;
+		}
+	    }
+	    Row [r].length = (int) (pdest - &A [Row [r].start]) ;
+#ifndef NDEBUG
+	    debug_rows-- ;
+#endif
+	}
+    }
+    /* ensure we found all the rows */
+    assert (debug_rows == 0) ;
+
+    /* === Return the new value of pfree ==================================== */
+
+    return ((int) (pdest - &A [0])) ;
+}
+
+
+/* ========================================================================== */
+/* === clear_mark =========================================================== */
+/* ========================================================================== */
+
+/*
+    Clears the Row [].shared2.mark array, and returns the new tag_mark.
+    Return value is the new tag_mark.  Not user-callable.
+*/
+
+PRIVATE int clear_mark	/* return the new value for tag_mark */
+(
+    /* === Parameters ======================================================= */
+
+    int n_row,		/* number of rows in A */
+    RowInfo Row []	/* Row [0 ... n_row-1].shared2.mark is set to zero */
+)
+{
+    /* === Local variables ================================================== */
+
+    int r ;
+
+    DEBUG0 (("Clear mark\n")) ;
+    for (r = 0 ; r < n_row ; r++)
+    {
+	if (ROW_IS_ALIVE (r))
+	{
+	    Row [r].shared2.mark = 0 ;
+	}
+    }
+    return (1) ;
+}
+
+
+/* ========================================================================== */
+/* === debugging routines =================================================== */
+/* ========================================================================== */
+
+/* When debugging is disabled, the remainder of this file is ignored. */
+
+#ifndef NDEBUG
+
+
+/* ========================================================================== */
+/* === debug_structures ===================================================== */
+/* ========================================================================== */
+
+/*
+    At this point, all empty rows and columns are dead.  All live columns
+    are "clean" (containing no dead rows) and simplicial (no supercolumns
+    yet).  Rows may contain dead columns, but all live rows contain at
+    least one live column.
+*/
+
+PRIVATE void debug_structures
+(
+    /* === Parameters ======================================================= */
+
+    int n_row,
+    int n_col,
+    RowInfo Row [],
+    ColInfo Col [],
+    int A [],
+    int n_col2
+)
+{
+    /* === Local variables ================================================== */
+
+    int i ;
+    int c ;
+    int *cp ;
+    int *cp_end ;
+    int len ;
+    int score ;
+    int r ;
+    int *rp ;
+    int *rp_end ;
+    int deg ;
+
+    /* === Check A, Row, and Col ============================================ */
+
+    for (c = 0 ; c < n_col ; c++)
+    {
+	if (COL_IS_ALIVE (c))
+	{
+	    len = Col [c].length ;
+	    score = Col [c].shared2.score ;
+	    DEBUG4 (("initial live col %5d %5d %5d\n", c, len, score)) ;
+	    assert (len > 0) ;
+	    assert (score >= 0) ;
+	    assert (Col [c].shared1.thickness == 1) ;
+	    cp = &A [Col [c].start] ;
+	    cp_end = cp + len ;
+	    while (cp < cp_end)
+	    {
+		r = *cp++ ;
+		assert (ROW_IS_ALIVE (r)) ;
+	    }
+	}
+	else
+	{
+	    i = Col [c].shared2.order ;
+	    assert (i >= n_col2 && i < n_col) ;
+	}
+    }
+
+    for (r = 0 ; r < n_row ; r++)
+    {
+	if (ROW_IS_ALIVE (r))
+	{
+	    i = 0 ;
+	    len = Row [r].length ;
+	    deg = Row [r].shared1.degree ;
+	    assert (len > 0) ;
+	    assert (deg > 0) ;
+	    rp = &A [Row [r].start] ;
+	    rp_end = rp + len ;
+	    while (rp < rp_end)
+	    {
+		c = *rp++ ;
+		if (COL_IS_ALIVE (c))
+		{
+		    i++ ;
+		}
+	    }
+	    assert (i > 0) ;
+	}
+    }
+}
+
+
+/* ========================================================================== */
+/* === debug_deg_lists ====================================================== */
+/* ========================================================================== */
+
+/*
+    Prints the contents of the degree lists.  Counts the number of columns
+    in the degree list and compares it to the total it should have.  Also
+    checks the row degrees.
+*/
+
+PRIVATE void debug_deg_lists
+(
+    /* === Parameters ======================================================= */
+
+    int n_row,
+    int n_col,
+    RowInfo Row [],
+    ColInfo Col [],
+    int head [],
+    int min_score,
+    int should,
+    int max_deg
+)
+{
+    /* === Local variables ================================================== */
+
+    int deg ;
+    int col ;
+    int have ;
+    int row ;
+
+    /* === Check the degree lists =========================================== */
+
+    if (n_col > 10000 && debug_colamd <= 0)
+    {
+	return ;
+    }
+    have = 0 ;
+    DEBUG4 (("Degree lists: %d\n", min_score)) ;
+    for (deg = 0 ; deg <= n_col ; deg++)
+    {
+	col = head [deg] ;
+	if (col == EMPTY)
+	{
+	    continue ;
+	}
+	DEBUG4 (("%d:", deg)) ;
+	while (col != EMPTY)
+	{
+	    DEBUG4 ((" %d", col)) ;
+	    have += Col [col].shared1.thickness ;
+	    assert (COL_IS_ALIVE (col)) ;
+	    col = Col [col].shared4.degree_next ;
+	}
+	DEBUG4 (("\n")) ;
+    }
+    DEBUG4 (("should %d have %d\n", should, have)) ;
+    assert (should == have) ;
+
+    /* === Check the row degrees ============================================ */
+
+    if (n_row > 10000 && debug_colamd <= 0)
+    {
+	return ;
+    }
+    for (row = 0 ; row < n_row ; row++)
+    {
+	if (ROW_IS_ALIVE (row))
+	{
+	    assert (Row [row].shared1.degree <= max_deg) ;
+	}
+    }
+}
+
+
+/* ========================================================================== */
+/* === debug_mark =========================================================== */
+/* ========================================================================== */
+
+/*
+    Ensures that the tag_mark is less that the maximum and also ensures that
+    each entry in the mark array is less than the tag mark.
+*/
+
+PRIVATE void debug_mark
+(
+    /* === Parameters ======================================================= */
+
+    int n_row,
+    RowInfo Row [],
+    int tag_mark,
+    int max_mark
+)
+{
+    /* === Local variables ================================================== */
+
+    int r ;
+
+    /* === Check the Row marks ============================================== */
+
+    assert (tag_mark > 0 && tag_mark <= max_mark) ;
+    if (n_row > 10000 && debug_colamd <= 0)
+    {
+	return ;
+    }
+    for (r = 0 ; r < n_row ; r++)
+    {
+	assert (Row [r].shared2.mark < tag_mark) ;
+    }
+}
+
+
+/* ========================================================================== */
+/* === debug_matrix ========================================================= */
+/* ========================================================================== */
+
+/*
+    Prints out the contents of the columns and the rows.
+*/
+
+PRIVATE void debug_matrix
+(
+    /* === Parameters ======================================================= */
+
+    int n_row,
+    int n_col,
+    RowInfo Row [],
+    ColInfo Col [],
+    int A []
+)
+{
+    /* === Local variables ================================================== */
+
+    int r ;
+    int c ;
+    int *rp ;
+    int *rp_end ;
+    int *cp ;
+    int *cp_end ;
+
+    /* === Dump the rows and columns of the matrix ========================== */
+
+    if (debug_colamd < 3)
+    {
+	return ;
+    }
+    DEBUG3 (("DUMP MATRIX:\n")) ;
+    for (r = 0 ; r < n_row ; r++)
+    {
+	DEBUG3 (("Row %d alive? %d\n", r, ROW_IS_ALIVE (r))) ;
+	if (ROW_IS_DEAD (r))
+	{
+	    continue ;
+	}
+	DEBUG3 (("start %d length %d degree %d\n",
+		Row [r].start, Row [r].length, Row [r].shared1.degree)) ;
+	rp = &A [Row [r].start] ;
+	rp_end = rp + Row [r].length ;
+	while (rp < rp_end)
+	{
+	    c = *rp++ ;
+	    DEBUG3 (("	%d col %d\n", COL_IS_ALIVE (c), c)) ;
+	}
+    }
+
+    for (c = 0 ; c < n_col ; c++)
+    {
+	DEBUG3 (("Col %d alive? %d\n", c, COL_IS_ALIVE (c))) ;
+	if (COL_IS_DEAD (c))
+	{
+	    continue ;
+	}
+	DEBUG3 (("start %d length %d shared1 %d shared2 %d\n",
+		Col [c].start, Col [c].length,
+		Col [c].shared1.thickness, Col [c].shared2.score)) ;
+	cp = &A [Col [c].start] ;
+	cp_end = cp + Col [c].length ;
+	while (cp < cp_end)
+	{
+	    r = *cp++ ;
+	    DEBUG3 (("	%d row %d\n", ROW_IS_ALIVE (r), r)) ;
+	}
+    }
+}
+
+#endif
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/colamd.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,67 @@
+/* ========================================================================== */
+/* === colamd prototypes and definitions ==================================== */
+/* ========================================================================== */
+
+/*
+    This is the colamd include file,
+
+	http://www.cise.ufl.edu/~davis/colamd/colamd.h
+
+    for use in the colamd.c, colamdmex.c, and symamdmex.c files located at
+
+	http://www.cise.ufl.edu/~davis/colamd/
+
+    See those files for a description of colamd and symamd, and for the
+    copyright notice, which also applies to this file.
+
+    August 3, 1998.  Version 1.0.
+*/
+
+/* ========================================================================== */
+/* === Definitions ========================================================== */
+/* ========================================================================== */
+
+/* size of the knobs [ ] array.  Only knobs [0..1] are currently used. */
+#define COLAMD_KNOBS 20
+
+/* number of output statistics.  Only A [0..2] are currently used. */
+#define COLAMD_STATS 20
+
+/* knobs [0] and A [0]: dense row knob and output statistic. */
+#define COLAMD_DENSE_ROW 0
+
+/* knobs [1] and A [1]: dense column knob and output statistic. */
+#define COLAMD_DENSE_COL 1
+
+/* A [2]: memory defragmentation count output statistic */
+#define COLAMD_DEFRAG_COUNT 2
+
+/* A [3]: whether or not the input columns were jumbled or had duplicates */
+#define COLAMD_JUMBLED_COLS 3
+
+/* ========================================================================== */
+/* === Prototypes of user-callable routines ================================= */
+/* ========================================================================== */
+
+int colamd_recommended		/* returns recommended value of Alen */
+(
+    int nnz,			/* nonzeros in A */
+    int n_row,			/* number of rows in A */
+    int n_col			/* number of columns in A */
+) ;
+
+void colamd_set_defaults	/* sets default parameters */
+(				/* knobs argument is modified on output */
+    double knobs [COLAMD_KNOBS]	/* parameter settings for colamd */
+) ;
+
+int colamd			/* returns TRUE if successful, FALSE otherwise*/
+(				/* A and p arguments are modified on output */
+    int n_row,			/* number of rows in A */
+    int n_col,			/* number of columns in A */
+    int Alen,			/* size of the array A */
+    int A [],			/* row indices of A, of size Alen */
+    int p [],			/* column pointers of A, of size n_col+1 */
+    double knobs [COLAMD_KNOBS]	/* parameter settings for colamd */
+) ;
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dcolumn_bmod.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,350 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "dsp_defs.h"
+#include "util.h"
+
+/* 
+ * Function prototypes 
+ */
+void dusolve(int, int, double*, double*);
+void dlsolve(int, int, double*, double*);
+void dmatvec(int, int, int, double*, double*, double*);
+
+
+
+/* Return value:   0 - successful return
+ *               > 0 - number of bytes allocated when run out of space
+ */
+int
+dcolumn_bmod (
+	     const int  jcol,	  /* in */
+	     const int  nseg,	  /* in */
+	     double     *dense,	  /* in */
+	     double     *tempv,	  /* working array */
+	     int        *segrep,  /* in */
+	     int        *repfnz,  /* in */
+	     int        fpanelc,  /* in -- first column in the current panel */
+	     GlobalLU_t *Glu      /* modified */
+	     )
+{
+/*
+ * Purpose:
+ * ========
+ *    Performs numeric block updates (sup-col) in topological order.
+ *    It features: col-col, 2cols-col, 3cols-col, and sup-col updates.
+ *    Special processing on the supernodal portion of L\U[*,j]
+ *
+ */
+#ifdef _CRAY
+    _fcd ftcs1 = _cptofcd("L", strlen("L")),
+         ftcs2 = _cptofcd("N", strlen("N")),
+         ftcs3 = _cptofcd("U", strlen("U"));
+#endif
+    int         incx = 1, incy = 1;
+    double      alpha, beta;
+    
+    /* krep = representative of current k-th supernode
+     * fsupc = first supernodal column
+     * nsupc = no of columns in supernode
+     * nsupr = no of rows in supernode (used as leading dimension)
+     * luptr = location of supernodal LU-block in storage
+     * kfnz = first nonz in the k-th supernodal segment
+     * no_zeros = no of leading zeros in a supernodal U-segment
+     */
+    double       ukj, ukj1, ukj2;
+    int          luptr, luptr1, luptr2;
+    int          fsupc, nsupc, nsupr, segsze;
+    int          nrow;	  /* No of rows in the matrix of matrix-vector */
+    int          jcolp1, jsupno, k, ksub, krep, krep_ind, ksupno;
+    register int lptr, kfnz, isub, irow, i;
+    register int no_zeros, new_next; 
+    int          ufirst, nextlu;
+    int          fst_col; /* First column within small LU update */
+    int          d_fsupc; /* Distance between the first column of the current
+			     panel and the first column of the current snode. */
+    int          *xsup, *supno;
+    int          *lsub, *xlsub;
+    double       *lusup;
+    int          *xlusup;
+    int          nzlumax;
+    double       *tempv1;
+    double      zero = 0.0;
+    double      one = 1.0;
+    double      none = -1.0;
+    int          mem_error;
+    extern SuperLUStat_t SuperLUStat;
+    flops_t  *ops = SuperLUStat.ops;
+
+    xsup    = Glu->xsup;
+    supno   = Glu->supno;
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    lusup   = Glu->lusup;
+    xlusup  = Glu->xlusup;
+    nzlumax = Glu->nzlumax;
+    jcolp1 = jcol + 1;
+    jsupno = supno[jcol];
+    
+    /* 
+     * For each nonz supernode segment of U[*,j] in topological order 
+     */
+    k = nseg - 1;
+    for (ksub = 0; ksub < nseg; ksub++) {
+
+	krep = segrep[k];
+	k--;
+	ksupno = supno[krep];
+	if ( jsupno != ksupno ) { /* Outside the rectangular supernode */
+
+	    fsupc = xsup[ksupno];
+	    fst_col = MAX ( fsupc, fpanelc );
+
+  	    /* Distance from the current supernode to the current panel; 
+	       d_fsupc=0 if fsupc > fpanelc. */
+  	    d_fsupc = fst_col - fsupc; 
+
+	    luptr = xlusup[fst_col] + d_fsupc;
+	    lptr = xlsub[fsupc] + d_fsupc;
+
+	    kfnz = repfnz[krep];
+	    kfnz = MAX ( kfnz, fpanelc );
+
+	    segsze = krep - kfnz + 1;
+	    nsupc = krep - fst_col + 1;
+	    nsupr = xlsub[fsupc+1] - xlsub[fsupc];	/* Leading dimension */
+	    nrow = nsupr - d_fsupc - nsupc;
+	    krep_ind = lptr + nsupc - 1;
+
+	    ops[TRSV] += segsze * (segsze - 1);
+	    ops[GEMV] += 2 * nrow * segsze;
+
+
+	    /* 
+	     * Case 1: Update U-segment of size 1 -- col-col update 
+	     */
+	    if ( segsze == 1 ) {
+	  	ukj = dense[lsub[krep_ind]];
+		luptr += nsupr*(nsupc-1) + nsupc;
+
+		for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+		    irow = lsub[i];
+		    dense[irow] -=  ukj*lusup[luptr];
+		    luptr++;
+		}
+
+	    } else if ( segsze <= 3 ) {
+		ukj = dense[lsub[krep_ind]];
+		luptr += nsupr*(nsupc-1) + nsupc-1;
+		ukj1 = dense[lsub[krep_ind - 1]];
+		luptr1 = luptr - nsupr;
+
+		if ( segsze == 2 ) { /* Case 2: 2cols-col update */
+		    ukj -= ukj1 * lusup[luptr1];
+		    dense[lsub[krep_ind]] = ukj;
+		    for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+		    	irow = lsub[i];
+		    	luptr++;
+		    	luptr1++;
+		    	dense[irow] -= ( ukj*lusup[luptr]
+					+ ukj1*lusup[luptr1] );
+		    }
+		} else { /* Case 3: 3cols-col update */
+		    ukj2 = dense[lsub[krep_ind - 2]];
+		    luptr2 = luptr1 - nsupr;
+		    ukj1 -= ukj2 * lusup[luptr2-1];
+		    ukj = ukj - ukj1*lusup[luptr1] - ukj2*lusup[luptr2];
+		    dense[lsub[krep_ind]] = ukj;
+		    dense[lsub[krep_ind-1]] = ukj1;
+		    for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+		    	irow = lsub[i];
+		    	luptr++;
+		    	luptr1++;
+			luptr2++;
+		    	dense[irow] -= ( ukj*lusup[luptr]
+			     + ukj1*lusup[luptr1] + ukj2*lusup[luptr2] );
+		    }
+		}
+
+
+
+	    } else {
+	  	/*
+		 * Case: sup-col update
+		 * Perform a triangular solve and block update,
+		 * then scatter the result of sup-col update to dense
+		 */
+
+		no_zeros = kfnz - fst_col;
+
+	        /* Copy U[*,j] segment from dense[*] to tempv[*] */
+	        isub = lptr + no_zeros;
+	        for (i = 0; i < segsze; i++) {
+	  	    irow = lsub[isub];
+		    tempv[i] = dense[irow];
+		    ++isub; 
+	        }
+
+	        /* Dense triangular solve -- start effective triangle */
+		luptr += nsupr * no_zeros + no_zeros; 
+		
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		STRSV( ftcs1, ftcs2, ftcs3, &segsze, &lusup[luptr], 
+		       &nsupr, tempv, &incx );
+#else		
+		dtrsv_( "L", "N", "U", &segsze, &lusup[luptr], 
+		       &nsupr, tempv, &incx );
+#endif		
+ 		luptr += segsze;  /* Dense matrix-vector */
+		tempv1 = &tempv[segsze];
+                alpha = one;
+                beta = zero;
+#ifdef _CRAY
+		SGEMV( ftcs2, &nrow, &segsze, &alpha, &lusup[luptr], 
+		       &nsupr, tempv, &incx, &beta, tempv1, &incy );
+#else
+		dgemv_( "N", &nrow, &segsze, &alpha, &lusup[luptr], 
+		       &nsupr, tempv, &incx, &beta, tempv1, &incy );
+#endif
+#else
+		dlsolve ( nsupr, segsze, &lusup[luptr], tempv );
+
+ 		luptr += segsze;  /* Dense matrix-vector */
+		tempv1 = &tempv[segsze];
+		dmatvec (nsupr, nrow , segsze, &lusup[luptr], tempv, tempv1);
+#endif
+		
+		
+                /* Scatter tempv[] into SPA dense[] as a temporary storage */
+                isub = lptr + no_zeros;
+                for (i = 0; i < segsze; i++) {
+                    irow = lsub[isub];
+                    dense[irow] = tempv[i];
+                    tempv[i] = zero;
+                    ++isub;
+                }
+
+		/* Scatter tempv1[] into SPA dense[] */
+		for (i = 0; i < nrow; i++) {
+		    irow = lsub[isub];
+		    dense[irow] -= tempv1[i];
+		    tempv1[i] = zero;
+		    ++isub;
+		}
+	    }
+	    
+	} /* if jsupno ... */
+
+    } /* for each segment... */
+
+    /*
+     *	Process the supernodal portion of L\U[*,j]
+     */
+    nextlu = xlusup[jcol];
+    fsupc = xsup[jsupno];
+
+    /* Copy the SPA dense into L\U[*,j] */
+    new_next = nextlu + xlsub[fsupc+1] - xlsub[fsupc];
+    while ( new_next > nzlumax ) {
+	if (mem_error = dLUMemXpand(jcol, nextlu, LUSUP, &nzlumax, Glu))
+	    return (mem_error);
+	lusup = Glu->lusup;
+	lsub = Glu->lsub;
+    }
+
+    for (isub = xlsub[fsupc]; isub < xlsub[fsupc+1]; isub++) {
+  	irow = lsub[isub];
+	lusup[nextlu] = dense[irow];
+        dense[irow] = zero;
+	++nextlu;
+    }
+
+    xlusup[jcolp1] = nextlu;	/* Close L\U[*,jcol] */
+
+    /* For more updates within the panel (also within the current supernode), 
+     * should start from the first column of the panel, or the first column 
+     * of the supernode, whichever is bigger. There are 2 cases:
+     *    1) fsupc < fpanelc, then fst_col := fpanelc
+     *    2) fsupc >= fpanelc, then fst_col := fsupc
+     */
+    fst_col = MAX ( fsupc, fpanelc );
+
+    if ( fst_col < jcol ) {
+
+  	/* Distance between the current supernode and the current panel.
+	   d_fsupc=0 if fsupc >= fpanelc. */
+  	d_fsupc = fst_col - fsupc;
+
+	lptr = xlsub[fsupc] + d_fsupc;
+	luptr = xlusup[fst_col] + d_fsupc;
+	nsupr = xlsub[fsupc+1] - xlsub[fsupc];	/* Leading dimension */
+	nsupc = jcol - fst_col;	/* Excluding jcol */
+	nrow = nsupr - d_fsupc - nsupc;
+
+	/* Points to the beginning of jcol in snode L\U(jsupno) */
+	ufirst = xlusup[jcol] + d_fsupc;	
+
+	ops[TRSV] += nsupc * (nsupc - 1);
+	ops[GEMV] += 2 * nrow * nsupc;
+	
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+	STRSV( ftcs1, ftcs2, ftcs3, &nsupc, &lusup[luptr], 
+	       &nsupr, &lusup[ufirst], &incx );
+#else
+	dtrsv_( "L", "N", "U", &nsupc, &lusup[luptr], 
+	       &nsupr, &lusup[ufirst], &incx );
+#endif
+	
+	alpha = none; beta = one; /* y := beta*y + alpha*A*x */
+
+#ifdef _CRAY
+	SGEMV( ftcs2, &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr,
+	       &lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
+#else
+	dgemv_( "N", &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr,
+	       &lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
+#endif
+#else
+	dlsolve ( nsupr, nsupc, &lusup[luptr], &lusup[ufirst] );
+
+	dmatvec ( nsupr, nrow, nsupc, &lusup[luptr+nsupc],
+		&lusup[ufirst], tempv );
+	
+        /* Copy updates from tempv[*] into lusup[*] */
+	isub = ufirst + nsupc;
+	for (i = 0; i < nrow; i++) {
+	    lusup[isub] -= tempv[i];
+	    tempv[i] = 0.0;
+	    ++isub;
+	}
+
+#endif
+	
+	
+    } /* if fst_col < jcol ... */ 
+
+    return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dcolumn_dfs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,271 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "dsp_defs.h"
+#include "util.h"
+
+/* What type of supernodes we want */
+#define T2_SUPER
+
+int
+dcolumn_dfs(
+	   const int  m,         /* in - number of rows in the matrix */
+	   const int  jcol,      /* in */
+	   int        *perm_r,   /* in */
+	   int        *nseg,     /* modified - with new segments appended */
+	   int        *lsub_col, /* in - defines the RHS vector to start the dfs */
+	   int        *segrep,   /* modified - with new segments appended */
+	   int        *repfnz,   /* modified */
+	   int        *xprune,   /* modified */
+	   int        *marker,   /* modified */
+	   int        *parent,	 /* working array */
+	   int        *xplore,   /* working array */
+	   GlobalLU_t *Glu       /* modified */
+	   )
+{
+/* 
+ * Purpose
+ * =======
+ *   "column_dfs" performs a symbolic factorization on column jcol, and
+ *   decide the supernode boundary.
+ *
+ *   This routine does not use numeric values, but only use the RHS 
+ *   row indices to start the dfs.
+ *
+ *   A supernode representative is the last column of a supernode.
+ *   The nonzeros in U[*,j] are segments that end at supernodal
+ *   representatives. The routine returns a list of such supernodal 
+ *   representatives in topological order of the dfs that generates them.
+ *   The location of the first nonzero in each such supernodal segment
+ *   (supernodal entry location) is also returned.
+ *
+ * Local parameters
+ * ================
+ *   nseg: no of segments in current U[*,j]
+ *   jsuper: jsuper=NO if column j does not belong to the same
+ *	supernode as j-1. Otherwise, jsuper=nsuper.
+ *
+ *   marker2: A-row --> A-row/col (0/1)
+ *   repfnz: SuperA-col --> PA-row
+ *   parent: SuperA-col --> SuperA-col
+ *   xplore: SuperA-col --> index to L-structure
+ *
+ * Return value
+ * ============
+ *     0  success;
+ *   > 0  number of bytes allocated when run out of space.
+ *
+ */
+    int     jcolp1, jcolm1, jsuper, nsuper, nextl;
+    int     k, krep, krow, kmark, kperm;
+    int     *marker2;           /* Used for small panel LU */
+    int	    fsupc;		/* First column of a snode */
+    int     myfnz;		/* First nonz column of a U-segment */
+    int	    chperm, chmark, chrep, kchild;
+    int     xdfs, maxdfs, kpar, oldrep;
+    int     jptr, jm1ptr;
+    int     ito, ifrom, istop;	/* Used to compress row subscripts */
+    int     mem_error;
+    int     *xsup, *supno, *lsub, *xlsub;
+    int     nzlmax;
+    static  int  first = 1, maxsuper;
+    
+    xsup    = Glu->xsup;
+    supno   = Glu->supno;
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    nzlmax  = Glu->nzlmax;
+
+    if ( first ) {
+	maxsuper = sp_ienv(3);
+	first = 0;
+    }
+    jcolp1  = jcol + 1;
+    jcolm1  = jcol - 1;
+    nsuper  = supno[jcol];
+    jsuper  = nsuper;
+    nextl   = xlsub[jcol];
+    marker2 = &marker[2*m];
+
+
+    /* For each nonzero in A[*,jcol] do dfs */
+    for (k = 0; lsub_col[k] != EMPTY; k++) {
+
+	krow = lsub_col[k];
+    	lsub_col[k] = EMPTY;
+	kmark = marker2[krow];    	
+
+	/* krow was visited before, go to the next nonz */
+        if ( kmark == jcol ) continue; 
+
+	/* For each unmarked nbr krow of jcol
+	 *	krow is in L: place it in structure of L[*,jcol]
+	 */
+	marker2[krow] = jcol;
+	kperm = perm_r[krow];
+
+   	if ( kperm == EMPTY ) {
+	    lsub[nextl++] = krow; 	/* krow is indexed into A */
+	    if ( nextl >= nzlmax ) {
+		if ( mem_error = dLUMemXpand(jcol, nextl, LSUB, &nzlmax, Glu) )
+		    return (mem_error);
+		lsub = Glu->lsub;
+	    }
+            if ( kmark != jcolm1 ) jsuper = NO;	/* Row index subset testing */
+  	} else {
+	    /*	krow is in U: if its supernode-rep krep
+	     *	has been explored, update repfnz[*]
+	     */
+	    krep = xsup[supno[kperm]+1] - 1;
+	    myfnz = repfnz[krep];
+
+	    if ( myfnz != EMPTY ) {	/* Visited before */
+	    	if ( myfnz > kperm ) repfnz[krep] = kperm;
+		/* continue; */
+	    }
+	    else {
+		/* Otherwise, perform dfs starting at krep */
+		oldrep = EMPTY;
+	 	parent[krep] = oldrep;
+	  	repfnz[krep] = kperm;
+		xdfs = xlsub[krep];
+	  	maxdfs = xprune[krep];
+
+		do {
+		    /* 
+		     * For each unmarked kchild of krep 
+		     */
+		    while ( xdfs < maxdfs ) {
+
+		   	kchild = lsub[xdfs];
+			xdfs++;
+		  	chmark = marker2[kchild];
+
+		   	if ( chmark != jcol ) { /* Not reached yet */
+		   	    marker2[kchild] = jcol;
+		   	    chperm = perm_r[kchild];
+
+		   	    /* Case kchild is in L: place it in L[*,k] */
+		   	    if ( chperm == EMPTY ) {
+			    	lsub[nextl++] = kchild;
+				if ( nextl >= nzlmax ) {
+				    if ( mem_error =
+					 dLUMemXpand(jcol,nextl,LSUB,&nzlmax,Glu) )
+					return (mem_error);
+				    lsub = Glu->lsub;
+				}
+				if ( chmark != jcolm1 ) jsuper = NO;
+			    } else {
+		    	    	/* Case kchild is in U: 
+				 *   chrep = its supernode-rep. If its rep has 
+			         *   been explored, update its repfnz[*]
+			         */
+		   	    	chrep = xsup[supno[chperm]+1] - 1;
+		   		myfnz = repfnz[chrep];
+		   		if ( myfnz != EMPTY ) { /* Visited before */
+				    if ( myfnz > chperm )
+     				  	repfnz[chrep] = chperm;
+				} else {
+		        	    /* Continue dfs at super-rep of kchild */
+		   		    xplore[krep] = xdfs;	
+		   		    oldrep = krep;
+		   		    krep = chrep; /* Go deeper down G(L^t) */
+				    parent[krep] = oldrep;
+		    		    repfnz[krep] = chperm;
+		   		    xdfs = xlsub[krep];     
+				    maxdfs = xprune[krep];
+				} /* else */
+
+			   } /* else */
+
+			} /* if */
+
+		    } /* while */
+
+		    /* krow has no more unexplored nbrs;
+	   	     *    place supernode-rep krep in postorder DFS.
+	   	     *    backtrack dfs to its parent
+		     */
+		    segrep[*nseg] = krep;
+		    ++(*nseg);
+		    kpar = parent[krep]; /* Pop from stack, mimic recursion */
+		    if ( kpar == EMPTY ) break; /* dfs done */
+		    krep = kpar;
+		    xdfs = xplore[krep];
+		    maxdfs = xprune[krep];
+
+		} while ( kpar != EMPTY ); 	/* Until empty stack */
+
+	    } /* else */
+
+	} /* else */
+
+    } /* for each nonzero ... */
+
+    /* Check to see if j belongs in the same supernode as j-1 */
+    if ( jcol == 0 ) { /* Do nothing for column 0 */
+	nsuper = supno[0] = 0;
+    } else {
+   	fsupc = xsup[nsuper];
+	jptr = xlsub[jcol];	/* Not compressed yet */
+	jm1ptr = xlsub[jcolm1];
+
+#ifdef T2_SUPER
+	if ( (nextl-jptr != jptr-jm1ptr-1) ) jsuper = NO;
+#endif
+	/* Make sure the number of columns in a supernode doesn't
+	   exceed threshold. */
+	if ( jcol - fsupc >= maxsuper ) jsuper = NO;
+
+	/* If jcol starts a new supernode, reclaim storage space in
+	 * lsub from the previous supernode. Note we only store
+	 * the subscript set of the first and last columns of
+   	 * a supernode. (first for num values, last for pruning)
+	 */
+	if ( jsuper == NO ) {	/* starts a new supernode */
+	    if ( (fsupc < jcolm1-1) ) {	/* >= 3 columns in nsuper */
+#ifdef CHK_COMPRESS
+		printf("  Compress lsub[] at super %d-%d\n", fsupc, jcolm1);
+#endif
+	        ito = xlsub[fsupc+1];
+		xlsub[jcolm1] = ito;
+		istop = ito + jptr - jm1ptr;
+		xprune[jcolm1] = istop; /* Initialize xprune[jcol-1] */
+		xlsub[jcol] = istop;
+		for (ifrom = jm1ptr; ifrom < nextl; ++ifrom, ++ito)
+		    lsub[ito] = lsub[ifrom];
+		nextl = ito;            /* = istop + length(jcol) */
+	    }
+	    nsuper++;
+	    supno[jcol] = nsuper;
+	} /* if a new supernode */
+
+    }	/* else: jcol > 0 */ 
+    
+    /* Tidy up the pointers before exit */
+    xsup[nsuper+1] = jcolp1;
+    supno[jcolp1]  = nsuper;
+    xprune[jcol]   = nextl;	/* Initialize upper bound for pruning */
+    xlsub[jcolp1]  = nextl;
+
+    return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dcomplex.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,105 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * This file defines common arithmetic operations for complex type.
+ */
+#include <math.h>
+#include "dcomplex.h"
+#include "util.h"
+
+
+/* Complex Division c = a/b */
+void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b)
+{
+    double ratio, den;
+    double abr, abi, cr, ci;
+  
+    if( (abr = b->r) < 0.)
+	abr = - abr;
+    if( (abi = b->i) < 0.)
+	abi = - abi;
+    if( abr <= abi ) {
+	if (abi == 0) {
+	    ABORT("z_div.c: division by zero");
+	}	  
+	ratio = b->r / b->i ;
+	den = b->i * (1 + ratio*ratio);
+	cr = (a->r*ratio + a->i) / den;
+	ci = (a->i*ratio - a->r) / den;
+    } else {
+	ratio = b->i / b->r ;
+	den = b->r * (1 + ratio*ratio);
+	cr = (a->r + a->i*ratio) / den;
+	ci = (a->i - a->r*ratio) / den;
+    }
+    c->r = cr;
+    c->i = ci;
+}
+
+
+/* Returns sqrt(z.r^2 + z.i^2) */
+double z_abs(doublecomplex *z)
+{
+    double temp;
+    double real = z->r;
+    double imag = z->i;
+
+    if (real < 0) real = -real;
+    if (imag < 0) imag = -imag;
+    if (imag > real) {
+	temp = real;
+	real = imag;
+	imag = temp;
+    }
+    if ((real+imag) == real) return(real);
+  
+    temp = imag/real;
+    temp = real*sqrt(1.0 + temp*temp);  /*overflow!!*/
+    return (temp);
+}
+
+
+/* Approximates the abs */
+/* Returns abs(z.r) + abs(z.i) */
+double z_abs1(doublecomplex *z)
+{
+    double real = z->r;
+    double imag = z->i;
+  
+    if (real < 0) real = -real;
+    if (imag < 0) imag = -imag;
+
+    return (real + imag);
+}
+
+/* Return the exponentiation */
+void z_exp(doublecomplex *r, doublecomplex *z)
+{
+    double expx;
+
+    expx = exp(z->r);
+    r->r = expx * cos(z->i);
+    r->i = expx * sin(z->i);
+}
+
+/* Return the complex conjugate */
+void d_cnjg(doublecomplex *r, doublecomplex *z)
+{
+    r->r = z->r;
+    r->i = -z->i;
+}
+
+/* Return the imaginary part */
+double d_imag(doublecomplex *z)
+{
+    return (z->i);
+}
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dcomplex.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,68 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#ifndef __SUPERLU_DCOMPLEX /* allow multiple inclusions */
+#define __SUPERLU_DCOMPLEX
+
+/* 
+ * This header file is to be included in source files z*.c
+ */
+#ifndef DCOMPLEX_INCLUDE
+#define DCOMPLEX_INCLUDE
+
+typedef struct { double r, i; } doublecomplex;
+
+
+/* Macro definitions */
+
+/* Complex Addition c = a + b */
+#define z_add(c, a, b) { (c)->r = (a)->r + (b)->r; \
+			 (c)->i = (a)->i + (b)->i; }
+
+/* Complex Subtraction c = a - b */
+#define z_sub(c, a, b) { (c)->r = (a)->r - (b)->r; \
+			 (c)->i = (a)->i - (b)->i; }
+
+/* Complex-Double Multiplication */
+#define zd_mult(c, a, b) { (c)->r = (a)->r * (b); \
+                           (c)->i = (a)->i * (b); }
+
+/* Complex-Complex Multiplication */
+#define zz_mult(c, a, b) { \
+	double cr, ci; \
+    	cr = (a)->r * (b)->r - (a)->i * (b)->i; \
+    	ci = (a)->i * (b)->r + (a)->r * (b)->i; \
+    	(c)->r = cr; \
+    	(c)->i = ci; \
+    }
+
+/* Complex equality testing */
+#define z_eq(a, b)  ( (a)->r == (b)->r && (a)->i == (b)->i )
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* Prototypes for functions in dcomplex.c */
+void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
+double z_abs(doublecomplex *);     /* exact */
+double z_abs1(doublecomplex *);    /* approximate */
+void z_exp(doublecomplex *, doublecomplex *);
+void d_cnjg(doublecomplex *r, doublecomplex *z);
+double d_imag(doublecomplex *);
+
+
+#ifdef __cplusplus
+  }
+#endif
+
+#endif
+
+#endif  /* __SUPERLU_DCOMPLEX */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dcopy_to_ucol.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,105 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "dsp_defs.h"
+#include "util.h"
+
+int
+dcopy_to_ucol(
+	      int        jcol,	  /* in */
+	      int        nseg,	  /* in */
+	      int        *segrep,  /* in */
+	      int        *repfnz,  /* in */
+	      int        *perm_r,  /* in */
+	      double     *dense,   /* modified - reset to zero on return */
+	      GlobalLU_t *Glu      /* modified */
+	      )
+{
+/* 
+ * Gather from SPA dense[*] to global ucol[*].
+ */
+    int ksub, krep, ksupno;
+    int i, k, kfnz, segsze;
+    int fsupc, isub, irow;
+    int jsupno, nextu;
+    int new_next, mem_error;
+    int       *xsup, *supno;
+    int       *lsub, *xlsub;
+    double    *ucol;
+    int       *usub, *xusub;
+    int       nzumax;
+
+    double zero = 0.0;
+
+    xsup    = Glu->xsup;
+    supno   = Glu->supno;
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    ucol    = Glu->ucol;
+    usub    = Glu->usub;
+    xusub   = Glu->xusub;
+    nzumax  = Glu->nzumax;
+    
+    jsupno = supno[jcol];
+    nextu  = xusub[jcol];
+    k = nseg - 1;
+    for (ksub = 0; ksub < nseg; ksub++) {
+	krep = segrep[k--];
+	ksupno = supno[krep];
+
+	if ( ksupno != jsupno ) { /* Should go into ucol[] */
+	    kfnz = repfnz[krep];
+	    if ( kfnz != EMPTY ) {	/* Nonzero U-segment */
+
+	    	fsupc = xsup[ksupno];
+	        isub = xlsub[fsupc] + kfnz - fsupc;
+	        segsze = krep - kfnz + 1;
+
+		new_next = nextu + segsze;
+		while ( new_next > nzumax ) {
+		    if (mem_error = dLUMemXpand(jcol, nextu, UCOL, &nzumax, Glu))
+			return (mem_error);
+		    ucol = Glu->ucol;
+		    if (mem_error = dLUMemXpand(jcol, nextu, USUB, &nzumax, Glu))
+			return (mem_error);
+		    usub = Glu->usub;
+		    lsub = Glu->lsub;
+		}
+		
+		for (i = 0; i < segsze; i++) {
+		    irow = lsub[isub];
+		    usub[nextu] = perm_r[irow];
+		    ucol[nextu] = dense[irow];
+		    dense[irow] = zero;
+		    nextu++;
+		    isub++;
+		} 
+
+	    }
+
+	}
+
+    } /* for each segment... */
+
+    xusub[jcol + 1] = nextu;      /* Close U[*,jcol] */
+    return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dgscon.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,148 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:	dgscon.c
+ * History:     Modified from lapack routines DGECON.
+ */
+#include <math.h>
+#include "util.h"
+#include "dsp_defs.h"
+
+void
+dgscon(char *norm, SuperMatrix *L, SuperMatrix *U,
+       double anorm, double *rcond, int *info)
+{
+/*
+    Purpose   
+    =======   
+
+    DGSCON estimates the reciprocal of the condition number of a general 
+    real matrix A, in either the 1-norm or the infinity-norm, using   
+    the LU factorization computed by DGETRF.   
+
+    An estimate is obtained for norm(inv(A)), and the reciprocal of the   
+    condition number is computed as   
+       RCOND = 1 / ( norm(A) * norm(inv(A)) ).   
+
+    See supermatrix.h for the definition of 'SuperMatrix' structure.
+ 
+    Arguments   
+    =========   
+
+    NORM    (input) char*
+            Specifies whether the 1-norm condition number or the   
+            infinity-norm condition number is required:   
+            = '1' or 'O':  1-norm;   
+            = 'I':         Infinity-norm.
+	    
+    L       (input) SuperMatrix*
+            The factor L from the factorization Pr*A*Pc=L*U as computed by
+            dgstrf(). Use compressed row subscripts storage for supernodes,
+            i.e., L has types: Stype = SC, Dtype = _D, Mtype = TRLU.
+ 
+    U       (input) SuperMatrix*
+            The factor U from the factorization Pr*A*Pc=L*U as computed by
+            dgstrf(). Use column-wise storage scheme, i.e., U has types:
+            Stype = NC, Dtype = _D, Mtype = TRU.
+	    
+    ANORM   (input) double
+            If NORM = '1' or 'O', the 1-norm of the original matrix A.   
+            If NORM = 'I', the infinity-norm of the original matrix A.
+	    
+    RCOND   (output) double*
+            The reciprocal of the condition number of the matrix A,   
+            computed as RCOND = 1/(norm(A) * norm(inv(A))).
+	    
+    INFO    (output) int*
+            = 0:  successful exit   
+            < 0:  if INFO = -i, the i-th argument had an illegal value   
+
+    ===================================================================== 
+*/
+
+    /* Local variables */
+    int    kase, kase1, onenrm, i;
+    double ainvnm;
+    double *work;
+    int    *iwork;
+    extern int drscl_(int *, double *, double *, int *);
+
+    extern int dlacon_(int *, double *, double *, int *, double *, int *);
+
+    
+    /* Test the input parameters. */
+    *info = 0;
+    onenrm = *(unsigned char *)norm == '1' || lsame_(norm, "O");
+    if (! onenrm && ! lsame_(norm, "I")) *info = -1;
+    else if (L->nrow < 0 || L->nrow != L->ncol ||
+             L->Stype != SC || L->Dtype != _D || L->Mtype != TRLU)
+	 *info = -2;
+    else if (U->nrow < 0 || U->nrow != U->ncol ||
+             U->Stype != NC || U->Dtype != _D || U->Mtype != TRU) 
+	*info = -3;
+    if (*info != 0) {
+	i = -(*info);
+	xerbla_("dgscon", &i);
+	return;
+    }
+
+    /* Quick return if possible */
+    *rcond = 0.;
+    if ( L->nrow == 0 || U->nrow == 0) {
+	*rcond = 1.;
+	return;
+    }
+
+    work = doubleCalloc( 3*L->nrow );
+    iwork = intMalloc( L->nrow );
+
+
+    if ( !work || !iwork )
+	ABORT("Malloc fails for work arrays in dgscon.");
+    
+    /* Estimate the norm of inv(A). */
+    ainvnm = 0.;
+    if ( onenrm ) kase1 = 1;
+    else kase1 = 2;
+    kase = 0;
+
+    do {
+	dlacon_(&L->nrow, &work[L->nrow], &work[0], &iwork[0], &ainvnm, &kase);
+
+	if (kase == 0) break;
+
+	if (kase == kase1) {
+	    /* Multiply by inv(L). */
+	    sp_dtrsv("Lower", "No transpose", "Unit", L, U, &work[0], info);
+
+	    /* Multiply by inv(U). */
+	    sp_dtrsv("Upper", "No transpose", "Non-unit", L, U, &work[0],info);
+	    
+	} else {
+
+	    /* Multiply by inv(U'). */
+	    sp_dtrsv("Upper", "Transpose", "Non-unit", L, U, &work[0], info);
+
+	    /* Multiply by inv(L'). */
+	    sp_dtrsv("Lower", "Transpose", "Unit", L, U, &work[0], info);
+	    
+	}
+
+    } while ( kase != 0 );
+
+    /* Compute the estimate of the reciprocal condition number. */
+    if (ainvnm != 0.) *rcond = (1. / ainvnm) / anorm;
+
+    SUPERLU_FREE (work);
+    SUPERLU_FREE (iwork);
+    return;
+
+} /* dgscon */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dgsequ.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,186 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:	dgsequ.c
+ * History:     Modified from LAPACK routine DGEEQU
+ */
+#include <math.h>
+#include "dsp_defs.h"
+#include "util.h"
+
+void
+dgsequ(SuperMatrix *A, double *r, double *c, double *rowcnd,
+	double *colcnd, double *amax, int *info)
+{
+/*    
+    Purpose   
+    =======   
+
+    DGSEQU computes row and column scalings intended to equilibrate an   
+    M-by-N sparse matrix A and reduce its condition number. R returns the row
+    scale factors and C the column scale factors, chosen to try to make   
+    the largest element in each row and column of the matrix B with   
+    elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.   
+
+    R(i) and C(j) are restricted to be between SMLNUM = smallest safe   
+    number and BIGNUM = largest safe number.  Use of these scaling   
+    factors is not guaranteed to reduce the condition number of A but   
+    works well in practice.   
+
+    See supermatrix.h for the definition of 'SuperMatrix' structure.
+ 
+    Arguments   
+    =========   
+
+    A       (input) SuperMatrix*
+            The matrix of dimension (A->nrow, A->ncol) whose equilibration
+            factors are to be computed. The type of A can be:
+            Stype = NC; Dtype = _D; Mtype = GE.
+	    
+    R       (output) double*, size A->nrow
+            If INFO = 0 or INFO > M, R contains the row scale factors   
+            for A.
+	    
+    C       (output) double*, size A->ncol
+            If INFO = 0,  C contains the column scale factors for A.
+	    
+    ROWCND  (output) double*
+            If INFO = 0 or INFO > M, ROWCND contains the ratio of the   
+            smallest R(i) to the largest R(i).  If ROWCND >= 0.1 and   
+            AMAX is neither too large nor too small, it is not worth   
+            scaling by R.
+	    
+    COLCND  (output) double*
+            If INFO = 0, COLCND contains the ratio of the smallest   
+            C(i) to the largest C(i).  If COLCND >= 0.1, it is not   
+            worth scaling by C.
+	    
+    AMAX    (output) double*
+            Absolute value of largest matrix element.  If AMAX is very   
+            close to overflow or very close to underflow, the matrix   
+            should be scaled.
+	    
+    INFO    (output) int*
+            = 0:  successful exit   
+            < 0:  if INFO = -i, the i-th argument had an illegal value   
+            > 0:  if INFO = i,  and i is   
+                  <= A->nrow:  the i-th row of A is exactly zero   
+                  >  A->ncol:  the (i-M)-th column of A is exactly zero   
+
+    ===================================================================== 
+*/
+
+    /* Local variables */
+    NCformat *Astore;
+    double   *Aval;
+    int i, j, irow;
+    double rcmin, rcmax;
+    double bignum, smlnum;
+    extern double dlamch_(char *);
+    
+    /* Test the input parameters. */
+    *info = 0;
+    if ( A->nrow < 0 || A->ncol < 0 ||
+	 A->Stype != NC || A->Dtype != _D || A->Mtype != GE )
+	*info = -1;
+    if (*info != 0) {
+	i = -(*info);
+	xerbla_("dgsequ", &i);
+	return;
+    }
+
+    /* Quick return if possible */
+    if ( A->nrow == 0 || A->ncol == 0 ) {
+	*rowcnd = 1.;
+	*colcnd = 1.;
+	*amax = 0.;
+	return;
+    }
+
+    Astore = A->Store;
+    Aval = Astore->nzval;
+    
+    /* Get machine constants. */
+    smlnum = dlamch_("S");
+    bignum = 1. / smlnum;
+
+    /* Compute row scale factors. */
+    for (i = 0; i < A->nrow; ++i) r[i] = 0.;
+
+    /* Find the maximum element in each row. */
+    for (j = 0; j < A->ncol; ++j)
+	for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+	    irow = Astore->rowind[i];
+	    r[irow] = MAX( r[irow], fabs(Aval[i]) );
+	}
+
+    /* Find the maximum and minimum scale factors. */
+    rcmin = bignum;
+    rcmax = 0.;
+    for (i = 0; i < A->nrow; ++i) {
+	rcmax = MAX(rcmax, r[i]);
+	rcmin = MIN(rcmin, r[i]);
+    }
+    *amax = rcmax;
+
+    if (rcmin == 0.) {
+	/* Find the first zero scale factor and return an error code. */
+	for (i = 0; i < A->nrow; ++i)
+	    if (r[i] == 0.) {
+		*info = i + 1;
+		return;
+	    }
+    } else {
+	/* Invert the scale factors. */
+	for (i = 0; i < A->nrow; ++i)
+	    r[i] = 1. / MIN( MAX( r[i], smlnum ), bignum );
+	/* Compute ROWCND = min(R(I)) / max(R(I)) */
+	*rowcnd = MAX( rcmin, smlnum ) / MIN( rcmax, bignum );
+    }
+
+    /* Compute column scale factors */
+    for (j = 0; j < A->ncol; ++j) c[j] = 0.;
+
+    /* Find the maximum element in each column, assuming the row
+       scalings computed above. */
+    for (j = 0; j < A->ncol; ++j)
+	for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+	    irow = Astore->rowind[i];
+	    c[j] = MAX( c[j], fabs(Aval[i]) * r[irow] );
+	}
+
+    /* Find the maximum and minimum scale factors. */
+    rcmin = bignum;
+    rcmax = 0.;
+    for (j = 0; j < A->ncol; ++j) {
+	rcmax = MAX(rcmax, c[j]);
+	rcmin = MIN(rcmin, c[j]);
+    }
+
+    if (rcmin == 0.) {
+	/* Find the first zero scale factor and return an error code. */
+	for (j = 0; j < A->ncol; ++j)
+	    if ( c[j] == 0. ) {
+		*info = A->nrow + j + 1;
+		return;
+	    }
+    } else {
+	/* Invert the scale factors. */
+	for (j = 0; j < A->ncol; ++j)
+	    c[j] = 1. / MIN( MAX( c[j], smlnum ), bignum);
+	/* Compute COLCND = min(C(J)) / max(C(J)) */
+	*colcnd = MAX( rcmin, smlnum ) / MIN( rcmax, bignum );
+    }
+
+    return;
+
+} /* dgsequ */
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dgsrfs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,430 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:	dgsrfs.c
+ * History:     Modified from lapack routine DGERFS
+ */
+#include <math.h>
+#include "dsp_defs.h"
+#include "util.h"
+
+void
+dgsrfs(char *trans, SuperMatrix *A, SuperMatrix *L, SuperMatrix *U,
+       int *perm_r, int *perm_c, char *equed, double *R, double *C,
+       SuperMatrix *B, SuperMatrix *X, 
+       double *ferr, double *berr, int *info)
+{
+/*
+ *   Purpose   
+ *   =======   
+ *
+ *   DGSRFS improves the computed solution to a system of linear   
+ *   equations and provides error bounds and backward error estimates for 
+ *   the solution.   
+ *
+ *   If equilibration was performed, the system becomes:
+ *           (diag(R)*A_original*diag(C)) * X = diag(R)*B_original.
+ *
+ *   See supermatrix.h for the definition of 'SuperMatrix' structure.
+ *
+ *   Arguments   
+ *   =========   
+ *
+ *   trans   (input) char*
+ *           Specifies the form of the system of equations:   
+ *           = 'N':  A * X = B     (No transpose)   
+ *           = 'T':  A**T * X = B  (Transpose)   
+ *           = 'C':  A**H * X = B  (Conjugate transpose = Transpose)
+ *   
+ *   A       (input) SuperMatrix*
+ *           The original matrix A in the system, or the scaled A if
+ *           equilibration was done. The type of A can be:
+ *           Stype = NC, Dtype = _D, Mtype = GE.
+ *    
+ *   L       (input) SuperMatrix*
+ *	     The factor L from the factorization Pr*A*Pc=L*U. Use
+ *           compressed row subscripts storage for supernodes, 
+ *           i.e., L has types: Stype = SC, Dtype = _D, Mtype = TRLU.
+ * 
+ *   U       (input) SuperMatrix*
+ *           The factor U from the factorization Pr*A*Pc=L*U as computed by
+ *           dgstrf(). Use column-wise storage scheme, 
+ *           i.e., U has types: Stype = NC, Dtype = _D, Mtype = TRU.
+ *
+ *   perm_r  (input) int*, dimension (A->nrow)
+ *           Row permutation vector, which defines the permutation matrix Pr;
+ *           perm_r[i] = j means row i of A is in position j in Pr*A.
+ *
+ *   perm_c  (input) int*, dimension (A->ncol)
+ *	     Column permutation vector, which defines the 
+ *           permutation matrix Pc; perm_c[i] = j means column i of A is 
+ *           in position j in A*Pc.
+ *
+ *   equed   (input) Specifies the form of equilibration that was done.
+ *           = 'N': No equilibration.
+ *           = 'R': Row equilibration, i.e., A was premultiplied by diag(R).
+ *           = 'C': Column equilibration, i.e., A was postmultiplied by
+ *                  diag(C).
+ *           = 'B': Both row and column equilibration, i.e., A was replaced 
+ *                  by diag(R)*A*diag(C).
+ *
+ *   R       (input) double*, dimension (A->nrow)
+ *           The row scale factors for A.
+ *           If equed = 'R' or 'B', A is premultiplied by diag(R).
+ *           If equed = 'N' or 'C', R is not accessed.
+ * 
+ *   C       (input) double*, dimension (A->ncol)
+ *           The column scale factors for A.
+ *           If equed = 'C' or 'B', A is postmultiplied by diag(C).
+ *           If equed = 'N' or 'R', C is not accessed.
+ *
+ *   B       (input) SuperMatrix*
+ *           B has types: Stype = DN, Dtype = _D, Mtype = GE.
+ *           The right hand side matrix B.
+ *           if equed = 'R' or 'B', B is premultiplied by diag(R).
+ *
+ *   X       (input/output) SuperMatrix*
+ *           X has types: Stype = DN, Dtype = _D, Mtype = GE.
+ *           On entry, the solution matrix X, as computed by dgstrs().
+ *           On exit, the improved solution matrix X.
+ *           if *equed = 'C' or 'B', X should be premultiplied by diag(C)
+ *               in order to obtain the solution to the original system.
+ *
+ *   FERR    (output) double*, dimension (B->ncol)   
+ *           The estimated forward error bound for each solution vector   
+ *           X(j) (the j-th column of the solution matrix X).   
+ *           If XTRUE is the true solution corresponding to X(j), FERR(j) 
+ *           is an estimated upper bound for the magnitude of the largest 
+ *           element in (X(j) - XTRUE) divided by the magnitude of the   
+ *           largest element in X(j).  The estimate is as reliable as   
+ *           the estimate for RCOND, and is almost always a slight   
+ *           overestimate of the true error.
+ *
+ *   BERR    (output) double*, dimension (B->ncol)   
+ *           The componentwise relative backward error of each solution   
+ *           vector X(j) (i.e., the smallest relative change in   
+ *           any element of A or B that makes X(j) an exact solution).
+ *
+ *   info    (output) int*   
+ *           = 0:  successful exit   
+ *            < 0:  if INFO = -i, the i-th argument had an illegal value   
+ *
+ *    Internal Parameters   
+ *    ===================   
+ *
+ *    ITMAX is the maximum number of steps of iterative refinement.   
+ *
+ */  
+
+#define ITMAX 5
+    
+    /* Table of constant values */
+    int    ione = 1;
+    double ndone = -1.;
+    double done = 1.;
+    
+    /* Local variables */
+    NCformat *Astore;
+    double   *Aval;
+    SuperMatrix Bjcol;
+    DNformat *Bstore, *Xstore, *Bjcol_store;
+    double   *Bmat, *Xmat, *Bptr, *Xptr;
+    int      kase;
+    double   safe1, safe2;
+    int      i, j, k, irow, nz, count, notran, rowequ, colequ;
+    int      ldb, ldx, nrhs;
+    double   s, xk, lstres, eps, safmin;
+    char     transt[1];
+    double   *work;
+    double   *rwork;
+    int      *iwork;
+    extern double dlamch_(char *);
+    extern int dlacon_(int *, double *, double *, int *, double *, int *);
+#ifdef _CRAY
+    extern int SCOPY(int *, double *, int *, double *, int *);
+    extern int SSAXPY(int *, double *, double *, int *, double *, int *);
+#else
+    extern int dcopy_(int *, double *, int *, double *, int *);
+    extern int daxpy_(int *, double *, double *, int *, double *, int *);
+#endif
+
+    Astore = A->Store;
+    Aval   = Astore->nzval;
+    Bstore = B->Store;
+    Xstore = X->Store;
+    Bmat   = Bstore->nzval;
+    Xmat   = Xstore->nzval;
+    ldb    = Bstore->lda;
+    ldx    = Xstore->lda;
+    nrhs   = B->ncol;
+    
+    /* Test the input parameters */
+    *info = 0;
+    notran = lsame_(trans, "N");
+    if ( !notran && !lsame_(trans, "T") && !lsame_(trans, "C"))	*info = -1;
+    else if ( A->nrow != A->ncol || A->nrow < 0 ||
+	      A->Stype != NC || A->Dtype != _D || A->Mtype != GE )
+	*info = -2;
+    else if ( L->nrow != L->ncol || L->nrow < 0 ||
+ 	      L->Stype != SC || L->Dtype != _D || L->Mtype != TRLU )
+	*info = -3;
+    else if ( U->nrow != U->ncol || U->nrow < 0 ||
+ 	      U->Stype != NC || U->Dtype != _D || U->Mtype != TRU )
+	*info = -4;
+    else if ( ldb < MAX(0, A->nrow) ||
+ 	      B->Stype != DN || B->Dtype != _D || B->Mtype != GE )
+        *info = -10;
+    else if ( ldx < MAX(0, A->nrow) ||
+ 	      X->Stype != DN || X->Dtype != _D || X->Mtype != GE )
+	*info = -11;
+    if (*info != 0) {
+	i = -(*info);
+	xerbla_("dgsrfs", &i);
+	return;
+    }
+
+    /* Quick return if possible */
+    if ( A->nrow == 0 || nrhs == 0) {
+	for (j = 0; j < nrhs; ++j) {
+	    ferr[j] = 0.;
+	    berr[j] = 0.;
+	}
+	return;
+    }
+
+    rowequ = lsame_(equed, "R") || lsame_(equed, "B");
+    colequ = lsame_(equed, "C") || lsame_(equed, "B");
+    
+    /* Allocate working space */
+    work = doubleMalloc(2*A->nrow);
+    rwork = (double *) SUPERLU_MALLOC( A->nrow * sizeof(double) );
+    iwork = intMalloc(2*A->nrow);
+    if ( !work || !rwork || !iwork ) 
+        ABORT("Malloc fails for work/rwork/iwork.");
+    
+    if ( notran ) {
+	*(unsigned char *)transt = 'T';
+    } else {
+	*(unsigned char *)transt = 'N';
+    }
+
+    /* NZ = maximum number of nonzero elements in each row of A, plus 1 */
+    nz     = A->ncol + 1;
+    eps    = dlamch_("Epsilon");
+    safmin = dlamch_("Safe minimum");
+    safe1  = nz * safmin;
+    safe2  = safe1 / eps;
+
+    /* Compute the number of nonzeros in each row (or column) of A */
+    for (i = 0; i < A->nrow; ++i) iwork[i] = 0;
+    if ( notran ) {
+	for (k = 0; k < A->ncol; ++k)
+	    for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) 
+		++iwork[Astore->rowind[i]];
+    } else {
+	for (k = 0; k < A->ncol; ++k)
+	    iwork[k] = Astore->colptr[k+1] - Astore->colptr[k];
+    }	
+
+    /* Copy one column of RHS B into Bjcol. */
+    Bjcol.Stype = B->Stype;
+    Bjcol.Dtype = B->Dtype;
+    Bjcol.Mtype = B->Mtype;
+    Bjcol.nrow  = B->nrow;
+    Bjcol.ncol  = 1;
+    Bjcol.Store = (void *) SUPERLU_MALLOC( sizeof(DNformat) );
+    if ( !Bjcol.Store ) ABORT("SUPERLU_MALLOC fails for Bjcol.Store");
+    Bjcol_store = Bjcol.Store;
+    Bjcol_store->lda = ldb;
+    Bjcol_store->nzval = work; /* address aliasing */
+	
+    /* Do for each right hand side ... */
+    for (j = 0; j < nrhs; ++j) {
+	count = 0;
+	lstres = 3.;
+	Bptr = &Bmat[j*ldb];
+	Xptr = &Xmat[j*ldx];
+
+	while (1) { /* Loop until stopping criterion is satisfied. */
+
+	    /* Compute residual R = B - op(A) * X,   
+	       where op(A) = A, A**T, or A**H, depending on TRANS. */
+	    
+#ifdef _CRAY
+	    SCOPY(&A->nrow, Bptr, &ione, work, &ione);
+#else
+	    dcopy_(&A->nrow, Bptr, &ione, work, &ione);
+#endif
+	    sp_dgemv(trans, ndone, A, Xptr, ione, done, work, ione);
+
+	    /* Compute componentwise relative backward error from formula 
+	       max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )   
+	       where abs(Z) is the componentwise absolute value of the matrix
+	       or vector Z.  If the i-th component of the denominator is less
+	       than SAFE2, then SAFE1 is added to the i-th component of the   
+	       numerator and denominator before dividing. */
+
+	    for (i = 0; i < A->nrow; ++i) rwork[i] = fabs( Bptr[i] );
+	    
+	    /* Compute abs(op(A))*abs(X) + abs(B). */
+	    if (notran) {
+		for (k = 0; k < A->ncol; ++k) {
+		    xk = fabs( Xptr[k] );
+		    for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i)
+			rwork[Astore->rowind[i]] += fabs(Aval[i]) * xk;
+		}
+	    } else {
+		for (k = 0; k < A->ncol; ++k) {
+		    s = 0.;
+		    for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) {
+			irow = Astore->rowind[i];
+			s += fabs(Aval[i]) * fabs(Xptr[irow]);
+		    }
+		    rwork[k] += s;
+		}
+	    }
+	    s = 0.;
+	    for (i = 0; i < A->nrow; ++i) {
+		if (rwork[i] > safe2)
+		    s = MAX( s, fabs(work[i]) / rwork[i] );
+		else
+		    s = MAX( s, (fabs(work[i]) + safe1) / 
+				(rwork[i] + safe1) );
+	    }
+	    berr[j] = s;
+
+	    /* Test stopping criterion. Continue iterating if   
+	       1) The residual BERR(J) is larger than machine epsilon, and   
+	       2) BERR(J) decreased by at least a factor of 2 during the   
+	          last iteration, and   
+	       3) At most ITMAX iterations tried. */
+
+	    if (berr[j] > eps && berr[j] * 2. <= lstres && count < ITMAX) {
+		/* Update solution and try again. */
+		dgstrs (trans, L, U, perm_r, perm_c, &Bjcol, info);
+		
+#ifdef _CRAY
+		SAXPY(&A->nrow, &done, work, &ione,
+		       &Xmat[j*ldx], &ione);
+#else
+		daxpy_(&A->nrow, &done, work, &ione,
+		       &Xmat[j*ldx], &ione);
+#endif
+		lstres = berr[j];
+		++count;
+	    } else {
+		break;
+	    }
+        
+	} /* end while */
+
+	/* Bound error from formula:
+	   norm(X - XTRUE) / norm(X) .le. FERR = norm( abs(inv(op(A)))*   
+	   ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)   
+          where   
+            norm(Z) is the magnitude of the largest component of Z   
+            inv(op(A)) is the inverse of op(A)   
+            abs(Z) is the componentwise absolute value of the matrix or
+	       vector Z   
+            NZ is the maximum number of nonzeros in any row of A, plus 1   
+            EPS is machine epsilon   
+
+          The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))   
+          is incremented by SAFE1 if the i-th component of   
+          abs(op(A))*abs(X) + abs(B) is less than SAFE2.   
+
+          Use DLACON to estimate the infinity-norm of the matrix   
+             inv(op(A)) * diag(W),   
+          where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) */
+	
+	for (i = 0; i < A->nrow; ++i) rwork[i] = fabs( Bptr[i] );
+	
+	/* Compute abs(op(A))*abs(X) + abs(B). */
+	if ( notran ) {
+	    for (k = 0; k < A->ncol; ++k) {
+		xk = fabs( Xptr[k] );
+		for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i)
+		    rwork[Astore->rowind[i]] += fabs(Aval[i]) * xk;
+	    }
+	} else {
+	    for (k = 0; k < A->ncol; ++k) {
+		s = 0.;
+		for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) {
+		    irow = Astore->rowind[i];
+		    xk = fabs( Xptr[irow] );
+		    s += fabs(Aval[i]) * xk;
+		}
+		rwork[k] += s;
+	    }
+	}
+	
+	for (i = 0; i < A->nrow; ++i)
+	    if (rwork[i] > safe2)
+		rwork[i] = fabs(work[i]) + (iwork[i]+1)*eps*rwork[i];
+	    else
+		rwork[i] = fabs(work[i])+(iwork[i]+1)*eps*rwork[i]+safe1;
+
+	kase = 0;
+
+	do {
+	    dlacon_(&A->nrow, &work[A->nrow], work,
+		    &iwork[A->nrow], &ferr[j], &kase);
+	    if (kase == 0) break;
+
+	    if (kase == 1) {
+		/* Multiply by diag(W)*inv(op(A)**T)*(diag(C) or diag(R)). */
+		if ( notran && colequ )
+		    for (i = 0; i < A->ncol; ++i) work[i] *= C[i];
+		else if ( !notran && rowequ )
+		    for (i = 0; i < A->nrow; ++i) work[i] *= R[i];
+		
+		dgstrs (transt, L, U, perm_r, perm_c, &Bjcol, info);
+		
+		for (i = 0; i < A->nrow; ++i) work[i] *= rwork[i];
+	    } else {
+		/* Multiply by (diag(C) or diag(R))*inv(op(A))*diag(W). */
+		for (i = 0; i < A->nrow; ++i) work[i] *= rwork[i];
+		
+		dgstrs (trans, L, U, perm_r, perm_c, &Bjcol, info);
+		
+		if ( notran && colequ )
+		    for (i = 0; i < A->ncol; ++i) work[i] *= C[i];
+		else if ( !notran && rowequ )
+		    for (i = 0; i < A->ncol; ++i) work[i] *= R[i];  
+	    }
+	    
+	} while ( kase != 0 );
+
+
+	/* Normalize error. */
+	lstres = 0.;
+ 	if ( notran && colequ ) {
+	    for (i = 0; i < A->nrow; ++i)
+	    	lstres = MAX( lstres, C[i] * fabs( Xptr[i]) );
+  	} else if ( !notran && rowequ ) {
+	    for (i = 0; i < A->nrow; ++i)
+	    	lstres = MAX( lstres, R[i] * fabs( Xptr[i]) );
+	} else {
+	    for (i = 0; i < A->nrow; ++i)
+	    	lstres = MAX( lstres, fabs( Xptr[i]) );
+	}
+	if ( lstres != 0. )
+	    ferr[j] /= lstres;
+
+    } /* for each RHS j ... */
+    
+    SUPERLU_FREE(work);
+    SUPERLU_FREE(rwork);
+    SUPERLU_FREE(iwork);
+    SUPERLU_FREE(Bjcol.Store);
+
+    return;
+
+} /* dgsrfs */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dgssv.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,196 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include "dsp_defs.h"
+#include "util.h"
+
+void
+dgssv(SuperMatrix *A, int *perm_c, int *perm_r, SuperMatrix *L,
+      SuperMatrix *U, SuperMatrix *B, int *info )
+{
+/*
+ * Purpose
+ * =======
+ *
+ * DGSSV solves the system of linear equations A*X=B, using the
+ * LU factorization from DGSTRF. It performs the following steps:
+ *
+ *   1. If A is stored column-wise (A->Stype = NC):
+ *
+ *      1.1. Permute the columns of A, forming A*Pc, where Pc
+ *           is a permutation matrix. For more details of this step, 
+ *           see sp_preorder.c.
+ *
+ *      1.2. Factor A as Pr*A*Pc=L*U with the permutation Pr determined
+ *           by Gaussian elimination with partial pivoting.
+ *           L is unit lower triangular with offdiagonal entries
+ *           bounded by 1 in magnitude, and U is upper triangular.
+ *
+ *      1.3. Solve the system of equations A*X=B using the factored
+ *           form of A.
+ *
+ *   2. If A is stored row-wise (A->Stype = NR), apply the
+ *      above algorithm to the transpose of A:
+ *
+ *      2.1. Permute columns of transpose(A) (rows of A),
+ *           forming transpose(A)*Pc, where Pc is a permutation matrix. 
+ *           For more details of this step, see sp_preorder.c.
+ *
+ *      2.2. Factor A as Pr*transpose(A)*Pc=L*U with the permutation Pr
+ *           determined by Gaussian elimination with partial pivoting.
+ *           L is unit lower triangular with offdiagonal entries
+ *           bounded by 1 in magnitude, and U is upper triangular.
+ *
+ *      2.3. Solve the system of equations A*X=B using the factored
+ *           form of A.
+ *
+ *   See supermatrix.h for the definition of 'SuperMatrix' structure.
+ * 
+ * Arguments
+ * =========
+ *
+ * A       (input) SuperMatrix*
+ *         Matrix A in A*X=B, of dimension (A->nrow, A->ncol). The number
+ *         of linear equations is A->nrow. Currently, the type of A can be:
+ *         Stype = NC or NR; Dtype = _D; Mtype = GE. In the future, more
+ *         general A will be handled.
+ *
+ * perm_c  (input/output) int*
+ *         If A->Stype = NC, column permutation vector of size A->ncol
+ *         which defines the permutation matrix Pc; perm_c[i] = j means 
+ *         column i of A is in position j in A*Pc.
+ *         On exit, perm_c may be overwritten by the product of the input
+ *         perm_c and a permutation that postorders the elimination tree
+ *         of Pc'*A'*A*Pc; perm_c is not changed if the elimination tree
+ *         is already in postorder.
+ *
+ *         If A->Stype = NR, column permutation vector of size A->nrow
+ *         which describes permutation of columns of transpose(A) 
+ *         (rows of A) as described above.
+ * 
+ * perm_r  (output) int*
+ *         If A->Stype = NC, row permutation vector of size A->nrow, 
+ *         which defines the permutation matrix Pr, and is determined 
+ *         by partial pivoting.  perm_r[i] = j means row i of A is in 
+ *         position j in Pr*A.
+ *
+ *         If A->Stype = NR, permutation vector of size A->ncol, which
+ *         determines permutation of rows of transpose(A)
+ *         (columns of A) as described above.
+ *
+ * L       (output) SuperMatrix*
+ *         The factor L from the factorization 
+ *             Pr*A*Pc=L*U              (if A->Stype = NC) or
+ *             Pr*transpose(A)*Pc=L*U   (if A->Stype = NR).
+ *         Uses compressed row subscripts storage for supernodes, i.e.,
+ *         L has types: Stype = SC, Dtype = _D, Mtype = TRLU.
+ *         
+ * U       (output) SuperMatrix*
+ *	   The factor U from the factorization 
+ *             Pr*A*Pc=L*U              (if A->Stype = NC) or
+ *             Pr*transpose(A)*Pc=L*U   (if A->Stype = NR).
+ *         Uses column-wise storage scheme, i.e., U has types:
+ *         Stype = NC, Dtype = _D, Mtype = TRU.
+ *
+ * B       (input/output) SuperMatrix*
+ *         B has types: Stype = DN, Dtype = _D, Mtype = GE.
+ *         On entry, the right hand side matrix.
+ *         On exit, the solution matrix if info = 0;
+ *
+ * info    (output) int*
+ *	   = 0: successful exit
+ *         > 0: if info = i, and i is
+ *             <= A->ncol: U(i,i) is exactly zero. The factorization has
+ *                been completed, but the factor U is exactly singular,
+ *                so the solution could not be computed.
+ *             > A->ncol: number of bytes allocated when memory allocation
+ *                failure occurred, plus A->ncol.
+ *   
+ */
+    double   t1;	/* Temporary time */
+    char     refact[1], trans[1];
+    DNformat *Bstore;
+    SuperMatrix *AA; /* A in NC format used by the factorization routine.*/
+    SuperMatrix AC; /* Matrix postmultiplied by Pc */
+    int      lwork = 0, *etree, i;
+    
+    /* Set default values for some parameters */
+    double   diag_pivot_thresh = 1.0;
+    double   drop_tol = 0;
+    int      panel_size;     /* panel size */
+    int      relax;          /* no of columns in a relaxed snodes */
+    double   *utime;
+    extern SuperLUStat_t SuperLUStat;
+
+    /* Test the input parameters ... */
+    *info = 0;
+    Bstore = B->Store;
+    if ( A->nrow != A->ncol || A->nrow < 0 ||
+	 (A->Stype != NC && A->Stype != NR) ||
+	 A->Dtype != _D || A->Mtype != GE )
+	*info = -1;
+    else if ( B->ncol < 0 || Bstore->lda < MAX(0, A->nrow) ||
+	B->Stype != DN || B->Dtype != _D || B->Mtype != GE )
+	*info = -6;
+    if ( *info != 0 ) {
+	i = -(*info);
+	xerbla_("dgssv", &i);
+	return;
+    }
+    
+    *refact = 'N';
+    *trans = 'N';
+    panel_size = sp_ienv(1);
+    relax = sp_ienv(2);
+
+    StatInit(panel_size, relax);
+    utime = SuperLUStat.utime;
+ 
+    /* Convert A to NC format when necessary. */
+    if ( A->Stype == NR ) {
+	NRformat *Astore = A->Store;
+	AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
+	dCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz, 
+			       Astore->nzval, Astore->colind, Astore->rowptr,
+			       NC, A->Dtype, A->Mtype);
+	*trans = 'T';
+    } else if ( A->Stype == NC ) AA = A;
+
+    etree = intMalloc(A->ncol);
+
+    t1 = SuperLU_timer_();
+    sp_preorder(refact, AA, perm_c, etree, &AC);
+    utime[ETREE] = SuperLU_timer_() - t1;
+
+    /*printf("Factor PA = LU ... relax %d\tw %d\tmaxsuper %d\trowblk %d\n", 
+	  relax, panel_size, sp_ienv(3), sp_ienv(4));*/
+    t1 = SuperLU_timer_(); 
+    /* Compute the LU factorization of A. */
+    dgstrf(refact, &AC, diag_pivot_thresh, drop_tol, relax, panel_size,
+	   etree, NULL, lwork, perm_r, perm_c, L, U, info);
+    utime[FACT] = SuperLU_timer_() - t1;
+
+    t1 = SuperLU_timer_();
+    if ( *info == 0 ) {
+        /* Solve the system A*X=B, overwriting B with X. */
+        dgstrs (trans, L, U, perm_r, perm_c, B, info);
+    }
+    utime[SOLVE] = SuperLU_timer_() - t1;
+
+    SUPERLU_FREE (etree);
+    Destroy_CompCol_Permuted(&AC);
+    if ( A->Stype == NR ) {
+	Destroy_SuperMatrix_Store(AA);
+	SUPERLU_FREE(AA);
+    }
+
+    PrintStat( &SuperLUStat );
+    StatFree();
+
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dgssvx.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,624 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include "dsp_defs.h"
+#include "util.h"
+
+void
+dgssvx(char *fact, char *trans, char *refact,
+       SuperMatrix *A, factor_param_t *factor_params, int *perm_c,
+       int *perm_r, int *etree, char *equed, double *R, double *C,
+       SuperMatrix *L, SuperMatrix *U, void *work, int lwork,
+       SuperMatrix *B, SuperMatrix *X, double *recip_pivot_growth, 
+       double *rcond, double *ferr, double *berr, 
+       mem_usage_t *mem_usage, int *info )
+{
+/*
+ * Purpose
+ * =======
+ *
+ * DGSSVX solves the system of linear equations A*X=B or A'*X=B, using
+ * the LU factorization from dgstrf(). Error bounds on the solution and
+ * a condition estimate are also provided. It performs the following steps:
+ *
+ *   1. If A is stored column-wise (A->Stype = NC):
+ *  
+ *      1.1. If fact = 'E', scaling factors are computed to equilibrate the
+ *           system:
+ *             trans = 'N':  diag(R)*A*diag(C)     *inv(diag(C))*X = diag(R)*B
+ *             trans = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
+ *             trans = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
+ *           Whether or not the system will be equilibrated depends on the
+ *           scaling of the matrix A, but if equilibration is used, A is
+ *           overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if trans='N')
+ *           or diag(C)*B (if trans = 'T' or 'C').
+ *
+ *      1.2. Permute columns of A, forming A*Pc, where Pc is a permutation
+ *           matrix that usually preserves sparsity.
+ *           For more details of this step, see sp_preorder.c.
+ *
+ *      1.3. If fact = 'N' or 'E', the LU decomposition is used to factor the
+ *           matrix A (after equilibration if fact = 'E') as Pr*A*Pc = L*U,
+ *           with Pr determined by partial pivoting.
+ *
+ *      1.4. Compute the reciprocal pivot growth factor.
+ *
+ *      1.5. If some U(i,i) = 0, so that U is exactly singular, then the
+ *           routine returns with info = i. Otherwise, the factored form of 
+ *           A is used to estimate the condition number of the matrix A. If
+ *           the reciprocal of the condition number is less than machine
+ *           precision, info = A->ncol+1 is returned as a warning, but the
+ *           routine still goes on to solve for X and computes error bounds
+ *           as described below.
+ *
+ *      1.6. The system of equations is solved for X using the factored form
+ *           of A.
+ *
+ *      1.7. Iterative refinement is applied to improve the computed solution
+ *           matrix and calculate error bounds and backward error estimates
+ *           for it.
+ *
+ *      1.8. If equilibration was used, the matrix X is premultiplied by
+ *           diag(C) (if trans = 'N') or diag(R) (if trans = 'T' or 'C') so
+ *           that it solves the original system before equilibration.
+ *
+ *   2. If A is stored row-wise (A->Stype = NR), apply the above algorithm
+ *      to the transpose of A:
+ *
+ *      2.1. If fact = 'E', scaling factors are computed to equilibrate the
+ *           system:
+ *             trans = 'N':  diag(R)*A'*diag(C)     *inv(diag(C))*X = diag(R)*B
+ *             trans = 'T': (diag(R)*A'*diag(C))**T *inv(diag(R))*X = diag(C)*B
+ *             trans = 'C': (diag(R)*A'*diag(C))**H *inv(diag(R))*X = diag(C)*B
+ *           Whether or not the system will be equilibrated depends on the
+ *           scaling of the matrix A, but if equilibration is used, A' is
+ *           overwritten by diag(R)*A'*diag(C) and B by diag(R)*B 
+ *           (if trans='N') or diag(C)*B (if trans = 'T' or 'C').
+ *
+ *      2.2. Permute columns of transpose(A) (rows of A), 
+ *           forming transpose(A)*Pc, where Pc is a permutation matrix that 
+ *           usually preserves sparsity.
+ *           For more details of this step, see sp_preorder.c.
+ *
+ *      2.3. If fact = 'N' or 'E', the LU decomposition is used to factor the
+ *           transpose(A) (after equilibration if fact = 'E') as 
+ *           Pr*transpose(A)*Pc = L*U with the permutation Pr determined by
+ *           partial pivoting.
+ *
+ *      2.4. Compute the reciprocal pivot growth factor.
+ *
+ *      2.5. If some U(i,i) = 0, so that U is exactly singular, then the
+ *           routine returns with info = i. Otherwise, the factored form 
+ *           of transpose(A) is used to estimate the condition number of the
+ *           matrix A. If the reciprocal of the condition number
+ *           is less than machine precision, info = A->nrow+1 is returned as
+ *           a warning, but the routine still goes on to solve for X and
+ *           computes error bounds as described below.
+ *
+ *      2.6. The system of equations is solved for X using the factored form
+ *           of transpose(A).
+ *
+ *      2.7. Iterative refinement is applied to improve the computed solution
+ *           matrix and calculate error bounds and backward error estimates
+ *           for it.
+ *
+ *      2.8. If equilibration was used, the matrix X is premultiplied by
+ *           diag(C) (if trans = 'N') or diag(R) (if trans = 'T' or 'C') so
+ *           that it solves the original system before equilibration.
+ *
+ *   See supermatrix.h for the definition of 'SuperMatrix' structure.
+ *
+ * Arguments
+ * =========
+ *
+ * fact    (input) char*
+ *         Specifies whether or not the factored form of the matrix
+ *         A is supplied on entry, and if not, whether the matrix A should
+ *         be equilibrated before it is factored.
+ *         = 'F': On entry, L, U, perm_r and perm_c contain the factored
+ *                form of A. If equed is not 'N', the matrix A has been
+ *                equilibrated with scaling factors R and C.
+ *                A, L, U, perm_r are not modified.
+ *         = 'N': The matrix A will be factored, and the factors will be
+ *                stored in L and U.
+ *         = 'E': The matrix A will be equilibrated if necessary, then
+ *                factored into L and U.
+ *
+ * trans   (input) char*
+ *         Specifies the form of the system of equations:
+ *         = 'N': A * X = B        (No transpose)
+ *         = 'T': A**T * X = B     (Transpose)
+ *         = 'C': A**H * X = B     (Transpose)
+ *
+ * refact  (input) char*
+ *         Specifies whether we want to re-factor the matrix.
+ *         = 'N': Factor the matrix A.
+ *         = 'Y': Matrix A was factored before, now we want to re-factor
+ *                matrix A with perm_r and etree as inputs. Use
+ *                the same storage for the L\U factors previously allocated,
+ *                expand it if necessary. User should insure to use the same
+ *                memory model.
+ *         If fact = 'F', then refact is not accessed.
+ *
+ * A       (input/output) SuperMatrix*
+ *         Matrix A in A*X=B, of dimension (A->nrow, A->ncol). The number
+ *         of the linear equations is A->nrow. Currently, the type of A can be:
+ *         Stype = NC or NR, Dtype = _D, Mtype = GE. In the future,
+ *         more general A can be handled.
+ *
+ *         On entry, If fact = 'F' and equed is not 'N', then A must have
+ *         been equilibrated by the scaling factors in R and/or C.  
+ *         A is not modified if fact = 'F' or 'N', or if fact = 'E' and 
+ *         equed = 'N' on exit.
+ *
+ *         On exit, if fact = 'E' and equed is not 'N', A is scaled as follows:
+ *         If A->Stype = NC:
+ *           equed = 'R':  A := diag(R) * A
+ *           equed = 'C':  A := A * diag(C)
+ *           equed = 'B':  A := diag(R) * A * diag(C).
+ *         If A->Stype = NR:
+ *           equed = 'R':  transpose(A) := diag(R) * transpose(A)
+ *           equed = 'C':  transpose(A) := transpose(A) * diag(C)
+ *           equed = 'B':  transpose(A) := diag(R) * transpose(A) * diag(C).
+ *
+ * factor_params (input) factor_param_t*
+ *         The structure defines the input scalar parameters, consisting of
+ *         the following fields. If factor_params = NULL, the default
+ *         values are used for all the fields; otherwise, the values
+ *         are given by the user.
+ *         - panel_size (int): Panel size. A panel consists of at most
+ *             panel_size consecutive columns. If panel_size = -1, use 
+ *             default value 8.
+ *         - relax (int): To control degree of relaxing supernodes. If the
+ *             number of nodes (columns) in a subtree of the elimination
+ *             tree is less than relax, this subtree is considered as one
+ *             supernode, regardless of the row structures of those columns.
+ *             If relax = -1, use default value 8.
+ *         - diag_pivot_thresh (double): Diagonal pivoting threshold.
+ *             At step j of the Gaussian elimination, if
+ *                 abs(A_jj) >= diag_pivot_thresh * (max_(i>=j) abs(A_ij)),
+ *             then use A_jj as pivot. 0 <= diag_pivot_thresh <= 1.
+ *             If diag_pivot_thresh = -1, use default value 1.0,
+ *             which corresponds to standard partial pivoting.
+ *         - drop_tol (double): Drop tolerance threshold. (NOT IMPLEMENTED)
+ *             At step j of the Gaussian elimination, if
+ *                 abs(A_ij)/(max_i abs(A_ij)) < drop_tol,
+ *             then drop entry A_ij. 0 <= drop_tol <= 1.
+ *             If drop_tol = -1, use default value 0.0, which corresponds to
+ *             standard Gaussian elimination.
+ *
+ * perm_c  (input/output) int*
+ *	   If A->Stype = NC, Column permutation vector of size A->ncol,
+ *         which defines the permutation matrix Pc; perm_c[i] = j means
+ *         column i of A is in position j in A*Pc.
+ *         On exit, perm_c may be overwritten by the product of the input
+ *         perm_c and a permutation that postorders the elimination tree
+ *         of Pc'*A'*A*Pc; perm_c is not changed if the elimination tree
+ *         is already in postorder.
+ *
+ *         If A->Stype = NR, column permutation vector of size A->nrow,
+ *         which describes permutation of columns of transpose(A) 
+ *         (rows of A) as described above.
+ * 
+ * perm_r  (input/output) int*
+ *         If A->Stype = NC, row permutation vector of size A->nrow, 
+ *         which defines the permutation matrix Pr, and is determined
+ *         by partial pivoting.  perm_r[i] = j means row i of A is in 
+ *         position j in Pr*A.
+ *
+ *         If A->Stype = NR, permutation vector of size A->ncol, which
+ *         determines permutation of rows of transpose(A)
+ *         (columns of A) as described above.
+ *
+ *         If refact is not 'Y', perm_r is output argument;
+ *         If refact = 'Y', the pivoting routine will try to use the input
+ *         perm_r, unless a certain threshold criterion is violated.
+ *         In that case, perm_r is overwritten by a new permutation
+ *         determined by partial pivoting or diagonal threshold pivoting.
+ * 
+ * etree   (input/output) int*,  dimension (A->ncol)
+ *         Elimination tree of Pc'*A'*A*Pc.
+ *         If fact is not 'F' and refact = 'Y', etree is an input argument,
+ *         otherwise it is an output argument.
+ *         Note: etree is a vector of parent pointers for a forest whose
+ *         vertices are the integers 0 to A->ncol-1; etree[root]==A->ncol.
+ *
+ * equed   (input/output) char*
+ *         Specifies the form of equilibration that was done.
+ *         = 'N': No equilibration.
+ *         = 'R': Row equilibration, i.e., A was premultiplied by diag(R).
+ *         = 'C': Column equilibration, i.e., A was postmultiplied by diag(C).
+ *         = 'B': Both row and column equilibration, i.e., A was replaced 
+ *                by diag(R)*A*diag(C).
+ *         If fact = 'F', equed is an input argument, otherwise it is
+ *         an output argument.
+ *
+ * R       (input/output) double*, dimension (A->nrow)
+ *         The row scale factors for A or transpose(A).
+ *         If equed = 'R' or 'B', A (if A->Stype = NC) or transpose(A) (if
+ *             A->Stype = NR) is multiplied on the left by diag(R).
+ *         If equed = 'N' or 'C', R is not accessed.
+ *         If fact = 'F', R is an input argument; otherwise, R is output.
+ *         If fact = 'F' and equed = 'R' or 'B', each element of R must
+ *            be positive.
+ * 
+ * C       (input/output) double*, dimension (A->ncol)
+ *         The column scale factors for A or transpose(A).
+ *         If equed = 'C' or 'B', A (if A->Stype = NC) or transpose(A) (if 
+ *             A->Stype = NR) is multiplied on the right by diag(C).
+ *         If equed = 'N' or 'R', C is not accessed.
+ *         If fact = 'F', C is an input argument; otherwise, C is output.
+ *         If fact = 'F' and equed = 'C' or 'B', each element of C must
+ *            be positive.
+ *         
+ * L       (output) SuperMatrix*
+ *	   The factor L from the factorization
+ *             Pr*A*Pc=L*U              (if A->Stype = NC) or
+ *             Pr*transpose(A)*Pc=L*U   (if A->Stype = NR).
+ *         Uses compressed row subscripts storage for supernodes, i.e.,
+ *         L has types: Stype = SC, Dtype = _D, Mtype = TRLU.
+ *
+ * U       (output) SuperMatrix*
+ *	   The factor U from the factorization
+ *             Pr*A*Pc=L*U              (if A->Stype = NC) or
+ *             Pr*transpose(A)*Pc=L*U   (if A->Stype = NR).
+ *         Uses column-wise storage scheme, i.e., U has types:
+ *         Stype = NC, Dtype = _D, Mtype = TRU.
+ *
+ * work    (workspace/output) void*, size (lwork) (in bytes)
+ *         User supplied workspace, should be large enough
+ *         to hold data structures for factors L and U.
+ *         On exit, if fact is not 'F', L and U point to this array.
+ *
+ * lwork   (input) int
+ *         Specifies the size of work array in bytes.
+ *         = 0:  allocate space internally by system malloc;
+ *         > 0:  use user-supplied work array of length lwork in bytes,
+ *               returns error if space runs out.
+ *         = -1: the routine guesses the amount of space needed without
+ *               performing the factorization, and returns it in
+ *               mem_usage->total_needed; no other side effects.
+ *
+ *         See argument 'mem_usage' for memory usage statistics.
+ *
+ * B       (input/output) SuperMatrix*
+ *         B has types: Stype = DN, Dtype = _D, Mtype = GE.
+ *         On entry, the right hand side matrix.
+ *         On exit,
+ *            if equed = 'N', B is not modified; otherwise
+ *            if A->Stype = NC:
+ *               if trans = 'N' and equed = 'R' or 'B', B is overwritten by
+ *                  diag(R)*B;
+ *               if trans = 'T' or 'C' and equed = 'C' of 'B', B is
+ *                  overwritten by diag(C)*B;
+ *            if A->Stype = NR:
+ *               if trans = 'N' and equed = 'C' or 'B', B is overwritten by
+ *                  diag(C)*B;
+ *               if trans = 'T' or 'C' and equed = 'R' of 'B', B is
+ *                  overwritten by diag(R)*B.
+ *
+ * X       (output) SuperMatrix*
+ *         X has types: Stype = DN, Dtype = _D, Mtype = GE. 
+ *         If info = 0 or info = A->ncol+1, X contains the solution matrix
+ *         to the original system of equations. Note that A and B are modified
+ *         on exit if equed is not 'N', and the solution to the equilibrated
+ *         system is inv(diag(C))*X if trans = 'N' and equed = 'C' or 'B',
+ *         or inv(diag(R))*X if trans = 'T' or 'C' and equed = 'R' or 'B'.
+ *
+ * recip_pivot_growth (output) double*
+ *         The reciprocal pivot growth factor max_j( norm(A_j)/norm(U_j) ).
+ *         The infinity norm is used. If recip_pivot_growth is much less
+ *         than 1, the stability of the LU factorization could be poor.
+ *
+ * rcond   (output) double*
+ *         The estimate of the reciprocal condition number of the matrix A
+ *         after equilibration (if done). If rcond is less than the machine
+ *         precision (in particular, if rcond = 0), the matrix is singular
+ *         to working precision. This condition is indicated by a return
+ *         code of info > 0.
+ *
+ * FERR    (output) double*, dimension (B->ncol)   
+ *         The estimated forward error bound for each solution vector   
+ *         X(j) (the j-th column of the solution matrix X).   
+ *         If XTRUE is the true solution corresponding to X(j), FERR(j) 
+ *         is an estimated upper bound for the magnitude of the largest 
+ *         element in (X(j) - XTRUE) divided by the magnitude of the   
+ *         largest element in X(j).  The estimate is as reliable as   
+ *         the estimate for RCOND, and is almost always a slight   
+ *         overestimate of the true error.
+ *
+ * BERR    (output) double*, dimension (B->ncol)
+ *         The componentwise relative backward error of each solution   
+ *         vector X(j) (i.e., the smallest relative change in   
+ *         any element of A or B that makes X(j) an exact solution).
+ *
+ * mem_usage (output) mem_usage_t*
+ *         Record the memory usage statistics, consisting of following fields:
+ *         - for_lu (float)
+ *           The amount of space used in bytes for L\U data structures.
+ *         - total_needed (float)
+ *           The amount of space needed in bytes to perform factorization.
+ *         - expansions (int)
+ *           The number of memory expansions during the LU factorization.
+ *
+ * info    (output) int*
+ *         = 0: successful exit   
+ *         < 0: if info = -i, the i-th argument had an illegal value   
+ *         > 0: if info = i, and i is   
+ *              <= A->ncol: U(i,i) is exactly zero. The factorization has   
+ *                    been completed, but the factor U is exactly   
+ *                    singular, so the solution and error bounds   
+ *                    could not be computed.   
+ *              = A->ncol+1: U is nonsingular, but RCOND is less than machine
+ *                    precision, meaning that the matrix is singular to
+ *                    working precision. Nevertheless, the solution and
+ *                    error bounds are computed because there are a number
+ *                    of situations where the computed solution can be more
+ *                    accurate than the value of RCOND would suggest.   
+ *              > A->ncol+1: number of bytes allocated when memory allocation
+ *                    failure occurred, plus A->ncol.
+ *
+ */
+
+    DNformat  *Bstore, *Xstore;
+    double    *Bmat, *Xmat;
+    int       ldb, ldx, nrhs;
+    SuperMatrix *AA; /* A in NC format used by the factorization routine.*/
+    SuperMatrix AC; /* Matrix postmultiplied by Pc */
+    int       colequ, equil, nofact, notran, rowequ;
+    char      trant[1], norm[1];
+    int       i, j, info1;
+    double    amax, anorm, bignum, smlnum, colcnd, rowcnd, rcmax, rcmin;
+    int       relax, panel_size;
+    double    diag_pivot_thresh, drop_tol;
+    double    t0;      /* temporary time */
+    double    *utime;
+    extern SuperLUStat_t SuperLUStat;
+
+    /* External functions */
+    extern double dlangs(char *, SuperMatrix *);
+    extern double dlamch_(char *);
+
+    Bstore = B->Store;
+    Xstore = X->Store;
+    Bmat   = Bstore->nzval;
+    Xmat   = Xstore->nzval;
+    ldb    = Bstore->lda;
+    ldx    = Xstore->lda;
+    nrhs   = B->ncol;
+
+#if 0
+printf("dgssvx: fact=%c, trans=%c, refact=%c, equed=%c\n",
+       *fact, *trans, *refact, *equed);
+#endif
+    
+    *info = 0;
+    nofact = lsame_(fact, "N");
+    equil = lsame_(fact, "E");
+    notran = lsame_(trans, "N");
+    if (nofact || equil) {
+	*(unsigned char *)equed = 'N';
+	rowequ = FALSE;
+	colequ = FALSE;
+    } else {
+	rowequ = lsame_(equed, "R") || lsame_(equed, "B");
+	colequ = lsame_(equed, "C") || lsame_(equed, "B");
+	smlnum = dlamch_("Safe minimum");
+	bignum = 1. / smlnum;
+    }
+
+    /* Test the input parameters */
+    if (!nofact && !equil && !lsame_(fact, "F")) *info = -1;
+    else if (!notran && !lsame_(trans, "T") && !lsame_(trans, "C")) *info = -2;
+    else if ( !(lsame_(refact,"Y") || lsame_(refact, "N")) ) *info = -3;
+    else if ( A->nrow != A->ncol || A->nrow < 0 ||
+	      (A->Stype != NC && A->Stype != NR) ||
+	      A->Dtype != _D || A->Mtype != GE )
+	*info = -4;
+    else if (lsame_(fact, "F") && !(rowequ || colequ || lsame_(equed, "N")))
+	*info = -9;
+    else {
+	if (rowequ) {
+	    rcmin = bignum;
+	    rcmax = 0.;
+	    for (j = 0; j < A->nrow; ++j) {
+		rcmin = MIN(rcmin, R[j]);
+		rcmax = MAX(rcmax, R[j]);
+	    }
+	    if (rcmin <= 0.) *info = -10;
+	    else if ( A->nrow > 0)
+		rowcnd = MAX(rcmin,smlnum) / MIN(rcmax,bignum);
+	    else rowcnd = 1.;
+	}
+	if (colequ && *info == 0) {
+	    rcmin = bignum;
+	    rcmax = 0.;
+	    for (j = 0; j < A->nrow; ++j) {
+		rcmin = MIN(rcmin, C[j]);
+		rcmax = MAX(rcmax, C[j]);
+	    }
+	    if (rcmin <= 0.) *info = -11;
+	    else if (A->nrow > 0)
+		colcnd = MAX(rcmin,smlnum) / MIN(rcmax,bignum);
+	    else colcnd = 1.;
+	}
+	if (*info == 0) {
+	    if ( lwork < -1 ) *info = -15;
+	    else if ( B->ncol < 0 || Bstore->lda < MAX(0, A->nrow) ||
+		      B->Stype != DN || B->Dtype != _D || 
+		      B->Mtype != GE )
+		*info = -16;
+	    else if ( X->ncol < 0 || Xstore->lda < MAX(0, A->nrow) ||
+		      B->ncol != X->ncol || X->Stype != DN ||
+		      X->Dtype != _D || X->Mtype != GE )
+		*info = -17;
+	}
+    }
+    if (*info != 0) {
+	i = -(*info);
+	xerbla_("dgssvx", &i);
+	return;
+    }
+    
+    /* Default values for factor_params */
+    panel_size = sp_ienv(1);
+    relax      = sp_ienv(2);
+    diag_pivot_thresh = 1.0;
+    drop_tol   = 0.0;
+    if ( factor_params != NULL ) {
+	if ( factor_params->panel_size != -1 )
+	    panel_size = factor_params->panel_size;
+	if ( factor_params->relax != -1 ) relax = factor_params->relax;
+	if ( factor_params->diag_pivot_thresh != -1 )
+	    diag_pivot_thresh = factor_params->diag_pivot_thresh;
+	if ( factor_params->drop_tol != -1 )
+	    drop_tol = factor_params->drop_tol;
+    }
+
+    StatInit(panel_size, relax);
+    utime = SuperLUStat.utime;
+    
+    /* Convert A to NC format when necessary. */
+    if ( A->Stype == NR ) {
+	NRformat *Astore = A->Store;
+	AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
+	dCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz, 
+			       Astore->nzval, Astore->colind, Astore->rowptr,
+			       NC, A->Dtype, A->Mtype);
+	if ( notran ) { /* Reverse the transpose argument. */
+	    *trant = 'T';
+	    notran = 0;
+	} else {
+	    *trant = 'N';
+	    notran = 1;
+	}
+    } else { /* A->Stype == NC */
+	*trant = *trans;
+	AA = A;
+    }
+
+    if ( equil ) {
+	t0 = SuperLU_timer_();
+	/* Compute row and column scalings to equilibrate the matrix A. */
+	dgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);
+	
+	if ( info1 == 0 ) {
+	    /* Equilibrate matrix A. */
+	    dlaqgs(AA, R, C, rowcnd, colcnd, amax, equed);
+	    rowequ = lsame_(equed, "R") || lsame_(equed, "B");
+	    colequ = lsame_(equed, "C") || lsame_(equed, "B");
+	}
+	utime[EQUIL] = SuperLU_timer_() - t0;
+    }
+
+    /* Scale the right hand side if equilibration was performed. */
+    if ( notran ) {
+	if ( rowequ ) {
+	    for (j = 0; j < nrhs; ++j)
+		for (i = 0; i < A->nrow; ++i) {
+		  Bmat[i + j*ldb] *= R[i];
+	        }
+	}
+    } else if ( colequ ) {
+	for (j = 0; j < nrhs; ++j)
+	    for (i = 0; i < A->nrow; ++i) {
+	      Bmat[i + j*ldb] *= C[i];
+	    }
+    }
+
+    if ( nofact || equil ) {
+	
+	t0 = SuperLU_timer_();
+	sp_preorder(refact, AA, perm_c, etree, &AC);
+	utime[ETREE] = SuperLU_timer_() - t0;
+    
+/*	printf("Factor PA = LU ... relax %d\tw %d\tmaxsuper %d\trowblk %d\n", 
+	       relax, panel_size, sp_ienv(3), sp_ienv(4));
+	fflush(stdout); */
+	
+	/* Compute the LU factorization of A*Pc. */
+	t0 = SuperLU_timer_();
+	dgstrf(refact, &AC, diag_pivot_thresh, drop_tol, relax, panel_size,
+	       etree, work, lwork, perm_r, perm_c, L, U, info);
+	utime[FACT] = SuperLU_timer_() - t0;
+	
+	if ( lwork == -1 ) {
+	    mem_usage->total_needed = *info - A->ncol;
+	    return;
+	}
+    }
+
+    if ( *info > 0 ) {
+	if ( *info <= A->ncol ) {
+	    /* Compute the reciprocal pivot growth factor of the leading
+	       rank-deficient *info columns of A. */
+	    *recip_pivot_growth = dPivotGrowth(*info, AA, perm_c, L, U);
+	}
+	return;
+    }
+
+    /* Compute the reciprocal pivot growth factor *recip_pivot_growth. */
+    *recip_pivot_growth = dPivotGrowth(A->ncol, AA, perm_c, L, U);
+
+    /* Estimate the reciprocal of the condition number of A. */
+    t0 = SuperLU_timer_();
+    if ( notran ) {
+	*(unsigned char *)norm = '1';
+    } else {
+	*(unsigned char *)norm = 'I';
+    }
+    anorm = dlangs(norm, AA);
+    dgscon(norm, L, U, anorm, rcond, info);
+    utime[RCOND] = SuperLU_timer_() - t0;
+    
+    /* Compute the solution matrix X. */
+    for (j = 0; j < nrhs; j++)    /* Save a copy of the right hand sides */
+	for (i = 0; i < B->nrow; i++)
+	    Xmat[i + j*ldx] = Bmat[i + j*ldb];
+    
+    t0 = SuperLU_timer_();
+    dgstrs (trant, L, U, perm_r, perm_c, X, info);
+    utime[SOLVE] = SuperLU_timer_() - t0;
+    
+    /* Use iterative refinement to improve the computed solution and compute
+       error bounds and backward error estimates for it. */
+    t0 = SuperLU_timer_();
+    dgsrfs(trant, AA, L, U, perm_r, perm_c, equed, R, C, B,
+	      X, ferr, berr, info);
+    utime[REFINE] = SuperLU_timer_() - t0;
+
+    /* Transform the solution matrix X to a solution of the original system. */
+    if ( notran ) {
+	if ( colequ ) {
+	    for (j = 0; j < nrhs; ++j)
+		for (i = 0; i < A->nrow; ++i) {
+                  Xmat[i + j*ldx] *= C[i];
+	        }
+	}
+    } else if ( rowequ ) {
+	for (j = 0; j < nrhs; ++j)
+	    for (i = 0; i < A->nrow; ++i) {
+	      Xmat[i + j*ldx] *= R[i];
+            }
+    }
+
+    /* Set INFO = A->ncol+1 if the matrix is singular to working precision. */
+    if ( *rcond < dlamch_("E") ) *info = A->ncol + 1;
+
+    dQuerySpace(L, U, panel_size, mem_usage);
+
+    if ( nofact || equil ) Destroy_CompCol_Permuted(&AC);
+    if ( A->Stype == NR ) {
+	Destroy_SuperMatrix_Store(AA);
+	SUPERLU_FREE(AA);
+    }
+
+    PrintStat( &SuperLUStat );
+    StatFree();
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dgstrf.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,415 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "dsp_defs.h"
+#include "util.h"
+
+void
+dgstrf (char *refact, SuperMatrix *A, double diag_pivot_thresh, 
+	double drop_tol, int relax, int panel_size, int *etree, 
+	void *work, int lwork, int *perm_r, int *perm_c, 
+	SuperMatrix *L, SuperMatrix *U, int *info)
+{
+/*
+ * Purpose
+ * =======
+ *
+ * DGSTRF computes an LU factorization of a general sparse m-by-n
+ * matrix A using partial pivoting with row interchanges.
+ * The factorization has the form
+ *     Pr * A = L * U
+ * where Pr is a row permutation matrix, L is lower triangular with unit
+ * diagonal elements (lower trapezoidal if A->nrow > A->ncol), and U is upper 
+ * triangular (upper trapezoidal if A->nrow < A->ncol).
+ *
+ * See supermatrix.h for the definition of 'SuperMatrix' structure.
+ *
+ * Arguments
+ * =========
+ *
+ * refact (input) char*
+ *          Specifies whether we want to use perm_r from a previous factor.
+ *          = 'Y': re-use perm_r; perm_r is input, unchanged on exit.
+ *          = 'N': perm_r is determined by partial pivoting, and output.
+ *
+ * A        (input) SuperMatrix*
+ *	    Original matrix A, permuted by columns, of dimension
+ *          (A->nrow, A->ncol). The type of A can be:
+ *          Stype = NCP; Dtype = D; Mtype = GE.
+ *
+ * diag_pivot_thresh (input) double
+ *	    Diagonal pivoting threshold. At step j of the Gaussian elimination,
+ *          if abs(A_jj) >= thresh * (max_(i>=j) abs(A_ij)), use A_jj as pivot.
+ *	    0 <= thresh <= 1. The default value of thresh is 1, corresponding
+ *          to partial pivoting.
+ *
+ * drop_tol (input) double (NOT IMPLEMENTED)
+ *	    Drop tolerance parameter. At step j of the Gaussian elimination,
+ *          if abs(A_ij)/(max_i abs(A_ij)) < drop_tol, drop entry A_ij.
+ *          0 <= drop_tol <= 1. The default value of drop_tol is 0.
+ *
+ * relax    (input) int
+ *          To control degree of relaxing supernodes. If the number
+ *          of nodes (columns) in a subtree of the elimination tree is less
+ *          than relax, this subtree is considered as one supernode,
+ *          regardless of the row structures of those columns.
+ *
+ * panel_size (input) int
+ *          A panel consists of at most panel_size consecutive columns.
+ *
+ * etree    (input) int*, dimension (A->ncol)
+ *          Elimination tree of A'*A.
+ *          Note: etree is a vector of parent pointers for a forest whose
+ *          vertices are the integers 0 to A->ncol-1; etree[root]==A->ncol.
+ *          On input, the columns of A should be permuted so that the
+ *          etree is in a certain postorder.
+ *
+ * work     (input/output) void*, size (lwork) (in bytes)
+ *          User-supplied work space and space for the output data structures.
+ *          Not referenced if lwork = 0;
+ *
+ * lwork   (input) int
+ *         Specifies the size of work array in bytes.
+ *         = 0:  allocate space internally by system malloc;
+ *         > 0:  use user-supplied work array of length lwork in bytes,
+ *               returns error if space runs out.
+ *         = -1: the routine guesses the amount of space needed without
+ *               performing the factorization, and returns it in
+ *               *info; no other side effects.
+ *
+ * perm_r   (input/output) int*, dimension (A->nrow)
+ *          Row permutation vector which defines the permutation matrix Pr,
+ *          perm_r[i] = j means row i of A is in position j in Pr*A.
+ *          If refact is not 'Y', perm_r is output argument;
+ *          If refact = 'Y', the pivoting routine will try to use the input
+ *          perm_r, unless a certain threshold criterion is violated.
+ *          In that case, perm_r is overwritten by a new permutation
+ *          determined by partial pivoting or diagonal threshold pivoting.
+ *
+ * perm_c   (input) int*, dimension (A->ncol)
+ *	    Column permutation vector, which defines the 
+ *          permutation matrix Pc; perm_c[i] = j means column i of A is 
+ *          in position j in A*Pc.
+ *          When searching for diagonal, perm_c[*] is applied to the
+ *          row subscripts of A, so that diagonal threshold pivoting
+ *          can find the diagonal of A, rather than that of A*Pc.
+ *
+ * L        (output) SuperMatrix*
+ *          The factor L from the factorization Pr*A=L*U; use compressed row 
+ *          subscripts storage for supernodes, i.e., L has type: 
+ *          Stype = SC, Dtype = _D, Mtype = TRLU.
+ *
+ * U        (output) SuperMatrix*
+ *	    The factor U from the factorization Pr*A*Pc=L*U. Use column-wise
+ *          storage scheme, i.e., U has types: Stype = NC, 
+ *          Dtype = _D, Mtype = TRU.
+ *
+ * info     (output) int*
+ *          = 0: successful exit
+ *          < 0: if info = -i, the i-th argument had an illegal value
+ *          > 0: if info = i, and i is
+ *             <= A->ncol: U(i,i) is exactly zero. The factorization has
+ *                been completed, but the factor U is exactly singular,
+ *                and division by zero will occur if it is used to solve a
+ *                system of equations.
+ *             > A->ncol: number of bytes allocated when memory allocation
+ *                failure occurred, plus A->ncol. If lwork = -1, it is
+ *                the estimated amount of space needed, plus A->ncol.
+ *
+ * ======================================================================
+ *
+ * Local Working Arrays: 
+ * ======================
+ *   m = number of rows in the matrix
+ *   n = number of columns in the matrix
+ *
+ *   xprune[0:n-1]: xprune[*] points to locations in subscript 
+ *	vector lsub[*]. For column i, xprune[i] denotes the point where 
+ *	structural pruning begins. I.e. only xlsub[i],..,xprune[i]-1 need 
+ *	to be traversed for symbolic factorization.
+ *
+ *   marker[0:3*m-1]: marker[i] = j means that node i has been 
+ *	reached when working on column j.
+ *	Storage: relative to original row subscripts
+ *	NOTE: There are 3 of them: marker/marker1 are used for panel dfs, 
+ *	      see dpanel_dfs.c; marker2 is used for inner-factorization,
+ *            see dcolumn_dfs.c.
+ *
+ *   parent[0:m-1]: parent vector used during dfs
+ *      Storage: relative to new row subscripts
+ *
+ *   xplore[0:m-1]: xplore[i] gives the location of the next (dfs) 
+ *	unexplored neighbor of i in lsub[*]
+ *
+ *   segrep[0:nseg-1]: contains the list of supernodal representatives
+ *	in topological order of the dfs. A supernode representative is the 
+ *	last column of a supernode.
+ *      The maximum size of segrep[] is n.
+ *
+ *   repfnz[0:W*m-1]: for a nonzero segment U[*,j] that ends at a 
+ *	supernodal representative r, repfnz[r] is the location of the first 
+ *	nonzero in this segment.  It is also used during the dfs: repfnz[r]>0
+ *	indicates the supernode r has been explored.
+ *	NOTE: There are W of them, each used for one column of a panel. 
+ *
+ *   panel_lsub[0:W*m-1]: temporary for the nonzeros row indices below 
+ *      the panel diagonal. These are filled in during dpanel_dfs(), and are
+ *      used later in the inner LU factorization within the panel.
+ *	panel_lsub[]/dense[] pair forms the SPA data structure.
+ *	NOTE: There are W of them.
+ *
+ *   dense[0:W*m-1]: sparse accumulating (SPA) vector for intermediate values;
+ *	    	   NOTE: there are W of them.
+ *
+ *   tempv[0:*]: real temporary used for dense numeric kernels;
+ *	The size of this array is defined by NUM_TEMPV() in dsp_defs.h.
+ *
+ */
+    /* Local working arrays */
+    NCPformat *Astore;
+    int       *iperm_r; /* inverse of perm_r; not used if refact = 'N' */
+    int       *iperm_c; /* inverse of perm_c */
+    int       *iwork;
+    double    *dwork;
+    int	      *segrep, *repfnz, *parent, *xplore;
+    int	      *panel_lsub; /* dense[]/panel_lsub[] pair forms a w-wide SPA */
+    int	      *xprune;
+    int	      *marker;
+    double    *dense, *tempv;
+    int       *relax_end;
+    double    *a;
+    int       *asub;
+    int       *xa_begin, *xa_end;
+    int       *xsup, *supno;
+    int       *xlsub, *xlusup, *xusub;
+    int       nzlumax;
+    static GlobalLU_t Glu; /* persistent to facilitate multiple factors. */
+
+    /* Local scalars */
+    int       pivrow;   /* pivotal row number in the original matrix A */
+    int       nseg1;	/* no of segments in U-column above panel row jcol */
+    int       nseg;	/* no of segments in each U-column */
+    register int jcol;	
+    register int kcol;	/* end column of a relaxed snode */
+    register int icol;
+    register int i, k, jj, new_next, iinfo;
+    int       m, n, min_mn, jsupno, fsupc, nextlu, nextu;
+    int       w_def;	/* upper bound on panel width */
+    int       usepr;
+    int       nnzL, nnzU;
+    extern SuperLUStat_t SuperLUStat;
+    int       *panel_histo = SuperLUStat.panel_histo;
+    flops_t   *ops = SuperLUStat.ops;
+
+    iinfo    = 0;
+    m        = A->nrow;
+    n        = A->ncol;
+    min_mn   = MIN(m, n);
+    Astore   = A->Store;
+    a        = Astore->nzval;
+    asub     = Astore->rowind;
+    xa_begin = Astore->colbeg;
+    xa_end   = Astore->colend;
+
+    /* Allocate storage common to the factor routines */
+    *info = dLUMemInit(refact, work, lwork, m, n, Astore->nnz,
+		      panel_size, L, U, &Glu, &iwork, &dwork);
+    if ( *info ) return;
+    
+    xsup    = Glu.xsup;
+    supno   = Glu.supno;
+    xlsub   = Glu.xlsub;
+    xlusup  = Glu.xlusup;
+    xusub   = Glu.xusub;
+    
+    SetIWork(m, n, panel_size, iwork, &segrep, &parent, &xplore,
+	     &repfnz, &panel_lsub, &xprune, &marker);
+    dSetRWork(m, panel_size, dwork, &dense, &tempv);
+    
+    usepr = lsame_(refact, "Y");
+    if ( usepr ) {
+	/* Compute the inverse of perm_r */
+	iperm_r = (int *) intMalloc(m);
+	for (k = 0; k < m; ++k) iperm_r[perm_r[k]] = k;
+    }
+    iperm_c = (int *) intMalloc(n);
+    for (k = 0; k < n; ++k) iperm_c[perm_c[k]] = k;
+
+    /* Identify relaxed snodes */
+    relax_end = (int *) intMalloc(n);
+    relax_snode(n, etree, relax, marker, relax_end); 
+    
+    ifill (perm_r, m, EMPTY);
+    ifill (marker, m * NO_MARKER, EMPTY);
+    supno[0] = -1;
+    xsup[0]  = xlsub[0] = xusub[0] = xlusup[0] = 0;
+    w_def    = panel_size;
+
+    /* 
+     * Work on one "panel" at a time. A panel is one of the following: 
+     *	   (a) a relaxed supernode at the bottom of the etree, or
+     *	   (b) panel_size contiguous columns, defined by the user
+     */
+    for (jcol = 0; jcol < min_mn; ) {
+
+	if ( relax_end[jcol] != EMPTY ) { /* start of a relaxed snode */
+   	    kcol = relax_end[jcol];	  /* end of the relaxed snode */
+	    panel_histo[kcol-jcol+1]++;
+
+	    /* --------------------------------------
+	     * Factorize the relaxed supernode(jcol:kcol) 
+	     * -------------------------------------- */
+	    /* Determine the union of the row structure of the snode */
+	    if ( (*info = dsnode_dfs(jcol, kcol, asub, xa_begin, xa_end,
+				    xprune, marker, &Glu)) != 0 )
+		return;
+
+            nextu    = xusub[jcol];
+	    nextlu   = xlusup[jcol];
+	    jsupno   = supno[jcol];
+	    fsupc    = xsup[jsupno];
+	    new_next = nextlu + (xlsub[fsupc+1]-xlsub[fsupc])*(kcol-jcol+1);
+	    nzlumax = Glu.nzlumax;
+	    while ( new_next > nzlumax ) {
+		if ( *info = dLUMemXpand(jcol, nextlu, LUSUP, &nzlumax, &Glu) )
+		    return;
+	    }
+    
+	    for (icol = jcol; icol<= kcol; icol++) {
+		xusub[icol+1] = nextu;
+		
+    		/* Scatter into SPA dense[*] */
+    		for (k = xa_begin[icol]; k < xa_end[icol]; k++)
+        	    dense[asub[k]] = a[k];
+
+	       	/* Numeric update within the snode */
+	        dsnode_bmod(icol, jsupno, fsupc, dense, tempv, &Glu);
+
+		if ( *info = dpivotL(icol, diag_pivot_thresh, &usepr, perm_r,
+				    iperm_r, iperm_c, &pivrow, &Glu) )
+		    if ( iinfo == 0 ) iinfo = *info;
+		
+#ifdef DEBUG
+		dprint_lu_col("[1]: ", icol, pivrow, xprune, &Glu);
+#endif
+
+	    }
+
+	    jcol = icol;
+
+	} else { /* Work on one panel of panel_size columns */
+	    
+	    /* Adjust panel_size so that a panel won't overlap with the next 
+	     * relaxed snode.
+	     */
+	    panel_size = w_def;
+	    for (k = jcol + 1; k < MIN(jcol+panel_size, min_mn); k++) 
+		if ( relax_end[k] != EMPTY ) {
+		    panel_size = k - jcol;
+		    break;
+		}
+	    if ( k == min_mn ) panel_size = min_mn - jcol;
+	    panel_histo[panel_size]++;
+
+	    /* symbolic factor on a panel of columns */
+	    dpanel_dfs(m, panel_size, jcol, A, perm_r, &nseg1,
+		      dense, panel_lsub, segrep, repfnz, xprune,
+		      marker, parent, xplore, &Glu);
+	    
+	    /* numeric sup-panel updates in topological order */
+	    dpanel_bmod(m, panel_size, jcol, nseg1, dense,
+		       tempv, segrep, repfnz, &Glu);
+	    
+	    /* Sparse LU within the panel, and below panel diagonal */
+    	    for ( jj = jcol; jj < jcol + panel_size; jj++) {
+ 		k = (jj - jcol) * m; /* column index for w-wide arrays */
+
+		nseg = nseg1;	/* Begin after all the panel segments */
+
+	    	if ((*info = dcolumn_dfs(m, jj, perm_r, &nseg, &panel_lsub[k],
+					segrep, &repfnz[k], xprune, marker,
+					parent, xplore, &Glu)) != 0) return;
+
+	      	/* Numeric updates */
+	    	if ((*info = dcolumn_bmod(jj, (nseg - nseg1), &dense[k],
+					 tempv, &segrep[nseg1], &repfnz[k],
+					 jcol, &Glu)) != 0) return;
+		
+	        /* Copy the U-segments to ucol[*] */
+		if ((*info = dcopy_to_ucol(jj, nseg, segrep, &repfnz[k],
+					  perm_r, &dense[k], &Glu)) != 0)
+		    return;
+
+	    	if ( *info = dpivotL(jj, diag_pivot_thresh, &usepr, perm_r,
+				    iperm_r, iperm_c, &pivrow, &Glu) )
+		    if ( iinfo == 0 ) iinfo = *info;
+
+		/* Prune columns (0:jj-1) using column jj */
+	    	dpruneL(jj, perm_r, pivrow, nseg, segrep,
+		       &repfnz[k], xprune, &Glu);
+
+		/* Reset repfnz[] for this column */
+	    	resetrep_col (nseg, segrep, &repfnz[k]);
+		
+#ifdef DEBUG
+		dprint_lu_col("[2]: ", jj, pivrow, xprune, &Glu);
+#endif
+
+	    }
+
+   	    jcol += panel_size;	/* Move to the next panel */
+
+	} /* else */
+
+    } /* for */
+
+    *info = iinfo;
+    
+    if ( m > n ) {
+	k = 0;
+        for (i = 0; i < m; ++i) 
+            if ( perm_r[i] == EMPTY ) {
+    		perm_r[i] = n + k;
+		++k;
+	    }
+    }
+
+    countnz(min_mn, xprune, &nnzL, &nnzU, &Glu);
+    fixupL(min_mn, perm_r, &Glu);
+
+    dLUWorkFree(iwork, dwork, &Glu); /* Free work space and compress storage */
+
+    if ( !lsame_(refact, "Y") ) {
+        dCreate_SuperNode_Matrix(L, A->nrow, A->ncol, nnzL, Glu.lusup, 
+	                         Glu.xlusup, Glu.lsub, Glu.xlsub, Glu.supno,
+			         Glu.xsup, SC, _D, TRLU);
+    	dCreate_CompCol_Matrix(U, A->nrow, A->ncol, nnzU, Glu.ucol, 
+			       Glu.usub, Glu.xusub, NC, _D, TRU);
+    }
+    
+    ops[FACT] += ops[TRSV] + ops[GEMV];	
+    
+    if ( usepr ) SUPERLU_FREE (iperm_r);
+    SUPERLU_FREE (iperm_c);
+    SUPERLU_FREE (relax_end);
+
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dgstrs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,331 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "dsp_defs.h"
+#include "util.h"
+
+
+/* 
+ * Function prototypes 
+ */
+void dusolve(int, int, double*, double*);
+void dlsolve(int, int, double*, double*);
+void dmatvec(int, int, int, double*, double*, double*);
+
+
+void
+dgstrs (char *trans, SuperMatrix *L, SuperMatrix *U,
+	int *perm_r, int *perm_c, SuperMatrix *B, int *info)
+{
+/*
+ * Purpose
+ * =======
+ *
+ * DGSTRS solves a system of linear equations A*X=B or A'*X=B
+ * with A sparse and B dense, using the LU factorization computed by
+ * DGSTRF.
+ *
+ * See supermatrix.h for the definition of 'SuperMatrix' structure.
+ *
+ * Arguments
+ * =========
+ *
+ * trans   (input) char*
+ *          Specifies the form of the system of equations:
+ *          = 'N':  A * X = B  (No transpose)
+ *          = 'T':  A'* X = B  (Transpose)
+ *          = 'C':  A**H * X = B  (Conjugate transpose)
+ *
+ * L       (input) SuperMatrix*
+ *         The factor L from the factorization Pr*A*Pc=L*U as computed by
+ *         dgstrf(). Use compressed row subscripts storage for supernodes,
+ *         i.e., L has types: Stype = SC, Dtype = _D, Mtype = TRLU.
+ *
+ * U       (input) SuperMatrix*
+ *         The factor U from the factorization Pr*A*Pc=L*U as computed by
+ *         dgstrf(). Use column-wise storage scheme, i.e., U has types:
+ *         Stype = NC, Dtype = _D, Mtype = TRU.
+ *
+ * perm_r  (input) int*, dimension (L->nrow)
+ *         Row permutation vector, which defines the permutation matrix Pr; 
+ *         perm_r[i] = j means row i of A is in position j in Pr*A.
+ *
+ * perm_c  (input) int*, dimension (L->ncol)
+ *	   Column permutation vector, which defines the 
+ *         permutation matrix Pc; perm_c[i] = j means column i of A is 
+ *         in position j in A*Pc.
+ *
+ * B       (input/output) SuperMatrix*
+ *         B has types: Stype = DN, Dtype = _D, Mtype = GE.
+ *         On entry, the right hand side matrix.
+ *         On exit, the solution matrix if info = 0;
+ *
+ * info    (output) int*
+ * 	   = 0: successful exit
+ *	   < 0: if info = -i, the i-th argument had an illegal value
+ *
+ */
+#ifdef _CRAY
+    _fcd ftcs1, ftcs2, ftcs3, ftcs4;
+#endif
+    int      incx = 1, incy = 1;
+    double   alpha = 1.0, beta = 1.0;
+    DNformat *Bstore;
+    double   *Bmat;
+    SCformat *Lstore;
+    NCformat *Ustore;
+    double   *Lval, *Uval;
+    int      nrow, notran;
+    int      fsupc, nsupr, nsupc, luptr, istart, irow;
+    int      i, j, k, iptr, jcol, n, ldb, nrhs;
+    double   *work, *work_col, *rhs_work, *soln;
+    flops_t  solve_ops;
+    extern SuperLUStat_t SuperLUStat;
+    void dprint_soln();
+
+    /* Test input parameters ... */
+    *info = 0;
+    Bstore = B->Store;
+    ldb = Bstore->lda;
+    nrhs = B->ncol;
+    notran = lsame_(trans, "N");
+    if ( !notran && !lsame_(trans, "T") && !lsame_(trans, "C") ) *info = -1;
+    else if ( L->nrow != L->ncol || L->nrow < 0 ||
+	      L->Stype != SC || L->Dtype != _D || L->Mtype != TRLU )
+	*info = -2;
+    else if ( U->nrow != U->ncol || U->nrow < 0 ||
+	      U->Stype != NC || U->Dtype != _D || U->Mtype != TRU )
+	*info = -3;
+    else if ( ldb < MAX(0, L->nrow) ||
+	      B->Stype != DN || B->Dtype != _D || B->Mtype != GE )
+	*info = -6;
+    if ( *info ) {
+	i = -(*info);
+	xerbla_("dgstrs", &i);
+	return;
+    }
+
+    n = L->nrow;
+    work = doubleCalloc(n * nrhs);
+    if ( !work ) ABORT("Malloc fails for local work[].");
+    soln = doubleMalloc(n);
+    if ( !soln ) ABORT("Malloc fails for local soln[].");
+
+    Bmat = Bstore->nzval;
+    Lstore = L->Store;
+    Lval = Lstore->nzval;
+    Ustore = U->Store;
+    Uval = Ustore->nzval;
+    solve_ops = 0;
+    
+    if ( notran ) {
+	/* Permute right hand sides to form Pr*B */
+	for (i = 0; i < nrhs; i++) {
+	    rhs_work = &Bmat[i*ldb];
+	    for (k = 0; k < n; k++) soln[perm_r[k]] = rhs_work[k];
+	    for (k = 0; k < n; k++) rhs_work[k] = soln[k];
+	}
+	
+	/* Forward solve PLy=Pb. */
+	for (k = 0; k <= Lstore->nsuper; k++) {
+	    fsupc = L_FST_SUPC(k);
+	    istart = L_SUB_START(fsupc);
+	    nsupr = L_SUB_START(fsupc+1) - istart;
+	    nsupc = L_FST_SUPC(k+1) - fsupc;
+	    nrow = nsupr - nsupc;
+
+	    solve_ops += nsupc * (nsupc - 1) * nrhs;
+	    solve_ops += 2 * nrow * nsupc * nrhs;
+	    
+	    if ( nsupc == 1 ) {
+		for (j = 0; j < nrhs; j++) {
+		    rhs_work = &Bmat[j*ldb];
+	    	    luptr = L_NZ_START(fsupc);
+		    for (iptr=istart+1; iptr < L_SUB_START(fsupc+1); iptr++){
+			irow = L_SUB(iptr);
+			++luptr;
+			rhs_work[irow] -= rhs_work[fsupc] * Lval[luptr];
+		    }
+		}
+	    } else {
+	    	luptr = L_NZ_START(fsupc);
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		ftcs1 = _cptofcd("L", strlen("L"));
+		ftcs2 = _cptofcd("N", strlen("N"));
+		ftcs3 = _cptofcd("U", strlen("U"));
+		STRSM( ftcs1, ftcs1, ftcs2, ftcs3, &nsupc, &nrhs, &alpha,
+		       &Lval[luptr], &nsupr, &Bmat[fsupc], &ldb);
+		
+		SGEMM( ftcs2, ftcs2, &nrow, &nrhs, &nsupc, &alpha, 
+			&Lval[luptr+nsupc], &nsupr, &Bmat[fsupc], &ldb, 
+			&beta, &work[0], &n );
+#else
+		dtrsm_("L", "L", "N", "U", &nsupc, &nrhs, &alpha,
+		       &Lval[luptr], &nsupr, &Bmat[fsupc], &ldb);
+		
+		dgemm_( "N", "N", &nrow, &nrhs, &nsupc, &alpha, 
+			&Lval[luptr+nsupc], &nsupr, &Bmat[fsupc], &ldb, 
+			&beta, &work[0], &n );
+#endif
+		for (j = 0; j < nrhs; j++) {
+		    rhs_work = &Bmat[j*ldb];
+		    work_col = &work[j*n];
+		    iptr = istart + nsupc;
+		    for (i = 0; i < nrow; i++) {
+			irow = L_SUB(iptr);
+			rhs_work[irow] -= work_col[i]; /* Scatter */
+			work_col[i] = 0.0;
+			iptr++;
+		    }
+		}
+#else		
+		for (j = 0; j < nrhs; j++) {
+		    rhs_work = &Bmat[j*ldb];
+		    dlsolve (nsupr, nsupc, &Lval[luptr], &rhs_work[fsupc]);
+		    dmatvec (nsupr, nrow, nsupc, &Lval[luptr+nsupc],
+			    &rhs_work[fsupc], &work[0] );
+
+		    iptr = istart + nsupc;
+		    for (i = 0; i < nrow; i++) {
+			irow = L_SUB(iptr);
+			rhs_work[irow] -= work[i];
+			work[i] = 0.0;
+			iptr++;
+		    }
+		}
+#endif		    
+	    } /* else ... */
+	} /* for L-solve */
+
+#ifdef DEBUG
+  	printf("After L-solve: y=\n");
+	dprint_soln(n, nrhs, Bmat);
+#endif
+
+	/*
+	 * Back solve Ux=y.
+	 */
+	for (k = Lstore->nsuper; k >= 0; k--) {
+	    fsupc = L_FST_SUPC(k);
+	    istart = L_SUB_START(fsupc);
+	    nsupr = L_SUB_START(fsupc+1) - istart;
+	    nsupc = L_FST_SUPC(k+1) - fsupc;
+	    luptr = L_NZ_START(fsupc);
+
+	    solve_ops += nsupc * (nsupc + 1) * nrhs;
+
+	    if ( nsupc == 1 ) {
+		rhs_work = &Bmat[0];
+		for (j = 0; j < nrhs; j++) {
+		    rhs_work[fsupc] /= Lval[luptr];
+		    rhs_work += ldb;
+		}
+	    } else {
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		ftcs1 = _cptofcd("L", strlen("L"));
+		ftcs2 = _cptofcd("U", strlen("U"));
+		ftcs3 = _cptofcd("N", strlen("N"));
+		STRSM( ftcs1, ftcs2, ftcs3, ftcs3, &nsupc, &nrhs, &alpha,
+		       &Lval[luptr], &nsupr, &Bmat[fsupc], &ldb);
+#else
+		dtrsm_("L", "U", "N", "N", &nsupc, &nrhs, &alpha,
+		       &Lval[luptr], &nsupr, &Bmat[fsupc], &ldb);
+#endif
+#else		
+		for (j = 0; j < nrhs; j++)
+		    dusolve ( nsupr, nsupc, &Lval[luptr], &Bmat[fsupc+j*ldb] );
+#endif		
+	    }
+
+	    for (j = 0; j < nrhs; ++j) {
+		rhs_work = &Bmat[j*ldb];
+		for (jcol = fsupc; jcol < fsupc + nsupc; jcol++) {
+		    solve_ops += 2*(U_NZ_START(jcol+1) - U_NZ_START(jcol));
+		    for (i = U_NZ_START(jcol); i < U_NZ_START(jcol+1); i++ ){
+			irow = U_SUB(i);
+			rhs_work[irow] -= rhs_work[jcol] * Uval[i];
+		    }
+		}
+	    }
+	    
+	} /* for U-solve */
+
+#ifdef DEBUG
+  	printf("After U-solve: x=\n");
+	dprint_soln(n, nrhs, Bmat);
+#endif
+
+	/* Compute the final solution X := Pc*X. */
+	for (i = 0; i < nrhs; i++) {
+	    rhs_work = &Bmat[i*ldb];
+	    for (k = 0; k < n; k++) soln[k] = rhs_work[perm_c[k]];
+	    for (k = 0; k < n; k++) rhs_work[k] = soln[k];
+	}
+	
+        SuperLUStat.ops[SOLVE] = solve_ops;
+
+    } else { /* Solve A'*X=B */
+	/* Permute right hand sides to form Pc'*B. */
+	for (i = 0; i < nrhs; i++) {
+	    rhs_work = &Bmat[i*ldb];
+	    for (k = 0; k < n; k++) soln[perm_c[k]] = rhs_work[k];
+	    for (k = 0; k < n; k++) rhs_work[k] = soln[k];
+	}
+
+	SuperLUStat.ops[SOLVE] = 0;
+	
+	for (k = 0; k < nrhs; ++k) {
+	    
+	    /* Multiply by inv(U'). */
+	    sp_dtrsv("U", "T", "N", L, U, &Bmat[k*ldb], info);
+	    
+	    /* Multiply by inv(L'). */
+	    sp_dtrsv("L", "T", "U", L, U, &Bmat[k*ldb], info);
+	    
+	}
+	
+	/* Compute the final solution X := Pr'*X (=inv(Pr)*X) */
+	for (i = 0; i < nrhs; i++) {
+	    rhs_work = &Bmat[i*ldb];
+	    for (k = 0; k < n; k++) soln[k] = rhs_work[perm_r[k]];
+	    for (k = 0; k < n; k++) rhs_work[k] = soln[k];
+	}
+
+    }
+
+    SUPERLU_FREE(work);
+    SUPERLU_FREE(soln);
+}
+
+/*
+ * Diagnostic print of the solution vector 
+ */
+void
+dprint_soln(int n, int nrhs, double *soln)
+{
+    int i;
+
+    for (i = 0; i < n; i++) 
+  	printf("\t%d: %.4f\n", i, soln[i]);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dlacon.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,229 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include <math.h>
+#include "Cnames.h"
+
+int
+dlacon_(int *n, double *v, double *x, int *isgn, double *est, int *kase)
+
+{
+/*
+    Purpose   
+    =======   
+
+    DLACON estimates the 1-norm of a square matrix A.   
+    Reverse communication is used for evaluating matrix-vector products. 
+  
+
+    Arguments   
+    =========   
+
+    N      (input) INT
+           The order of the matrix.  N >= 1.   
+
+    V      (workspace) DOUBLE PRECISION array, dimension (N)   
+           On the final return, V = A*W,  where  EST = norm(V)/norm(W)   
+           (W is not returned).   
+
+    X      (input/output) DOUBLE PRECISION array, dimension (N)   
+           On an intermediate return, X should be overwritten by   
+                 A * X,   if KASE=1,   
+                 A' * X,  if KASE=2,
+           and DLACON must be re-called with all the other parameters   
+           unchanged.   
+
+    ISGN   (workspace) INT array, dimension (N)
+
+    EST    (output) DOUBLE PRECISION   
+           An estimate (a lower bound) for norm(A).   
+
+    KASE   (input/output) INT
+           On the initial call to DLACON, KASE should be 0.   
+           On an intermediate return, KASE will be 1 or 2, indicating   
+           whether X should be overwritten by A * X  or A' * X.   
+           On the final return from DLACON, KASE will again be 0.   
+
+    Further Details   
+    ======= =======   
+
+    Contributed by Nick Higham, University of Manchester.   
+    Originally named CONEST, dated March 16, 1988.   
+
+    Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of 
+    a real or complex matrix, with applications to condition estimation", 
+    ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.   
+    ===================================================================== 
+*/
+
+    /* Table of constant values */
+    int c__1 = 1;
+    double      zero = 0.0;
+    double      one = 1.0;
+    
+    /* Local variables */
+    static int iter;
+    static int jump, jlast;
+    static double altsgn, estold;
+    static int i, j;
+    double temp;
+#ifdef _CRAY
+    extern int ISAMAX(int *, double *, int *);
+    extern double SASUM(int *, double *, int *);
+    extern int SCOPY(int *, double *, int *, double *, int *);
+#else
+    extern int idamax_(int *, double *, int *);
+    extern double dasum_(int *, double *, int *);
+    extern int dcopy_(int *, double *, int *, double *, int *);
+#endif
+#define d_sign(a, b) (b >= 0 ? fabs(a) : -fabs(a))    /* Copy sign */
+#define i_dnnt(a) \
+	( a>=0 ? floor(a+.5) : -floor(.5-a) ) /* Round to nearest integer */
+
+    if ( *kase == 0 ) {
+	for (i = 0; i < *n; ++i) {
+	    x[i] = 1. / (double) (*n);
+	}
+	*kase = 1;
+	jump = 1;
+	return 0;
+    }
+
+    switch (jump) {
+	case 1:  goto L20;
+	case 2:  goto L40;
+	case 3:  goto L70;
+	case 4:  goto L110;
+	case 5:  goto L140;
+    }
+
+    /*     ................ ENTRY   (JUMP = 1)   
+	   FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X. */
+  L20:
+    if (*n == 1) {
+	v[0] = x[0];
+	*est = fabs(v[0]);
+	/*        ... QUIT */
+	goto L150;
+    }
+#ifdef _CRAY
+    *est = SASUM(n, x, &c__1);
+#else
+    *est = dasum_(n, x, &c__1);
+#endif
+
+    for (i = 0; i < *n; ++i) {
+	x[i] = d_sign(one, x[i]);
+	isgn[i] = i_dnnt(x[i]);
+    }
+    *kase = 2;
+    jump = 2;
+    return 0;
+
+    /*     ................ ENTRY   (JUMP = 2)   
+	   FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X. */
+L40:
+#ifdef _CRAY
+    j = ISAMAX(n, &x[0], &c__1);
+#else
+    j = idamax_(n, &x[0], &c__1);
+#endif
+    --j;
+    iter = 2;
+
+    /*     MAIN LOOP - ITERATIONS 2,3,...,ITMAX. */
+L50:
+    for (i = 0; i < *n; ++i) x[i] = zero;
+    x[j] = one;
+    *kase = 1;
+    jump = 3;
+    return 0;
+
+    /*     ................ ENTRY   (JUMP = 3)   
+	   X HAS BEEN OVERWRITTEN BY A*X. */
+L70:
+#ifdef _CRAY
+    SCOPY(n, x, &c__1, v, &c__1);
+#else
+    dcopy_(n, x, &c__1, v, &c__1);
+#endif
+    estold = *est;
+#ifdef _CRAY
+    *est = SASUM(n, v, &c__1);
+#else
+    *est = dasum_(n, v, &c__1);
+#endif
+
+    for (i = 0; i < *n; ++i)
+	if (i_dnnt(d_sign(one, x[i])) != isgn[i])
+	    goto L90;
+
+    /*     REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED. */
+    goto L120;
+
+L90:
+    /*     TEST FOR CYCLING. */
+    if (*est <= estold) goto L120;
+
+    for (i = 0; i < *n; ++i) {
+	x[i] = d_sign(one, x[i]);
+	isgn[i] = i_dnnt(x[i]);
+    }
+    *kase = 2;
+    jump = 4;
+    return 0;
+
+    /*     ................ ENTRY   (JUMP = 4)   
+	   X HAS BEEN OVERWRITTEN BY TRANDPOSE(A)*X. */
+L110:
+    jlast = j;
+#ifdef _CRAY
+    j = ISAMAX(n, &x[0], &c__1);
+#else
+    j = idamax_(n, &x[0], &c__1);
+#endif
+    --j;
+    if (x[jlast] != fabs(x[j]) && iter < 5) {
+	++iter;
+	goto L50;
+    }
+
+    /*     ITERATION COMPLETE.  FINAL STAGE. */
+L120:
+    altsgn = 1.;
+    for (i = 1; i <= *n; ++i) {
+	x[i-1] = altsgn * ((double)(i - 1) / (double)(*n - 1) + 1.);
+	altsgn = -altsgn;
+    }
+    *kase = 1;
+    jump = 5;
+    return 0;
+    
+    /*     ................ ENTRY   (JUMP = 5)   
+	   X HAS BEEN OVERWRITTEN BY A*X. */
+L140:
+#ifdef _CRAY
+    temp = SASUM(n, x, &c__1) / (double)(*n * 3) * 2.;
+#else
+    temp = dasum_(n, x, &c__1) / (double)(*n * 3) * 2.;
+#endif
+    if (temp > *est) {
+#ifdef _CRAY
+	SCOPY(n, &x[0], &c__1, &v[0], &c__1);
+#else
+	dcopy_(n, &x[0], &c__1, &v[0], &c__1);
+#endif
+	*est = temp;
+    }
+
+L150:
+    *kase = 0;
+    return 0;
+
+} /* dlacon_ */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dlamch.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,961 @@
+#define TRUE_ (1)
+#define FALSE_ (0)
+#define min(a,b) ((a) <= (b) ? (a) : (b))
+#define max(a,b) ((a) >= (b) ? (a) : (b))
+
+double dlamch_(char *cmach)
+{
+/*  -- LAPACK auxiliary routine (version 2.0) --   
+       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
+       Courant Institute, Argonne National Lab, and Rice University   
+       October 31, 1992   
+
+    Purpose   
+    =======   
+
+    DLAMCH determines double precision machine parameters.   
+
+    Arguments   
+    =========   
+
+    CMACH   (input) CHARACTER*1   
+            Specifies the value to be returned by DLAMCH:   
+            = 'E' or 'e',   DLAMCH := eps   
+            = 'S' or 's ,   DLAMCH := sfmin   
+            = 'B' or 'b',   DLAMCH := base   
+            = 'P' or 'p',   DLAMCH := eps*base   
+            = 'N' or 'n',   DLAMCH := t   
+            = 'R' or 'r',   DLAMCH := rnd   
+            = 'M' or 'm',   DLAMCH := emin   
+            = 'U' or 'u',   DLAMCH := rmin   
+            = 'L' or 'l',   DLAMCH := emax   
+            = 'O' or 'o',   DLAMCH := rmax   
+
+            where   
+
+            eps   = relative machine precision   
+            sfmin = safe minimum, such that 1/sfmin does not overflow   
+            base  = base of the machine   
+            prec  = eps*base   
+            t     = number of (base) digits in the mantissa   
+            rnd   = 1.0 when rounding occurs in addition, 0.0 otherwise   
+            emin  = minimum exponent before (gradual) underflow   
+            rmin  = underflow threshold - base**(emin-1)   
+            emax  = largest exponent before overflow   
+            rmax  = overflow threshold  - (base**emax)*(1-eps)   
+
+   ===================================================================== 
+*/
+
+    static int first = TRUE_;
+
+    /* System generated locals */
+    int i__1;
+    double ret_val;
+    /* Builtin functions */
+    double pow_di(double *, int *);
+    /* Local variables */
+    static double base;
+    static int beta;
+    static double emin, prec, emax;
+    static int imin, imax;
+    static int lrnd;
+    static double rmin, rmax, t, rmach;
+/*    extern int lsame_(char *, char *);*/
+    static double small, sfmin;
+    extern /* Subroutine */ int dlamc2_(int *, int *, int *, 
+	    double *, int *, double *, int *, double *);
+    static int it;
+    static double rnd, eps;
+
+    if (first) {
+	first = FALSE_;
+	dlamc2_(&beta, &it, &lrnd, &eps, &imin, &rmin, &imax, &rmax);
+	base = (double) beta;
+	t = (double) it;
+	if (lrnd) {
+	    rnd = 1.;
+	    i__1 = 1 - it;
+	    eps = pow_di(&base, &i__1) / 2;
+	} else {
+	    rnd = 0.;
+	    i__1 = 1 - it;
+	    eps = pow_di(&base, &i__1);
+	}
+	prec = eps * base;
+	emin = (double) imin;
+	emax = (double) imax;
+	sfmin = rmin;
+	small = 1. / rmax;
+	if (small >= sfmin) {
+
+	/* Use SMALL plus a bit, to avoid the possibility of rounding   
+             causing overflow when computing  1/sfmin. */
+	    sfmin = small * (eps + 1.);
+	}
+    }
+
+    if (lsame_(cmach, "E")) {
+	rmach = eps;
+    } else if (lsame_(cmach, "S")) {
+	rmach = sfmin;
+    } else if (lsame_(cmach, "B")) {
+	rmach = base;
+    } else if (lsame_(cmach, "P")) {
+	rmach = prec;
+    } else if (lsame_(cmach, "N")) {
+	rmach = t;
+    } else if (lsame_(cmach, "R")) {
+	rmach = rnd;
+    } else if (lsame_(cmach, "M")) {
+	rmach = emin;
+    } else if (lsame_(cmach, "U")) {
+	rmach = rmin;
+    } else if (lsame_(cmach, "L")) {
+	rmach = emax;
+    } else if (lsame_(cmach, "O")) {
+	rmach = rmax;
+    }
+
+    ret_val = rmach;
+    return ret_val;
+
+/*     End of DLAMCH */
+
+} /* dlamch_ */
+
+
+/* Subroutine */ int dlamc1_(int *beta, int *t, int *rnd, int 
+	*ieee1)
+{
+/*  -- LAPACK auxiliary routine (version 2.0) --   
+       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
+       Courant Institute, Argonne National Lab, and Rice University   
+       October 31, 1992   
+
+
+    Purpose   
+    =======   
+
+    DLAMC1 determines the machine parameters given by BETA, T, RND, and   
+    IEEE1.   
+
+    Arguments   
+    =========   
+
+    BETA    (output) INT   
+            The base of the machine.   
+
+    T       (output) INT   
+            The number of ( BETA ) digits in the mantissa.   
+
+    RND     (output) INT   
+            Specifies whether proper rounding  ( RND = .TRUE. )  or   
+            chopping  ( RND = .FALSE. )  occurs in addition. This may not 
+  
+            be a reliable guide to the way in which the machine performs 
+  
+            its arithmetic.   
+
+    IEEE1   (output) INT   
+            Specifies whether rounding appears to be done in the IEEE   
+            'round to nearest' style.   
+
+    Further Details   
+    ===============   
+
+    The routine is based on the routine  ENVRON  by Malcolm and   
+    incorporates suggestions by Gentleman and Marovich. See   
+
+       Malcolm M. A. (1972) Algorithms to reveal properties of   
+          floating-point arithmetic. Comms. of the ACM, 15, 949-951.   
+
+       Gentleman W. M. and Marovich S. B. (1974) More on algorithms   
+          that reveal properties of floating point arithmetic units.   
+          Comms. of the ACM, 17, 276-277.   
+
+   ===================================================================== 
+*/
+    /* Initialized data */
+    static int first = TRUE_;
+    /* System generated locals */
+    double d__1, d__2;
+    /* Local variables */
+    static int lrnd;
+    static double a, b, c, f;
+    static int lbeta;
+    static double savec;
+    extern double dlamc3_(double *, double *);
+    static int lieee1;
+    static double t1, t2;
+    static int lt;
+    static double one, qtr;
+
+    if (first) {
+	first = FALSE_;
+	one = 1.;
+
+/*        LBETA,  LIEEE1,  LT and  LRND  are the  local values  of  BE
+TA,   
+          IEEE1, T and RND.   
+
+          Throughout this routine  we use the function  DLAMC3  to ens
+ure   
+          that relevant values are  stored and not held in registers, 
+ or   
+          are not affected by optimizers.   
+
+          Compute  a = 2.0**m  with the  smallest positive integer m s
+uch   
+          that   
+
+             fl( a + 1.0 ) = a. */
+
+	a = 1.;
+	c = 1.;
+
+/* +       WHILE( C.EQ.ONE )LOOP */
+L10:
+	if (c == one) {
+	    a *= 2;
+	    c = dlamc3_(&a, &one);
+	    d__1 = -a;
+	    c = dlamc3_(&c, &d__1);
+	    goto L10;
+	}
+/* +       END WHILE   
+
+          Now compute  b = 2.0**m  with the smallest positive integer 
+m   
+          such that   
+
+             fl( a + b ) .gt. a. */
+
+	b = 1.;
+	c = dlamc3_(&a, &b);
+
+/* +       WHILE( C.EQ.A )LOOP */
+L20:
+	if (c == a) {
+	    b *= 2;
+	    c = dlamc3_(&a, &b);
+	    goto L20;
+	}
+/* +       END WHILE   
+
+          Now compute the base.  a and c  are neighbouring floating po
+int   
+          numbers  in the  interval  ( beta**t, beta**( t + 1 ) )  and
+ so   
+          their difference is beta. Adding 0.25 to c is to ensure that
+ it   
+          is truncated to beta and not ( beta - 1 ). */
+
+	qtr = one / 4;
+	savec = c;
+	d__1 = -a;
+	c = dlamc3_(&c, &d__1);
+	lbeta = (int) (c + qtr);
+
+/*        Now determine whether rounding or chopping occurs,  by addin
+g a   
+          bit  less  than  beta/2  and a  bit  more  than  beta/2  to 
+ a. */
+
+	b = (double) lbeta;
+	d__1 = b / 2;
+	d__2 = -b / 100;
+	f = dlamc3_(&d__1, &d__2);
+	c = dlamc3_(&f, &a);
+	if (c == a) {
+	    lrnd = TRUE_;
+	} else {
+	    lrnd = FALSE_;
+	}
+	d__1 = b / 2;
+	d__2 = b / 100;
+	f = dlamc3_(&d__1, &d__2);
+	c = dlamc3_(&f, &a);
+	if (lrnd && c == a) {
+	    lrnd = FALSE_;
+	}
+
+/*        Try and decide whether rounding is done in the  IEEE  'round
+ to   
+          nearest' style. B/2 is half a unit in the last place of the 
+two   
+          numbers A and SAVEC. Furthermore, A is even, i.e. has last  
+bit   
+          zero, and SAVEC is odd. Thus adding B/2 to A should not  cha
+nge   
+          A, but adding B/2 to SAVEC should change SAVEC. */
+
+	d__1 = b / 2;
+	t1 = dlamc3_(&d__1, &a);
+	d__1 = b / 2;
+	t2 = dlamc3_(&d__1, &savec);
+	lieee1 = t1 == a && t2 > savec && lrnd;
+
+/*        Now find  the  mantissa, t.  It should  be the  integer part
+ of   
+          log to the base beta of a,  however it is safer to determine
+  t   
+          by powering.  So we find t as the smallest positive integer 
+for   
+          which   
+
+             fl( beta**t + 1.0 ) = 1.0. */
+
+	lt = 0;
+	a = 1.;
+	c = 1.;
+
+/* +       WHILE( C.EQ.ONE )LOOP */
+L30:
+	if (c == one) {
+	    ++lt;
+	    a *= lbeta;
+	    c = dlamc3_(&a, &one);
+	    d__1 = -a;
+	    c = dlamc3_(&c, &d__1);
+	    goto L30;
+	}
+/* +       END WHILE */
+
+    }
+
+    *beta = lbeta;
+    *t = lt;
+    *rnd = lrnd;
+    *ieee1 = lieee1;
+    return 0;
+
+/*     End of DLAMC1 */
+
+} /* dlamc1_ */
+
+
+/* Subroutine */ int dlamc2_(int *beta, int *t, int *rnd, 
+	double *eps, int *emin, double *rmin, int *emax, 
+	double *rmax)
+{
+/*  -- LAPACK auxiliary routine (version 2.0) --   
+       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
+       Courant Institute, Argonne National Lab, and Rice University   
+       October 31, 1992   
+
+
+    Purpose   
+    =======   
+
+    DLAMC2 determines the machine parameters specified in its argument   
+    list.   
+
+    Arguments   
+    =========   
+
+    BETA    (output) INT   
+            The base of the machine.   
+
+    T       (output) INT   
+            The number of ( BETA ) digits in the mantissa.   
+
+    RND     (output) INT   
+            Specifies whether proper rounding  ( RND = .TRUE. )  or   
+            chopping  ( RND = .FALSE. )  occurs in addition. This may not 
+  
+            be a reliable guide to the way in which the machine performs 
+  
+            its arithmetic.   
+
+    EPS     (output) DOUBLE PRECISION   
+            The smallest positive number such that   
+
+               fl( 1.0 - EPS ) .LT. 1.0,   
+
+            where fl denotes the computed value.   
+
+    EMIN    (output) INT   
+            The minimum exponent before (gradual) underflow occurs.   
+
+    RMIN    (output) DOUBLE PRECISION   
+            The smallest normalized number for the machine, given by   
+            BASE**( EMIN - 1 ), where  BASE  is the floating point value 
+  
+            of BETA.   
+
+    EMAX    (output) INT   
+            The maximum exponent before overflow occurs.   
+
+    RMAX    (output) DOUBLE PRECISION   
+            The largest positive number for the machine, given by   
+            BASE**EMAX * ( 1 - EPS ), where  BASE  is the floating point 
+  
+            value of BETA.   
+
+    Further Details   
+    ===============   
+
+    The computation of  EPS  is based on a routine PARANOIA by   
+    W. Kahan of the University of California at Berkeley.   
+
+   ===================================================================== 
+*/
+    /* Table of constant values */
+    static int c__1 = 1;
+    
+    /* Initialized data */
+    static int first = TRUE_;
+    static int iwarn = FALSE_;
+    /* System generated locals */
+    int i__1;
+    double d__1, d__2, d__3, d__4, d__5;
+    /* Builtin functions */
+    double pow_di(double *, int *);
+    /* Local variables */
+    static int ieee;
+    static double half;
+    static int lrnd;
+    static double leps, zero, a, b, c;
+    static int i, lbeta;
+    static double rbase;
+    static int lemin, lemax, gnmin;
+    static double small;
+    static int gpmin;
+    static double third, lrmin, lrmax, sixth;
+    extern /* Subroutine */ int dlamc1_(int *, int *, int *, 
+	    int *);
+    extern double dlamc3_(double *, double *);
+    static int lieee1;
+    extern /* Subroutine */ int dlamc4_(int *, double *, int *), 
+	    dlamc5_(int *, int *, int *, int *, int *, 
+	    double *);
+    static int lt, ngnmin, ngpmin;
+    static double one, two;
+
+    if (first) {
+	first = FALSE_;
+	zero = 0.;
+	one = 1.;
+	two = 2.;
+
+/*        LBETA, LT, LRND, LEPS, LEMIN and LRMIN  are the local values
+ of   
+          BETA, T, RND, EPS, EMIN and RMIN.   
+
+          Throughout this routine  we use the function  DLAMC3  to ens
+ure   
+          that relevant values are stored  and not held in registers, 
+ or   
+          are not affected by optimizers.   
+
+          DLAMC1 returns the parameters  LBETA, LT, LRND and LIEEE1. 
+*/
+
+	dlamc1_(&lbeta, &lt, &lrnd, &lieee1);
+
+/*        Start to find EPS. */
+
+	b = (double) lbeta;
+	i__1 = -lt;
+	a = pow_di(&b, &i__1);
+	leps = a;
+
+/*        Try some tricks to see whether or not this is the correct  E
+PS. */
+
+	b = two / 3;
+	half = one / 2;
+	d__1 = -half;
+	sixth = dlamc3_(&b, &d__1);
+	third = dlamc3_(&sixth, &sixth);
+	d__1 = -half;
+	b = dlamc3_(&third, &d__1);
+	b = dlamc3_(&b, &sixth);
+	b = abs(b);
+	if (b < leps) {
+	    b = leps;
+	}
+
+	leps = 1.;
+
+/* +       WHILE( ( LEPS.GT.B ).AND.( B.GT.ZERO ) )LOOP */
+L10:
+	if (leps > b && b > zero) {
+	    leps = b;
+	    d__1 = half * leps;
+/* Computing 5th power */
+	    d__3 = two, d__4 = d__3, d__3 *= d__3;
+/* Computing 2nd power */
+	    d__5 = leps;
+	    d__2 = d__4 * (d__3 * d__3) * (d__5 * d__5);
+	    c = dlamc3_(&d__1, &d__2);
+	    d__1 = -c;
+	    c = dlamc3_(&half, &d__1);
+	    b = dlamc3_(&half, &c);
+	    d__1 = -b;
+	    c = dlamc3_(&half, &d__1);
+	    b = dlamc3_(&half, &c);
+	    goto L10;
+	}
+/* +       END WHILE */
+
+	if (a < leps) {
+	    leps = a;
+	}
+
+/*        Computation of EPS complete.   
+
+          Now find  EMIN.  Let A = + or - 1, and + or - (1 + BASE**(-3
+)).   
+          Keep dividing  A by BETA until (gradual) underflow occurs. T
+his   
+          is detected when we cannot recover the previous A. */
+
+	rbase = one / lbeta;
+	small = one;
+	for (i = 1; i <= 3; ++i) {
+	    d__1 = small * rbase;
+	    small = dlamc3_(&d__1, &zero);
+/* L20: */
+	}
+	a = dlamc3_(&one, &small);
+	dlamc4_(&ngpmin, &one, &lbeta);
+	d__1 = -one;
+	dlamc4_(&ngnmin, &d__1, &lbeta);
+	dlamc4_(&gpmin, &a, &lbeta);
+	d__1 = -a;
+	dlamc4_(&gnmin, &d__1, &lbeta);
+	ieee = FALSE_;
+
+	if (ngpmin == ngnmin && gpmin == gnmin) {
+	    if (ngpmin == gpmin) {
+		lemin = ngpmin;
+/*            ( Non twos-complement machines, no gradual under
+flow;   
+                e.g.,  VAX ) */
+	    } else if (gpmin - ngpmin == 3) {
+		lemin = ngpmin - 1 + lt;
+		ieee = TRUE_;
+/*            ( Non twos-complement machines, with gradual und
+erflow;   
+                e.g., IEEE standard followers ) */
+	    } else {
+		lemin = min(ngpmin,gpmin);
+/*            ( A guess; no known machine ) */
+		iwarn = TRUE_;
+	    }
+
+	} else if (ngpmin == gpmin && ngnmin == gnmin) {
+	    if ((i__1 = ngpmin - ngnmin, abs(i__1)) == 1) {
+		lemin = max(ngpmin,ngnmin);
+/*            ( Twos-complement machines, no gradual underflow
+;   
+                e.g., CYBER 205 ) */
+	    } else {
+		lemin = min(ngpmin,ngnmin);
+/*            ( A guess; no known machine ) */
+		iwarn = TRUE_;
+	    }
+
+	} else if ((i__1 = ngpmin - ngnmin, abs(i__1)) == 1 && gpmin == gnmin)
+		 {
+	    if (gpmin - min(ngpmin,ngnmin) == 3) {
+		lemin = max(ngpmin,ngnmin) - 1 + lt;
+/*            ( Twos-complement machines with gradual underflo
+w;   
+                no known machine ) */
+	    } else {
+		lemin = min(ngpmin,ngnmin);
+/*            ( A guess; no known machine ) */
+		iwarn = TRUE_;
+	    }
+
+	} else {
+/* Computing MIN */
+	    i__1 = min(ngpmin,ngnmin), i__1 = min(i__1,gpmin);
+	    lemin = min(i__1,gnmin);
+/*         ( A guess; no known machine ) */
+	    iwarn = TRUE_;
+	}
+/* **   
+   Comment out this if block if EMIN is ok */
+	if (iwarn) {
+	    first = TRUE_;
+	    printf("\n\n WARNING. The value EMIN may be incorrect:- ");
+	    printf("EMIN = %8i\n",lemin);
+	    printf("If, after inspection, the value EMIN looks acceptable");
+            printf("please comment out \n the IF block as marked within the"); 
+            printf("code of routine DLAMC2, \n otherwise supply EMIN"); 
+            printf("explicitly.\n");
+	}
+/* **   
+
+          Assume IEEE arithmetic if we found denormalised  numbers abo
+ve,   
+          or if arithmetic seems to round in the  IEEE style,  determi
+ned   
+          in routine DLAMC1. A true IEEE machine should have both  thi
+ngs   
+          true; however, faulty machines may have one or the other. */
+
+	ieee = ieee || lieee1;
+
+/*        Compute  RMIN by successive division by  BETA. We could comp
+ute   
+          RMIN as BASE**( EMIN - 1 ),  but some machines underflow dur
+ing   
+          this computation. */
+
+	lrmin = 1.;
+	i__1 = 1 - lemin;
+	for (i = 1; i <= 1-lemin; ++i) {
+	    d__1 = lrmin * rbase;
+	    lrmin = dlamc3_(&d__1, &zero);
+/* L30: */
+	}
+
+/*        Finally, call DLAMC5 to compute EMAX and RMAX. */
+
+	dlamc5_(&lbeta, &lt, &lemin, &ieee, &lemax, &lrmax);
+    }
+
+    *beta = lbeta;
+    *t = lt;
+    *rnd = lrnd;
+    *eps = leps;
+    *emin = lemin;
+    *rmin = lrmin;
+    *emax = lemax;
+    *rmax = lrmax;
+
+    return 0;
+
+
+/*     End of DLAMC2 */
+
+} /* dlamc2_ */
+
+
+double dlamc3_(double *a, double *b)
+{
+/*  -- LAPACK auxiliary routine (version 2.0) --   
+       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
+       Courant Institute, Argonne National Lab, and Rice University   
+       October 31, 1992   
+
+
+    Purpose   
+    =======   
+
+    DLAMC3  is intended to force  A  and  B  to be stored prior to doing 
+  
+    the addition of  A  and  B ,  for use in situations where optimizers 
+  
+    might hold one of these in a register.   
+
+    Arguments   
+    =========   
+
+    A, B    (input) DOUBLE PRECISION   
+            The values A and B.   
+
+   ===================================================================== 
+*/
+/* >>Start of File<<   
+       System generated locals */
+    double ret_val;
+
+    ret_val = *a + *b;
+
+    return ret_val;
+
+/*     End of DLAMC3 */
+
+} /* dlamc3_ */
+
+
+/* Subroutine */ int dlamc4_(int *emin, double *start, int *base)
+{
+/*  -- LAPACK auxiliary routine (version 2.0) --   
+       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
+       Courant Institute, Argonne National Lab, and Rice University   
+       October 31, 1992   
+
+
+    Purpose   
+    =======   
+
+    DLAMC4 is a service routine for DLAMC2.   
+
+    Arguments   
+    =========   
+
+    EMIN    (output) EMIN   
+            The minimum exponent before (gradual) underflow, computed by 
+  
+            setting A = START and dividing by BASE until the previous A   
+            can not be recovered.   
+
+    START   (input) DOUBLE PRECISION   
+            The starting point for determining EMIN.   
+
+    BASE    (input) INT   
+            The base of the machine.   
+
+   ===================================================================== 
+*/
+    /* System generated locals */
+    int i__1;
+    double d__1;
+    /* Local variables */
+    static double zero, a;
+    static int i;
+    static double rbase, b1, b2, c1, c2, d1, d2;
+    extern double dlamc3_(double *, double *);
+    static double one;
+
+    a = *start;
+    one = 1.;
+    rbase = one / *base;
+    zero = 0.;
+    *emin = 1;
+    d__1 = a * rbase;
+    b1 = dlamc3_(&d__1, &zero);
+    c1 = a;
+    c2 = a;
+    d1 = a;
+    d2 = a;
+/* +    WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND.   
+      $       ( D1.EQ.A ).AND.( D2.EQ.A )      )LOOP */
+L10:
+    if (c1 == a && c2 == a && d1 == a && d2 == a) {
+	--(*emin);
+	a = b1;
+	d__1 = a / *base;
+	b1 = dlamc3_(&d__1, &zero);
+	d__1 = b1 * *base;
+	c1 = dlamc3_(&d__1, &zero);
+	d1 = zero;
+	i__1 = *base;
+	for (i = 1; i <= *base; ++i) {
+	    d1 += b1;
+/* L20: */
+	}
+	d__1 = a * rbase;
+	b2 = dlamc3_(&d__1, &zero);
+	d__1 = b2 / rbase;
+	c2 = dlamc3_(&d__1, &zero);
+	d2 = zero;
+	i__1 = *base;
+	for (i = 1; i <= *base; ++i) {
+	    d2 += b2;
+/* L30: */
+	}
+	goto L10;
+    }
+/* +    END WHILE */
+
+    return 0;
+
+/*     End of DLAMC4 */
+
+} /* dlamc4_ */
+
+
+/* Subroutine */ int dlamc5_(int *beta, int *p, int *emin, 
+	int *ieee, int *emax, double *rmax)
+{
+/*  -- LAPACK auxiliary routine (version 2.0) --   
+       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
+       Courant Institute, Argonne National Lab, and Rice University   
+       October 31, 1992   
+
+
+    Purpose   
+    =======   
+
+    DLAMC5 attempts to compute RMAX, the largest machine floating-point   
+    number, without overflow.  It assumes that EMAX + abs(EMIN) sum   
+    approximately to a power of 2.  It will fail on machines where this   
+    assumption does not hold, for example, the Cyber 205 (EMIN = -28625, 
+  
+    EMAX = 28718).  It will also fail if the value supplied for EMIN is   
+    too large (i.e. too close to zero), probably with overflow.   
+
+    Arguments   
+    =========   
+
+    BETA    (input) INT   
+            The base of floating-point arithmetic.   
+
+    P       (input) INT   
+            The number of base BETA digits in the mantissa of a   
+            floating-point value.   
+
+    EMIN    (input) INT   
+            The minimum exponent before (gradual) underflow.   
+
+    IEEE    (input) INT   
+            A int flag specifying whether or not the arithmetic   
+            system is thought to comply with the IEEE standard.   
+
+    EMAX    (output) INT   
+            The largest exponent before overflow   
+
+    RMAX    (output) DOUBLE PRECISION   
+            The largest machine floating-point number.   
+
+   ===================================================================== 
+  
+
+
+       First compute LEXP and UEXP, two powers of 2 that bound   
+       abs(EMIN). We then assume that EMAX + abs(EMIN) will sum   
+       approximately to the bound that is closest to abs(EMIN).   
+       (EMAX is the exponent of the required number RMAX). */
+    /* Table of constant values */
+    static double c_b5 = 0.;
+    
+    /* System generated locals */
+    int i__1;
+    double d__1;
+    /* Local variables */
+    static int lexp;
+    static double oldy;
+    static int uexp, i;
+    static double y, z;
+    static int nbits;
+    extern double dlamc3_(double *, double *);
+    static double recbas;
+    static int exbits, expsum, try__;
+
+
+
+    lexp = 1;
+    exbits = 1;
+L10:
+    try__ = lexp << 1;
+    if (try__ <= -(*emin)) {
+	lexp = try__;
+	++exbits;
+	goto L10;
+    }
+    if (lexp == -(*emin)) {
+	uexp = lexp;
+    } else {
+	uexp = try__;
+	++exbits;
+    }
+
+/*     Now -LEXP is less than or equal to EMIN, and -UEXP is greater   
+       than or equal to EMIN. EXBITS is the number of bits needed to   
+       store the exponent. */
+
+    if (uexp + *emin > -lexp - *emin) {
+	expsum = lexp << 1;
+    } else {
+	expsum = uexp << 1;
+    }
+
+/*     EXPSUM is the exponent range, approximately equal to   
+       EMAX - EMIN + 1 . */
+
+    *emax = expsum + *emin - 1;
+    nbits = exbits + 1 + *p;
+
+/*     NBITS is the total number of bits needed to store a   
+       floating-point number. */
+
+    if (nbits % 2 == 1 && *beta == 2) {
+
+/*        Either there are an odd number of bits used to store a   
+          floating-point number, which is unlikely, or some bits are 
+  
+          not used in the representation of numbers, which is possible
+,   
+          (e.g. Cray machines) or the mantissa has an implicit bit,   
+          (e.g. IEEE machines, Dec Vax machines), which is perhaps the
+   
+          most likely. We have to assume the last alternative.   
+          If this is true, then we need to reduce EMAX by one because 
+  
+          there must be some way of representing zero in an implicit-b
+it   
+          system. On machines like Cray, we are reducing EMAX by one 
+  
+          unnecessarily. */
+
+	--(*emax);
+    }
+
+    if (*ieee) {
+
+/*        Assume we are on an IEEE machine which reserves one exponent
+   
+          for infinity and NaN. */
+
+	--(*emax);
+    }
+
+/*     Now create RMAX, the largest machine number, which should   
+       be equal to (1.0 - BETA**(-P)) * BETA**EMAX .   
+
+       First compute 1.0 - BETA**(-P), being careful that the   
+       result is less than 1.0 . */
+
+    recbas = 1. / *beta;
+    z = *beta - 1.;
+    y = 0.;
+    i__1 = *p;
+    for (i = 1; i <= *p; ++i) {
+	z *= recbas;
+	if (y < 1.) {
+	    oldy = y;
+	}
+	y = dlamc3_(&y, &z);
+/* L20: */
+    }
+    if (y >= 1.) {
+	y = oldy;
+    }
+
+/*     Now multiply by BETA**EMAX to get RMAX. */
+
+    i__1 = *emax;
+    for (i = 1; i <= *emax; ++i) {
+	d__1 = y * *beta;
+	y = dlamc3_(&d__1, &c_b5);
+/* L30: */
+    }
+
+    *rmax = y;
+    return 0;
+
+/*     End of DLAMC5 */
+
+} /* dlamc5_ */
+
+double pow_di(double *ap, int *bp)
+{
+    double pow, x;
+    int n;
+
+    pow = 1;
+    x = *ap;
+    n = *bp;
+
+    if(n != 0){
+	if(n < 0) {
+	    n = -n;
+	    x = 1/x;
+	}
+	for( ; ; ) {
+	    if(n & 01) pow *= x;
+	    if(n >>= 1)	x *= x;
+	    else break;
+	}
+    }
+    return(pow);
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dlangs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,112 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:	dlangs.c
+ * History:     Modified from lapack routine DLANGE
+ */
+#include <math.h>
+#include "dsp_defs.h"
+#include "util.h"
+
+double dlangs(char *norm, SuperMatrix *A)
+{
+/* 
+    Purpose   
+    =======   
+
+    DLANGS returns the value of the one norm, or the Frobenius norm, or 
+    the infinity norm, or the element of largest absolute value of a 
+    real matrix A.   
+
+    Description   
+    ===========   
+
+    DLANGE returns the value   
+
+       DLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'   
+                (   
+                ( norm1(A),         NORM = '1', 'O' or 'o'   
+                (   
+                ( normI(A),         NORM = 'I' or 'i'   
+                (   
+                ( normF(A),         NORM = 'F', 'f', 'E' or 'e'   
+
+    where  norm1  denotes the  one norm of a matrix (maximum column sum), 
+    normI  denotes the  infinity norm  of a matrix  (maximum row sum) and 
+    normF  denotes the  Frobenius norm of a matrix (square root of sum of 
+    squares).  Note that  max(abs(A(i,j)))  is not a  matrix norm.   
+
+    Arguments   
+    =========   
+
+    NORM    (input) CHARACTER*1   
+            Specifies the value to be returned in DLANGE as described above.   
+    A       (input) SuperMatrix*
+            The M by N sparse matrix A. 
+
+   ===================================================================== 
+*/
+    
+    /* Local variables */
+    NCformat *Astore;
+    double   *Aval;
+    int      i, j, irow;
+    double   value, sum;
+    double   *rwork;
+
+    Astore = A->Store;
+    Aval   = Astore->nzval;
+    
+    if ( MIN(A->nrow, A->ncol) == 0) {
+	value = 0.;
+	
+    } else if (lsame_(norm, "M")) {
+	/* Find max(abs(A(i,j))). */
+	value = 0.;
+	for (j = 0; j < A->ncol; ++j)
+	    for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; i++)
+		value = MAX( value, fabs( Aval[i]) );
+	
+    } else if (lsame_(norm, "O") || *(unsigned char *)norm == '1') {
+	/* Find norm1(A). */
+	value = 0.;
+	for (j = 0; j < A->ncol; ++j) {
+	    sum = 0.;
+	    for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; i++) 
+		sum += fabs(Aval[i]);
+	    value = MAX(value,sum);
+	}
+	
+    } else if (lsame_(norm, "I")) {
+	/* Find normI(A). */
+	if ( !(rwork = (double *) SUPERLU_MALLOC(A->nrow * sizeof(double))) )
+	    ABORT("SUPERLU_MALLOC fails for rwork.");
+	for (i = 0; i < A->nrow; ++i) rwork[i] = 0.;
+	for (j = 0; j < A->ncol; ++j)
+	    for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; i++) {
+		irow = Astore->rowind[i];
+		rwork[irow] += fabs(Aval[i]);
+	    }
+	value = 0.;
+	for (i = 0; i < A->nrow; ++i)
+	    value = MAX(value, rwork[i]);
+	
+	SUPERLU_FREE (rwork);
+	
+    } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+	/* Find normF(A). */
+	ABORT("Not implemented.");
+    } else
+	ABORT("Illegal norm specified.");
+
+    return (value);
+
+} /* dlangs */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dlaqgs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,138 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:	dlaqgs.c
+ * History:     Modified from LAPACK routine DLAQGE
+ */
+#include <math.h>
+#include "dsp_defs.h"
+#include "util.h"
+
+void
+dlaqgs(SuperMatrix *A, double *r, double *c, 
+	double rowcnd, double colcnd, double amax, char *equed)
+{
+/*
+    Purpose   
+    =======   
+
+    DLAQGS equilibrates a general sparse M by N matrix A using the row and   
+    scaling factors in the vectors R and C.   
+
+    See supermatrix.h for the definition of 'SuperMatrix' structure.
+
+    Arguments   
+    =========   
+
+    A       (input/output) SuperMatrix*
+            On exit, the equilibrated matrix.  See EQUED for the form of 
+            the equilibrated matrix. The type of A can be:
+	    Stype = NC; Dtype = _D; Mtype = GE.
+	    
+    R       (input) double*, dimension (A->nrow)
+            The row scale factors for A.
+	    
+    C       (input) double*, dimension (A->ncol)
+            The column scale factors for A.
+	    
+    ROWCND  (input) double
+            Ratio of the smallest R(i) to the largest R(i).
+	    
+    COLCND  (input) double
+            Ratio of the smallest C(i) to the largest C(i).
+	    
+    AMAX    (input) double
+            Absolute value of largest matrix entry.
+	    
+    EQUED   (output) char*
+            Specifies the form of equilibration that was done.   
+            = 'N':  No equilibration   
+            = 'R':  Row equilibration, i.e., A has been premultiplied by  
+                    diag(R).   
+            = 'C':  Column equilibration, i.e., A has been postmultiplied  
+                    by diag(C).   
+            = 'B':  Both row and column equilibration, i.e., A has been
+                    replaced by diag(R) * A * diag(C).   
+
+    Internal Parameters   
+    ===================   
+
+    THRESH is a threshold value used to decide if row or column scaling   
+    should be done based on the ratio of the row or column scaling   
+    factors.  If ROWCND < THRESH, row scaling is done, and if   
+    COLCND < THRESH, column scaling is done.   
+
+    LARGE and SMALL are threshold values used to decide if row scaling   
+    should be done based on the absolute size of the largest matrix   
+    element.  If AMAX > LARGE or AMAX < SMALL, row scaling is done.   
+
+    ===================================================================== 
+*/
+
+#define THRESH    (0.1)
+    
+    /* Local variables */
+    NCformat *Astore;
+    double   *Aval;
+    int i, j, irow;
+    double large, small, cj;
+    extern double dlamch_(char *);
+
+
+    /* Quick return if possible */
+    if (A->nrow <= 0 || A->ncol <= 0) {
+	*(unsigned char *)equed = 'N';
+	return;
+    }
+
+    Astore = A->Store;
+    Aval = Astore->nzval;
+    
+    /* Initialize LARGE and SMALL. */
+    small = dlamch_("Safe minimum") / dlamch_("Precision");
+    large = 1. / small;
+
+    if (rowcnd >= THRESH && amax >= small && amax <= large) {
+	if (colcnd >= THRESH)
+	    *(unsigned char *)equed = 'N';
+	else {
+	    /* Column scaling */
+	    for (j = 0; j < A->ncol; ++j) {
+		cj = c[j];
+		for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+		    Aval[i] *= cj;
+                }
+	    }
+	    *(unsigned char *)equed = 'C';
+	}
+    } else if (colcnd >= THRESH) {
+	/* Row scaling, no column scaling */
+	for (j = 0; j < A->ncol; ++j)
+	    for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+		irow = Astore->rowind[i];
+		Aval[i] *= r[irow];
+	    }
+	*(unsigned char *)equed = 'R';
+    } else {
+	/* Row and column scaling */
+	for (j = 0; j < A->ncol; ++j) {
+	    cj = c[j];
+	    for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+		irow = Astore->rowind[i];
+		Aval[i] *= cj * r[irow];
+	    }
+	}
+	*(unsigned char *)equed = 'B';
+    }
+
+    return;
+
+} /* dlaqgs */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dmemory.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,678 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include "dsp_defs.h"
+#include "util.h"
+
+/* Constants */
+#define NO_MEMTYPE  4      /* 0: lusup;
+			      1: ucol;
+			      2: lsub;
+			      3: usub */
+#define GluIntArray(n)   (5 * (n) + 5)
+
+/* Internal prototypes */
+void  *dexpand (int *, MemType,int, int, GlobalLU_t *);
+int   dLUWorkInit (int, int, int, int **, double **, LU_space_t);
+void  copy_mem_double (int, void *, void *);
+void  dStackCompress (GlobalLU_t *);
+void  dSetupSpace (void *, int, LU_space_t *);
+void  *duser_malloc (int, int);
+void  duser_free (int, int);
+
+/* External prototypes (in memory.c - prec-indep) */
+extern void    copy_mem_int    (int, void *, void *);
+extern void    user_bcopy      (char *, char *, int);
+
+/* Headers for 4 types of dynamatically managed memory */
+typedef struct e_node {
+    int size;      /* length of the memory that has been used */
+    void *mem;     /* pointer to the new malloc'd store */
+} ExpHeader;
+
+typedef struct {
+    int  size;
+    int  used;
+    int  top1;  /* grow upward, relative to &array[0] */
+    int  top2;  /* grow downward */
+    void *array;
+} LU_stack_t;
+
+/* Variables local to this file */
+static ExpHeader *expanders; /* Array of pointers to 4 types of memory */
+static LU_stack_t stack;
+static int no_expand;
+
+/* Macros to manipulate stack */
+#define StackFull(x)         ( x + stack.used >= stack.size )
+#define NotDoubleAlign(addr) ( (long int)addr & 7 )
+#define DoubleAlign(addr)    ( ((long int)addr + 7) & ~7L )
+#define TempSpace(n, w)      ( (2*w + 4 + NO_MARKER)*m*sizeof(int) + \
+			      (w + 1)*n*sizeof(double) )
+#define Reduce(alpha)        ((alpha + 1) / 2)  /* i.e. (alpha-1)/2 + 1 */
+
+
+
+
+/*
+ * Setup the memory model to be used for factorization.
+ *    lwork = 0: use system malloc;
+ *    lwork > 0: use user-supplied work[] space.
+ */
+void dSetupSpace(void *work, int lwork, LU_space_t *MemModel)
+{
+    if ( lwork == 0 ) {
+	*MemModel = SYSTEM; /* malloc/free */
+    } else if ( lwork > 0 ) {
+	*MemModel = USER;   /* user provided space */
+	stack.used = 0;
+	stack.top1 = 0;
+	stack.top2 = (lwork/4)*4; /* must be word addressable */
+	stack.size = stack.top2;
+	stack.array = (void *) work;
+    }
+}
+
+
+
+void *duser_malloc(int bytes, int which_end)
+{
+    void *buf;
+    
+    if ( StackFull(bytes) ) return (NULL);
+
+    if ( which_end == HEAD ) {
+	buf = (char*) stack.array + stack.top1;
+	stack.top1 += bytes;
+    } else {
+	stack.top2 -= bytes;
+	buf = (char*) stack.array + stack.top2;
+    }
+    
+    stack.used += bytes;
+    return buf;
+}
+
+
+void duser_free(int bytes, int which_end)
+{
+    if ( which_end == HEAD ) {
+	stack.top1 -= bytes;
+    } else {
+	stack.top2 += bytes;
+    }
+    stack.used -= bytes;
+}
+
+
+
+/*
+ * mem_usage consists of the following fields:
+ *    - for_lu (float)
+ *      The amount of space used in bytes for the L\U data structures.
+ *    - total_needed (float)
+ *      The amount of space needed in bytes to perform factorization.
+ *    - expansions (int)
+ *      Number of memory expansions during the LU factorization.
+ */
+int dQuerySpace(SuperMatrix *L, SuperMatrix *U, int panel_size,
+	        mem_usage_t *mem_usage)
+{
+    SCformat *Lstore;
+    NCformat *Ustore;
+    register int n, iword, dword;
+
+    Lstore = L->Store;
+    Ustore = U->Store;
+    n = L->ncol;
+    iword = sizeof(int);
+    dword = sizeof(double);
+
+    /* For LU factors */
+    mem_usage->for_lu = (float)( (4*n + 3) * iword + Lstore->nzval_colptr[n] *
+				 dword + Lstore->rowind_colptr[n] * iword );
+    mem_usage->for_lu += (float)( (n + 1) * iword +
+				 Ustore->colptr[n] * (dword + iword) );
+
+    /* Working storage to support factorization */
+    mem_usage->total_needed = mem_usage->for_lu +
+	(float)( (2 * panel_size + 4 + NO_MARKER) * n * iword +
+		(panel_size + 1) * n * dword );
+
+    mem_usage->expansions = --no_expand;
+
+    return 0;
+} /* dQuerySpace */
+
+/*
+ * Allocate storage for the data structures common to all factor routines.
+ * For those unpredictable size, make a guess as FILL * nnz(A).
+ * Return value:
+ *     If lwork = -1, return the estimated amount of space required, plus n;
+ *     otherwise, return the amount of space actually allocated when
+ *     memory allocation failure occurred.
+ */
+int
+dLUMemInit(char *refact, void *work, int lwork, int m, int n, int annz,
+	  int panel_size, SuperMatrix *L, SuperMatrix *U, GlobalLU_t *Glu,
+	  int **iwork, double **dwork)
+{
+    int      info, iword, dword;
+    SCformat *Lstore;
+    NCformat *Ustore;
+    int      *xsup, *supno;
+    int      *lsub, *xlsub;
+    double   *lusup;
+    int      *xlusup;
+    double   *ucol;
+    int      *usub, *xusub;
+    int      nzlmax, nzumax, nzlumax;
+    int      FILL = sp_ienv(6);
+    
+    Glu->n    = n;
+    no_expand = 0;
+    iword     = sizeof(int);
+    dword     = sizeof(double);
+
+    expanders = (ExpHeader *) SUPERLU_MALLOC( NO_MEMTYPE * sizeof(ExpHeader) );
+    if ( !expanders ) ABORT("SUPERLU_MALLOC fails for expanders");
+    
+    if ( lsame_(refact, "N") ) {
+	/* Guess for L\U factors */
+	nzumax = nzlumax = FILL * annz;
+	nzlmax = MAX(1, FILL/4.) * annz;
+
+	if ( lwork == -1 ) {
+	    return ( GluIntArray(n) * iword + TempSpace(m, panel_size)
+		    + (nzlmax+nzumax)*iword + (nzlumax+nzumax)*dword + n );
+        } else {
+	    dSetupSpace(work, lwork, &Glu->MemModel);
+	}
+	
+#ifdef DEBUG		   
+	printf("dLUMemInit() called: annz %d, MemModel %d\n", 
+		annz, Glu->MemModel);
+#endif	
+	
+	/* Integer pointers for L\U factors */
+	if ( Glu->MemModel == SYSTEM ) {
+	    xsup   = intMalloc(n+1);
+	    supno  = intMalloc(n+1);
+	    xlsub  = intMalloc(n+1);
+	    xlusup = intMalloc(n+1);
+	    xusub  = intMalloc(n+1);
+	} else {
+	    xsup   = (int *)duser_malloc((n+1) * iword, HEAD);
+	    supno  = (int *)duser_malloc((n+1) * iword, HEAD);
+	    xlsub  = (int *)duser_malloc((n+1) * iword, HEAD);
+	    xlusup = (int *)duser_malloc((n+1) * iword, HEAD);
+	    xusub  = (int *)duser_malloc((n+1) * iword, HEAD);
+	}
+
+	lusup = (double *) dexpand( &nzlumax, LUSUP, 0, 0, Glu );
+	ucol  = (double *) dexpand( &nzumax, UCOL, 0, 0, Glu );
+	lsub  = (int *)    dexpand( &nzlmax, LSUB, 0, 0, Glu );
+	usub  = (int *)    dexpand( &nzumax, USUB, 0, 1, Glu );
+
+	while ( !lusup || !ucol || !lsub || !usub ) {
+	    if ( Glu->MemModel == SYSTEM ) {
+		SUPERLU_FREE(lusup); 
+		SUPERLU_FREE(ucol); 
+		SUPERLU_FREE(lsub); 
+		SUPERLU_FREE(usub);
+	    } else {
+		duser_free((nzlumax+nzumax)*dword+(nzlmax+nzumax)*iword, HEAD);
+	    }
+	    nzlumax /= 2;
+	    nzumax /= 2;
+	    nzlmax /= 2;
+	    if ( nzlumax < annz ) {
+		printf("Not enough memory to perform factorization.\n");
+		return (dmemory_usage(nzlmax, nzumax, nzlumax, n) + n);
+	    }
+	    lusup = (double *) dexpand( &nzlumax, LUSUP, 0, 0, Glu );
+	    ucol  = (double *) dexpand( &nzumax, UCOL, 0, 0, Glu );
+	    lsub  = (int *)    dexpand( &nzlmax, LSUB, 0, 0, Glu );
+	    usub  = (int *)    dexpand( &nzumax, USUB, 0, 1, Glu );
+	}
+	
+    } else {
+	/* refact == 'Y' */
+	Lstore   = L->Store;
+	Ustore   = U->Store;
+	xsup     = Lstore->sup_to_col;
+	supno    = Lstore->col_to_sup;
+	xlsub    = Lstore->rowind_colptr;
+	xlusup   = Lstore->nzval_colptr;
+	xusub    = Ustore->colptr;
+	nzlmax   = Glu->nzlmax;    /* max from previous factorization */
+	nzumax   = Glu->nzumax;
+	nzlumax  = Glu->nzlumax;
+	
+	if ( lwork == -1 ) {
+	    return ( GluIntArray(n) * iword + TempSpace(m, panel_size)
+		    + (nzlmax+nzumax)*iword + (nzlumax+nzumax)*dword + n );
+        } else if ( lwork == 0 ) {
+	    Glu->MemModel = SYSTEM;
+	} else {
+	    Glu->MemModel = USER;
+	    stack.top2 = (lwork/4)*4; /* must be word-addressable */
+	    stack.size = stack.top2;
+	}
+	
+	lsub  = expanders[LSUB].mem  = Lstore->rowind;
+	lusup = expanders[LUSUP].mem = Lstore->nzval;
+	usub  = expanders[USUB].mem  = Ustore->rowind;
+	ucol  = expanders[UCOL].mem  = Ustore->nzval;;
+	expanders[LSUB].size         = nzlmax;
+	expanders[LUSUP].size        = nzlumax;
+	expanders[USUB].size         = nzumax;
+	expanders[UCOL].size         = nzumax;	
+    }
+
+    Glu->xsup    = xsup;
+    Glu->supno   = supno;
+    Glu->lsub    = lsub;
+    Glu->xlsub   = xlsub;
+    Glu->lusup   = lusup;
+    Glu->xlusup  = xlusup;
+    Glu->ucol    = ucol;
+    Glu->usub    = usub;
+    Glu->xusub   = xusub;
+    Glu->nzlmax  = nzlmax;
+    Glu->nzumax  = nzumax;
+    Glu->nzlumax = nzlumax;
+    
+    info = dLUWorkInit(m, n, panel_size, iwork, dwork, Glu->MemModel);
+    if ( info )
+	return ( info + dmemory_usage(nzlmax, nzumax, nzlumax, n) + n);
+    
+    ++no_expand;
+    return 0;
+    
+} /* dLUMemInit */
+
+/* Allocate known working storage. Returns 0 if success, otherwise
+   returns the number of bytes allocated so far when failure occurred. */
+int
+dLUWorkInit(int m, int n, int panel_size, int **iworkptr, 
+            double **dworkptr, LU_space_t MemModel)
+{
+    int    isize, dsize, extra;
+    double *old_ptr;
+    int    maxsuper = sp_ienv(3),
+           rowblk   = sp_ienv(4);
+
+    isize = ( (2 * panel_size + 3 + NO_MARKER ) * m + n ) * sizeof(int);
+    dsize = (m * panel_size +
+	     NUM_TEMPV(m,panel_size,maxsuper,rowblk)) * sizeof(double);
+    
+    if ( MemModel == SYSTEM ) 
+	*iworkptr = (int *) intCalloc(isize/sizeof(int));
+    else
+	*iworkptr = (int *) duser_malloc(isize, TAIL);
+    if ( ! *iworkptr ) {
+	fprintf(stderr, "dLUWorkInit: malloc fails for local iworkptr[]\n");
+	return (isize + n);
+    }
+
+    if ( MemModel == SYSTEM )
+	*dworkptr = (double *) SUPERLU_MALLOC(dsize);
+    else {
+	*dworkptr = (double *) duser_malloc(dsize, TAIL);
+	if ( NotDoubleAlign(*dworkptr) ) {
+	    old_ptr = *dworkptr;
+	    *dworkptr = (double*) DoubleAlign(*dworkptr);
+	    *dworkptr = (double*) ((double*)*dworkptr - 1);
+	    extra = (char*)old_ptr - (char*)*dworkptr;
+#ifdef DEBUG	    
+	    printf("dLUWorkInit: not aligned, extra %d\n", extra);
+#endif	    
+	    stack.top2 -= extra;
+	    stack.used += extra;
+	}
+    }
+    if ( ! *dworkptr ) {
+	fprintf(stderr, "malloc fails for local dworkptr[].");
+	return (isize + dsize + n);
+    }
+	
+    return 0;
+}
+
+
+/*
+ * Set up pointers for real working arrays.
+ */
+void
+dSetRWork(int m, int panel_size, double *dworkptr,
+	 double **dense, double **tempv)
+{
+    double zero = 0.0;
+
+    int maxsuper = sp_ienv(3),
+        rowblk   = sp_ienv(4);
+    *dense = dworkptr;
+    *tempv = *dense + panel_size*m;
+    dfill (*dense, m * panel_size, zero);
+    dfill (*tempv, NUM_TEMPV(m,panel_size,maxsuper,rowblk), zero);     
+}
+	
+/*
+ * Free the working storage used by factor routines.
+ */
+void dLUWorkFree(int *iwork, double *dwork, GlobalLU_t *Glu)
+{
+    if ( Glu->MemModel == SYSTEM ) {
+	SUPERLU_FREE (iwork);
+	SUPERLU_FREE (dwork);
+    } else {
+	stack.used -= (stack.size - stack.top2);
+	stack.top2 = stack.size;
+/*	dStackCompress(Glu);  */
+    }
+    
+    SUPERLU_FREE (expanders);
+}
+
+/* Expand the data structures for L and U during the factorization.
+ * Return value:   0 - successful return
+ *               > 0 - number of bytes allocated when run out of space
+ */
+int
+dLUMemXpand(int jcol,
+	   int next,          /* number of elements currently in the factors */
+	   MemType mem_type,  /* which type of memory to expand  */
+	   int *maxlen,       /* modified - maximum length of a data structure */
+	   GlobalLU_t *Glu    /* modified - global LU data structures */
+	   )
+{
+    void   *new_mem;
+    
+#ifdef DEBUG    
+    printf("dLUMemXpand(): jcol %d, next %d, maxlen %d, MemType %d\n",
+	   jcol, next, *maxlen, mem_type);
+#endif    
+
+    if (mem_type == USUB) 
+    	new_mem = dexpand(maxlen, mem_type, next, 1, Glu);
+    else
+	new_mem = dexpand(maxlen, mem_type, next, 0, Glu);
+    
+    if ( !new_mem ) {
+	int    nzlmax  = Glu->nzlmax;
+	int    nzumax  = Glu->nzumax;
+	int    nzlumax = Glu->nzlumax;
+    	fprintf(stderr, "Can't expand MemType %d: jcol %d\n", mem_type, jcol);
+    	return (dmemory_usage(nzlmax, nzumax, nzlumax, Glu->n) + Glu->n);
+    }
+
+    switch ( mem_type ) {
+      case LUSUP:
+	Glu->lusup   = (double *) new_mem;
+	Glu->nzlumax = *maxlen;
+	break;
+      case UCOL:
+	Glu->ucol   = (double *) new_mem;
+	Glu->nzumax = *maxlen;
+	break;
+      case LSUB:
+	Glu->lsub   = (int *) new_mem;
+	Glu->nzlmax = *maxlen;
+	break;
+      case USUB:
+	Glu->usub   = (int *) new_mem;
+	Glu->nzumax = *maxlen;
+	break;
+    }
+    
+    return 0;
+    
+}
+
+
+
+void
+copy_mem_double(int howmany, void *old, void *new)
+{
+    register int i;
+    double *dold = old;
+    double *dnew = new;
+    for (i = 0; i < howmany; i++) dnew[i] = dold[i];
+}
+
+/*
+ * Expand the existing storage to accommodate more fill-ins.
+ */
+void
+*dexpand (
+	 int *prev_len,   /* length used from previous call */
+	 MemType type,    /* which part of the memory to expand */
+	 int len_to_copy, /* size of the memory to be copied to new store */
+	 int keep_prev,   /* = 1: use prev_len;
+			     = 0: compute new_len to expand */
+	 GlobalLU_t *Glu  /* modified - global LU data structures */
+	)
+{
+    float    EXPAND = 1.5;
+    float    alpha;
+    void     *new_mem, *old_mem;
+    int      new_len, tries, lword, extra, bytes_to_copy;
+
+    alpha = EXPAND;
+
+    if ( no_expand == 0 || keep_prev ) /* First time allocate requested */
+        new_len = *prev_len;
+    else {
+	new_len = alpha * *prev_len;
+    }
+    
+    if ( type == LSUB || type == USUB ) lword = sizeof(int);
+    else lword = sizeof(double);
+
+    if ( Glu->MemModel == SYSTEM ) {
+	new_mem = (void *) SUPERLU_MALLOC(new_len * lword);
+/*	new_mem = (void *) calloc(new_len, lword); */
+	if ( no_expand != 0 ) {
+	    tries = 0;
+	    if ( keep_prev ) {
+		if ( !new_mem ) return (NULL);
+	    } else {
+		while ( !new_mem ) {
+		    if ( ++tries > 10 ) return (NULL);
+		    alpha = Reduce(alpha);
+		    new_len = alpha * *prev_len;
+		    new_mem = (void *) SUPERLU_MALLOC(new_len * lword); 
+/*		    new_mem = (void *) calloc(new_len, lword); */
+		}
+	    }
+	    if ( type == LSUB || type == USUB ) {
+		copy_mem_int(len_to_copy, expanders[type].mem, new_mem);
+	    } else {
+		copy_mem_double(len_to_copy, expanders[type].mem, new_mem);
+	    }
+	    SUPERLU_FREE (expanders[type].mem);
+	}
+	expanders[type].mem = (void *) new_mem;
+	
+    } else { /* MemModel == USER */
+	if ( no_expand == 0 ) {
+	    new_mem = duser_malloc(new_len * lword, HEAD);
+	    if ( NotDoubleAlign(new_mem) &&
+		(type == LUSUP || type == UCOL) ) {
+		old_mem = new_mem;
+		new_mem = (void *)DoubleAlign(new_mem);
+		extra = (char*)new_mem - (char*)old_mem;
+#ifdef DEBUG		
+		printf("expand(): not aligned, extra %d\n", extra);
+#endif		
+		stack.top1 += extra;
+		stack.used += extra;
+	    }
+	    expanders[type].mem = (void *) new_mem;
+	}
+	else {
+	    tries = 0;
+	    extra = (new_len - *prev_len) * lword;
+	    if ( keep_prev ) {
+		if ( StackFull(extra) ) return (NULL);
+	    } else {
+		while ( StackFull(extra) ) {
+		    if ( ++tries > 10 ) return (NULL);
+		    alpha = Reduce(alpha);
+		    new_len = alpha * *prev_len;
+		    extra = (new_len - *prev_len) * lword;	    
+		}
+	    }
+
+	    if ( type != USUB ) {
+		new_mem = (void*)((char*)expanders[type + 1].mem + extra);
+		bytes_to_copy = (char*)stack.array + stack.top1
+		    - (char*)expanders[type + 1].mem;
+		user_bcopy(expanders[type+1].mem, new_mem, bytes_to_copy);
+
+		if ( type < USUB ) {
+		    Glu->usub = expanders[USUB].mem =
+			(void*)((char*)expanders[USUB].mem + extra);
+		}
+		if ( type < LSUB ) {
+		    Glu->lsub = expanders[LSUB].mem =
+			(void*)((char*)expanders[LSUB].mem + extra);
+		}
+		if ( type < UCOL ) {
+		    Glu->ucol = expanders[UCOL].mem =
+			(void*)((char*)expanders[UCOL].mem + extra);
+		}
+		stack.top1 += extra;
+		stack.used += extra;
+		if ( type == UCOL ) {
+		    stack.top1 += extra;   /* Add same amount for USUB */
+		    stack.used += extra;
+		}
+		
+	    } /* if ... */
+
+	} /* else ... */
+    }
+
+    expanders[type].size = new_len;
+    *prev_len = new_len;
+    if ( no_expand ) ++no_expand;
+    
+    return (void *) expanders[type].mem;
+    
+} /* dexpand */
+
+
+/*
+ * Compress the work[] array to remove fragmentation.
+ */
+void
+dStackCompress(GlobalLU_t *Glu)
+{
+    register int iword, dword, bytes_to_copy, ndim;
+    char    *last, *fragment;
+    char     *src, *dest;
+    int      *ifrom, *ito;
+    double   *dfrom, *dto;
+    int      *xlsub, *lsub, *xusub, *usub, *xlusup;
+    double   *ucol, *lusup;
+    
+    iword = sizeof(int);
+    dword = sizeof(double);
+    ndim = Glu->n;
+
+    xlsub  = Glu->xlsub;
+    lsub   = Glu->lsub;
+    xusub  = Glu->xusub;
+    usub   = Glu->usub;
+    xlusup = Glu->xlusup;
+    ucol   = Glu->ucol;
+    lusup  = Glu->lusup;
+    
+    dfrom = ucol;
+    dto = (double *)((char*)lusup + xlusup[ndim] * dword);
+    copy_mem_double(xusub[ndim], dfrom, dto);
+    ucol = dto;
+
+    ifrom = lsub;
+    ito = (int *) ((char*)ucol + xusub[ndim] * iword);
+    copy_mem_int(xlsub[ndim], ifrom, ito);
+    lsub = ito;
+    
+    ifrom = usub;
+    ito = (int *) ((char*)lsub + xlsub[ndim] * iword);
+    copy_mem_int(xusub[ndim], ifrom, ito);
+    usub = ito;
+    
+    last = (char*)usub + xusub[ndim] * iword;
+    fragment = (char*) (((char*)stack.array + stack.top1) - last);
+    stack.used -= (long int) fragment;
+    stack.top1 -= (long int) fragment;
+
+    Glu->ucol = ucol;
+    Glu->lsub = lsub;
+    Glu->usub = usub;
+    
+#ifdef DEBUG
+    printf("dStackCompress: fragment %d\n", fragment);
+    /* for (last = 0; last < ndim; ++last)
+	print_lu_col("After compress:", last, 0);*/
+#endif    
+    
+}
+
+/*
+ * Allocate storage for original matrix A
+ */
+void
+dallocateA(int n, int nnz, double **a, int **asub, int **xa)
+{
+    *a    = (double *) doubleMalloc(nnz);
+    *asub = (int *) intMalloc(nnz);
+    *xa   = (int *) intMalloc(n+1);
+}
+
+
+double *doubleMalloc(int n)
+{
+    double *buf;
+    buf = (double *) SUPERLU_MALLOC(n * sizeof(double)); 
+    if ( !buf ) {
+	ABORT("SUPERLU_MALLOC failed for buf in doubleMalloc()\n");
+    }
+    return (buf);
+}
+
+double *doubleCalloc(int n)
+{
+    double *buf;
+    register int i;
+    double zero = 0.0;
+    buf = (double *) SUPERLU_MALLOC(n * sizeof(double));
+    if ( !buf ) {
+	ABORT("SUPERLU_MALLOC failed for buf in doubleCalloc()\n");
+    }
+    for (i = 0; i < n; ++i) buf[i] = zero;
+    return (buf);
+}
+
+
+int dmemory_usage(const int nzlmax, const int nzumax, 
+		  const int nzlumax, const int n)
+{
+    register int iword, dword;
+
+    iword   = sizeof(int);
+    dword   = sizeof(double);
+    
+    return (10 * n * iword +
+	    nzlmax * iword + nzumax * (iword + dword) + nzlumax * dword);
+
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dpanel_bmod.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,452 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "dsp_defs.h"
+#include "util.h"
+
+/* 
+ * Function prototypes 
+ */
+void dlsolve(int, int, double *, double *);
+void dmatvec(int, int, int, double *, double *, double *);
+extern void dcheck_tempv();
+
+void
+dpanel_bmod (
+	    const int  m,          /* in - number of rows in the matrix */
+	    const int  w,          /* in */
+	    const int  jcol,       /* in */
+	    const int  nseg,       /* in */
+	    double     *dense,     /* out, of size n by w */
+	    double     *tempv,     /* working array */
+	    int        *segrep,    /* in */
+	    int        *repfnz,    /* in, of size n by w */
+	    GlobalLU_t *Glu        /* modified */
+	    )
+{
+/* 
+ * Purpose
+ * =======
+ *
+ *    Performs numeric block updates (sup-panel) in topological order.
+ *    It features: col-col, 2cols-col, 3cols-col, and sup-col updates.
+ *    Special processing on the supernodal portion of L\U[*,j]
+ *
+ *    Before entering this routine, the original nonzeros in the panel 
+ *    were already copied into the spa[m,w].
+ *
+ *    Updated/Output parameters-
+ *	dense[0:m-1,w]: L[*,j:j+w-1] and U[*,j:j+w-1] are returned 
+ *      collectively in the m-by-w vector dense[*]. 
+ *
+ */
+
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+    _fcd ftcs1 = _cptofcd("L", strlen("L")),
+         ftcs2 = _cptofcd("N", strlen("N")),
+         ftcs3 = _cptofcd("U", strlen("U"));
+#endif
+    int          incx = 1, incy = 1;
+    double       alpha, beta;
+#endif
+
+    register int k, ksub;
+    int          fsupc, nsupc, nsupr, nrow;
+    int          krep, krep_ind;
+    double       ukj, ukj1, ukj2;
+    int          luptr, luptr1, luptr2;
+    int          segsze;
+    int          block_nrow;  /* no of rows in a block row */
+    register int lptr;	      /* Points to the row subscripts of a supernode */
+    int          kfnz, irow, no_zeros; 
+    register int isub, isub1, i;
+    register int jj;	      /* Index through each column in the panel */
+    int          *xsup, *supno;
+    int          *lsub, *xlsub;
+    double       *lusup;
+    int          *xlusup;
+    int          *repfnz_col; /* repfnz[] for a column in the panel */
+    double       *dense_col;  /* dense[] for a column in the panel */
+    double       *tempv1;             /* Used in 1-D update */
+    double       *TriTmp, *MatvecTmp; /* used in 2-D update */
+    double      zero = 0.0;
+    double      one = 1.0;
+    register int ldaTmp;
+    register int r_ind, r_hi;
+    static   int first = 1, maxsuper, rowblk, colblk;
+    extern SuperLUStat_t SuperLUStat;
+    flops_t  *ops = SuperLUStat.ops;
+    
+    xsup    = Glu->xsup;
+    supno   = Glu->supno;
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    lusup   = Glu->lusup;
+    xlusup  = Glu->xlusup;
+    
+    if ( first ) {
+	maxsuper = sp_ienv(3);
+	rowblk   = sp_ienv(4);
+	colblk   = sp_ienv(5);
+	first = 0;
+    }
+    ldaTmp = maxsuper + rowblk;
+
+    /* 
+     * For each nonz supernode segment of U[*,j] in topological order 
+     */
+    k = nseg - 1;
+    for (ksub = 0; ksub < nseg; ksub++) { /* for each updating supernode */
+
+	/* krep = representative of current k-th supernode
+	 * fsupc = first supernodal column
+	 * nsupc = no of columns in a supernode
+	 * nsupr = no of rows in a supernode
+	 */
+        krep = segrep[k--];
+	fsupc = xsup[supno[krep]];
+	nsupc = krep - fsupc + 1;
+	nsupr = xlsub[fsupc+1] - xlsub[fsupc];
+	nrow = nsupr - nsupc;
+	lptr = xlsub[fsupc];
+	krep_ind = lptr + nsupc - 1;
+
+	repfnz_col = repfnz;
+	dense_col = dense;
+	
+	if ( nsupc >= colblk && nrow > rowblk ) { /* 2-D block update */
+
+	    TriTmp = tempv;
+	
+	    /* Sequence through each column in panel -- triangular solves */
+	    for (jj = jcol; jj < jcol + w; jj++,
+		 repfnz_col += m, dense_col += m, TriTmp += ldaTmp ) {
+
+		kfnz = repfnz_col[krep];
+		if ( kfnz == EMPTY ) continue;	/* Skip any zero segment */
+	    
+		segsze = krep - kfnz + 1;
+		luptr = xlusup[fsupc];
+
+		ops[TRSV] += segsze * (segsze - 1);
+		ops[GEMV] += 2 * nrow * segsze;
+	
+		/* Case 1: Update U-segment of size 1 -- col-col update */
+		if ( segsze == 1 ) {
+		    ukj = dense_col[lsub[krep_ind]];
+		    luptr += nsupr*(nsupc-1) + nsupc;
+
+		    for (i = lptr + nsupc; i < xlsub[fsupc+1]; i++) {
+			irow = lsub[i];
+			dense_col[irow] -= ukj * lusup[luptr];
+			++luptr;
+		    }
+
+		} else if ( segsze <= 3 ) {
+		    ukj = dense_col[lsub[krep_ind]];
+		    ukj1 = dense_col[lsub[krep_ind - 1]];
+		    luptr += nsupr*(nsupc-1) + nsupc-1;
+		    luptr1 = luptr - nsupr;
+
+		    if ( segsze == 2 ) {
+			ukj -= ukj1 * lusup[luptr1];
+			dense_col[lsub[krep_ind]] = ukj;
+			for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+			    irow = lsub[i];
+			    luptr++; luptr1++;
+			    dense_col[irow] -= (ukj*lusup[luptr]
+						+ ukj1*lusup[luptr1]);
+			}
+		    } else {
+			ukj2 = dense_col[lsub[krep_ind - 2]];
+			luptr2 = luptr1 - nsupr;
+			ukj1 -= ukj2 * lusup[luptr2-1];
+			ukj = ukj - ukj1*lusup[luptr1] - ukj2*lusup[luptr2];
+			dense_col[lsub[krep_ind]] = ukj;
+			dense_col[lsub[krep_ind-1]] = ukj1;
+			for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+			    irow = lsub[i];
+			    luptr++; luptr1++; luptr2++;
+			    dense_col[irow] -= ( ukj*lusup[luptr]
+                             + ukj1*lusup[luptr1] + ukj2*lusup[luptr2] );
+			}
+		    }
+
+		} else  {	/* segsze >= 4 */
+		    
+		    /* Copy U[*,j] segment from dense[*] to TriTmp[*], which
+		       holds the result of triangular solves.    */
+		    no_zeros = kfnz - fsupc;
+		    isub = lptr + no_zeros;
+		    for (i = 0; i < segsze; ++i) {
+			irow = lsub[isub];
+			TriTmp[i] = dense_col[irow]; /* Gather */
+			++isub;
+		    }
+		    
+		    /* start effective triangle */
+		    luptr += nsupr * no_zeros + no_zeros;
+
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		    STRSV( ftcs1, ftcs2, ftcs3, &segsze, &lusup[luptr], 
+			   &nsupr, TriTmp, &incx );
+#else
+		    dtrsv_( "L", "N", "U", &segsze, &lusup[luptr], 
+			   &nsupr, TriTmp, &incx );
+#endif
+#else		
+		    dlsolve ( nsupr, segsze, &lusup[luptr], TriTmp );
+#endif
+		    
+
+		} /* else ... */
+	    
+	    }  /* for jj ... end tri-solves */
+
+	    /* Block row updates; push all the way into dense[*] block */
+	    for ( r_ind = 0; r_ind < nrow; r_ind += rowblk ) {
+		
+		r_hi = MIN(nrow, r_ind + rowblk);
+		block_nrow = MIN(rowblk, r_hi - r_ind);
+		luptr = xlusup[fsupc] + nsupc + r_ind;
+		isub1 = lptr + nsupc + r_ind;
+		
+		repfnz_col = repfnz;
+		TriTmp = tempv;
+		dense_col = dense;
+		
+		/* Sequence through each column in panel -- matrix-vector */
+		for (jj = jcol; jj < jcol + w; jj++,
+		     repfnz_col += m, dense_col += m, TriTmp += ldaTmp) {
+		    
+		    kfnz = repfnz_col[krep];
+		    if ( kfnz == EMPTY ) continue; /* Skip any zero segment */
+		    
+		    segsze = krep - kfnz + 1;
+		    if ( segsze <= 3 ) continue;   /* skip unrolled cases */
+		    
+		    /* Perform a block update, and scatter the result of
+		       matrix-vector to dense[].		 */
+		    no_zeros = kfnz - fsupc;
+		    luptr1 = luptr + nsupr * no_zeros;
+		    MatvecTmp = &TriTmp[maxsuper];
+		    
+#ifdef USE_VENDOR_BLAS
+		    alpha = one; 
+                    beta = zero;
+#ifdef _CRAY
+		    SGEMV(ftcs2, &block_nrow, &segsze, &alpha, &lusup[luptr1], 
+			   &nsupr, TriTmp, &incx, &beta, MatvecTmp, &incy);
+#else
+		    dgemv_("N", &block_nrow, &segsze, &alpha, &lusup[luptr1], 
+			   &nsupr, TriTmp, &incx, &beta, MatvecTmp, &incy);
+#endif
+#else
+		    dmatvec(nsupr, block_nrow, segsze, &lusup[luptr1],
+			   TriTmp, MatvecTmp);
+#endif
+		    
+		    /* Scatter MatvecTmp[*] into SPA dense[*] temporarily
+		     * such that MatvecTmp[*] can be re-used for the
+		     * the next blok row update. dense[] will be copied into 
+		     * global store after the whole panel has been finished.
+		     */
+		    isub = isub1;
+		    for (i = 0; i < block_nrow; i++) {
+			irow = lsub[isub];
+			dense_col[irow] -= MatvecTmp[i];
+			MatvecTmp[i] = zero;
+			++isub;
+		    }
+		    
+		} /* for jj ... */
+		
+	    } /* for each block row ... */
+	    
+	    /* Scatter the triangular solves into SPA dense[*] */
+	    repfnz_col = repfnz;
+	    TriTmp = tempv;
+	    dense_col = dense;
+	    
+	    for (jj = jcol; jj < jcol + w; jj++,
+		 repfnz_col += m, dense_col += m, TriTmp += ldaTmp) {
+		kfnz = repfnz_col[krep];
+		if ( kfnz == EMPTY ) continue; /* Skip any zero segment */
+		
+		segsze = krep - kfnz + 1;
+		if ( segsze <= 3 ) continue; /* skip unrolled cases */
+		
+		no_zeros = kfnz - fsupc;		
+		isub = lptr + no_zeros;
+		for (i = 0; i < segsze; i++) {
+		    irow = lsub[isub];
+		    dense_col[irow] = TriTmp[i];
+		    TriTmp[i] = zero;
+		    ++isub;
+		}
+		
+	    } /* for jj ... */
+	    
+	} else { /* 1-D block modification */
+	    
+	    
+	    /* Sequence through each column in the panel */
+	    for (jj = jcol; jj < jcol + w; jj++,
+		 repfnz_col += m, dense_col += m) {
+		
+		kfnz = repfnz_col[krep];
+		if ( kfnz == EMPTY ) continue;	/* Skip any zero segment */
+		
+		segsze = krep - kfnz + 1;
+		luptr = xlusup[fsupc];
+
+		ops[TRSV] += segsze * (segsze - 1);
+		ops[GEMV] += 2 * nrow * segsze;
+		
+		/* Case 1: Update U-segment of size 1 -- col-col update */
+		if ( segsze == 1 ) {
+		    ukj = dense_col[lsub[krep_ind]];
+		    luptr += nsupr*(nsupc-1) + nsupc;
+
+		    for (i = lptr + nsupc; i < xlsub[fsupc+1]; i++) {
+			irow = lsub[i];
+			dense_col[irow] -= ukj * lusup[luptr];
+			++luptr;
+		    }
+
+		} else if ( segsze <= 3 ) {
+		    ukj = dense_col[lsub[krep_ind]];
+		    luptr += nsupr*(nsupc-1) + nsupc-1;
+		    ukj1 = dense_col[lsub[krep_ind - 1]];
+		    luptr1 = luptr - nsupr;
+
+		    if ( segsze == 2 ) {
+			ukj -= ukj1 * lusup[luptr1];
+			dense_col[lsub[krep_ind]] = ukj;
+			for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+			    irow = lsub[i];
+			    ++luptr;  ++luptr1;
+			    dense_col[irow] -= (ukj*lusup[luptr]
+						+ ukj1*lusup[luptr1]);
+			}
+		    } else {
+			ukj2 = dense_col[lsub[krep_ind - 2]];
+			luptr2 = luptr1 - nsupr;
+			ukj1 -= ukj2 * lusup[luptr2-1];
+			ukj = ukj - ukj1*lusup[luptr1] - ukj2*lusup[luptr2];
+			dense_col[lsub[krep_ind]] = ukj;
+			dense_col[lsub[krep_ind-1]] = ukj1;
+			for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+			    irow = lsub[i];
+			    ++luptr; ++luptr1; ++luptr2;
+			    dense_col[irow] -= ( ukj*lusup[luptr]
+                             + ukj1*lusup[luptr1] + ukj2*lusup[luptr2] );
+			}
+		    }
+
+		} else  { /* segsze >= 4 */
+		    /* 
+		     * Perform a triangular solve and block update,
+		     * then scatter the result of sup-col update to dense[].
+		     */
+		    no_zeros = kfnz - fsupc;
+		    
+		    /* Copy U[*,j] segment from dense[*] to tempv[*]: 
+		     *    The result of triangular solve is in tempv[*];
+		     *    The result of matrix vector update is in dense_col[*]
+		     */
+		    isub = lptr + no_zeros;
+		    for (i = 0; i < segsze; ++i) {
+			irow = lsub[isub];
+			tempv[i] = dense_col[irow]; /* Gather */
+			++isub;
+		    }
+		    
+		    /* start effective triangle */
+		    luptr += nsupr * no_zeros + no_zeros;
+		    
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		    STRSV( ftcs1, ftcs2, ftcs3, &segsze, &lusup[luptr], 
+			   &nsupr, tempv, &incx );
+#else
+		    dtrsv_( "L", "N", "U", &segsze, &lusup[luptr], 
+			   &nsupr, tempv, &incx );
+#endif
+		    
+		    luptr += segsze;	/* Dense matrix-vector */
+		    tempv1 = &tempv[segsze];
+                    alpha = one;
+                    beta = zero;
+#ifdef _CRAY
+		    SGEMV( ftcs2, &nrow, &segsze, &alpha, &lusup[luptr], 
+			   &nsupr, tempv, &incx, &beta, tempv1, &incy );
+#else
+		    dgemv_( "N", &nrow, &segsze, &alpha, &lusup[luptr], 
+			   &nsupr, tempv, &incx, &beta, tempv1, &incy );
+#endif
+#else
+		    dlsolve ( nsupr, segsze, &lusup[luptr], tempv );
+		    
+		    luptr += segsze;        /* Dense matrix-vector */
+		    tempv1 = &tempv[segsze];
+		    dmatvec (nsupr, nrow, segsze, &lusup[luptr], tempv, tempv1);
+#endif
+		    
+		    /* Scatter tempv[*] into SPA dense[*] temporarily, such
+		     * that tempv[*] can be used for the triangular solve of
+		     * the next column of the panel. They will be copied into 
+		     * ucol[*] after the whole panel has been finished.
+		     */
+		    isub = lptr + no_zeros;
+		    for (i = 0; i < segsze; i++) {
+			irow = lsub[isub];
+			dense_col[irow] = tempv[i];
+			tempv[i] = zero;
+			isub++;
+		    }
+		    
+		    /* Scatter the update from tempv1[*] into SPA dense[*] */
+		    /* Start dense rectangular L */
+		    for (i = 0; i < nrow; i++) {
+			irow = lsub[isub];
+			dense_col[irow] -= tempv1[i];
+			tempv1[i] = zero;
+			++isub;	
+		    }
+		    
+		} /* else segsze>=4 ... */
+		
+	    } /* for each column in the panel... */
+	    
+	} /* else 1-D update ... */
+
+    } /* for each updating supernode ... */
+
+}
+
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dpanel_dfs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,249 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "dsp_defs.h"
+#include "util.h"
+
+void
+dpanel_dfs (
+	   const int  m,           /* in - number of rows in the matrix */
+	   const int  w,           /* in */
+	   const int  jcol,        /* in */
+	   SuperMatrix *A,       /* in - original matrix */
+	   int        *perm_r,     /* in */
+	   int        *nseg,	   /* out */
+	   double     *dense,      /* out */
+	   int        *panel_lsub, /* out */
+	   int        *segrep,     /* out */
+	   int        *repfnz,     /* out */
+	   int        *xprune,     /* out */
+	   int        *marker,     /* out */     
+	   int        *parent,     /* working array */
+	   int        *xplore,     /* working array */
+	   GlobalLU_t *Glu         /* modified */
+	   )
+{
+/*
+ * Purpose
+ * =======
+ *
+ *   Performs a symbolic factorization on a panel of columns [jcol, jcol+w).
+ *
+ *   A supernode representative is the last column of a supernode.
+ *   The nonzeros in U[*,j] are segments that end at supernodal
+ *   representatives.
+ *
+ *   The routine returns one list of the supernodal representatives
+ *   in topological order of the dfs that generates them. This list is
+ *   a superset of the topological order of each individual column within
+ *   the panel. 
+ *   The location of the first nonzero in each supernodal segment
+ *   (supernodal entry location) is also returned. Each column has a 
+ *   separate list for this purpose.
+ *
+ *   Two marker arrays are used for dfs:
+ *     marker[i] == jj, if i was visited during dfs of current column jj;
+ *     marker1[i] >= jcol, if i was visited by earlier columns in this panel;
+ *
+ *   marker: A-row --> A-row/col (0/1)
+ *   repfnz: SuperA-col --> PA-row
+ *   parent: SuperA-col --> SuperA-col
+ *   xplore: SuperA-col --> index to L-structure
+ *
+ */
+    NCPformat *Astore;
+    double    *a;
+    int       *asub;
+    int       *xa_begin, *xa_end;
+    int	      krep, chperm, chmark, chrep, oldrep, kchild, myfnz;
+    int       k, krow, kmark, kperm;
+    int       xdfs, maxdfs, kpar;
+    int       jj;	   /* index through each column in the panel */
+    int       *marker1;	   /* marker1[jj] >= jcol if vertex jj was visited 
+			      by a previous column within this panel.   */
+    int       *repfnz_col; /* start of each column in the panel */
+    double    *dense_col;  /* start of each column in the panel */
+    int       nextl_col;   /* next available position in panel_lsub[*,jj] */
+    int       *xsup, *supno;
+    int       *lsub, *xlsub;
+
+    /* Initialize pointers */
+    Astore     = A->Store;
+    a          = Astore->nzval;
+    asub       = Astore->rowind;
+    xa_begin   = Astore->colbeg;
+    xa_end     = Astore->colend;
+    marker1    = marker + m;
+    repfnz_col = repfnz;
+    dense_col  = dense;
+    *nseg      = 0;
+    xsup       = Glu->xsup;
+    supno      = Glu->supno;
+    lsub       = Glu->lsub;
+    xlsub      = Glu->xlsub;
+
+    /* For each column in the panel */
+    for (jj = jcol; jj < jcol + w; jj++) {
+	nextl_col = (jj - jcol) * m;
+
+#ifdef CHK_DFS
+	printf("\npanel col %d: ", jj);
+#endif
+
+	/* For each nonz in A[*,jj] do dfs */
+	for (k = xa_begin[jj]; k < xa_end[jj]; k++) {
+	    krow = asub[k];
+            dense_col[krow] = a[k];
+	    kmark = marker[krow];    	
+	    if ( kmark == jj ) 
+		continue;     /* krow visited before, go to the next nonzero */
+
+	    /* For each unmarked nbr krow of jj
+	     * krow is in L: place it in structure of L[*,jj]
+	     */
+	    marker[krow] = jj;
+	    kperm = perm_r[krow];
+	    
+	    if ( kperm == EMPTY ) {
+		panel_lsub[nextl_col++] = krow; /* krow is indexed into A */
+	    }
+	    /* 
+	     * krow is in U: if its supernode-rep krep
+	     * has been explored, update repfnz[*]
+	     */
+	    else {
+		
+		krep = xsup[supno[kperm]+1] - 1;
+		myfnz = repfnz_col[krep];
+		
+#ifdef CHK_DFS
+		printf("krep %d, myfnz %d, perm_r[%d] %d\n", krep, myfnz, krow, kperm);
+#endif
+		if ( myfnz != EMPTY ) {	/* Representative visited before */
+		    if ( myfnz > kperm ) repfnz_col[krep] = kperm;
+		    /* continue; */
+		}
+		else {
+		    /* Otherwise, perform dfs starting at krep */
+		    oldrep = EMPTY;
+		    parent[krep] = oldrep;
+		    repfnz_col[krep] = kperm;
+		    xdfs = xlsub[krep];
+		    maxdfs = xprune[krep];
+		    
+#ifdef CHK_DFS 
+		    printf("  xdfs %d, maxdfs %d: ", xdfs, maxdfs);
+		    for (i = xdfs; i < maxdfs; i++) printf(" %d", lsub[i]);
+		    printf("\n");
+#endif
+		    do {
+			/* 
+			 * For each unmarked kchild of krep 
+			 */
+			while ( xdfs < maxdfs ) {
+			    
+			    kchild = lsub[xdfs];
+			    xdfs++;
+			    chmark = marker[kchild];
+			    
+			    if ( chmark != jj ) { /* Not reached yet */
+				marker[kchild] = jj;
+				chperm = perm_r[kchild];
+			      
+				/* Case kchild is in L: place it in L[*,j] */
+				if ( chperm == EMPTY ) {
+				    panel_lsub[nextl_col++] = kchild;
+				} 
+				/* Case kchild is in U: 
+				 *   chrep = its supernode-rep. If its rep has 
+				 *   been explored, update its repfnz[*]
+				 */
+				else {
+				    
+				    chrep = xsup[supno[chperm]+1] - 1;
+				    myfnz = repfnz_col[chrep];
+#ifdef CHK_DFS
+				    printf("chrep %d,myfnz %d,perm_r[%d] %d\n",chrep,myfnz,kchild,chperm);
+#endif
+				    if ( myfnz != EMPTY ) { /* Visited before */
+					if ( myfnz > chperm )
+					    repfnz_col[chrep] = chperm;
+				    }
+				    else {
+					/* Cont. dfs at snode-rep of kchild */
+					xplore[krep] = xdfs;	
+					oldrep = krep;
+					krep = chrep; /* Go deeper down G(L) */
+					parent[krep] = oldrep;
+					repfnz_col[krep] = chperm;
+					xdfs = xlsub[krep];     
+					maxdfs = xprune[krep];
+#ifdef CHK_DFS 
+					printf("  xdfs %d, maxdfs %d: ", xdfs, maxdfs);
+					for (i = xdfs; i < maxdfs; i++) printf(" %d", lsub[i]);	
+					printf("\n");
+#endif
+				    } /* else */
+				  
+				} /* else */
+			      
+			    } /* if... */
+			    
+			} /* while xdfs < maxdfs */
+			
+			/* krow has no more unexplored nbrs:
+			 *    Place snode-rep krep in postorder DFS, if this 
+			 *    segment is seen for the first time. (Note that
+			 *    "repfnz[krep]" may change later.)
+			 *    Backtrack dfs to its parent.
+			 */
+			if ( marker1[krep] < jcol ) {
+			    segrep[*nseg] = krep;
+			    ++(*nseg);
+			    marker1[krep] = jj;
+			}
+			
+			kpar = parent[krep]; /* Pop stack, mimic recursion */
+			if ( kpar == EMPTY ) break; /* dfs done */
+			krep = kpar;
+			xdfs = xplore[krep];
+			maxdfs = xprune[krep];
+			
+#ifdef CHK_DFS 
+			printf("  pop stack: krep %d,xdfs %d,maxdfs %d: ", krep,xdfs,maxdfs);
+			for (i = xdfs; i < maxdfs; i++) printf(" %d", lsub[i]);
+			printf("\n");
+#endif
+		    } while ( kpar != EMPTY ); /* do-while - until empty stack */
+		    
+		} /* else */
+		
+	    } /* else */
+	    
+	} /* for each nonz in A[*,jj] */
+	
+	repfnz_col += m;    /* Move to next column */
+        dense_col += m;
+	
+    } /* for jj ... */
+    
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dpivotL.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,175 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include <math.h>
+#include <stdlib.h>
+#include "dsp_defs.h"
+#include "util.h"
+
+#undef DEBUG
+
+int
+dpivotL(
+        const int  jcol,     /* in */
+        const double u,      /* in - diagonal pivoting threshold */
+        int        *usepr,   /* re-use the pivot sequence given by perm_r/iperm_r */
+        int        *perm_r,  /* may be modified */
+        int        *iperm_r, /* in - inverse of perm_r */
+        int        *iperm_c, /* in - used to find diagonal of Pc*A*Pc' */
+        int        *pivrow,  /* out */
+        GlobalLU_t *Glu      /* modified - global LU data structures */
+       )
+{
+/*
+ * Purpose
+ * =======
+ *   Performs the numerical pivoting on the current column of L,
+ *   and the CDIV operation.
+ *
+ *   Pivot policy:
+ *   (1) Compute thresh = u * max_(i>=j) abs(A_ij);
+ *   (2) IF user specifies pivot row k and abs(A_kj) >= thresh THEN
+ *           pivot row = k;
+ *       ELSE IF abs(A_jj) >= thresh THEN
+ *           pivot row = j;
+ *       ELSE
+ *           pivot row = m;
+ * 
+ *   Note: If you absolutely want to use a given pivot order, then set u=0.0.
+ *
+ *   Return value: 0      success;
+ *                 i > 0  U(i,i) is exactly zero.
+ *
+ */
+    int          fsupc;	    /* first column in the supernode */
+    int          nsupc;	    /* no of columns in the supernode */
+    int          nsupr;     /* no of rows in the supernode */
+    int          lptr;	    /* points to the starting subscript of the supernode */
+    int          pivptr, old_pivptr, diag, diagind;
+    double       pivmax, rtemp, thresh;
+    double       temp;
+    double       *lu_sup_ptr; 
+    double       *lu_col_ptr;
+    int          *lsub_ptr;
+    int          isub, icol, k, itemp;
+    int          *lsub, *xlsub;
+    double       *lusup;
+    int          *xlusup;
+    extern SuperLUStat_t SuperLUStat;
+    flops_t  *ops = SuperLUStat.ops;
+
+    /* Initialize pointers */
+    lsub       = Glu->lsub;
+    xlsub      = Glu->xlsub;
+    lusup      = Glu->lusup;
+    xlusup     = Glu->xlusup;
+    fsupc      = (Glu->xsup)[(Glu->supno)[jcol]];
+    nsupc      = jcol - fsupc;	        /* excluding jcol; nsupc >= 0 */
+    lptr       = xlsub[fsupc];
+    nsupr      = xlsub[fsupc+1] - lptr;
+    lu_sup_ptr = &lusup[xlusup[fsupc]];	/* start of the current supernode */
+    lu_col_ptr = &lusup[xlusup[jcol]];	/* start of jcol in the supernode */
+    lsub_ptr   = &lsub[lptr];	/* start of row indices of the supernode */
+
+#ifdef DEBUG
+if ( jcol == MIN_COL ) {
+    printf("Before cdiv: col %d\n", jcol);
+    for (k = nsupc; k < nsupr; k++) 
+	printf("  lu[%d] %f\n", lsub_ptr[k], lu_col_ptr[k]);
+}
+#endif
+    
+    /* Determine the largest abs numerical value for partial pivoting;
+       Also search for user-specified pivot, and diagonal element. */
+    if ( *usepr ) *pivrow = iperm_r[jcol];
+    diagind = iperm_c[jcol];
+    pivmax = 0.0;
+    pivptr = nsupc;
+    diag = EMPTY;
+    old_pivptr = nsupc;
+    for (isub = nsupc; isub < nsupr; ++isub) {
+	rtemp = fabs (lu_col_ptr[isub]);
+	if ( rtemp > pivmax ) {
+	    pivmax = rtemp;
+	    pivptr = isub;
+	}
+	if ( *usepr && lsub_ptr[isub] == *pivrow ) old_pivptr = isub;
+	if ( lsub_ptr[isub] == diagind ) diag = isub;
+    }
+
+    /* Test for singularity */
+    if ( pivmax == 0.0 ) {
+	*pivrow = lsub_ptr[pivptr];
+	perm_r[*pivrow] = jcol;
+	*usepr = 0;
+	return (jcol+1);
+    }
+
+    thresh = u * pivmax;
+    
+    /* Choose appropriate pivotal element by our policy. */
+    if ( *usepr ) {
+        rtemp = fabs (lu_col_ptr[old_pivptr]);
+	if ( rtemp != 0.0 && rtemp >= thresh )
+	    pivptr = old_pivptr;
+	else
+	    *usepr = 0;
+    }
+    if ( *usepr == 0 ) {
+	/* Use diagonal pivot? */
+	if ( diag >= 0 ) { /* diagonal exists */
+	    rtemp = fabs (lu_col_ptr[diag]);
+	    if ( rtemp != 0.0 && rtemp >= thresh ) pivptr = diag;
+        }
+	*pivrow = lsub_ptr[pivptr];
+    }
+    
+    /* Record pivot row */
+    perm_r[*pivrow] = jcol;
+    
+    /* Interchange row subscripts */
+    if ( pivptr != nsupc ) {
+	itemp = lsub_ptr[pivptr];
+	lsub_ptr[pivptr] = lsub_ptr[nsupc];
+	lsub_ptr[nsupc] = itemp;
+
+	/* Interchange numerical values as well, for the whole snode, such 
+	 * that L is indexed the same way as A.
+ 	 */
+	for (icol = 0; icol <= nsupc; icol++) {
+	    itemp = pivptr + icol * nsupr;
+	    temp = lu_sup_ptr[itemp];
+	    lu_sup_ptr[itemp] = lu_sup_ptr[nsupc + icol*nsupr];
+	    lu_sup_ptr[nsupc + icol*nsupr] = temp;
+	}
+    } /* if */
+
+    /* cdiv operation */
+    ops[FACT] += nsupr - nsupc;
+
+    temp = 1.0 / lu_col_ptr[nsupc];
+    for (k = nsupc+1; k < nsupr; k++) 
+	lu_col_ptr[k] *= temp;
+
+    return 0;
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dpivotgrowth.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,109 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include <math.h>
+#include "dsp_defs.h"
+#include "util.h"
+
+double
+dPivotGrowth(int ncols, SuperMatrix *A, int *perm_c, 
+             SuperMatrix *L, SuperMatrix *U)
+{
+/*
+ * Purpose
+ * =======
+ *
+ * Compute the reciprocal pivot growth factor of the leading ncols columns
+ * of the matrix, using the formula:
+ *     min_j ( max_i(abs(A_ij)) / max_i(abs(U_ij)) )
+ *
+ * Arguments
+ * =========
+ *
+ * ncols    (input) int
+ *          The number of columns of matrices A, L and U.
+ *
+ * A        (input) SuperMatrix*
+ *	    Original matrix A, permuted by columns, of dimension
+ *          (A->nrow, A->ncol). The type of A can be:
+ *          Stype = NC; Dtype = _D; Mtype = GE.
+ *
+ * L        (output) SuperMatrix*
+ *          The factor L from the factorization Pr*A=L*U; use compressed row 
+ *          subscripts storage for supernodes, i.e., L has type: 
+ *          Stype = SC; Dtype = _D; Mtype = TRLU.
+ *
+ * U        (output) SuperMatrix*
+ *	    The factor U from the factorization Pr*A*Pc=L*U. Use column-wise
+ *          storage scheme, i.e., U has types: Stype = NC;
+ *          Dtype = _D; Mtype = TRU.
+ *
+ */
+    NCformat *Astore;
+    SCformat *Lstore;
+    NCformat *Ustore;
+    double  *Aval, *Lval, *Uval;
+    int      fsupc, nsupr, luptr, nz_in_U;
+    int      i, j, k, oldcol;
+    int      *inv_perm_c;
+    double   rpg, maxaj, maxuj;
+    extern   double dlamch_(char *);
+    double   smlnum;
+    double   *luval;
+   
+    /* Get machine constants. */
+    smlnum = dlamch_("S");
+    rpg = 1. / smlnum;
+
+    Astore = A->Store;
+    Lstore = L->Store;
+    Ustore = U->Store;
+    Aval = Astore->nzval;
+    Lval = Lstore->nzval;
+    Uval = Ustore->nzval;
+    
+    inv_perm_c = (int *) SUPERLU_MALLOC(A->ncol*sizeof(int));
+    for (j = 0; j < A->ncol; ++j) inv_perm_c[perm_c[j]] = j;
+
+    for (k = 0; k <= Lstore->nsuper; ++k) {
+	fsupc = L_FST_SUPC(k);
+	nsupr = L_SUB_START(fsupc+1) - L_SUB_START(fsupc);
+	luptr = L_NZ_START(fsupc);
+	luval = &Lval[luptr];
+	nz_in_U = 1;
+	
+	for (j = fsupc; j < L_FST_SUPC(k+1) && j < ncols; ++j) {
+	    maxaj = 0.;
+            oldcol = inv_perm_c[j];
+	    for (i = Astore->colptr[oldcol]; i < Astore->colptr[oldcol+1]; ++i)
+		maxaj = MAX( maxaj, fabs(Aval[i]) );
+	
+	    maxuj = 0.;
+	    for (i = Ustore->colptr[j]; i < Ustore->colptr[j+1]; i++)
+		maxuj = MAX( maxuj, fabs(Uval[i]) );
+	    
+	    /* Supernode */
+	    for (i = 0; i < nz_in_U; ++i)
+		maxuj = MAX( maxuj, fabs(luval[i]) );
+
+	    ++nz_in_U;
+	    luval += nsupr;
+
+	    if ( maxuj == 0. )
+		rpg = MIN( rpg, 1.);
+	    else
+		rpg = MIN( rpg, maxaj / maxuj );
+	}
+	
+	if ( j >= ncols ) break;
+    }
+
+    SUPERLU_FREE(inv_perm_c);
+    return (rpg);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dpruneL.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,149 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "dsp_defs.h"
+#include "util.h"
+
+void
+dpruneL(
+       const int  jcol,	     /* in */
+       const int  *perm_r,   /* in */
+       const int  pivrow,    /* in */
+       const int  nseg,	     /* in */
+       const int  *segrep,   /* in */
+       const int  *repfnz,   /* in */
+       int        *xprune,   /* out */
+       GlobalLU_t *Glu       /* modified - global LU data structures */
+       )
+{
+/*
+ * Purpose
+ * =======
+ *   Prunes the L-structure of supernodes whose L-structure
+ *   contains the current pivot row "pivrow"
+ *
+ */
+    double     utemp;
+    int        jsupno, irep, irep1, kmin, kmax, krow, movnum;
+    int        i, ktemp, minloc, maxloc;
+    int        do_prune; /* logical variable */
+    int        *xsup, *supno;
+    int        *lsub, *xlsub;
+    double     *lusup;
+    int        *xlusup;
+
+    xsup       = Glu->xsup;
+    supno      = Glu->supno;
+    lsub       = Glu->lsub;
+    xlsub      = Glu->xlsub;
+    lusup      = Glu->lusup;
+    xlusup     = Glu->xlusup;
+    
+    /*
+     * For each supernode-rep irep in U[*,j]
+     */
+    jsupno = supno[jcol];
+    for (i = 0; i < nseg; i++) {
+
+	irep = segrep[i];
+	irep1 = irep + 1;
+	do_prune = FALSE;
+
+	/* Don't prune with a zero U-segment */
+ 	if ( repfnz[irep] == EMPTY )
+		continue;
+
+     	/* If a snode overlaps with the next panel, then the U-segment 
+   	 * is fragmented into two parts -- irep and irep1. We should let
+	 * pruning occur at the rep-column in irep1's snode. 
+	 */
+	if ( supno[irep] == supno[irep1] ) 	/* Don't prune */
+		continue;
+
+	/*
+	 * If it has not been pruned & it has a nonz in row L[pivrow,i]
+	 */
+	if ( supno[irep] != jsupno ) {
+	    if ( xprune[irep] >= xlsub[irep1] ) {
+		kmin = xlsub[irep];
+		kmax = xlsub[irep1] - 1;
+		for (krow = kmin; krow <= kmax; krow++) 
+		    if ( lsub[krow] == pivrow ) {
+			do_prune = TRUE;
+			break;
+		    }
+	    }
+	    
+    	    if ( do_prune ) {
+
+	     	/* Do a quicksort-type partition
+	     	 * movnum=TRUE means that the num values have to be exchanged.
+	     	 */
+	        movnum = FALSE;
+	        if ( irep == xsup[supno[irep]] ) /* Snode of size 1 */
+			movnum = TRUE;
+
+	        while ( kmin <= kmax ) {
+
+	    	    if ( perm_r[lsub[kmax]] == EMPTY ) 
+			kmax--;
+		    else if ( perm_r[lsub[kmin]] != EMPTY )
+			kmin++;
+		    else { /* kmin below pivrow, and kmax above pivrow: 
+		            * 	interchange the two subscripts
+			    */
+		        ktemp = lsub[kmin];
+		        lsub[kmin] = lsub[kmax];
+		        lsub[kmax] = ktemp;
+
+			/* If the supernode has only one column, then we
+ 			 * only keep one set of subscripts. For any subscript 
+			 * interchange performed, similar interchange must be 
+			 * done on the numerical values.
+ 			 */
+		        if ( movnum ) {
+		    	    minloc = xlusup[irep] + (kmin - xlsub[irep]);
+		    	    maxloc = xlusup[irep] + (kmax - xlsub[irep]);
+			    utemp = lusup[minloc];
+		  	    lusup[minloc] = lusup[maxloc];
+			    lusup[maxloc] = utemp;
+		        }
+
+		        kmin++;
+		        kmax--;
+
+		    }
+
+	        } /* while */
+
+	        xprune[irep] = kmin;	/* Pruning */
+
+#ifdef CHK_PRUNE
+	printf("    After dpruneL(),using col %d:  xprune[%d] = %d\n", 
+			jcol, irep, kmin);
+#endif
+	    } /* if do_prune */
+
+	} /* if */
+
+    } /* for each U-segment... */
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dreadhb.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,247 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "dsp_defs.h"
+
+
+/* Eat up the rest of the current line */
+int dDumpLine(FILE *fp)
+{
+    register int c;
+    while ((c = fgetc(fp)) != '\n') ;
+    return 0;
+}
+
+int dParseIntFormat(char *buf, int *num, int *size)
+{
+    char *tmp;
+
+    tmp = buf;
+    while (*tmp++ != '(') ;
+    sscanf(tmp, "%d", num);
+    while (*tmp != 'I' && *tmp != 'i') ++tmp;
+    ++tmp;
+    sscanf(tmp, "%d", size);
+    return 0;
+}
+
+int dParseFloatFormat(char *buf, int *num, int *size)
+{
+    char *tmp, *period;
+    
+    tmp = buf;
+    while (*tmp++ != '(') ;
+    sscanf(tmp, "%d", num);
+    while (*tmp != 'E' && *tmp != 'e' && *tmp != 'D' && *tmp != 'd'
+	   && *tmp != 'F' && *tmp != 'f') ++tmp;
+    ++tmp;
+    period = tmp;
+    while (*period != '.' && *period != ')') ++period ;
+    *period = '\0';
+    sscanf(tmp, "%2d", size);
+
+    return 0;
+}
+
+int dReadVector(FILE *fp, int n, int *where, int perline, int persize)
+{
+    register int i, j, item;
+    char tmp, buf[100];
+    
+    i = 0;
+    while (i < n) {
+	fgets(buf, 100, fp);    /* read a line at a time */
+	for (j=0; j<perline && i<n; j++) {
+	    tmp = buf[(j+1)*persize];     /* save the char at that place */
+	    buf[(j+1)*persize] = 0;       /* null terminate */
+	    item = atoi(&buf[j*persize]); 
+	    buf[(j+1)*persize] = tmp;     /* recover the char at that place */
+	    where[i++] = item - 1;
+	}
+    }
+
+    return 0;
+}
+
+int dReadValues(FILE *fp, int n, double *destination, int perline, int persize)
+{
+    register int i, j, k, s;
+    char tmp, buf[100];
+    
+    i = 0;
+    while (i < n) {
+	fgets(buf, 100, fp);    /* read a line at a time */
+	for (j=0; j<perline && i<n; j++) {
+	    tmp = buf[(j+1)*persize];     /* save the char at that place */
+	    buf[(j+1)*persize] = 0;       /* null terminate */
+	    s = j*persize;
+	    for (k = 0; k < persize; ++k) /* No D_ format in C */
+		if ( buf[s+k] == 'D' || buf[s+k] == 'd' ) buf[s+k] = 'E';
+	    destination[i++] = atof(&buf[s]);
+	    buf[(j+1)*persize] = tmp;     /* recover the char at that place */
+	}
+    }
+
+    return 0;
+}
+
+
+
+void
+dreadhb(int *nrow, int *ncol, int *nonz,
+	double **nzval, int **rowind, int **colptr)
+{
+/* 
+ * Purpose
+ * =======
+ * 
+ * Read a DOUBLE PRECISION matrix stored in Harwell-Boeing format 
+ * as described below.
+ * 
+ * Line 1 (A72,A8) 
+ *  	Col. 1 - 72   Title (TITLE) 
+ *	Col. 73 - 80  Key (KEY) 
+ * 
+ * Line 2 (5I14) 
+ * 	Col. 1 - 14   Total number of lines excluding header (TOTCRD) 
+ * 	Col. 15 - 28  Number of lines for pointers (PTRCRD) 
+ * 	Col. 29 - 42  Number of lines for row (or variable) indices (INDCRD) 
+ * 	Col. 43 - 56  Number of lines for numerical values (VALCRD) 
+ *	Col. 57 - 70  Number of lines for right-hand sides (RHSCRD) 
+ *                    (including starting guesses and solution vectors 
+ *		       if present) 
+ *           	      (zero indicates no right-hand side data is present) 
+ *
+ * Line 3 (A3, 11X, 4I14) 
+ *   	Col. 1 - 3    Matrix type (see below) (MXTYPE) 
+ * 	Col. 15 - 28  Number of rows (or variables) (NROW) 
+ * 	Col. 29 - 42  Number of columns (or elements) (NCOL) 
+ *	Col. 43 - 56  Number of row (or variable) indices (NNZERO) 
+ *	              (equal to number of entries for assembled matrices) 
+ * 	Col. 57 - 70  Number of elemental matrix entries (NELTVL) 
+ *	              (zero in the case of assembled matrices) 
+ * Line 4 (2A16, 2A20) 
+ * 	Col. 1 - 16   Format for pointers (PTRFMT) 
+ *	Col. 17 - 32  Format for row (or variable) indices (INDFMT) 
+ *	Col. 33 - 52  Format for numerical values of coefficient matrix (VALFMT) 
+ * 	Col. 53 - 72 Format for numerical values of right-hand sides (RHSFMT) 
+ *
+ * Line 5 (A3, 11X, 2I14) Only present if there are right-hand sides present 
+ *    	Col. 1 	      Right-hand side type: 
+ *	         	  F for full storage or M for same format as matrix 
+ *    	Col. 2        G if a starting vector(s) (Guess) is supplied. (RHSTYP) 
+ *    	Col. 3        X if an exact solution vector(s) is supplied. 
+ *	Col. 15 - 28  Number of right-hand sides (NRHS) 
+ *	Col. 29 - 42  Number of row indices (NRHSIX) 
+ *          	      (ignored in case of unassembled matrices) 
+ *
+ * The three character type field on line 3 describes the matrix type. 
+ * The following table lists the permitted values for each of the three 
+ * characters. As an example of the type field, RSA denotes that the matrix 
+ * is real, symmetric, and assembled. 
+ *
+ * First Character: 
+ *	R Real matrix 
+ *	C Complex matrix 
+ *	P Pattern only (no numerical values supplied) 
+ *
+ * Second Character: 
+ *	S Symmetric 
+ *	U Unsymmetric 
+ *	H Hermitian 
+ *	Z Skew symmetric 
+ *	R Rectangular 
+ *
+ * Third Character: 
+ *	A Assembled 
+ *	E Elemental matrices (unassembled) 
+ *
+ */
+
+    register int i, numer_lines = 0, rhscrd = 0;
+    int tmp, colnum, colsize, rownum, rowsize, valnum, valsize;
+    char buf[100], type[4], key[10];
+    FILE *fp;
+
+    fp = stdin;
+
+    /* Line 1 */
+    fgets(buf, 100, fp);
+    fputs(buf, stdout);
+#if 0
+    fscanf(fp, "%72c", buf); buf[72] = 0;
+    printf("Title: %s", buf);
+    fscanf(fp, "%8c", key);  key[8] = 0;
+    printf("Key: %s\n", key);
+    dDumpLine(fp);
+#endif
+
+    /* Line 2 */
+    for (i=0; i<5; i++) {
+	fscanf(fp, "%14c", buf); buf[14] = 0;
+	sscanf(buf, "%d", &tmp);
+	if (i == 3) numer_lines = tmp;
+	if (i == 4 && tmp) rhscrd = tmp;
+    }
+    dDumpLine(fp);
+
+    /* Line 3 */
+    fscanf(fp, "%3c", type);
+    fscanf(fp, "%11c", buf); /* pad */
+    type[3] = 0;
+#ifdef DEBUG
+    printf("Matrix type %s\n", type);
+#endif
+    
+    fscanf(fp, "%14c", buf); sscanf(buf, "%d", nrow);
+    fscanf(fp, "%14c", buf); sscanf(buf, "%d", ncol);
+    fscanf(fp, "%14c", buf); sscanf(buf, "%d", nonz);
+    fscanf(fp, "%14c", buf); sscanf(buf, "%d", &tmp);
+    
+    if (tmp != 0)
+	  printf("This is not an assembled matrix!\n");
+    if (*nrow != *ncol)
+	printf("Matrix is not square.\n");
+    dDumpLine(fp);
+
+    /* Allocate storage for the three arrays ( nzval, rowind, colptr ) */
+    dallocateA(*ncol, *nonz, nzval, rowind, colptr);
+
+    /* Line 4: format statement */
+    fscanf(fp, "%16c", buf);
+    dParseIntFormat(buf, &colnum, &colsize);
+    fscanf(fp, "%16c", buf);
+    dParseIntFormat(buf, &rownum, &rowsize);
+    fscanf(fp, "%20c", buf);
+    dParseFloatFormat(buf, &valnum, &valsize);
+    fscanf(fp, "%20c", buf);
+    dDumpLine(fp);
+
+    /* Line 5: right-hand side */    
+    if ( rhscrd ) dDumpLine(fp); /* skip RHSFMT */
+    
+#ifdef DEBUG
+    printf("%d rows, %d nonzeros\n", *nrow, *nonz);
+    printf("colnum %d, colsize %d\n", colnum, colsize);
+    printf("rownum %d, rowsize %d\n", rownum, rowsize);
+    printf("valnum %d, valsize %d\n", valnum, valsize);
+#endif
+    
+    dReadVector(fp, *ncol+1, *colptr, colnum, colsize);
+    dReadVector(fp, *nonz, *rowind, rownum, rowsize);
+    if ( numer_lines ) {
+        dReadValues(fp, *nonz, *nzval, valnum, valsize);
+    }
+    
+    fclose(fp);
+
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dsnode_bmod.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,118 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "dsp_defs.h"
+#include "util.h"
+
+
+/*
+ * Performs numeric block updates within the relaxed snode. 
+ */
+int
+dsnode_bmod (
+	    const int  jcol,	  /* in */
+	    const int  jsupno,    /* in */
+	    const int  fsupc,     /* in */
+	    double     *dense,    /* in */
+	    double     *tempv,    /* working array */
+	    GlobalLU_t *Glu       /* modified */
+	    )
+{
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+    _fcd ftcs1 = _cptofcd("L", strlen("L")),
+	 ftcs2 = _cptofcd("N", strlen("N")),
+	 ftcs3 = _cptofcd("U", strlen("U"));
+#endif
+    int            incx = 1, incy = 1;
+    double         alpha = -1.0, beta = 1.0;
+#endif
+
+    int            luptr, nsupc, nsupr, nrow;
+    int            isub, irow, i, iptr; 
+    register int   ufirst, nextlu;
+    int            *lsub, *xlsub;
+    double         *lusup;
+    int            *xlusup;
+    extern SuperLUStat_t SuperLUStat;
+    flops_t *ops = SuperLUStat.ops;
+
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    lusup   = Glu->lusup;
+    xlusup  = Glu->xlusup;
+
+    nextlu = xlusup[jcol];
+    
+    /*
+     *	Process the supernodal portion of L\U[*,j]
+     */
+    for (isub = xlsub[fsupc]; isub < xlsub[fsupc+1]; isub++) {
+  	irow = lsub[isub];
+	lusup[nextlu] = dense[irow];
+	dense[irow] = 0;
+	++nextlu;
+    }
+
+    xlusup[jcol + 1] = nextlu;	/* Initialize xlusup for next column */
+    
+    if ( fsupc < jcol ) {
+
+	luptr = xlusup[fsupc];
+	nsupr = xlsub[fsupc+1] - xlsub[fsupc];
+	nsupc = jcol - fsupc;	/* Excluding jcol */
+	ufirst = xlusup[jcol];	/* Points to the beginning of column
+				   jcol in supernode L\U(jsupno). */
+	nrow = nsupr - nsupc;
+
+	ops[TRSV] += nsupc * (nsupc - 1);
+	ops[GEMV] += 2 * nrow * nsupc;
+
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+	STRSV( ftcs1, ftcs2, ftcs3, &nsupc, &lusup[luptr], &nsupr, 
+	      &lusup[ufirst], &incx );
+	SGEMV( ftcs2, &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr, 
+		&lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
+#else
+	dtrsv_( "L", "N", "U", &nsupc, &lusup[luptr], &nsupr, 
+	      &lusup[ufirst], &incx );
+	dgemv_( "N", &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr, 
+		&lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
+#endif
+#else
+	dlsolve ( nsupr, nsupc, &lusup[luptr], &lusup[ufirst] );
+	dmatvec ( nsupr, nrow, nsupc, &lusup[luptr+nsupc], 
+			&lusup[ufirst], &tempv[0] );
+
+        /* Scatter tempv[*] into lusup[*] */
+	iptr = ufirst + nsupc;
+	for (i = 0; i < nrow; i++) {
+	    lusup[iptr++] -= tempv[i];
+	    tempv[i] = 0.0;
+	}
+#endif
+
+    }
+
+    return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dsnode_dfs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,106 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "dsp_defs.h"
+#include "util.h"
+
+int
+dsnode_dfs (
+	   const int  jcol,	    /* in - start of the supernode */
+	   const int  kcol, 	    /* in - end of the supernode */
+	   const int  *asub,        /* in */
+	   const int  *xa_begin,    /* in */
+	   const int  *xa_end,      /* in */
+	   int        *xprune,      /* out */
+	   int        *marker,      /* modified */
+	   GlobalLU_t *Glu          /* modified */
+	   )
+{
+/* Purpose
+ * =======
+ *    dsnode_dfs() - Determine the union of the row structures of those 
+ *    columns within the relaxed snode.
+ *    Note: The relaxed snodes are leaves of the supernodal etree, therefore, 
+ *    the portion outside the rectangular supernode must be zero.
+ *
+ * Return value
+ * ============
+ *     0   success;
+ *    >0   number of bytes allocated when run out of memory.
+ *
+ */
+    register int i, k, ifrom, ito, nextl, new_next;
+    int          nsuper, krow, kmark, mem_error;
+    int          *xsup, *supno;
+    int          *lsub, *xlsub;
+    int          nzlmax;
+    
+    xsup    = Glu->xsup;
+    supno   = Glu->supno;
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    nzlmax  = Glu->nzlmax;
+
+    nsuper = ++supno[jcol];	/* Next available supernode number */
+    nextl = xlsub[jcol];
+
+    for (i = jcol; i <= kcol; i++) {
+	/* For each nonzero in A[*,i] */
+	for (k = xa_begin[i]; k < xa_end[i]; k++) {	
+	    krow = asub[k];
+	    kmark = marker[krow];
+	    if ( kmark != kcol ) { /* First time visit krow */
+		marker[krow] = kcol;
+		lsub[nextl++] = krow;
+		if ( nextl >= nzlmax ) {
+		    if ( mem_error = dLUMemXpand(jcol, nextl, LSUB, &nzlmax, Glu) )
+			return (mem_error);
+		    lsub = Glu->lsub;
+		}
+	    }
+    	}
+	supno[i] = nsuper;
+    }
+
+    /* Supernode > 1, then make a copy of the subscripts for pruning */
+    if ( jcol < kcol ) {
+	new_next = nextl + (nextl - xlsub[jcol]);
+	while ( new_next > nzlmax ) {
+	    if ( mem_error = dLUMemXpand(jcol, nextl, LSUB, &nzlmax, Glu) )
+		return (mem_error);
+	    lsub = Glu->lsub;
+	}
+	ito = nextl;
+	for (ifrom = xlsub[jcol]; ifrom < nextl; )
+	    lsub[ito++] = lsub[ifrom++];	
+        for (i = jcol+1; i <= kcol; i++) xlsub[i] = nextl;
+	nextl = ito;
+    }
+
+    xsup[nsuper+1] = kcol + 1;
+    supno[kcol+1]  = nsuper;
+    xprune[kcol]   = nextl;
+    xlsub[kcol+1]  = nextl;
+
+    return 0;
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dsp_blas2.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,473 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:		sp_blas2.c
+ * Purpose:		Sparse BLAS 2, using some dense BLAS 2 operations.
+ */
+
+#include "dsp_defs.h"
+#include "util.h"
+
+
+/* 
+ * Function prototypes 
+ */
+void dusolve(int, int, double*, double*);
+void dlsolve(int, int, double*, double*);
+void dmatvec(int, int, int, double*, double*, double*);
+
+
+int
+sp_dtrsv(char *uplo, char *trans, char *diag, SuperMatrix *L, 
+	 SuperMatrix *U, double *x, int *info)
+{
+/*
+ *   Purpose
+ *   =======
+ *
+ *   sp_dtrsv() solves one of the systems of equations   
+ *       A*x = b,   or   A'*x = b,
+ *   where b and x are n element vectors and A is a sparse unit , or   
+ *   non-unit, upper or lower triangular matrix.   
+ *   No test for singularity or near-singularity is included in this   
+ *   routine. Such tests must be performed before calling this routine.   
+ *
+ *   Parameters   
+ *   ==========   
+ *
+ *   uplo   - (input) char*
+ *            On entry, uplo specifies whether the matrix is an upper or   
+ *             lower triangular matrix as follows:   
+ *                uplo = 'U' or 'u'   A is an upper triangular matrix.   
+ *                uplo = 'L' or 'l'   A is a lower triangular matrix.   
+ *
+ *   trans  - (input) char*
+ *             On entry, trans specifies the equations to be solved as   
+ *             follows:   
+ *                trans = 'N' or 'n'   A*x = b.   
+ *                trans = 'T' or 't'   A'*x = b.   
+ *                trans = 'C' or 'c'   A'*x = b.   
+ *
+ *   diag   - (input) char*
+ *             On entry, diag specifies whether or not A is unit   
+ *             triangular as follows:   
+ *                diag = 'U' or 'u'   A is assumed to be unit triangular.   
+ *                diag = 'N' or 'n'   A is not assumed to be unit   
+ *                                    triangular.   
+ *	     
+ *   L       - (input) SuperMatrix*
+ *	       The factor L from the factorization Pr*A*Pc=L*U. Use
+ *             compressed row subscripts storage for supernodes,
+ *             i.e., L has types: Stype = SC, Dtype = _D, Mtype = TRLU.
+ *
+ *   U       - (input) SuperMatrix*
+ *	        The factor U from the factorization Pr*A*Pc=L*U.
+ *	        U has types: Stype = NC, Dtype = _D, Mtype = TRU.
+ *    
+ *   x       - (input/output) double*
+ *             Before entry, the incremented array X must contain the n   
+ *             element right-hand side vector b. On exit, X is overwritten 
+ *             with the solution vector x.
+ *
+ *   info    - (output) int*
+ *             If *info = -i, the i-th argument had an illegal value.
+ *
+ */
+#ifdef _CRAY
+    _fcd ftcs1 = _cptofcd("L", strlen("L")),
+	 ftcs2 = _cptofcd("N", strlen("N")),
+	 ftcs3 = _cptofcd("U", strlen("U"));
+#endif
+    SCformat *Lstore;
+    NCformat *Ustore;
+    double   *Lval, *Uval;
+    int incx = 1, incy = 1;
+    double alpha = 1.0, beta = 1.0;
+    int nrow;
+    int fsupc, nsupr, nsupc, luptr, istart, irow;
+    int i, k, iptr, jcol;
+    double *work;
+    flops_t solve_ops;
+    extern SuperLUStat_t SuperLUStat;
+
+    /* Test the input parameters */
+    *info = 0;
+    if ( !lsame_(uplo,"L") && !lsame_(uplo, "U") ) *info = -1;
+    else if ( !lsame_(trans, "N") && !lsame_(trans, "T") ) *info = -2;
+    else if ( !lsame_(diag, "U") && !lsame_(diag, "N") ) *info = -3;
+    else if ( L->nrow != L->ncol || L->nrow < 0 ) *info = -4;
+    else if ( U->nrow != U->ncol || U->nrow < 0 ) *info = -5;
+    if ( *info ) {
+	i = -(*info);
+	xerbla_("sp_dtrsv", &i);
+	return 0;
+    }
+
+    Lstore = L->Store;
+    Lval = Lstore->nzval;
+    Ustore = U->Store;
+    Uval = Ustore->nzval;
+    solve_ops = 0;
+
+    if ( !(work = doubleCalloc(L->nrow)) )
+	ABORT("Malloc fails for work in sp_dtrsv().");
+    
+    if ( lsame_(trans, "N") ) {	/* Form x := inv(A)*x. */
+	
+	if ( lsame_(uplo, "L") ) {
+	    /* Form x := inv(L)*x */
+    	    if ( L->nrow == 0 ) return 0; /* Quick return */
+	    
+	    for (k = 0; k <= Lstore->nsuper; k++) {
+		fsupc = L_FST_SUPC(k);
+		istart = L_SUB_START(fsupc);
+		nsupr = L_SUB_START(fsupc+1) - istart;
+		nsupc = L_FST_SUPC(k+1) - fsupc;
+		luptr = L_NZ_START(fsupc);
+		nrow = nsupr - nsupc;
+
+	        solve_ops += nsupc * (nsupc - 1);
+	        solve_ops += 2 * nrow * nsupc;
+
+		if ( nsupc == 1 ) {
+		    for (iptr=istart+1; iptr < L_SUB_START(fsupc+1); ++iptr) {
+			irow = L_SUB(iptr);
+			++luptr;
+			x[irow] -= x[fsupc] * Lval[luptr];
+		    }
+		} else {
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		    STRSV(ftcs1, ftcs2, ftcs3, &nsupc, &Lval[luptr], &nsupr,
+		       	&x[fsupc], &incx);
+		
+		    SGEMV(ftcs2, &nrow, &nsupc, &alpha, &Lval[luptr+nsupc], 
+		       	&nsupr, &x[fsupc], &incx, &beta, &work[0], &incy);
+#else
+		    dtrsv_("L", "N", "U", &nsupc, &Lval[luptr], &nsupr,
+		       	&x[fsupc], &incx);
+		
+		    dgemv_("N", &nrow, &nsupc, &alpha, &Lval[luptr+nsupc], 
+		       	&nsupr, &x[fsupc], &incx, &beta, &work[0], &incy);
+#endif
+#else
+		    dlsolve ( nsupr, nsupc, &Lval[luptr], &x[fsupc]);
+		
+		    dmatvec ( nsupr, nsupr-nsupc, nsupc, &Lval[luptr+nsupc],
+			&x[fsupc], &work[0] );
+#endif		
+		
+		    iptr = istart + nsupc;
+		    for (i = 0; i < nrow; ++i, ++iptr) {
+			irow = L_SUB(iptr);
+			x[irow] -= work[i];	/* Scatter */
+			work[i] = 0.0;
+
+		    }
+	 	}
+	    } /* for k ... */
+	    
+	} else {
+	    /* Form x := inv(U)*x */
+	    
+	    if ( U->nrow == 0 ) return 0; /* Quick return */
+	    
+	    for (k = Lstore->nsuper; k >= 0; k--) {
+	    	fsupc = L_FST_SUPC(k);
+	    	nsupr = L_SUB_START(fsupc+1) - L_SUB_START(fsupc);
+	    	nsupc = L_FST_SUPC(k+1) - fsupc;
+	    	luptr = L_NZ_START(fsupc);
+		
+    	        solve_ops += nsupc * (nsupc + 1);
+
+		if ( nsupc == 1 ) {
+		    x[fsupc] /= Lval[luptr];
+		    for (i = U_NZ_START(fsupc); i < U_NZ_START(fsupc+1); ++i) {
+			irow = U_SUB(i);
+			x[irow] -= x[fsupc] * Uval[i];
+		    }
+		} else {
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		    STRSV(ftcs3, ftcs2, ftcs2, &nsupc, &Lval[luptr], &nsupr,
+		       &x[fsupc], &incx);
+#else
+		    dtrsv_("U", "N", "N", &nsupc, &Lval[luptr], &nsupr,
+		       &x[fsupc], &incx);
+#endif
+#else		
+		    dusolve ( nsupr, nsupc, &Lval[luptr], &x[fsupc] );
+#endif		
+
+		    for (jcol = fsupc; jcol < L_FST_SUPC(k+1); jcol++) {
+		        solve_ops += 2*(U_NZ_START(jcol+1) - U_NZ_START(jcol));
+		    	for (i = U_NZ_START(jcol); i < U_NZ_START(jcol+1); 
+				i++) {
+			    irow = U_SUB(i);
+			    x[irow] -= x[jcol] * Uval[i];
+		    	}
+                    }
+		}
+	    } /* for k ... */
+	    
+	}
+    } else { /* Form x := inv(A')*x */
+	
+	if ( lsame_(uplo, "L") ) {
+	    /* Form x := inv(L')*x */
+    	    if ( L->nrow == 0 ) return 0; /* Quick return */
+	    
+	    for (k = Lstore->nsuper; k >= 0; --k) {
+	    	fsupc = L_FST_SUPC(k);
+	    	istart = L_SUB_START(fsupc);
+	    	nsupr = L_SUB_START(fsupc+1) - istart;
+	    	nsupc = L_FST_SUPC(k+1) - fsupc;
+	    	luptr = L_NZ_START(fsupc);
+
+		solve_ops += 2 * (nsupr - nsupc) * nsupc;
+
+		for (jcol = fsupc; jcol < L_FST_SUPC(k+1); jcol++) {
+		    iptr = istart + nsupc;
+		    for (i = L_NZ_START(jcol) + nsupc; 
+				i < L_NZ_START(jcol+1); i++) {
+			irow = L_SUB(iptr);
+			x[jcol] -= x[irow] * Lval[i];
+			iptr++;
+		    }
+		}
+		
+		if ( nsupc > 1 ) {
+		    solve_ops += nsupc * (nsupc - 1);
+#ifdef _CRAY
+                    ftcs1 = _cptofcd("L", strlen("L"));
+                    ftcs2 = _cptofcd("T", strlen("T"));
+                    ftcs3 = _cptofcd("U", strlen("U"));
+		    STRSV(ftcs1, ftcs2, ftcs3, &nsupc, &Lval[luptr], &nsupr,
+			&x[fsupc], &incx);
+#else
+		    dtrsv_("L", "T", "U", &nsupc, &Lval[luptr], &nsupr,
+			&x[fsupc], &incx);
+#endif
+		}
+	    }
+	} else {
+	    /* Form x := inv(U')*x */
+	    if ( U->nrow == 0 ) return 0; /* Quick return */
+	    
+	    for (k = 0; k <= Lstore->nsuper; k++) {
+	    	fsupc = L_FST_SUPC(k);
+	    	nsupr = L_SUB_START(fsupc+1) - L_SUB_START(fsupc);
+	    	nsupc = L_FST_SUPC(k+1) - fsupc;
+	    	luptr = L_NZ_START(fsupc);
+
+		for (jcol = fsupc; jcol < L_FST_SUPC(k+1); jcol++) {
+		    solve_ops += 2*(U_NZ_START(jcol+1) - U_NZ_START(jcol));
+		    for (i = U_NZ_START(jcol); i < U_NZ_START(jcol+1); i++) {
+			irow = U_SUB(i);
+			x[jcol] -= x[irow] * Uval[i];
+		    }
+		}
+
+		solve_ops += nsupc * (nsupc + 1);
+
+		if ( nsupc == 1 ) {
+		    x[fsupc] /= Lval[luptr];
+		} else {
+#ifdef _CRAY
+                    ftcs1 = _cptofcd("U", strlen("U"));
+                    ftcs2 = _cptofcd("T", strlen("T"));
+                    ftcs3 = _cptofcd("N", strlen("N"));
+		    STRSV( ftcs1, ftcs2, ftcs3, &nsupc, &Lval[luptr], &nsupr,
+			    &x[fsupc], &incx);
+#else
+		    dtrsv_("U", "T", "N", &nsupc, &Lval[luptr], &nsupr,
+			    &x[fsupc], &incx);
+#endif
+		}
+	    } /* for k ... */
+	}
+    }
+
+    SuperLUStat.ops[SOLVE] += solve_ops;
+    SUPERLU_FREE(work);
+    return 0;
+}
+
+
+
+
+int
+sp_dgemv(char *trans, double alpha, SuperMatrix *A, double *x, 
+	 int incx, double beta, double *y, int incy)
+{
+/*  Purpose   
+    =======   
+
+    sp_dgemv()  performs one of the matrix-vector operations   
+       y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,   
+    where alpha and beta are scalars, x and y are vectors and A is a
+    sparse A->nrow by A->ncol matrix.   
+
+    Parameters   
+    ==========   
+
+    TRANS  - (input) char*
+             On entry, TRANS specifies the operation to be performed as   
+             follows:   
+                TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.   
+                TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.   
+                TRANS = 'C' or 'c'   y := alpha*A'*x + beta*y.   
+
+    ALPHA  - (input) double
+             On entry, ALPHA specifies the scalar alpha.   
+
+    A      - (input) SuperMatrix*
+             Matrix A with a sparse format, of dimension (A->nrow, A->ncol).
+             Currently, the type of A can be:
+                 Stype = NC or NCP; Dtype = _D; Mtype = GE. 
+             In the future, more general A can be handled.
+
+    X      - (input) double*, array of DIMENSION at least   
+             ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'   
+             and at least   
+             ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.   
+             Before entry, the incremented array X must contain the   
+             vector x.   
+
+    INCX   - (input) int
+             On entry, INCX specifies the increment for the elements of   
+             X. INCX must not be zero.   
+
+    BETA   - (input) double
+             On entry, BETA specifies the scalar beta. When BETA is   
+             supplied as zero then Y need not be set on input.   
+
+    Y      - (output) double*,  array of DIMENSION at least   
+             ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'   
+             and at least   
+             ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.   
+             Before entry with BETA non-zero, the incremented array Y   
+             must contain the vector y. On exit, Y is overwritten by the 
+             updated vector y.
+	     
+    INCY   - (input) int
+             On entry, INCY specifies the increment for the elements of   
+             Y. INCY must not be zero.   
+
+    ==== Sparse Level 2 Blas routine.   
+*/
+
+    /* Local variables */
+    NCformat *Astore;
+    double   *Aval;
+    int info;
+    double temp;
+    int lenx, leny, i, j, irow;
+    int iy, jx, jy, kx, ky;
+    int notran;
+
+    notran = lsame_(trans, "N");
+    Astore = A->Store;
+    Aval = Astore->nzval;
+    
+    /* Test the input parameters */
+    info = 0;
+    if ( !notran && !lsame_(trans, "T") && !lsame_(trans, "C")) info = 1;
+    else if ( A->nrow < 0 || A->ncol < 0 ) info = 3;
+    else if (incx == 0) info = 5;
+    else if (incy == 0)	info = 8;
+    if (info != 0) {
+	xerbla_("sp_dgemv ", &info);
+	return 0;
+    }
+
+    /* Quick return if possible. */
+    if (A->nrow == 0 || A->ncol == 0 || alpha == 0. && beta == 1.)
+	return 0;
+
+    /* Set  LENX  and  LENY, the lengths of the vectors x and y, and set 
+       up the start points in  X  and  Y. */
+    if (lsame_(trans, "N")) {
+	lenx = A->ncol;
+	leny = A->nrow;
+    } else {
+	lenx = A->nrow;
+	leny = A->ncol;
+    }
+    if (incx > 0) kx = 0;
+    else kx =  - (lenx - 1) * incx;
+    if (incy > 0) ky = 0;
+    else ky =  - (leny - 1) * incy;
+
+    /* Start the operations. In this version the elements of A are   
+       accessed sequentially with one pass through A. */
+    /* First form  y := beta*y. */
+    if (beta != 1.) {
+	if (incy == 1) {
+	    if (beta == 0.)
+		for (i = 0; i < leny; ++i) y[i] = 0.;
+	    else
+		for (i = 0; i < leny; ++i) y[i] = beta * y[i];
+	} else {
+	    iy = ky;
+	    if (beta == 0.)
+		for (i = 0; i < leny; ++i) {
+		    y[iy] = 0.;
+		    iy += incy;
+		}
+	    else
+		for (i = 0; i < leny; ++i) {
+		    y[iy] = beta * y[iy];
+		    iy += incy;
+		}
+	}
+    }
+    
+    if (alpha == 0.) return 0;
+
+    if ( notran ) {
+	/* Form  y := alpha*A*x + y. */
+	jx = kx;
+	if (incy == 1) {
+	    for (j = 0; j < A->ncol; ++j) {
+		if (x[jx] != 0.) {
+		    temp = alpha * x[jx];
+		    for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+			irow = Astore->rowind[i];
+			y[irow] += temp * Aval[i];
+		    }
+		}
+		jx += incx;
+	    }
+	} else {
+	    ABORT("Not implemented.");
+	}
+    } else {
+	/* Form  y := alpha*A'*x + y. */
+	jy = ky;
+	if (incx == 1) {
+	    for (j = 0; j < A->ncol; ++j) {
+		temp = 0.;
+		for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+		    irow = Astore->rowind[i];
+		    temp += Aval[i] * x[irow];
+		}
+		y[jy] += alpha * temp;
+		jy += incy;
+	    }
+	} else {
+	    ABORT("Not implemented.");
+	}
+    }
+    return 0;
+} /* sp_dgemv */
+
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dsp_blas3.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,121 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:		sp_blas3.c
+ * Purpose:		Sparse BLAS3, using some dense BLAS3 operations.
+ */
+
+#include "dsp_defs.h"
+#include "util.h"
+
+int
+sp_dgemm(char *transa, char *transb, int m, int n, int k, 
+         double alpha, SuperMatrix *A, double *b, int ldb, 
+         double beta, double *c, int ldc)
+{
+/*  Purpose   
+    =======   
+
+    sp_d performs one of the matrix-matrix operations   
+
+       C := alpha*op( A )*op( B ) + beta*C,   
+
+    where  op( X ) is one of 
+
+       op( X ) = X   or   op( X ) = X'   or   op( X ) = conjg( X' ),
+
+    alpha and beta are scalars, and A, B and C are matrices, with op( A ) 
+    an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix. 
+  
+
+    Parameters   
+    ==========   
+
+    TRANSA - (input) char*
+             On entry, TRANSA specifies the form of op( A ) to be used in 
+             the matrix multiplication as follows:   
+                TRANSA = 'N' or 'n',  op( A ) = A.   
+                TRANSA = 'T' or 't',  op( A ) = A'.   
+                TRANSA = 'C' or 'c',  op( A ) = conjg( A' ).   
+             Unchanged on exit.   
+
+    TRANSB - (input) char*
+             On entry, TRANSB specifies the form of op( B ) to be used in 
+             the matrix multiplication as follows:   
+                TRANSB = 'N' or 'n',  op( B ) = B.   
+                TRANSB = 'T' or 't',  op( B ) = B'.   
+                TRANSB = 'C' or 'c',  op( B ) = conjg( B' ).   
+             Unchanged on exit.   
+
+    M      - (input) int   
+             On entry,  M  specifies  the number of rows of the matrix 
+	     op( A ) and of the matrix C.  M must be at least zero. 
+	     Unchanged on exit.   
+
+    N      - (input) int
+             On entry,  N specifies the number of columns of the matrix 
+	     op( B ) and the number of columns of the matrix C. N must be 
+	     at least zero.
+	     Unchanged on exit.   
+
+    K      - (input) int
+             On entry, K specifies the number of columns of the matrix 
+	     op( A ) and the number of rows of the matrix op( B ). K must 
+	     be at least  zero.   
+             Unchanged on exit.
+	     
+    ALPHA  - (input) double
+             On entry, ALPHA specifies the scalar alpha.   
+
+    A      - (input) SuperMatrix*
+             Matrix A with a sparse format, of dimension (A->nrow, A->ncol).
+             Currently, the type of A can be:
+                 Stype = NC or NCP; Dtype = _D; Mtype = GE. 
+             In the future, more general A can be handled.
+
+    B      - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is 
+             n when TRANSB = 'N' or 'n',  and is  k otherwise.   
+             Before entry with  TRANSB = 'N' or 'n',  the leading k by n 
+             part of the array B must contain the matrix B, otherwise 
+             the leading n by k part of the array B must contain the 
+             matrix B.   
+             Unchanged on exit.   
+
+    LDB    - (input) int
+             On entry, LDB specifies the first dimension of B as declared 
+             in the calling (sub) program. LDB must be at least max( 1, n ).  
+             Unchanged on exit.   
+
+    BETA   - (input) double
+             On entry, BETA specifies the scalar beta. When BETA is   
+             supplied as zero then C need not be set on input.   
+
+    C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).   
+             Before entry, the leading m by n part of the array C must 
+             contain the matrix C,  except when beta is zero, in which 
+             case C need not be set on entry.   
+             On exit, the array C is overwritten by the m by n matrix 
+	     ( alpha*op( A )*B + beta*C ).   
+
+    LDC    - (input) int
+             On entry, LDC specifies the first dimension of C as declared 
+             in the calling (sub)program. LDC must be at least max(1,m).   
+             Unchanged on exit.   
+
+    ==== Sparse Level 3 Blas routine.   
+*/
+    int    incx = 1, incy = 1;
+    int    j;
+
+    for (j = 0; j < n; ++j) {
+	sp_dgemv(transa, alpha, A, &b[ldb*j], incx, beta, &c[ldc*j], incy);
+    }
+    return 0;    
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dsp_defs.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,249 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#ifndef __SUPERLU_dSP_DEFS /* allow multiple inclusions */
+#define __SUPERLU_dSP_DEFS
+
+/*
+ * File name:		dsp_defs.h
+ * Purpose:             Sparse matrix types and function prototypes
+ * History:
+ */
+#ifdef _CRAY
+#include <fortran.h>
+#include <string.h>
+#endif
+#include "Cnames.h"
+#include "supermatrix.h"
+
+
+/* No of marker arrays used in the symbolic factorization,
+   each of size n */
+#define NO_MARKER     3
+#define NUM_TEMPV(m,w,t,b)  ( MAX(m, (t + b)*w) )
+
+typedef enum {LUSUP, UCOL, LSUB, USUB} MemType;
+typedef enum {HEAD, TAIL}              stack_end_t;
+typedef enum {SYSTEM, USER}            LU_space_t;
+
+/*
+ * Global data structures used in LU factorization -
+ * 
+ *   nsuper: #supernodes = nsuper + 1, numbered [0, nsuper].
+ *   (xsup,supno): supno[i] is the supernode no to which i belongs;
+ *	xsup(s) points to the beginning of the s-th supernode.
+ *	e.g.   supno 0 1 2 2 3 3 3 4 4 4 4 4   (n=12)
+ *	        xsup 0 1 2 4 7 12
+ *	Note: dfs will be performed on supernode rep. relative to the new 
+ *	      row pivoting ordering
+ *
+ *   (xlsub,lsub): lsub[*] contains the compressed subscript of
+ *	rectangular supernodes; xlsub[j] points to the starting
+ *	location of the j-th column in lsub[*]. Note that xlsub 
+ *	is indexed by column.
+ *	Storage: original row subscripts
+ *
+ *      During the course of sparse LU factorization, we also use
+ *	(xlsub,lsub) for the purpose of symmetric pruning. For each
+ *	supernode {s,s+1,...,t=s+r} with first column s and last
+ *	column t, the subscript set
+ *		lsub[j], j=xlsub[s], .., xlsub[s+1]-1
+ *	is the structure of column s (i.e. structure of this supernode).
+ *	It is used for the storage of numerical values.
+ *	Furthermore,
+ *		lsub[j], j=xlsub[t], .., xlsub[t+1]-1
+ *	is the structure of the last column t of this supernode.
+ *	It is for the purpose of symmetric pruning. Therefore, the
+ *	structural subscripts can be rearranged without making physical
+ *	interchanges among the numerical values.
+ *
+ *	However, if the supernode has only one column, then we
+ *	only keep one set of subscripts. For any subscript interchange
+ *	performed, similar interchange must be done on the numerical
+ *	values.
+ *
+ *	The last column structures (for pruning) will be removed
+ *	after the numercial LU factorization phase.
+ *
+ *   (xlusup,lusup): lusup[*] contains the numerical values of the
+ *	rectangular supernodes; xlusup[j] points to the starting
+ *	location of the j-th column in storage vector lusup[*]
+ *	Note: xlusup is indexed by column.
+ *	Each rectangular supernode is stored by column-major
+ *	scheme, consistent with Fortran 2-dim array storage.
+ *
+ *   (xusub,ucol,usub): ucol[*] stores the numerical values of
+ *	U-columns outside the rectangular supernodes. The row
+ *	subscript of nonzero ucol[k] is stored in usub[k].
+ *	xusub[i] points to the starting location of column i in ucol.
+ *	Storage: new row subscripts; that is subscripts of PA.
+ */
+typedef struct {
+    int     *xsup;    /* supernode and column mapping */
+    int     *supno;   
+    int     *lsub;    /* compressed L subscripts */
+    int	    *xlsub;
+    double  *lusup;   /* L supernodes */
+    int     *xlusup;
+    double  *ucol;    /* U columns */
+    int     *usub;
+    int	    *xusub;
+    int     nzlmax;   /* current max size of lsub */
+    int     nzumax;   /*    "    "    "      ucol */
+    int     nzlumax;  /*    "    "    "     lusup */
+    int     n;        /* number of columns in the matrix */
+    LU_space_t MemModel; /* 0 - system malloc'd; 1 - user provided */
+} GlobalLU_t;
+
+typedef struct {
+    int panel_size;
+    int relax;
+    double diag_pivot_thresh;
+    double drop_tol;
+} factor_param_t;
+
+typedef struct {
+    float for_lu;
+    float total_needed;
+    int   expansions;
+} mem_usage_t;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* Driver routines */
+extern void
+dgssv(SuperMatrix *, int *, int *, SuperMatrix *, SuperMatrix *, 
+	SuperMatrix *, int *);
+extern void
+dgssvx(char *, char *, char *, SuperMatrix *, factor_param_t *,
+       int *, int *, int *, char *, double *, double *,
+       SuperMatrix *, SuperMatrix *, void *, int, SuperMatrix *, 
+       SuperMatrix *, double *, double *, double *,
+       double *, mem_usage_t *, int *);
+
+/* Supernodal LU factor related */
+extern void
+dCreate_CompCol_Matrix(SuperMatrix *, int, int, int, double *,
+		       int *, int *, Stype_t, Dtype_t, Mtype_t);
+extern void
+dCopy_CompCol_Matrix(SuperMatrix *, SuperMatrix *);
+extern void
+dCreate_Dense_Matrix(SuperMatrix *, int, int, double *, int,
+		     Stype_t, Dtype_t, Mtype_t);
+extern void
+dCreate_SuperNode_Matrix(SuperMatrix *, int, int, int, double *, 
+		         int *, int *, int *, int *, int *,
+			 Stype_t, Dtype_t, Mtype_t);
+extern void
+dCopy_Dense_Matrix(int, int, double *, int, double *, int);
+
+extern void    Destroy_SuperMatrix_Store(SuperMatrix *);
+extern void    Destroy_CompCol_Matrix(SuperMatrix *);
+extern void    Destroy_SuperNode_Matrix(SuperMatrix *);
+extern void    Destroy_CompCol_Permuted(SuperMatrix *);
+extern void    Destroy_Dense_Matrix(SuperMatrix *);
+extern void    get_perm_c(int, SuperMatrix *, int *);
+extern void    sp_preorder (char*, SuperMatrix*, int*, int*, SuperMatrix*);
+extern void    countnz (const int, int *, int *, int *, GlobalLU_t *);
+extern void    fixupL (const int, const int *, GlobalLU_t *);
+
+extern void    dallocateA (int, int, double **, int **, int **);
+extern void    dgstrf (char*, SuperMatrix*, double, double, int, int, int*,
+			void *, int, int *, int *, 
+                        SuperMatrix *, SuperMatrix *, int *);
+extern int     dsnode_dfs (const int, const int, const int *, const int *,
+			     const int *, int *, int *, GlobalLU_t *);
+extern int     dsnode_bmod (const int, const int, const int, double *,
+                              double *, GlobalLU_t *);
+extern void    dpanel_dfs (const int, const int, const int, SuperMatrix *,
+			   int *, int *, double *, int *, int *, int *,
+			   int *, int *, int *, int *, GlobalLU_t *);
+extern void    dpanel_bmod (const int, const int, const int, const int,
+                           double *, double *, int *, int *,
+			   GlobalLU_t *);
+extern int     dcolumn_dfs (const int, const int, int *, int *, int *, int *,
+			   int *, int *, int *, int *, int *, GlobalLU_t *);
+extern int     dcolumn_bmod (const int, const int, double *,
+			   double *, int *, int *, int, GlobalLU_t *);
+extern int     dcopy_to_ucol (int, int, int *, int *, int *,
+                              double *, GlobalLU_t *);         
+extern int     dpivotL (const int, const double, int *, int *, 
+                              int *, int *, int *, GlobalLU_t *);
+extern void    dpruneL (const int, const int *, const int, const int,
+			     const int *, const int *, int *, GlobalLU_t *);
+extern void    dreadmt (int *, int *, int *, double **, int **, int **);
+extern void    dGenXtrue (int, int, double *, int);
+extern void    dFillRHS (char *, int, double *, int, SuperMatrix *,
+			SuperMatrix *);
+extern void    dgstrs (char *, SuperMatrix *, SuperMatrix *, int *, int *,
+			SuperMatrix *, int *);
+
+
+/* Driver related */
+
+extern void    dgsequ (SuperMatrix *, double *, double *, double *,
+			     double *, double *, int *);
+extern void    dlaqgs (SuperMatrix *, double *, double *, double,
+                             double, double, char *);
+extern void    dgscon (char *, SuperMatrix *, SuperMatrix *,
+			double, double *, int *);
+extern double  dPivotGrowth(int, SuperMatrix *, int *, 
+                            SuperMatrix *, SuperMatrix *);
+extern void    dgsrfs (char *, SuperMatrix *, SuperMatrix *, 
+			SuperMatrix *, int *, int *, char *, double *,
+			double *, SuperMatrix *, SuperMatrix *, 
+			double *, double *, int *);
+
+extern int     sp_dtrsv (char *, char *, char *, SuperMatrix *,
+			SuperMatrix *, double *, int *);
+extern int     sp_dgemv (char *, double, SuperMatrix *, double *,
+			int, double, double *, int);
+
+extern int     sp_dgemm (char *, char *, int, int, int, double,
+			SuperMatrix *, double *, int, double, 
+			double *, int);
+
+/* Memory-related */
+extern int     dLUMemInit (char *, void *, int, int, int, int, int,
+			     SuperMatrix *, SuperMatrix *,
+			     GlobalLU_t *, int **, double **);
+extern void    dSetRWork (int, int, double *, double **, double **);
+extern void    dLUWorkFree (int *, double *, GlobalLU_t *);
+extern int     dLUMemXpand (int, int, MemType, int *, GlobalLU_t *);
+
+extern double  *doubleMalloc(int);
+extern double  *doubleCalloc(int);
+extern int     dmemory_usage(const int, const int, const int, const int);
+extern int     dQuerySpace (SuperMatrix *, SuperMatrix *, int,
+				mem_usage_t *);
+
+/* Auxiliary routines */
+extern void    dreadhb(int *, int *, int *, double **, int **, int **);
+extern void    dCompRow_to_CompCol(int, int, int, double*, int*, int*,
+		                   double **, int **, int **);
+extern void    dfill (double *, int, double);
+extern void    dinf_norm_error (int, SuperMatrix *, double *);
+extern void    PrintPerf (SuperMatrix *, SuperMatrix *, mem_usage_t *,
+			 double, double, double *, double *, char *);
+
+/* Routines for debugging */
+extern void    dPrint_CompCol_Matrix(char *, SuperMatrix *);
+extern void    dPrint_SuperNode_Matrix(char *, SuperMatrix *);
+extern void    dPrint_Dense_Matrix(char *, SuperMatrix *);
+extern void    print_lu_col(char *, int, int, int *, GlobalLU_t *);
+extern void    check_tempv(int, double *);
+
+#ifdef __cplusplus
+  }
+#endif
+
+#endif /* __SUPERLU_dSP_DEFS */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/dutil.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,460 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include <math.h>
+#include "dsp_defs.h"
+#include "util.h"
+
+void
+dCreate_CompCol_Matrix(SuperMatrix *A, int m, int n, int nnz, 
+		       double *nzval, int *rowind, int *colptr,
+		       Stype_t stype, Dtype_t dtype, Mtype_t mtype)
+{
+    NCformat *Astore;
+
+    A->Stype = stype;
+    A->Dtype = dtype;
+    A->Mtype = mtype;
+    A->nrow = m;
+    A->ncol = n;
+    A->Store = (void *) SUPERLU_MALLOC( sizeof(NCformat) );
+    if ( !(A->Store) ) ABORT("SUPERLU_MALLOC fails for A->Store");
+    Astore = A->Store;
+    Astore->nnz = nnz;
+    Astore->nzval = nzval;
+    Astore->rowind = rowind;
+    Astore->colptr = colptr;
+}
+
+void
+dCreate_CompRow_Matrix(SuperMatrix *A, int m, int n, int nnz, 
+		       double *nzval, int *colind, int *rowptr,
+		       Stype_t stype, Dtype_t dtype, Mtype_t mtype)
+{
+    NRformat *Astore;
+
+    A->Stype = stype;
+    A->Dtype = dtype;
+    A->Mtype = mtype;
+    A->nrow = m;
+    A->ncol = n;
+    A->Store = (void *) SUPERLU_MALLOC( sizeof(NRformat) );
+    if ( !(A->Store) ) ABORT("SUPERLU_MALLOC fails for A->Store");
+    Astore = A->Store;
+    Astore->nnz = nnz;
+    Astore->nzval = nzval;
+    Astore->colind = colind;
+    Astore->rowptr = rowptr;
+}
+
+/* Copy matrix A into matrix B. */
+void
+dCopy_CompCol_Matrix(SuperMatrix *A, SuperMatrix *B)
+{
+    NCformat *Astore, *Bstore;
+    int      ncol, nnz, i;
+
+    B->Stype = A->Stype;
+    B->Dtype = A->Dtype;
+    B->Mtype = A->Mtype;
+    B->nrow  = A->nrow;;
+    B->ncol  = ncol = A->ncol;
+    Astore   = (NCformat *) A->Store;
+    Bstore   = (NCformat *) B->Store;
+    Bstore->nnz = nnz = Astore->nnz;
+    for (i = 0; i < nnz; ++i)
+	((double *)Bstore->nzval)[i] = ((double *)Astore->nzval)[i];
+    for (i = 0; i < nnz; ++i) Bstore->rowind[i] = Astore->rowind[i];
+    for (i = 0; i <= ncol; ++i) Bstore->colptr[i] = Astore->colptr[i];
+}
+
+
+void
+dCreate_Dense_Matrix(SuperMatrix *X, int m, int n, double *x, int ldx,
+		    Stype_t stype, Dtype_t dtype, Mtype_t mtype)
+{
+    DNformat    *Xstore;
+    
+    X->Stype = stype;
+    X->Dtype = dtype;
+    X->Mtype = mtype;
+    X->nrow = m;
+    X->ncol = n;
+    X->Store = (void *) SUPERLU_MALLOC( sizeof(DNformat) );
+    if ( !(X->Store) ) ABORT("SUPERLU_MALLOC fails for X->Store");
+    Xstore = (DNformat *) X->Store;
+    Xstore->lda = ldx;
+    Xstore->nzval = (double *) x;
+}
+
+void
+dCopy_Dense_Matrix(int M, int N, double *X, int ldx,
+			double *Y, int ldy)
+{
+/*
+ *
+ *  Purpose
+ *  =======
+ *
+ *  Copies a two-dimensional matrix X to another matrix Y.
+ */
+    int    i, j;
+    
+    for (j = 0; j < N; ++j)
+        for (i = 0; i < M; ++i)
+            Y[i + j*ldy] = X[i + j*ldx];
+}
+
+void
+dCreate_SuperNode_Matrix(SuperMatrix *L, int m, int n, int nnz, 
+			double *nzval, int *nzval_colptr, int *rowind,
+			int *rowind_colptr, int *col_to_sup, int *sup_to_col,
+			Stype_t stype, Dtype_t dtype, Mtype_t mtype)
+{
+    SCformat *Lstore;
+
+    L->Stype = stype;
+    L->Dtype = dtype;
+    L->Mtype = mtype;
+    L->nrow = m;
+    L->ncol = n;
+    L->Store = (void *) SUPERLU_MALLOC( sizeof(SCformat) );
+    if ( !(L->Store) ) ABORT("SUPERLU_MALLOC fails for L->Store");
+    Lstore = L->Store;
+    Lstore->nnz = nnz;
+    Lstore->nsuper = col_to_sup[n];
+    Lstore->nzval = nzval;
+    Lstore->nzval_colptr = nzval_colptr;
+    Lstore->rowind = rowind;
+    Lstore->rowind_colptr = rowind_colptr;
+    Lstore->col_to_sup = col_to_sup;
+    Lstore->sup_to_col = sup_to_col;
+
+}
+
+
+/*
+ * Convert a row compressed storage into a column compressed storage.
+ */
+void
+dCompRow_to_CompCol(int m, int n, int nnz, 
+		    double *a, int *colind, int *rowptr,
+		    double **at, int **rowind, int **colptr)
+{
+    register int i, j, col, relpos;
+    int *marker;
+
+    /* Allocate storage for another copy of the matrix. */
+    *at = (double *) doubleMalloc(nnz);
+    *rowind = (int *) intMalloc(nnz);
+    *colptr = (int *) intMalloc(n+1);
+    marker = (int *) intCalloc(n);
+    
+    /* Get counts of each column of A, and set up column pointers */
+    for (i = 0; i < m; ++i)
+	for (j = rowptr[i]; j < rowptr[i+1]; ++j) ++marker[colind[j]];
+    (*colptr)[0] = 0;
+    for (j = 0; j < n; ++j) {
+	(*colptr)[j+1] = (*colptr)[j] + marker[j];
+	marker[j] = (*colptr)[j];
+    }
+
+    /* Transfer the matrix into the compressed column storage. */
+    for (i = 0; i < m; ++i) {
+	for (j = rowptr[i]; j < rowptr[i+1]; ++j) {
+	    col = colind[j];
+	    relpos = marker[col];
+	    (*rowind)[relpos] = i;
+	    (*at)[relpos] = a[j];
+	    ++marker[col];
+	}
+    }
+
+    SUPERLU_FREE(marker);
+}
+
+
+void
+dPrint_CompCol_Matrix(char *what, SuperMatrix *A)
+{
+    NCformat     *Astore;
+    register int i,n;
+    double       *dp;
+    
+    printf("\nCompCol matrix %s:\n", what);
+    printf("Stype %d, Dtype %d, Mtype %d\n", A->Stype,A->Dtype,A->Mtype);
+    n = A->ncol;
+    Astore = (NCformat *) A->Store;
+    dp = (double *) Astore->nzval;
+    printf("nrow %d, ncol %d, nnz %d\n", A->nrow,A->ncol,Astore->nnz);
+    printf("nzval: ");
+    for (i = 0; i < Astore->colptr[n]; ++i) printf("%f  ", dp[i]);
+    printf("\nrowind: ");
+    for (i = 0; i < Astore->colptr[n]; ++i) printf("%d  ", Astore->rowind[i]);
+    printf("\ncolptr: ");
+    for (i = 0; i <= n; ++i) printf("%d  ", Astore->colptr[i]);
+    printf("\n");
+    fflush(stdout);
+}
+
+void
+dPrint_SuperNode_Matrix(char *what, SuperMatrix *A)
+{
+    SCformat     *Astore;
+    register int i,n;
+    double       *dp;
+    
+    printf("\nSuperNode matrix %s:\n", what);
+    printf("Stype %d, Dtype %d, Mtype %d\n", A->Stype,A->Dtype,A->Mtype);
+    n = A->ncol;
+    Astore = (SCformat *) A->Store;
+    dp = (double *) Astore->nzval;
+    printf("nrow %d, ncol %d, nnz %d, nsuper %d\n", 
+	   A->nrow,A->ncol,Astore->nnz,Astore->nsuper);
+    printf("nzval: ");
+    for (i = 0; i < Astore->nzval_colptr[n]; ++i) printf("%f  ", dp[i]);
+    printf("\nnzval_colptr: ");
+    for (i = 0; i <= n; ++i) printf("%d  ", Astore->nzval_colptr[i]);
+    printf("\nrowind: ");
+    for (i = 0; i < Astore->rowind_colptr[n]; ++i) 
+        printf("%d  ", Astore->rowind[i]);
+    printf("\nrowind_colptr: ");
+    for (i = 0; i <= n; ++i) printf("%d  ", Astore->rowind_colptr[i]);
+    printf("\ncol_to_sup: ");
+    for (i = 0; i < n; ++i) printf("%d  ", Astore->col_to_sup[i]);
+    printf("\nsup_to_col: ");
+    for (i = 0; i <= Astore->nsuper+1; ++i) 
+        printf("%d  ", Astore->sup_to_col[i]);
+    printf("\n");
+    fflush(stdout);
+}
+
+void
+dPrint_Dense_Matrix(char *what, SuperMatrix *A)
+{
+    DNformat     *Astore;
+    register int i;
+    double       *dp;
+    
+    printf("\nDense matrix %s:\n", what);
+    printf("Stype %d, Dtype %d, Mtype %d\n", A->Stype,A->Dtype,A->Mtype);
+    Astore = (DNformat *) A->Store;
+    dp = (double *) Astore->nzval;
+    printf("nrow %d, ncol %d, lda %d\n", A->nrow,A->ncol,Astore->lda);
+    printf("\nnzval: ");
+    for (i = 0; i < A->nrow; ++i) printf("%f  ", dp[i]);
+    printf("\n");
+    fflush(stdout);
+}
+
+/*
+ * Diagnostic print of column "jcol" in the U/L factor.
+ */
+void
+dprint_lu_col(char *msg, int jcol, int pivrow, int *xprune, GlobalLU_t *Glu)
+{
+    int     i, k, fsupc;
+    int     *xsup, *supno;
+    int     *xlsub, *lsub;
+    double  *lusup;
+    int     *xlusup;
+    double  *ucol;
+    int     *usub, *xusub;
+
+    xsup    = Glu->xsup;
+    supno   = Glu->supno;
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    lusup   = Glu->lusup;
+    xlusup  = Glu->xlusup;
+    ucol    = Glu->ucol;
+    usub    = Glu->usub;
+    xusub   = Glu->xusub;
+    
+    printf("%s", msg);
+    printf("col %d: pivrow %d, supno %d, xprune %d\n", 
+	   jcol, pivrow, supno[jcol], xprune[jcol]);
+    
+    printf("\tU-col:\n");
+    for (i = xusub[jcol]; i < xusub[jcol+1]; i++)
+	printf("\t%d%10.4f\n", usub[i], ucol[i]);
+    printf("\tL-col in rectangular snode:\n");
+    fsupc = xsup[supno[jcol]];	/* first col of the snode */
+    i = xlsub[fsupc];
+    k = xlusup[jcol];
+    while ( i < xlsub[fsupc+1] && k < xlusup[jcol+1] ) {
+	printf("\t%d\t%10.4f\n", lsub[i], lusup[k]);
+	i++; k++;
+    }
+    fflush(stdout);
+}
+
+
+/*
+ * Check whether tempv[] == 0. This should be true before and after 
+ * calling any numeric routines, i.e., "panel_bmod" and "column_bmod". 
+ */
+void dcheck_tempv(int n, double *tempv)
+{
+    int i;
+	
+    for (i = 0; i < n; i++) {
+	if (tempv[i] != 0.0) 
+	{
+	    fprintf(stderr,"tempv[%d] = %f\n", i,tempv[i]);
+	    ABORT("dcheck_tempv");
+	}
+    }
+}
+
+
+void
+dGenXtrue(int n, int nrhs, double *x, int ldx)
+{
+    int  i, j;
+    for (j = 0; j < nrhs; ++j)
+	for (i = 0; i < n; ++i) {
+	    x[i + j*ldx] = 1.0;/* + (double)(i+1.)/n;*/
+	}
+}
+
+/*
+ * Let rhs[i] = sum of i-th row of A, so the solution vector is all 1's
+ */
+void
+dFillRHS(char *trans, int nrhs, double *x, int ldx,
+		SuperMatrix *A, SuperMatrix *B)
+{
+    NCformat *Astore;
+    double   *Aval;
+    DNformat *Bstore;
+    double   *rhs;
+    double one = 1.0;
+    double zero = 0.0;
+    int      ldc;
+
+    Astore = A->Store;
+    Aval   = (double *) Astore->nzval;
+    Bstore = B->Store;
+    rhs    = Bstore->nzval;
+    ldc    = Bstore->lda;
+    
+    sp_dgemm(trans, "N", A->nrow, nrhs, A->ncol, one, A,
+	     x, ldx, zero, rhs, ldc);
+
+}
+
+/* 
+ * Fills a double precision array with a given value.
+ */
+void 
+dfill(double *a, int alen, double dval)
+{
+    register int i;
+    for (i = 0; i < alen; i++) a[i] = dval;
+}
+
+
+
+/* 
+ * Check the inf-norm of the error vector 
+ */
+void dinf_norm_error(int nrhs, SuperMatrix *X, double *xtrue)
+{
+    DNformat *Xstore;
+    double err, xnorm;
+    double *Xmat, *soln_work;
+    int i, j;
+
+    Xstore = X->Store;
+    Xmat = Xstore->nzval;
+
+    for (j = 0; j < nrhs; j++) {
+      soln_work = &Xmat[j*Xstore->lda];
+      err = xnorm = 0.0;
+      for (i = 0; i < X->nrow; i++) {
+	err = MAX(err, fabs(soln_work[i] - xtrue[i]));
+	xnorm = MAX(xnorm, fabs(soln_work[i]));
+      }
+      err = err / xnorm;
+      printf("||X - Xtrue||/||X|| = %e\n", err);
+    }
+}
+
+
+
+/* Print performance of the code. */
+void
+dPrintPerf(SuperMatrix *L, SuperMatrix *U, mem_usage_t *mem_usage,
+	       double rpg, double rcond, double *ferr,
+	       double *berr, char *equed)
+{
+    SCformat *Lstore;
+    NCformat *Ustore;
+    extern SuperLUStat_t SuperLUStat;
+    double   *utime;
+    flops_t  *ops;
+    
+    utime = SuperLUStat.utime;
+    ops   = SuperLUStat.ops;
+    
+    if ( utime[FACT] != 0. )
+	printf("Factor flops = %e\tMflops = %8.2f\n", ops[FACT],
+	       ops[FACT]*1e-6/utime[FACT]);
+    printf("Identify relaxed snodes	= %8.2f\n", utime[RELAX]);
+    if ( utime[SOLVE] != 0. )
+	printf("Solve flops = %.0f, Mflops = %8.2f\n", ops[SOLVE],
+	       ops[SOLVE]*1e-6/utime[SOLVE]);
+    
+    Lstore = (SCformat *) L->Store;
+    Ustore = (NCformat *) U->Store;
+    printf("\tNo of nonzeros in factor L = %d\n", Lstore->nnz);
+    printf("\tNo of nonzeros in factor U = %d\n", Ustore->nnz);
+    printf("\tNo of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz);
+	
+    printf("L\\U MB %.3f\ttotal MB needed %.3f\texpansions %d\n",
+	   mem_usage->for_lu/1e6, mem_usage->total_needed/1e6,
+	   mem_usage->expansions);
+	
+    printf("\tFactor\tMflops\tSolve\tMflops\tEtree\tEquil\tRcond\tRefine\n");
+    printf("PERF:%8.2f%8.2f%8.2f%8.2f%8.2f%8.2f%8.2f%8.2f\n",
+	   utime[FACT], ops[FACT]*1e-6/utime[FACT],
+	   utime[SOLVE], ops[SOLVE]*1e-6/utime[SOLVE],
+	   utime[ETREE], utime[EQUIL], utime[RCOND], utime[REFINE]);
+    
+    printf("\tRpg\t\tRcond\t\tFerr\t\tBerr\t\tEquil?\n");
+    printf("NUM:\t%e\t%e\t%e\t%e\t%s\n",
+	   rpg, rcond, ferr[0], berr[0], equed);
+    
+}
+
+
+
+
+print_double_vec(char *what, int n, double *vec)
+{
+    int i;
+    printf("%s: n %d\n", what, n);
+    for (i = 0; i < n; ++i) printf("%d\t%f\n", i, vec[i]);
+    return 0;
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/get_perm_c.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,453 @@
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include "supermatrix.h"
+#include "util.h"
+#include "colamd.h"
+
+extern int  genmmd_(int *, int *, int *, int *, int *, int *, int *, 
+		    int *, int *, int *, int *, int *);
+
+void
+get_colamd(
+	   const int m,  /* number of rows in matrix A. */
+	   const int n,  /* number of columns in matrix A. */
+	   const int nnz,/* number of nonzeros in matrix A. */
+	   int *colptr,  /* column pointer of size n+1 for matrix A. */
+	   int *rowind,  /* row indices of size nz for matrix A. */
+	   int *perm_c   /* out - the column permutation vector. */
+	   )
+{
+    int Alen, *A, i, info, *p;
+    double *knobs;
+
+    Alen = colamd_recommended(nnz, m, n);
+
+    if ( !(knobs = (double *) SUPERLU_MALLOC(COLAMD_KNOBS * sizeof(double))) )
+        ABORT("Malloc fails for knobs");
+    colamd_set_defaults(knobs);
+
+    if (!(A = (int *) SUPERLU_MALLOC(Alen * sizeof(int))) )
+        ABORT("Malloc fails for A[]");
+    if (!(p = (int *) SUPERLU_MALLOC((n+1) * sizeof(int))) )
+        ABORT("Malloc fails for p[]");
+    for (i = 0; i <= n; ++i) p[i] = colptr[i];
+    for (i = 0; i < nnz; ++i) A[i] = rowind[i];
+    info = colamd(m, n, Alen, A, p, knobs);
+    if ( info == FALSE ) ABORT("COLAMD failed");
+
+    for (i = 0; i < n; ++i) perm_c[p[i]] = i;
+
+    SUPERLU_FREE(knobs);
+    SUPERLU_FREE(A);
+    SUPERLU_FREE(p);
+}
+
+void
+getata(
+       const int m,      /* number of rows in matrix A. */
+       const int n,      /* number of columns in matrix A. */
+       const int nz,     /* number of nonzeros in matrix A */
+       int *colptr,      /* column pointer of size n+1 for matrix A. */
+       int *rowind,      /* row indices of size nz for matrix A. */
+       int *atanz,       /* out - on exit, returns the actual number of
+                            nonzeros in matrix A'*A. */
+       int **ata_colptr, /* out - size n+1 */
+       int **ata_rowind  /* out - size *atanz */
+       )
+/*
+ * Purpose
+ * =======
+ *
+ * Form the structure of A'*A. A is an m-by-n matrix in column oriented
+ * format represented by (colptr, rowind). The output A'*A is in column
+ * oriented format (symmetrically, also row oriented), represented by
+ * (ata_colptr, ata_rowind).
+ *
+ * This routine is modified from GETATA routine by Tim Davis.
+ * The complexity of this algorithm is: SUM_{i=1,m} r(i)^2,
+ * i.e., the sum of the square of the row counts.
+ *
+ * Questions
+ * =========
+ *     o  Do I need to withhold the *dense* rows?
+ *     o  How do I know the number of nonzeros in A'*A?
+ * 
+ */
+{
+    register int i, j, k, col, num_nz, ti, trow;
+    int *marker, *b_colptr, *b_rowind;
+    int *t_colptr, *t_rowind; /* a column oriented form of T = A' */
+
+    if ( !(marker = (int*) SUPERLU_MALLOC( (MAX(m,n)+1) * sizeof(int)) ) )
+	ABORT("SUPERLU_MALLOC fails for marker[]");
+    if ( !(t_colptr = (int*) SUPERLU_MALLOC( (m+1) * sizeof(int)) ) )
+	ABORT("SUPERLU_MALLOC t_colptr[]");
+    if ( !(t_rowind = (int*) SUPERLU_MALLOC( nz * sizeof(int)) ) )
+	ABORT("SUPERLU_MALLOC fails for t_rowind[]");
+
+    
+    /* Get counts of each column of T, and set up column pointers */
+    for (i = 0; i < m; ++i) marker[i] = 0;
+    for (j = 0; j < n; ++j) {
+	for (i = colptr[j]; i < colptr[j+1]; ++i)
+	    ++marker[rowind[i]];
+    }
+    t_colptr[0] = 0;
+    for (i = 0; i < m; ++i) {
+	t_colptr[i+1] = t_colptr[i] + marker[i];
+	marker[i] = t_colptr[i];
+    }
+
+    /* Transpose the matrix from A to T */
+    for (j = 0; j < n; ++j)
+	for (i = colptr[j]; i < colptr[j+1]; ++i) {
+	    col = rowind[i];
+	    t_rowind[marker[col]] = j;
+	    ++marker[col];
+	}
+
+    
+    /* ----------------------------------------------------------------
+       compute B = T * A, where column j of B is:
+
+       Struct (B_*j) =    UNION   ( Struct (T_*k) )
+                        A_kj != 0
+
+       do not include the diagonal entry
+   
+       ( Partition A as: A = (A_*1, ..., A_*n)
+         Then B = T * A = (T * A_*1, ..., T * A_*n), where
+         T * A_*j = (T_*1, ..., T_*m) * A_*j.  )
+       ---------------------------------------------------------------- */
+
+    /* Zero the diagonal flag */
+    for (i = 0; i < n; ++i) marker[i] = -1;
+
+    /* First pass determines number of nonzeros in B */
+    num_nz = 0;
+    for (j = 0; j < n; ++j) {
+	/* Flag the diagonal so it's not included in the B matrix */
+	marker[j] = j;
+
+	for (i = colptr[j]; i < colptr[j+1]; ++i) {
+	    /* A_kj is nonzero, add pattern of column T_*k to B_*j */
+	    k = rowind[i];
+	    for (ti = t_colptr[k]; ti < t_colptr[k+1]; ++ti) {
+		trow = t_rowind[ti];
+		if ( marker[trow] != j ) {
+		    marker[trow] = j;
+		    num_nz++;
+		}
+	    }
+	}
+    }
+    *atanz = num_nz;
+    
+    /* Allocate storage for A'*A */
+    if ( !(*ata_colptr = (int*) SUPERLU_MALLOC( (n+1) * sizeof(int)) ) )
+	ABORT("SUPERLU_MALLOC fails for ata_colptr[]");
+    if ( *atanz ) {
+	if ( !(*ata_rowind = (int*) SUPERLU_MALLOC( *atanz * sizeof(int)) ) )
+	    ABORT("SUPERLU_MALLOC fails for ata_rowind[]");
+    }
+    b_colptr = *ata_colptr; /* aliasing */
+    b_rowind = *ata_rowind;
+    
+    /* Zero the diagonal flag */
+    for (i = 0; i < n; ++i) marker[i] = -1;
+    
+    /* Compute each column of B, one at a time */
+    num_nz = 0;
+    for (j = 0; j < n; ++j) {
+	b_colptr[j] = num_nz;
+	
+	/* Flag the diagonal so it's not included in the B matrix */
+	marker[j] = j;
+
+	for (i = colptr[j]; i < colptr[j+1]; ++i) {
+	    /* A_kj is nonzero, add pattern of column T_*k to B_*j */
+	    k = rowind[i];
+	    for (ti = t_colptr[k]; ti < t_colptr[k+1]; ++ti) {
+		trow = t_rowind[ti];
+		if ( marker[trow] != j ) {
+		    marker[trow] = j;
+		    b_rowind[num_nz++] = trow;
+		}
+	    }
+	}
+    }
+    b_colptr[n] = num_nz;
+       
+    SUPERLU_FREE(marker);
+    SUPERLU_FREE(t_colptr);
+    SUPERLU_FREE(t_rowind);
+}
+
+
+void
+a_plus_at(
+	  const int n,      /* number of columns in matrix A. */
+	  const int nz,     /* number of nonzeros in matrix A */
+	  int *colptr,      /* column pointer of size n+1 for matrix A. */
+	  int *rowind,      /* row indices of size nz for matrix A. */
+	  int *bnz,         /* out - on exit, returns the actual number of
+                               nonzeros in matrix A'*A. */
+	  int **b_colptr,   /* out - size n+1 */
+	  int **b_rowind    /* out - size *bnz */
+	  )
+{
+/*
+ * Purpose
+ * =======
+ *
+ * Form the structure of A'+A. A is an n-by-n matrix in column oriented
+ * format represented by (colptr, rowind). The output A'+A is in column
+ * oriented format (symmetrically, also row oriented), represented by
+ * (b_colptr, b_rowind).
+ *
+ */
+    register int i, j, k, col, num_nz;
+    int *t_colptr, *t_rowind; /* a column oriented form of T = A' */
+    int *marker;
+
+    if ( !(marker = (int*) SUPERLU_MALLOC( n * sizeof(int)) ) )
+	ABORT("SUPERLU_MALLOC fails for marker[]");
+    if ( !(t_colptr = (int*) SUPERLU_MALLOC( (n+1) * sizeof(int)) ) )
+	ABORT("SUPERLU_MALLOC fails for t_colptr[]");
+    if ( !(t_rowind = (int*) SUPERLU_MALLOC( nz * sizeof(int)) ) )
+	ABORT("SUPERLU_MALLOC fails t_rowind[]");
+
+    
+    /* Get counts of each column of T, and set up column pointers */
+    for (i = 0; i < n; ++i) marker[i] = 0;
+    for (j = 0; j < n; ++j) {
+	for (i = colptr[j]; i < colptr[j+1]; ++i)
+	    ++marker[rowind[i]];
+    }
+    t_colptr[0] = 0;
+    for (i = 0; i < n; ++i) {
+	t_colptr[i+1] = t_colptr[i] + marker[i];
+	marker[i] = t_colptr[i];
+    }
+
+    /* Transpose the matrix from A to T */
+    for (j = 0; j < n; ++j)
+	for (i = colptr[j]; i < colptr[j+1]; ++i) {
+	    col = rowind[i];
+	    t_rowind[marker[col]] = j;
+	    ++marker[col];
+	}
+
+
+    /* ----------------------------------------------------------------
+       compute B = A + T, where column j of B is:
+
+       Struct (B_*j) = Struct (A_*k) UNION Struct (T_*k)
+
+       do not include the diagonal entry
+       ---------------------------------------------------------------- */
+
+    /* Zero the diagonal flag */
+    for (i = 0; i < n; ++i) marker[i] = -1;
+
+    /* First pass determines number of nonzeros in B */
+    num_nz = 0;
+    for (j = 0; j < n; ++j) {
+	/* Flag the diagonal so it's not included in the B matrix */
+	marker[j] = j;
+
+	/* Add pattern of column A_*k to B_*j */
+	for (i = colptr[j]; i < colptr[j+1]; ++i) {
+	    k = rowind[i];
+	    if ( marker[k] != j ) {
+		marker[k] = j;
+		++num_nz;
+	    }
+	}
+
+	/* Add pattern of column T_*k to B_*j */
+	for (i = t_colptr[j]; i < t_colptr[j+1]; ++i) {
+	    k = t_rowind[i];
+	    if ( marker[k] != j ) {
+		marker[k] = j;
+		++num_nz;
+	    }
+	}
+    }
+    *bnz = num_nz;
+    
+    /* Allocate storage for A+A' */
+    if ( !(*b_colptr = (int*) SUPERLU_MALLOC( (n+1) * sizeof(int)) ) )
+	ABORT("SUPERLU_MALLOC fails for b_colptr[]");
+    if ( *bnz) {
+      if ( !(*b_rowind = (int*) SUPERLU_MALLOC( *bnz * sizeof(int)) ) )
+	ABORT("SUPERLU_MALLOC fails for b_rowind[]");
+    }
+    
+    /* Zero the diagonal flag */
+    for (i = 0; i < n; ++i) marker[i] = -1;
+    
+    /* Compute each column of B, one at a time */
+    num_nz = 0;
+    for (j = 0; j < n; ++j) {
+	(*b_colptr)[j] = num_nz;
+	
+	/* Flag the diagonal so it's not included in the B matrix */
+	marker[j] = j;
+
+	/* Add pattern of column A_*k to B_*j */
+	for (i = colptr[j]; i < colptr[j+1]; ++i) {
+	    k = rowind[i];
+	    if ( marker[k] != j ) {
+		marker[k] = j;
+		(*b_rowind)[num_nz++] = k;
+	    }
+	}
+
+	/* Add pattern of column T_*k to B_*j */
+	for (i = t_colptr[j]; i < t_colptr[j+1]; ++i) {
+	    k = t_rowind[i];
+	    if ( marker[k] != j ) {
+		marker[k] = j;
+		(*b_rowind)[num_nz++] = k;
+	    }
+	}
+    }
+    (*b_colptr)[n] = num_nz;
+       
+    SUPERLU_FREE(marker);
+    SUPERLU_FREE(t_colptr);
+    SUPERLU_FREE(t_rowind);
+}
+
+void
+get_perm_c(int ispec, SuperMatrix *A, int *perm_c)
+/*
+ * Purpose
+ * =======
+ *
+ * GET_PERM_C obtains a permutation matrix Pc, by applying the multiple
+ * minimum degree ordering code by Joseph Liu to matrix A'*A or A+A'.
+ * or using approximate minimum degree column ordering by Davis et. al.
+ * The LU factorization of A*Pc tends to have less fill than the LU 
+ * factorization of A.
+ *
+ * Arguments
+ * =========
+ *
+ * ispec   (input) int
+ *         Specifies the type of column ordering to reduce fill:
+ *         = 1: minimum degree on the structure of A^T * A
+ *         = 2: minimum degree on the structure of A^T + A
+ *         = 3: approximate minimum degree for unsymmetric matrices
+ *         If ispec == 0, the natural ordering (i.e., Pc = I) is returned.
+ * 
+ * A       (input) SuperMatrix*
+ *         Matrix A in A*X=B, of dimension (A->nrow, A->ncol). The number
+ *         of the linear equations is A->nrow. Currently, the type of A 
+ *         can be: Stype = NC; Dtype = _D; Mtype = GE. In the future,
+ *         more general A can be handled.
+ *
+ * perm_c  (output) int*
+ *	   Column permutation vector of size A->ncol, which defines the 
+ *         permutation matrix Pc; perm_c[i] = j means column i of A is 
+ *         in position j in A*Pc.
+ *
+ */
+{
+    NCformat *Astore = A->Store;
+    int m, n, bnz, *b_colptr, i;
+    int delta, maxint, nofsub, *invp;
+    int *b_rowind, *dhead, *qsize, *llist, *marker;
+    double t, SuperLU_timer_();
+    
+    m = A->nrow;
+    n = A->ncol;
+
+    t = SuperLU_timer_();
+    switch ( ispec ) {
+        case 0: /* Natural ordering */
+	      for (i = 0; i < n; ++i) perm_c[i] = i;
+#ifdef VERBOSE                     
+	      printf("Use natural column ordering.\n");
+#endif              
+	      return;
+        case 1: /* Minimum degree ordering on A'*A */
+	      getata(m, n, Astore->nnz, Astore->colptr, Astore->rowind,
+		     &bnz, &b_colptr, &b_rowind);
+#ifdef VERBOSE                     
+	      printf("Use minimum degree ordering on A'*A.\n");
+#endif              
+	      t = SuperLU_timer_() - t;
+	      /*printf("Form A'*A time = %8.3f\n", t);*/
+	      break;
+        case 2: /* Minimum degree ordering on A'+A */
+	      if ( m != n ) ABORT("Matrix is not square");
+	      a_plus_at(n, Astore->nnz, Astore->colptr, Astore->rowind,
+			&bnz, &b_colptr, &b_rowind);
+#ifdef VERBOSE                     
+	      printf("Use minimum degree ordering on A'+A.\n");
+#endif
+	      t = SuperLU_timer_() - t;
+	      /*printf("Form A'+A time = %8.3f\n", t);*/
+	      break;
+        case 3: /* Approximate minimum degree column ordering. */
+	      get_colamd(m, n, Astore->nnz, Astore->colptr, Astore->rowind,
+			 perm_c);
+#ifdef VERBOSE                     
+	      printf(".. Use approximate minimum degree column ordering.\n");
+#endif              
+	      return; 
+        default:
+	      ABORT("Invalid ISPEC");
+    }
+
+    if ( bnz != 0 ) {
+	t = SuperLU_timer_();
+
+	/* Initialize and allocate storage for GENMMD. */
+	delta = 1; /* DELTA is a parameter to allow the choice of nodes
+		      whose degree <= min-degree + DELTA. */
+	maxint = 2147483647; /* 2**31 - 1 */
+	invp = (int *) SUPERLU_MALLOC((n+delta)*sizeof(int));
+	if ( !invp ) ABORT("SUPERLU_MALLOC fails for invp.");
+	dhead = (int *) SUPERLU_MALLOC((n+delta)*sizeof(int));
+	if ( !dhead ) ABORT("SUPERLU_MALLOC fails for dhead.");
+	qsize = (int *) SUPERLU_MALLOC((n+delta)*sizeof(int));
+	if ( !qsize ) ABORT("SUPERLU_MALLOC fails for qsize.");
+	llist = (int *) SUPERLU_MALLOC(n*sizeof(int));
+	if ( !llist ) ABORT("SUPERLU_MALLOC fails for llist.");
+	marker = (int *) SUPERLU_MALLOC(n*sizeof(int));
+	if ( !marker ) ABORT("SUPERLU_MALLOC fails for marker.");
+
+	/* Transform adjacency list into 1-based indexing required by GENMMD.*/
+	for (i = 0; i <= n; ++i) ++b_colptr[i];
+	for (i = 0; i < bnz; ++i) ++b_rowind[i];
+	
+	genmmd_(&n, b_colptr, b_rowind, perm_c, invp, &delta, dhead, 
+		qsize, llist, marker, &maxint, &nofsub);
+
+	/* Transform perm_c into 0-based indexing. */
+	for (i = 0; i < n; ++i) --perm_c[i];
+
+	SUPERLU_FREE(b_colptr);
+	SUPERLU_FREE(b_rowind);
+	SUPERLU_FREE(invp);
+	SUPERLU_FREE(dhead);
+	SUPERLU_FREE(qsize);
+	SUPERLU_FREE(llist);
+	SUPERLU_FREE(marker);
+
+	t = SuperLU_timer_() - t;
+	/*  printf("call GENMMD time = %8.3f\n", t);*/
+
+    } else { /* Empty adjacency structure */
+	for (i = 0; i < n; ++i) perm_c[i] = i;
+    }
+
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/icmax1.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,115 @@
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include <math.h>
+#include "scomplex.h"
+
+int icmax1_(int *n, complex *cx, int *incx)
+{
+/*  -- LAPACK auxiliary routine (version 2.0) --   
+       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
+       Courant Institute, Argonne National Lab, and Rice University   
+       September 30, 1994   
+
+
+    Purpose   
+    =======   
+
+    ICMAX1 finds the index of the element whose real part has maximum   
+    absolute value.   
+
+    Based on ICAMAX from Level 1 BLAS.   
+    The change is to use the 'genuine' absolute value.   
+
+    Contributed by Nick Higham for use with CLACON.   
+
+    Arguments   
+    =========   
+
+    N       (input) INT   
+            The number of elements in the vector CX.   
+
+    CX      (input) COMPLEX array, dimension (N)   
+            The vector whose elements will be summed.   
+
+    INCX    (input) INT   
+            The spacing between successive values of CX.  INCX >= 1.   
+
+   ===================================================================== 
+  
+
+
+       NEXT LINE IS THE ONLY MODIFICATION.   
+
+    
+   Parameter adjustments   
+       Function Body */
+    /* System generated locals */
+    int ret_val, i__1, i__2;
+    float r__1;
+    /* Local variables */
+    static float smax;
+    static int i, ix;
+
+
+#define CX(I) cx[(I)-1]
+
+
+    ret_val = 0;
+    if (*n < 1) {
+	return ret_val;
+    }
+    ret_val = 1;
+    if (*n == 1) {
+	return ret_val;
+    }
+    if (*incx == 1) {
+	goto L30;
+    }
+
+/*     CODE FOR INCREMENT NOT EQUAL TO 1 */
+
+    ix = 1;
+    smax = (r__1 = CX(1).r, fabs(r__1));
+    ix += *incx;
+    i__1 = *n;
+    for (i = 2; i <= *n; ++i) {
+	i__2 = ix;
+	if ((r__1 = CX(ix).r, fabs(r__1)) <= smax) {
+	    goto L10;
+	}
+	ret_val = i;
+	i__2 = ix;
+	smax = (r__1 = CX(ix).r, fabs(r__1));
+L10:
+	ix += *incx;
+/* L20: */
+    }
+    return ret_val;
+
+/*     CODE FOR INCREMENT EQUAL TO 1 */
+
+L30:
+    smax = (r__1 = CX(1).r, fabs(r__1));
+    i__1 = *n;
+    for (i = 2; i <= *n; ++i) {
+	i__2 = i;
+	if ((r__1 = CX(i).r, fabs(r__1)) <= smax) {
+	    goto L40;
+	}
+	ret_val = i;
+	i__2 = i;
+	smax = (r__1 = CX(i).r, fabs(r__1));
+L40:
+	;
+    }
+    return ret_val;
+
+/*     End of ICMAX1 */
+
+} /* icmax1_ */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/izmax1.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,108 @@
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include "dcomplex.h"
+
+int
+izmax1_(int *n, doublecomplex *cx, int *incx)
+{
+/*  -- LAPACK auxiliary routine (version 2.0) --   
+       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
+       Courant Institute, Argonne National Lab, and Rice University   
+       September 30, 1994   
+
+
+    Purpose   
+    =======   
+
+    IZMAX1 finds the index of the element whose real part has maximum   
+    absolute value.   
+
+    Based on IZAMAX from Level 1 BLAS.   
+    The change is to use the 'genuine' absolute value.   
+
+    Contributed by Nick Higham for use with ZLACON.   
+
+    Arguments   
+    =========   
+
+    N       (input) INT   
+            The number of elements in the vector CX.   
+
+    CX      (input) COMPLEX*16 array, dimension (N)   
+            The vector whose elements will be summed.   
+
+    INCX    (input) INT   
+            The spacing between successive values of CX.  INCX >= 1.   
+
+   ===================================================================== 
+*/  
+
+    /* System generated locals */
+    int ret_val, i__1, i__2;
+    double d__1;
+    
+    /* Local variables */
+    double smax;
+    int i, ix;
+
+#define CX(I) cx[(I)-1]
+
+    ret_val = 0;
+    if (*n < 1) {
+	return ret_val;
+    }
+    ret_val = 1;
+    if (*n == 1) {
+	return ret_val;
+    }
+    if (*incx == 1) {
+	goto L30;
+    }
+
+/*     CODE FOR INCREMENT NOT EQUAL TO 1 */
+
+    ix = 1;
+    smax = (d__1 = CX(1).r, abs(d__1));
+    ix += *incx;
+    i__1 = *n;
+    for (i = 2; i <= *n; ++i) {
+	i__2 = ix;
+	if ((d__1 = CX(ix).r, abs(d__1)) <= smax) {
+	    goto L10;
+	}
+	ret_val = i;
+	i__2 = ix;
+	smax = (d__1 = CX(ix).r, abs(d__1));
+L10:
+	ix += *incx;
+/* L20: */
+    }
+    return ret_val;
+
+/*     CODE FOR INCREMENT EQUAL TO 1 */
+
+L30:
+    smax = (d__1 = CX(1).r, abs(d__1));
+    i__1 = *n;
+    for (i = 2; i <= *n; ++i) {
+	i__2 = i;
+	if ((d__1 = CX(i).r, abs(d__1)) <= smax) {
+	    goto L40;
+	}
+	ret_val = i;
+	i__2 = i;
+	smax = (d__1 = CX(i).r, abs(d__1));
+L40:
+	;
+    }
+    return ret_val;
+
+/*     End of IZMAX1 */
+
+} /* izmax1_ */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/lsame.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,70 @@
+int lsame_(char *ca, char *cb)
+{
+/*  -- LAPACK auxiliary routine (version 2.0) --   
+       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
+       Courant Institute, Argonne National Lab, and Rice University   
+       September 30, 1994   
+
+    Purpose   
+    =======   
+
+    LSAME returns .TRUE. if CA is the same letter as CB regardless of case.   
+
+    Arguments   
+    =========   
+
+    CA      (input) CHARACTER*1   
+    CB      (input) CHARACTER*1   
+            CA and CB specify the single characters to be compared.   
+
+   ===================================================================== 
+*/  
+
+    /* System generated locals */
+    int ret_val;
+    
+    /* Local variables */
+    int inta, intb, zcode;
+
+    ret_val = *(unsigned char *)ca == *(unsigned char *)cb;
+    if (ret_val) {
+	return ret_val;
+    }
+
+    /* Now test for equivalence if both characters are alphabetic. */
+
+    zcode = 'Z';
+
+    /* Use 'Z' rather than 'A' so that ASCII can be detected on Prime   
+       machines, on which ICHAR returns a value with bit 8 set.   
+       ICHAR('A') on Prime machines returns 193 which is the same as   
+       ICHAR('A') on an EBCDIC machine. */
+
+    inta = *(unsigned char *)ca;
+    intb = *(unsigned char *)cb;
+
+    if (zcode == 90 || zcode == 122) {
+	/* ASCII is assumed - ZCODE is the ASCII code of either lower or   
+          upper case 'Z'. */
+	if (inta >= 97 && inta <= 122) inta += -32;
+	if (intb >= 97 && intb <= 122) intb += -32;
+
+    } else if (zcode == 233 || zcode == 169) {
+	/* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or   
+          upper case 'Z'. */
+	if (inta >= 129 && inta <= 137 || inta >= 145 && inta <= 153 || inta 
+		>= 162 && inta <= 169)
+	    inta += 64;
+	if (intb >= 129 && intb <= 137 || intb >= 145 && intb <= 153 || intb 
+		>= 162 && intb <= 169)
+	    intb += 64;
+    } else if (zcode == 218 || zcode == 250) {
+	/* ASCII is assumed, on Prime machines - ZCODE is the ASCII code   
+          plus 128 of either lower or upper case 'Z'. */
+	if (inta >= 225 && inta <= 250) inta += -32;
+	if (intb >= 225 && intb <= 250) intb += -32;
+    }
+    ret_val = inta == intb;
+    return ret_val;
+    
+} /* lsame_ */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/memory.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,132 @@
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/** Precision-independent memory-related routines.
+    (Shared by [sdcz]memory.c) **/
+
+#include "util.h"
+
+/*
+ * Set up pointers for integer working arrays.
+ */
+void
+SetIWork(int m, int n, int panel_size, int *iworkptr, int **segrep,
+	 int **parent, int **xplore, int **repfnz, int **panel_lsub,
+	 int **xprune, int **marker)
+{
+    *segrep = iworkptr;
+    *parent = iworkptr + m;
+    *xplore = *parent + m;
+    *repfnz = *xplore + m;
+    *panel_lsub = *repfnz + panel_size * m;
+    *xprune = *panel_lsub + panel_size * m;
+    *marker = *xprune + n;
+    ifill (*repfnz, n * panel_size, EMPTY);
+    ifill (*panel_lsub, m * panel_size, EMPTY);
+}
+
+
+void
+copy_mem_int(int howmany, void *old, void *new)
+{
+    register int i;
+    int *iold = old;
+    int *inew = new;
+    for (i = 0; i < howmany; i++) inew[i] = iold[i];
+}
+
+
+void
+user_bcopy(char *src, char *dest, int bytes)
+{
+    char *s_ptr, *d_ptr;
+
+    s_ptr = src + bytes - 1;
+    d_ptr = dest + bytes - 1;
+    for (; d_ptr >= dest; --s_ptr, --d_ptr ) *d_ptr = *s_ptr;
+}
+
+
+
+int *intMalloc(int n)
+{
+    int *buf;
+    buf = (int *) SUPERLU_MALLOC(n * sizeof(int));
+    if ( !buf ) {
+	ABORT("SUPERLU_MALLOC fails for buf in intMalloc()");
+    }
+    return (buf);
+}
+
+int *intCalloc(int n)
+{
+    int *buf;
+    register int i;
+    buf = (int *) SUPERLU_MALLOC(n * sizeof(int));
+    if ( !buf ) {
+	ABORT("SUPERLU_MALLOC fails for buf in intCalloc()");
+    }
+    for (i = 0; i < n; ++i) buf[i] = 0;
+    return (buf);
+}
+
+
+
+#if 0
+check_expanders()
+{
+    int p;
+    printf("Check expanders:\n");
+    for (p = 0; p < NO_MEMTYPE; p++) {
+	printf("type %d, size %d, mem %d\n",
+	       p, expanders[p].size, (int)expanders[p].mem);
+    }
+
+    return 0;
+}
+
+
+StackInfo()
+{
+    printf("Stack: size %d, used %d, top1 %d, top2 %d\n",
+	   stack.size, stack.used, stack.top1, stack.top2);
+    return 0;
+}
+
+
+
+PrintStack(char *msg, GlobalLU_t *Glu)
+{
+    int i;
+    int *xlsub, *lsub, *xusub, *usub;
+
+    xlsub = Glu->xlsub;
+    lsub  = Glu->lsub;
+    xusub = Glu->xusub;
+    usub  = Glu->usub;
+
+    printf("%s\n", msg);
+    
+/*    printf("\nUCOL: ");
+    for (i = 0; i < xusub[ndim]; ++i)
+	printf("%f  ", ucol[i]);
+
+    printf("\nLSUB: ");
+    for (i = 0; i < xlsub[ndim]; ++i)
+	printf("%d  ", lsub[i]);
+
+    printf("\nUSUB: ");
+    for (i = 0; i < xusub[ndim]; ++i)
+	printf("%d  ", usub[i]);
+
+    printf("\n");*/
+    return 0;
+}   
+#endif
+
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/mmd.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,1012 @@
+
+typedef int shortint;
+
+/* *************************************************************** */
+/* *************************************************************** */
+/* ****     GENMMD ..... MULTIPLE MINIMUM EXTERNAL DEGREE     **** */
+/* *************************************************************** */
+/* *************************************************************** */
+
+/*     AUTHOR - JOSEPH W.H. LIU */
+/*              DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
+
+/*     PURPOSE - THIS ROUTINE IMPLEMENTS THE MINIMUM DEGREE */
+/*        ALGORITHM.  IT MAKES USE OF THE IMPLICIT REPRESENTATION */
+/*        OF ELIMINATION GRAPHS BY QUOTIENT GRAPHS, AND THE */
+/*        NOTION OF INDISTINGUISHABLE NODES.  IT ALSO IMPLEMENTS */
+/*        THE MODIFICATIONS BY MULTIPLE ELIMINATION AND MINIMUM */
+/*        EXTERNAL DEGREE. */
+/*        --------------------------------------------- */
+/*        CAUTION - THE ADJACENCY VECTOR ADJNCY WILL BE */
+/*        DESTROYED. */
+/*        --------------------------------------------- */
+
+/*     INPUT PARAMETERS - */
+/*        NEQNS  - NUMBER OF EQUATIONS. */
+/*        (XADJ,ADJNCY) - THE ADJACENCY STRUCTURE. */
+/*        DELTA  - TOLERANCE VALUE FOR MULTIPLE ELIMINATION. */
+/*        MAXINT - MAXIMUM MACHINE REPRESENTABLE (SHORT) INTEGER */
+/*                 (ANY SMALLER ESTIMATE WILL DO) FOR MARKING */
+/*                 NODES. */
+
+/*     OUTPUT PARAMETERS - */
+/*        PERM   - THE MINIMUM DEGREE ORDERING. */
+/*        INVP   - THE INVERSE OF PERM. */
+/*        NOFSUB - AN UPPER BOUND ON THE NUMBER OF NONZERO */
+/*                 SUBSCRIPTS FOR THE COMPRESSED STORAGE SCHEME. */
+
+/*     WORKING PARAMETERS - */
+/*        DHEAD  - VECTOR FOR HEAD OF DEGREE LISTS. */
+/*        INVP   - USED TEMPORARILY FOR DEGREE FORWARD LINK. */
+/*        PERM   - USED TEMPORARILY FOR DEGREE BACKWARD LINK. */
+/*        QSIZE  - VECTOR FOR SIZE OF SUPERNODES. */
+/*        LLIST  - VECTOR FOR TEMPORARY LINKED LISTS. */
+/*        MARKER - A TEMPORARY MARKER VECTOR. */
+
+/*     PROGRAM SUBROUTINES - */
+/*        MMDELM, MMDINT, MMDNUM, MMDUPD. */
+
+/* *************************************************************** */
+
+/* Subroutine */ int genmmd_(int *neqns, int *xadj, shortint *adjncy, 
+	shortint *invp, shortint *perm, int *delta, shortint *dhead, 
+	shortint *qsize, shortint *llist, shortint *marker, int *maxint, 
+	int *nofsub)
+{
+    /* System generated locals */
+    int i__1;
+
+    /* Local variables */
+    static int mdeg, ehead, i, mdlmt, mdnode;
+    extern /* Subroutine */ int mmdelm_(int *, int *, shortint *, 
+	    shortint *, shortint *, shortint *, shortint *, shortint *, 
+	    shortint *, int *, int *), mmdupd_(int *, int *, 
+	    int *, shortint *, int *, int *, shortint *, shortint 
+	    *, shortint *, shortint *, shortint *, shortint *, int *, 
+	    int *), mmdint_(int *, int *, shortint *, shortint *, 
+	    shortint *, shortint *, shortint *, shortint *, shortint *), 
+	    mmdnum_(int *, shortint *, shortint *, shortint *);
+    static int nextmd, tag, num;
+
+
+/* *************************************************************** */
+
+
+/* *************************************************************** */
+
+    /* Parameter adjustments */
+    --marker;
+    --llist;
+    --qsize;
+    --dhead;
+    --perm;
+    --invp;
+    --adjncy;
+    --xadj;
+
+    /* Function Body */
+    if (*neqns <= 0) {
+	return 0;
+    }
+
+/*        ------------------------------------------------ */
+/*        INITIALIZATION FOR THE MINIMUM DEGREE ALGORITHM. */
+/*        ------------------------------------------------ */
+    *nofsub = 0;
+    mmdint_(neqns, &xadj[1], &adjncy[1], &dhead[1], &invp[1], &perm[1], &
+	    qsize[1], &llist[1], &marker[1]);
+
+/*        ---------------------------------------------- */
+/*        NUM COUNTS THE NUMBER OF ORDERED NODES PLUS 1. */
+/*        ---------------------------------------------- */
+    num = 1;
+
+/*        ----------------------------- */
+/*        ELIMINATE ALL ISOLATED NODES. */
+/*        ----------------------------- */
+    nextmd = dhead[1];
+L100:
+    if (nextmd <= 0) {
+	goto L200;
+    }
+    mdnode = nextmd;
+    nextmd = invp[mdnode];
+    marker[mdnode] = *maxint;
+    invp[mdnode] = -num;
+    ++num;
+    goto L100;
+
+L200:
+/*        ---------------------------------------- */
+/*        SEARCH FOR NODE OF THE MINIMUM DEGREE. */
+/*        MDEG IS THE CURRENT MINIMUM DEGREE; */
+/*        TAG IS USED TO FACILITATE MARKING NODES. */
+/*        ---------------------------------------- */
+    if (num > *neqns) {
+	goto L1000;
+    }
+    tag = 1;
+    dhead[1] = 0;
+    mdeg = 2;
+L300:
+    if (dhead[mdeg] > 0) {
+	goto L400;
+    }
+    ++mdeg;
+    goto L300;
+L400:
+/*            ------------------------------------------------- */
+/*            USE VALUE OF DELTA TO SET UP MDLMT, WHICH GOVERNS */
+/*            WHEN A DEGREE UPDATE IS TO BE PERFORMED. */
+/*            ------------------------------------------------- */
+    mdlmt = mdeg + *delta;
+    ehead = 0;
+
+L500:
+    mdnode = dhead[mdeg];
+    if (mdnode > 0) {
+	goto L600;
+    }
+    ++mdeg;
+    if (mdeg > mdlmt) {
+	goto L900;
+    }
+    goto L500;
+L600:
+/*                ---------------------------------------- */
+/*                REMOVE MDNODE FROM THE DEGREE STRUCTURE. */
+/*                ---------------------------------------- */
+    nextmd = invp[mdnode];
+    dhead[mdeg] = nextmd;
+    if (nextmd > 0) {
+	perm[nextmd] = -mdeg;
+    }
+    invp[mdnode] = -num;
+    *nofsub = *nofsub + mdeg + qsize[mdnode] - 2;
+    if (num + qsize[mdnode] > *neqns) {
+	goto L1000;
+    }
+/*                ---------------------------------------------- */
+/*                ELIMINATE MDNODE AND PERFORM QUOTIENT GRAPH */
+/*                TRANSFORMATION.  RESET TAG VALUE IF NECESSARY. */
+/*                ---------------------------------------------- */
+    ++tag;
+    if (tag < *maxint) {
+	goto L800;
+    }
+    tag = 1;
+    i__1 = *neqns;
+    for (i = 1; i <= i__1; ++i) {
+	if (marker[i] < *maxint) {
+	    marker[i] = 0;
+	}
+/* L700: */
+    }
+L800:
+    mmdelm_(&mdnode, &xadj[1], &adjncy[1], &dhead[1], &invp[1], &perm[1], &
+	    qsize[1], &llist[1], &marker[1], maxint, &tag);
+    num += qsize[mdnode];
+    llist[mdnode] = ehead;
+    ehead = mdnode;
+    if (*delta >= 0) {
+	goto L500;
+    }
+L900:
+/*            ------------------------------------------- */
+/*            UPDATE DEGREES OF THE NODES INVOLVED IN THE */
+/*            MINIMUM DEGREE NODES ELIMINATION. */
+/*            ------------------------------------------- */
+    if (num > *neqns) {
+	goto L1000;
+    }
+    mmdupd_(&ehead, neqns, &xadj[1], &adjncy[1], delta, &mdeg, &dhead[1], &
+	    invp[1], &perm[1], &qsize[1], &llist[1], &marker[1], maxint, &tag)
+	    ;
+    goto L300;
+
+L1000:
+    mmdnum_(neqns, &perm[1], &invp[1], &qsize[1]);
+    return 0;
+
+} /* genmmd_ */
+
+/* *************************************************************** */
+/* *************************************************************** */
+/* ***     MMDINT ..... MULT MINIMUM DEGREE INITIALIZATION     *** */
+/* *************************************************************** */
+/* *************************************************************** */
+
+/*     AUTHOR - JOSEPH W.H. LIU */
+/*              DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
+
+/*     PURPOSE - THIS ROUTINE PERFORMS INITIALIZATION FOR THE */
+/*        MULTIPLE ELIMINATION VERSION OF THE MINIMUM DEGREE */
+/*        ALGORITHM. */
+
+/*     INPUT PARAMETERS - */
+/*        NEQNS  - NUMBER OF EQUATIONS. */
+/*        (XADJ,ADJNCY) - ADJACENCY STRUCTURE. */
+
+/*     OUTPUT PARAMETERS - */
+/*        (DHEAD,DFORW,DBAKW) - DEGREE DOUBLY LINKED STRUCTURE. */
+/*        QSIZE  - SIZE OF SUPERNODE (INITIALIZED TO ONE). */
+/*        LLIST  - LINKED LIST. */
+/*        MARKER - MARKER VECTOR. */
+
+/* *************************************************************** */
+
+/* Subroutine */ int mmdint_(int *neqns, int *xadj, shortint *adjncy, 
+	shortint *dhead, shortint *dforw, shortint *dbakw, shortint *qsize, 
+	shortint *llist, shortint *marker)
+{
+    /* System generated locals */
+    int i__1;
+
+    /* Local variables */
+    static int ndeg, node, fnode;
+
+
+/* *************************************************************** */
+
+
+/* *************************************************************** */
+
+    /* Parameter adjustments */
+    --marker;
+    --llist;
+    --qsize;
+    --dbakw;
+    --dforw;
+    --dhead;
+    --adjncy;
+    --xadj;
+
+    /* Function Body */
+    i__1 = *neqns;
+    for (node = 1; node <= i__1; ++node) {
+	dhead[node] = 0;
+	qsize[node] = 1;
+	marker[node] = 0;
+	llist[node] = 0;
+/* L100: */
+    }
+/*        ------------------------------------------ */
+/*        INITIALIZE THE DEGREE DOUBLY LINKED LISTS. */
+/*        ------------------------------------------ */
+    i__1 = *neqns;
+    for (node = 1; node <= i__1; ++node) {
+	ndeg = xadj[node + 1] - xadj[node] + 1;
+	fnode = dhead[ndeg];
+	dforw[node] = fnode;
+	dhead[ndeg] = node;
+	if (fnode > 0) {
+	    dbakw[fnode] = node;
+	}
+	dbakw[node] = -ndeg;
+/* L200: */
+    }
+    return 0;
+
+} /* mmdint_ */
+
+/* *************************************************************** */
+/* *************************************************************** */
+/* **     MMDELM ..... MULTIPLE MINIMUM DEGREE ELIMINATION     *** */
+/* *************************************************************** */
+/* *************************************************************** */
+
+/*     AUTHOR - JOSEPH W.H. LIU */
+/*              DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
+
+/*     PURPOSE - THIS ROUTINE ELIMINATES THE NODE MDNODE OF */
+/*        MINIMUM DEGREE FROM THE ADJACENCY STRUCTURE, WHICH */
+/*        IS STORED IN THE QUOTIENT GRAPH FORMAT.  IT ALSO */
+/*        TRANSFORMS THE QUOTIENT GRAPH REPRESENTATION OF THE */
+/*        ELIMINATION GRAPH. */
+
+/*     INPUT PARAMETERS - */
+/*        MDNODE - NODE OF MINIMUM DEGREE. */
+/*        MAXINT - ESTIMATE OF MAXIMUM REPRESENTABLE (SHORT) */
+/*                 INT. */
+/*        TAG    - TAG VALUE. */
+
+/*     UPDATED PARAMETERS - */
+/*        (XADJ,ADJNCY) - UPDATED ADJACENCY STRUCTURE. */
+/*        (DHEAD,DFORW,DBAKW) - DEGREE DOUBLY LINKED STRUCTURE. */
+/*        QSIZE  - SIZE OF SUPERNODE. */
+/*        MARKER - MARKER VECTOR. */
+/*        LLIST  - TEMPORARY LINKED LIST OF ELIMINATED NABORS. */
+
+/* *************************************************************** */
+
+/* Subroutine */ int mmdelm_(int *mdnode, int *xadj, shortint *adjncy,
+	 shortint *dhead, shortint *dforw, shortint *dbakw, shortint *qsize, 
+	shortint *llist, shortint *marker, int *maxint, int *tag)
+{
+    /* System generated locals */
+    int i__1, i__2;
+
+    /* Local variables */
+    static int node, link, rloc, rlmt, i, j, nabor, rnode, elmnt, xqnbr, 
+	    istop, jstop, istrt, jstrt, nxnode, pvnode, nqnbrs, npv;
+
+
+/* *************************************************************** */
+
+
+/* *************************************************************** */
+
+/*        ----------------------------------------------- */
+/*        FIND REACHABLE SET AND PLACE IN DATA STRUCTURE. */
+/*        ----------------------------------------------- */
+    /* Parameter adjustments */
+    --marker;
+    --llist;
+    --qsize;
+    --dbakw;
+    --dforw;
+    --dhead;
+    --adjncy;
+    --xadj;
+
+    /* Function Body */
+    marker[*mdnode] = *tag;
+    istrt = xadj[*mdnode];
+    istop = xadj[*mdnode + 1] - 1;
+/*        ------------------------------------------------------- */
+/*        ELMNT POINTS TO THE BEGINNING OF THE LIST OF ELIMINATED */
+/*        NABORS OF MDNODE, AND RLOC GIVES THE STORAGE LOCATION */
+/*        FOR THE NEXT REACHABLE NODE. */
+/*        ------------------------------------------------------- */
+    elmnt = 0;
+    rloc = istrt;
+    rlmt = istop;
+    i__1 = istop;
+    for (i = istrt; i <= i__1; ++i) {
+	nabor = adjncy[i];
+	if (nabor == 0) {
+	    goto L300;
+	}
+	if (marker[nabor] >= *tag) {
+	    goto L200;
+	}
+	marker[nabor] = *tag;
+	if (dforw[nabor] < 0) {
+	    goto L100;
+	}
+	adjncy[rloc] = nabor;
+	++rloc;
+	goto L200;
+L100:
+	llist[nabor] = elmnt;
+	elmnt = nabor;
+L200:
+	;
+    }
+L300:
+/*            ----------------------------------------------------- */
+/*            MERGE WITH REACHABLE NODES FROM GENERALIZED ELEMENTS. */
+/*            ----------------------------------------------------- */
+    if (elmnt <= 0) {
+	goto L1000;
+    }
+    adjncy[rlmt] = -elmnt;
+    link = elmnt;
+L400:
+    jstrt = xadj[link];
+    jstop = xadj[link + 1] - 1;
+    i__1 = jstop;
+    for (j = jstrt; j <= i__1; ++j) {
+	node = adjncy[j];
+	link = -node;
+	if (node < 0) {
+	    goto L400;
+	} else if (node == 0) {
+	    goto L900;
+	} else {
+	    goto L500;
+	}
+L500:
+	if (marker[node] >= *tag || dforw[node] < 0) {
+	    goto L800;
+	}
+	marker[node] = *tag;
+/*                            --------------------------------- */
+/*                            USE STORAGE FROM ELIMINATED NODES */
+/*                            IF NECESSARY. */
+/*                            --------------------------------- */
+L600:
+	if (rloc < rlmt) {
+	    goto L700;
+	}
+	link = -adjncy[rlmt];
+	rloc = xadj[link];
+	rlmt = xadj[link + 1] - 1;
+	goto L600;
+L700:
+	adjncy[rloc] = node;
+	++rloc;
+L800:
+	;
+    }
+L900:
+    elmnt = llist[elmnt];
+    goto L300;
+L1000:
+    if (rloc <= rlmt) {
+	adjncy[rloc] = 0;
+    }
+/*        -------------------------------------------------------- */
+/*        FOR EACH NODE IN THE REACHABLE SET, DO THE FOLLOWING ... */
+/*        -------------------------------------------------------- */
+    link = *mdnode;
+L1100:
+    istrt = xadj[link];
+    istop = xadj[link + 1] - 1;
+    i__1 = istop;
+    for (i = istrt; i <= i__1; ++i) {
+	rnode = adjncy[i];
+	link = -rnode;
+	if (rnode < 0) {
+	    goto L1100;
+	} else if (rnode == 0) {
+	    goto L1800;
+	} else {
+	    goto L1200;
+	}
+L1200:
+/*                -------------------------------------------- */
+/*                IF RNODE IS IN THE DEGREE LIST STRUCTURE ... */
+/*                -------------------------------------------- */
+	pvnode = dbakw[rnode];
+	if (pvnode == 0 || pvnode == -(*maxint)) {
+	    goto L1300;
+	}
+/*                    ------------------------------------- */
+/*                    THEN REMOVE RNODE FROM THE STRUCTURE. */
+/*                    ------------------------------------- */
+	nxnode = dforw[rnode];
+	if (nxnode > 0) {
+	    dbakw[nxnode] = pvnode;
+	}
+	if (pvnode > 0) {
+	    dforw[pvnode] = nxnode;
+	}
+	npv = -pvnode;
+	if (pvnode < 0) {
+	    dhead[npv] = nxnode;
+	}
+L1300:
+/*                ---------------------------------------- */
+/*                PURGE INACTIVE QUOTIENT NABORS OF RNODE. */
+/*                ---------------------------------------- */
+	jstrt = xadj[rnode];
+	jstop = xadj[rnode + 1] - 1;
+	xqnbr = jstrt;
+	i__2 = jstop;
+	for (j = jstrt; j <= i__2; ++j) {
+	    nabor = adjncy[j];
+	    if (nabor == 0) {
+		goto L1500;
+	    }
+	    if (marker[nabor] >= *tag) {
+		goto L1400;
+	    }
+	    adjncy[xqnbr] = nabor;
+	    ++xqnbr;
+L1400:
+	    ;
+	}
+L1500:
+/*                ---------------------------------------- */
+/*                IF NO ACTIVE NABOR AFTER THE PURGING ... */
+/*                ---------------------------------------- */
+	nqnbrs = xqnbr - jstrt;
+	if (nqnbrs > 0) {
+	    goto L1600;
+	}
+/*                    ----------------------------- */
+/*                    THEN MERGE RNODE WITH MDNODE. */
+/*                    ----------------------------- */
+	qsize[*mdnode] += qsize[rnode];
+	qsize[rnode] = 0;
+	marker[rnode] = *maxint;
+	dforw[rnode] = -(*mdnode);
+	dbakw[rnode] = -(*maxint);
+	goto L1700;
+L1600:
+/*                -------------------------------------- */
+/*                ELSE FLAG RNODE FOR DEGREE UPDATE, AND */
+/*                ADD MDNODE AS A NABOR OF RNODE. */
+/*                -------------------------------------- */
+	dforw[rnode] = nqnbrs + 1;
+	dbakw[rnode] = 0;
+	adjncy[xqnbr] = *mdnode;
+	++xqnbr;
+	if (xqnbr <= jstop) {
+	    adjncy[xqnbr] = 0;
+	}
+
+L1700:
+	;
+    }
+L1800:
+    return 0;
+
+} /* mmdelm_ */
+
+/* *************************************************************** */
+/* *************************************************************** */
+/* *****     MMDUPD ..... MULTIPLE MINIMUM DEGREE UPDATE     ***** */
+/* *************************************************************** */
+/* *************************************************************** */
+
+/*     AUTHOR - JOSEPH W.H. LIU */
+/*              DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
+
+/*     PURPOSE - THIS ROUTINE UPDATES THE DEGREES OF NODES */
+/*        AFTER A MULTIPLE ELIMINATION STEP. */
+
+/*     INPUT PARAMETERS - */
+/*        EHEAD  - THE BEGINNING OF THE LIST OF ELIMINATED */
+/*                 NODES (I.E., NEWLY FORMED ELEMENTS). */
+/*        NEQNS  - NUMBER OF EQUATIONS. */
+/*        (XADJ,ADJNCY) - ADJACENCY STRUCTURE. */
+/*        DELTA  - TOLERANCE VALUE FOR MULTIPLE ELIMINATION. */
+/*        MAXINT - MAXIMUM MACHINE REPRESENTABLE (SHORT) */
+/*                 INTEGER. */
+
+/*     UPDATED PARAMETERS - */
+/*        MDEG   - NEW MINIMUM DEGREE AFTER DEGREE UPDATE. */
+/*        (DHEAD,DFORW,DBAKW) - DEGREE DOUBLY LINKED STRUCTURE. */
+/*        QSIZE  - SIZE OF SUPERNODE. */
+/*        LLIST  - WORKING LINKED LIST. */
+/*        MARKER - MARKER VECTOR FOR DEGREE UPDATE. */
+/*        TAG    - TAG VALUE. */
+
+/* *************************************************************** */
+
+/* Subroutine */ int mmdupd_(int *ehead, int *neqns, int *xadj, 
+	shortint *adjncy, int *delta, int *mdeg, shortint *dhead, 
+	shortint *dforw, shortint *dbakw, shortint *qsize, shortint *llist, 
+	shortint *marker, int *maxint, int *tag)
+{
+    /* System generated locals */
+    int i__1, i__2;
+
+    /* Local variables */
+    static int node, mtag, link, mdeg0, i, j, enode, fnode, nabor, elmnt, 
+	    istop, jstop, q2head, istrt, jstrt, qxhead, iq2, deg, deg0;
+
+
+/* *************************************************************** */
+
+
+/* *************************************************************** */
+
+    /* Parameter adjustments */
+    --marker;
+    --llist;
+    --qsize;
+    --dbakw;
+    --dforw;
+    --dhead;
+    --adjncy;
+    --xadj;
+
+    /* Function Body */
+    mdeg0 = *mdeg + *delta;
+    elmnt = *ehead;
+L100:
+/*            ------------------------------------------------------- */
+/*            FOR EACH OF THE NEWLY FORMED ELEMENT, DO THE FOLLOWING. */
+/*            (RESET TAG VALUE IF NECESSARY.) */
+/*            ------------------------------------------------------- */
+    if (elmnt <= 0) {
+	return 0;
+    }
+    mtag = *tag + mdeg0;
+    if (mtag < *maxint) {
+	goto L300;
+    }
+    *tag = 1;
+    i__1 = *neqns;
+    for (i = 1; i <= i__1; ++i) {
+	if (marker[i] < *maxint) {
+	    marker[i] = 0;
+	}
+/* L200: */
+    }
+    mtag = *tag + mdeg0;
+L300:
+/*            --------------------------------------------- */
+/*            CREATE TWO LINKED LISTS FROM NODES ASSOCIATED */
+/*            WITH ELMNT: ONE WITH TWO NABORS (Q2HEAD) IN */
+/*            ADJACENCY STRUCTURE, AND THE OTHER WITH MORE */
+/*            THAN TWO NABORS (QXHEAD).  ALSO COMPUTE DEG0, */
+/*            NUMBER OF NODES IN THIS ELEMENT. */
+/*            --------------------------------------------- */
+    q2head = 0;
+    qxhead = 0;
+    deg0 = 0;
+    link = elmnt;
+L400:
+    istrt = xadj[link];
+    istop = xadj[link + 1] - 1;
+    i__1 = istop;
+    for (i = istrt; i <= i__1; ++i) {
+	enode = adjncy[i];
+	link = -enode;
+	if (enode < 0) {
+	    goto L400;
+	} else if (enode == 0) {
+	    goto L800;
+	} else {
+	    goto L500;
+	}
+
+L500:
+	if (qsize[enode] == 0) {
+	    goto L700;
+	}
+	deg0 += qsize[enode];
+	marker[enode] = mtag;
+/*                        ---------------------------------- */
+/*                        IF ENODE REQUIRES A DEGREE UPDATE, */
+/*                        THEN DO THE FOLLOWING. */
+/*                        ---------------------------------- */
+	if (dbakw[enode] != 0) {
+	    goto L700;
+	}
+/*                            --------------------------------------- 
+*/
+/*                            PLACE EITHER IN QXHEAD OR Q2HEAD LISTS. 
+*/
+/*                            --------------------------------------- 
+*/
+	if (dforw[enode] == 2) {
+	    goto L600;
+	}
+	llist[enode] = qxhead;
+	qxhead = enode;
+	goto L700;
+L600:
+	llist[enode] = q2head;
+	q2head = enode;
+L700:
+	;
+    }
+L800:
+/*            -------------------------------------------- */
+/*            FOR EACH ENODE IN Q2 LIST, DO THE FOLLOWING. */
+/*            -------------------------------------------- */
+    enode = q2head;
+    iq2 = 1;
+L900:
+    if (enode <= 0) {
+	goto L1500;
+    }
+    if (dbakw[enode] != 0) {
+	goto L2200;
+    }
+    ++(*tag);
+    deg = deg0;
+/*                    ------------------------------------------ */
+/*                    IDENTIFY THE OTHER ADJACENT ELEMENT NABOR. */
+/*                    ------------------------------------------ */
+    istrt = xadj[enode];
+    nabor = adjncy[istrt];
+    if (nabor == elmnt) {
+	nabor = adjncy[istrt + 1];
+    }
+/*                    ------------------------------------------------ */
+/*                    IF NABOR IS UNELIMINATED, INCREASE DEGREE COUNT. */
+/*                    ------------------------------------------------ */
+    link = nabor;
+    if (dforw[nabor] < 0) {
+	goto L1000;
+    }
+    deg += qsize[nabor];
+    goto L2100;
+L1000:
+/*                        -------------------------------------------- */
+/*                        OTHERWISE, FOR EACH NODE IN THE 2ND ELEMENT, */
+/*                        DO THE FOLLOWING. */
+/*                        -------------------------------------------- */
+    istrt = xadj[link];
+    istop = xadj[link + 1] - 1;
+    i__1 = istop;
+    for (i = istrt; i <= i__1; ++i) {
+	node = adjncy[i];
+	link = -node;
+	if (node == enode) {
+	    goto L1400;
+	}
+	if (node < 0) {
+	    goto L1000;
+	} else if (node == 0) {
+	    goto L2100;
+	} else {
+	    goto L1100;
+	}
+
+L1100:
+	if (qsize[node] == 0) {
+	    goto L1400;
+	}
+	if (marker[node] >= *tag) {
+	    goto L1200;
+	}
+/*                                -----------------------------------
+-- */
+/*                                CASE WHEN NODE IS NOT YET CONSIDERED
+. */
+/*                                -----------------------------------
+-- */
+	marker[node] = *tag;
+	deg += qsize[node];
+	goto L1400;
+L1200:
+/*                            ----------------------------------------
+ */
+/*                            CASE WHEN NODE IS INDISTINGUISHABLE FROM
+ */
+/*                            ENODE.  MERGE THEM INTO A NEW SUPERNODE.
+ */
+/*                            ----------------------------------------
+ */
+	if (dbakw[node] != 0) {
+	    goto L1400;
+	}
+	if (dforw[node] != 2) {
+	    goto L1300;
+	}
+	qsize[enode] += qsize[node];
+	qsize[node] = 0;
+	marker[node] = *maxint;
+	dforw[node] = -enode;
+	dbakw[node] = -(*maxint);
+	goto L1400;
+L1300:
+/*                            -------------------------------------- 
+*/
+/*                            CASE WHEN NODE IS OUTMATCHED BY ENODE. 
+*/
+/*                            -------------------------------------- 
+*/
+	if (dbakw[node] == 0) {
+	    dbakw[node] = -(*maxint);
+	}
+L1400:
+	;
+    }
+    goto L2100;
+L1500:
+/*                ------------------------------------------------ */
+/*                FOR EACH ENODE IN THE QX LIST, DO THE FOLLOWING. */
+/*                ------------------------------------------------ */
+    enode = qxhead;
+    iq2 = 0;
+L1600:
+    if (enode <= 0) {
+	goto L2300;
+    }
+    if (dbakw[enode] != 0) {
+	goto L2200;
+    }
+    ++(*tag);
+    deg = deg0;
+/*                        --------------------------------- */
+/*                        FOR EACH UNMARKED NABOR OF ENODE, */
+/*                        DO THE FOLLOWING. */
+/*                        --------------------------------- */
+    istrt = xadj[enode];
+    istop = xadj[enode + 1] - 1;
+    i__1 = istop;
+    for (i = istrt; i <= i__1; ++i) {
+	nabor = adjncy[i];
+	if (nabor == 0) {
+	    goto L2100;
+	}
+	if (marker[nabor] >= *tag) {
+	    goto L2000;
+	}
+	marker[nabor] = *tag;
+	link = nabor;
+/*                                ------------------------------ */
+/*                                IF UNELIMINATED, INCLUDE IT IN */
+/*                                DEG COUNT. */
+/*                                ------------------------------ */
+	if (dforw[nabor] < 0) {
+	    goto L1700;
+	}
+	deg += qsize[nabor];
+	goto L2000;
+L1700:
+/*                                    ------------------------------- 
+*/
+/*                                    IF ELIMINATED, INCLUDE UNMARKED 
+*/
+/*                                    NODES IN THIS ELEMENT INTO THE 
+*/
+/*                                    DEGREE COUNT. */
+/*                                    ------------------------------- 
+*/
+	jstrt = xadj[link];
+	jstop = xadj[link + 1] - 1;
+	i__2 = jstop;
+	for (j = jstrt; j <= i__2; ++j) {
+	    node = adjncy[j];
+	    link = -node;
+	    if (node < 0) {
+		goto L1700;
+	    } else if (node == 0) {
+		goto L2000;
+	    } else {
+		goto L1800;
+	    }
+
+L1800:
+	    if (marker[node] >= *tag) {
+		goto L1900;
+	    }
+	    marker[node] = *tag;
+	    deg += qsize[node];
+L1900:
+	    ;
+	}
+L2000:
+	;
+    }
+L2100:
+/*                    ------------------------------------------- */
+/*                    UPDATE EXTERNAL DEGREE OF ENODE IN DEGREE */
+/*                    STRUCTURE, AND MDEG (MIN DEG) IF NECESSARY. */
+/*                    ------------------------------------------- */
+    deg = deg - qsize[enode] + 1;
+    fnode = dhead[deg];
+    dforw[enode] = fnode;
+    dbakw[enode] = -deg;
+    if (fnode > 0) {
+	dbakw[fnode] = enode;
+    }
+    dhead[deg] = enode;
+    if (deg < *mdeg) {
+	*mdeg = deg;
+    }
+L2200:
+/*                    ---------------------------------- */
+/*                    GET NEXT ENODE IN CURRENT ELEMENT. */
+/*                    ---------------------------------- */
+    enode = llist[enode];
+    if (iq2 == 1) {
+	goto L900;
+    }
+    goto L1600;
+L2300:
+/*            ----------------------------- */
+/*            GET NEXT ELEMENT IN THE LIST. */
+/*            ----------------------------- */
+    *tag = mtag;
+    elmnt = llist[elmnt];
+    goto L100;
+
+} /* mmdupd_ */
+
+/* *************************************************************** */
+/* *************************************************************** */
+/* *****     MMDNUM ..... MULTI MINIMUM DEGREE NUMBERING     ***** */
+/* *************************************************************** */
+/* *************************************************************** */
+
+/*     AUTHOR - JOSEPH W.H. LIU */
+/*              DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */
+
+/*     PURPOSE - THIS ROUTINE PERFORMS THE FINAL STEP IN */
+/*        PRODUCING THE PERMUTATION AND INVERSE PERMUTATION */
+/*        VECTORS IN THE MULTIPLE ELIMINATION VERSION OF THE */
+/*        MINIMUM DEGREE ORDERING ALGORITHM. */
+
+/*     INPUT PARAMETERS - */
+/*        NEQNS  - NUMBER OF EQUATIONS. */
+/*        QSIZE  - SIZE OF SUPERNODES AT ELIMINATION. */
+
+/*     UPDATED PARAMETERS - */
+/*        INVP   - INVERSE PERMUTATION VECTOR.  ON INPUT, */
+/*                 IF QSIZE(NODE)=0, THEN NODE HAS BEEN MERGED */
+/*                 INTO THE NODE -INVP(NODE); OTHERWISE, */
+/*                 -INVP(NODE) IS ITS INVERSE LABELLING. */
+
+/*     OUTPUT PARAMETERS - */
+/*        PERM   - THE PERMUTATION VECTOR. */
+
+/* *************************************************************** */
+
+/* Subroutine */ int mmdnum_(int *neqns, shortint *perm, shortint *invp, 
+	shortint *qsize)
+{
+    /* System generated locals */
+    int i__1;
+
+    /* Local variables */
+    static int node, root, nextf, father, nqsize, num;
+
+
+/* *************************************************************** */
+
+
+/* *************************************************************** */
+
+    /* Parameter adjustments */
+    --qsize;
+    --invp;
+    --perm;
+
+    /* Function Body */
+    i__1 = *neqns;
+    for (node = 1; node <= i__1; ++node) {
+	nqsize = qsize[node];
+	if (nqsize <= 0) {
+	    perm[node] = invp[node];
+	}
+	if (nqsize > 0) {
+	    perm[node] = -invp[node];
+	}
+/* L100: */
+    }
+/*        ------------------------------------------------------ */
+/*        FOR EACH NODE WHICH HAS BEEN MERGED, DO THE FOLLOWING. */
+/*        ------------------------------------------------------ */
+    i__1 = *neqns;
+    for (node = 1; node <= i__1; ++node) {
+	if (perm[node] > 0) {
+	    goto L500;
+	}
+/*                ----------------------------------------- */
+/*                TRACE THE MERGED TREE UNTIL ONE WHICH HAS */
+/*                NOT BEEN MERGED, CALL IT ROOT. */
+/*                ----------------------------------------- */
+	father = node;
+L200:
+	if (perm[father] > 0) {
+	    goto L300;
+	}
+	father = -perm[father];
+	goto L200;
+L300:
+/*                ----------------------- */
+/*                NUMBER NODE AFTER ROOT. */
+/*                ----------------------- */
+	root = father;
+	num = perm[root] + 1;
+	invp[node] = -num;
+	perm[root] = num;
+/*                ------------------------ */
+/*                SHORTEN THE MERGED TREE. */
+/*                ------------------------ */
+	father = node;
+L400:
+	nextf = -perm[father];
+	if (nextf <= 0) {
+	    goto L500;
+	}
+	perm[father] = -root;
+	father = nextf;
+	goto L400;
+L500:
+	;
+    }
+/*        ---------------------- */
+/*        READY TO COMPUTE PERM. */
+/*        ---------------------- */
+    i__1 = *neqns;
+    for (node = 1; node <= i__1; ++node) {
+	num = -invp[node];
+	invp[node] = num;
+	perm[num] = node;
+/* L600: */
+    }
+    return 0;
+
+} /* mmdnum_ */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/relax_snode.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,73 @@
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "util.h"
+
+void
+relax_snode (
+	     const     int n,
+	     int       *et,           /* column elimination tree */
+	     const int relax_columns, /* max no of columns allowed in a
+					 relaxed snode */
+	     int       *descendants,  /* no of descendants of each node
+					 in the etree */
+	     int       *relax_end     /* last column in a supernode */
+	     )
+{
+/*
+ * Purpose
+ * =======
+ *    relax_snode() - Identify the initial relaxed supernodes, assuming that 
+ *    the matrix has been reordered according to the postorder of the etree.
+ *
+ */ 
+    register int i, j, parent;
+    register int snode_start;	/* beginning of a snode */
+    
+    ifill (relax_end, n, EMPTY);
+    for (j = 0; j < n; j++) descendants[j] = 0;
+
+    /* Compute the number of descendants of each node in the etree */
+    for (j = 0; j < n; j++) {
+	parent = et[j];
+	if ( parent != n )  /* not the dummy root */
+	    descendants[parent] += descendants[j] + 1;
+    }
+
+    /* Identify the relaxed supernodes by postorder traversal of the etree. */
+    for (j = 0; j < n; ) { 
+     	parent = et[j];
+        snode_start = j;
+ 	while ( parent != n && descendants[parent] < relax_columns ) {
+	    j = parent;
+	    parent = et[j];
+	}
+	/* Found a supernode with j being the last column. */
+	relax_end[snode_start] = j;		/* Last column is recorded */
+	j++;
+	/* Search for a new leaf */
+	while ( descendants[j] != 0 && j < n ) j++;
+    }
+
+    /*printf("No of relaxed snodes: %d; relaxed columns: %d\n", 
+		nsuper, no_relaxed_col); */
+}
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/sp_coletree.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,265 @@
+
+/*  Elimination tree computation and layout routines */
+
+#include <stdio.h>
+#include <malloc.h>
+#include <stdlib.h>
+#include "util.h"
+
+/* 
+ *  Implementation of disjoint set union routines.
+ *  Elements are integers in 0..n-1, and the 
+ *  names of the sets themselves are of type int.
+ *  
+ *  Calls are:
+ *  initialize_disjoint_sets (n) initial call.
+ *  s = make_set (i)             returns a set containing only i.
+ *  s = link (t, u)		 returns s = t union u, destroying t and u.
+ *  s = find (i)		 return name of set containing i.
+ *  finalize_disjoint_sets 	 final call.
+ *
+ *  This implementation uses path compression but not weighted union.
+ *  See Tarjan's book for details.
+ *  John Gilbert, CMI, 1987.
+ *
+ *  Implemented path-halving by XL 7/5/95.
+ */
+
+static int	*pp;		/* parent array for sets */
+
+static 
+int *mxCallocInt(int n)
+{
+    register int i;
+    int *buf;
+
+    buf = (int *) SUPERLU_MALLOC( n * sizeof(int) );
+    if ( !buf ) {
+         ABORT("SUPERLU_MALLOC fails for buf in mxCallocInt()");
+       }
+    for (i = 0; i < n; i++) buf[i] = 0;
+    return (buf);
+}
+      
+static
+void initialize_disjoint_sets (
+	int n
+	)
+{
+	pp = mxCallocInt(n);
+}
+
+
+static
+int make_set (
+	int i
+	)
+{
+	pp[i] = i;
+	return i;
+}
+
+
+static
+int link (
+	int s,
+	int t
+	)
+{
+	pp[s] = t;
+	return t;
+}
+
+
+/* PATH HALVING */
+static
+int find (int i)
+{
+    register int p, gp;
+    
+    p = pp[i];
+    gp = pp[p];
+    while (gp != p) {
+	pp[i] = gp;
+	i = gp;
+	p = pp[i];
+	gp = pp[p];
+    }
+    return (p);
+}
+
+#if 0
+/* PATH COMPRESSION */
+static
+int find (
+	int i
+	)
+{
+	if (pp[i] != i) 
+		pp[i] = find (pp[i]);
+	return pp[i];
+}
+#endif
+
+static
+void finalize_disjoint_sets (
+	void
+	)
+{
+	SUPERLU_FREE(pp);
+}
+
+
+/*
+ *      Find the elimination tree for A'*A.
+ *      This uses something similar to Liu's algorithm. 
+ *      It runs in time O(nz(A)*log n) and does not form A'*A.
+ *
+ *      Input:
+ *        Sparse matrix A.  Numeric values are ignored, so any
+ *        explicit zeros are treated as nonzero.
+ *      Output:
+ *        Integer array of parents representing the elimination
+ *        tree of the symbolic product A'*A.  Each vertex is a
+ *        column of A, and nc means a root of the elimination forest.
+ *
+ *      John R. Gilbert, Xerox, 10 Dec 1990
+ *      Based on code by JRG dated 1987, 1988, and 1990.
+ */
+
+/*
+ * Nonsymmetric elimination tree
+ */
+int
+sp_coletree(
+	    int *acolst, int *acolend, /* column start and end past 1 */
+	    int *arow,                 /* row indices of A */
+	    int nr, int nc,            /* dimension of A */
+	    int *parent	               /* parent in elim tree */
+	    )
+{
+	int	*root;			/* root of subtee of etree 	*/
+	int     *firstcol;		/* first nonzero col in each row*/
+	int	rset, cset;             
+	int	row, col;
+	int	rroot;
+	int	p;
+
+	root = mxCallocInt (nc);
+	initialize_disjoint_sets (nc);
+
+	/* Compute firstcol[row] = first nonzero column in row */
+
+	firstcol = mxCallocInt (nr);
+	for (row = 0; row < nr; firstcol[row++] = nc);
+	for (col = 0; col < nc; col++) 
+		for (p = acolst[col]; p < acolend[col]; p++) {
+			row = arow[p];
+			firstcol[row] = MIN(firstcol[row], col);
+		}
+
+	/* Compute etree by Liu's algorithm for symmetric matrices,
+           except use (firstcol[r],c) in place of an edge (r,c) of A.
+	   Thus each row clique in A'*A is replaced by a star
+	   centered at its first vertex, which has the same fill. */
+
+	for (col = 0; col < nc; col++) {
+		cset = make_set (col);
+		root[cset] = col;
+		parent[col] = nc; /* Matlab */
+		for (p = acolst[col]; p < acolend[col]; p++) {
+			row = firstcol[arow[p]];
+			if (row >= col) continue;
+			rset = find (row);
+			rroot = root[rset];
+			if (rroot != col) {
+				parent[rroot] = col;
+				cset = link (cset, rset);
+				root[cset] = col;
+			}
+		}
+	}
+
+	SUPERLU_FREE (root);
+	SUPERLU_FREE (firstcol);
+	finalize_disjoint_sets ();
+	return 0;
+}
+
+/*
+ *  q = TreePostorder (n, p);
+ *
+ *	Postorder a tree.
+ *	Input:
+ *	  p is a vector of parent pointers for a forest whose
+ *        vertices are the integers 0 to n-1; p[root]==n.
+ *	Output:
+ *	  q is a vector indexed by 0..n-1 such that q[i] is the
+ *	  i-th vertex in a postorder numbering of the tree.
+ *
+ *        ( 2/7/95 modified by X.Li:
+ *          q is a vector indexed by 0:n-1 such that vertex i is the
+ *          q[i]-th vertex in a postorder numbering of the tree.
+ *          That is, this is the inverse of the previous q. )
+ *
+ *	In the child structure, lower-numbered children are represented
+ *	first, so that a tree which is already numbered in postorder
+ *	will not have its order changed.
+ *    
+ *  Written by John Gilbert, Xerox, 10 Dec 1990.
+ *  Based on code written by John Gilbert at CMI in 1987.
+ */
+
+static int	*first_kid, *next_kid;	/* Linked list of children.	*/
+static int	*post, postnum;
+
+static
+/*
+ * Depth-first search from vertex v.
+ */
+void etdfs (
+	int	v
+	)
+{
+	int	w;
+
+	for (w = first_kid[v]; w != -1; w = next_kid[w]) {
+		etdfs (w);
+	}
+	/* post[postnum++] = v; in Matlab */
+	post[v] = postnum++;    /* Modified by X.Li on 2/14/95 */
+}
+
+
+/*
+ * Post order a tree
+ */
+int *TreePostorder(
+	int n,
+	int *parent
+)
+{
+	int	v, dad;
+
+	/* Allocate storage for working arrays and results	*/
+	first_kid = 	mxCallocInt (n+1);
+	next_kid  = 	mxCallocInt (n+1);
+	post	  = 	mxCallocInt (n+1);
+
+	/* Set up structure describing children */
+	for (v = 0; v <= n; first_kid[v++] = -1);
+	for (v = n-1; v >= 0; v--) {
+		dad = parent[v];
+		next_kid[v] = first_kid[dad];
+		first_kid[dad] = v;
+	}
+
+	/* Depth-first search from dummy root vertex #n */
+	postnum = 0;
+	etdfs (n);
+
+	SUPERLU_FREE (first_kid);
+	SUPERLU_FREE (next_kid);
+	return post;
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/sp_ienv.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,61 @@
+/*
+ * File name:		sp_ienv.c
+ * History:             Modified from lapack routine ILAENV
+ */
+int
+sp_ienv(int ispec)
+{
+/*
+    Purpose   
+    =======   
+
+    sp_ienv() is inquired to choose machine-dependent parameters for the
+    local environment. See ISPEC for a description of the parameters.   
+
+    This version provides a set of parameters which should give good,   
+    but not optimal, performance on many of the currently available   
+    computers.  Users are encouraged to modify this subroutine to set   
+    the tuning parameters for their particular machine using the option   
+    and problem size information in the arguments.   
+
+    Arguments   
+    =========   
+
+    ISPEC   (input) int
+            Specifies the parameter to be returned as the value of SP_IENV.   
+            = 1: the panel size w; a panel consists of w consecutive
+	         columns of matrix A in the process of Gaussian elimination.
+		 The best value depends on machine's cache characters.
+            = 2: the relaxation parameter relax; if the number of
+	         nodes (columns) in a subtree of the elimination tree is less
+		 than relax, this subtree is considered as one supernode,
+		 regardless of the their row structures.
+            = 3: the maximum size for a supernode;
+	    = 4: the minimum row dimension for 2-D blocking to be used;
+	    = 5: the minimum column dimension for 2-D blocking to be used;
+	    = 6: the estimated fills factor for L and U, compared with A;
+	    
+   (SP_IENV) (output) int
+            >= 0: the value of the parameter specified by ISPEC   
+            < 0:  if SP_IENV = -k, the k-th argument had an illegal value. 
+  
+    ===================================================================== 
+*/
+    int i;
+
+    switch (ispec) {
+	case 1: return (10);
+	case 2: return (5);
+	case 3: return (100);
+	case 4: return (200);
+	case 5: return (40);
+        case 6: return (20);
+    }
+
+    /* Invalid value for ISPEC */
+    i = 1;
+    xerbla_("sp_ienv", &i);
+    return 0;
+
+} /* sp_ienv_ */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/sp_preorder.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,161 @@
+#include "supermatrix.h"
+#include "util.h"
+
+void
+sp_preorder(char *refact,  SuperMatrix *A, int *perm_c, 
+	    int *etree, SuperMatrix *AC)
+{
+/*
+ * Purpose
+ * =======
+ *
+ * sp_preorder() permutes the columns of the original matrix. It performs
+ * the following steps:
+ *
+ *    1. Apply column permutation perm_c[] to A's column pointers to form AC;
+ *
+ *    2. If refact = 'N', then
+ *       (1) Compute column elimination tree etree[] of AC'AC;
+ *       (2) Post order etree[] to get a postordered elimination tree etree[],
+ *           and a postorder permutation post[];
+ *       (3) Apply post[] permutation to columns of AC;
+ *       (4) Overwrite perm_c[] with the product perm_c * post.
+ *
+ * Arguments
+ * =========
+ *
+ * refact (input) char *
+ *         Specifies whether or not the elimination tree will be re-used.
+ *         = 'N': first time factor A, etree is computed and output.
+ *         = 'Y': re-factor A, etree is input, unchanged on exit.
+ *
+ * A       (input) SuperMatrix*
+ *         Matrix A in A*X=B, of dimension (A->nrow, A->ncol). The number
+ *         of the linear equations is A->nrow. Currently, the type of A can be:
+ *         Stype = NC or NCP; Dtype = _D; Mtype = GE. In the future,
+ *         more general A can be handled.
+ *
+ * perm_c  (input/output) int*
+ *	   Column permutation vector of size A->ncol, which defines the 
+ *         permutation matrix Pc; perm_c[i] = j means column i of A is 
+ *         in position j in A*Pc.
+ *
+ * etree   (input/output) int*
+ *         Elimination tree of Pc'*A'*A*Pc, dimension A->ncol.
+ *         If fact is not 'F' and refact = 'Y', etree is an input argument,
+ *         otherwise it is an output argument.
+ *         Note: etree is a vector of parent pointers for a forest whose
+ *         vertices are the integers 0 to A->ncol-1; etree[root]==A->ncol.
+ *
+ * AC      (output) SuperMatrix*
+ *         The resulting matrix after applied the column permutation
+ *         perm_c[] to matrix A. The type of AC can be:
+ *         Stype = NCP; Dtype = D; Mtype = GE.
+ *
+ */
+
+    NCformat  *Astore;
+    NCPformat *ACstore;
+    int       *iwork, *post;
+    register  int n, i;
+
+    n = A->ncol;
+    iwork = (int*) SUPERLU_MALLOC((n+1)*sizeof(int)); 
+    if ( !iwork ) ABORT("SUPERLU_MALLOC fails for iwork[]");
+    
+    /* Apply column permutation perm_c to A's column pointers so to
+       obtain NCP format in AC = A*Pc.  */
+    AC->Stype       = NCP;
+    AC->Dtype       = A->Dtype;
+    AC->Mtype       = A->Mtype;
+    AC->nrow        = A->nrow;
+    AC->ncol        = A->ncol;
+    Astore          = A->Store;
+    ACstore = AC->Store = (void *) SUPERLU_MALLOC( sizeof(NCPformat) );
+    if ( !ACstore ) ABORT("SUPERLU_MALLOC fails for ACstore");
+    ACstore->nnz    = Astore->nnz;
+    ACstore->nzval  = Astore->nzval;
+    ACstore->rowind = Astore->rowind;
+    ACstore->colbeg = (int*) SUPERLU_MALLOC(n*sizeof(int));
+    if ( !(ACstore->colbeg) ) ABORT("SUPERLU_MALLOC fails for ACstore->colbeg");
+    ACstore->colend = (int*) SUPERLU_MALLOC(n*sizeof(int));
+    if ( !(ACstore->colend) ) ABORT("SUPERLU_MALLOC fails for ACstore->colend");
+
+#ifdef DEBUG
+    print_int_vec("pre_order:", n, perm_c);
+    check_perm("Initial perm_c", n, perm_c);
+#endif      
+
+    for (i = 0; i < n; i++) {
+	ACstore->colbeg[perm_c[i]] = Astore->colptr[i]; 
+	ACstore->colend[perm_c[i]] = Astore->colptr[i+1];
+    }
+	
+    if ( lsame_(refact, "N") ) {
+	
+	/* Compute the column elimination tree */
+	sp_coletree(ACstore->colbeg, ACstore->colend, ACstore->rowind,
+		    A->nrow, A->ncol, etree);
+#ifdef DEBUG	
+	print_int_vec("etree:", n, etree);
+#endif	
+	
+	/* Post order etree */
+	post = (int *) TreePostorder(n, etree);
+	/* for (i = 0; i < n+1; ++i) inv_post[post[i]] = i;
+	   iwork = post; */
+
+#ifdef DEBUG
+	print_int_vec("post:", n+1, post);
+	check_perm("post", n, post);	
+#endif	
+
+	/* Renumber etree in postorder */
+	for (i = 0; i < n; ++i) iwork[post[i]] = post[etree[i]];
+	for (i = 0; i < n; ++i) etree[i] = iwork[i];
+
+#ifdef DEBUG	
+	print_int_vec("postorder etree:", n, etree);
+#endif
+	
+	/* Postmultiply A*Pc by post[] */
+	for (i = 0; i < n; ++i) iwork[post[i]] = ACstore->colbeg[i];
+	for (i = 0; i < n; ++i) ACstore->colbeg[i] = iwork[i];
+	for (i = 0; i < n; ++i) iwork[post[i]] = ACstore->colend[i];
+	for (i = 0; i < n; ++i) ACstore->colend[i] = iwork[i];
+
+	for (i = 0; i < n; ++i)
+	    iwork[i] = post[perm_c[i]];  /* product of perm_c and post */
+	for (i = 0; i < n; ++i) perm_c[i] = iwork[i];
+
+#ifdef DEBUG
+	print_int_vec("Pc*post:", n, perm_c);
+	check_perm("final perm_c", n, perm_c);	
+#endif
+
+	SUPERLU_FREE (post);
+
+    } /* if refact = 'N' */
+
+    SUPERLU_FREE (iwork);
+
+}
+
+check_perm(char *what, int n, int *perm)
+{
+    register int i;
+    int          *marker;
+    marker = (int *) calloc(n, sizeof(int));
+
+    for (i = 0; i < n; ++i) {
+	if ( marker[perm[i]] == 1 || perm[i] >= n ) {
+	    printf("%s: Not a valid PERM[%d] = %d\n", what, i, perm[i]);
+	    ABORT("check_perm");
+	} else {
+	    marker[perm[i]] = 1;
+	}
+    }
+
+    SUPERLU_FREE(marker);
+    return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/superlu_timer.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,45 @@
+/* 
+ * Purpose
+ * ======= 
+ *	Returns the time in seconds used by the process.
+ *
+ * Note: the timer function call is machine dependent. Use conditional
+ *       compilation to choose the appropriate function.
+ *
+ */
+
+
+#ifdef SUN 
+/*
+ * 	It uses the system call gethrtime(3C), which is accurate to 
+ *	nanoseconds. 
+*/
+#include <sys/time.h>
+ 
+double SuperLU_timer_() {
+    return ( (double)gethrtime() / 1e9 );
+}
+
+#else
+
+#include <sys/types.h>
+#include <sys/times.h>
+#include <time.h>
+#include <sys/time.h>
+
+#ifndef CLK_TCK
+#define CLK_TCK 60
+#endif
+
+double SuperLU_timer_()
+{
+    struct tms use;
+    double tmp;
+    times(&use);
+    tmp = use.tms_utime;
+    tmp += use.tms_stime;
+    return (double)(tmp) / CLK_TCK;
+}
+
+#endif
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/supermatrix.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,136 @@
+#ifndef __SUPERLU_SUPERMATRIX /* allow multiple inclusions */
+#define __SUPERLU_SUPERMATRIX
+
+/********************************************
+ * The matrix types are defined as follows. *
+ ********************************************/
+typedef enum {
+    NC,        /* column-wise, no supernode */
+    NR,        /* row-wize, no supernode */
+    SC,        /* column-wise, supernode */
+    SR,        /* row-wise, supernode */
+    NCP,       /* column-wise, column-permuted, no supernode 
+                  (The consecutive columns of nonzeros, after permutation,
+		   may not be stored  contiguously.) */
+    DN         /* Fortran style column-wise storage for dense matrix */
+} Stype_t;
+
+typedef enum {
+    _S,         /* single */
+    _D,         /* double */
+    _C,         /* single complex */
+    _Z          /* double complex */
+} Dtype_t;
+
+typedef enum {
+    GE,        /* general */
+    TRLU,      /* lower triangular, unit diagonal */
+    TRUU,      /* upper triangular, unit diagonal */
+    TRL,       /* lower triangular */
+    TRU,       /* upper triangular */
+    SYL,       /* symmetric, store lower half */
+    SYU,       /* symmetric, store upper half */
+    HEL,       /* Hermitian, store lower half */
+    HEU        /* Hermitian, store upper half */
+} Mtype_t;
+
+typedef struct {
+	Stype_t Stype; /* Storage type: interprets the storage structure 
+		   	  pointed to by *Store. */
+	Dtype_t Dtype; /* Data type. */
+	Mtype_t Mtype; /* Matrix type: describes the mathematical property of 
+			  the matrix. */
+	int  nrow;     /* number of rows */
+	int  ncol;     /* number of columns */
+	void *Store;   /* pointer to the actual storage of the matrix */
+} SuperMatrix;
+
+/***********************************************
+ * The storage schemes are defined as follows. *
+ ***********************************************/
+
+/* Stype == NC (Also known as Harwell-Boeing sparse matrix format (CCS)) */
+typedef struct {
+    int  nnz;	  /* number of nonzeros in the matrix */
+    void *nzval;  /* pointer to array of nonzero values, packed by column */
+    int  *rowind; /* pointer to array of row indices of the nonzeros */
+    int  *colptr; /* pointer to array of beginning of columns in nzval[] 
+                     and rowind[]  */
+                  /* Note:
+		     Zero-based indexing is used;
+		     colptr[] has ncol+1 entries, the last one pointing
+		         beyond the last column, so that colptr[ncol] = nnz. */
+} NCformat;
+
+/* Stype == NR (Also known as row compressed storage (RCS). */
+typedef struct {
+    int  nnz;	  /* number of nonzeros in the matrix */
+    void *nzval;  /* pointer to array of nonzero values, packed by row */
+    int  *colind; /* pointer to array of column indices of the nonzeros */
+    int  *rowptr; /* pointer to array of beginning of rows in nzval[] 
+                     and colind[]  */
+                  /* Note:
+		     Zero-based indexing is used;
+		     rowptr[] has nrow+1 entries, the last one pointing
+		         beyond the last column, so that rowptr[nrow] = nnz. */
+} NRformat;
+
+/* Stype == SC */
+typedef struct {
+  int  nnz;	     /* number of nonzeros in the matrix */
+  int  nsuper;       /* number of supernodes, minus 1 */
+  void *nzval;       /* pointer to array of nonzero values, packed by column */
+  int  *nzval_colptr;/* pointer to array of beginning of columns in nzval[] */
+  int  *rowind;      /* pointer to array of compressed row indices of 
+			rectangular supernodes */
+  int *rowind_colptr;/* pointer to array of beginning of columns in rowind[] */
+  int *col_to_sup;   /* col_to_sup[j] is the supernode number to which column 
+			j belongs; mapping from column to supernode number. */
+  int *sup_to_col;   /* sup_to_col[s] points to the start of the s-th 
+			supernode; mapping from supernode number to column.
+		        e.g.: col_to_sup: 0 1 2 2 3 3 3 4 4 4 4 4 (ncol=12)
+		              sup_to_col: 0 1 2 4 7 12            (nsuper=4) */
+                     /* Note:
+		        Zero-based indexing is used;
+		        nzval_colptr[], rowind_colptr[], col_to_sup and
+		        sup_to_col[] have ncol+1 entries, the last one
+		        pointing beyond the last column.         */
+} SCformat;
+
+/* Stype == NCP */
+typedef struct {
+    int nnz;	  /* number of nonzeros in the matrix */
+    void *nzval;  /* pointer to array of nonzero values, packed by column */
+    int *rowind;  /* pointer to array of row indices of the nonzeros */
+		  /* Note: nzval[]/rowind[] always have the same length */
+    int *colbeg;  /* colbeg[j] points to the beginning of column j in nzval[] 
+                     and rowind[]  */
+    int *colend;  /* colend[j] points to one past the last element of column
+		     j in nzval[] and rowind[]  */
+		  /* Note:
+		     Zero-based indexing is used;
+		     The consecutive columns of the nonzeros may not be 
+		     contiguous in storage, because the matrix has been 
+		     postmultiplied by a column permutation matrix. */
+} NCPformat;
+
+/* Stype == DN */
+typedef struct {
+    int lda;      /* leading dimension */
+    void *nzval;  /* array of size lda*ncol to represent a dense matrix */
+} DNformat;
+
+
+
+/*********************************************************
+ * Macros used for easy access of sparse matrix entries. *
+ *********************************************************/
+#define L_SUB_START(col)     ( Lstore->rowind_colptr[col] )
+#define L_SUB(ptr)           ( Lstore->rowind[ptr] )
+#define L_NZ_START(col)      ( Lstore->nzval_colptr[col] )
+#define L_FST_SUPC(superno)  ( Lstore->sup_to_col[superno] )
+#define U_NZ_START(col)      ( Ustore->colptr[col] )
+#define U_SUB(ptr)           ( Ustore->rowind[ptr] )
+
+
+#endif  /* __SUPERLU_SUPERMATRIX */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/util.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,396 @@
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include <math.h>
+#include "dsp_defs.h"
+#include "util.h"
+
+/* 
+ * Global statistics variale
+ */
+SuperLUStat_t SuperLUStat;
+
+void superlu_abort_and_exit(char* msg)
+{
+    fprintf(stderr, msg);
+    exit (-1);
+}
+
+void *superlu_malloc(int size)
+{
+    void *buf;
+    buf = (void *) malloc(size);
+    return (buf);
+}
+
+void superlu_free(void *addr)
+{
+    free (addr);
+}
+
+
+/* Deallocate the structure pointing to the actual storage of the matrix. */
+void
+Destroy_SuperMatrix_Store(SuperMatrix *A)
+{
+    SUPERLU_FREE ( A->Store );
+}
+
+void
+Destroy_CompCol_Matrix(SuperMatrix *A)
+{
+    SUPERLU_FREE( ((NCformat *)A->Store)->rowind );
+    SUPERLU_FREE( ((NCformat *)A->Store)->colptr );
+    SUPERLU_FREE( ((NCformat *)A->Store)->nzval );
+    SUPERLU_FREE( A->Store );
+}
+
+
+void
+Destroy_SuperNode_Matrix(SuperMatrix *A)
+{
+    SUPERLU_FREE ( ((SCformat *)A->Store)->rowind );
+    SUPERLU_FREE ( ((SCformat *)A->Store)->rowind_colptr );
+    SUPERLU_FREE ( ((SCformat *)A->Store)->nzval );
+    SUPERLU_FREE ( ((SCformat *)A->Store)->nzval_colptr );
+    SUPERLU_FREE ( ((SCformat *)A->Store)->col_to_sup );
+    SUPERLU_FREE ( ((SCformat *)A->Store)->sup_to_col );
+    SUPERLU_FREE ( A->Store );
+}
+
+/* A is of type Stype==NCP */
+void
+Destroy_CompCol_Permuted(SuperMatrix *A)
+{
+    SUPERLU_FREE ( ((NCPformat *)A->Store)->colbeg );
+    SUPERLU_FREE ( ((NCPformat *)A->Store)->colend );
+    SUPERLU_FREE ( A->Store );
+}
+
+/* A is of type Stype==DN */
+void
+Destroy_Dense_Matrix(SuperMatrix *A)
+{
+    DNformat* Astore = A->Store;
+    SUPERLU_FREE (Astore->nzval);
+    SUPERLU_FREE ( A->Store );
+}
+
+/*
+ * Reset repfnz[] for the current column 
+ */
+void
+resetrep_col (const int nseg, const int *segrep, int *repfnz)
+{
+    int i, irep;
+    
+    for (i = 0; i < nseg; i++) {
+	irep = segrep[i];
+	repfnz[irep] = EMPTY;
+    }
+}
+
+
+/*
+ * Count the total number of nonzeros in factors L and U,  and in the 
+ * symmetrically reduced L. 
+ */
+void
+countnz(const int n, int *xprune, int *nnzL, int *nnzU, GlobalLU_t *Glu)
+{
+    int          nsuper, fsupc, i, j;
+    int          nnzL0, jlen, irep;
+    int          *xsup, *xlsub;
+
+    xsup   = Glu->xsup;
+    xlsub  = Glu->xlsub;
+    *nnzL  = 0;
+    *nnzU  = (Glu->xusub)[n];
+    nnzL0  = 0;
+    nsuper = (Glu->supno)[n];
+
+    if ( n <= 0 ) return;
+
+    /* 
+     * For each supernode
+     */
+    for (i = 0; i <= nsuper; i++) {
+	fsupc = xsup[i];
+	jlen = xlsub[fsupc+1] - xlsub[fsupc];
+
+	for (j = fsupc; j < xsup[i+1]; j++) {
+	    *nnzL += jlen;
+	    *nnzU += j - fsupc + 1;
+	    jlen--;
+	}
+	irep = xsup[i+1] - 1;
+	nnzL0 += xprune[irep] - xlsub[irep];
+    }
+    
+    /* printf("\tNo of nonzeros in symm-reduced L = %d\n", nnzL0);*/
+}
+
+
+
+/*
+ * Fix up the data storage lsub for L-subscripts. It removes the subscript
+ * sets for structural pruning,	and applies permuation to the remaining
+ * subscripts.
+ */
+void
+fixupL(const int n, const int *perm_r, GlobalLU_t *Glu)
+{
+    register int nsuper, fsupc, nextl, i, j, k, jstrt;
+    int          *xsup, *lsub, *xlsub;
+
+    if ( n <= 1 ) return;
+
+    xsup   = Glu->xsup;
+    lsub   = Glu->lsub;
+    xlsub  = Glu->xlsub;
+    nextl  = 0;
+    nsuper = (Glu->supno)[n];
+    
+    /* 
+     * For each supernode ...
+     */
+    for (i = 0; i <= nsuper; i++) {
+	fsupc = xsup[i];
+	jstrt = xlsub[fsupc];
+	xlsub[fsupc] = nextl;
+	for (j = jstrt; j < xlsub[fsupc+1]; j++) {
+	    lsub[nextl] = perm_r[lsub[j]]; /* Now indexed into P*A */
+	    nextl++;
+  	}
+	for (k = fsupc+1; k < xsup[i+1]; k++) 
+	    	xlsub[k] = nextl;	/* Other columns in supernode i */
+
+    }
+
+    xlsub[n] = nextl;
+}
+
+
+/*
+ * Diagnostic print of segment info after panel_dfs().
+ */
+void print_panel_seg(int n, int w, int jcol, int nseg, 
+		     int *segrep, int *repfnz)
+{
+    int j, k;
+    
+    for (j = jcol; j < jcol+w; j++) {
+	printf("\tcol %d:\n", j);
+	for (k = 0; k < nseg; k++)
+	    printf("\t\tseg %d, segrep %d, repfnz %d\n", k, 
+			segrep[k], repfnz[(j-jcol)*n + segrep[k]]);
+    }
+
+}
+
+
+
+
+
+void
+StatInit(int panel_size, int relax)
+{
+    register int i, w;
+    w = MAX(panel_size, relax);
+    SuperLUStat.panel_histo = intCalloc(w+1);
+    SuperLUStat.utime = (double *) SUPERLU_MALLOC(NPHASES * sizeof(double));
+    if (!SuperLUStat.utime) ABORT("SUPERLU_MALLOC fails for SuperLUStat.utime");
+    SuperLUStat.ops = (flops_t *) SUPERLU_MALLOC(NPHASES * sizeof(flops_t));
+    if (!SuperLUStat.ops) ABORT("SUPERLU_MALLOC fails for SuperLUStat.ops");
+    for (i = 0; i < NPHASES; ++i) {
+        SuperLUStat.utime[i] = 0.;
+        SuperLUStat.ops[i] = 0.;
+    }
+}
+
+
+void
+PrintStat(SuperLUStat_t *SuperLUStat)
+{
+/* mods by aadler, dec 99*/
+#ifdef VERBOSE
+    double         *utime;
+    flops_t        *ops;
+
+    utime = SuperLUStat->utime;
+    ops   = SuperLUStat->ops;
+    printf("Factor time  = %8.2f\n", utime[FACT]);
+    if ( utime[FACT] != 0.0 )
+      printf("Factor flops = %e\tMflops = %8.2f\n", ops[FACT],
+	     ops[FACT]*1e-6/utime[FACT]);
+
+    printf("Solve time   = %8.2f\n", utime[SOLVE]);
+    if ( utime[SOLVE] != 0.0 )
+      printf("Solve flops = %e\tMflops = %8.2f\n", ops[SOLVE],
+	     ops[SOLVE]*1e-6/utime[SOLVE]);
+#endif // VERBOSE
+}
+
+
+void
+StatFree()
+{
+    SUPERLU_FREE(SuperLUStat.panel_histo);
+    SUPERLU_FREE(SuperLUStat.utime);
+    SUPERLU_FREE(SuperLUStat.ops);
+}
+
+
+flops_t
+LUFactFlops()
+{
+    return (SuperLUStat.ops[FACT]);
+}
+
+flops_t
+LUSolveFlops()
+{
+    return (SuperLUStat.ops[SOLVE]);
+}
+
+
+
+
+
+/* 
+ * Fills an integer array with a given value.
+ */
+void ifill(int *a, int alen, int ival)
+{
+    register int i;
+    for (i = 0; i < alen; i++) a[i] = ival;
+}
+
+
+
+/* 
+ * Get the statistics of the supernodes 
+ */
+#define NBUCKS 10
+static 	int	max_sup_size;
+
+void super_stats(int nsuper, int *xsup)
+{
+    register int nsup1 = 0;
+    int          i, isize, whichb, bl, bh;
+    int          bucket[NBUCKS];
+
+    max_sup_size = 0;
+
+    for (i = 0; i <= nsuper; i++) {
+	isize = xsup[i+1] - xsup[i];
+	if ( isize == 1 ) nsup1++;
+	if ( max_sup_size < isize ) max_sup_size = isize;	
+    }
+
+    printf("    Supernode statistics:\n\tno of super = %d\n", nsuper+1);
+    printf("\tmax supernode size = %d\n", max_sup_size);
+    printf("\tno of size 1 supernodes = %d\n", nsup1);
+
+    /* Histogram of the supernode sizes */
+    ifill (bucket, NBUCKS, 0);
+
+    for (i = 0; i <= nsuper; i++) {
+        isize = xsup[i+1] - xsup[i];
+        whichb = (float) isize / max_sup_size * NBUCKS;
+        if (whichb >= NBUCKS) whichb = NBUCKS - 1;
+        bucket[whichb]++;
+    }
+    
+    printf("\tHistogram of supernode sizes:\n");
+    for (i = 0; i < NBUCKS; i++) {
+        bl = (float) i * max_sup_size / NBUCKS;
+        bh = (float) (i+1) * max_sup_size / NBUCKS;
+        printf("\tsnode: %d-%d\t\t%d\n", bl+1, bh, bucket[i]);
+    }
+
+}
+
+
+float SpaSize(int n, int np, float sum_npw)
+{
+    return (sum_npw*8 + np*8 + n*4)/1024.;
+}
+
+float DenseSize(int n, float sum_nw)
+{
+    return (sum_nw*8 + n*8)/1024.;;
+}
+
+
+
+/*
+ * Check whether repfnz[] == EMPTY after reset.
+ */
+void check_repfnz(int n, int w, int jcol, int *repfnz)
+{
+    int jj, k;
+
+    for (jj = jcol; jj < jcol+w; jj++) 
+	for (k = 0; k < n; k++)
+	    if ( repfnz[(jj-jcol)*n + k] != EMPTY ) {
+		fprintf(stderr, "col %d, repfnz_col[%d] = %d\n", jj,
+			k, repfnz[(jj-jcol)*n + k]);
+		ABORT("check_repfnz");
+	    }
+}
+
+
+/* Print a summary of the testing results. */
+void
+PrintSumm(char *type, int nfail, int nrun, int nerrs)
+{
+    if ( nfail > 0 )
+	printf("%3s driver: %d out of %d tests failed to pass the threshold\n",
+	       type, nfail, nrun);
+    else
+	printf("All tests for %3s driver passed the threshold (%6d tests run)\n", type, nrun);
+
+    if ( nerrs > 0 )
+	printf("%6d error messages recorded\n", nerrs);
+}
+
+
+int print_int_vec(char *what, int n, int *vec)
+{
+    int i;
+    printf("%s\n", what);
+    for (i = 0; i < n; ++i) printf("%d\t%d\n", i, vec[i]);
+    return 0;
+}
+
+int PrintInt10(char *name, int len, int *x)
+{
+    register int i;
+    
+    printf("%s:", name);
+    for (i = 0; i < len; ++i) {
+	if ( i % 10 == 0 ) printf("\n[%4d-%4d]", i, i+9);
+	printf("%6d", x[i]);
+    }
+    printf("\n");
+    return 0;
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/util.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,117 @@
+#ifndef __SUPERLU_UTIL /* allow multiple inclusions */
+#define __SUPERLU_UTIL
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <malloc.h>
+#include <assert.h>
+
+/* Macros */
+#ifndef USER_ABORT
+#define USER_ABORT(msg) superlu_abort_and_exit(msg)
+#endif
+
+#define ABORT(err_msg) \
+ { char msg[256];\
+   sprintf(msg,"%s at line %d in file %s\n",err_msg,__LINE__, __FILE__);\
+   USER_ABORT(msg); }
+
+
+#ifndef USER_MALLOC
+#define USER_MALLOC(size) superlu_malloc(size)
+#endif
+
+#define SUPERLU_MALLOC(size) USER_MALLOC(size)
+
+#ifndef USER_FREE
+#define USER_FREE(addr) superlu_free(addr)
+#endif
+
+#define SUPERLU_FREE(addr) USER_FREE(addr)
+
+
+#define MAX(x, y) 	( (x) > (y) ? (x) : (y) )
+#define MIN(x, y) 	( (x) < (y) ? (x) : (y) )
+
+/* 
+ * Constants 
+ */
+#define EMPTY	(-1)
+#define NO	(-1)
+#define FALSE	0
+#define TRUE	1
+
+/*
+ * Type definitions
+ */
+typedef float    flops_t;
+typedef unsigned char Logical;
+
+/* 
+ * The following enumerate type is used by the statistics variable 
+ * SuperLUStat, to keep track of flop count and time spent at various stages.
+ *
+ * Note that not all of the fields are disjoint.
+ */
+typedef enum {
+    COLPERM, /* find a column ordering that minimizes fills */
+    RELAX,   /* find artificial supernodes */
+    ETREE,   /* compute column etree */
+    EQUIL,   /* equilibrate the original matrix */
+    FACT,    /* perform LU factorization */
+    RCOND,   /* estimate reciprocal condition number */
+    SOLVE,   /* forward and back solves */
+    REFINE,  /* perform iterative refinement */
+    FLOAT,   /* time spent in floating-point operations */
+    TRSV,    /* fraction of FACT spent in xTRSV */
+    GEMV,    /* fraction of FACT spent in xGEMV */
+    FERR,    /* estimate error bounds after iterative refinement */
+    NPHASES  /* total number of phases */
+} PhaseType;
+
+typedef struct {
+    int     *panel_histo; /* histogram of panel size distribution */
+    double  *utime;       /* running time at various phases */
+    flops_t *ops;         /* operation count at various phases */
+} SuperLUStat_t;
+
+/* Macros */
+#define FIRSTCOL_OF_SNODE(i)	(xsup[i])
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern void    superlu_abort_and_exit(char*);
+extern void    *superlu_malloc (int);
+extern int     *intMalloc (int);
+extern int     *intCalloc (int);
+extern void    superlu_free (void*);
+extern void    SetIWork (int, int, int, int *, int **, int **, int **,
+                         int **, int **, int **, int **);
+extern void    StatInit(int, int);
+extern void    StatFree();
+extern int     sp_coletree (int *, int *, int *, int, int, int *);
+extern void    relax_snode  (int, int *, int, int *, int *);
+extern void    resetrep_col (const int, const int *, int *);
+extern int     spcoletree (int *, int *, int *, int, int, int *);
+extern int     *TreePostorder (int, int *);
+extern double  SuperLU_timer_ ();
+extern int     sp_ienv (int);
+extern int     lsame_ (char *, char *);
+extern int     xerbla_ (char *, int *);
+extern void    ifill (int *, int, int);
+extern void    snode_profile (int, int *);
+extern void    super_stats (int, int *);
+extern void    PrintSumm (char *, int, int, int);
+extern void    PrintStat (SuperLUStat_t *);
+extern void    print_panel_seg(int, int, int, int, int *, int *);
+extern void    check_repfnz(int, int, int, int *);
+
+#ifdef __cplusplus
+  }
+#endif
+
+#endif /* __SUPERLU_UTIL */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/xerbla.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,40 @@
+/* Subroutine */ int xerbla_(char *srname, int *info)
+{
+/*  -- LAPACK auxiliary routine (version 2.0) --   
+       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
+       Courant Institute, Argonne National Lab, and Rice University   
+       September 30, 1994   
+
+
+    Purpose   
+    =======   
+
+    XERBLA  is an error handler for the LAPACK routines.   
+    It is called by an LAPACK routine if an input parameter has an   
+    invalid value.  A message is printed and execution stops.   
+
+    Installers may consider modifying the STOP statement in order to   
+    call system-specific exception-handling facilities.   
+
+    Arguments   
+    =========   
+
+    SRNAME  (input) CHARACTER*6   
+            The name of the routine which called XERBLA.   
+
+    INFO    (input) INT   
+            The position of the invalid parameter in the parameter list   
+
+            of the calling routine.   
+
+   ===================================================================== 
+*/
+
+    printf("** On entry to %6s, parameter number %2d had an illegal value\n",
+		srname, *info);
+
+/*     End of XERBLA */
+
+    return 0;
+} /* xerbla_ */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zcolumn_bmod.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,365 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "zsp_defs.h"
+#include "util.h"
+
+/* 
+ * Function prototypes 
+ */
+void zusolve(int, int, doublecomplex*, doublecomplex*);
+void zlsolve(int, int, doublecomplex*, doublecomplex*);
+void zmatvec(int, int, int, doublecomplex*, doublecomplex*, doublecomplex*);
+
+
+
+/* Return value:   0 - successful return
+ *               > 0 - number of bytes allocated when run out of space
+ */
+int
+zcolumn_bmod (
+	     const int  jcol,	  /* in */
+	     const int  nseg,	  /* in */
+	     doublecomplex     *dense,	  /* in */
+	     doublecomplex     *tempv,	  /* working array */
+	     int        *segrep,  /* in */
+	     int        *repfnz,  /* in */
+	     int        fpanelc,  /* in -- first column in the current panel */
+	     GlobalLU_t *Glu      /* modified */
+	     )
+{
+/*
+ * Purpose:
+ * ========
+ *    Performs numeric block updates (sup-col) in topological order.
+ *    It features: col-col, 2cols-col, 3cols-col, and sup-col updates.
+ *    Special processing on the supernodal portion of L\U[*,j]
+ *
+ */
+#ifdef _CRAY
+    _fcd ftcs1 = _cptofcd("L", strlen("L")),
+         ftcs2 = _cptofcd("N", strlen("N")),
+         ftcs3 = _cptofcd("U", strlen("U"));
+#endif
+    int         incx = 1, incy = 1;
+    doublecomplex      alpha, beta;
+    
+    /* krep = representative of current k-th supernode
+     * fsupc = first supernodal column
+     * nsupc = no of columns in supernode
+     * nsupr = no of rows in supernode (used as leading dimension)
+     * luptr = location of supernodal LU-block in storage
+     * kfnz = first nonz in the k-th supernodal segment
+     * no_zeros = no of leading zeros in a supernodal U-segment
+     */
+    doublecomplex       ukj, ukj1, ukj2;
+    int          luptr, luptr1, luptr2;
+    int          fsupc, nsupc, nsupr, segsze;
+    int          nrow;	  /* No of rows in the matrix of matrix-vector */
+    int          jcolp1, jsupno, k, ksub, krep, krep_ind, ksupno;
+    register int lptr, kfnz, isub, irow, i;
+    register int no_zeros, new_next; 
+    int          ufirst, nextlu;
+    int          fst_col; /* First column within small LU update */
+    int          d_fsupc; /* Distance between the first column of the current
+			     panel and the first column of the current snode. */
+    int          *xsup, *supno;
+    int          *lsub, *xlsub;
+    doublecomplex       *lusup;
+    int          *xlusup;
+    int          nzlumax;
+    doublecomplex       *tempv1;
+    doublecomplex      zero = {0.0, 0.0};
+    doublecomplex      one = {1.0, 0.0};
+    doublecomplex      none = {-1.0, 0.0};
+    doublecomplex	 comp_temp, comp_temp1;
+    int          mem_error;
+    extern SuperLUStat_t SuperLUStat;
+    flops_t  *ops = SuperLUStat.ops;
+
+    xsup    = Glu->xsup;
+    supno   = Glu->supno;
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    lusup   = Glu->lusup;
+    xlusup  = Glu->xlusup;
+    nzlumax = Glu->nzlumax;
+    jcolp1 = jcol + 1;
+    jsupno = supno[jcol];
+    
+    /* 
+     * For each nonz supernode segment of U[*,j] in topological order 
+     */
+    k = nseg - 1;
+    for (ksub = 0; ksub < nseg; ksub++) {
+
+	krep = segrep[k];
+	k--;
+	ksupno = supno[krep];
+	if ( jsupno != ksupno ) { /* Outside the rectangular supernode */
+
+	    fsupc = xsup[ksupno];
+	    fst_col = MAX ( fsupc, fpanelc );
+
+  	    /* Distance from the current supernode to the current panel; 
+	       d_fsupc=0 if fsupc > fpanelc. */
+  	    d_fsupc = fst_col - fsupc; 
+
+	    luptr = xlusup[fst_col] + d_fsupc;
+	    lptr = xlsub[fsupc] + d_fsupc;
+
+	    kfnz = repfnz[krep];
+	    kfnz = MAX ( kfnz, fpanelc );
+
+	    segsze = krep - kfnz + 1;
+	    nsupc = krep - fst_col + 1;
+	    nsupr = xlsub[fsupc+1] - xlsub[fsupc];	/* Leading dimension */
+	    nrow = nsupr - d_fsupc - nsupc;
+	    krep_ind = lptr + nsupc - 1;
+
+	    ops[TRSV] += 4 * segsze * (segsze - 1);
+	    ops[GEMV] += 8 * nrow * segsze;
+
+
+
+	    /* 
+	     * Case 1: Update U-segment of size 1 -- col-col update 
+	     */
+	    if ( segsze == 1 ) {
+	  	ukj = dense[lsub[krep_ind]];
+		luptr += nsupr*(nsupc-1) + nsupc;
+
+		for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+		    irow = lsub[i];
+		    zz_mult(&comp_temp, &ukj, &lusup[luptr]);
+		    z_sub(&dense[irow], &dense[irow], &comp_temp);
+		    luptr++;
+		}
+
+	    } else if ( segsze <= 3 ) {
+		ukj = dense[lsub[krep_ind]];
+		luptr += nsupr*(nsupc-1) + nsupc-1;
+		ukj1 = dense[lsub[krep_ind - 1]];
+		luptr1 = luptr - nsupr;
+
+		if ( segsze == 2 ) { /* Case 2: 2cols-col update */
+		    zz_mult(&comp_temp, &ukj1, &lusup[luptr1]);
+		    z_sub(&ukj, &ukj, &comp_temp);
+		    dense[lsub[krep_ind]] = ukj;
+		    for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+		    	irow = lsub[i];
+		    	luptr++;
+		    	luptr1++;
+			zz_mult(&comp_temp, &ukj, &lusup[luptr]);
+			zz_mult(&comp_temp1, &ukj1, &lusup[luptr1]);
+			z_add(&comp_temp, &comp_temp, &comp_temp1);
+			z_sub(&dense[irow], &dense[irow], &comp_temp);
+		    }
+		} else { /* Case 3: 3cols-col update */
+		    ukj2 = dense[lsub[krep_ind - 2]];
+		    luptr2 = luptr1 - nsupr;
+  		    zz_mult(&comp_temp, &ukj2, &lusup[luptr2-1]);
+		    z_sub(&ukj1, &ukj1, &comp_temp);
+
+		    zz_mult(&comp_temp, &ukj1, &lusup[luptr1]);
+		    zz_mult(&comp_temp1, &ukj2, &lusup[luptr2]);
+		    z_add(&comp_temp, &comp_temp, &comp_temp1);
+		    z_sub(&ukj, &ukj, &comp_temp);
+
+		    dense[lsub[krep_ind]] = ukj;
+		    dense[lsub[krep_ind-1]] = ukj1;
+		    for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+		    	irow = lsub[i];
+		    	luptr++;
+		    	luptr1++;
+			luptr2++;
+			zz_mult(&comp_temp, &ukj, &lusup[luptr]);
+			zz_mult(&comp_temp1, &ukj1, &lusup[luptr1]);
+			z_add(&comp_temp, &comp_temp, &comp_temp1);
+			zz_mult(&comp_temp1, &ukj2, &lusup[luptr2]);
+			z_add(&comp_temp, &comp_temp, &comp_temp1);
+			z_sub(&dense[irow], &dense[irow], &comp_temp);
+		    }
+		}
+
+
+	    } else {
+	  	/*
+		 * Case: sup-col update
+		 * Perform a triangular solve and block update,
+		 * then scatter the result of sup-col update to dense
+		 */
+
+		no_zeros = kfnz - fst_col;
+
+	        /* Copy U[*,j] segment from dense[*] to tempv[*] */
+	        isub = lptr + no_zeros;
+	        for (i = 0; i < segsze; i++) {
+	  	    irow = lsub[isub];
+		    tempv[i] = dense[irow];
+		    ++isub; 
+	        }
+
+	        /* Dense triangular solve -- start effective triangle */
+		luptr += nsupr * no_zeros + no_zeros; 
+		
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		CTRSV( ftcs1, ftcs2, ftcs3, &segsze, &lusup[luptr], 
+		       &nsupr, tempv, &incx );
+#else		
+		ztrsv_( "L", "N", "U", &segsze, &lusup[luptr], 
+		       &nsupr, tempv, &incx );
+#endif		
+ 		luptr += segsze;  /* Dense matrix-vector */
+		tempv1 = &tempv[segsze];
+                alpha = one;
+                beta = zero;
+#ifdef _CRAY
+		CGEMV( ftcs2, &nrow, &segsze, &alpha, &lusup[luptr], 
+		       &nsupr, tempv, &incx, &beta, tempv1, &incy );
+#else
+		zgemv_( "N", &nrow, &segsze, &alpha, &lusup[luptr], 
+		       &nsupr, tempv, &incx, &beta, tempv1, &incy );
+#endif
+#else
+		zlsolve ( nsupr, segsze, &lusup[luptr], tempv );
+
+ 		luptr += segsze;  /* Dense matrix-vector */
+		tempv1 = &tempv[segsze];
+		zmatvec (nsupr, nrow , segsze, &lusup[luptr], tempv, tempv1);
+#endif
+		
+		
+                /* Scatter tempv[] into SPA dense[] as a temporary storage */
+                isub = lptr + no_zeros;
+                for (i = 0; i < segsze; i++) {
+                    irow = lsub[isub];
+                    dense[irow] = tempv[i];
+                    tempv[i] = zero;
+                    ++isub;
+                }
+
+		/* Scatter tempv1[] into SPA dense[] */
+		for (i = 0; i < nrow; i++) {
+		    irow = lsub[isub];
+		    z_sub(&dense[irow], &dense[irow], &tempv1[i]);
+		    tempv1[i] = zero;
+		    ++isub;
+		}
+	    }
+	    
+	} /* if jsupno ... */
+
+    } /* for each segment... */
+
+    /*
+     *	Process the supernodal portion of L\U[*,j]
+     */
+    nextlu = xlusup[jcol];
+    fsupc = xsup[jsupno];
+
+    /* Copy the SPA dense into L\U[*,j] */
+    new_next = nextlu + xlsub[fsupc+1] - xlsub[fsupc];
+    while ( new_next > nzlumax ) {
+	if (mem_error = zLUMemXpand(jcol, nextlu, LUSUP, &nzlumax, Glu))
+	    return (mem_error);
+	lusup = Glu->lusup;
+	lsub = Glu->lsub;
+    }
+
+    for (isub = xlsub[fsupc]; isub < xlsub[fsupc+1]; isub++) {
+  	irow = lsub[isub];
+	lusup[nextlu] = dense[irow];
+        dense[irow] = zero;
+	++nextlu;
+    }
+
+    xlusup[jcolp1] = nextlu;	/* Close L\U[*,jcol] */
+
+    /* For more updates within the panel (also within the current supernode), 
+     * should start from the first column of the panel, or the first column 
+     * of the supernode, whichever is bigger. There are 2 cases:
+     *    1) fsupc < fpanelc, then fst_col := fpanelc
+     *    2) fsupc >= fpanelc, then fst_col := fsupc
+     */
+    fst_col = MAX ( fsupc, fpanelc );
+
+    if ( fst_col < jcol ) {
+
+  	/* Distance between the current supernode and the current panel.
+	   d_fsupc=0 if fsupc >= fpanelc. */
+  	d_fsupc = fst_col - fsupc;
+
+	lptr = xlsub[fsupc] + d_fsupc;
+	luptr = xlusup[fst_col] + d_fsupc;
+	nsupr = xlsub[fsupc+1] - xlsub[fsupc];	/* Leading dimension */
+	nsupc = jcol - fst_col;	/* Excluding jcol */
+	nrow = nsupr - d_fsupc - nsupc;
+
+	/* Points to the beginning of jcol in snode L\U(jsupno) */
+	ufirst = xlusup[jcol] + d_fsupc;	
+
+	ops[TRSV] += 4 * nsupc * (nsupc - 1);
+	ops[GEMV] += 8 * nrow * nsupc;
+	
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+	CTRSV( ftcs1, ftcs2, ftcs3, &nsupc, &lusup[luptr], 
+	       &nsupr, &lusup[ufirst], &incx );
+#else
+	ztrsv_( "L", "N", "U", &nsupc, &lusup[luptr], 
+	       &nsupr, &lusup[ufirst], &incx );
+#endif
+	
+	alpha = none; beta = one; /* y := beta*y + alpha*A*x */
+
+#ifdef _CRAY
+	CGEMV( ftcs2, &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr,
+	       &lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
+#else
+	zgemv_( "N", &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr,
+	       &lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
+#endif
+#else
+	zlsolve ( nsupr, nsupc, &lusup[luptr], &lusup[ufirst] );
+
+	zmatvec ( nsupr, nrow, nsupc, &lusup[luptr+nsupc],
+		&lusup[ufirst], tempv );
+	
+        /* Copy updates from tempv[*] into lusup[*] */
+	isub = ufirst + nsupc;
+	for (i = 0; i < nrow; i++) {
+	    z_sub(&lusup[isub], &lusup[isub], &tempv[i]);
+	    tempv[i] = zero;
+	    ++isub;
+	}
+
+#endif
+	
+	
+    } /* if fst_col < jcol ... */ 
+
+    return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zcolumn_dfs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,271 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "zsp_defs.h"
+#include "util.h"
+
+/* What type of supernodes we want */
+#define T2_SUPER
+
+int
+zcolumn_dfs(
+	   const int  m,         /* in - number of rows in the matrix */
+	   const int  jcol,      /* in */
+	   int        *perm_r,   /* in */
+	   int        *nseg,     /* modified - with new segments appended */
+	   int        *lsub_col, /* in - defines the RHS vector to start the dfs */
+	   int        *segrep,   /* modified - with new segments appended */
+	   int        *repfnz,   /* modified */
+	   int        *xprune,   /* modified */
+	   int        *marker,   /* modified */
+	   int        *parent,	 /* working array */
+	   int        *xplore,   /* working array */
+	   GlobalLU_t *Glu       /* modified */
+	   )
+{
+/* 
+ * Purpose
+ * =======
+ *   "column_dfs" performs a symbolic factorization on column jcol, and
+ *   decide the supernode boundary.
+ *
+ *   This routine does not use numeric values, but only use the RHS 
+ *   row indices to start the dfs.
+ *
+ *   A supernode representative is the last column of a supernode.
+ *   The nonzeros in U[*,j] are segments that end at supernodal
+ *   representatives. The routine returns a list of such supernodal 
+ *   representatives in topological order of the dfs that generates them.
+ *   The location of the first nonzero in each such supernodal segment
+ *   (supernodal entry location) is also returned.
+ *
+ * Local parameters
+ * ================
+ *   nseg: no of segments in current U[*,j]
+ *   jsuper: jsuper=NO if column j does not belong to the same
+ *	supernode as j-1. Otherwise, jsuper=nsuper.
+ *
+ *   marker2: A-row --> A-row/col (0/1)
+ *   repfnz: SuperA-col --> PA-row
+ *   parent: SuperA-col --> SuperA-col
+ *   xplore: SuperA-col --> index to L-structure
+ *
+ * Return value
+ * ============
+ *     0  success;
+ *   > 0  number of bytes allocated when run out of space.
+ *
+ */
+    int     jcolp1, jcolm1, jsuper, nsuper, nextl;
+    int     k, krep, krow, kmark, kperm;
+    int     *marker2;           /* Used for small panel LU */
+    int	    fsupc;		/* First column of a snode */
+    int     myfnz;		/* First nonz column of a U-segment */
+    int	    chperm, chmark, chrep, kchild;
+    int     xdfs, maxdfs, kpar, oldrep;
+    int     jptr, jm1ptr;
+    int     ito, ifrom, istop;	/* Used to compress row subscripts */
+    int     mem_error;
+    int     *xsup, *supno, *lsub, *xlsub;
+    int     nzlmax;
+    static  int  first = 1, maxsuper;
+    
+    xsup    = Glu->xsup;
+    supno   = Glu->supno;
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    nzlmax  = Glu->nzlmax;
+
+    if ( first ) {
+	maxsuper = sp_ienv(3);
+	first = 0;
+    }
+    jcolp1  = jcol + 1;
+    jcolm1  = jcol - 1;
+    nsuper  = supno[jcol];
+    jsuper  = nsuper;
+    nextl   = xlsub[jcol];
+    marker2 = &marker[2*m];
+
+
+    /* For each nonzero in A[*,jcol] do dfs */
+    for (k = 0; lsub_col[k] != EMPTY; k++) {
+
+	krow = lsub_col[k];
+    	lsub_col[k] = EMPTY;
+	kmark = marker2[krow];    	
+
+	/* krow was visited before, go to the next nonz */
+        if ( kmark == jcol ) continue; 
+
+	/* For each unmarked nbr krow of jcol
+	 *	krow is in L: place it in structure of L[*,jcol]
+	 */
+	marker2[krow] = jcol;
+	kperm = perm_r[krow];
+
+   	if ( kperm == EMPTY ) {
+	    lsub[nextl++] = krow; 	/* krow is indexed into A */
+	    if ( nextl >= nzlmax ) {
+		if ( mem_error = zLUMemXpand(jcol, nextl, LSUB, &nzlmax, Glu) )
+		    return (mem_error);
+		lsub = Glu->lsub;
+	    }
+            if ( kmark != jcolm1 ) jsuper = NO;	/* Row index subset testing */
+  	} else {
+	    /*	krow is in U: if its supernode-rep krep
+	     *	has been explored, update repfnz[*]
+	     */
+	    krep = xsup[supno[kperm]+1] - 1;
+	    myfnz = repfnz[krep];
+
+	    if ( myfnz != EMPTY ) {	/* Visited before */
+	    	if ( myfnz > kperm ) repfnz[krep] = kperm;
+		/* continue; */
+	    }
+	    else {
+		/* Otherwise, perform dfs starting at krep */
+		oldrep = EMPTY;
+	 	parent[krep] = oldrep;
+	  	repfnz[krep] = kperm;
+		xdfs = xlsub[krep];
+	  	maxdfs = xprune[krep];
+
+		do {
+		    /* 
+		     * For each unmarked kchild of krep 
+		     */
+		    while ( xdfs < maxdfs ) {
+
+		   	kchild = lsub[xdfs];
+			xdfs++;
+		  	chmark = marker2[kchild];
+
+		   	if ( chmark != jcol ) { /* Not reached yet */
+		   	    marker2[kchild] = jcol;
+		   	    chperm = perm_r[kchild];
+
+		   	    /* Case kchild is in L: place it in L[*,k] */
+		   	    if ( chperm == EMPTY ) {
+			    	lsub[nextl++] = kchild;
+				if ( nextl >= nzlmax ) {
+				    if ( mem_error =
+					 zLUMemXpand(jcol,nextl,LSUB,&nzlmax,Glu) )
+					return (mem_error);
+				    lsub = Glu->lsub;
+				}
+				if ( chmark != jcolm1 ) jsuper = NO;
+			    } else {
+		    	    	/* Case kchild is in U: 
+				 *   chrep = its supernode-rep. If its rep has 
+			         *   been explored, update its repfnz[*]
+			         */
+		   	    	chrep = xsup[supno[chperm]+1] - 1;
+		   		myfnz = repfnz[chrep];
+		   		if ( myfnz != EMPTY ) { /* Visited before */
+				    if ( myfnz > chperm )
+     				  	repfnz[chrep] = chperm;
+				} else {
+		        	    /* Continue dfs at super-rep of kchild */
+		   		    xplore[krep] = xdfs;	
+		   		    oldrep = krep;
+		   		    krep = chrep; /* Go deeper down G(L^t) */
+				    parent[krep] = oldrep;
+		    		    repfnz[krep] = chperm;
+		   		    xdfs = xlsub[krep];     
+				    maxdfs = xprune[krep];
+				} /* else */
+
+			   } /* else */
+
+			} /* if */
+
+		    } /* while */
+
+		    /* krow has no more unexplored nbrs;
+	   	     *    place supernode-rep krep in postorder DFS.
+	   	     *    backtrack dfs to its parent
+		     */
+		    segrep[*nseg] = krep;
+		    ++(*nseg);
+		    kpar = parent[krep]; /* Pop from stack, mimic recursion */
+		    if ( kpar == EMPTY ) break; /* dfs done */
+		    krep = kpar;
+		    xdfs = xplore[krep];
+		    maxdfs = xprune[krep];
+
+		} while ( kpar != EMPTY ); 	/* Until empty stack */
+
+	    } /* else */
+
+	} /* else */
+
+    } /* for each nonzero ... */
+
+    /* Check to see if j belongs in the same supernode as j-1 */
+    if ( jcol == 0 ) { /* Do nothing for column 0 */
+	nsuper = supno[0] = 0;
+    } else {
+   	fsupc = xsup[nsuper];
+	jptr = xlsub[jcol];	/* Not compressed yet */
+	jm1ptr = xlsub[jcolm1];
+
+#ifdef T2_SUPER
+	if ( (nextl-jptr != jptr-jm1ptr-1) ) jsuper = NO;
+#endif
+	/* Make sure the number of columns in a supernode doesn't
+	   exceed threshold. */
+	if ( jcol - fsupc >= maxsuper ) jsuper = NO;
+
+	/* If jcol starts a new supernode, reclaim storage space in
+	 * lsub from the previous supernode. Note we only store
+	 * the subscript set of the first and last columns of
+   	 * a supernode. (first for num values, last for pruning)
+	 */
+	if ( jsuper == NO ) {	/* starts a new supernode */
+	    if ( (fsupc < jcolm1-1) ) {	/* >= 3 columns in nsuper */
+#ifdef CHK_COMPRESS
+		printf("  Compress lsub[] at super %d-%d\n", fsupc, jcolm1);
+#endif
+	        ito = xlsub[fsupc+1];
+		xlsub[jcolm1] = ito;
+		istop = ito + jptr - jm1ptr;
+		xprune[jcolm1] = istop; /* Initialize xprune[jcol-1] */
+		xlsub[jcol] = istop;
+		for (ifrom = jm1ptr; ifrom < nextl; ++ifrom, ++ito)
+		    lsub[ito] = lsub[ifrom];
+		nextl = ito;            /* = istop + length(jcol) */
+	    }
+	    nsuper++;
+	    supno[jcol] = nsuper;
+	} /* if a new supernode */
+
+    }	/* else: jcol > 0 */ 
+    
+    /* Tidy up the pointers before exit */
+    xsup[nsuper+1] = jcolp1;
+    supno[jcolp1]  = nsuper;
+    xprune[jcol]   = nextl;	/* Initialize upper bound for pruning */
+    xlsub[jcolp1]  = nextl;
+
+    return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zcopy_to_ucol.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,105 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "zsp_defs.h"
+#include "util.h"
+
+int
+zcopy_to_ucol(
+	      int        jcol,	  /* in */
+	      int        nseg,	  /* in */
+	      int        *segrep,  /* in */
+	      int        *repfnz,  /* in */
+	      int        *perm_r,  /* in */
+	      doublecomplex     *dense,   /* modified - reset to zero on return */
+	      GlobalLU_t *Glu      /* modified */
+	      )
+{
+/* 
+ * Gather from SPA dense[*] to global ucol[*].
+ */
+    int ksub, krep, ksupno;
+    int i, k, kfnz, segsze;
+    int fsupc, isub, irow;
+    int jsupno, nextu;
+    int new_next, mem_error;
+    int       *xsup, *supno;
+    int       *lsub, *xlsub;
+    doublecomplex    *ucol;
+    int       *usub, *xusub;
+    int       nzumax;
+
+    doublecomplex zero = {0.0, 0.0};
+
+    xsup    = Glu->xsup;
+    supno   = Glu->supno;
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    ucol    = Glu->ucol;
+    usub    = Glu->usub;
+    xusub   = Glu->xusub;
+    nzumax  = Glu->nzumax;
+    
+    jsupno = supno[jcol];
+    nextu  = xusub[jcol];
+    k = nseg - 1;
+    for (ksub = 0; ksub < nseg; ksub++) {
+	krep = segrep[k--];
+	ksupno = supno[krep];
+
+	if ( ksupno != jsupno ) { /* Should go into ucol[] */
+	    kfnz = repfnz[krep];
+	    if ( kfnz != EMPTY ) {	/* Nonzero U-segment */
+
+	    	fsupc = xsup[ksupno];
+	        isub = xlsub[fsupc] + kfnz - fsupc;
+	        segsze = krep - kfnz + 1;
+
+		new_next = nextu + segsze;
+		while ( new_next > nzumax ) {
+		    if (mem_error = zLUMemXpand(jcol, nextu, UCOL, &nzumax, Glu))
+			return (mem_error);
+		    ucol = Glu->ucol;
+		    if (mem_error = zLUMemXpand(jcol, nextu, USUB, &nzumax, Glu))
+			return (mem_error);
+		    usub = Glu->usub;
+		    lsub = Glu->lsub;
+		}
+		
+		for (i = 0; i < segsze; i++) {
+		    irow = lsub[isub];
+		    usub[nextu] = perm_r[irow];
+		    ucol[nextu] = dense[irow];
+		    dense[irow] = zero;
+		    nextu++;
+		    isub++;
+		} 
+
+	    }
+
+	}
+
+    } /* for each segment... */
+
+    xusub[jcol + 1] = nextu;      /* Close U[*,jcol] */
+    return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zgscon.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,145 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:	zgscon.c
+ * History:     Modified from lapack routines ZGECON.
+ */
+#include <math.h>
+#include "util.h"
+#include "zsp_defs.h"
+
+void
+zgscon(char *norm, SuperMatrix *L, SuperMatrix *U,
+       double anorm, double *rcond, int *info)
+{
+/*
+    Purpose   
+    =======   
+
+    ZGSCON estimates the reciprocal of the condition number of a general 
+    real matrix A, in either the 1-norm or the infinity-norm, using   
+    the LU factorization computed by ZGETRF.   
+
+    An estimate is obtained for norm(inv(A)), and the reciprocal of the   
+    condition number is computed as   
+       RCOND = 1 / ( norm(A) * norm(inv(A)) ).   
+
+    See supermatrix.h for the definition of 'SuperMatrix' structure.
+ 
+    Arguments   
+    =========   
+
+    NORM    (input) char*
+            Specifies whether the 1-norm condition number or the   
+            infinity-norm condition number is required:   
+            = '1' or 'O':  1-norm;   
+            = 'I':         Infinity-norm.
+	    
+    L       (input) SuperMatrix*
+            The factor L from the factorization Pr*A*Pc=L*U as computed by
+            zgstrf(). Use compressed row subscripts storage for supernodes,
+            i.e., L has types: Stype = SC, Dtype = _Z, Mtype = TRLU.
+ 
+    U       (input) SuperMatrix*
+            The factor U from the factorization Pr*A*Pc=L*U as computed by
+            zgstrf(). Use column-wise storage scheme, i.e., U has types:
+            Stype = NC, Dtype = _Z, Mtype = TRU.
+	    
+    ANORM   (input) double
+            If NORM = '1' or 'O', the 1-norm of the original matrix A.   
+            If NORM = 'I', the infinity-norm of the original matrix A.
+	    
+    RCOND   (output) double*
+            The reciprocal of the condition number of the matrix A,   
+            computed as RCOND = 1/(norm(A) * norm(inv(A))).
+	    
+    INFO    (output) int*
+            = 0:  successful exit   
+            < 0:  if INFO = -i, the i-th argument had an illegal value   
+
+    ===================================================================== 
+*/
+
+    /* Local variables */
+    int    kase, kase1, onenrm, i;
+    double ainvnm;
+    doublecomplex *work;
+    extern int zrscl_(int *, doublecomplex *, doublecomplex *, int *);
+
+    extern int zlacon_(int *, doublecomplex *, doublecomplex *, double *, int *);
+
+    
+    /* Test the input parameters. */
+    *info = 0;
+    onenrm = *(unsigned char *)norm == '1' || lsame_(norm, "O");
+    if (! onenrm && ! lsame_(norm, "I")) *info = -1;
+    else if (L->nrow < 0 || L->nrow != L->ncol ||
+             L->Stype != SC || L->Dtype != _Z || L->Mtype != TRLU)
+	 *info = -2;
+    else if (U->nrow < 0 || U->nrow != U->ncol ||
+             U->Stype != NC || U->Dtype != _Z || U->Mtype != TRU) 
+	*info = -3;
+    if (*info != 0) {
+	i = -(*info);
+	xerbla_("zgscon", &i);
+	return;
+    }
+
+    /* Quick return if possible */
+    *rcond = 0.;
+    if ( L->nrow == 0 || U->nrow == 0) {
+	*rcond = 1.;
+	return;
+    }
+
+    work = doublecomplexCalloc( 3*L->nrow );
+
+
+    if ( !work )
+	ABORT("Malloc fails for work arrays in zgscon.");
+    
+    /* Estimate the norm of inv(A). */
+    ainvnm = 0.;
+    if ( onenrm ) kase1 = 1;
+    else kase1 = 2;
+    kase = 0;
+
+    do {
+	zlacon_(&L->nrow, &work[L->nrow], &work[0], &ainvnm, &kase);
+
+	if (kase == 0) break;
+
+	if (kase == kase1) {
+	    /* Multiply by inv(L). */
+	    sp_ztrsv("Lower", "No transpose", "Unit", L, U, &work[0], info);
+
+	    /* Multiply by inv(U). */
+	    sp_ztrsv("Upper", "No transpose", "Non-unit", L, U, &work[0],info);
+	    
+	} else {
+
+	    /* Multiply by inv(U'). */
+	    sp_ztrsv("Upper", "Transpose", "Non-unit", L, U, &work[0], info);
+
+	    /* Multiply by inv(L'). */
+	    sp_ztrsv("Lower", "Transpose", "Unit", L, U, &work[0], info);
+	    
+	}
+
+    } while ( kase != 0 );
+
+    /* Compute the estimate of the reciprocal condition number. */
+    if (ainvnm != 0.) *rcond = (1. / ainvnm) / anorm;
+
+    SUPERLU_FREE (work);
+    return;
+
+} /* zgscon */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zgsequ.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,186 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:	zgsequ.c
+ * History:     Modified from LAPACK routine ZGEEQU
+ */
+#include <math.h>
+#include "zsp_defs.h"
+#include "util.h"
+
+void
+zgsequ(SuperMatrix *A, double *r, double *c, double *rowcnd,
+	double *colcnd, double *amax, int *info)
+{
+/*    
+    Purpose   
+    =======   
+
+    ZGSEQU computes row and column scalings intended to equilibrate an   
+    M-by-N sparse matrix A and reduce its condition number. R returns the row
+    scale factors and C the column scale factors, chosen to try to make   
+    the largest element in each row and column of the matrix B with   
+    elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.   
+
+    R(i) and C(j) are restricted to be between SMLNUM = smallest safe   
+    number and BIGNUM = largest safe number.  Use of these scaling   
+    factors is not guaranteed to reduce the condition number of A but   
+    works well in practice.   
+
+    See supermatrix.h for the definition of 'SuperMatrix' structure.
+ 
+    Arguments   
+    =========   
+
+    A       (input) SuperMatrix*
+            The matrix of dimension (A->nrow, A->ncol) whose equilibration
+            factors are to be computed. The type of A can be:
+            Stype = NC; Dtype = _Z; Mtype = GE.
+	    
+    R       (output) double*, size A->nrow
+            If INFO = 0 or INFO > M, R contains the row scale factors   
+            for A.
+	    
+    C       (output) double*, size A->ncol
+            If INFO = 0,  C contains the column scale factors for A.
+	    
+    ROWCND  (output) double*
+            If INFO = 0 or INFO > M, ROWCND contains the ratio of the   
+            smallest R(i) to the largest R(i).  If ROWCND >= 0.1 and   
+            AMAX is neither too large nor too small, it is not worth   
+            scaling by R.
+	    
+    COLCND  (output) double*
+            If INFO = 0, COLCND contains the ratio of the smallest   
+            C(i) to the largest C(i).  If COLCND >= 0.1, it is not   
+            worth scaling by C.
+	    
+    AMAX    (output) double*
+            Absolute value of largest matrix element.  If AMAX is very   
+            close to overflow or very close to underflow, the matrix   
+            should be scaled.
+	    
+    INFO    (output) int*
+            = 0:  successful exit   
+            < 0:  if INFO = -i, the i-th argument had an illegal value   
+            > 0:  if INFO = i,  and i is   
+                  <= A->nrow:  the i-th row of A is exactly zero   
+                  >  A->ncol:  the (i-M)-th column of A is exactly zero   
+
+    ===================================================================== 
+*/
+
+    /* Local variables */
+    NCformat *Astore;
+    doublecomplex   *Aval;
+    int i, j, irow;
+    double rcmin, rcmax;
+    double bignum, smlnum;
+    extern double dlamch_(char *);
+    
+    /* Test the input parameters. */
+    *info = 0;
+    if ( A->nrow < 0 || A->ncol < 0 ||
+	 A->Stype != NC || A->Dtype != _Z || A->Mtype != GE )
+	*info = -1;
+    if (*info != 0) {
+	i = -(*info);
+	xerbla_("zgsequ", &i);
+	return;
+    }
+
+    /* Quick return if possible */
+    if ( A->nrow == 0 || A->ncol == 0 ) {
+	*rowcnd = 1.;
+	*colcnd = 1.;
+	*amax = 0.;
+	return;
+    }
+
+    Astore = A->Store;
+    Aval = Astore->nzval;
+    
+    /* Get machine constants. */
+    smlnum = dlamch_("S");
+    bignum = 1. / smlnum;
+
+    /* Compute row scale factors. */
+    for (i = 0; i < A->nrow; ++i) r[i] = 0.;
+
+    /* Find the maximum element in each row. */
+    for (j = 0; j < A->ncol; ++j)
+	for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+	    irow = Astore->rowind[i];
+	    r[irow] = MAX( r[irow], z_abs1(&Aval[i]) );
+	}
+
+    /* Find the maximum and minimum scale factors. */
+    rcmin = bignum;
+    rcmax = 0.;
+    for (i = 0; i < A->nrow; ++i) {
+	rcmax = MAX(rcmax, r[i]);
+	rcmin = MIN(rcmin, r[i]);
+    }
+    *amax = rcmax;
+
+    if (rcmin == 0.) {
+	/* Find the first zero scale factor and return an error code. */
+	for (i = 0; i < A->nrow; ++i)
+	    if (r[i] == 0.) {
+		*info = i + 1;
+		return;
+	    }
+    } else {
+	/* Invert the scale factors. */
+	for (i = 0; i < A->nrow; ++i)
+	    r[i] = 1. / MIN( MAX( r[i], smlnum ), bignum );
+	/* Compute ROWCND = min(R(I)) / max(R(I)) */
+	*rowcnd = MAX( rcmin, smlnum ) / MIN( rcmax, bignum );
+    }
+
+    /* Compute column scale factors */
+    for (j = 0; j < A->ncol; ++j) c[j] = 0.;
+
+    /* Find the maximum element in each column, assuming the row
+       scalings computed above. */
+    for (j = 0; j < A->ncol; ++j)
+	for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+	    irow = Astore->rowind[i];
+	    c[j] = MAX( c[j], z_abs1(&Aval[i]) * r[irow] );
+	}
+
+    /* Find the maximum and minimum scale factors. */
+    rcmin = bignum;
+    rcmax = 0.;
+    for (j = 0; j < A->ncol; ++j) {
+	rcmax = MAX(rcmax, c[j]);
+	rcmin = MIN(rcmin, c[j]);
+    }
+
+    if (rcmin == 0.) {
+	/* Find the first zero scale factor and return an error code. */
+	for (j = 0; j < A->ncol; ++j)
+	    if ( c[j] == 0. ) {
+		*info = A->nrow + j + 1;
+		return;
+	    }
+    } else {
+	/* Invert the scale factors. */
+	for (j = 0; j < A->ncol; ++j)
+	    c[j] = 1. / MIN( MAX( c[j], smlnum ), bignum);
+	/* Compute COLCND = min(C(J)) / max(C(J)) */
+	*colcnd = MAX( rcmin, smlnum ) / MIN( rcmax, bignum );
+    }
+
+    return;
+
+} /* zgsequ */
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zgsrfs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,440 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:	zgsrfs.c
+ * History:     Modified from lapack routine ZGERFS
+ */
+#include <math.h>
+#include "zsp_defs.h"
+#include "util.h"
+
+void
+zgsrfs(char *trans, SuperMatrix *A, SuperMatrix *L, SuperMatrix *U,
+       int *perm_r, int *perm_c, char *equed, double *R, double *C,
+       SuperMatrix *B, SuperMatrix *X, 
+       double *ferr, double *berr, int *info)
+{
+/*
+ *   Purpose   
+ *   =======   
+ *
+ *   ZGSRFS improves the computed solution to a system of linear   
+ *   equations and provides error bounds and backward error estimates for 
+ *   the solution.   
+ *
+ *   If equilibration was performed, the system becomes:
+ *           (diag(R)*A_original*diag(C)) * X = diag(R)*B_original.
+ *
+ *   See supermatrix.h for the definition of 'SuperMatrix' structure.
+ *
+ *   Arguments   
+ *   =========   
+ *
+ *   trans   (input) char*
+ *           Specifies the form of the system of equations:   
+ *           = 'N':  A * X = B     (No transpose)   
+ *           = 'T':  A**T * X = B  (Transpose)   
+ *           = 'C':  A**H * X = B  (Conjugate transpose = Transpose)
+ *   
+ *   A       (input) SuperMatrix*
+ *           The original matrix A in the system, or the scaled A if
+ *           equilibration was done. The type of A can be:
+ *           Stype = NC, Dtype = _Z, Mtype = GE.
+ *    
+ *   L       (input) SuperMatrix*
+ *	     The factor L from the factorization Pr*A*Pc=L*U. Use
+ *           compressed row subscripts storage for supernodes, 
+ *           i.e., L has types: Stype = SC, Dtype = _Z, Mtype = TRLU.
+ * 
+ *   U       (input) SuperMatrix*
+ *           The factor U from the factorization Pr*A*Pc=L*U as computed by
+ *           zgstrf(). Use column-wise storage scheme, 
+ *           i.e., U has types: Stype = NC, Dtype = _Z, Mtype = TRU.
+ *
+ *   perm_r  (input) int*, dimension (A->nrow)
+ *           Row permutation vector, which defines the permutation matrix Pr;
+ *           perm_r[i] = j means row i of A is in position j in Pr*A.
+ *
+ *   perm_c  (input) int*, dimension (A->ncol)
+ *	     Column permutation vector, which defines the 
+ *           permutation matrix Pc; perm_c[i] = j means column i of A is 
+ *           in position j in A*Pc.
+ *
+ *   equed   (input) Specifies the form of equilibration that was done.
+ *           = 'N': No equilibration.
+ *           = 'R': Row equilibration, i.e., A was premultiplied by diag(R).
+ *           = 'C': Column equilibration, i.e., A was postmultiplied by
+ *                  diag(C).
+ *           = 'B': Both row and column equilibration, i.e., A was replaced 
+ *                  by diag(R)*A*diag(C).
+ *
+ *   R       (input) double*, dimension (A->nrow)
+ *           The row scale factors for A.
+ *           If equed = 'R' or 'B', A is premultiplied by diag(R).
+ *           If equed = 'N' or 'C', R is not accessed.
+ * 
+ *   C       (input) double*, dimension (A->ncol)
+ *           The column scale factors for A.
+ *           If equed = 'C' or 'B', A is postmultiplied by diag(C).
+ *           If equed = 'N' or 'R', C is not accessed.
+ *
+ *   B       (input) SuperMatrix*
+ *           B has types: Stype = DN, Dtype = _Z, Mtype = GE.
+ *           The right hand side matrix B.
+ *           if equed = 'R' or 'B', B is premultiplied by diag(R).
+ *
+ *   X       (input/output) SuperMatrix*
+ *           X has types: Stype = DN, Dtype = _Z, Mtype = GE.
+ *           On entry, the solution matrix X, as computed by zgstrs().
+ *           On exit, the improved solution matrix X.
+ *           if *equed = 'C' or 'B', X should be premultiplied by diag(C)
+ *               in order to obtain the solution to the original system.
+ *
+ *   FERR    (output) double*, dimension (B->ncol)   
+ *           The estimated forward error bound for each solution vector   
+ *           X(j) (the j-th column of the solution matrix X).   
+ *           If XTRUE is the true solution corresponding to X(j), FERR(j) 
+ *           is an estimated upper bound for the magnitude of the largest 
+ *           element in (X(j) - XTRUE) divided by the magnitude of the   
+ *           largest element in X(j).  The estimate is as reliable as   
+ *           the estimate for RCOND, and is almost always a slight   
+ *           overestimate of the true error.
+ *
+ *   BERR    (output) double*, dimension (B->ncol)   
+ *           The componentwise relative backward error of each solution   
+ *           vector X(j) (i.e., the smallest relative change in   
+ *           any element of A or B that makes X(j) an exact solution).
+ *
+ *   info    (output) int*   
+ *           = 0:  successful exit   
+ *            < 0:  if INFO = -i, the i-th argument had an illegal value   
+ *
+ *    Internal Parameters   
+ *    ===================   
+ *
+ *    ITMAX is the maximum number of steps of iterative refinement.   
+ *
+ */  
+
+#define ITMAX 5
+    
+    /* Table of constant values */
+    int    ione = 1;
+    doublecomplex ndone = {-1., 0.};
+    doublecomplex done = {1., 0.};
+    
+    /* Local variables */
+    NCformat *Astore;
+    doublecomplex   *Aval;
+    SuperMatrix Bjcol;
+    DNformat *Bstore, *Xstore, *Bjcol_store;
+    doublecomplex   *Bmat, *Xmat, *Bptr, *Xptr;
+    int      kase;
+    double   safe1, safe2;
+    int      i, j, k, irow, nz, count, notran, rowequ, colequ;
+    int      ldb, ldx, nrhs;
+    double   s, xk, lstres, eps, safmin;
+    char     transt[1];
+    doublecomplex   *work;
+    double   *rwork;
+    int      *iwork;
+    extern double dlamch_(char *);
+    extern int zlacon_(int *, doublecomplex *, doublecomplex *, double *, int *);
+#ifdef _CRAY
+    extern int CCOPY(int *, doublecomplex *, int *, doublecomplex *, int *);
+    extern int CSAXPY(int *, doublecomplex *, doublecomplex *, int *, doublecomplex *, int *);
+#else
+    extern int zcopy_(int *, doublecomplex *, int *, doublecomplex *, int *);
+    extern int zaxpy_(int *, doublecomplex *, doublecomplex *, int *, doublecomplex *, int *);
+#endif
+
+    Astore = A->Store;
+    Aval   = Astore->nzval;
+    Bstore = B->Store;
+    Xstore = X->Store;
+    Bmat   = Bstore->nzval;
+    Xmat   = Xstore->nzval;
+    ldb    = Bstore->lda;
+    ldx    = Xstore->lda;
+    nrhs   = B->ncol;
+    
+    /* Test the input parameters */
+    *info = 0;
+    notran = lsame_(trans, "N");
+    if ( !notran && !lsame_(trans, "T") && !lsame_(trans, "C"))	*info = -1;
+    else if ( A->nrow != A->ncol || A->nrow < 0 ||
+	      A->Stype != NC || A->Dtype != _Z || A->Mtype != GE )
+	*info = -2;
+    else if ( L->nrow != L->ncol || L->nrow < 0 ||
+ 	      L->Stype != SC || L->Dtype != _Z || L->Mtype != TRLU )
+	*info = -3;
+    else if ( U->nrow != U->ncol || U->nrow < 0 ||
+ 	      U->Stype != NC || U->Dtype != _Z || U->Mtype != TRU )
+	*info = -4;
+    else if ( ldb < MAX(0, A->nrow) ||
+ 	      B->Stype != DN || B->Dtype != _Z || B->Mtype != GE )
+        *info = -10;
+    else if ( ldx < MAX(0, A->nrow) ||
+ 	      X->Stype != DN || X->Dtype != _Z || X->Mtype != GE )
+	*info = -11;
+    if (*info != 0) {
+	i = -(*info);
+	xerbla_("zgsrfs", &i);
+	return;
+    }
+
+    /* Quick return if possible */
+    if ( A->nrow == 0 || nrhs == 0) {
+	for (j = 0; j < nrhs; ++j) {
+	    ferr[j] = 0.;
+	    berr[j] = 0.;
+	}
+	return;
+    }
+
+    rowequ = lsame_(equed, "R") || lsame_(equed, "B");
+    colequ = lsame_(equed, "C") || lsame_(equed, "B");
+    
+    /* Allocate working space */
+    work = doublecomplexMalloc(2*A->nrow);
+    rwork = (double *) SUPERLU_MALLOC( A->nrow * sizeof(double) );
+    iwork = intMalloc(A->nrow);
+    if ( !work || !rwork || !iwork ) 
+        ABORT("Malloc fails for work/rwork/iwork.");
+    
+    if ( notran ) {
+	*(unsigned char *)transt = 'T';
+    } else {
+	*(unsigned char *)transt = 'N';
+    }
+
+    /* NZ = maximum number of nonzero elements in each row of A, plus 1 */
+    nz     = A->ncol + 1;
+    eps    = dlamch_("Epsilon");
+    safmin = dlamch_("Safe minimum");
+    safe1  = nz * safmin;
+    safe2  = safe1 / eps;
+
+    /* Compute the number of nonzeros in each row (or column) of A */
+    for (i = 0; i < A->nrow; ++i) iwork[i] = 0;
+    if ( notran ) {
+	for (k = 0; k < A->ncol; ++k)
+	    for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) 
+		++iwork[Astore->rowind[i]];
+    } else {
+	for (k = 0; k < A->ncol; ++k)
+	    iwork[k] = Astore->colptr[k+1] - Astore->colptr[k];
+    }	
+
+    /* Copy one column of RHS B into Bjcol. */
+    Bjcol.Stype = B->Stype;
+    Bjcol.Dtype = B->Dtype;
+    Bjcol.Mtype = B->Mtype;
+    Bjcol.nrow  = B->nrow;
+    Bjcol.ncol  = 1;
+    Bjcol.Store = (void *) SUPERLU_MALLOC( sizeof(DNformat) );
+    if ( !Bjcol.Store ) ABORT("SUPERLU_MALLOC fails for Bjcol.Store");
+    Bjcol_store = Bjcol.Store;
+    Bjcol_store->lda = ldb;
+    Bjcol_store->nzval = work; /* address aliasing */
+	
+    /* Do for each right hand side ... */
+    for (j = 0; j < nrhs; ++j) {
+	count = 0;
+	lstres = 3.;
+	Bptr = &Bmat[j*ldb];
+	Xptr = &Xmat[j*ldx];
+
+	while (1) { /* Loop until stopping criterion is satisfied. */
+
+	    /* Compute residual R = B - op(A) * X,   
+	       where op(A) = A, A**T, or A**H, depending on TRANS. */
+	    
+#ifdef _CRAY
+	    CCOPY(&A->nrow, Bptr, &ione, work, &ione);
+#else
+	    zcopy_(&A->nrow, Bptr, &ione, work, &ione);
+#endif
+	    sp_zgemv(trans, ndone, A, Xptr, ione, done, work, ione);
+
+	    /* Compute componentwise relative backward error from formula 
+	       max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )   
+	       where abs(Z) is the componentwise absolute value of the matrix
+	       or vector Z.  If the i-th component of the denominator is less
+	       than SAFE2, then SAFE1 is added to the i-th component of the   
+	       numerator and denominator before dividing. */
+
+	    for (i = 0; i < A->nrow; ++i) rwork[i] = z_abs1( &Bptr[i] );
+	    
+	    /* Compute abs(op(A))*abs(X) + abs(B). */
+	    if (notran) {
+		for (k = 0; k < A->ncol; ++k) {
+		    xk = z_abs1( &Xptr[k] );
+		    for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i)
+			rwork[Astore->rowind[i]] += z_abs1(&Aval[i]) * xk;
+		}
+	    } else {
+		for (k = 0; k < A->ncol; ++k) {
+		    s = 0.;
+		    for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) {
+			irow = Astore->rowind[i];
+			s += z_abs1(&Aval[i]) * z_abs1(&Xptr[irow]);
+		    }
+		    rwork[k] += s;
+		}
+	    }
+	    s = 0.;
+	    for (i = 0; i < A->nrow; ++i) {
+		if (rwork[i] > safe2)
+		    s = MAX( s, z_abs1(&work[i]) / rwork[i] );
+		else
+		    s = MAX( s, (z_abs1(&work[i]) + safe1) / 
+				(rwork[i] + safe1) );
+	    }
+	    berr[j] = s;
+
+	    /* Test stopping criterion. Continue iterating if   
+	       1) The residual BERR(J) is larger than machine epsilon, and   
+	       2) BERR(J) decreased by at least a factor of 2 during the   
+	          last iteration, and   
+	       3) At most ITMAX iterations tried. */
+
+	    if (berr[j] > eps && berr[j] * 2. <= lstres && count < ITMAX) {
+		/* Update solution and try again. */
+		zgstrs (trans, L, U, perm_r, perm_c, &Bjcol, info);
+		
+#ifdef _CRAY
+		CAXPY(&A->nrow, &done, work, &ione,
+		       &Xmat[j*ldx], &ione);
+#else
+		zaxpy_(&A->nrow, &done, work, &ione,
+		       &Xmat[j*ldx], &ione);
+#endif
+		lstres = berr[j];
+		++count;
+	    } else {
+		break;
+	    }
+        
+	} /* end while */
+
+	/* Bound error from formula:
+	   norm(X - XTRUE) / norm(X) .le. FERR = norm( abs(inv(op(A)))*   
+	   ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)   
+          where   
+            norm(Z) is the magnitude of the largest component of Z   
+            inv(op(A)) is the inverse of op(A)   
+            abs(Z) is the componentwise absolute value of the matrix or
+	       vector Z   
+            NZ is the maximum number of nonzeros in any row of A, plus 1   
+            EPS is machine epsilon   
+
+          The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))   
+          is incremented by SAFE1 if the i-th component of   
+          abs(op(A))*abs(X) + abs(B) is less than SAFE2.   
+
+          Use ZLACON to estimate the infinity-norm of the matrix   
+             inv(op(A)) * diag(W),   
+          where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) */
+	
+	for (i = 0; i < A->nrow; ++i) rwork[i] = z_abs1( &Bptr[i] );
+	
+	/* Compute abs(op(A))*abs(X) + abs(B). */
+	if ( notran ) {
+	    for (k = 0; k < A->ncol; ++k) {
+		xk = z_abs1( &Xptr[k] );
+		for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i)
+		    rwork[Astore->rowind[i]] += z_abs1(&Aval[i]) * xk;
+	    }
+	} else {
+	    for (k = 0; k < A->ncol; ++k) {
+		s = 0.;
+		for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) {
+		    irow = Astore->rowind[i];
+		    xk = z_abs1( &Xptr[irow] );
+		    s += z_abs1(&Aval[i]) * xk;
+		}
+		rwork[k] += s;
+	    }
+	}
+	
+	for (i = 0; i < A->nrow; ++i)
+	    if (rwork[i] > safe2)
+		rwork[i] = z_abs(&work[i]) + (iwork[i]+1)*eps*rwork[i];
+	    else
+		rwork[i] = z_abs(&work[i])+(iwork[i]+1)*eps*rwork[i]+safe1;
+	kase = 0;
+
+	do {
+	    zlacon_(&A->nrow, &work[A->nrow], work,
+		    &ferr[j], &kase);
+	    if (kase == 0) break;
+
+	    if (kase == 1) {
+		/* Multiply by diag(W)*inv(op(A)**T)*(diag(C) or diag(R)). */
+		if ( notran && colequ )
+		    for (i = 0; i < A->ncol; ++i) {
+		        zd_mult(&work[i], &work[i], C[i]);
+	            }
+		else if ( !notran && rowequ )
+		    for (i = 0; i < A->nrow; ++i) {
+		        zd_mult(&work[i], &work[i], R[i]);
+                    }
+
+		zgstrs (transt, L, U, perm_r, perm_c, &Bjcol, info);
+		
+		for (i = 0; i < A->nrow; ++i) {
+		    zd_mult(&work[i], &work[i], rwork[i]);
+	 	}
+	    } else {
+		/* Multiply by (diag(C) or diag(R))*inv(op(A))*diag(W). */
+		for (i = 0; i < A->nrow; ++i) {
+		    zd_mult(&work[i], &work[i], rwork[i]);
+		}
+		
+		zgstrs (trans, L, U, perm_r, perm_c, &Bjcol, info);
+		
+		if ( notran && colequ )
+		    for (i = 0; i < A->ncol; ++i) {
+		        zd_mult(&work[i], &work[i], C[i]);
+		    }
+		else if ( !notran && rowequ )
+		    for (i = 0; i < A->ncol; ++i) {
+		        zd_mult(&work[i], &work[i], R[i]);  
+		    }
+	    }
+	    
+	} while ( kase != 0 );
+
+	/* Normalize error. */
+	lstres = 0.;
+ 	if ( notran && colequ ) {
+	    for (i = 0; i < A->nrow; ++i)
+	    	lstres = MAX( lstres, C[i] * z_abs1( &Xptr[i]) );
+  	} else if ( !notran && rowequ ) {
+	    for (i = 0; i < A->nrow; ++i)
+	    	lstres = MAX( lstres, R[i] * z_abs1( &Xptr[i]) );
+	} else {
+	    for (i = 0; i < A->nrow; ++i)
+	    	lstres = MAX( lstres, z_abs1( &Xptr[i]) );
+	}
+	if ( lstres != 0. )
+	    ferr[j] /= lstres;
+
+    } /* for each RHS j ... */
+    
+    SUPERLU_FREE(work);
+    SUPERLU_FREE(rwork);
+    SUPERLU_FREE(iwork);
+    SUPERLU_FREE(Bjcol.Store);
+
+    return;
+
+} /* zgsrfs */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zgssv.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,196 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include "zsp_defs.h"
+#include "util.h"
+
+void
+zgssv(SuperMatrix *A, int *perm_c, int *perm_r, SuperMatrix *L,
+      SuperMatrix *U, SuperMatrix *B, int *info )
+{
+/*
+ * Purpose
+ * =======
+ *
+ * ZGSSV solves the system of linear equations A*X=B, using the
+ * LU factorization from ZGSTRF. It performs the following steps:
+ *
+ *   1. If A is stored column-wise (A->Stype = NC):
+ *
+ *      1.1. Permute the columns of A, forming A*Pc, where Pc
+ *           is a permutation matrix. For more details of this step, 
+ *           see sp_preorder.c.
+ *
+ *      1.2. Factor A as Pr*A*Pc=L*U with the permutation Pr determined
+ *           by Gaussian elimination with partial pivoting.
+ *           L is unit lower triangular with offdiagonal entries
+ *           bounded by 1 in magnitude, and U is upper triangular.
+ *
+ *      1.3. Solve the system of equations A*X=B using the factored
+ *           form of A.
+ *
+ *   2. If A is stored row-wise (A->Stype = NR), apply the
+ *      above algorithm to the transpose of A:
+ *
+ *      2.1. Permute columns of transpose(A) (rows of A),
+ *           forming transpose(A)*Pc, where Pc is a permutation matrix. 
+ *           For more details of this step, see sp_preorder.c.
+ *
+ *      2.2. Factor A as Pr*transpose(A)*Pc=L*U with the permutation Pr
+ *           determined by Gaussian elimination with partial pivoting.
+ *           L is unit lower triangular with offdiagonal entries
+ *           bounded by 1 in magnitude, and U is upper triangular.
+ *
+ *      2.3. Solve the system of equations A*X=B using the factored
+ *           form of A.
+ *
+ *   See supermatrix.h for the definition of 'SuperMatrix' structure.
+ * 
+ * Arguments
+ * =========
+ *
+ * A       (input) SuperMatrix*
+ *         Matrix A in A*X=B, of dimension (A->nrow, A->ncol). The number
+ *         of linear equations is A->nrow. Currently, the type of A can be:
+ *         Stype = NC or NR; Dtype = _Z; Mtype = GE. In the future, more
+ *         general A will be handled.
+ *
+ * perm_c  (input/output) int*
+ *         If A->Stype = NC, column permutation vector of size A->ncol
+ *         which defines the permutation matrix Pc; perm_c[i] = j means 
+ *         column i of A is in position j in A*Pc.
+ *         On exit, perm_c may be overwritten by the product of the input
+ *         perm_c and a permutation that postorders the elimination tree
+ *         of Pc'*A'*A*Pc; perm_c is not changed if the elimination tree
+ *         is already in postorder.
+ *
+ *         If A->Stype = NR, column permutation vector of size A->nrow
+ *         which describes permutation of columns of transpose(A) 
+ *         (rows of A) as described above.
+ * 
+ * perm_r  (output) int*
+ *         If A->Stype = NC, row permutation vector of size A->nrow, 
+ *         which defines the permutation matrix Pr, and is determined 
+ *         by partial pivoting.  perm_r[i] = j means row i of A is in 
+ *         position j in Pr*A.
+ *
+ *         If A->Stype = NR, permutation vector of size A->ncol, which
+ *         determines permutation of rows of transpose(A)
+ *         (columns of A) as described above.
+ *
+ * L       (output) SuperMatrix*
+ *         The factor L from the factorization 
+ *             Pr*A*Pc=L*U              (if A->Stype = NC) or
+ *             Pr*transpose(A)*Pc=L*U   (if A->Stype = NR).
+ *         Uses compressed row subscripts storage for supernodes, i.e.,
+ *         L has types: Stype = SC, Dtype = _Z, Mtype = TRLU.
+ *         
+ * U       (output) SuperMatrix*
+ *	   The factor U from the factorization 
+ *             Pr*A*Pc=L*U              (if A->Stype = NC) or
+ *             Pr*transpose(A)*Pc=L*U   (if A->Stype = NR).
+ *         Uses column-wise storage scheme, i.e., U has types:
+ *         Stype = NC, Dtype = _Z, Mtype = TRU.
+ *
+ * B       (input/output) SuperMatrix*
+ *         B has types: Stype = DN, Dtype = _Z, Mtype = GE.
+ *         On entry, the right hand side matrix.
+ *         On exit, the solution matrix if info = 0;
+ *
+ * info    (output) int*
+ *	   = 0: successful exit
+ *         > 0: if info = i, and i is
+ *             <= A->ncol: U(i,i) is exactly zero. The factorization has
+ *                been completed, but the factor U is exactly singular,
+ *                so the solution could not be computed.
+ *             > A->ncol: number of bytes allocated when memory allocation
+ *                failure occurred, plus A->ncol.
+ *   
+ */
+    double   t1;	/* Temporary time */
+    char     refact[1], trans[1];
+    DNformat *Bstore;
+    SuperMatrix *AA; /* A in NC format used by the factorization routine.*/
+    SuperMatrix AC; /* Matrix postmultiplied by Pc */
+    int      lwork = 0, *etree, i;
+    
+    /* Set default values for some parameters */
+    double   diag_pivot_thresh = 1.0;
+    double   drop_tol = 0;
+    int      panel_size;     /* panel size */
+    int      relax;          /* no of columns in a relaxed snodes */
+    double   *utime;
+    extern SuperLUStat_t SuperLUStat;
+
+    /* Test the input parameters ... */
+    *info = 0;
+    Bstore = B->Store;
+    if ( A->nrow != A->ncol || A->nrow < 0 ||
+	 (A->Stype != NC && A->Stype != NR) ||
+	 A->Dtype != _Z || A->Mtype != GE )
+	*info = -1;
+    else if ( B->ncol < 0 || Bstore->lda < MAX(0, A->nrow) ||
+	B->Stype != DN || B->Dtype != _Z || B->Mtype != GE )
+	*info = -6;
+    if ( *info != 0 ) {
+	i = -(*info);
+	xerbla_("zgssv", &i);
+	return;
+    }
+    
+    *refact = 'N';
+    *trans = 'N';
+    panel_size = sp_ienv(1);
+    relax = sp_ienv(2);
+
+    StatInit(panel_size, relax);
+    utime = SuperLUStat.utime;
+ 
+    /* Convert A to NC format when necessary. */
+    if ( A->Stype == NR ) {
+	NRformat *Astore = A->Store;
+	AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
+	zCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz, 
+			       Astore->nzval, Astore->colind, Astore->rowptr,
+			       NC, A->Dtype, A->Mtype);
+	*trans = 'T';
+    } else if ( A->Stype == NC ) AA = A;
+
+    etree = intMalloc(A->ncol);
+
+    t1 = SuperLU_timer_();
+    sp_preorder(refact, AA, perm_c, etree, &AC);
+    utime[ETREE] = SuperLU_timer_() - t1;
+
+    /*printf("Factor PA = LU ... relax %d\tw %d\tmaxsuper %d\trowblk %d\n", 
+	  relax, panel_size, sp_ienv(3), sp_ienv(4));*/
+    t1 = SuperLU_timer_(); 
+    /* Compute the LU factorization of A. */
+    zgstrf(refact, &AC, diag_pivot_thresh, drop_tol, relax, panel_size,
+	   etree, NULL, lwork, perm_r, perm_c, L, U, info);
+    utime[FACT] = SuperLU_timer_() - t1;
+
+    t1 = SuperLU_timer_();
+    if ( *info == 0 ) {
+        /* Solve the system A*X=B, overwriting B with X. */
+        zgstrs (trans, L, U, perm_r, perm_c, B, info);
+    }
+    utime[SOLVE] = SuperLU_timer_() - t1;
+
+    SUPERLU_FREE (etree);
+    Destroy_CompCol_Permuted(&AC);
+    if ( A->Stype == NR ) {
+	Destroy_SuperMatrix_Store(AA);
+	SUPERLU_FREE(AA);
+    }
+
+    PrintStat( &SuperLUStat );
+    StatFree();
+
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zgssvx.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,624 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include "zsp_defs.h"
+#include "util.h"
+
+void
+zgssvx(char *fact, char *trans, char *refact,
+       SuperMatrix *A, factor_param_t *factor_params, int *perm_c,
+       int *perm_r, int *etree, char *equed, double *R, double *C,
+       SuperMatrix *L, SuperMatrix *U, void *work, int lwork,
+       SuperMatrix *B, SuperMatrix *X, double *recip_pivot_growth, 
+       double *rcond, double *ferr, double *berr, 
+       mem_usage_t *mem_usage, int *info )
+{
+/*
+ * Purpose
+ * =======
+ *
+ * ZGSSVX solves the system of linear equations A*X=B or A'*X=B, using
+ * the LU factorization from zgstrf(). Error bounds on the solution and
+ * a condition estimate are also provided. It performs the following steps:
+ *
+ *   1. If A is stored column-wise (A->Stype = NC):
+ *  
+ *      1.1. If fact = 'E', scaling factors are computed to equilibrate the
+ *           system:
+ *             trans = 'N':  diag(R)*A*diag(C)     *inv(diag(C))*X = diag(R)*B
+ *             trans = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
+ *             trans = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
+ *           Whether or not the system will be equilibrated depends on the
+ *           scaling of the matrix A, but if equilibration is used, A is
+ *           overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if trans='N')
+ *           or diag(C)*B (if trans = 'T' or 'C').
+ *
+ *      1.2. Permute columns of A, forming A*Pc, where Pc is a permutation
+ *           matrix that usually preserves sparsity.
+ *           For more details of this step, see sp_preorder.c.
+ *
+ *      1.3. If fact = 'N' or 'E', the LU decomposition is used to factor the
+ *           matrix A (after equilibration if fact = 'E') as Pr*A*Pc = L*U,
+ *           with Pr determined by partial pivoting.
+ *
+ *      1.4. Compute the reciprocal pivot growth factor.
+ *
+ *      1.5. If some U(i,i) = 0, so that U is exactly singular, then the
+ *           routine returns with info = i. Otherwise, the factored form of 
+ *           A is used to estimate the condition number of the matrix A. If
+ *           the reciprocal of the condition number is less than machine
+ *           precision, info = A->ncol+1 is returned as a warning, but the
+ *           routine still goes on to solve for X and computes error bounds
+ *           as described below.
+ *
+ *      1.6. The system of equations is solved for X using the factored form
+ *           of A.
+ *
+ *      1.7. Iterative refinement is applied to improve the computed solution
+ *           matrix and calculate error bounds and backward error estimates
+ *           for it.
+ *
+ *      1.8. If equilibration was used, the matrix X is premultiplied by
+ *           diag(C) (if trans = 'N') or diag(R) (if trans = 'T' or 'C') so
+ *           that it solves the original system before equilibration.
+ *
+ *   2. If A is stored row-wise (A->Stype = NR), apply the above algorithm
+ *      to the transpose of A:
+ *
+ *      2.1. If fact = 'E', scaling factors are computed to equilibrate the
+ *           system:
+ *             trans = 'N':  diag(R)*A'*diag(C)     *inv(diag(C))*X = diag(R)*B
+ *             trans = 'T': (diag(R)*A'*diag(C))**T *inv(diag(R))*X = diag(C)*B
+ *             trans = 'C': (diag(R)*A'*diag(C))**H *inv(diag(R))*X = diag(C)*B
+ *           Whether or not the system will be equilibrated depends on the
+ *           scaling of the matrix A, but if equilibration is used, A' is
+ *           overwritten by diag(R)*A'*diag(C) and B by diag(R)*B 
+ *           (if trans='N') or diag(C)*B (if trans = 'T' or 'C').
+ *
+ *      2.2. Permute columns of transpose(A) (rows of A), 
+ *           forming transpose(A)*Pc, where Pc is a permutation matrix that 
+ *           usually preserves sparsity.
+ *           For more details of this step, see sp_preorder.c.
+ *
+ *      2.3. If fact = 'N' or 'E', the LU decomposition is used to factor the
+ *           transpose(A) (after equilibration if fact = 'E') as 
+ *           Pr*transpose(A)*Pc = L*U with the permutation Pr determined by
+ *           partial pivoting.
+ *
+ *      2.4. Compute the reciprocal pivot growth factor.
+ *
+ *      2.5. If some U(i,i) = 0, so that U is exactly singular, then the
+ *           routine returns with info = i. Otherwise, the factored form 
+ *           of transpose(A) is used to estimate the condition number of the
+ *           matrix A. If the reciprocal of the condition number
+ *           is less than machine precision, info = A->nrow+1 is returned as
+ *           a warning, but the routine still goes on to solve for X and
+ *           computes error bounds as described below.
+ *
+ *      2.6. The system of equations is solved for X using the factored form
+ *           of transpose(A).
+ *
+ *      2.7. Iterative refinement is applied to improve the computed solution
+ *           matrix and calculate error bounds and backward error estimates
+ *           for it.
+ *
+ *      2.8. If equilibration was used, the matrix X is premultiplied by
+ *           diag(C) (if trans = 'N') or diag(R) (if trans = 'T' or 'C') so
+ *           that it solves the original system before equilibration.
+ *
+ *   See supermatrix.h for the definition of 'SuperMatrix' structure.
+ *
+ * Arguments
+ * =========
+ *
+ * fact    (input) char*
+ *         Specifies whether or not the factored form of the matrix
+ *         A is supplied on entry, and if not, whether the matrix A should
+ *         be equilibrated before it is factored.
+ *         = 'F': On entry, L, U, perm_r and perm_c contain the factored
+ *                form of A. If equed is not 'N', the matrix A has been
+ *                equilibrated with scaling factors R and C.
+ *                A, L, U, perm_r are not modified.
+ *         = 'N': The matrix A will be factored, and the factors will be
+ *                stored in L and U.
+ *         = 'E': The matrix A will be equilibrated if necessary, then
+ *                factored into L and U.
+ *
+ * trans   (input) char*
+ *         Specifies the form of the system of equations:
+ *         = 'N': A * X = B        (No transpose)
+ *         = 'T': A**T * X = B     (Transpose)
+ *         = 'C': A**H * X = B     (Transpose)
+ *
+ * refact  (input) char*
+ *         Specifies whether we want to re-factor the matrix.
+ *         = 'N': Factor the matrix A.
+ *         = 'Y': Matrix A was factored before, now we want to re-factor
+ *                matrix A with perm_r and etree as inputs. Use
+ *                the same storage for the L\U factors previously allocated,
+ *                expand it if necessary. User should insure to use the same
+ *                memory model.
+ *         If fact = 'F', then refact is not accessed.
+ *
+ * A       (input/output) SuperMatrix*
+ *         Matrix A in A*X=B, of dimension (A->nrow, A->ncol). The number
+ *         of the linear equations is A->nrow. Currently, the type of A can be:
+ *         Stype = NC or NR, Dtype = _Z, Mtype = GE. In the future,
+ *         more general A can be handled.
+ *
+ *         On entry, If fact = 'F' and equed is not 'N', then A must have
+ *         been equilibrated by the scaling factors in R and/or C.  
+ *         A is not modified if fact = 'F' or 'N', or if fact = 'E' and 
+ *         equed = 'N' on exit.
+ *
+ *         On exit, if fact = 'E' and equed is not 'N', A is scaled as follows:
+ *         If A->Stype = NC:
+ *           equed = 'R':  A := diag(R) * A
+ *           equed = 'C':  A := A * diag(C)
+ *           equed = 'B':  A := diag(R) * A * diag(C).
+ *         If A->Stype = NR:
+ *           equed = 'R':  transpose(A) := diag(R) * transpose(A)
+ *           equed = 'C':  transpose(A) := transpose(A) * diag(C)
+ *           equed = 'B':  transpose(A) := diag(R) * transpose(A) * diag(C).
+ *
+ * factor_params (input) factor_param_t*
+ *         The structure defines the input scalar parameters, consisting of
+ *         the following fields. If factor_params = NULL, the default
+ *         values are used for all the fields; otherwise, the values
+ *         are given by the user.
+ *         - panel_size (int): Panel size. A panel consists of at most
+ *             panel_size consecutive columns. If panel_size = -1, use 
+ *             default value 8.
+ *         - relax (int): To control degree of relaxing supernodes. If the
+ *             number of nodes (columns) in a subtree of the elimination
+ *             tree is less than relax, this subtree is considered as one
+ *             supernode, regardless of the row structures of those columns.
+ *             If relax = -1, use default value 8.
+ *         - diag_pivot_thresh (double): Diagonal pivoting threshold.
+ *             At step j of the Gaussian elimination, if
+ *                 abs(A_jj) >= diag_pivot_thresh * (max_(i>=j) abs(A_ij)),
+ *             then use A_jj as pivot. 0 <= diag_pivot_thresh <= 1.
+ *             If diag_pivot_thresh = -1, use default value 1.0,
+ *             which corresponds to standard partial pivoting.
+ *         - drop_tol (double): Drop tolerance threshold. (NOT IMPLEMENTED)
+ *             At step j of the Gaussian elimination, if
+ *                 abs(A_ij)/(max_i abs(A_ij)) < drop_tol,
+ *             then drop entry A_ij. 0 <= drop_tol <= 1.
+ *             If drop_tol = -1, use default value 0.0, which corresponds to
+ *             standard Gaussian elimination.
+ *
+ * perm_c  (input/output) int*
+ *	   If A->Stype = NC, Column permutation vector of size A->ncol,
+ *         which defines the permutation matrix Pc; perm_c[i] = j means
+ *         column i of A is in position j in A*Pc.
+ *         On exit, perm_c may be overwritten by the product of the input
+ *         perm_c and a permutation that postorders the elimination tree
+ *         of Pc'*A'*A*Pc; perm_c is not changed if the elimination tree
+ *         is already in postorder.
+ *
+ *         If A->Stype = NR, column permutation vector of size A->nrow,
+ *         which describes permutation of columns of transpose(A) 
+ *         (rows of A) as described above.
+ * 
+ * perm_r  (input/output) int*
+ *         If A->Stype = NC, row permutation vector of size A->nrow, 
+ *         which defines the permutation matrix Pr, and is determined
+ *         by partial pivoting.  perm_r[i] = j means row i of A is in 
+ *         position j in Pr*A.
+ *
+ *         If A->Stype = NR, permutation vector of size A->ncol, which
+ *         determines permutation of rows of transpose(A)
+ *         (columns of A) as described above.
+ *
+ *         If refact is not 'Y', perm_r is output argument;
+ *         If refact = 'Y', the pivoting routine will try to use the input
+ *         perm_r, unless a certain threshold criterion is violated.
+ *         In that case, perm_r is overwritten by a new permutation
+ *         determined by partial pivoting or diagonal threshold pivoting.
+ * 
+ * etree   (input/output) int*,  dimension (A->ncol)
+ *         Elimination tree of Pc'*A'*A*Pc.
+ *         If fact is not 'F' and refact = 'Y', etree is an input argument,
+ *         otherwise it is an output argument.
+ *         Note: etree is a vector of parent pointers for a forest whose
+ *         vertices are the integers 0 to A->ncol-1; etree[root]==A->ncol.
+ *
+ * equed   (input/output) char*
+ *         Specifies the form of equilibration that was done.
+ *         = 'N': No equilibration.
+ *         = 'R': Row equilibration, i.e., A was premultiplied by diag(R).
+ *         = 'C': Column equilibration, i.e., A was postmultiplied by diag(C).
+ *         = 'B': Both row and column equilibration, i.e., A was replaced 
+ *                by diag(R)*A*diag(C).
+ *         If fact = 'F', equed is an input argument, otherwise it is
+ *         an output argument.
+ *
+ * R       (input/output) double*, dimension (A->nrow)
+ *         The row scale factors for A or transpose(A).
+ *         If equed = 'R' or 'B', A (if A->Stype = NC) or transpose(A) (if
+ *             A->Stype = NR) is multiplied on the left by diag(R).
+ *         If equed = 'N' or 'C', R is not accessed.
+ *         If fact = 'F', R is an input argument; otherwise, R is output.
+ *         If fact = 'F' and equed = 'R' or 'B', each element of R must
+ *            be positive.
+ * 
+ * C       (input/output) double*, dimension (A->ncol)
+ *         The column scale factors for A or transpose(A).
+ *         If equed = 'C' or 'B', A (if A->Stype = NC) or transpose(A) (if 
+ *             A->Stype = NR) is multiplied on the right by diag(C).
+ *         If equed = 'N' or 'R', C is not accessed.
+ *         If fact = 'F', C is an input argument; otherwise, C is output.
+ *         If fact = 'F' and equed = 'C' or 'B', each element of C must
+ *            be positive.
+ *         
+ * L       (output) SuperMatrix*
+ *	   The factor L from the factorization
+ *             Pr*A*Pc=L*U              (if A->Stype = NC) or
+ *             Pr*transpose(A)*Pc=L*U   (if A->Stype = NR).
+ *         Uses compressed row subscripts storage for supernodes, i.e.,
+ *         L has types: Stype = SC, Dtype = _Z, Mtype = TRLU.
+ *
+ * U       (output) SuperMatrix*
+ *	   The factor U from the factorization
+ *             Pr*A*Pc=L*U              (if A->Stype = NC) or
+ *             Pr*transpose(A)*Pc=L*U   (if A->Stype = NR).
+ *         Uses column-wise storage scheme, i.e., U has types:
+ *         Stype = NC, Dtype = _Z, Mtype = TRU.
+ *
+ * work    (workspace/output) void*, size (lwork) (in bytes)
+ *         User supplied workspace, should be large enough
+ *         to hold data structures for factors L and U.
+ *         On exit, if fact is not 'F', L and U point to this array.
+ *
+ * lwork   (input) int
+ *         Specifies the size of work array in bytes.
+ *         = 0:  allocate space internally by system malloc;
+ *         > 0:  use user-supplied work array of length lwork in bytes,
+ *               returns error if space runs out.
+ *         = -1: the routine guesses the amount of space needed without
+ *               performing the factorization, and returns it in
+ *               mem_usage->total_needed; no other side effects.
+ *
+ *         See argument 'mem_usage' for memory usage statistics.
+ *
+ * B       (input/output) SuperMatrix*
+ *         B has types: Stype = DN, Dtype = _Z, Mtype = GE.
+ *         On entry, the right hand side matrix.
+ *         On exit,
+ *            if equed = 'N', B is not modified; otherwise
+ *            if A->Stype = NC:
+ *               if trans = 'N' and equed = 'R' or 'B', B is overwritten by
+ *                  diag(R)*B;
+ *               if trans = 'T' or 'C' and equed = 'C' of 'B', B is
+ *                  overwritten by diag(C)*B;
+ *            if A->Stype = NR:
+ *               if trans = 'N' and equed = 'C' or 'B', B is overwritten by
+ *                  diag(C)*B;
+ *               if trans = 'T' or 'C' and equed = 'R' of 'B', B is
+ *                  overwritten by diag(R)*B.
+ *
+ * X       (output) SuperMatrix*
+ *         X has types: Stype = DN, Dtype = _Z, Mtype = GE. 
+ *         If info = 0 or info = A->ncol+1, X contains the solution matrix
+ *         to the original system of equations. Note that A and B are modified
+ *         on exit if equed is not 'N', and the solution to the equilibrated
+ *         system is inv(diag(C))*X if trans = 'N' and equed = 'C' or 'B',
+ *         or inv(diag(R))*X if trans = 'T' or 'C' and equed = 'R' or 'B'.
+ *
+ * recip_pivot_growth (output) double*
+ *         The reciprocal pivot growth factor max_j( norm(A_j)/norm(U_j) ).
+ *         The infinity norm is used. If recip_pivot_growth is much less
+ *         than 1, the stability of the LU factorization could be poor.
+ *
+ * rcond   (output) double*
+ *         The estimate of the reciprocal condition number of the matrix A
+ *         after equilibration (if done). If rcond is less than the machine
+ *         precision (in particular, if rcond = 0), the matrix is singular
+ *         to working precision. This condition is indicated by a return
+ *         code of info > 0.
+ *
+ * FERR    (output) double*, dimension (B->ncol)   
+ *         The estimated forward error bound for each solution vector   
+ *         X(j) (the j-th column of the solution matrix X).   
+ *         If XTRUE is the true solution corresponding to X(j), FERR(j) 
+ *         is an estimated upper bound for the magnitude of the largest 
+ *         element in (X(j) - XTRUE) divided by the magnitude of the   
+ *         largest element in X(j).  The estimate is as reliable as   
+ *         the estimate for RCOND, and is almost always a slight   
+ *         overestimate of the true error.
+ *
+ * BERR    (output) double*, dimension (B->ncol)
+ *         The componentwise relative backward error of each solution   
+ *         vector X(j) (i.e., the smallest relative change in   
+ *         any element of A or B that makes X(j) an exact solution).
+ *
+ * mem_usage (output) mem_usage_t*
+ *         Record the memory usage statistics, consisting of following fields:
+ *         - for_lu (float)
+ *           The amount of space used in bytes for L\U data structures.
+ *         - total_needed (float)
+ *           The amount of space needed in bytes to perform factorization.
+ *         - expansions (int)
+ *           The number of memory expansions during the LU factorization.
+ *
+ * info    (output) int*
+ *         = 0: successful exit   
+ *         < 0: if info = -i, the i-th argument had an illegal value   
+ *         > 0: if info = i, and i is   
+ *              <= A->ncol: U(i,i) is exactly zero. The factorization has   
+ *                    been completed, but the factor U is exactly   
+ *                    singular, so the solution and error bounds   
+ *                    could not be computed.   
+ *              = A->ncol+1: U is nonsingular, but RCOND is less than machine
+ *                    precision, meaning that the matrix is singular to
+ *                    working precision. Nevertheless, the solution and
+ *                    error bounds are computed because there are a number
+ *                    of situations where the computed solution can be more
+ *                    accurate than the value of RCOND would suggest.   
+ *              > A->ncol+1: number of bytes allocated when memory allocation
+ *                    failure occurred, plus A->ncol.
+ *
+ */
+
+    DNformat  *Bstore, *Xstore;
+    doublecomplex    *Bmat, *Xmat;
+    int       ldb, ldx, nrhs;
+    SuperMatrix *AA; /* A in NC format used by the factorization routine.*/
+    SuperMatrix AC; /* Matrix postmultiplied by Pc */
+    int       colequ, equil, nofact, notran, rowequ;
+    char      trant[1], norm[1];
+    int       i, j, info1;
+    double    amax, anorm, bignum, smlnum, colcnd, rowcnd, rcmax, rcmin;
+    int       relax, panel_size;
+    double    diag_pivot_thresh, drop_tol;
+    double    t0;      /* temporary time */
+    double    *utime;
+    extern SuperLUStat_t SuperLUStat;
+
+    /* External functions */
+    extern double zlangs(char *, SuperMatrix *);
+    extern double dlamch_(char *);
+
+    Bstore = B->Store;
+    Xstore = X->Store;
+    Bmat   = Bstore->nzval;
+    Xmat   = Xstore->nzval;
+    ldb    = Bstore->lda;
+    ldx    = Xstore->lda;
+    nrhs   = B->ncol;
+
+#if 0
+printf("zgssvx: fact=%c, trans=%c, refact=%c, equed=%c\n",
+       *fact, *trans, *refact, *equed);
+#endif
+    
+    *info = 0;
+    nofact = lsame_(fact, "N");
+    equil = lsame_(fact, "E");
+    notran = lsame_(trans, "N");
+    if (nofact || equil) {
+	*(unsigned char *)equed = 'N';
+	rowequ = FALSE;
+	colequ = FALSE;
+    } else {
+	rowequ = lsame_(equed, "R") || lsame_(equed, "B");
+	colequ = lsame_(equed, "C") || lsame_(equed, "B");
+	smlnum = dlamch_("Safe minimum");
+	bignum = 1. / smlnum;
+    }
+
+    /* Test the input parameters */
+    if (!nofact && !equil && !lsame_(fact, "F")) *info = -1;
+    else if (!notran && !lsame_(trans, "T") && !lsame_(trans, "C")) *info = -2;
+    else if ( !(lsame_(refact,"Y") || lsame_(refact, "N")) ) *info = -3;
+    else if ( A->nrow != A->ncol || A->nrow < 0 ||
+	      (A->Stype != NC && A->Stype != NR) ||
+	      A->Dtype != _Z || A->Mtype != GE )
+	*info = -4;
+    else if (lsame_(fact, "F") && !(rowequ || colequ || lsame_(equed, "N")))
+	*info = -9;
+    else {
+	if (rowequ) {
+	    rcmin = bignum;
+	    rcmax = 0.;
+	    for (j = 0; j < A->nrow; ++j) {
+		rcmin = MIN(rcmin, R[j]);
+		rcmax = MAX(rcmax, R[j]);
+	    }
+	    if (rcmin <= 0.) *info = -10;
+	    else if ( A->nrow > 0)
+		rowcnd = MAX(rcmin,smlnum) / MIN(rcmax,bignum);
+	    else rowcnd = 1.;
+	}
+	if (colequ && *info == 0) {
+	    rcmin = bignum;
+	    rcmax = 0.;
+	    for (j = 0; j < A->nrow; ++j) {
+		rcmin = MIN(rcmin, C[j]);
+		rcmax = MAX(rcmax, C[j]);
+	    }
+	    if (rcmin <= 0.) *info = -11;
+	    else if (A->nrow > 0)
+		colcnd = MAX(rcmin,smlnum) / MIN(rcmax,bignum);
+	    else colcnd = 1.;
+	}
+	if (*info == 0) {
+	    if ( lwork < -1 ) *info = -15;
+	    else if ( B->ncol < 0 || Bstore->lda < MAX(0, A->nrow) ||
+		      B->Stype != DN || B->Dtype != _Z || 
+		      B->Mtype != GE )
+		*info = -16;
+	    else if ( X->ncol < 0 || Xstore->lda < MAX(0, A->nrow) ||
+		      B->ncol != X->ncol || X->Stype != DN ||
+		      X->Dtype != _Z || X->Mtype != GE )
+		*info = -17;
+	}
+    }
+    if (*info != 0) {
+	i = -(*info);
+	xerbla_("zgssvx", &i);
+	return;
+    }
+    
+    /* Default values for factor_params */
+    panel_size = sp_ienv(1);
+    relax      = sp_ienv(2);
+    diag_pivot_thresh = 1.0;
+    drop_tol   = 0.0;
+    if ( factor_params != NULL ) {
+	if ( factor_params->panel_size != -1 )
+	    panel_size = factor_params->panel_size;
+	if ( factor_params->relax != -1 ) relax = factor_params->relax;
+	if ( factor_params->diag_pivot_thresh != -1 )
+	    diag_pivot_thresh = factor_params->diag_pivot_thresh;
+	if ( factor_params->drop_tol != -1 )
+	    drop_tol = factor_params->drop_tol;
+    }
+
+    StatInit(panel_size, relax);
+    utime = SuperLUStat.utime;
+    
+    /* Convert A to NC format when necessary. */
+    if ( A->Stype == NR ) {
+	NRformat *Astore = A->Store;
+	AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
+	zCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz, 
+			       Astore->nzval, Astore->colind, Astore->rowptr,
+			       NC, A->Dtype, A->Mtype);
+	if ( notran ) { /* Reverse the transpose argument. */
+	    *trant = 'T';
+	    notran = 0;
+	} else {
+	    *trant = 'N';
+	    notran = 1;
+	}
+    } else { /* A->Stype == NC */
+	*trant = *trans;
+	AA = A;
+    }
+
+    if ( equil ) {
+	t0 = SuperLU_timer_();
+	/* Compute row and column scalings to equilibrate the matrix A. */
+	zgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);
+	
+	if ( info1 == 0 ) {
+	    /* Equilibrate matrix A. */
+	    zlaqgs(AA, R, C, rowcnd, colcnd, amax, equed);
+	    rowequ = lsame_(equed, "R") || lsame_(equed, "B");
+	    colequ = lsame_(equed, "C") || lsame_(equed, "B");
+	}
+	utime[EQUIL] = SuperLU_timer_() - t0;
+    }
+
+    /* Scale the right hand side if equilibration was performed. */
+    if ( notran ) {
+	if ( rowequ ) {
+	    for (j = 0; j < nrhs; ++j)
+		for (i = 0; i < A->nrow; ++i) {
+                  zd_mult(&Bmat[i + j*ldb], &Bmat[i + j*ldb], R[i]);
+	        }
+	}
+    } else if ( colequ ) {
+	for (j = 0; j < nrhs; ++j)
+	    for (i = 0; i < A->nrow; ++i) {
+              zd_mult(&Bmat[i + j*ldb], &Bmat[i + j*ldb], C[i]);
+	    }
+    }
+
+    if ( nofact || equil ) {
+	
+	t0 = SuperLU_timer_();
+	sp_preorder(refact, AA, perm_c, etree, &AC);
+	utime[ETREE] = SuperLU_timer_() - t0;
+    
+/*	printf("Factor PA = LU ... relax %d\tw %d\tmaxsuper %d\trowblk %d\n", 
+	       relax, panel_size, sp_ienv(3), sp_ienv(4));
+	fflush(stdout); */
+	
+	/* Compute the LU factorization of A*Pc. */
+	t0 = SuperLU_timer_();
+	zgstrf(refact, &AC, diag_pivot_thresh, drop_tol, relax, panel_size,
+	       etree, work, lwork, perm_r, perm_c, L, U, info);
+	utime[FACT] = SuperLU_timer_() - t0;
+	
+	if ( lwork == -1 ) {
+	    mem_usage->total_needed = *info - A->ncol;
+	    return;
+	}
+    }
+
+    if ( *info > 0 ) {
+	if ( *info <= A->ncol ) {
+	    /* Compute the reciprocal pivot growth factor of the leading
+	       rank-deficient *info columns of A. */
+	    *recip_pivot_growth = zPivotGrowth(*info, AA, perm_c, L, U);
+	}
+	return;
+    }
+
+    /* Compute the reciprocal pivot growth factor *recip_pivot_growth. */
+    *recip_pivot_growth = zPivotGrowth(A->ncol, AA, perm_c, L, U);
+
+    /* Estimate the reciprocal of the condition number of A. */
+    t0 = SuperLU_timer_();
+    if ( notran ) {
+	*(unsigned char *)norm = '1';
+    } else {
+	*(unsigned char *)norm = 'I';
+    }
+    anorm = zlangs(norm, AA);
+    zgscon(norm, L, U, anorm, rcond, info);
+    utime[RCOND] = SuperLU_timer_() - t0;
+    
+    /* Compute the solution matrix X. */
+    for (j = 0; j < nrhs; j++)    /* Save a copy of the right hand sides */
+	for (i = 0; i < B->nrow; i++)
+	    Xmat[i + j*ldx] = Bmat[i + j*ldb];
+    
+    t0 = SuperLU_timer_();
+    zgstrs (trant, L, U, perm_r, perm_c, X, info);
+    utime[SOLVE] = SuperLU_timer_() - t0;
+    
+    /* Use iterative refinement to improve the computed solution and compute
+       error bounds and backward error estimates for it. */
+    t0 = SuperLU_timer_();
+    zgsrfs(trant, AA, L, U, perm_r, perm_c, equed, R, C, B,
+	      X, ferr, berr, info);
+    utime[REFINE] = SuperLU_timer_() - t0;
+
+    /* Transform the solution matrix X to a solution of the original system. */
+    if ( notran ) {
+	if ( colequ ) {
+	    for (j = 0; j < nrhs; ++j)
+		for (i = 0; i < A->nrow; ++i) {
+                  zd_mult(&Xmat[i + j*ldx], &Xmat[i + j*ldx], C[i]);
+	        }
+	}
+    } else if ( rowequ ) {
+	for (j = 0; j < nrhs; ++j)
+	    for (i = 0; i < A->nrow; ++i) {
+              zd_mult(&Xmat[i+ j*ldx], &Xmat[i+ j*ldx], R[i]);
+            }
+    }
+
+    /* Set INFO = A->ncol+1 if the matrix is singular to working precision. */
+    if ( *rcond < dlamch_("E") ) *info = A->ncol + 1;
+
+    zQuerySpace(L, U, panel_size, mem_usage);
+
+    if ( nofact || equil ) Destroy_CompCol_Permuted(&AC);
+    if ( A->Stype == NR ) {
+	Destroy_SuperMatrix_Store(AA);
+	SUPERLU_FREE(AA);
+    }
+
+    PrintStat( &SuperLUStat );
+    StatFree();
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zgstrf.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,415 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "zsp_defs.h"
+#include "util.h"
+
+void
+zgstrf (char *refact, SuperMatrix *A, double diag_pivot_thresh, 
+	double drop_tol, int relax, int panel_size, int *etree, 
+	void *work, int lwork, int *perm_r, int *perm_c, 
+	SuperMatrix *L, SuperMatrix *U, int *info)
+{
+/*
+ * Purpose
+ * =======
+ *
+ * ZGSTRF computes an LU factorization of a general sparse m-by-n
+ * matrix A using partial pivoting with row interchanges.
+ * The factorization has the form
+ *     Pr * A = L * U
+ * where Pr is a row permutation matrix, L is lower triangular with unit
+ * diagonal elements (lower trapezoidal if A->nrow > A->ncol), and U is upper 
+ * triangular (upper trapezoidal if A->nrow < A->ncol).
+ *
+ * See supermatrix.h for the definition of 'SuperMatrix' structure.
+ *
+ * Arguments
+ * =========
+ *
+ * refact (input) char*
+ *          Specifies whether we want to use perm_r from a previous factor.
+ *          = 'Y': re-use perm_r; perm_r is input, unchanged on exit.
+ *          = 'N': perm_r is determined by partial pivoting, and output.
+ *
+ * A        (input) SuperMatrix*
+ *	    Original matrix A, permuted by columns, of dimension
+ *          (A->nrow, A->ncol). The type of A can be:
+ *          Stype = NCP; Dtype = D; Mtype = GE.
+ *
+ * diag_pivot_thresh (input) double
+ *	    Diagonal pivoting threshold. At step j of the Gaussian elimination,
+ *          if abs(A_jj) >= thresh * (max_(i>=j) abs(A_ij)), use A_jj as pivot.
+ *	    0 <= thresh <= 1. The default value of thresh is 1, corresponding
+ *          to partial pivoting.
+ *
+ * drop_tol (input) double (NOT IMPLEMENTED)
+ *	    Drop tolerance parameter. At step j of the Gaussian elimination,
+ *          if abs(A_ij)/(max_i abs(A_ij)) < drop_tol, drop entry A_ij.
+ *          0 <= drop_tol <= 1. The default value of drop_tol is 0.
+ *
+ * relax    (input) int
+ *          To control degree of relaxing supernodes. If the number
+ *          of nodes (columns) in a subtree of the elimination tree is less
+ *          than relax, this subtree is considered as one supernode,
+ *          regardless of the row structures of those columns.
+ *
+ * panel_size (input) int
+ *          A panel consists of at most panel_size consecutive columns.
+ *
+ * etree    (input) int*, dimension (A->ncol)
+ *          Elimination tree of A'*A.
+ *          Note: etree is a vector of parent pointers for a forest whose
+ *          vertices are the integers 0 to A->ncol-1; etree[root]==A->ncol.
+ *          On input, the columns of A should be permuted so that the
+ *          etree is in a certain postorder.
+ *
+ * work     (input/output) void*, size (lwork) (in bytes)
+ *          User-supplied work space and space for the output data structures.
+ *          Not referenced if lwork = 0;
+ *
+ * lwork   (input) int
+ *         Specifies the size of work array in bytes.
+ *         = 0:  allocate space internally by system malloc;
+ *         > 0:  use user-supplied work array of length lwork in bytes,
+ *               returns error if space runs out.
+ *         = -1: the routine guesses the amount of space needed without
+ *               performing the factorization, and returns it in
+ *               *info; no other side effects.
+ *
+ * perm_r   (input/output) int*, dimension (A->nrow)
+ *          Row permutation vector which defines the permutation matrix Pr,
+ *          perm_r[i] = j means row i of A is in position j in Pr*A.
+ *          If refact is not 'Y', perm_r is output argument;
+ *          If refact = 'Y', the pivoting routine will try to use the input
+ *          perm_r, unless a certain threshold criterion is violated.
+ *          In that case, perm_r is overwritten by a new permutation
+ *          determined by partial pivoting or diagonal threshold pivoting.
+ *
+ * perm_c   (input) int*, dimension (A->ncol)
+ *	    Column permutation vector, which defines the 
+ *          permutation matrix Pc; perm_c[i] = j means column i of A is 
+ *          in position j in A*Pc.
+ *          When searching for diagonal, perm_c[*] is applied to the
+ *          row subscripts of A, so that diagonal threshold pivoting
+ *          can find the diagonal of A, rather than that of A*Pc.
+ *
+ * L        (output) SuperMatrix*
+ *          The factor L from the factorization Pr*A=L*U; use compressed row 
+ *          subscripts storage for supernodes, i.e., L has type: 
+ *          Stype = SC, Dtype = _Z, Mtype = TRLU.
+ *
+ * U        (output) SuperMatrix*
+ *	    The factor U from the factorization Pr*A*Pc=L*U. Use column-wise
+ *          storage scheme, i.e., U has types: Stype = NC, 
+ *          Dtype = _Z, Mtype = TRU.
+ *
+ * info     (output) int*
+ *          = 0: successful exit
+ *          < 0: if info = -i, the i-th argument had an illegal value
+ *          > 0: if info = i, and i is
+ *             <= A->ncol: U(i,i) is exactly zero. The factorization has
+ *                been completed, but the factor U is exactly singular,
+ *                and division by zero will occur if it is used to solve a
+ *                system of equations.
+ *             > A->ncol: number of bytes allocated when memory allocation
+ *                failure occurred, plus A->ncol. If lwork = -1, it is
+ *                the estimated amount of space needed, plus A->ncol.
+ *
+ * ======================================================================
+ *
+ * Local Working Arrays: 
+ * ======================
+ *   m = number of rows in the matrix
+ *   n = number of columns in the matrix
+ *
+ *   xprune[0:n-1]: xprune[*] points to locations in subscript 
+ *	vector lsub[*]. For column i, xprune[i] denotes the point where 
+ *	structural pruning begins. I.e. only xlsub[i],..,xprune[i]-1 need 
+ *	to be traversed for symbolic factorization.
+ *
+ *   marker[0:3*m-1]: marker[i] = j means that node i has been 
+ *	reached when working on column j.
+ *	Storage: relative to original row subscripts
+ *	NOTE: There are 3 of them: marker/marker1 are used for panel dfs, 
+ *	      see zpanel_dfs.c; marker2 is used for inner-factorization,
+ *            see zcolumn_dfs.c.
+ *
+ *   parent[0:m-1]: parent vector used during dfs
+ *      Storage: relative to new row subscripts
+ *
+ *   xplore[0:m-1]: xplore[i] gives the location of the next (dfs) 
+ *	unexplored neighbor of i in lsub[*]
+ *
+ *   segrep[0:nseg-1]: contains the list of supernodal representatives
+ *	in topological order of the dfs. A supernode representative is the 
+ *	last column of a supernode.
+ *      The maximum size of segrep[] is n.
+ *
+ *   repfnz[0:W*m-1]: for a nonzero segment U[*,j] that ends at a 
+ *	supernodal representative r, repfnz[r] is the location of the first 
+ *	nonzero in this segment.  It is also used during the dfs: repfnz[r]>0
+ *	indicates the supernode r has been explored.
+ *	NOTE: There are W of them, each used for one column of a panel. 
+ *
+ *   panel_lsub[0:W*m-1]: temporary for the nonzeros row indices below 
+ *      the panel diagonal. These are filled in during zpanel_dfs(), and are
+ *      used later in the inner LU factorization within the panel.
+ *	panel_lsub[]/dense[] pair forms the SPA data structure.
+ *	NOTE: There are W of them.
+ *
+ *   dense[0:W*m-1]: sparse accumulating (SPA) vector for intermediate values;
+ *	    	   NOTE: there are W of them.
+ *
+ *   tempv[0:*]: real temporary used for dense numeric kernels;
+ *	The size of this array is defined by NUM_TEMPV() in zsp_defs.h.
+ *
+ */
+    /* Local working arrays */
+    NCPformat *Astore;
+    int       *iperm_r; /* inverse of perm_r; not used if refact = 'N' */
+    int       *iperm_c; /* inverse of perm_c */
+    int       *iwork;
+    doublecomplex    *zwork;
+    int	      *segrep, *repfnz, *parent, *xplore;
+    int	      *panel_lsub; /* dense[]/panel_lsub[] pair forms a w-wide SPA */
+    int	      *xprune;
+    int	      *marker;
+    doublecomplex    *dense, *tempv;
+    int       *relax_end;
+    doublecomplex    *a;
+    int       *asub;
+    int       *xa_begin, *xa_end;
+    int       *xsup, *supno;
+    int       *xlsub, *xlusup, *xusub;
+    int       nzlumax;
+    static GlobalLU_t Glu; /* persistent to facilitate multiple factors. */
+
+    /* Local scalars */
+    int       pivrow;   /* pivotal row number in the original matrix A */
+    int       nseg1;	/* no of segments in U-column above panel row jcol */
+    int       nseg;	/* no of segments in each U-column */
+    register int jcol;	
+    register int kcol;	/* end column of a relaxed snode */
+    register int icol;
+    register int i, k, jj, new_next, iinfo;
+    int       m, n, min_mn, jsupno, fsupc, nextlu, nextu;
+    int       w_def;	/* upper bound on panel width */
+    int       usepr;
+    int       nnzL, nnzU;
+    extern SuperLUStat_t SuperLUStat;
+    int       *panel_histo = SuperLUStat.panel_histo;
+    flops_t   *ops = SuperLUStat.ops;
+
+    iinfo    = 0;
+    m        = A->nrow;
+    n        = A->ncol;
+    min_mn   = MIN(m, n);
+    Astore   = A->Store;
+    a        = Astore->nzval;
+    asub     = Astore->rowind;
+    xa_begin = Astore->colbeg;
+    xa_end   = Astore->colend;
+
+    /* Allocate storage common to the factor routines */
+    *info = zLUMemInit(refact, work, lwork, m, n, Astore->nnz,
+		      panel_size, L, U, &Glu, &iwork, &zwork);
+    if ( *info ) return;
+    
+    xsup    = Glu.xsup;
+    supno   = Glu.supno;
+    xlsub   = Glu.xlsub;
+    xlusup  = Glu.xlusup;
+    xusub   = Glu.xusub;
+    
+    SetIWork(m, n, panel_size, iwork, &segrep, &parent, &xplore,
+	     &repfnz, &panel_lsub, &xprune, &marker);
+    zSetRWork(m, panel_size, zwork, &dense, &tempv);
+    
+    usepr = lsame_(refact, "Y");
+    if ( usepr ) {
+	/* Compute the inverse of perm_r */
+	iperm_r = (int *) intMalloc(m);
+	for (k = 0; k < m; ++k) iperm_r[perm_r[k]] = k;
+    }
+    iperm_c = (int *) intMalloc(n);
+    for (k = 0; k < n; ++k) iperm_c[perm_c[k]] = k;
+
+    /* Identify relaxed snodes */
+    relax_end = (int *) intMalloc(n);
+    relax_snode(n, etree, relax, marker, relax_end); 
+    
+    ifill (perm_r, m, EMPTY);
+    ifill (marker, m * NO_MARKER, EMPTY);
+    supno[0] = -1;
+    xsup[0]  = xlsub[0] = xusub[0] = xlusup[0] = 0;
+    w_def    = panel_size;
+
+    /* 
+     * Work on one "panel" at a time. A panel is one of the following: 
+     *	   (a) a relaxed supernode at the bottom of the etree, or
+     *	   (b) panel_size contiguous columns, defined by the user
+     */
+    for (jcol = 0; jcol < min_mn; ) {
+
+	if ( relax_end[jcol] != EMPTY ) { /* start of a relaxed snode */
+   	    kcol = relax_end[jcol];	  /* end of the relaxed snode */
+	    panel_histo[kcol-jcol+1]++;
+
+	    /* --------------------------------------
+	     * Factorize the relaxed supernode(jcol:kcol) 
+	     * -------------------------------------- */
+	    /* Determine the union of the row structure of the snode */
+	    if ( (*info = zsnode_dfs(jcol, kcol, asub, xa_begin, xa_end,
+				    xprune, marker, &Glu)) != 0 )
+		return;
+
+            nextu    = xusub[jcol];
+	    nextlu   = xlusup[jcol];
+	    jsupno   = supno[jcol];
+	    fsupc    = xsup[jsupno];
+	    new_next = nextlu + (xlsub[fsupc+1]-xlsub[fsupc])*(kcol-jcol+1);
+	    nzlumax = Glu.nzlumax;
+	    while ( new_next > nzlumax ) {
+		if ( *info = zLUMemXpand(jcol, nextlu, LUSUP, &nzlumax, &Glu) )
+		    return;
+	    }
+    
+	    for (icol = jcol; icol<= kcol; icol++) {
+		xusub[icol+1] = nextu;
+		
+    		/* Scatter into SPA dense[*] */
+    		for (k = xa_begin[icol]; k < xa_end[icol]; k++)
+        	    dense[asub[k]] = a[k];
+
+	       	/* Numeric update within the snode */
+	        zsnode_bmod(icol, jsupno, fsupc, dense, tempv, &Glu);
+
+		if ( *info = zpivotL(icol, diag_pivot_thresh, &usepr, perm_r,
+				    iperm_r, iperm_c, &pivrow, &Glu) )
+		    if ( iinfo == 0 ) iinfo = *info;
+		
+#ifdef DEBUG
+		zprint_lu_col("[1]: ", icol, pivrow, xprune, &Glu);
+#endif
+
+	    }
+
+	    jcol = icol;
+
+	} else { /* Work on one panel of panel_size columns */
+	    
+	    /* Adjust panel_size so that a panel won't overlap with the next 
+	     * relaxed snode.
+	     */
+	    panel_size = w_def;
+	    for (k = jcol + 1; k < MIN(jcol+panel_size, min_mn); k++) 
+		if ( relax_end[k] != EMPTY ) {
+		    panel_size = k - jcol;
+		    break;
+		}
+	    if ( k == min_mn ) panel_size = min_mn - jcol;
+	    panel_histo[panel_size]++;
+
+	    /* symbolic factor on a panel of columns */
+	    zpanel_dfs(m, panel_size, jcol, A, perm_r, &nseg1,
+		      dense, panel_lsub, segrep, repfnz, xprune,
+		      marker, parent, xplore, &Glu);
+	    
+	    /* numeric sup-panel updates in topological order */
+	    zpanel_bmod(m, panel_size, jcol, nseg1, dense,
+		       tempv, segrep, repfnz, &Glu);
+	    
+	    /* Sparse LU within the panel, and below panel diagonal */
+    	    for ( jj = jcol; jj < jcol + panel_size; jj++) {
+ 		k = (jj - jcol) * m; /* column index for w-wide arrays */
+
+		nseg = nseg1;	/* Begin after all the panel segments */
+
+	    	if ((*info = zcolumn_dfs(m, jj, perm_r, &nseg, &panel_lsub[k],
+					segrep, &repfnz[k], xprune, marker,
+					parent, xplore, &Glu)) != 0) return;
+
+	      	/* Numeric updates */
+	    	if ((*info = zcolumn_bmod(jj, (nseg - nseg1), &dense[k],
+					 tempv, &segrep[nseg1], &repfnz[k],
+					 jcol, &Glu)) != 0) return;
+		
+	        /* Copy the U-segments to ucol[*] */
+		if ((*info = zcopy_to_ucol(jj, nseg, segrep, &repfnz[k],
+					  perm_r, &dense[k], &Glu)) != 0)
+		    return;
+
+	    	if ( *info = zpivotL(jj, diag_pivot_thresh, &usepr, perm_r,
+				    iperm_r, iperm_c, &pivrow, &Glu) )
+		    if ( iinfo == 0 ) iinfo = *info;
+
+		/* Prune columns (0:jj-1) using column jj */
+	    	zpruneL(jj, perm_r, pivrow, nseg, segrep,
+		       &repfnz[k], xprune, &Glu);
+
+		/* Reset repfnz[] for this column */
+	    	resetrep_col (nseg, segrep, &repfnz[k]);
+		
+#ifdef DEBUG
+		zprint_lu_col("[2]: ", jj, pivrow, xprune, &Glu);
+#endif
+
+	    }
+
+   	    jcol += panel_size;	/* Move to the next panel */
+
+	} /* else */
+
+    } /* for */
+
+    *info = iinfo;
+    
+    if ( m > n ) {
+	k = 0;
+        for (i = 0; i < m; ++i) 
+            if ( perm_r[i] == EMPTY ) {
+    		perm_r[i] = n + k;
+		++k;
+	    }
+    }
+
+    countnz(min_mn, xprune, &nnzL, &nnzU, &Glu);
+    fixupL(min_mn, perm_r, &Glu);
+
+    zLUWorkFree(iwork, zwork, &Glu); /* Free work space and compress storage */
+
+    if ( !lsame_(refact, "Y") ) {
+        zCreate_SuperNode_Matrix(L, A->nrow, A->ncol, nnzL, Glu.lusup, 
+	                         Glu.xlusup, Glu.lsub, Glu.xlsub, Glu.supno,
+			         Glu.xsup, SC, _Z, TRLU);
+    	zCreate_CompCol_Matrix(U, A->nrow, A->ncol, nnzU, Glu.ucol, 
+			       Glu.usub, Glu.xusub, NC, _Z, TRU);
+    }
+    
+    ops[FACT] += ops[TRSV] + ops[GEMV];	
+    
+    if ( usepr ) SUPERLU_FREE (iperm_r);
+    SUPERLU_FREE (iperm_c);
+    SUPERLU_FREE (relax_end);
+
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zgstrs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,336 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "zsp_defs.h"
+#include "util.h"
+
+
+/* 
+ * Function prototypes 
+ */
+void zusolve(int, int, doublecomplex*, doublecomplex*);
+void zlsolve(int, int, doublecomplex*, doublecomplex*);
+void zmatvec(int, int, int, doublecomplex*, doublecomplex*, doublecomplex*);
+
+
+void
+zgstrs (char *trans, SuperMatrix *L, SuperMatrix *U,
+	int *perm_r, int *perm_c, SuperMatrix *B, int *info)
+{
+/*
+ * Purpose
+ * =======
+ *
+ * ZGSTRS solves a system of linear equations A*X=B or A'*X=B
+ * with A sparse and B dense, using the LU factorization computed by
+ * ZGSTRF.
+ *
+ * See supermatrix.h for the definition of 'SuperMatrix' structure.
+ *
+ * Arguments
+ * =========
+ *
+ * trans   (input) char*
+ *          Specifies the form of the system of equations:
+ *          = 'N':  A * X = B  (No transpose)
+ *          = 'T':  A'* X = B  (Transpose)
+ *          = 'C':  A**H * X = B  (Conjugate transpose)
+ *
+ * L       (input) SuperMatrix*
+ *         The factor L from the factorization Pr*A*Pc=L*U as computed by
+ *         zgstrf(). Use compressed row subscripts storage for supernodes,
+ *         i.e., L has types: Stype = SC, Dtype = _Z, Mtype = TRLU.
+ *
+ * U       (input) SuperMatrix*
+ *         The factor U from the factorization Pr*A*Pc=L*U as computed by
+ *         zgstrf(). Use column-wise storage scheme, i.e., U has types:
+ *         Stype = NC, Dtype = _Z, Mtype = TRU.
+ *
+ * perm_r  (input) int*, dimension (L->nrow)
+ *         Row permutation vector, which defines the permutation matrix Pr; 
+ *         perm_r[i] = j means row i of A is in position j in Pr*A.
+ *
+ * perm_c  (input) int*, dimension (L->ncol)
+ *	   Column permutation vector, which defines the 
+ *         permutation matrix Pc; perm_c[i] = j means column i of A is 
+ *         in position j in A*Pc.
+ *
+ * B       (input/output) SuperMatrix*
+ *         B has types: Stype = DN, Dtype = _Z, Mtype = GE.
+ *         On entry, the right hand side matrix.
+ *         On exit, the solution matrix if info = 0;
+ *
+ * info    (output) int*
+ * 	   = 0: successful exit
+ *	   < 0: if info = -i, the i-th argument had an illegal value
+ *
+ */
+#ifdef _CRAY
+    _fcd ftcs1, ftcs2, ftcs3, ftcs4;
+#endif
+    int      incx = 1, incy = 1;
+    doublecomplex   alpha = {1.0, 0.0}, beta = {1.0, 0.0};
+    doublecomplex   temp_comp;
+    DNformat *Bstore;
+    doublecomplex   *Bmat;
+    SCformat *Lstore;
+    NCformat *Ustore;
+    doublecomplex   *Lval, *Uval;
+    int      nrow, notran;
+    int      fsupc, nsupr, nsupc, luptr, istart, irow;
+    int      i, j, k, iptr, jcol, n, ldb, nrhs;
+    doublecomplex   *work, *work_col, *rhs_work, *soln;
+    flops_t  solve_ops;
+    extern SuperLUStat_t SuperLUStat;
+    void zprint_soln();
+
+    /* Test input parameters ... */
+    *info = 0;
+    Bstore = B->Store;
+    ldb = Bstore->lda;
+    nrhs = B->ncol;
+    notran = lsame_(trans, "N");
+    if ( !notran && !lsame_(trans, "T") && !lsame_(trans, "C") ) *info = -1;
+    else if ( L->nrow != L->ncol || L->nrow < 0 ||
+	      L->Stype != SC || L->Dtype != _Z || L->Mtype != TRLU )
+	*info = -2;
+    else if ( U->nrow != U->ncol || U->nrow < 0 ||
+	      U->Stype != NC || U->Dtype != _Z || U->Mtype != TRU )
+	*info = -3;
+    else if ( ldb < MAX(0, L->nrow) ||
+	      B->Stype != DN || B->Dtype != _Z || B->Mtype != GE )
+	*info = -6;
+    if ( *info ) {
+	i = -(*info);
+	xerbla_("zgstrs", &i);
+	return;
+    }
+
+    n = L->nrow;
+    work = doublecomplexCalloc(n * nrhs);
+    if ( !work ) ABORT("Malloc fails for local work[].");
+    soln = doublecomplexMalloc(n);
+    if ( !soln ) ABORT("Malloc fails for local soln[].");
+
+    Bmat = Bstore->nzval;
+    Lstore = L->Store;
+    Lval = Lstore->nzval;
+    Ustore = U->Store;
+    Uval = Ustore->nzval;
+    solve_ops = 0;
+    
+    if ( notran ) {
+	/* Permute right hand sides to form Pr*B */
+	for (i = 0; i < nrhs; i++) {
+	    rhs_work = &Bmat[i*ldb];
+	    for (k = 0; k < n; k++) soln[perm_r[k]] = rhs_work[k];
+	    for (k = 0; k < n; k++) rhs_work[k] = soln[k];
+	}
+	
+	/* Forward solve PLy=Pb. */
+	for (k = 0; k <= Lstore->nsuper; k++) {
+	    fsupc = L_FST_SUPC(k);
+	    istart = L_SUB_START(fsupc);
+	    nsupr = L_SUB_START(fsupc+1) - istart;
+	    nsupc = L_FST_SUPC(k+1) - fsupc;
+	    nrow = nsupr - nsupc;
+
+	    solve_ops += 4 * nsupc * (nsupc - 1) * nrhs;
+	    solve_ops += 8 * nrow * nsupc * nrhs;
+	    
+	    if ( nsupc == 1 ) {
+		for (j = 0; j < nrhs; j++) {
+		    rhs_work = &Bmat[j*ldb];
+	    	    luptr = L_NZ_START(fsupc);
+		    for (iptr=istart+1; iptr < L_SUB_START(fsupc+1); iptr++){
+			irow = L_SUB(iptr);
+			++luptr;
+			zz_mult(&temp_comp, &rhs_work[fsupc], &Lval[luptr]);
+			z_sub(&rhs_work[irow], &rhs_work[irow], &temp_comp);
+		    }
+		}
+	    } else {
+	    	luptr = L_NZ_START(fsupc);
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		ftcs1 = _cptofcd("L", strlen("L"));
+		ftcs2 = _cptofcd("N", strlen("N"));
+		ftcs3 = _cptofcd("U", strlen("U"));
+		CTRSM( ftcs1, ftcs1, ftcs2, ftcs3, &nsupc, &nrhs, &alpha,
+		       &Lval[luptr], &nsupr, &Bmat[fsupc], &ldb);
+		
+		CGEMM( ftcs2, ftcs2, &nrow, &nrhs, &nsupc, &alpha, 
+			&Lval[luptr+nsupc], &nsupr, &Bmat[fsupc], &ldb, 
+			&beta, &work[0], &n );
+#else
+		ztrsm_("L", "L", "N", "U", &nsupc, &nrhs, &alpha,
+		       &Lval[luptr], &nsupr, &Bmat[fsupc], &ldb);
+		
+		zgemm_( "N", "N", &nrow, &nrhs, &nsupc, &alpha, 
+			&Lval[luptr+nsupc], &nsupr, &Bmat[fsupc], &ldb, 
+			&beta, &work[0], &n );
+#endif
+		for (j = 0; j < nrhs; j++) {
+		    rhs_work = &Bmat[j*ldb];
+		    work_col = &work[j*n];
+		    iptr = istart + nsupc;
+		    for (i = 0; i < nrow; i++) {
+			irow = L_SUB(iptr);
+			z_sub(&rhs_work[irow], &rhs_work[irow], &work_col[i]);
+			work_col[i].r = 0.0;
+	                work_col[i].i = 0.0;
+			iptr++;
+		    }
+		}
+#else		
+		for (j = 0; j < nrhs; j++) {
+		    rhs_work = &Bmat[j*ldb];
+		    zlsolve (nsupr, nsupc, &Lval[luptr], &rhs_work[fsupc]);
+		    zmatvec (nsupr, nrow, nsupc, &Lval[luptr+nsupc],
+			    &rhs_work[fsupc], &work[0] );
+
+		    iptr = istart + nsupc;
+		    for (i = 0; i < nrow; i++) {
+			irow = L_SUB(iptr);
+			z_sub(&rhs_work[irow], &rhs_work[irow], &work[i]);
+			work[i].r = 0.;
+	                work[i].i = 0.;
+			iptr++;
+		    }
+		}
+#endif		    
+	    } /* else ... */
+	} /* for L-solve */
+
+#ifdef DEBUG
+  	printf("After L-solve: y=\n");
+	zprint_soln(n, nrhs, Bmat);
+#endif
+
+	/*
+	 * Back solve Ux=y.
+	 */
+	for (k = Lstore->nsuper; k >= 0; k--) {
+	    fsupc = L_FST_SUPC(k);
+	    istart = L_SUB_START(fsupc);
+	    nsupr = L_SUB_START(fsupc+1) - istart;
+	    nsupc = L_FST_SUPC(k+1) - fsupc;
+	    luptr = L_NZ_START(fsupc);
+
+	    solve_ops += 4 * nsupc * (nsupc + 1) * nrhs;
+
+	    if ( nsupc == 1 ) {
+		rhs_work = &Bmat[0];
+		for (j = 0; j < nrhs; j++) {
+		    z_div(&rhs_work[fsupc], &rhs_work[fsupc], &Lval[luptr]);
+		    rhs_work += ldb;
+		}
+	    } else {
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		ftcs1 = _cptofcd("L", strlen("L"));
+		ftcs2 = _cptofcd("U", strlen("U"));
+		ftcs3 = _cptofcd("N", strlen("N"));
+		CTRSM( ftcs1, ftcs2, ftcs3, ftcs3, &nsupc, &nrhs, &alpha,
+		       &Lval[luptr], &nsupr, &Bmat[fsupc], &ldb);
+#else
+		ztrsm_("L", "U", "N", "N", &nsupc, &nrhs, &alpha,
+		       &Lval[luptr], &nsupr, &Bmat[fsupc], &ldb);
+#endif
+#else		
+		for (j = 0; j < nrhs; j++)
+		    zusolve ( nsupr, nsupc, &Lval[luptr], &Bmat[fsupc+j*ldb] );
+#endif		
+	    }
+
+	    for (j = 0; j < nrhs; ++j) {
+		rhs_work = &Bmat[j*ldb];
+		for (jcol = fsupc; jcol < fsupc + nsupc; jcol++) {
+		    solve_ops += 8*(U_NZ_START(jcol+1) - U_NZ_START(jcol));
+		    for (i = U_NZ_START(jcol); i < U_NZ_START(jcol+1); i++ ){
+			irow = U_SUB(i);
+			zz_mult(&temp_comp, &rhs_work[jcol], &Uval[i]);
+			z_sub(&rhs_work[irow], &rhs_work[irow], &temp_comp);
+		    }
+		}
+	    }
+	    
+	} /* for U-solve */
+
+#ifdef DEBUG
+  	printf("After U-solve: x=\n");
+	zprint_soln(n, nrhs, Bmat);
+#endif
+
+	/* Compute the final solution X := Pc*X. */
+	for (i = 0; i < nrhs; i++) {
+	    rhs_work = &Bmat[i*ldb];
+	    for (k = 0; k < n; k++) soln[k] = rhs_work[perm_c[k]];
+	    for (k = 0; k < n; k++) rhs_work[k] = soln[k];
+	}
+	
+        SuperLUStat.ops[SOLVE] = solve_ops;
+
+    } else { /* Solve A'*X=B */
+	/* Permute right hand sides to form Pc'*B. */
+	for (i = 0; i < nrhs; i++) {
+	    rhs_work = &Bmat[i*ldb];
+	    for (k = 0; k < n; k++) soln[perm_c[k]] = rhs_work[k];
+	    for (k = 0; k < n; k++) rhs_work[k] = soln[k];
+	}
+
+	SuperLUStat.ops[SOLVE] = 0;
+	
+	for (k = 0; k < nrhs; ++k) {
+	    
+	    /* Multiply by inv(U'). */
+	    sp_ztrsv("U", "T", "N", L, U, &Bmat[k*ldb], info);
+	    
+	    /* Multiply by inv(L'). */
+	    sp_ztrsv("L", "T", "U", L, U, &Bmat[k*ldb], info);
+	    
+	}
+	
+	/* Compute the final solution X := Pr'*X (=inv(Pr)*X) */
+	for (i = 0; i < nrhs; i++) {
+	    rhs_work = &Bmat[i*ldb];
+	    for (k = 0; k < n; k++) soln[k] = rhs_work[perm_r[k]];
+	    for (k = 0; k < n; k++) rhs_work[k] = soln[k];
+	}
+
+    }
+
+    SUPERLU_FREE(work);
+    SUPERLU_FREE(soln);
+}
+
+/*
+ * Diagnostic print of the solution vector 
+ */
+void
+zprint_soln(int n, int nrhs, doublecomplex *soln)
+{
+    int i;
+
+    for (i = 0; i < n; i++) 
+  	printf("\t%d: %.4f\n", i, soln[i]);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zlacon.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,214 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include <math.h>
+#include "Cnames.h"
+#include "dcomplex.h"
+
+int
+zlacon_(int *n, doublecomplex *v, doublecomplex *x, double *est, int *kase)
+
+{
+/*
+    Purpose   
+    =======   
+
+    ZLACON estimates the 1-norm of a square matrix A.   
+    Reverse communication is used for evaluating matrix-vector products. 
+  
+
+    Arguments   
+    =========   
+
+    N      (input) INT
+           The order of the matrix.  N >= 1.   
+
+    V      (workspace) DOUBLE COMPLEX PRECISION array, dimension (N)   
+           On the final return, V = A*W,  where  EST = norm(V)/norm(W)   
+           (W is not returned).   
+
+    X      (input/output) DOUBLE COMPLEX PRECISION array, dimension (N)   
+           On an intermediate return, X should be overwritten by   
+                 A * X,   if KASE=1,   
+                 A' * X,  if KASE=2,
+           where A' is the conjugate transpose of A,
+           and ZLACON must be re-called with all the other parameters   
+           unchanged.   
+
+
+    EST    (output) DOUBLE PRECISION   
+           An estimate (a lower bound) for norm(A).   
+
+    KASE   (input/output) INT
+           On the initial call to ZLACON, KASE should be 0.   
+           On an intermediate return, KASE will be 1 or 2, indicating   
+           whether X should be overwritten by A * X  or A' * X.   
+           On the final return from ZLACON, KASE will again be 0.   
+
+    Further Details   
+    ======= =======   
+
+    Contributed by Nick Higham, University of Manchester.   
+    Originally named CONEST, dated March 16, 1988.   
+
+    Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of 
+    a real or complex matrix, with applications to condition estimation", 
+    ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.   
+    ===================================================================== 
+*/
+
+    /* Table of constant values */
+    int c__1 = 1;
+    doublecomplex      zero = {0.0, 0.0};
+    doublecomplex      one = {1.0, 0.0};
+
+    /* System generated locals */
+    double d__1;
+    
+    /* Local variables */
+    static int iter;
+    static int jump, jlast;
+    static double altsgn, estold;
+    static int i, j;
+    double temp;
+    double safmin;
+    extern double dlamch_(char *);
+    extern int izmax1_(int *, doublecomplex *, int *);
+    extern double dzsum1_(int *, doublecomplex *, int *);
+
+    safmin = dlamch_("Safe minimum");
+    if ( *kase == 0 ) {
+	for (i = 0; i < *n; ++i) {
+	    x[i].r = 1. / (double) (*n);
+	    x[i].i = 0.;
+	}
+	*kase = 1;
+	jump = 1;
+	return 0;
+    }
+
+    switch (jump) {
+	case 1:  goto L20;
+	case 2:  goto L40;
+	case 3:  goto L70;
+	case 4:  goto L110;
+	case 5:  goto L140;
+    }
+
+    /*     ................ ENTRY   (JUMP = 1)   
+	   FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X. */
+  L20:
+    if (*n == 1) {
+	v[0] = x[0];
+	*est = z_abs(&v[0]);
+	/*        ... QUIT */
+	goto L150;
+    }
+    *est = dzsum1_(n, x, &c__1);
+
+    for (i = 0; i < *n; ++i) {
+	d__1 = z_abs(&x[i]);
+	if (d__1 > safmin) {
+	    d__1 = 1 / d__1;
+	    x[i].r *= d__1;
+	    x[i].i *= d__1;
+	} else {
+	    x[i] = one;
+	}
+    }
+    *kase = 2;
+    jump = 2;
+    return 0;
+
+    /*     ................ ENTRY   (JUMP = 2)   
+	   FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X. */
+L40:
+    j = izmax1_(n, &x[0], &c__1);
+    --j;
+    iter = 2;
+
+    /*     MAIN LOOP - ITERATIONS 2,3,...,ITMAX. */
+L50:
+    for (i = 0; i < *n; ++i) x[i] = zero;
+    x[j] = one;
+    *kase = 1;
+    jump = 3;
+    return 0;
+
+    /*     ................ ENTRY   (JUMP = 3)   
+	   X HAS BEEN OVERWRITTEN BY A*X. */
+L70:
+#ifdef _CRAY
+    CCOPY(n, x, &c__1, v, &c__1);
+#else
+    zcopy_(n, x, &c__1, v, &c__1);
+#endif
+    estold = *est;
+    *est = dzsum1_(n, v, &c__1);
+
+
+L90:
+    /*     TEST FOR CYCLING. */
+    if (*est <= estold) goto L120;
+
+    for (i = 0; i < *n; ++i) {
+	d__1 = z_abs(&x[i]);
+	if (d__1 > safmin) {
+	    d__1 = 1 / d__1;
+	    x[i].r *= d__1;
+	    x[i].i *= d__1;
+	} else {
+	    x[i] = one;
+	}
+    }
+    *kase = 2;
+    jump = 4;
+    return 0;
+
+    /*     ................ ENTRY   (JUMP = 4)   
+	   X HAS BEEN OVERWRITTEN BY TRANDPOSE(A)*X. */
+L110:
+    jlast = j;
+    j = izmax1_(n, &x[0], &c__1);
+    --j;
+    if (x[jlast].r != (d__1 = x[j].r, fabs(d__1)) && iter < 5) {
+	++iter;
+	goto L50;
+    }
+
+    /*     ITERATION COMPLETE.  FINAL STAGE. */
+L120:
+    altsgn = 1.;
+    for (i = 1; i <= *n; ++i) {
+	x[i-1].r = altsgn * ((double)(i - 1) / (double)(*n - 1) + 1.);
+	x[i-1].i = 0.;
+	altsgn = -altsgn;
+    }
+    *kase = 1;
+    jump = 5;
+    return 0;
+    
+    /*     ................ ENTRY   (JUMP = 5)   
+	   X HAS BEEN OVERWRITTEN BY A*X. */
+L140:
+    temp = dzsum1_(n, x, &c__1) / (double)(*n * 3) * 2.;
+    if (temp > *est) {
+#ifdef _CRAY
+	CCOPY(n, &x[0], &c__1, &v[0], &c__1);
+#else
+	zcopy_(n, &x[0], &c__1, &v[0], &c__1);
+#endif
+	*est = temp;
+    }
+
+L150:
+    *kase = 0;
+    return 0;
+
+} /* zlacon_ */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zlangs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,112 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:	zlangs.c
+ * History:     Modified from lapack routine ZLANGE
+ */
+#include <math.h>
+#include "zsp_defs.h"
+#include "util.h"
+
+double zlangs(char *norm, SuperMatrix *A)
+{
+/* 
+    Purpose   
+    =======   
+
+    ZLANGS returns the value of the one norm, or the Frobenius norm, or 
+    the infinity norm, or the element of largest absolute value of a 
+    real matrix A.   
+
+    Description   
+    ===========   
+
+    ZLANGE returns the value   
+
+       ZLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'   
+                (   
+                ( norm1(A),         NORM = '1', 'O' or 'o'   
+                (   
+                ( normI(A),         NORM = 'I' or 'i'   
+                (   
+                ( normF(A),         NORM = 'F', 'f', 'E' or 'e'   
+
+    where  norm1  denotes the  one norm of a matrix (maximum column sum), 
+    normI  denotes the  infinity norm  of a matrix  (maximum row sum) and 
+    normF  denotes the  Frobenius norm of a matrix (square root of sum of 
+    squares).  Note that  max(abs(A(i,j)))  is not a  matrix norm.   
+
+    Arguments   
+    =========   
+
+    NORM    (input) CHARACTER*1   
+            Specifies the value to be returned in ZLANGE as described above.   
+    A       (input) SuperMatrix*
+            The M by N sparse matrix A. 
+
+   ===================================================================== 
+*/
+    
+    /* Local variables */
+    NCformat *Astore;
+    doublecomplex   *Aval;
+    int      i, j, irow;
+    double   value, sum;
+    double   *rwork;
+
+    Astore = A->Store;
+    Aval   = Astore->nzval;
+    
+    if ( MIN(A->nrow, A->ncol) == 0) {
+	value = 0.;
+	
+    } else if (lsame_(norm, "M")) {
+	/* Find max(abs(A(i,j))). */
+	value = 0.;
+	for (j = 0; j < A->ncol; ++j)
+	    for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; i++)
+		value = MAX( value, z_abs( &Aval[i]) );
+	
+    } else if (lsame_(norm, "O") || *(unsigned char *)norm == '1') {
+	/* Find norm1(A). */
+	value = 0.;
+	for (j = 0; j < A->ncol; ++j) {
+	    sum = 0.;
+	    for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; i++) 
+		sum += z_abs( &Aval[i] );
+	    value = MAX(value,sum);
+	}
+	
+    } else if (lsame_(norm, "I")) {
+	/* Find normI(A). */
+	if ( !(rwork = (double *) SUPERLU_MALLOC(A->nrow * sizeof(double))) )
+	    ABORT("SUPERLU_MALLOC fails for rwork.");
+	for (i = 0; i < A->nrow; ++i) rwork[i] = 0.;
+	for (j = 0; j < A->ncol; ++j)
+	    for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; i++) {
+		irow = Astore->rowind[i];
+		rwork[irow] += z_abs( &Aval[i] );
+	    }
+	value = 0.;
+	for (i = 0; i < A->nrow; ++i)
+	    value = MAX(value, rwork[i]);
+	
+	SUPERLU_FREE (rwork);
+	
+    } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+	/* Find normF(A). */
+	ABORT("Not implemented.");
+    } else
+	ABORT("Illegal norm specified.");
+
+    return (value);
+
+} /* zlangs */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zlaqgs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,140 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:	zlaqgs.c
+ * History:     Modified from LAPACK routine ZLAQGE
+ */
+#include <math.h>
+#include "zsp_defs.h"
+#include "util.h"
+
+void
+zlaqgs(SuperMatrix *A, double *r, double *c, 
+	double rowcnd, double colcnd, double amax, char *equed)
+{
+/*
+    Purpose   
+    =======   
+
+    ZLAQGS equilibrates a general sparse M by N matrix A using the row and   
+    scaling factors in the vectors R and C.   
+
+    See supermatrix.h for the definition of 'SuperMatrix' structure.
+
+    Arguments   
+    =========   
+
+    A       (input/output) SuperMatrix*
+            On exit, the equilibrated matrix.  See EQUED for the form of 
+            the equilibrated matrix. The type of A can be:
+	    Stype = NC; Dtype = _Z; Mtype = GE.
+	    
+    R       (input) double*, dimension (A->nrow)
+            The row scale factors for A.
+	    
+    C       (input) double*, dimension (A->ncol)
+            The column scale factors for A.
+	    
+    ROWCND  (input) double
+            Ratio of the smallest R(i) to the largest R(i).
+	    
+    COLCND  (input) double
+            Ratio of the smallest C(i) to the largest C(i).
+	    
+    AMAX    (input) double
+            Absolute value of largest matrix entry.
+	    
+    EQUED   (output) char*
+            Specifies the form of equilibration that was done.   
+            = 'N':  No equilibration   
+            = 'R':  Row equilibration, i.e., A has been premultiplied by  
+                    diag(R).   
+            = 'C':  Column equilibration, i.e., A has been postmultiplied  
+                    by diag(C).   
+            = 'B':  Both row and column equilibration, i.e., A has been
+                    replaced by diag(R) * A * diag(C).   
+
+    Internal Parameters   
+    ===================   
+
+    THRESH is a threshold value used to decide if row or column scaling   
+    should be done based on the ratio of the row or column scaling   
+    factors.  If ROWCND < THRESH, row scaling is done, and if   
+    COLCND < THRESH, column scaling is done.   
+
+    LARGE and SMALL are threshold values used to decide if row scaling   
+    should be done based on the absolute size of the largest matrix   
+    element.  If AMAX > LARGE or AMAX < SMALL, row scaling is done.   
+
+    ===================================================================== 
+*/
+
+#define THRESH    (0.1)
+    
+    /* Local variables */
+    NCformat *Astore;
+    doublecomplex   *Aval;
+    int i, j, irow;
+    double large, small, cj;
+    extern double dlamch_(char *);
+    double temp;
+
+
+    /* Quick return if possible */
+    if (A->nrow <= 0 || A->ncol <= 0) {
+	*(unsigned char *)equed = 'N';
+	return;
+    }
+
+    Astore = A->Store;
+    Aval = Astore->nzval;
+    
+    /* Initialize LARGE and SMALL. */
+    small = dlamch_("Safe minimum") / dlamch_("Precision");
+    large = 1. / small;
+
+    if (rowcnd >= THRESH && amax >= small && amax <= large) {
+	if (colcnd >= THRESH)
+	    *(unsigned char *)equed = 'N';
+	else {
+	    /* Column scaling */
+	    for (j = 0; j < A->ncol; ++j) {
+		cj = c[j];
+		for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+		    zd_mult(&Aval[i], &Aval[i], cj);
+                }
+	    }
+	    *(unsigned char *)equed = 'C';
+	}
+    } else if (colcnd >= THRESH) {
+	/* Row scaling, no column scaling */
+	for (j = 0; j < A->ncol; ++j)
+	    for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+		irow = Astore->rowind[i];
+		zd_mult(&Aval[i], &Aval[i], r[irow]);
+	    }
+	*(unsigned char *)equed = 'R';
+    } else {
+	/* Row and column scaling */
+	for (j = 0; j < A->ncol; ++j) {
+	    cj = c[j];
+	    for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+		irow = Astore->rowind[i];
+		temp = cj * r[irow];
+		zd_mult(&Aval[i], &Aval[i], temp);
+	    }
+	}
+	*(unsigned char *)equed = 'B';
+    }
+
+    return;
+
+} /* zlaqgs */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zmemory.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,678 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include "zsp_defs.h"
+#include "util.h"
+
+/* Constants */
+#define NO_MEMTYPE  4      /* 0: lusup;
+			      1: ucol;
+			      2: lsub;
+			      3: usub */
+#define GluIntArray(n)   (5 * (n) + 5)
+
+/* Internal prototypes */
+void  *zexpand (int *, MemType,int, int, GlobalLU_t *);
+int   zLUWorkInit (int, int, int, int **, doublecomplex **, LU_space_t);
+void  copy_mem_doublecomplex (int, void *, void *);
+void  zStackCompress (GlobalLU_t *);
+void  zSetupSpace (void *, int, LU_space_t *);
+void  *zuser_malloc (int, int);
+void  zuser_free (int, int);
+
+/* External prototypes (in memory.c - prec-indep) */
+extern void    copy_mem_int    (int, void *, void *);
+extern void    user_bcopy      (char *, char *, int);
+
+/* Headers for 4 types of dynamatically managed memory */
+typedef struct e_node {
+    int size;      /* length of the memory that has been used */
+    void *mem;     /* pointer to the new malloc'd store */
+} ExpHeader;
+
+typedef struct {
+    int  size;
+    int  used;
+    int  top1;  /* grow upward, relative to &array[0] */
+    int  top2;  /* grow downward */
+    void *array;
+} LU_stack_t;
+
+/* Variables local to this file */
+static ExpHeader *expanders; /* Array of pointers to 4 types of memory */
+static LU_stack_t stack;
+static int no_expand;
+
+/* Macros to manipulate stack */
+#define StackFull(x)         ( x + stack.used >= stack.size )
+#define NotDoubleAlign(addr) ( (long int)addr & 7 )
+#define DoubleAlign(addr)    ( ((long int)addr + 7) & ~7L )
+#define TempSpace(n, w)      ( (2*w + 4 + NO_MARKER)*m*sizeof(int) + \
+			      (w + 1)*n*sizeof(doublecomplex) )
+#define Reduce(alpha)        ((alpha + 1) / 2)  /* i.e. (alpha-1)/2 + 1 */
+
+
+
+
+/*
+ * Setup the memory model to be used for factorization.
+ *    lwork = 0: use system malloc;
+ *    lwork > 0: use user-supplied work[] space.
+ */
+void zSetupSpace(void *work, int lwork, LU_space_t *MemModel)
+{
+    if ( lwork == 0 ) {
+	*MemModel = SYSTEM; /* malloc/free */
+    } else if ( lwork > 0 ) {
+	*MemModel = USER;   /* user provided space */
+	stack.used = 0;
+	stack.top1 = 0;
+	stack.top2 = (lwork/4)*4; /* must be word addressable */
+	stack.size = stack.top2;
+	stack.array = (void *) work;
+    }
+}
+
+
+
+void *zuser_malloc(int bytes, int which_end)
+{
+    void *buf;
+    
+    if ( StackFull(bytes) ) return (NULL);
+
+    if ( which_end == HEAD ) {
+	buf = (char*) stack.array + stack.top1;
+	stack.top1 += bytes;
+    } else {
+	stack.top2 -= bytes;
+	buf = (char*) stack.array + stack.top2;
+    }
+    
+    stack.used += bytes;
+    return buf;
+}
+
+
+void zuser_free(int bytes, int which_end)
+{
+    if ( which_end == HEAD ) {
+	stack.top1 -= bytes;
+    } else {
+	stack.top2 += bytes;
+    }
+    stack.used -= bytes;
+}
+
+
+
+/*
+ * mem_usage consists of the following fields:
+ *    - for_lu (float)
+ *      The amount of space used in bytes for the L\U data structures.
+ *    - total_needed (float)
+ *      The amount of space needed in bytes to perform factorization.
+ *    - expansions (int)
+ *      Number of memory expansions during the LU factorization.
+ */
+int zQuerySpace(SuperMatrix *L, SuperMatrix *U, int panel_size,
+	        mem_usage_t *mem_usage)
+{
+    SCformat *Lstore;
+    NCformat *Ustore;
+    register int n, iword, dword;
+
+    Lstore = L->Store;
+    Ustore = U->Store;
+    n = L->ncol;
+    iword = sizeof(int);
+    dword = sizeof(doublecomplex);
+
+    /* For LU factors */
+    mem_usage->for_lu = (float)( (4*n + 3) * iword + Lstore->nzval_colptr[n] *
+				 dword + Lstore->rowind_colptr[n] * iword );
+    mem_usage->for_lu += (float)( (n + 1) * iword +
+				 Ustore->colptr[n] * (dword + iword) );
+
+    /* Working storage to support factorization */
+    mem_usage->total_needed = mem_usage->for_lu +
+	(float)( (2 * panel_size + 4 + NO_MARKER) * n * iword +
+		(panel_size + 1) * n * dword );
+
+    mem_usage->expansions = --no_expand;
+
+    return 0;
+} /* zQuerySpace */
+
+/*
+ * Allocate storage for the data structures common to all factor routines.
+ * For those unpredictable size, make a guess as FILL * nnz(A).
+ * Return value:
+ *     If lwork = -1, return the estimated amount of space required, plus n;
+ *     otherwise, return the amount of space actually allocated when
+ *     memory allocation failure occurred.
+ */
+int
+zLUMemInit(char *refact, void *work, int lwork, int m, int n, int annz,
+	  int panel_size, SuperMatrix *L, SuperMatrix *U, GlobalLU_t *Glu,
+	  int **iwork, doublecomplex **dwork)
+{
+    int      info, iword, dword;
+    SCformat *Lstore;
+    NCformat *Ustore;
+    int      *xsup, *supno;
+    int      *lsub, *xlsub;
+    doublecomplex   *lusup;
+    int      *xlusup;
+    doublecomplex   *ucol;
+    int      *usub, *xusub;
+    int      nzlmax, nzumax, nzlumax;
+    int      FILL = sp_ienv(6);
+    
+    Glu->n    = n;
+    no_expand = 0;
+    iword     = sizeof(int);
+    dword     = sizeof(doublecomplex);
+
+    expanders = (ExpHeader *) SUPERLU_MALLOC( NO_MEMTYPE * sizeof(ExpHeader) );
+    if ( !expanders ) ABORT("SUPERLU_MALLOC fails for expanders");
+    
+    if ( lsame_(refact, "N") ) {
+	/* Guess for L\U factors */
+	nzumax = nzlumax = FILL * annz;
+	nzlmax = MAX(1, FILL/4.) * annz;
+
+	if ( lwork == -1 ) {
+	    return ( GluIntArray(n) * iword + TempSpace(m, panel_size)
+		    + (nzlmax+nzumax)*iword + (nzlumax+nzumax)*dword + n );
+        } else {
+	    zSetupSpace(work, lwork, &Glu->MemModel);
+	}
+	
+#ifdef DEBUG		   
+	printf("zLUMemInit() called: annz %d, MemModel %d\n", 
+		annz, Glu->MemModel);
+#endif	
+	
+	/* Integer pointers for L\U factors */
+	if ( Glu->MemModel == SYSTEM ) {
+	    xsup   = intMalloc(n+1);
+	    supno  = intMalloc(n+1);
+	    xlsub  = intMalloc(n+1);
+	    xlusup = intMalloc(n+1);
+	    xusub  = intMalloc(n+1);
+	} else {
+	    xsup   = (int *)zuser_malloc((n+1) * iword, HEAD);
+	    supno  = (int *)zuser_malloc((n+1) * iword, HEAD);
+	    xlsub  = (int *)zuser_malloc((n+1) * iword, HEAD);
+	    xlusup = (int *)zuser_malloc((n+1) * iword, HEAD);
+	    xusub  = (int *)zuser_malloc((n+1) * iword, HEAD);
+	}
+
+	lusup = (doublecomplex *) zexpand( &nzlumax, LUSUP, 0, 0, Glu );
+	ucol  = (doublecomplex *) zexpand( &nzumax, UCOL, 0, 0, Glu );
+	lsub  = (int *)    zexpand( &nzlmax, LSUB, 0, 0, Glu );
+	usub  = (int *)    zexpand( &nzumax, USUB, 0, 1, Glu );
+
+	while ( !lusup || !ucol || !lsub || !usub ) {
+	    if ( Glu->MemModel == SYSTEM ) {
+		SUPERLU_FREE(lusup); 
+		SUPERLU_FREE(ucol); 
+		SUPERLU_FREE(lsub); 
+		SUPERLU_FREE(usub);
+	    } else {
+		zuser_free((nzlumax+nzumax)*dword+(nzlmax+nzumax)*iword, HEAD);
+	    }
+	    nzlumax /= 2;
+	    nzumax /= 2;
+	    nzlmax /= 2;
+	    if ( nzlumax < annz ) {
+		printf("Not enough memory to perform factorization.\n");
+		return (zmemory_usage(nzlmax, nzumax, nzlumax, n) + n);
+	    }
+	    lusup = (doublecomplex *) zexpand( &nzlumax, LUSUP, 0, 0, Glu );
+	    ucol  = (doublecomplex *) zexpand( &nzumax, UCOL, 0, 0, Glu );
+	    lsub  = (int *)    zexpand( &nzlmax, LSUB, 0, 0, Glu );
+	    usub  = (int *)    zexpand( &nzumax, USUB, 0, 1, Glu );
+	}
+	
+    } else {
+	/* refact == 'Y' */
+	Lstore   = L->Store;
+	Ustore   = U->Store;
+	xsup     = Lstore->sup_to_col;
+	supno    = Lstore->col_to_sup;
+	xlsub    = Lstore->rowind_colptr;
+	xlusup   = Lstore->nzval_colptr;
+	xusub    = Ustore->colptr;
+	nzlmax   = Glu->nzlmax;    /* max from previous factorization */
+	nzumax   = Glu->nzumax;
+	nzlumax  = Glu->nzlumax;
+	
+	if ( lwork == -1 ) {
+	    return ( GluIntArray(n) * iword + TempSpace(m, panel_size)
+		    + (nzlmax+nzumax)*iword + (nzlumax+nzumax)*dword + n );
+        } else if ( lwork == 0 ) {
+	    Glu->MemModel = SYSTEM;
+	} else {
+	    Glu->MemModel = USER;
+	    stack.top2 = (lwork/4)*4; /* must be word-addressable */
+	    stack.size = stack.top2;
+	}
+	
+	lsub  = expanders[LSUB].mem  = Lstore->rowind;
+	lusup = expanders[LUSUP].mem = Lstore->nzval;
+	usub  = expanders[USUB].mem  = Ustore->rowind;
+	ucol  = expanders[UCOL].mem  = Ustore->nzval;;
+	expanders[LSUB].size         = nzlmax;
+	expanders[LUSUP].size        = nzlumax;
+	expanders[USUB].size         = nzumax;
+	expanders[UCOL].size         = nzumax;	
+    }
+
+    Glu->xsup    = xsup;
+    Glu->supno   = supno;
+    Glu->lsub    = lsub;
+    Glu->xlsub   = xlsub;
+    Glu->lusup   = lusup;
+    Glu->xlusup  = xlusup;
+    Glu->ucol    = ucol;
+    Glu->usub    = usub;
+    Glu->xusub   = xusub;
+    Glu->nzlmax  = nzlmax;
+    Glu->nzumax  = nzumax;
+    Glu->nzlumax = nzlumax;
+    
+    info = zLUWorkInit(m, n, panel_size, iwork, dwork, Glu->MemModel);
+    if ( info )
+	return ( info + zmemory_usage(nzlmax, nzumax, nzlumax, n) + n);
+    
+    ++no_expand;
+    return 0;
+    
+} /* zLUMemInit */
+
+/* Allocate known working storage. Returns 0 if success, otherwise
+   returns the number of bytes allocated so far when failure occurred. */
+int
+zLUWorkInit(int m, int n, int panel_size, int **iworkptr, 
+            doublecomplex **dworkptr, LU_space_t MemModel)
+{
+    int    isize, dsize, extra;
+    doublecomplex *old_ptr;
+    int    maxsuper = sp_ienv(3),
+           rowblk   = sp_ienv(4);
+
+    isize = ( (2 * panel_size + 3 + NO_MARKER ) * m + n ) * sizeof(int);
+    dsize = (m * panel_size +
+	     NUM_TEMPV(m,panel_size,maxsuper,rowblk)) * sizeof(doublecomplex);
+    
+    if ( MemModel == SYSTEM ) 
+	*iworkptr = (int *) intCalloc(isize/sizeof(int));
+    else
+	*iworkptr = (int *) zuser_malloc(isize, TAIL);
+    if ( ! *iworkptr ) {
+	fprintf(stderr, "zLUWorkInit: malloc fails for local iworkptr[]\n");
+	return (isize + n);
+    }
+
+    if ( MemModel == SYSTEM )
+	*dworkptr = (doublecomplex *) SUPERLU_MALLOC(dsize);
+    else {
+	*dworkptr = (doublecomplex *) zuser_malloc(dsize, TAIL);
+	if ( NotDoubleAlign(*dworkptr) ) {
+	    old_ptr = *dworkptr;
+	    *dworkptr = (doublecomplex*) DoubleAlign(*dworkptr);
+	    *dworkptr = (doublecomplex*) ((double*)*dworkptr - 1);
+	    extra = (char*)old_ptr - (char*)*dworkptr;
+#ifdef DEBUG	    
+	    printf("zLUWorkInit: not aligned, extra %d\n", extra);
+#endif	    
+	    stack.top2 -= extra;
+	    stack.used += extra;
+	}
+    }
+    if ( ! *dworkptr ) {
+	fprintf(stderr, "malloc fails for local dworkptr[].");
+	return (isize + dsize + n);
+    }
+	
+    return 0;
+}
+
+
+/*
+ * Set up pointers for real working arrays.
+ */
+void
+zSetRWork(int m, int panel_size, doublecomplex *dworkptr,
+	 doublecomplex **dense, doublecomplex **tempv)
+{
+    doublecomplex zero = {0.0, 0.0};
+
+    int maxsuper = sp_ienv(3),
+        rowblk   = sp_ienv(4);
+    *dense = dworkptr;
+    *tempv = *dense + panel_size*m;
+    zfill (*dense, m * panel_size, zero);
+    zfill (*tempv, NUM_TEMPV(m,panel_size,maxsuper,rowblk), zero);     
+}
+	
+/*
+ * Free the working storage used by factor routines.
+ */
+void zLUWorkFree(int *iwork, doublecomplex *dwork, GlobalLU_t *Glu)
+{
+    if ( Glu->MemModel == SYSTEM ) {
+	SUPERLU_FREE (iwork);
+	SUPERLU_FREE (dwork);
+    } else {
+	stack.used -= (stack.size - stack.top2);
+	stack.top2 = stack.size;
+/*	zStackCompress(Glu);  */
+    }
+    
+    SUPERLU_FREE (expanders);
+}
+
+/* Expand the data structures for L and U during the factorization.
+ * Return value:   0 - successful return
+ *               > 0 - number of bytes allocated when run out of space
+ */
+int
+zLUMemXpand(int jcol,
+	   int next,          /* number of elements currently in the factors */
+	   MemType mem_type,  /* which type of memory to expand  */
+	   int *maxlen,       /* modified - maximum length of a data structure */
+	   GlobalLU_t *Glu    /* modified - global LU data structures */
+	   )
+{
+    void   *new_mem;
+    
+#ifdef DEBUG    
+    printf("zLUMemXpand(): jcol %d, next %d, maxlen %d, MemType %d\n",
+	   jcol, next, *maxlen, mem_type);
+#endif    
+
+    if (mem_type == USUB) 
+    	new_mem = zexpand(maxlen, mem_type, next, 1, Glu);
+    else
+	new_mem = zexpand(maxlen, mem_type, next, 0, Glu);
+    
+    if ( !new_mem ) {
+	int    nzlmax  = Glu->nzlmax;
+	int    nzumax  = Glu->nzumax;
+	int    nzlumax = Glu->nzlumax;
+    	fprintf(stderr, "Can't expand MemType %d: jcol %d\n", mem_type, jcol);
+    	return (zmemory_usage(nzlmax, nzumax, nzlumax, Glu->n) + Glu->n);
+    }
+
+    switch ( mem_type ) {
+      case LUSUP:
+	Glu->lusup   = (doublecomplex *) new_mem;
+	Glu->nzlumax = *maxlen;
+	break;
+      case UCOL:
+	Glu->ucol   = (doublecomplex *) new_mem;
+	Glu->nzumax = *maxlen;
+	break;
+      case LSUB:
+	Glu->lsub   = (int *) new_mem;
+	Glu->nzlmax = *maxlen;
+	break;
+      case USUB:
+	Glu->usub   = (int *) new_mem;
+	Glu->nzumax = *maxlen;
+	break;
+    }
+    
+    return 0;
+    
+}
+
+
+
+void
+copy_mem_doublecomplex(int howmany, void *old, void *new)
+{
+    register int i;
+    doublecomplex *dold = old;
+    doublecomplex *dnew = new;
+    for (i = 0; i < howmany; i++) dnew[i] = dold[i];
+}
+
+/*
+ * Expand the existing storage to accommodate more fill-ins.
+ */
+void
+*zexpand (
+	 int *prev_len,   /* length used from previous call */
+	 MemType type,    /* which part of the memory to expand */
+	 int len_to_copy, /* size of the memory to be copied to new store */
+	 int keep_prev,   /* = 1: use prev_len;
+			     = 0: compute new_len to expand */
+	 GlobalLU_t *Glu  /* modified - global LU data structures */
+	)
+{
+    float    EXPAND = 1.5;
+    float    alpha;
+    void     *new_mem, *old_mem;
+    int      new_len, tries, lword, extra, bytes_to_copy;
+
+    alpha = EXPAND;
+
+    if ( no_expand == 0 || keep_prev ) /* First time allocate requested */
+        new_len = *prev_len;
+    else {
+	new_len = alpha * *prev_len;
+    }
+    
+    if ( type == LSUB || type == USUB ) lword = sizeof(int);
+    else lword = sizeof(doublecomplex);
+
+    if ( Glu->MemModel == SYSTEM ) {
+	new_mem = (void *) SUPERLU_MALLOC(new_len * lword);
+/*	new_mem = (void *) calloc(new_len, lword); */
+	if ( no_expand != 0 ) {
+	    tries = 0;
+	    if ( keep_prev ) {
+		if ( !new_mem ) return (NULL);
+	    } else {
+		while ( !new_mem ) {
+		    if ( ++tries > 10 ) return (NULL);
+		    alpha = Reduce(alpha);
+		    new_len = alpha * *prev_len;
+		    new_mem = (void *) SUPERLU_MALLOC(new_len * lword); 
+/*		    new_mem = (void *) calloc(new_len, lword); */
+		}
+	    }
+	    if ( type == LSUB || type == USUB ) {
+		copy_mem_int(len_to_copy, expanders[type].mem, new_mem);
+	    } else {
+		copy_mem_doublecomplex(len_to_copy, expanders[type].mem, new_mem);
+	    }
+	    SUPERLU_FREE (expanders[type].mem);
+	}
+	expanders[type].mem = (void *) new_mem;
+	
+    } else { /* MemModel == USER */
+	if ( no_expand == 0 ) {
+	    new_mem = zuser_malloc(new_len * lword, HEAD);
+	    if ( NotDoubleAlign(new_mem) &&
+		(type == LUSUP || type == UCOL) ) {
+		old_mem = new_mem;
+		new_mem = (void *)DoubleAlign(new_mem);
+		extra = (char*)new_mem - (char*)old_mem;
+#ifdef DEBUG		
+		printf("expand(): not aligned, extra %d\n", extra);
+#endif		
+		stack.top1 += extra;
+		stack.used += extra;
+	    }
+	    expanders[type].mem = (void *) new_mem;
+	}
+	else {
+	    tries = 0;
+	    extra = (new_len - *prev_len) * lword;
+	    if ( keep_prev ) {
+		if ( StackFull(extra) ) return (NULL);
+	    } else {
+		while ( StackFull(extra) ) {
+		    if ( ++tries > 10 ) return (NULL);
+		    alpha = Reduce(alpha);
+		    new_len = alpha * *prev_len;
+		    extra = (new_len - *prev_len) * lword;	    
+		}
+	    }
+
+	    if ( type != USUB ) {
+		new_mem = (void*)((char*)expanders[type + 1].mem + extra);
+		bytes_to_copy = (char*)stack.array + stack.top1
+		    - (char*)expanders[type + 1].mem;
+		user_bcopy(expanders[type+1].mem, new_mem, bytes_to_copy);
+
+		if ( type < USUB ) {
+		    Glu->usub = expanders[USUB].mem =
+			(void*)((char*)expanders[USUB].mem + extra);
+		}
+		if ( type < LSUB ) {
+		    Glu->lsub = expanders[LSUB].mem =
+			(void*)((char*)expanders[LSUB].mem + extra);
+		}
+		if ( type < UCOL ) {
+		    Glu->ucol = expanders[UCOL].mem =
+			(void*)((char*)expanders[UCOL].mem + extra);
+		}
+		stack.top1 += extra;
+		stack.used += extra;
+		if ( type == UCOL ) {
+		    stack.top1 += extra;   /* Add same amount for USUB */
+		    stack.used += extra;
+		}
+		
+	    } /* if ... */
+
+	} /* else ... */
+    }
+
+    expanders[type].size = new_len;
+    *prev_len = new_len;
+    if ( no_expand ) ++no_expand;
+    
+    return (void *) expanders[type].mem;
+    
+} /* zexpand */
+
+
+/*
+ * Compress the work[] array to remove fragmentation.
+ */
+void
+zStackCompress(GlobalLU_t *Glu)
+{
+    register int iword, dword, bytes_to_copy, ndim;
+    char    *last, *fragment;
+    char     *src, *dest;
+    int      *ifrom, *ito;
+    doublecomplex   *dfrom, *dto;
+    int      *xlsub, *lsub, *xusub, *usub, *xlusup;
+    doublecomplex   *ucol, *lusup;
+    
+    iword = sizeof(int);
+    dword = sizeof(doublecomplex);
+    ndim = Glu->n;
+
+    xlsub  = Glu->xlsub;
+    lsub   = Glu->lsub;
+    xusub  = Glu->xusub;
+    usub   = Glu->usub;
+    xlusup = Glu->xlusup;
+    ucol   = Glu->ucol;
+    lusup  = Glu->lusup;
+    
+    dfrom = ucol;
+    dto = (doublecomplex *)((char*)lusup + xlusup[ndim] * dword);
+    copy_mem_doublecomplex(xusub[ndim], dfrom, dto);
+    ucol = dto;
+
+    ifrom = lsub;
+    ito = (int *) ((char*)ucol + xusub[ndim] * iword);
+    copy_mem_int(xlsub[ndim], ifrom, ito);
+    lsub = ito;
+    
+    ifrom = usub;
+    ito = (int *) ((char*)lsub + xlsub[ndim] * iword);
+    copy_mem_int(xusub[ndim], ifrom, ito);
+    usub = ito;
+    
+    last = (char*)usub + xusub[ndim] * iword;
+    fragment = (char*) (((char*)stack.array + stack.top1) - last);
+    stack.used -= (long int) fragment;
+    stack.top1 -= (long int) fragment;
+
+    Glu->ucol = ucol;
+    Glu->lsub = lsub;
+    Glu->usub = usub;
+    
+#ifdef DEBUG
+    printf("zStackCompress: fragment %d\n", fragment);
+    /* for (last = 0; last < ndim; ++last)
+	print_lu_col("After compress:", last, 0);*/
+#endif    
+    
+}
+
+/*
+ * Allocate storage for original matrix A
+ */
+void
+zallocateA(int n, int nnz, doublecomplex **a, int **asub, int **xa)
+{
+    *a    = (doublecomplex *) doublecomplexMalloc(nnz);
+    *asub = (int *) intMalloc(nnz);
+    *xa   = (int *) intMalloc(n+1);
+}
+
+
+doublecomplex *doublecomplexMalloc(int n)
+{
+    doublecomplex *buf;
+    buf = (doublecomplex *) SUPERLU_MALLOC(n * sizeof(doublecomplex)); 
+    if ( !buf ) {
+	ABORT("SUPERLU_MALLOC failed for buf in doublecomplexMalloc()\n");
+    }
+    return (buf);
+}
+
+doublecomplex *doublecomplexCalloc(int n)
+{
+    doublecomplex *buf;
+    register int i;
+    doublecomplex zero = {0.0, 0.0};
+    buf = (doublecomplex *) SUPERLU_MALLOC(n * sizeof(doublecomplex));
+    if ( !buf ) {
+	ABORT("SUPERLU_MALLOC failed for buf in doublecomplexCalloc()\n");
+    }
+    for (i = 0; i < n; ++i) buf[i] = zero;
+    return (buf);
+}
+
+
+int zmemory_usage(const int nzlmax, const int nzumax, 
+		  const int nzlumax, const int n)
+{
+    register int iword, dword;
+
+    iword   = sizeof(int);
+    dword   = sizeof(doublecomplex);
+    
+    return (10 * n * iword +
+	    nzlmax * iword + nzumax * (iword + dword) + nzlumax * dword);
+
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zpanel_bmod.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,480 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "zsp_defs.h"
+#include "util.h"
+
+/* 
+ * Function prototypes 
+ */
+void zlsolve(int, int, doublecomplex *, doublecomplex *);
+void zmatvec(int, int, int, doublecomplex *, doublecomplex *, doublecomplex *);
+extern void zcheck_tempv();
+
+void
+zpanel_bmod (
+	    const int  m,          /* in - number of rows in the matrix */
+	    const int  w,          /* in */
+	    const int  jcol,       /* in */
+	    const int  nseg,       /* in */
+	    doublecomplex     *dense,     /* out, of size n by w */
+	    doublecomplex     *tempv,     /* working array */
+	    int        *segrep,    /* in */
+	    int        *repfnz,    /* in, of size n by w */
+	    GlobalLU_t *Glu        /* modified */
+	    )
+{
+/* 
+ * Purpose
+ * =======
+ *
+ *    Performs numeric block updates (sup-panel) in topological order.
+ *    It features: col-col, 2cols-col, 3cols-col, and sup-col updates.
+ *    Special processing on the supernodal portion of L\U[*,j]
+ *
+ *    Before entering this routine, the original nonzeros in the panel 
+ *    were already copied into the spa[m,w].
+ *
+ *    Updated/Output parameters-
+ *	dense[0:m-1,w]: L[*,j:j+w-1] and U[*,j:j+w-1] are returned 
+ *      collectively in the m-by-w vector dense[*]. 
+ *
+ */
+
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+    _fcd ftcs1 = _cptofcd("L", strlen("L")),
+         ftcs2 = _cptofcd("N", strlen("N")),
+         ftcs3 = _cptofcd("U", strlen("U"));
+#endif
+    int          incx = 1, incy = 1;
+    doublecomplex       alpha, beta;
+#endif
+
+    register int k, ksub;
+    int          fsupc, nsupc, nsupr, nrow;
+    int          krep, krep_ind;
+    doublecomplex       ukj, ukj1, ukj2;
+    int          luptr, luptr1, luptr2;
+    int          segsze;
+    int          block_nrow;  /* no of rows in a block row */
+    register int lptr;	      /* Points to the row subscripts of a supernode */
+    int          kfnz, irow, no_zeros; 
+    register int isub, isub1, i;
+    register int jj;	      /* Index through each column in the panel */
+    int          *xsup, *supno;
+    int          *lsub, *xlsub;
+    doublecomplex       *lusup;
+    int          *xlusup;
+    int          *repfnz_col; /* repfnz[] for a column in the panel */
+    doublecomplex       *dense_col;  /* dense[] for a column in the panel */
+    doublecomplex       *tempv1;             /* Used in 1-D update */
+    doublecomplex       *TriTmp, *MatvecTmp; /* used in 2-D update */
+    doublecomplex      zero = {0.0, 0.0};
+    doublecomplex      one = {1.0, 0.0};
+    doublecomplex      comp_temp, comp_temp1;
+    register int ldaTmp;
+    register int r_ind, r_hi;
+    static   int first = 1, maxsuper, rowblk, colblk;
+    extern SuperLUStat_t SuperLUStat;
+    flops_t  *ops = SuperLUStat.ops;
+    
+    xsup    = Glu->xsup;
+    supno   = Glu->supno;
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    lusup   = Glu->lusup;
+    xlusup  = Glu->xlusup;
+    
+    if ( first ) {
+	maxsuper = sp_ienv(3);
+	rowblk   = sp_ienv(4);
+	colblk   = sp_ienv(5);
+	first = 0;
+    }
+    ldaTmp = maxsuper + rowblk;
+
+    /* 
+     * For each nonz supernode segment of U[*,j] in topological order 
+     */
+    k = nseg - 1;
+    for (ksub = 0; ksub < nseg; ksub++) { /* for each updating supernode */
+
+	/* krep = representative of current k-th supernode
+	 * fsupc = first supernodal column
+	 * nsupc = no of columns in a supernode
+	 * nsupr = no of rows in a supernode
+	 */
+        krep = segrep[k--];
+	fsupc = xsup[supno[krep]];
+	nsupc = krep - fsupc + 1;
+	nsupr = xlsub[fsupc+1] - xlsub[fsupc];
+	nrow = nsupr - nsupc;
+	lptr = xlsub[fsupc];
+	krep_ind = lptr + nsupc - 1;
+
+	repfnz_col = repfnz;
+	dense_col = dense;
+	
+	if ( nsupc >= colblk && nrow > rowblk ) { /* 2-D block update */
+
+	    TriTmp = tempv;
+	
+	    /* Sequence through each column in panel -- triangular solves */
+	    for (jj = jcol; jj < jcol + w; jj++,
+		 repfnz_col += m, dense_col += m, TriTmp += ldaTmp ) {
+
+		kfnz = repfnz_col[krep];
+		if ( kfnz == EMPTY ) continue;	/* Skip any zero segment */
+	    
+		segsze = krep - kfnz + 1;
+		luptr = xlusup[fsupc];
+
+		ops[TRSV] += 4 * segsze * (segsze - 1);
+		ops[GEMV] += 8 * nrow * segsze;
+	
+		/* Case 1: Update U-segment of size 1 -- col-col update */
+		if ( segsze == 1 ) {
+		    ukj = dense_col[lsub[krep_ind]];
+		    luptr += nsupr*(nsupc-1) + nsupc;
+
+		    for (i = lptr + nsupc; i < xlsub[fsupc+1]; i++) {
+			irow = lsub[i];
+	    	        zz_mult(&comp_temp, &ukj, &lusup[luptr]);
+		        z_sub(&dense_col[irow], &dense_col[irow], &comp_temp);
+			++luptr;
+		    }
+
+		} else if ( segsze <= 3 ) {
+		    ukj = dense_col[lsub[krep_ind]];
+		    ukj1 = dense_col[lsub[krep_ind - 1]];
+		    luptr += nsupr*(nsupc-1) + nsupc-1;
+		    luptr1 = luptr - nsupr;
+
+		    if ( segsze == 2 ) {
+		        zz_mult(&comp_temp, &ukj1, &lusup[luptr1]);
+		        z_sub(&ukj, &ukj, &comp_temp);
+			dense_col[lsub[krep_ind]] = ukj;
+			for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+			    irow = lsub[i];
+			    luptr++; luptr1++;
+			    zz_mult(&comp_temp, &ukj, &lusup[luptr]);
+			    zz_mult(&comp_temp1, &ukj1, &lusup[luptr1]);
+			    z_add(&comp_temp, &comp_temp, &comp_temp1);
+			    z_sub(&dense_col[irow], &dense_col[irow], &comp_temp);
+			}
+		    } else {
+			ukj2 = dense_col[lsub[krep_ind - 2]];
+			luptr2 = luptr1 - nsupr;
+  		        zz_mult(&comp_temp, &ukj2, &lusup[luptr2-1]);
+		        z_sub(&ukj1, &ukj1, &comp_temp);
+
+		        zz_mult(&comp_temp, &ukj1, &lusup[luptr1]);
+        		zz_mult(&comp_temp1, &ukj2, &lusup[luptr2]);
+		        z_add(&comp_temp, &comp_temp, &comp_temp1);
+		        z_sub(&ukj, &ukj, &comp_temp);
+			dense_col[lsub[krep_ind]] = ukj;
+			dense_col[lsub[krep_ind-1]] = ukj1;
+			for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+			    irow = lsub[i];
+			    luptr++; luptr1++; luptr2++;
+			    zz_mult(&comp_temp, &ukj, &lusup[luptr]);
+			    zz_mult(&comp_temp1, &ukj1, &lusup[luptr1]);
+			    z_add(&comp_temp, &comp_temp, &comp_temp1);
+			    zz_mult(&comp_temp1, &ukj2, &lusup[luptr2]);
+			    z_add(&comp_temp, &comp_temp, &comp_temp1);
+			    z_sub(&dense_col[irow], &dense_col[irow], &comp_temp);
+			}
+		    }
+
+		} else  {	/* segsze >= 4 */
+		    
+		    /* Copy U[*,j] segment from dense[*] to TriTmp[*], which
+		       holds the result of triangular solves.    */
+		    no_zeros = kfnz - fsupc;
+		    isub = lptr + no_zeros;
+		    for (i = 0; i < segsze; ++i) {
+			irow = lsub[isub];
+			TriTmp[i] = dense_col[irow]; /* Gather */
+			++isub;
+		    }
+		    
+		    /* start effective triangle */
+		    luptr += nsupr * no_zeros + no_zeros;
+
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		    CTRSV( ftcs1, ftcs2, ftcs3, &segsze, &lusup[luptr], 
+			   &nsupr, TriTmp, &incx );
+#else
+		    ztrsv_( "L", "N", "U", &segsze, &lusup[luptr], 
+			   &nsupr, TriTmp, &incx );
+#endif
+#else		
+		    zlsolve ( nsupr, segsze, &lusup[luptr], TriTmp );
+#endif
+		    
+
+		} /* else ... */
+	    
+	    }  /* for jj ... end tri-solves */
+
+	    /* Block row updates; push all the way into dense[*] block */
+	    for ( r_ind = 0; r_ind < nrow; r_ind += rowblk ) {
+		
+		r_hi = MIN(nrow, r_ind + rowblk);
+		block_nrow = MIN(rowblk, r_hi - r_ind);
+		luptr = xlusup[fsupc] + nsupc + r_ind;
+		isub1 = lptr + nsupc + r_ind;
+		
+		repfnz_col = repfnz;
+		TriTmp = tempv;
+		dense_col = dense;
+		
+		/* Sequence through each column in panel -- matrix-vector */
+		for (jj = jcol; jj < jcol + w; jj++,
+		     repfnz_col += m, dense_col += m, TriTmp += ldaTmp) {
+		    
+		    kfnz = repfnz_col[krep];
+		    if ( kfnz == EMPTY ) continue; /* Skip any zero segment */
+		    
+		    segsze = krep - kfnz + 1;
+		    if ( segsze <= 3 ) continue;   /* skip unrolled cases */
+		    
+		    /* Perform a block update, and scatter the result of
+		       matrix-vector to dense[].		 */
+		    no_zeros = kfnz - fsupc;
+		    luptr1 = luptr + nsupr * no_zeros;
+		    MatvecTmp = &TriTmp[maxsuper];
+		    
+#ifdef USE_VENDOR_BLAS
+		    alpha = one; 
+                    beta = zero;
+#ifdef _CRAY
+		    CGEMV(ftcs2, &block_nrow, &segsze, &alpha, &lusup[luptr1], 
+			   &nsupr, TriTmp, &incx, &beta, MatvecTmp, &incy);
+#else
+		    zgemv_("N", &block_nrow, &segsze, &alpha, &lusup[luptr1], 
+			   &nsupr, TriTmp, &incx, &beta, MatvecTmp, &incy);
+#endif
+#else
+		    zmatvec(nsupr, block_nrow, segsze, &lusup[luptr1],
+			   TriTmp, MatvecTmp);
+#endif
+		    
+		    /* Scatter MatvecTmp[*] into SPA dense[*] temporarily
+		     * such that MatvecTmp[*] can be re-used for the
+		     * the next blok row update. dense[] will be copied into 
+		     * global store after the whole panel has been finished.
+		     */
+		    isub = isub1;
+		    for (i = 0; i < block_nrow; i++) {
+			irow = lsub[isub];
+		        z_sub(&dense_col[irow], &dense_col[irow], 
+                              &MatvecTmp[i]);
+			MatvecTmp[i] = zero;
+			++isub;
+		    }
+		    
+		} /* for jj ... */
+		
+	    } /* for each block row ... */
+	    
+	    /* Scatter the triangular solves into SPA dense[*] */
+	    repfnz_col = repfnz;
+	    TriTmp = tempv;
+	    dense_col = dense;
+	    
+	    for (jj = jcol; jj < jcol + w; jj++,
+		 repfnz_col += m, dense_col += m, TriTmp += ldaTmp) {
+		kfnz = repfnz_col[krep];
+		if ( kfnz == EMPTY ) continue; /* Skip any zero segment */
+		
+		segsze = krep - kfnz + 1;
+		if ( segsze <= 3 ) continue; /* skip unrolled cases */
+		
+		no_zeros = kfnz - fsupc;		
+		isub = lptr + no_zeros;
+		for (i = 0; i < segsze; i++) {
+		    irow = lsub[isub];
+		    dense_col[irow] = TriTmp[i];
+		    TriTmp[i] = zero;
+		    ++isub;
+		}
+		
+	    } /* for jj ... */
+	    
+	} else { /* 1-D block modification */
+	    
+	    
+	    /* Sequence through each column in the panel */
+	    for (jj = jcol; jj < jcol + w; jj++,
+		 repfnz_col += m, dense_col += m) {
+		
+		kfnz = repfnz_col[krep];
+		if ( kfnz == EMPTY ) continue;	/* Skip any zero segment */
+		
+		segsze = krep - kfnz + 1;
+		luptr = xlusup[fsupc];
+
+		ops[TRSV] += 4 * segsze * (segsze - 1);
+		ops[GEMV] += 8 * nrow * segsze;
+		
+		/* Case 1: Update U-segment of size 1 -- col-col update */
+		if ( segsze == 1 ) {
+		    ukj = dense_col[lsub[krep_ind]];
+		    luptr += nsupr*(nsupc-1) + nsupc;
+
+		    for (i = lptr + nsupc; i < xlsub[fsupc+1]; i++) {
+			irow = lsub[i];
+	    	        zz_mult(&comp_temp, &ukj, &lusup[luptr]);
+		        z_sub(&dense_col[irow], &dense_col[irow], &comp_temp);
+			++luptr;
+		    }
+
+		} else if ( segsze <= 3 ) {
+		    ukj = dense_col[lsub[krep_ind]];
+		    luptr += nsupr*(nsupc-1) + nsupc-1;
+		    ukj1 = dense_col[lsub[krep_ind - 1]];
+		    luptr1 = luptr - nsupr;
+
+		    if ( segsze == 2 ) {
+		        zz_mult(&comp_temp, &ukj1, &lusup[luptr1]);
+		        z_sub(&ukj, &ukj, &comp_temp);
+			dense_col[lsub[krep_ind]] = ukj;
+			for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+			    irow = lsub[i];
+			    ++luptr;  ++luptr1;
+			    zz_mult(&comp_temp, &ukj, &lusup[luptr]);
+			    zz_mult(&comp_temp1, &ukj1, &lusup[luptr1]);
+			    z_add(&comp_temp, &comp_temp, &comp_temp1);
+			    z_sub(&dense_col[irow], &dense_col[irow], &comp_temp);
+			}
+		    } else {
+			ukj2 = dense_col[lsub[krep_ind - 2]];
+			luptr2 = luptr1 - nsupr;
+  		        zz_mult(&comp_temp, &ukj2, &lusup[luptr2-1]);
+		        z_sub(&ukj1, &ukj1, &comp_temp);
+
+		        zz_mult(&comp_temp, &ukj1, &lusup[luptr1]);
+        		zz_mult(&comp_temp1, &ukj2, &lusup[luptr2]);
+		        z_add(&comp_temp, &comp_temp, &comp_temp1);
+		        z_sub(&ukj, &ukj, &comp_temp);
+			dense_col[lsub[krep_ind]] = ukj;
+			dense_col[lsub[krep_ind-1]] = ukj1;
+			for (i = lptr + nsupc; i < xlsub[fsupc+1]; ++i) {
+			    irow = lsub[i];
+			    ++luptr; ++luptr1; ++luptr2;
+			    zz_mult(&comp_temp, &ukj, &lusup[luptr]);
+			    zz_mult(&comp_temp1, &ukj1, &lusup[luptr1]);
+			    z_add(&comp_temp, &comp_temp, &comp_temp1);
+			    zz_mult(&comp_temp1, &ukj2, &lusup[luptr2]);
+			    z_add(&comp_temp, &comp_temp, &comp_temp1);
+			    z_sub(&dense_col[irow], &dense_col[irow], &comp_temp);
+			}
+		    }
+
+		} else  { /* segsze >= 4 */
+		    /* 
+		     * Perform a triangular solve and block update,
+		     * then scatter the result of sup-col update to dense[].
+		     */
+		    no_zeros = kfnz - fsupc;
+		    
+		    /* Copy U[*,j] segment from dense[*] to tempv[*]: 
+		     *    The result of triangular solve is in tempv[*];
+		     *    The result of matrix vector update is in dense_col[*]
+		     */
+		    isub = lptr + no_zeros;
+		    for (i = 0; i < segsze; ++i) {
+			irow = lsub[isub];
+			tempv[i] = dense_col[irow]; /* Gather */
+			++isub;
+		    }
+		    
+		    /* start effective triangle */
+		    luptr += nsupr * no_zeros + no_zeros;
+		    
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		    CTRSV( ftcs1, ftcs2, ftcs3, &segsze, &lusup[luptr], 
+			   &nsupr, tempv, &incx );
+#else
+		    ztrsv_( "L", "N", "U", &segsze, &lusup[luptr], 
+			   &nsupr, tempv, &incx );
+#endif
+		    
+		    luptr += segsze;	/* Dense matrix-vector */
+		    tempv1 = &tempv[segsze];
+                    alpha = one;
+                    beta = zero;
+#ifdef _CRAY
+		    CGEMV( ftcs2, &nrow, &segsze, &alpha, &lusup[luptr], 
+			   &nsupr, tempv, &incx, &beta, tempv1, &incy );
+#else
+		    zgemv_( "N", &nrow, &segsze, &alpha, &lusup[luptr], 
+			   &nsupr, tempv, &incx, &beta, tempv1, &incy );
+#endif
+#else
+		    zlsolve ( nsupr, segsze, &lusup[luptr], tempv );
+		    
+		    luptr += segsze;        /* Dense matrix-vector */
+		    tempv1 = &tempv[segsze];
+		    zmatvec (nsupr, nrow, segsze, &lusup[luptr], tempv, tempv1);
+#endif
+		    
+		    /* Scatter tempv[*] into SPA dense[*] temporarily, such
+		     * that tempv[*] can be used for the triangular solve of
+		     * the next column of the panel. They will be copied into 
+		     * ucol[*] after the whole panel has been finished.
+		     */
+		    isub = lptr + no_zeros;
+		    for (i = 0; i < segsze; i++) {
+			irow = lsub[isub];
+			dense_col[irow] = tempv[i];
+			tempv[i] = zero;
+			isub++;
+		    }
+		    
+		    /* Scatter the update from tempv1[*] into SPA dense[*] */
+		    /* Start dense rectangular L */
+		    for (i = 0; i < nrow; i++) {
+			irow = lsub[isub];
+		        z_sub(&dense_col[irow], &dense_col[irow], &tempv1[i]);
+			tempv1[i] = zero;
+			++isub;	
+		    }
+		    
+		} /* else segsze>=4 ... */
+		
+	    } /* for each column in the panel... */
+	    
+	} /* else 1-D update ... */
+
+    } /* for each updating supernode ... */
+
+}
+
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zpanel_dfs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,249 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "zsp_defs.h"
+#include "util.h"
+
+void
+zpanel_dfs (
+	   const int  m,           /* in - number of rows in the matrix */
+	   const int  w,           /* in */
+	   const int  jcol,        /* in */
+	   SuperMatrix *A,       /* in - original matrix */
+	   int        *perm_r,     /* in */
+	   int        *nseg,	   /* out */
+	   doublecomplex     *dense,      /* out */
+	   int        *panel_lsub, /* out */
+	   int        *segrep,     /* out */
+	   int        *repfnz,     /* out */
+	   int        *xprune,     /* out */
+	   int        *marker,     /* out */     
+	   int        *parent,     /* working array */
+	   int        *xplore,     /* working array */
+	   GlobalLU_t *Glu         /* modified */
+	   )
+{
+/*
+ * Purpose
+ * =======
+ *
+ *   Performs a symbolic factorization on a panel of columns [jcol, jcol+w).
+ *
+ *   A supernode representative is the last column of a supernode.
+ *   The nonzeros in U[*,j] are segments that end at supernodal
+ *   representatives.
+ *
+ *   The routine returns one list of the supernodal representatives
+ *   in topological order of the dfs that generates them. This list is
+ *   a superset of the topological order of each individual column within
+ *   the panel. 
+ *   The location of the first nonzero in each supernodal segment
+ *   (supernodal entry location) is also returned. Each column has a 
+ *   separate list for this purpose.
+ *
+ *   Two marker arrays are used for dfs:
+ *     marker[i] == jj, if i was visited during dfs of current column jj;
+ *     marker1[i] >= jcol, if i was visited by earlier columns in this panel;
+ *
+ *   marker: A-row --> A-row/col (0/1)
+ *   repfnz: SuperA-col --> PA-row
+ *   parent: SuperA-col --> SuperA-col
+ *   xplore: SuperA-col --> index to L-structure
+ *
+ */
+    NCPformat *Astore;
+    doublecomplex    *a;
+    int       *asub;
+    int       *xa_begin, *xa_end;
+    int	      krep, chperm, chmark, chrep, oldrep, kchild, myfnz;
+    int       k, krow, kmark, kperm;
+    int       xdfs, maxdfs, kpar;
+    int       jj;	   /* index through each column in the panel */
+    int       *marker1;	   /* marker1[jj] >= jcol if vertex jj was visited 
+			      by a previous column within this panel.   */
+    int       *repfnz_col; /* start of each column in the panel */
+    doublecomplex    *dense_col;  /* start of each column in the panel */
+    int       nextl_col;   /* next available position in panel_lsub[*,jj] */
+    int       *xsup, *supno;
+    int       *lsub, *xlsub;
+
+    /* Initialize pointers */
+    Astore     = A->Store;
+    a          = Astore->nzval;
+    asub       = Astore->rowind;
+    xa_begin   = Astore->colbeg;
+    xa_end     = Astore->colend;
+    marker1    = marker + m;
+    repfnz_col = repfnz;
+    dense_col  = dense;
+    *nseg      = 0;
+    xsup       = Glu->xsup;
+    supno      = Glu->supno;
+    lsub       = Glu->lsub;
+    xlsub      = Glu->xlsub;
+
+    /* For each column in the panel */
+    for (jj = jcol; jj < jcol + w; jj++) {
+	nextl_col = (jj - jcol) * m;
+
+#ifdef CHK_DFS
+	printf("\npanel col %d: ", jj);
+#endif
+
+	/* For each nonz in A[*,jj] do dfs */
+	for (k = xa_begin[jj]; k < xa_end[jj]; k++) {
+	    krow = asub[k];
+            dense_col[krow] = a[k];
+	    kmark = marker[krow];    	
+	    if ( kmark == jj ) 
+		continue;     /* krow visited before, go to the next nonzero */
+
+	    /* For each unmarked nbr krow of jj
+	     * krow is in L: place it in structure of L[*,jj]
+	     */
+	    marker[krow] = jj;
+	    kperm = perm_r[krow];
+	    
+	    if ( kperm == EMPTY ) {
+		panel_lsub[nextl_col++] = krow; /* krow is indexed into A */
+	    }
+	    /* 
+	     * krow is in U: if its supernode-rep krep
+	     * has been explored, update repfnz[*]
+	     */
+	    else {
+		
+		krep = xsup[supno[kperm]+1] - 1;
+		myfnz = repfnz_col[krep];
+		
+#ifdef CHK_DFS
+		printf("krep %d, myfnz %d, perm_r[%d] %d\n", krep, myfnz, krow, kperm);
+#endif
+		if ( myfnz != EMPTY ) {	/* Representative visited before */
+		    if ( myfnz > kperm ) repfnz_col[krep] = kperm;
+		    /* continue; */
+		}
+		else {
+		    /* Otherwise, perform dfs starting at krep */
+		    oldrep = EMPTY;
+		    parent[krep] = oldrep;
+		    repfnz_col[krep] = kperm;
+		    xdfs = xlsub[krep];
+		    maxdfs = xprune[krep];
+		    
+#ifdef CHK_DFS 
+		    printf("  xdfs %d, maxdfs %d: ", xdfs, maxdfs);
+		    for (i = xdfs; i < maxdfs; i++) printf(" %d", lsub[i]);
+		    printf("\n");
+#endif
+		    do {
+			/* 
+			 * For each unmarked kchild of krep 
+			 */
+			while ( xdfs < maxdfs ) {
+			    
+			    kchild = lsub[xdfs];
+			    xdfs++;
+			    chmark = marker[kchild];
+			    
+			    if ( chmark != jj ) { /* Not reached yet */
+				marker[kchild] = jj;
+				chperm = perm_r[kchild];
+			      
+				/* Case kchild is in L: place it in L[*,j] */
+				if ( chperm == EMPTY ) {
+				    panel_lsub[nextl_col++] = kchild;
+				} 
+				/* Case kchild is in U: 
+				 *   chrep = its supernode-rep. If its rep has 
+				 *   been explored, update its repfnz[*]
+				 */
+				else {
+				    
+				    chrep = xsup[supno[chperm]+1] - 1;
+				    myfnz = repfnz_col[chrep];
+#ifdef CHK_DFS
+				    printf("chrep %d,myfnz %d,perm_r[%d] %d\n",chrep,myfnz,kchild,chperm);
+#endif
+				    if ( myfnz != EMPTY ) { /* Visited before */
+					if ( myfnz > chperm )
+					    repfnz_col[chrep] = chperm;
+				    }
+				    else {
+					/* Cont. dfs at snode-rep of kchild */
+					xplore[krep] = xdfs;	
+					oldrep = krep;
+					krep = chrep; /* Go deeper down G(L) */
+					parent[krep] = oldrep;
+					repfnz_col[krep] = chperm;
+					xdfs = xlsub[krep];     
+					maxdfs = xprune[krep];
+#ifdef CHK_DFS 
+					printf("  xdfs %d, maxdfs %d: ", xdfs, maxdfs);
+					for (i = xdfs; i < maxdfs; i++) printf(" %d", lsub[i]);	
+					printf("\n");
+#endif
+				    } /* else */
+				  
+				} /* else */
+			      
+			    } /* if... */
+			    
+			} /* while xdfs < maxdfs */
+			
+			/* krow has no more unexplored nbrs:
+			 *    Place snode-rep krep in postorder DFS, if this 
+			 *    segment is seen for the first time. (Note that
+			 *    "repfnz[krep]" may change later.)
+			 *    Backtrack dfs to its parent.
+			 */
+			if ( marker1[krep] < jcol ) {
+			    segrep[*nseg] = krep;
+			    ++(*nseg);
+			    marker1[krep] = jj;
+			}
+			
+			kpar = parent[krep]; /* Pop stack, mimic recursion */
+			if ( kpar == EMPTY ) break; /* dfs done */
+			krep = kpar;
+			xdfs = xplore[krep];
+			maxdfs = xprune[krep];
+			
+#ifdef CHK_DFS 
+			printf("  pop stack: krep %d,xdfs %d,maxdfs %d: ", krep,xdfs,maxdfs);
+			for (i = xdfs; i < maxdfs; i++) printf(" %d", lsub[i]);
+			printf("\n");
+#endif
+		    } while ( kpar != EMPTY ); /* do-while - until empty stack */
+		    
+		} /* else */
+		
+	    } /* else */
+	    
+	} /* for each nonz in A[*,jj] */
+	
+	repfnz_col += m;    /* Move to next column */
+        dense_col += m;
+	
+    } /* for jj ... */
+    
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zpivotL.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,176 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include <math.h>
+#include <stdlib.h>
+#include "zsp_defs.h"
+#include "util.h"
+
+#undef DEBUG
+
+int
+zpivotL(
+        const int  jcol,     /* in */
+        const double u,      /* in - diagonal pivoting threshold */
+        int        *usepr,   /* re-use the pivot sequence given by perm_r/iperm_r */
+        int        *perm_r,  /* may be modified */
+        int        *iperm_r, /* in - inverse of perm_r */
+        int        *iperm_c, /* in - used to find diagonal of Pc*A*Pc' */
+        int        *pivrow,  /* out */
+        GlobalLU_t *Glu      /* modified - global LU data structures */
+       )
+{
+/*
+ * Purpose
+ * =======
+ *   Performs the numerical pivoting on the current column of L,
+ *   and the CDIV operation.
+ *
+ *   Pivot policy:
+ *   (1) Compute thresh = u * max_(i>=j) abs(A_ij);
+ *   (2) IF user specifies pivot row k and abs(A_kj) >= thresh THEN
+ *           pivot row = k;
+ *       ELSE IF abs(A_jj) >= thresh THEN
+ *           pivot row = j;
+ *       ELSE
+ *           pivot row = m;
+ * 
+ *   Note: If you absolutely want to use a given pivot order, then set u=0.0.
+ *
+ *   Return value: 0      success;
+ *                 i > 0  U(i,i) is exactly zero.
+ *
+ */
+    doublecomplex one = {1.0, 0.0};
+    int          fsupc;	    /* first column in the supernode */
+    int          nsupc;	    /* no of columns in the supernode */
+    int          nsupr;     /* no of rows in the supernode */
+    int          lptr;	    /* points to the starting subscript of the supernode */
+    int          pivptr, old_pivptr, diag, diagind;
+    double       pivmax, rtemp, thresh;
+    doublecomplex       temp;
+    doublecomplex       *lu_sup_ptr; 
+    doublecomplex       *lu_col_ptr;
+    int          *lsub_ptr;
+    int          isub, icol, k, itemp;
+    int          *lsub, *xlsub;
+    doublecomplex       *lusup;
+    int          *xlusup;
+    extern SuperLUStat_t SuperLUStat;
+    flops_t  *ops = SuperLUStat.ops;
+
+    /* Initialize pointers */
+    lsub       = Glu->lsub;
+    xlsub      = Glu->xlsub;
+    lusup      = Glu->lusup;
+    xlusup     = Glu->xlusup;
+    fsupc      = (Glu->xsup)[(Glu->supno)[jcol]];
+    nsupc      = jcol - fsupc;	        /* excluding jcol; nsupc >= 0 */
+    lptr       = xlsub[fsupc];
+    nsupr      = xlsub[fsupc+1] - lptr;
+    lu_sup_ptr = &lusup[xlusup[fsupc]];	/* start of the current supernode */
+    lu_col_ptr = &lusup[xlusup[jcol]];	/* start of jcol in the supernode */
+    lsub_ptr   = &lsub[lptr];	/* start of row indices of the supernode */
+
+#ifdef DEBUG
+if ( jcol == MIN_COL ) {
+    printf("Before cdiv: col %d\n", jcol);
+    for (k = nsupc; k < nsupr; k++) 
+	printf("  lu[%d] %f\n", lsub_ptr[k], lu_col_ptr[k]);
+}
+#endif
+    
+    /* Determine the largest abs numerical value for partial pivoting;
+       Also search for user-specified pivot, and diagonal element. */
+    if ( *usepr ) *pivrow = iperm_r[jcol];
+    diagind = iperm_c[jcol];
+    pivmax = 0.0;
+    pivptr = nsupc;
+    diag = EMPTY;
+    old_pivptr = nsupc;
+    for (isub = nsupc; isub < nsupr; ++isub) {
+        rtemp = z_abs1 (&lu_col_ptr[isub]);
+	if ( rtemp > pivmax ) {
+	    pivmax = rtemp;
+	    pivptr = isub;
+	}
+	if ( *usepr && lsub_ptr[isub] == *pivrow ) old_pivptr = isub;
+	if ( lsub_ptr[isub] == diagind ) diag = isub;
+    }
+
+    /* Test for singularity */
+    if ( pivmax == 0.0 ) {
+	*pivrow = lsub_ptr[pivptr];
+	perm_r[*pivrow] = jcol;
+	*usepr = 0;
+	return (jcol+1);
+    }
+
+    thresh = u * pivmax;
+    
+    /* Choose appropriate pivotal element by our policy. */
+    if ( *usepr ) {
+        rtemp = z_abs1 (&lu_col_ptr[old_pivptr]);
+	if ( rtemp != 0.0 && rtemp >= thresh )
+	    pivptr = old_pivptr;
+	else
+	    *usepr = 0;
+    }
+    if ( *usepr == 0 ) {
+	/* Use diagonal pivot? */
+	if ( diag >= 0 ) { /* diagonal exists */
+            rtemp = z_abs1 (&lu_col_ptr[diag]);
+	    if ( rtemp != 0.0 && rtemp >= thresh ) pivptr = diag;
+        }
+	*pivrow = lsub_ptr[pivptr];
+    }
+    
+    /* Record pivot row */
+    perm_r[*pivrow] = jcol;
+    
+    /* Interchange row subscripts */
+    if ( pivptr != nsupc ) {
+	itemp = lsub_ptr[pivptr];
+	lsub_ptr[pivptr] = lsub_ptr[nsupc];
+	lsub_ptr[nsupc] = itemp;
+
+	/* Interchange numerical values as well, for the whole snode, such 
+	 * that L is indexed the same way as A.
+ 	 */
+	for (icol = 0; icol <= nsupc; icol++) {
+	    itemp = pivptr + icol * nsupr;
+	    temp = lu_sup_ptr[itemp];
+	    lu_sup_ptr[itemp] = lu_sup_ptr[nsupc + icol*nsupr];
+	    lu_sup_ptr[nsupc + icol*nsupr] = temp;
+	}
+    } /* if */
+
+    /* cdiv operation */
+    ops[FACT] += 10 * (nsupr - nsupc);
+
+    z_div(&temp, &one, &lu_col_ptr[nsupc]);
+    for (k = nsupc+1; k < nsupr; k++) 
+	zz_mult(&lu_col_ptr[k], &lu_col_ptr[k], &temp);
+
+    return 0;
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zpivotgrowth.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,110 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include <math.h>
+#include "zsp_defs.h"
+#include "util.h"
+
+double
+zPivotGrowth(int ncols, SuperMatrix *A, int *perm_c, 
+             SuperMatrix *L, SuperMatrix *U)
+{
+/*
+ * Purpose
+ * =======
+ *
+ * Compute the reciprocal pivot growth factor of the leading ncols columns
+ * of the matrix, using the formula:
+ *     min_j ( max_i(abs(A_ij)) / max_i(abs(U_ij)) )
+ *
+ * Arguments
+ * =========
+ *
+ * ncols    (input) int
+ *          The number of columns of matrices A, L and U.
+ *
+ * A        (input) SuperMatrix*
+ *	    Original matrix A, permuted by columns, of dimension
+ *          (A->nrow, A->ncol). The type of A can be:
+ *          Stype = NC; Dtype = _Z; Mtype = GE.
+ *
+ * L        (output) SuperMatrix*
+ *          The factor L from the factorization Pr*A=L*U; use compressed row 
+ *          subscripts storage for supernodes, i.e., L has type: 
+ *          Stype = SC; Dtype = _Z; Mtype = TRLU.
+ *
+ * U        (output) SuperMatrix*
+ *	    The factor U from the factorization Pr*A*Pc=L*U. Use column-wise
+ *          storage scheme, i.e., U has types: Stype = NC;
+ *          Dtype = _Z; Mtype = TRU.
+ *
+ */
+    NCformat *Astore;
+    SCformat *Lstore;
+    NCformat *Ustore;
+    doublecomplex  *Aval, *Lval, *Uval;
+    int      fsupc, nsupr, luptr, nz_in_U;
+    int      i, j, k, oldcol;
+    int      *inv_perm_c;
+    double   rpg, maxaj, maxuj;
+    extern   double dlamch_(char *);
+    double   smlnum;
+    doublecomplex   *luval;
+    doublecomplex   temp_comp;
+   
+    /* Get machine constants. */
+    smlnum = dlamch_("S");
+    rpg = 1. / smlnum;
+
+    Astore = A->Store;
+    Lstore = L->Store;
+    Ustore = U->Store;
+    Aval = Astore->nzval;
+    Lval = Lstore->nzval;
+    Uval = Ustore->nzval;
+    
+    inv_perm_c = (int *) SUPERLU_MALLOC(A->ncol*sizeof(int));
+    for (j = 0; j < A->ncol; ++j) inv_perm_c[perm_c[j]] = j;
+
+    for (k = 0; k <= Lstore->nsuper; ++k) {
+	fsupc = L_FST_SUPC(k);
+	nsupr = L_SUB_START(fsupc+1) - L_SUB_START(fsupc);
+	luptr = L_NZ_START(fsupc);
+	luval = &Lval[luptr];
+	nz_in_U = 1;
+	
+	for (j = fsupc; j < L_FST_SUPC(k+1) && j < ncols; ++j) {
+	    maxaj = 0.;
+            oldcol = inv_perm_c[j];
+	    for (i = Astore->colptr[oldcol]; i < Astore->colptr[oldcol+1]; ++i)
+		maxaj = MAX( maxaj, z_abs1( &Aval[i]) );
+	
+	    maxuj = 0.;
+	    for (i = Ustore->colptr[j]; i < Ustore->colptr[j+1]; i++)
+		maxuj = MAX( maxuj, z_abs1( &Uval[i]) );
+	    
+	    /* Supernode */
+	    for (i = 0; i < nz_in_U; ++i)
+		maxuj = MAX( maxuj, z_abs1( &luval[i]) );
+
+	    ++nz_in_U;
+	    luval += nsupr;
+
+	    if ( maxuj == 0. )
+		rpg = MIN( rpg, 1.);
+	    else
+		rpg = MIN( rpg, maxaj / maxuj );
+	}
+	
+	if ( j >= ncols ) break;
+    }
+
+    SUPERLU_FREE(inv_perm_c);
+    return (rpg);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zpruneL.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,149 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "zsp_defs.h"
+#include "util.h"
+
+void
+zpruneL(
+       const int  jcol,	     /* in */
+       const int  *perm_r,   /* in */
+       const int  pivrow,    /* in */
+       const int  nseg,	     /* in */
+       const int  *segrep,   /* in */
+       const int  *repfnz,   /* in */
+       int        *xprune,   /* out */
+       GlobalLU_t *Glu       /* modified - global LU data structures */
+       )
+{
+/*
+ * Purpose
+ * =======
+ *   Prunes the L-structure of supernodes whose L-structure
+ *   contains the current pivot row "pivrow"
+ *
+ */
+    doublecomplex     utemp;
+    int        jsupno, irep, irep1, kmin, kmax, krow, movnum;
+    int        i, ktemp, minloc, maxloc;
+    int        do_prune; /* logical variable */
+    int        *xsup, *supno;
+    int        *lsub, *xlsub;
+    doublecomplex     *lusup;
+    int        *xlusup;
+
+    xsup       = Glu->xsup;
+    supno      = Glu->supno;
+    lsub       = Glu->lsub;
+    xlsub      = Glu->xlsub;
+    lusup      = Glu->lusup;
+    xlusup     = Glu->xlusup;
+    
+    /*
+     * For each supernode-rep irep in U[*,j]
+     */
+    jsupno = supno[jcol];
+    for (i = 0; i < nseg; i++) {
+
+	irep = segrep[i];
+	irep1 = irep + 1;
+	do_prune = FALSE;
+
+	/* Don't prune with a zero U-segment */
+ 	if ( repfnz[irep] == EMPTY )
+		continue;
+
+     	/* If a snode overlaps with the next panel, then the U-segment 
+   	 * is fragmented into two parts -- irep and irep1. We should let
+	 * pruning occur at the rep-column in irep1's snode. 
+	 */
+	if ( supno[irep] == supno[irep1] ) 	/* Don't prune */
+		continue;
+
+	/*
+	 * If it has not been pruned & it has a nonz in row L[pivrow,i]
+	 */
+	if ( supno[irep] != jsupno ) {
+	    if ( xprune[irep] >= xlsub[irep1] ) {
+		kmin = xlsub[irep];
+		kmax = xlsub[irep1] - 1;
+		for (krow = kmin; krow <= kmax; krow++) 
+		    if ( lsub[krow] == pivrow ) {
+			do_prune = TRUE;
+			break;
+		    }
+	    }
+	    
+    	    if ( do_prune ) {
+
+	     	/* Do a quicksort-type partition
+	     	 * movnum=TRUE means that the num values have to be exchanged.
+	     	 */
+	        movnum = FALSE;
+	        if ( irep == xsup[supno[irep]] ) /* Snode of size 1 */
+			movnum = TRUE;
+
+	        while ( kmin <= kmax ) {
+
+	    	    if ( perm_r[lsub[kmax]] == EMPTY ) 
+			kmax--;
+		    else if ( perm_r[lsub[kmin]] != EMPTY )
+			kmin++;
+		    else { /* kmin below pivrow, and kmax above pivrow: 
+		            * 	interchange the two subscripts
+			    */
+		        ktemp = lsub[kmin];
+		        lsub[kmin] = lsub[kmax];
+		        lsub[kmax] = ktemp;
+
+			/* If the supernode has only one column, then we
+ 			 * only keep one set of subscripts. For any subscript 
+			 * interchange performed, similar interchange must be 
+			 * done on the numerical values.
+ 			 */
+		        if ( movnum ) {
+		    	    minloc = xlusup[irep] + (kmin - xlsub[irep]);
+		    	    maxloc = xlusup[irep] + (kmax - xlsub[irep]);
+			    utemp = lusup[minloc];
+		  	    lusup[minloc] = lusup[maxloc];
+			    lusup[maxloc] = utemp;
+		        }
+
+		        kmin++;
+		        kmax--;
+
+		    }
+
+	        } /* while */
+
+	        xprune[irep] = kmin;	/* Pruning */
+
+#ifdef CHK_PRUNE
+	printf("    After zpruneL(),using col %d:  xprune[%d] = %d\n", 
+			jcol, irep, kmin);
+#endif
+	    } /* if do_prune */
+
+	} /* if */
+
+    } /* for each U-segment... */
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zreadhb.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,257 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "zsp_defs.h"
+
+
+/* Eat up the rest of the current line */
+int zDumpLine(FILE *fp)
+{
+    register int c;
+    while ((c = fgetc(fp)) != '\n') ;
+    return 0;
+}
+
+int zParseIntFormat(char *buf, int *num, int *size)
+{
+    char *tmp;
+
+    tmp = buf;
+    while (*tmp++ != '(') ;
+    sscanf(tmp, "%d", num);
+    while (*tmp != 'I' && *tmp != 'i') ++tmp;
+    ++tmp;
+    sscanf(tmp, "%d", size);
+    return 0;
+}
+
+int zParseFloatFormat(char *buf, int *num, int *size)
+{
+    char *tmp, *period;
+    
+    tmp = buf;
+    while (*tmp++ != '(') ;
+    sscanf(tmp, "%d", num);
+    while (*tmp != 'E' && *tmp != 'e' && *tmp != 'D' && *tmp != 'd'
+	   && *tmp != 'F' && *tmp != 'f') ++tmp;
+    ++tmp;
+    period = tmp;
+    while (*period != '.' && *period != ')') ++period ;
+    *period = '\0';
+    sscanf(tmp, "%2d", size);
+
+    return 0;
+}
+
+int zReadVector(FILE *fp, int n, int *where, int perline, int persize)
+{
+    register int i, j, item;
+    char tmp, buf[100];
+    
+    i = 0;
+    while (i < n) {
+	fgets(buf, 100, fp);    /* read a line at a time */
+	for (j=0; j<perline && i<n; j++) {
+	    tmp = buf[(j+1)*persize];     /* save the char at that place */
+	    buf[(j+1)*persize] = 0;       /* null terminate */
+	    item = atoi(&buf[j*persize]); 
+	    buf[(j+1)*persize] = tmp;     /* recover the char at that place */
+	    where[i++] = item - 1;
+	}
+    }
+
+    return 0;
+}
+
+/* Read complex numbers as pairs of (real, imaginary) */
+int zReadValues(FILE *fp, int n, doublecomplex *destination, int perline, int persize)
+{
+    register int i, j, k, s, pair;
+    register double realpart;
+    char tmp, buf[100];
+    
+    i = pair = 0;
+    while (i < n) {
+	fgets(buf, 100, fp);    /* read a line at a time */
+	for (j=0; j<perline && i<n; j++) {
+	    tmp = buf[(j+1)*persize];     /* save the char at that place */
+	    buf[(j+1)*persize] = 0;       /* null terminate */
+	    s = j*persize;
+	    for (k = 0; k < persize; ++k) /* No D_ format in C */
+		if ( buf[s+k] == 'D' || buf[s+k] == 'd' ) buf[s+k] = 'E';
+	    if ( pair == 0 ) {
+	  	/* The value is real part */
+		realpart = atof(&buf[s]);
+		pair = 1;
+	    } else {
+		/* The value is imaginary part */
+	        destination[i].r = realpart;
+		destination[i++].i = atof(&buf[s]);
+		pair = 0;
+	    }
+	    buf[(j+1)*persize] = tmp;     /* recover the char at that place */
+	}
+    }
+
+    return 0;
+}
+
+
+void
+zreadhb(int *nrow, int *ncol, int *nonz,
+	doublecomplex **nzval, int **rowind, int **colptr)
+{
+/* 
+ * Purpose
+ * =======
+ * 
+ * Read a DOUBLE COMPLEX PRECISION matrix stored in Harwell-Boeing format 
+ * as described below.
+ * 
+ * Line 1 (A72,A8) 
+ *  	Col. 1 - 72   Title (TITLE) 
+ *	Col. 73 - 80  Key (KEY) 
+ * 
+ * Line 2 (5I14) 
+ * 	Col. 1 - 14   Total number of lines excluding header (TOTCRD) 
+ * 	Col. 15 - 28  Number of lines for pointers (PTRCRD) 
+ * 	Col. 29 - 42  Number of lines for row (or variable) indices (INDCRD) 
+ * 	Col. 43 - 56  Number of lines for numerical values (VALCRD) 
+ *	Col. 57 - 70  Number of lines for right-hand sides (RHSCRD) 
+ *                    (including starting guesses and solution vectors 
+ *		       if present) 
+ *           	      (zero indicates no right-hand side data is present) 
+ *
+ * Line 3 (A3, 11X, 4I14) 
+ *   	Col. 1 - 3    Matrix type (see below) (MXTYPE) 
+ * 	Col. 15 - 28  Number of rows (or variables) (NROW) 
+ * 	Col. 29 - 42  Number of columns (or elements) (NCOL) 
+ *	Col. 43 - 56  Number of row (or variable) indices (NNZERO) 
+ *	              (equal to number of entries for assembled matrices) 
+ * 	Col. 57 - 70  Number of elemental matrix entries (NELTVL) 
+ *	              (zero in the case of assembled matrices) 
+ * Line 4 (2A16, 2A20) 
+ * 	Col. 1 - 16   Format for pointers (PTRFMT) 
+ *	Col. 17 - 32  Format for row (or variable) indices (INDFMT) 
+ *	Col. 33 - 52  Format for numerical values of coefficient matrix (VALFMT) 
+ * 	Col. 53 - 72 Format for numerical values of right-hand sides (RHSFMT) 
+ *
+ * Line 5 (A3, 11X, 2I14) Only present if there are right-hand sides present 
+ *    	Col. 1 	      Right-hand side type: 
+ *	         	  F for full storage or M for same format as matrix 
+ *    	Col. 2        G if a starting vector(s) (Guess) is supplied. (RHSTYP) 
+ *    	Col. 3        X if an exact solution vector(s) is supplied. 
+ *	Col. 15 - 28  Number of right-hand sides (NRHS) 
+ *	Col. 29 - 42  Number of row indices (NRHSIX) 
+ *          	      (ignored in case of unassembled matrices) 
+ *
+ * The three character type field on line 3 describes the matrix type. 
+ * The following table lists the permitted values for each of the three 
+ * characters. As an example of the type field, RSA denotes that the matrix 
+ * is real, symmetric, and assembled. 
+ *
+ * First Character: 
+ *	R Real matrix 
+ *	C Complex matrix 
+ *	P Pattern only (no numerical values supplied) 
+ *
+ * Second Character: 
+ *	S Symmetric 
+ *	U Unsymmetric 
+ *	H Hermitian 
+ *	Z Skew symmetric 
+ *	R Rectangular 
+ *
+ * Third Character: 
+ *	A Assembled 
+ *	E Elemental matrices (unassembled) 
+ *
+ */
+
+    register int i, numer_lines = 0, rhscrd = 0;
+    int tmp, colnum, colsize, rownum, rowsize, valnum, valsize;
+    char buf[100], type[4], key[10];
+    FILE *fp;
+
+    fp = stdin;
+
+    /* Line 1 */
+    fgets(buf, 100, fp);
+    fputs(buf, stdout);
+#if 0
+    fscanf(fp, "%72c", buf); buf[72] = 0;
+    printf("Title: %s", buf);
+    fscanf(fp, "%8c", key);  key[8] = 0;
+    printf("Key: %s\n", key);
+    zDumpLine(fp);
+#endif
+
+    /* Line 2 */
+    for (i=0; i<5; i++) {
+	fscanf(fp, "%14c", buf); buf[14] = 0;
+	sscanf(buf, "%d", &tmp);
+	if (i == 3) numer_lines = tmp;
+	if (i == 4 && tmp) rhscrd = tmp;
+    }
+    zDumpLine(fp);
+
+    /* Line 3 */
+    fscanf(fp, "%3c", type);
+    fscanf(fp, "%11c", buf); /* pad */
+    type[3] = 0;
+#ifdef DEBUG
+    printf("Matrix type %s\n", type);
+#endif
+    
+    fscanf(fp, "%14c", buf); sscanf(buf, "%d", nrow);
+    fscanf(fp, "%14c", buf); sscanf(buf, "%d", ncol);
+    fscanf(fp, "%14c", buf); sscanf(buf, "%d", nonz);
+    fscanf(fp, "%14c", buf); sscanf(buf, "%d", &tmp);
+    
+    if (tmp != 0)
+	  printf("This is not an assembled matrix!\n");
+    if (*nrow != *ncol)
+	printf("Matrix is not square.\n");
+    zDumpLine(fp);
+
+    /* Allocate storage for the three arrays ( nzval, rowind, colptr ) */
+    zallocateA(*ncol, *nonz, nzval, rowind, colptr);
+
+    /* Line 4: format statement */
+    fscanf(fp, "%16c", buf);
+    zParseIntFormat(buf, &colnum, &colsize);
+    fscanf(fp, "%16c", buf);
+    zParseIntFormat(buf, &rownum, &rowsize);
+    fscanf(fp, "%20c", buf);
+    zParseFloatFormat(buf, &valnum, &valsize);
+    fscanf(fp, "%20c", buf);
+    zDumpLine(fp);
+
+    /* Line 5: right-hand side */    
+    if ( rhscrd ) zDumpLine(fp); /* skip RHSFMT */
+    
+#ifdef DEBUG
+    printf("%d rows, %d nonzeros\n", *nrow, *nonz);
+    printf("colnum %d, colsize %d\n", colnum, colsize);
+    printf("rownum %d, rowsize %d\n", rownum, rowsize);
+    printf("valnum %d, valsize %d\n", valnum, valsize);
+#endif
+    
+    zReadVector(fp, *ncol+1, *colptr, colnum, colsize);
+    zReadVector(fp, *nonz, *rowind, rownum, rowsize);
+    if ( numer_lines ) {
+        zReadValues(fp, *nonz, *nzval, valnum, valsize);
+    }
+    
+    fclose(fp);
+
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zsnode_bmod.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,120 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "zsp_defs.h"
+#include "util.h"
+
+
+/*
+ * Performs numeric block updates within the relaxed snode. 
+ */
+int
+zsnode_bmod (
+	    const int  jcol,	  /* in */
+	    const int  jsupno,    /* in */
+	    const int  fsupc,     /* in */
+	    doublecomplex     *dense,    /* in */
+	    doublecomplex     *tempv,    /* working array */
+	    GlobalLU_t *Glu       /* modified */
+	    )
+{
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+    _fcd ftcs1 = _cptofcd("L", strlen("L")),
+	 ftcs2 = _cptofcd("N", strlen("N")),
+	 ftcs3 = _cptofcd("U", strlen("U"));
+#endif
+    int            incx = 1, incy = 1;
+    doublecomplex         alpha = {-1.0, 0.0},  beta = {1.0, 0.0};
+#endif
+
+    doublecomplex   comp_zero = {0.0, 0.0};
+    int            luptr, nsupc, nsupr, nrow;
+    int            isub, irow, i, iptr; 
+    register int   ufirst, nextlu;
+    int            *lsub, *xlsub;
+    doublecomplex         *lusup;
+    int            *xlusup;
+    extern SuperLUStat_t SuperLUStat;
+    flops_t *ops = SuperLUStat.ops;
+
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    lusup   = Glu->lusup;
+    xlusup  = Glu->xlusup;
+
+    nextlu = xlusup[jcol];
+    
+    /*
+     *	Process the supernodal portion of L\U[*,j]
+     */
+    for (isub = xlsub[fsupc]; isub < xlsub[fsupc+1]; isub++) {
+  	irow = lsub[isub];
+	lusup[nextlu] = dense[irow];
+        dense[irow] = comp_zero;
+	++nextlu;
+    }
+
+    xlusup[jcol + 1] = nextlu;	/* Initialize xlusup for next column */
+    
+    if ( fsupc < jcol ) {
+
+	luptr = xlusup[fsupc];
+	nsupr = xlsub[fsupc+1] - xlsub[fsupc];
+	nsupc = jcol - fsupc;	/* Excluding jcol */
+	ufirst = xlusup[jcol];	/* Points to the beginning of column
+				   jcol in supernode L\U(jsupno). */
+	nrow = nsupr - nsupc;
+
+	ops[TRSV] += 4 * nsupc * (nsupc - 1);
+	ops[GEMV] += 8 * nrow * nsupc;
+
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+	CTRSV( ftcs1, ftcs2, ftcs3, &nsupc, &lusup[luptr], &nsupr, 
+	      &lusup[ufirst], &incx );
+	CGEMV( ftcs2, &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr, 
+		&lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
+#else
+	ztrsv_( "L", "N", "U", &nsupc, &lusup[luptr], &nsupr, 
+	      &lusup[ufirst], &incx );
+	zgemv_( "N", &nrow, &nsupc, &alpha, &lusup[luptr+nsupc], &nsupr, 
+		&lusup[ufirst], &incx, &beta, &lusup[ufirst+nsupc], &incy );
+#endif
+#else
+	zlsolve ( nsupr, nsupc, &lusup[luptr], &lusup[ufirst] );
+	zmatvec ( nsupr, nrow, nsupc, &lusup[luptr+nsupc], 
+			&lusup[ufirst], &tempv[0] );
+
+        /* Scatter tempv[*] into lusup[*] */
+	iptr = ufirst + nsupc;
+	for (i = 0; i < nrow; i++) {
+	    z_sub(&lusup[iptr], &lusup[iptr], &tempv[i]);
+            ++iptr;
+	    tempv[i] = comp_zero;
+	}
+#endif
+
+    }
+
+    return 0;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zsnode_dfs.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,106 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include "zsp_defs.h"
+#include "util.h"
+
+int
+zsnode_dfs (
+	   const int  jcol,	    /* in - start of the supernode */
+	   const int  kcol, 	    /* in - end of the supernode */
+	   const int  *asub,        /* in */
+	   const int  *xa_begin,    /* in */
+	   const int  *xa_end,      /* in */
+	   int        *xprune,      /* out */
+	   int        *marker,      /* modified */
+	   GlobalLU_t *Glu          /* modified */
+	   )
+{
+/* Purpose
+ * =======
+ *    zsnode_dfs() - Determine the union of the row structures of those 
+ *    columns within the relaxed snode.
+ *    Note: The relaxed snodes are leaves of the supernodal etree, therefore, 
+ *    the portion outside the rectangular supernode must be zero.
+ *
+ * Return value
+ * ============
+ *     0   success;
+ *    >0   number of bytes allocated when run out of memory.
+ *
+ */
+    register int i, k, ifrom, ito, nextl, new_next;
+    int          nsuper, krow, kmark, mem_error;
+    int          *xsup, *supno;
+    int          *lsub, *xlsub;
+    int          nzlmax;
+    
+    xsup    = Glu->xsup;
+    supno   = Glu->supno;
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    nzlmax  = Glu->nzlmax;
+
+    nsuper = ++supno[jcol];	/* Next available supernode number */
+    nextl = xlsub[jcol];
+
+    for (i = jcol; i <= kcol; i++) {
+	/* For each nonzero in A[*,i] */
+	for (k = xa_begin[i]; k < xa_end[i]; k++) {	
+	    krow = asub[k];
+	    kmark = marker[krow];
+	    if ( kmark != kcol ) { /* First time visit krow */
+		marker[krow] = kcol;
+		lsub[nextl++] = krow;
+		if ( nextl >= nzlmax ) {
+		    if ( mem_error = zLUMemXpand(jcol, nextl, LSUB, &nzlmax, Glu) )
+			return (mem_error);
+		    lsub = Glu->lsub;
+		}
+	    }
+    	}
+	supno[i] = nsuper;
+    }
+
+    /* Supernode > 1, then make a copy of the subscripts for pruning */
+    if ( jcol < kcol ) {
+	new_next = nextl + (nextl - xlsub[jcol]);
+	while ( new_next > nzlmax ) {
+	    if ( mem_error = zLUMemXpand(jcol, nextl, LSUB, &nzlmax, Glu) )
+		return (mem_error);
+	    lsub = Glu->lsub;
+	}
+	ito = nextl;
+	for (ifrom = xlsub[jcol]; ifrom < nextl; )
+	    lsub[ito++] = lsub[ifrom++];	
+        for (i = jcol+1; i <= kcol; i++) xlsub[i] = nextl;
+	nextl = ito;
+    }
+
+    xsup[nsuper+1] = kcol + 1;
+    supno[kcol+1]  = nsuper;
+    xprune[kcol]   = nextl;
+    xlsub[kcol+1]  = nextl;
+
+    return 0;
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zsp_blas2.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,483 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:		sp_blas2.c
+ * Purpose:		Sparse BLAS 2, using some dense BLAS 2 operations.
+ */
+
+#include "zsp_defs.h"
+#include "util.h"
+
+
+/* 
+ * Function prototypes 
+ */
+void zusolve(int, int, doublecomplex*, doublecomplex*);
+void zlsolve(int, int, doublecomplex*, doublecomplex*);
+void zmatvec(int, int, int, doublecomplex*, doublecomplex*, doublecomplex*);
+
+
+int
+sp_ztrsv(char *uplo, char *trans, char *diag, SuperMatrix *L, 
+	 SuperMatrix *U, doublecomplex *x, int *info)
+{
+/*
+ *   Purpose
+ *   =======
+ *
+ *   sp_ztrsv() solves one of the systems of equations   
+ *       A*x = b,   or   A'*x = b,
+ *   where b and x are n element vectors and A is a sparse unit , or   
+ *   non-unit, upper or lower triangular matrix.   
+ *   No test for singularity or near-singularity is included in this   
+ *   routine. Such tests must be performed before calling this routine.   
+ *
+ *   Parameters   
+ *   ==========   
+ *
+ *   uplo   - (input) char*
+ *            On entry, uplo specifies whether the matrix is an upper or   
+ *             lower triangular matrix as follows:   
+ *                uplo = 'U' or 'u'   A is an upper triangular matrix.   
+ *                uplo = 'L' or 'l'   A is a lower triangular matrix.   
+ *
+ *   trans  - (input) char*
+ *             On entry, trans specifies the equations to be solved as   
+ *             follows:   
+ *                trans = 'N' or 'n'   A*x = b.   
+ *                trans = 'T' or 't'   A'*x = b.   
+ *                trans = 'C' or 'c'   A'*x = b.   
+ *
+ *   diag   - (input) char*
+ *             On entry, diag specifies whether or not A is unit   
+ *             triangular as follows:   
+ *                diag = 'U' or 'u'   A is assumed to be unit triangular.   
+ *                diag = 'N' or 'n'   A is not assumed to be unit   
+ *                                    triangular.   
+ *	     
+ *   L       - (input) SuperMatrix*
+ *	       The factor L from the factorization Pr*A*Pc=L*U. Use
+ *             compressed row subscripts storage for supernodes,
+ *             i.e., L has types: Stype = SC, Dtype = _Z, Mtype = TRLU.
+ *
+ *   U       - (input) SuperMatrix*
+ *	        The factor U from the factorization Pr*A*Pc=L*U.
+ *	        U has types: Stype = NC, Dtype = _Z, Mtype = TRU.
+ *    
+ *   x       - (input/output) doublecomplex*
+ *             Before entry, the incremented array X must contain the n   
+ *             element right-hand side vector b. On exit, X is overwritten 
+ *             with the solution vector x.
+ *
+ *   info    - (output) int*
+ *             If *info = -i, the i-th argument had an illegal value.
+ *
+ */
+#ifdef _CRAY
+    _fcd ftcs1 = _cptofcd("L", strlen("L")),
+	 ftcs2 = _cptofcd("N", strlen("N")),
+	 ftcs3 = _cptofcd("U", strlen("U"));
+#endif
+    SCformat *Lstore;
+    NCformat *Ustore;
+    doublecomplex   *Lval, *Uval;
+    int incx = 1, incy = 1;
+    doublecomplex alpha = {1.0, 0.0}, beta = {1.0, 0.0};
+    doublecomplex comp_zero = {0.0, 0.0};
+    int nrow;
+    int fsupc, nsupr, nsupc, luptr, istart, irow;
+    int i, k, iptr, jcol;
+    doublecomplex *work;
+    flops_t solve_ops;
+    extern SuperLUStat_t SuperLUStat;
+
+    /* Test the input parameters */
+    *info = 0;
+    if ( !lsame_(uplo,"L") && !lsame_(uplo, "U") ) *info = -1;
+    else if ( !lsame_(trans, "N") && !lsame_(trans, "T") ) *info = -2;
+    else if ( !lsame_(diag, "U") && !lsame_(diag, "N") ) *info = -3;
+    else if ( L->nrow != L->ncol || L->nrow < 0 ) *info = -4;
+    else if ( U->nrow != U->ncol || U->nrow < 0 ) *info = -5;
+    if ( *info ) {
+	i = -(*info);
+	xerbla_("sp_ztrsv", &i);
+	return 0;
+    }
+
+    Lstore = L->Store;
+    Lval = Lstore->nzval;
+    Ustore = U->Store;
+    Uval = Ustore->nzval;
+    solve_ops = 0;
+
+    if ( !(work = doublecomplexCalloc(L->nrow)) )
+	ABORT("Malloc fails for work in sp_ztrsv().");
+    
+    if ( lsame_(trans, "N") ) {	/* Form x := inv(A)*x. */
+	
+	if ( lsame_(uplo, "L") ) {
+	    /* Form x := inv(L)*x */
+    	    if ( L->nrow == 0 ) return 0; /* Quick return */
+	    
+	    for (k = 0; k <= Lstore->nsuper; k++) {
+		fsupc = L_FST_SUPC(k);
+		istart = L_SUB_START(fsupc);
+		nsupr = L_SUB_START(fsupc+1) - istart;
+		nsupc = L_FST_SUPC(k+1) - fsupc;
+		luptr = L_NZ_START(fsupc);
+		nrow = nsupr - nsupc;
+
+	        solve_ops += 4 * nsupc * (nsupc - 1);
+	        solve_ops += 8 * nrow * nsupc;
+
+		if ( nsupc == 1 ) {
+		    for (iptr=istart+1; iptr < L_SUB_START(fsupc+1); ++iptr) {
+			irow = L_SUB(iptr);
+			++luptr;
+			zz_mult(&comp_zero, &x[fsupc], &Lval[luptr]);
+			z_sub(&x[irow], &x[irow], &comp_zero);
+		    }
+		} else {
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		    CTRSV(ftcs1, ftcs2, ftcs3, &nsupc, &Lval[luptr], &nsupr,
+		       	&x[fsupc], &incx);
+		
+		    CGEMV(ftcs2, &nrow, &nsupc, &alpha, &Lval[luptr+nsupc], 
+		       	&nsupr, &x[fsupc], &incx, &beta, &work[0], &incy);
+#else
+		    ztrsv_("L", "N", "U", &nsupc, &Lval[luptr], &nsupr,
+		       	&x[fsupc], &incx);
+		
+		    zgemv_("N", &nrow, &nsupc, &alpha, &Lval[luptr+nsupc], 
+		       	&nsupr, &x[fsupc], &incx, &beta, &work[0], &incy);
+#endif
+#else
+		    zlsolve ( nsupr, nsupc, &Lval[luptr], &x[fsupc]);
+		
+		    zmatvec ( nsupr, nsupr-nsupc, nsupc, &Lval[luptr+nsupc],
+			&x[fsupc], &work[0] );
+#endif		
+		
+		    iptr = istart + nsupc;
+		    for (i = 0; i < nrow; ++i, ++iptr) {
+			irow = L_SUB(iptr);
+			z_sub(&x[irow], &x[irow], &work[i]); /* Scatter */
+			work[i] = comp_zero;
+
+		    }
+	 	}
+	    } /* for k ... */
+	    
+	} else {
+	    /* Form x := inv(U)*x */
+	    
+	    if ( U->nrow == 0 ) return 0; /* Quick return */
+	    
+	    for (k = Lstore->nsuper; k >= 0; k--) {
+	    	fsupc = L_FST_SUPC(k);
+	    	nsupr = L_SUB_START(fsupc+1) - L_SUB_START(fsupc);
+	    	nsupc = L_FST_SUPC(k+1) - fsupc;
+	    	luptr = L_NZ_START(fsupc);
+		
+    	        solve_ops += 4 * nsupc * (nsupc + 1);
+
+		if ( nsupc == 1 ) {
+		    z_div(&x[fsupc], &x[fsupc], &Lval[luptr]);
+		    for (i = U_NZ_START(fsupc); i < U_NZ_START(fsupc+1); ++i) {
+			irow = U_SUB(i);
+			zz_mult(&comp_zero, &x[fsupc], &Uval[i]);
+			z_sub(&x[irow], &x[irow], &comp_zero);
+		    }
+		} else {
+#ifdef USE_VENDOR_BLAS
+#ifdef _CRAY
+		    CTRSV(ftcs3, ftcs2, ftcs2, &nsupc, &Lval[luptr], &nsupr,
+		       &x[fsupc], &incx);
+#else
+		    ztrsv_("U", "N", "N", &nsupc, &Lval[luptr], &nsupr,
+		       &x[fsupc], &incx);
+#endif
+#else		
+		    zusolve ( nsupr, nsupc, &Lval[luptr], &x[fsupc] );
+#endif		
+
+		    for (jcol = fsupc; jcol < L_FST_SUPC(k+1); jcol++) {
+		        solve_ops += 8*(U_NZ_START(jcol+1) - U_NZ_START(jcol));
+		    	for (i = U_NZ_START(jcol); i < U_NZ_START(jcol+1); 
+				i++) {
+			    irow = U_SUB(i);
+			zz_mult(&comp_zero, &x[jcol], &Uval[i]);
+			z_sub(&x[irow], &x[irow], &comp_zero);
+		    	}
+                    }
+		}
+	    } /* for k ... */
+	    
+	}
+    } else { /* Form x := inv(A')*x */
+	
+	if ( lsame_(uplo, "L") ) {
+	    /* Form x := inv(L')*x */
+    	    if ( L->nrow == 0 ) return 0; /* Quick return */
+	    
+	    for (k = Lstore->nsuper; k >= 0; --k) {
+	    	fsupc = L_FST_SUPC(k);
+	    	istart = L_SUB_START(fsupc);
+	    	nsupr = L_SUB_START(fsupc+1) - istart;
+	    	nsupc = L_FST_SUPC(k+1) - fsupc;
+	    	luptr = L_NZ_START(fsupc);
+
+		solve_ops += 8 * (nsupr - nsupc) * nsupc;
+
+		for (jcol = fsupc; jcol < L_FST_SUPC(k+1); jcol++) {
+		    iptr = istart + nsupc;
+		    for (i = L_NZ_START(jcol) + nsupc; 
+				i < L_NZ_START(jcol+1); i++) {
+			irow = L_SUB(iptr);
+			zz_mult(&comp_zero, &x[irow], &Lval[i]);
+		    	z_sub(&x[jcol], &x[jcol], &comp_zero);
+			iptr++;
+		    }
+		}
+		
+		if ( nsupc > 1 ) {
+		    solve_ops += 4 * nsupc * (nsupc - 1);
+#ifdef _CRAY
+                    ftcs1 = _cptofcd("L", strlen("L"));
+                    ftcs2 = _cptofcd("T", strlen("T"));
+                    ftcs3 = _cptofcd("U", strlen("U"));
+		    CTRSV(ftcs1, ftcs2, ftcs3, &nsupc, &Lval[luptr], &nsupr,
+			&x[fsupc], &incx);
+#else
+		    ztrsv_("L", "T", "U", &nsupc, &Lval[luptr], &nsupr,
+			&x[fsupc], &incx);
+#endif
+		}
+	    }
+	} else {
+	    /* Form x := inv(U')*x */
+	    if ( U->nrow == 0 ) return 0; /* Quick return */
+	    
+	    for (k = 0; k <= Lstore->nsuper; k++) {
+	    	fsupc = L_FST_SUPC(k);
+	    	nsupr = L_SUB_START(fsupc+1) - L_SUB_START(fsupc);
+	    	nsupc = L_FST_SUPC(k+1) - fsupc;
+	    	luptr = L_NZ_START(fsupc);
+
+		for (jcol = fsupc; jcol < L_FST_SUPC(k+1); jcol++) {
+		    solve_ops += 8*(U_NZ_START(jcol+1) - U_NZ_START(jcol));
+		    for (i = U_NZ_START(jcol); i < U_NZ_START(jcol+1); i++) {
+			irow = U_SUB(i);
+			zz_mult(&comp_zero, &x[irow], &Uval[i]);
+		    	z_sub(&x[jcol], &x[jcol], &comp_zero);
+		    }
+		}
+
+		solve_ops += 4 * nsupc * (nsupc + 1);
+
+		if ( nsupc == 1 ) {
+		    z_div(&x[fsupc], &x[fsupc], &Lval[luptr]);
+		} else {
+#ifdef _CRAY
+                    ftcs1 = _cptofcd("U", strlen("U"));
+                    ftcs2 = _cptofcd("T", strlen("T"));
+                    ftcs3 = _cptofcd("N", strlen("N"));
+		    CTRSV( ftcs1, ftcs2, ftcs3, &nsupc, &Lval[luptr], &nsupr,
+			    &x[fsupc], &incx);
+#else
+		    ztrsv_("U", "T", "N", &nsupc, &Lval[luptr], &nsupr,
+			    &x[fsupc], &incx);
+#endif
+		}
+	    } /* for k ... */
+	}
+    }
+
+    SuperLUStat.ops[SOLVE] += solve_ops;
+    SUPERLU_FREE(work);
+    return 0;
+}
+
+
+
+int
+sp_zgemv(char *trans, doublecomplex alpha, SuperMatrix *A, doublecomplex *x, 
+	 int incx, doublecomplex beta, doublecomplex *y, int incy)
+{
+/*  Purpose   
+    =======   
+
+    sp_zgemv()  performs one of the matrix-vector operations   
+       y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,   
+    where alpha and beta are scalars, x and y are vectors and A is a
+    sparse A->nrow by A->ncol matrix.   
+
+    Parameters   
+    ==========   
+
+    TRANS  - (input) char*
+             On entry, TRANS specifies the operation to be performed as   
+             follows:   
+                TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.   
+                TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.   
+                TRANS = 'C' or 'c'   y := alpha*A'*x + beta*y.   
+
+    ALPHA  - (input) doublecomplex
+             On entry, ALPHA specifies the scalar alpha.   
+
+    A      - (input) SuperMatrix*
+             Before entry, the leading m by n part of the array A must   
+             contain the matrix of coefficients.   
+
+    X      - (input) doublecomplex*, array of DIMENSION at least   
+             ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'   
+             and at least   
+             ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.   
+             Before entry, the incremented array X must contain the   
+             vector x.   
+
+    INCX   - (input) int
+             On entry, INCX specifies the increment for the elements of   
+             X. INCX must not be zero.   
+
+    BETA   - (input) doublecomplex
+             On entry, BETA specifies the scalar beta. When BETA is   
+             supplied as zero then Y need not be set on input.   
+
+    Y      - (output) doublecomplex*,  array of DIMENSION at least   
+             ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'   
+             and at least   
+             ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.   
+             Before entry with BETA non-zero, the incremented array Y   
+             must contain the vector y. On exit, Y is overwritten by the 
+             updated vector y.
+	     
+    INCY   - (input) int
+             On entry, INCY specifies the increment for the elements of   
+             Y. INCY must not be zero.   
+
+    ==== Sparse Level 2 Blas routine.   
+*/
+
+    /* Local variables */
+    NCformat *Astore;
+    doublecomplex   *Aval;
+    int info;
+    doublecomplex temp, temp1;
+    int lenx, leny, i, j, irow;
+    int iy, jx, jy, kx, ky;
+    int notran;
+    doublecomplex comp_zero = {0.0, 0.0};
+    doublecomplex comp_one = {1.0, 0.0};
+
+    notran = lsame_(trans, "N");
+    Astore = A->Store;
+    Aval = Astore->nzval;
+    
+    /* Test the input parameters */
+    info = 0;
+    if ( !notran && !lsame_(trans, "T") && !lsame_(trans, "C")) info = 1;
+    else if ( A->nrow < 0 || A->ncol < 0 ) info = 3;
+    else if (incx == 0) info = 5;
+    else if (incy == 0)	info = 8;
+    if (info != 0) {
+	xerbla_("sp_zgemv ", &info);
+	return 0;
+    }
+
+    /* Quick return if possible. */
+    if (A->nrow == 0 || A->ncol == 0 || 
+	z_eq(&alpha, &comp_zero) && 
+	z_eq(&beta, &comp_one))
+	return 0;
+
+
+    /* Set  LENX  and  LENY, the lengths of the vectors x and y, and set 
+       up the start points in  X  and  Y. */
+    if (lsame_(trans, "N")) {
+	lenx = A->ncol;
+	leny = A->nrow;
+    } else {
+	lenx = A->nrow;
+	leny = A->ncol;
+    }
+    if (incx > 0) kx = 0;
+    else kx =  - (lenx - 1) * incx;
+    if (incy > 0) ky = 0;
+    else ky =  - (leny - 1) * incy;
+
+    /* Start the operations. In this version the elements of A are   
+       accessed sequentially with one pass through A. */
+    /* First form  y := beta*y. */
+    if ( !z_eq(&beta, &comp_one) ) {
+	if (incy == 1) {
+	    if ( z_eq(&beta, &comp_zero) )
+		for (i = 0; i < leny; ++i) y[i] = comp_zero;
+	    else
+		for (i = 0; i < leny; ++i) 
+		  zz_mult(&y[i], &beta, &y[i]);
+	} else {
+	    iy = ky;
+	    if ( z_eq(&beta, &comp_zero) )
+		for (i = 0; i < leny; ++i) {
+		    y[iy] = comp_zero;
+		    iy += incy;
+		}
+	    else
+		for (i = 0; i < leny; ++i) {
+		    zz_mult(&y[iy], &beta, &y[iy]);
+		    iy += incy;
+		}
+	}
+    }
+    
+    if ( z_eq(&alpha, &comp_zero) ) return 0;
+
+    if ( notran ) {
+	/* Form  y := alpha*A*x + y. */
+	jx = kx;
+	if (incy == 1) {
+	    for (j = 0; j < A->ncol; ++j) {
+		if ( !z_eq(&x[jx], &comp_zero) ) {
+		    zz_mult(&temp, &alpha, &x[jx]);
+		    for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+			irow = Astore->rowind[i];
+			zz_mult(&temp1, &temp,  &Aval[i]);
+			z_add(&y[irow], &y[irow], &temp1);
+		    }
+		}
+		jx += incx;
+	    }
+	} else {
+	    ABORT("Not implemented.");
+	}
+    } else {
+	/* Form  y := alpha*A'*x + y. */
+	jy = ky;
+	if (incx == 1) {
+	    for (j = 0; j < A->ncol; ++j) {
+		temp = comp_zero;
+		for (i = Astore->colptr[j]; i < Astore->colptr[j+1]; ++i) {
+		    irow = Astore->rowind[i];
+		    zz_mult(&temp1, &Aval[i], &x[irow]);
+		    z_add(&temp, &temp, &temp1);
+		}
+		zz_mult(&temp1, &alpha, &temp);
+		z_add(&y[jy], &y[jy], &temp1);
+		jy += incy;
+	    }
+	} else {
+	    ABORT("Not implemented.");
+	}
+    }
+    return 0;    
+} /* sp_zgemv */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zsp_blas3.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,121 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+ * File name:		sp_blas3.c
+ * Purpose:		Sparse BLAS3, using some dense BLAS3 operations.
+ */
+
+#include "zsp_defs.h"
+#include "util.h"
+
+int
+sp_zgemm(char *transa, char *transb, int m, int n, int k, 
+         doublecomplex alpha, SuperMatrix *A, doublecomplex *b, int ldb, 
+         doublecomplex beta, doublecomplex *c, int ldc)
+{
+/*  Purpose   
+    =======   
+
+    sp_z performs one of the matrix-matrix operations   
+
+       C := alpha*op( A )*op( B ) + beta*C,   
+
+    where  op( X ) is one of 
+
+       op( X ) = X   or   op( X ) = X'   or   op( X ) = conjg( X' ),
+
+    alpha and beta are scalars, and A, B and C are matrices, with op( A ) 
+    an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix. 
+  
+
+    Parameters   
+    ==========   
+
+    TRANSA - (input) char*
+             On entry, TRANSA specifies the form of op( A ) to be used in 
+             the matrix multiplication as follows:   
+                TRANSA = 'N' or 'n',  op( A ) = A.   
+                TRANSA = 'T' or 't',  op( A ) = A'.   
+                TRANSA = 'C' or 'c',  op( A ) = conjg( A' ).   
+             Unchanged on exit.   
+
+    TRANSB - (input) char*
+             On entry, TRANSB specifies the form of op( B ) to be used in 
+             the matrix multiplication as follows:   
+                TRANSB = 'N' or 'n',  op( B ) = B.   
+                TRANSB = 'T' or 't',  op( B ) = B'.   
+                TRANSB = 'C' or 'c',  op( B ) = conjg( B' ).   
+             Unchanged on exit.   
+
+    M      - (input) int   
+             On entry,  M  specifies  the number of rows of the matrix 
+	     op( A ) and of the matrix C.  M must be at least zero. 
+	     Unchanged on exit.   
+
+    N      - (input) int
+             On entry,  N specifies the number of columns of the matrix 
+	     op( B ) and the number of columns of the matrix C. N must be 
+	     at least zero.
+	     Unchanged on exit.   
+
+    K      - (input) int
+             On entry, K specifies the number of columns of the matrix 
+	     op( A ) and the number of rows of the matrix op( B ). K must 
+	     be at least  zero.   
+             Unchanged on exit.
+	     
+    ALPHA  - (input) doublecomplex
+             On entry, ALPHA specifies the scalar alpha.   
+
+    A      - (input) SuperMatrix*
+             Matrix A with a sparse format, of dimension (A->nrow, A->ncol).
+             Currently, the type of A can be:
+                 Stype = NC or NCP; Dtype = _Z; Mtype = GE. 
+             In the future, more general A can be handled.
+
+    B      - DOUBLE COMPLEX PRECISION array of DIMENSION ( LDB, kb ), where kb is 
+             n when TRANSB = 'N' or 'n',  and is  k otherwise.   
+             Before entry with  TRANSB = 'N' or 'n',  the leading k by n 
+             part of the array B must contain the matrix B, otherwise 
+             the leading n by k part of the array B must contain the 
+             matrix B.   
+             Unchanged on exit.   
+
+    LDB    - (input) int
+             On entry, LDB specifies the first dimension of B as declared 
+             in the calling (sub) program. LDB must be at least max( 1, n ).  
+             Unchanged on exit.   
+
+    BETA   - (input) doublecomplex
+             On entry, BETA specifies the scalar beta. When BETA is   
+             supplied as zero then C need not be set on input.   
+
+    C      - DOUBLE COMPLEX PRECISION array of DIMENSION ( LDC, n ).   
+             Before entry, the leading m by n part of the array C must 
+             contain the matrix C,  except when beta is zero, in which 
+             case C need not be set on entry.   
+             On exit, the array C is overwritten by the m by n matrix 
+	     ( alpha*op( A )*B + beta*C ).   
+
+    LDC    - (input) int
+             On entry, LDC specifies the first dimension of C as declared 
+             in the calling (sub)program. LDC must be at least max(1,m).   
+             Unchanged on exit.   
+
+    ==== Sparse Level 3 Blas routine.   
+*/
+    int    incx = 1, incy = 1;
+    int    j;
+
+    for (j = 0; j < n; ++j) {
+	sp_zgemv(transa, alpha, A, &b[ldb*j], incx, beta, &c[ldc*j], incy);
+    }
+    return 0;    
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zsp_defs.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,252 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+#ifndef __SUPERLU_zSP_DEFS /* allow multiple inclusions */
+#define __SUPERLU_zSP_DEFS
+
+/*
+ * File name:		zsp_defs.h
+ * Purpose:             Sparse matrix types and function prototypes
+ * History:
+ */
+#ifdef _CRAY
+#include <fortran.h>
+#include <string.h>
+#endif
+#include "Cnames.h"
+#include "supermatrix.h"
+#include "dcomplex.h"
+
+
+/* No of marker arrays used in the symbolic factorization,
+   each of size n */
+#define NO_MARKER     3
+#define NUM_TEMPV(m,w,t,b)  ( MAX(m, (t + b)*w) )
+
+typedef enum {LUSUP, UCOL, LSUB, USUB} MemType;
+typedef enum {HEAD, TAIL}              stack_end_t;
+typedef enum {SYSTEM, USER}            LU_space_t;
+
+/*
+ * Global data structures used in LU factorization -
+ * 
+ *   nsuper: #supernodes = nsuper + 1, numbered [0, nsuper].
+ *   (xsup,supno): supno[i] is the supernode no to which i belongs;
+ *	xsup(s) points to the beginning of the s-th supernode.
+ *	e.g.   supno 0 1 2 2 3 3 3 4 4 4 4 4   (n=12)
+ *	        xsup 0 1 2 4 7 12
+ *	Note: dfs will be performed on supernode rep. relative to the new 
+ *	      row pivoting ordering
+ *
+ *   (xlsub,lsub): lsub[*] contains the compressed subscript of
+ *	rectangular supernodes; xlsub[j] points to the starting
+ *	location of the j-th column in lsub[*]. Note that xlsub 
+ *	is indexed by column.
+ *	Storage: original row subscripts
+ *
+ *      During the course of sparse LU factorization, we also use
+ *	(xlsub,lsub) for the purpose of symmetric pruning. For each
+ *	supernode {s,s+1,...,t=s+r} with first column s and last
+ *	column t, the subscript set
+ *		lsub[j], j=xlsub[s], .., xlsub[s+1]-1
+ *	is the structure of column s (i.e. structure of this supernode).
+ *	It is used for the storage of numerical values.
+ *	Furthermore,
+ *		lsub[j], j=xlsub[t], .., xlsub[t+1]-1
+ *	is the structure of the last column t of this supernode.
+ *	It is for the purpose of symmetric pruning. Therefore, the
+ *	structural subscripts can be rearranged without making physical
+ *	interchanges among the numerical values.
+ *
+ *	However, if the supernode has only one column, then we
+ *	only keep one set of subscripts. For any subscript interchange
+ *	performed, similar interchange must be done on the numerical
+ *	values.
+ *
+ *	The last column structures (for pruning) will be removed
+ *	after the numercial LU factorization phase.
+ *
+ *   (xlusup,lusup): lusup[*] contains the numerical values of the
+ *	rectangular supernodes; xlusup[j] points to the starting
+ *	location of the j-th column in storage vector lusup[*]
+ *	Note: xlusup is indexed by column.
+ *	Each rectangular supernode is stored by column-major
+ *	scheme, consistent with Fortran 2-dim array storage.
+ *
+ *   (xusub,ucol,usub): ucol[*] stores the numerical values of
+ *	U-columns outside the rectangular supernodes. The row
+ *	subscript of nonzero ucol[k] is stored in usub[k].
+ *	xusub[i] points to the starting location of column i in ucol.
+ *	Storage: new row subscripts; that is subscripts of PA.
+ */
+typedef struct {
+    int     *xsup;    /* supernode and column mapping */
+    int     *supno;   
+    int     *lsub;    /* compressed L subscripts */
+    int	    *xlsub;
+    doublecomplex  *lusup;   /* L supernodes */
+    int     *xlusup;
+    doublecomplex  *ucol;    /* U columns */
+    int     *usub;
+    int	    *xusub;
+    int     nzlmax;   /* current max size of lsub */
+    int     nzumax;   /*    "    "    "      ucol */
+    int     nzlumax;  /*    "    "    "     lusup */
+    int     n;        /* number of columns in the matrix */
+    LU_space_t MemModel; /* 0 - system malloc'd; 1 - user provided */
+} GlobalLU_t;
+
+typedef struct {
+    int panel_size;
+    int relax;
+    double diag_pivot_thresh;
+    double drop_tol;
+} factor_param_t;
+
+typedef struct {
+    float for_lu;
+    float total_needed;
+    int   expansions;
+} mem_usage_t;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* Driver routines */
+extern void
+zgssv(SuperMatrix *, int *, int *, SuperMatrix *, SuperMatrix *, 
+	SuperMatrix *, int *);
+extern void
+zgssvx(char *, char *, char *, SuperMatrix *, factor_param_t *,
+       int *, int *, int *, char *, double *, double *,
+       SuperMatrix *, SuperMatrix *, void *, int, SuperMatrix *, 
+       SuperMatrix *, double *, double *, double *,
+       double *, mem_usage_t *, int *);
+
+/* Supernodal LU factor related */
+extern void
+zCreate_CompCol_Matrix(SuperMatrix *, int, int, int, doublecomplex *,
+		       int *, int *, Stype_t, Dtype_t, Mtype_t);
+extern void
+zCopy_CompCol_Matrix(SuperMatrix *, SuperMatrix *);
+extern void
+zCreate_Dense_Matrix(SuperMatrix *, int, int, doublecomplex *, int,
+		     Stype_t, Dtype_t, Mtype_t);
+extern void
+zCreate_SuperNode_Matrix(SuperMatrix *, int, int, int, doublecomplex *, 
+		         int *, int *, int *, int *, int *,
+			 Stype_t, Dtype_t, Mtype_t);
+extern void
+zCopy_Dense_Matrix(int, int, doublecomplex *, int, doublecomplex *, int);
+
+extern void    Destroy_SuperMatrix_Store(SuperMatrix *);
+extern void    Destroy_CompCol_Matrix(SuperMatrix *);
+extern void    Destroy_SuperNode_Matrix(SuperMatrix *);
+extern void    Destroy_CompCol_Permuted(SuperMatrix *);
+extern void    Destroy_Dense_Matrix(SuperMatrix *);
+extern void    get_perm_c(int, SuperMatrix *, int *);
+extern void    sp_preorder (char*, SuperMatrix*, int*, int*, SuperMatrix*);
+extern void    countnz (const int, int *, int *, int *, GlobalLU_t *);
+extern void    fixupL (const int, const int *, GlobalLU_t *);
+
+extern void    zallocateA (int, int, doublecomplex **, int **, int **);
+extern void    zgstrf (char*, SuperMatrix*, double, double, int, int, int*,
+			void *, int, int *, int *, 
+                        SuperMatrix *, SuperMatrix *, int *);
+extern int     zsnode_dfs (const int, const int, const int *, const int *,
+			     const int *, int *, int *, GlobalLU_t *);
+extern int     zsnode_bmod (const int, const int, const int, doublecomplex *,
+                              doublecomplex *, GlobalLU_t *);
+extern void    zpanel_dfs (const int, const int, const int, SuperMatrix *,
+			   int *, int *, doublecomplex *, int *, int *, int *,
+			   int *, int *, int *, int *, GlobalLU_t *);
+extern void    zpanel_bmod (const int, const int, const int, const int,
+                           doublecomplex *, doublecomplex *, int *, int *,
+			   GlobalLU_t *);
+extern int     zcolumn_dfs (const int, const int, int *, int *, int *, int *,
+			   int *, int *, int *, int *, int *, GlobalLU_t *);
+extern int     zcolumn_bmod (const int, const int, doublecomplex *,
+			   doublecomplex *, int *, int *, int, GlobalLU_t *);
+extern int     zcopy_to_ucol (int, int, int *, int *, int *,
+                              doublecomplex *, GlobalLU_t *);         
+extern int     zpivotL (const int, const double, int *, int *, 
+                              int *, int *, int *, GlobalLU_t *);
+extern void    zpruneL (const int, const int *, const int, const int,
+			     const int *, const int *, int *, GlobalLU_t *);
+extern void    zreadmt (int *, int *, int *, doublecomplex **, int **, int **);
+extern void    zGenXtrue (int, int, doublecomplex *, int);
+extern void    zFillRHS (char *, int, doublecomplex *, int, SuperMatrix *,
+			SuperMatrix *);
+extern void    zgstrs (char *, SuperMatrix *, SuperMatrix *, int *, int *,
+			SuperMatrix *, int *);
+
+
+/* Driver related */
+
+extern void    zgsequ (SuperMatrix *, double *, double *, double *,
+			     double *, double *, int *);
+extern void    zlaqgs (SuperMatrix *, double *, double *, double,
+                             double, double, char *);
+extern void    zgscon (char *, SuperMatrix *, SuperMatrix *,
+			double, double *, int *);
+extern double  zPivotGrowth(int, SuperMatrix *, int *, 
+                            SuperMatrix *, SuperMatrix *);
+extern void    zgsrfs (char *, SuperMatrix *, SuperMatrix *, 
+			SuperMatrix *, int *, int *, char *, double *,
+			double *, SuperMatrix *, SuperMatrix *, 
+			double *, double *, int *);
+
+extern int     sp_ztrsv (char *, char *, char *, SuperMatrix *,
+			SuperMatrix *, doublecomplex *, int *);
+extern int     sp_zgemv (char *, doublecomplex, SuperMatrix *, doublecomplex *,
+			int, doublecomplex, doublecomplex *, int);
+
+extern int     sp_zgemm (char *, char *, int, int, int, doublecomplex,
+			SuperMatrix *, doublecomplex *, int, doublecomplex, 
+			doublecomplex *, int);
+
+/* Memory-related */
+extern int     zLUMemInit (char *, void *, int, int, int, int, int,
+			     SuperMatrix *, SuperMatrix *,
+			     GlobalLU_t *, int **, doublecomplex **);
+extern void    zSetRWork (int, int, doublecomplex *, doublecomplex **, doublecomplex **);
+extern void    zLUWorkFree (int *, doublecomplex *, GlobalLU_t *);
+extern int     zLUMemXpand (int, int, MemType, int *, GlobalLU_t *);
+
+extern doublecomplex  *doublecomplexMalloc(int);
+extern doublecomplex  *doublecomplexCalloc(int);
+extern double  *doubleMalloc(int);
+extern double  *doubleCalloc(int);
+extern int     zmemory_usage(const int, const int, const int, const int);
+extern int     zQuerySpace (SuperMatrix *, SuperMatrix *, int,
+				mem_usage_t *);
+
+/* Auxiliary routines */
+extern void    zreadhb(int *, int *, int *, doublecomplex **, int **, int **);
+extern void    zCompRow_to_CompCol(int, int, int, doublecomplex*, int*, int*,
+		                   doublecomplex **, int **, int **);
+extern void    zfill (doublecomplex *, int, doublecomplex);
+extern void    zinf_norm_error (int, SuperMatrix *, doublecomplex *);
+extern void    PrintPerf (SuperMatrix *, SuperMatrix *, mem_usage_t *,
+			 doublecomplex, doublecomplex, doublecomplex *, doublecomplex *, char *);
+
+/* Routines for debugging */
+extern void    zPrint_CompCol_Matrix(char *, SuperMatrix *);
+extern void    zPrint_SuperNode_Matrix(char *, SuperMatrix *);
+extern void    zPrint_Dense_Matrix(char *, SuperMatrix *);
+extern void    print_lu_col(char *, int, int, int *, GlobalLU_t *);
+extern void    check_tempv(int, doublecomplex *);
+
+#ifdef __cplusplus
+  }
+#endif
+
+#endif /* __SUPERLU_zSP_DEFS */
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/SuperLU/SRC/zutil.c	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,463 @@
+
+
+/*
+ * -- SuperLU routine (version 2.0) --
+ * Univ. of California Berkeley, Xerox Palo Alto Research Center,
+ * and Lawrence Berkeley National Lab.
+ * November 15, 1997
+ *
+ */
+/*
+  Copyright (c) 1994 by Xerox Corporation.  All rights reserved.
+ 
+  THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
+  EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ 
+  Permission is hereby granted to use or copy this program for any
+  purpose, provided the above notices are retained on all copies.
+  Permission to modify the code and to distribute modified code is
+  granted, provided the above notices are retained, and a notice that
+  the code was modified is included with the above copyright notice.
+*/
+
+#include <math.h>
+#include "zsp_defs.h"
+#include "util.h"
+
+void
+zCreate_CompCol_Matrix(SuperMatrix *A, int m, int n, int nnz, 
+		       doublecomplex *nzval, int *rowind, int *colptr,
+		       Stype_t stype, Dtype_t dtype, Mtype_t mtype)
+{
+    NCformat *Astore;
+
+    A->Stype = stype;
+    A->Dtype = dtype;
+    A->Mtype = mtype;
+    A->nrow = m;
+    A->ncol = n;
+    A->Store = (void *) SUPERLU_MALLOC( sizeof(NCformat) );
+    if ( !(A->Store) ) ABORT("SUPERLU_MALLOC fails for A->Store");
+    Astore = A->Store;
+    Astore->nnz = nnz;
+    Astore->nzval = nzval;
+    Astore->rowind = rowind;
+    Astore->colptr = colptr;
+}
+
+void
+zCreate_CompRow_Matrix(SuperMatrix *A, int m, int n, int nnz, 
+		       doublecomplex *nzval, int *colind, int *rowptr,
+		       Stype_t stype, Dtype_t dtype, Mtype_t mtype)
+{
+    NRformat *Astore;
+
+    A->Stype = stype;
+    A->Dtype = dtype;
+    A->Mtype = mtype;
+    A->nrow = m;
+    A->ncol = n;
+    A->Store = (void *) SUPERLU_MALLOC( sizeof(NRformat) );
+    if ( !(A->Store) ) ABORT("SUPERLU_MALLOC fails for A->Store");
+    Astore = A->Store;
+    Astore->nnz = nnz;
+    Astore->nzval = nzval;
+    Astore->colind = colind;
+    Astore->rowptr = rowptr;
+}
+
+/* Copy matrix A into matrix B. */
+void
+zCopy_CompCol_Matrix(SuperMatrix *A, SuperMatrix *B)
+{
+    NCformat *Astore, *Bstore;
+    int      ncol, nnz, i;
+
+    B->Stype = A->Stype;
+    B->Dtype = A->Dtype;
+    B->Mtype = A->Mtype;
+    B->nrow  = A->nrow;;
+    B->ncol  = ncol = A->ncol;
+    Astore   = (NCformat *) A->Store;
+    Bstore   = (NCformat *) B->Store;
+    Bstore->nnz = nnz = Astore->nnz;
+    for (i = 0; i < nnz; ++i)
+	((doublecomplex *)Bstore->nzval)[i] = ((doublecomplex *)Astore->nzval)[i];
+    for (i = 0; i < nnz; ++i) Bstore->rowind[i] = Astore->rowind[i];
+    for (i = 0; i <= ncol; ++i) Bstore->colptr[i] = Astore->colptr[i];
+}
+
+
+void
+zCreate_Dense_Matrix(SuperMatrix *X, int m, int n, doublecomplex *x, int ldx,
+		    Stype_t stype, Dtype_t dtype, Mtype_t mtype)
+{
+    DNformat    *Xstore;
+    
+    X->Stype = stype;
+    X->Dtype = dtype;
+    X->Mtype = mtype;
+    X->nrow = m;
+    X->ncol = n;
+    X->Store = (void *) SUPERLU_MALLOC( sizeof(DNformat) );
+    if ( !(X->Store) ) ABORT("SUPERLU_MALLOC fails for X->Store");
+    Xstore = (DNformat *) X->Store;
+    Xstore->lda = ldx;
+    Xstore->nzval = (doublecomplex *) x;
+}
+
+void
+zCopy_Dense_Matrix(int M, int N, doublecomplex *X, int ldx,
+			doublecomplex *Y, int ldy)
+{
+/*
+ *
+ *  Purpose
+ *  =======
+ *
+ *  Copies a two-dimensional matrix X to another matrix Y.
+ */
+    int    i, j;
+    
+    for (j = 0; j < N; ++j)
+        for (i = 0; i < M; ++i)
+            Y[i + j*ldy] = X[i + j*ldx];
+}
+
+void
+zCreate_SuperNode_Matrix(SuperMatrix *L, int m, int n, int nnz, 
+			doublecomplex *nzval, int *nzval_colptr, int *rowind,
+			int *rowind_colptr, int *col_to_sup, int *sup_to_col,
+			Stype_t stype, Dtype_t dtype, Mtype_t mtype)
+{
+    SCformat *Lstore;
+
+    L->Stype = stype;
+    L->Dtype = dtype;
+    L->Mtype = mtype;
+    L->nrow = m;
+    L->ncol = n;
+    L->Store = (void *) SUPERLU_MALLOC( sizeof(SCformat) );
+    if ( !(L->Store) ) ABORT("SUPERLU_MALLOC fails for L->Store");
+    Lstore = L->Store;
+    Lstore->nnz = nnz;
+    Lstore->nsuper = col_to_sup[n];
+    Lstore->nzval = nzval;
+    Lstore->nzval_colptr = nzval_colptr;
+    Lstore->rowind = rowind;
+    Lstore->rowind_colptr = rowind_colptr;
+    Lstore->col_to_sup = col_to_sup;
+    Lstore->sup_to_col = sup_to_col;
+
+}
+
+
+/*
+ * Convert a row compressed storage into a column compressed storage.
+ */
+void
+zCompRow_to_CompCol(int m, int n, int nnz, 
+		    doublecomplex *a, int *colind, int *rowptr,
+		    doublecomplex **at, int **rowind, int **colptr)
+{
+    register int i, j, col, relpos;
+    int *marker;
+
+    /* Allocate storage for another copy of the matrix. */
+    *at = (doublecomplex *) doublecomplexMalloc(nnz);
+    *rowind = (int *) intMalloc(nnz);
+    *colptr = (int *) intMalloc(n+1);
+    marker = (int *) intCalloc(n);
+    
+    /* Get counts of each column of A, and set up column pointers */
+    for (i = 0; i < m; ++i)
+	for (j = rowptr[i]; j < rowptr[i+1]; ++j) ++marker[colind[j]];
+    (*colptr)[0] = 0;
+    for (j = 0; j < n; ++j) {
+	(*colptr)[j+1] = (*colptr)[j] + marker[j];
+	marker[j] = (*colptr)[j];
+    }
+
+    /* Transfer the matrix into the compressed column storage. */
+    for (i = 0; i < m; ++i) {
+	for (j = rowptr[i]; j < rowptr[i+1]; ++j) {
+	    col = colind[j];
+	    relpos = marker[col];
+	    (*rowind)[relpos] = i;
+	    (*at)[relpos] = a[j];
+	    ++marker[col];
+	}
+    }
+
+    SUPERLU_FREE(marker);
+}
+
+
+void
+zPrint_CompCol_Matrix(char *what, SuperMatrix *A)
+{
+    NCformat     *Astore;
+    register int i,n;
+    double       *dp;
+    
+    printf("\nCompCol matrix %s:\n", what);
+    printf("Stype %d, Dtype %d, Mtype %d\n", A->Stype,A->Dtype,A->Mtype);
+    n = A->ncol;
+    Astore = (NCformat *) A->Store;
+    dp = (double *) Astore->nzval;
+    printf("nrow %d, ncol %d, nnz %d\n", A->nrow,A->ncol,Astore->nnz);
+    printf("nzval: ");
+    for (i = 0; i < 2*Astore->colptr[n]; ++i) printf("%f  ", dp[i]);
+    printf("\nrowind: ");
+    for (i = 0; i < Astore->colptr[n]; ++i) printf("%d  ", Astore->rowind[i]);
+    printf("\ncolptr: ");
+    for (i = 0; i <= n; ++i) printf("%d  ", Astore->colptr[i]);
+    printf("\n");
+    fflush(stdout);
+}
+
+void
+zPrint_SuperNode_Matrix(char *what, SuperMatrix *A)
+{
+    SCformat     *Astore;
+    register int i,n;
+    double       *dp;
+    
+    printf("\nSuperNode matrix %s:\n", what);
+    printf("Stype %d, Dtype %d, Mtype %d\n", A->Stype,A->Dtype,A->Mtype);
+    n = A->ncol;
+    Astore = (SCformat *) A->Store;
+    dp = (double *) Astore->nzval;
+    printf("nrow %d, ncol %d, nnz %d, nsuper %d\n", 
+	   A->nrow,A->ncol,Astore->nnz,Astore->nsuper);
+    printf("nzval: ");
+    for (i = 0; i < 2*Astore->nzval_colptr[n]; ++i) printf("%f  ", dp[i]);
+    printf("\nnzval_colptr: ");
+    for (i = 0; i <= n; ++i) printf("%d  ", Astore->nzval_colptr[i]);
+    printf("\nrowind: ");
+    for (i = 0; i < Astore->rowind_colptr[n]; ++i) 
+        printf("%d  ", Astore->rowind[i]);
+    printf("\nrowind_colptr: ");
+    for (i = 0; i <= n; ++i) printf("%d  ", Astore->rowind_colptr[i]);
+    printf("\ncol_to_sup: ");
+    for (i = 0; i < n; ++i) printf("%d  ", Astore->col_to_sup[i]);
+    printf("\nsup_to_col: ");
+    for (i = 0; i <= Astore->nsuper+1; ++i) 
+        printf("%d  ", Astore->sup_to_col[i]);
+    printf("\n");
+    fflush(stdout);
+}
+
+void
+zPrint_Dense_Matrix(char *what, SuperMatrix *A)
+{
+    DNformat     *Astore;
+    register int i;
+    double       *dp;
+    
+    printf("\nDense matrix %s:\n", what);
+    printf("Stype %d, Dtype %d, Mtype %d\n", A->Stype,A->Dtype,A->Mtype);
+    Astore = (DNformat *) A->Store;
+    dp = (double *) Astore->nzval;
+    printf("nrow %d, ncol %d, lda %d\n", A->nrow,A->ncol,Astore->lda);
+    printf("\nnzval: ");
+    for (i = 0; i < 2*A->nrow; ++i) printf("%f  ", dp[i]);
+    printf("\n");
+    fflush(stdout);
+}
+
+/*
+ * Diagnostic print of column "jcol" in the U/L factor.
+ */
+void
+zprint_lu_col(char *msg, int jcol, int pivrow, int *xprune, GlobalLU_t *Glu)
+{
+    int     i, k, fsupc;
+    int     *xsup, *supno;
+    int     *xlsub, *lsub;
+    doublecomplex  *lusup;
+    int     *xlusup;
+    doublecomplex  *ucol;
+    int     *usub, *xusub;
+
+    xsup    = Glu->xsup;
+    supno   = Glu->supno;
+    lsub    = Glu->lsub;
+    xlsub   = Glu->xlsub;
+    lusup   = Glu->lusup;
+    xlusup  = Glu->xlusup;
+    ucol    = Glu->ucol;
+    usub    = Glu->usub;
+    xusub   = Glu->xusub;
+    
+    printf("%s", msg);
+    printf("col %d: pivrow %d, supno %d, xprune %d\n", 
+	   jcol, pivrow, supno[jcol], xprune[jcol]);
+    
+    printf("\tU-col:\n");
+    for (i = xusub[jcol]; i < xusub[jcol+1]; i++)
+	printf("\t%d%10.4f, %10.4f\n", usub[i], ucol[i].r, ucol[i].i);
+    printf("\tL-col in rectangular snode:\n");
+    fsupc = xsup[supno[jcol]];	/* first col of the snode */
+    i = xlsub[fsupc];
+    k = xlusup[jcol];
+    while ( i < xlsub[fsupc+1] && k < xlusup[jcol+1] ) {
+	printf("\t%d\t%10.4f, %10.4f\n", lsub[i], lusup[k].r, lusup[k].i);
+	i++; k++;
+    }
+    fflush(stdout);
+}
+
+
+/*
+ * Check whether tempv[] == 0. This should be true before and after 
+ * calling any numeric routines, i.e., "panel_bmod" and "column_bmod". 
+ */
+void zcheck_tempv(int n, doublecomplex *tempv)
+{
+    int i;
+	
+    for (i = 0; i < n; i++) {
+	if ((tempv[i].r != 0.0) || (tempv[i].i != 0.0))
+	{
+	    fprintf(stderr,"tempv[%d] = {%f, %f}\n", i, tempv[i].r, tempv[i].i);
+	    ABORT("zcheck_tempv");
+	}
+    }
+}
+
+
+void
+zGenXtrue(int n, int nrhs, doublecomplex *x, int ldx)
+{
+    int  i, j;
+    for (j = 0; j < nrhs; ++j)
+	for (i = 0; i < n; ++i) {
+	    x[i + j*ldx].r = 1.0;
+	    x[i + j*ldx].i = 0.0;
+	}
+}
+
+/*
+ * Let rhs[i] = sum of i-th row of A, so the solution vector is all 1's
+ */
+void
+zFillRHS(char *trans, int nrhs, doublecomplex *x, int ldx,
+		SuperMatrix *A, SuperMatrix *B)
+{
+    NCformat *Astore;
+    doublecomplex   *Aval;
+    DNformat *Bstore;
+    doublecomplex   *rhs;
+    doublecomplex one = {1.0, 0.0};
+    doublecomplex zero = {0.0, 0.0};
+    int      ldc;
+
+    Astore = A->Store;
+    Aval   = (doublecomplex *) Astore->nzval;
+    Bstore = B->Store;
+    rhs    = Bstore->nzval;
+    ldc    = Bstore->lda;
+    
+    sp_zgemm(trans, "N", A->nrow, nrhs, A->ncol, one, A,
+	     x, ldx, zero, rhs, ldc);
+
+}
+
+/* 
+ * Fills a doublecomplex precision array with a given value.
+ */
+void 
+zfill(doublecomplex *a, int alen, doublecomplex dval)
+{
+    register int i;
+    for (i = 0; i < alen; i++) a[i] = dval;
+}
+
+
+
+/* 
+ * Check the inf-norm of the error vector 
+ */
+void zinf_norm_error(int nrhs, SuperMatrix *X, doublecomplex *xtrue)
+{
+    DNformat *Xstore;
+    double err, xnorm;
+    doublecomplex *Xmat, *soln_work;
+    doublecomplex temp;
+    int i, j;
+
+    Xstore = X->Store;
+    Xmat = Xstore->nzval;
+
+    for (j = 0; j < nrhs; j++) {
+      soln_work = &Xmat[j*Xstore->lda];
+      err = xnorm = 0.0;
+      for (i = 0; i < X->nrow; i++) {
+        z_sub(&temp, &soln_work[i], &xtrue[i]);
+	err = MAX(err, z_abs(&temp));
+	xnorm = MAX(xnorm, z_abs(&soln_work[i]));
+      }
+      err = err / xnorm;
+      printf("||X - Xtrue||/||X|| = %e\n", err);
+    }
+}
+
+
+
+/* Print performance of the code. */
+void
+zPrintPerf(SuperMatrix *L, SuperMatrix *U, mem_usage_t *mem_usage,
+	       double rpg, double rcond, double *ferr,
+	       double *berr, char *equed)
+{
+    SCformat *Lstore;
+    NCformat *Ustore;
+    extern SuperLUStat_t SuperLUStat;
+    double   *utime;
+    flops_t  *ops;
+    
+    utime = SuperLUStat.utime;
+    ops   = SuperLUStat.ops;
+    
+    if ( utime[FACT] != 0. )
+	printf("Factor flops = %e\tMflops = %8.2f\n", ops[FACT],
+	       ops[FACT]*1e-6/utime[FACT]);
+    printf("Identify relaxed snodes	= %8.2f\n", utime[RELAX]);
+    if ( utime[SOLVE] != 0. )
+	printf("Solve flops = %.0f, Mflops = %8.2f\n", ops[SOLVE],
+	       ops[SOLVE]*1e-6/utime[SOLVE]);
+    
+    Lstore = (SCformat *) L->Store;
+    Ustore = (NCformat *) U->Store;
+    printf("\tNo of nonzeros in factor L = %d\n", Lstore->nnz);
+    printf("\tNo of nonzeros in factor U = %d\n", Ustore->nnz);
+    printf("\tNo of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz);
+	
+    printf("L\\U MB %.3f\ttotal MB needed %.3f\texpansions %d\n",
+	   mem_usage->for_lu/1e6, mem_usage->total_needed/1e6,
+	   mem_usage->expansions);
+	
+    printf("\tFactor\tMflops\tSolve\tMflops\tEtree\tEquil\tRcond\tRefine\n");
+    printf("PERF:%8.2f%8.2f%8.2f%8.2f%8.2f%8.2f%8.2f%8.2f\n",
+	   utime[FACT], ops[FACT]*1e-6/utime[FACT],
+	   utime[SOLVE], ops[SOLVE]*1e-6/utime[SOLVE],
+	   utime[ETREE], utime[EQUIL], utime[RCOND], utime[REFINE]);
+    
+    printf("\tRpg\t\tRcond\t\tFerr\t\tBerr\t\tEquil?\n");
+    printf("NUM:\t%e\t%e\t%e\t%e\t%s\n",
+	   rpg, rcond, ferr[0], berr[0], equed);
+    
+}
+
+
+
+
+print_doublecomplex_vec(char *what, int n, doublecomplex *vec)
+{
+    int i;
+    printf("%s: n %d\n", what, n);
+    for (i = 0; i < n; ++i) printf("%d\t%f%f\n", i, vec[i].r, vec[i].i);
+    return 0;
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/complex_sparse_ops.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,1159 @@
+/*
+Sparse matrix functionality for octave, based on the
+   SuperLU package  
+Copyright (C) 1998-2000 Andy Adler
+
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Octave; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+$Id$
+
+*/
+
+#define  SPARSE_COMPLEX_CODE
+#include "make_sparse.h"
+#include "sparse_ops.h"
+
+//
+// Utility methods
+//
+
+// test that the doublecomplex type defined
+// by SuperLU is compatible with 
+// the Complex type from c++?
+//
+// return 0 if ok
+//       -ve if notok
+int
+complex_sparse_verify_doublecomplex_type(void) 
+{
+   int r= 99; int i= 98;
+   Complex cv(r,i);
+   doublecomplex * dc= (doublecomplex *) &cv;
+   if ( (dc->r == r) &&
+        (dc->i == i) )
+      return 0;
+   else
+      return -1;
+}   
+
+SuperMatrix
+create_SuperMatrix( int nr, int nc, int nnz,
+                    Complex * coef,
+                    int * ridx,
+                    int * cidx )
+{
+   SuperMatrix  X;
+   zCreate_CompCol_Matrix(&X, nr, nc, nnz,
+                          (doublecomplex *) coef,
+                          ridx, cidx, NC, _Z, GE);
+   return X;
+}
+
+//
+// Octave complex sparse methods
+//
+
+inline
+octave_complex_sparse::octave_complex_sparse (SuperMatrix A )
+{
+   DEBUGMSG("complex_sparse( SuperMatrix A)");
+   X= A;
+}
+
+inline
+octave_complex_sparse::~octave_complex_sparse (void)
+{
+   DEBUGMSG("complex_sparse destructor");
+   oct_sparse_Destroy_SuperMatrix( X ) ;
+}
+
+//NOTE: I'm not sure when this will get called,
+//      so I don't know what to do
+inline
+octave_complex_sparse::octave_complex_sparse (const octave_complex_sparse& S)
+{
+   DEBUGMSG("complex_sparse copy-constructor");
+   X= S.super_matrix();
+}   
+
+inline octave_value *
+octave_complex_sparse::clone (void)
+{
+   DEBUGMSG("complex_sparse - clone");
+   return new octave_complex_sparse (*this);
+}
+
+inline octave_complex_sparse
+octave_complex_sparse::sparse_value (bool = false) const {
+   DEBUGMSG("complex_sparse_value");
+   return  (*this);
+}
+
+SuperMatrix
+octave_complex_sparse::super_matrix (bool = false) const {
+   return X;
+}
+
+
+int octave_complex_sparse::rows    (void) const {
+   return X.nrow;
+}
+int octave_complex_sparse::columns (void) const {
+   return X.ncol;
+}
+
+int octave_complex_sparse::nnz     (void) const {
+   NCformat * NCF  = (NCformat * ) X.Store;
+   return   NCF->nnz ;
+}
+
+// upconvert octave_sparse to octave_complex_sparse
+octave_complex_sparse
+octave_sparse::complex_sparse_value (bool = false) const {
+   DEBUGMSG("sparse - complex_sparse_value");
+   DEFINE_SP_POINTERS_REAL( X )
+   int nnz= NCFX->nnz;
+
+   Complex *coefB = (Complex *) doublecomplexMalloc(nnz);
+   int *    ridxB =             intMalloc(nnz);
+   int *    cidxB =             intMalloc(X.ncol+1);
+
+   for ( int i=0; i<=Xnc; i++) 
+      cidxB[i]=  cidxX[i];
+
+   for ( int i=0; i< nnz; i++) {
+      coefB[i]= coefX[i];
+      ridxB[i]= ridxX[i];
+   }
+   
+   SuperMatrix B= create_SuperMatrix( Xnr, Xnc, nnz, coefB, ridxB, cidxB);
+   return octave_complex_sparse ( B );
+}
+
+ComplexMatrix
+oct_complex_sparse_to_full ( SuperMatrix X ) {
+   DEBUGMSG("complex_sparse - sparse_to_full");
+   DEFINE_SP_POINTERS_CPLX( X );
+   
+   ComplexMatrix M( Xnr, Xnc );
+   for (int j=0; j< Xnc; j++) {
+   // I think new Matrices are initialized to zero, however just in case
+      for (int i=0; i< Xnr; i++) M(i,j)= 0;
+   
+      for (int i= cidxX[j]; i< cidxX[j+1]; i++) 
+         M( ridxX[i],j)= coefX[i];
+   } // for i
+   return M;
+}   
+
+// type conversion functions
+
+static octave_value *
+default_numeric_conversion_function (const octave_value& a)
+{
+   DEBUGMSG("complex_sparse - default_numeric_conversion_function");
+   CAST_CONV_ARG (const octave_complex_sparse&);
+   return new octave_complex_matrix (v.complex_matrix_value ());
+}
+ 
+type_conv_fcn
+octave_complex_sparse::numeric_conversion_function (void) const
+{
+   DEBUGMSG("complex_sparse - numeric_conversion_function");
+   return default_numeric_conversion_function;
+}
+
+//idx_vector index_vector (void) const { return idx_vector ((double) iv); }
+
+octave_value octave_complex_sparse::any (void) const {
+   DEBUGMSG("complex_sparse - any");
+   ComplexMatrix M= oct_complex_sparse_to_full( X );
+   return M.any();
+}
+
+octave_value octave_complex_sparse::all (void) const {
+   DEBUGMSG("complex_sparse - all");
+   ComplexMatrix M= oct_complex_sparse_to_full( X );
+   return M.all();
+}
+
+bool octave_complex_sparse::is_defined    (void) const  { return true; }
+bool octave_complex_sparse::is_real_scalar (void) const { return false; }
+bool octave_complex_sparse::is_real_type (void) const { return false; }
+bool octave_complex_sparse::is_scalar_type (void) const { return false; }
+bool octave_complex_sparse::is_numeric_type (void) const { return true; }
+
+bool octave_complex_sparse::valid_as_scalar_index (void) const { return false; }
+
+bool octave_complex_sparse::valid_as_zero_index (void) const { return false; }
+
+
+//A matrix is true if it is all non zero
+bool octave_complex_sparse::is_true (void) const {
+   DEBUGMSG("complex_sparse - is_true");
+   NCformat * NCF  = (NCformat * ) X.Store;
+   return (X.nrow * X.ncol == NCF->nnz );
+}
+
+
+// rebuild a full matrix from a sparse one
+// this functionality is accessed through 'full'
+ComplexMatrix
+octave_complex_sparse::complex_matrix_value (bool = false) const {
+   DEBUGMSG("complex_sparse - complex_matrix_value");
+   ComplexMatrix M= oct_complex_sparse_to_full( X );
+   return M;
+}
+
+
+octave_value
+octave_complex_sparse::uminus (void) const {
+   DEFINE_SP_POINTERS_CPLX( X )
+   int nnz= NCFX->nnz;
+
+   Complex *coefB = (Complex *) doublecomplexMalloc(nnz);
+   int *   ridxB  =             intMalloc(nnz);
+   int *   cidxB  =             intMalloc(X.ncol+1);
+
+   for ( int i=0; i<=Xnc; i++) 
+      cidxB[i]=  cidxX[i];
+
+   for ( int i=0; i< nnz; i++) {
+      coefB[i]= -coefX[i];
+      ridxB[i]=  ridxX[i];
+   }
+   
+   SuperMatrix B= create_SuperMatrix( Xnr, Xnc, nnz, coefB, ridxB, cidxB );
+   return new octave_complex_sparse ( B );
+} // octave_value uminus (void) const {
+
+UNOPDECL (uminus, a ) 
+{ 
+   DEBUGMSG("complex_sparse - uminus");
+   CAST_UNOP_ARG (const octave_complex_sparse&); 
+   return v.uminus();
+}   
+
+SuperMatrix
+oct_complex_sparse_transpose ( SuperMatrix X ) {
+   DEFINE_SP_POINTERS_CPLX( X )
+   int nnz= NCFX->nnz;
+
+   DECLARE_SP_POINTERS_CPLX( B )
+
+   zCompRow_to_CompCol( Xnc, Xnr, nnz,
+                  (doublecomplex *) coefX, ridxX, cidxX,
+                  (doublecomplex **) &coefB, &ridxB, &cidxB);
+   
+   SuperMatrix B= create_SuperMatrix( Xnc, Xnr, nnz, coefB, ridxB, cidxB );
+   return B;
+}   
+
+octave_value octave_complex_sparse::transpose (void) const {
+   return new octave_complex_sparse ( oct_complex_sparse_transpose( X ) );
+} // octave_complex_sparse::transpose (void) const {
+
+UNOPDECL (transpose, a)
+{
+   DEBUGMSG("complex_sparse - transpose");
+   CAST_UNOP_ARG (const octave_complex_sparse&); 
+   return v.transpose();
+} // transpose
+
+octave_value octave_complex_sparse::hermitian (void) const {
+   SuperMatrix T= oct_complex_sparse_transpose( X );
+
+   NCformat * NCFT= (NCformat *) T.Store; 
+   doublecomplex * coefT = (doublecomplex *) NCFT->nzval;
+   for ( int k=0; k< NCFT->nnz; k++) {
+      double t= coefT[k].i;
+      // check that imag val is not 0, 
+      // otherwise we get -0 values
+      if (t != 0 )
+         coefT[k].i= -t;
+   }
+
+   return new octave_complex_sparse ( T );
+} // octave_complex_sparse::transpose (void) const {
+
+UNOPDECL (hermitian, a)
+{
+   DEBUGMSG("complex_sparse - hermitian");
+   CAST_UNOP_ARG (const octave_complex_sparse&); 
+   return v.hermitian();
+} // hermitian
+
+#if 0
+typedef struct { long val;
+                 long idx; } sort_idx;   
+// comparison function for sort in index
+static inline int
+ixp_comp(const void *i,const void*j )
+{
+   return (((sort_idx *) i)->val) - (((sort_idx *) j)->val);
+}
+
+// generates a sort of idxv with the sort index
+// note that sidx[] must have space for idxv.length elements
+static inline void
+sort_with_idx (sort_idx * sidx, const idx_vector& idxv, long ixl) 
+{
+   if (idxv.is_colon() ) {
+      for (int i=0; i< ixl; i++) {
+         sidx[i].val= i;
+         sidx[i].idx= i;
+      }
+   }
+   else {
+      for (int i=0; i< ixl; i++) {
+         sidx[i].val= idxv(i);
+         sidx[i].idx= i;
+      }
+
+      qsort( sidx, ixl, sizeof(sort_idx), ixp_comp );
+   }
+}   
+
+// Return a full vector output
+// Does it make sense to output a sparse matrix here?
+static ColumnVector
+sparse_index_oneidx ( SuperMatrix X, const idx_vector ix) {
+   DEBUGMSG("complex_sparse_index_oneidx");
+   DEFINE_SP_POINTERS_CPLX( X )
+   long      ixl; 
+
+   if (ix.is_colon() ) 
+      ixl= Xnr*Xnc;
+   else  
+      ixl= ix.length(-1); 
+
+   sort_idx ixp[ ixl ];
+   sort_with_idx (ixp, ix, ixl);
+
+   ColumnVector O( ixl );
+   long ip= -Xnr; // previous column position
+   long jj=0,jl=0;
+   for (long k=0; k< ixl; k++) {
+      long ii  = ixp[k].val;
+      long kout= ixp[k].idx;
+
+      if ( ii<0 || ii>=Xnr*Xnc) 
+         SP_FATAL_ERR("invalid matrix index");
+ 
+      int rown= ii/Xnr;
+      if ( rown > ip/Xnr ) { // we've moved to a new column
+         jl= cidxX[rown];
+         jj= cidxX[rown+1];
+      }
+
+      while ( ridxX[jl] < ii%Xnr && jl < jj ) jl++;
+
+      if ( ridxX[jl] == ii%Xnr && jl<jj ) 
+         O( kout ) = coefX[jl] ;
+      else
+         O( kout ) = 0 ;
+
+      ip=ii;
+   }
+   return O;
+} // sparse_index_oneidx (
+
+
+static SuperMatrix
+sparse_index_twoidx ( SuperMatrix X,
+                      const idx_vector ix,
+                      const idx_vector jx) {
+   DEBUGMSG("complex_sparse_index_twoidx");
+   DEFINE_SP_POINTERS_CPLX( X )
+
+   int ixl,jxl;
+   if (ix.is_colon() )      ixl= Xnr;
+   else                     ixl= ix.length(-1); 
+
+   if (jx.is_colon() )      jxl= Xnc;
+   else                     jxl= jx.length(-1); 
+
+   sort_idx ixp[ ixl ];
+   sort_with_idx (ixp, ix, ixl);
+
+   // extimate the nnz in the output matrix
+   int nnz = (int) ceil( (NCFX->nnz) * (1.0*ixl / Xnr) * (1.0*jxl / Xnc) ); 
+
+   double * coefB = doubleMalloc(nnz);
+   int    * ridxB = intMalloc   (nnz);
+   int    * cidxB = intMalloc   (jxl+1);  cidxB[0]= 0;
+
+   double tcol[ixl];  // a column of the extracted matrix
+
+   int cx= 0, ll=0;
+   int ip= -Xnc; // previous column position
+   for (int l=0; l< jxl; l++) {
+      if (jx.is_colon() )    ll= l;
+      else                   ll= jx(l);
+
+      if ( ll<0 || ll>=Xnc) 
+            SP_FATAL_ERR("invalid matrix index (x index)");
+
+      int jl= cidxX[ll];
+      int jj= cidxX[ll+1];
+      for (long k=0; k< ixl; k++) {
+         long ii  = ixp[k].val;
+         long kout= ixp[k].idx;
+   
+         if ( ii<0 || ii>=Xnr) 
+            SP_FATAL_ERR("invalid matrix index (x index)");
+
+         while ( ridxX[jl] < ii && jl < jj ) jl++;
+
+
+         if ( ridxX[jl] == ii && jl<jj ) 
+            tcol[ kout ] = coefX[jl] ;
+         else
+            tcol[ kout ] = 0 ;
+
+         ip=ii;
+   
+      } // for k
+      for (int j=0; j<ixl; j++) {
+         if (tcol[j] !=0 ) {
+            check_bounds( cx, nnz, ridxB, coefB );
+            ridxB[cx]= j;
+            coefB[cx]= tcol[j];
+            cx++;
+         }
+      }
+      cidxB[l+1]= cx;
+   } // for l
+
+   maybe_shrink( cx, nnz, ridxB, coefB );
+
+   SuperMatrix B;
+   dCreate_CompCol_Matrix(&B, ixl, jxl, cx,
+                       coefB, ridxB, cidxB, NC, _D, GE);
+
+   return B;                          
+} // sparse_index_twoidx (
+
+// indexing operations
+octave_value_list
+octave_complex_sparse::do_multi_index_op (int, const octave_value_list& idx) 
+{
+   DEBUGMSG("complex_sparse - index op");
+   octave_value retval;
+   
+   if ( idx.length () == 1) {
+      const idx_vector ix = idx (0).index_vector ();
+      ColumnVector O= sparse_index_oneidx( X, ix );
+
+      // the rules are complicated here X(Y):
+      // X is matrix: result is same shape as Y
+      // X is vector: result is same orientation as X
+      // X is scalar: result is column orientation
+
+// printf("idx(0) [%d x %d]\n", idx(0).rows(), idx(0).columns() );
+      if (1)  retval= O;
+      else                         retval= O.transpose();
+   } else
+   if ( idx.length () == 2) {
+      const idx_vector ix = idx (0).index_vector ();
+      const idx_vector jx = idx (1).index_vector ();
+
+      retval= new octave_complex_sparse ( 
+                  sparse_index_twoidx ( X, ix, jx ));
+   } else
+      SP_FATAL_ERR("need 1 or 2 indices for sparse indexing operations");
+
+   return retval;
+} // octave_complex_sparse::do_index_op
+
+
+octave_value
+octave_complex_sparse::extract (int r1, int c1, int r2, int c2) const {
+   DEBUGMSG("complex_sparse - extract");
+   DEFINE_SP_POINTERS_CPLX( X )
+
+// estimate the nnz needed is the A->nnz times the
+//  fraction of the matrix selected
+   if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; }
+   if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; }
+   int m= r1-r2+1;
+   int n= c1-c2+1;
+
+   int nnz = (int) ceil( (NCFX->nnz) * (1.0*m / Xnr)
+                                     * (1.0*n / Xnc) ); 
+
+   double * coefB = doubleMalloc(nnz);
+   int    * ridxB = intMalloc   (nnz);
+   int    * cidxB = intMalloc   (n+1);  cidxB[0]= 0;
+
+   int cx= 0;
+   for (int i=0, ii= c1; i < n ; i++, ii++) {
+      for ( int j= cidxX[ii]; j< cidxX[ii+1]; j++) {
+         int row = ridxX[ j ];
+         if ( row>= r1 && row<=r2 && coefX[j] !=0 ) {
+            check_bounds( cx, nnz, ridxB, coefB );
+            ridxB[ cx ]= row - r1;
+            coefB[ cx ]= coefX[ j ];
+            cx++;
+         } // if row
+      } //for j
+
+      cidxX[i+1] = cx;
+   } // for ( i=0
+
+   maybe_shrink( cx, nnz, ridxX, coefX );
+
+   SuperMatrix B;
+   dCreate_CompCol_Matrix(&B, m, n, cx,
+                          coefB, ridxB, cidxB, NC, _D, GE);
+
+   return new octave_complex_sparse ( B );
+} // octave_complex_sparse::extract (int r1, int c1, int r2, int c2) const {
+
+#endif
+
+void
+octave_complex_sparse::print (ostream& os, bool pr_as_read_syntax ) const
+{
+   DEBUGMSG("complex_sparse - print");
+#if 0
+// I find the SuperLU print function to be ugly and clumsy
+   zPrint_CompCol_Matrix("octave sparse", &X);
+#else      
+   DEFINE_SP_POINTERS_CPLX( X )
+   int nnz = NCFX->nnz;
+   
+   os << "Compressed Column Sparse (rows=" << Xnr <<
+                                 ", cols=" << Xnc <<
+                                 ", nnz=" << nnz << ")\n";
+   // add one to the printed indices to go from
+   //  zero-based to one-based arrays
+   for (int j=0; j< Xnc; j++) 
+      for (int i= cidxX[j]; i< cidxX[j+1]; i++) 
+         os << "  (" << ridxX[i]+1 <<
+               " , "  << j+1 << ") -> " << coefX[i] << "\n";
+#endif                  
+} // print
+
+//
+// sparse by complex  operations
+//
+
+octave_value
+complex_sparse_complex_multiply (
+            const octave_complex_sparse& spar,
+            const octave_complex&        cplx)
+{
+  DEBUGMSG("complex_sparse - complex_sparse_complex_multiply");
+  Complex c= cplx.complex_value();
+
+  SuperMatrix X= spar.super_matrix();
+  DEFINE_SP_POINTERS_CPLX( X )
+  int nnz= NCFX->nnz;
+
+  Complex *coefB = (Complex *) doublecomplexMalloc(nnz);
+  int *    ridxB = intMalloc(nnz);
+  int *    cidxB = intMalloc(X.ncol+1);
+
+  for ( int i=0; i<=Xnc; i++)
+     cidxB[i]=  cidxX[i];
+
+  for ( int i=0; i< nnz; i++) {
+     coefB[i]=  coefX[i] * c;
+     ridxB[i]=  ridxX[i];
+  }
+
+  SuperMatrix B= create_SuperMatrix( Xnr, Xnc, nnz, coefB, ridxB, cidxB );
+  return new octave_complex_sparse ( B );
+}
+
+//
+// complex_sparse by scalar operations
+//
+
+DEFBINOP (s_n_mul, complex_sparse, scalar) {
+  CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_scalar&);
+  Complex cv( v2.double_value(), 0 );
+  return complex_sparse_complex_multiply (v1, cv);
+}  
+
+DEFBINOP (n_s_mul,  scalar, complex_sparse) {
+  CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_sparse&);
+  Complex cv( v1.double_value(), 0 );
+  return complex_sparse_complex_multiply (v2, cv);
+}  
+
+DEFBINOP (s_n_div, complex_sparse, scalar) {
+  CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_scalar&);
+  Complex cv ( v2.double_value (), 0);
+  if (cv == Complex(0,0) ) gripe_divide_by_zero ();
+  return complex_sparse_complex_multiply (v1, 1.0 / cv );
+}  
+
+DEFBINOP (n_s_ldiv, scalar, complex_sparse) {
+  CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_sparse&);
+  Complex cv ( v1.double_value (), 0);
+  if (cv == Complex(0,0) ) gripe_divide_by_zero ();
+  return complex_sparse_complex_multiply (v2, 1.0 / cv );
+}  
+
+//
+// complex_sparse by complex operations
+//
+
+DEFBINOP (s_c_mul, complex_sparse, complex) {
+  CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_complex&);
+  return complex_sparse_complex_multiply (v1, v2);
+}  
+
+DEFBINOP (c_s_mul, complex, complex_sparse) {
+  CAST_BINOP_ARGS (const octave_complex&, const octave_complex_sparse&);
+  return complex_sparse_complex_multiply (v2, v1);
+}  
+
+DEFBINOP (s_c_div, complex_sparse, complex) {
+  CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_complex&);
+  Complex cv= v2.complex_value();
+  if (cv == Complex(0,0) ) gripe_divide_by_zero ();
+  return complex_sparse_complex_multiply (v1, 1.0 / cv );
+}  
+
+DEFBINOP (c_s_ldiv, complex, complex_sparse) {
+  CAST_BINOP_ARGS (const octave_complex&, const octave_complex_sparse&);
+  Complex cv= v1.complex_value();
+  if (cv == Complex(0,0) ) gripe_divide_by_zero ();
+  return complex_sparse_complex_multiply (v2, 1.0 / cv );
+}  
+
+//
+// sparse by matrix  operations
+//
+
+DEFBINOP( cs_cs_add, sparse, sparse)
+{
+   DEBUGMSG("complex_sparse - cs_cs_add");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_complex_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( Complex, + , 1 )
+   return new octave_complex_sparse ( X );
+}
+
+DEFBINOP( cs_s_add, complex_sparse, sparse)
+{   
+   DEBUGMSG("complex_sparse - cs_s_add");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( Complex, + , 1 )
+   return new octave_complex_sparse ( X );
+}   
+
+DEFBINOP( s_cs_add, sparse, complex_sparse)
+{   
+   DEBUGMSG("complex_sparse - s_cs_add");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_complex_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( Complex, + , 1 )
+   return new octave_complex_sparse ( X );
+}   
+
+DEFBINOP( cs_cs_sub, sparse, sparse)
+{
+   DEBUGMSG("complex_sparse - cs_cs_sub");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_complex_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( Complex, - , 1 )
+   return new octave_complex_sparse ( X );
+}
+
+DEFBINOP( cs_s_sub, complex_sparse, sparse)
+{   
+   DEBUGMSG("complex_sparse - cs_s_sub");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( Complex, - , 1 )
+   return new octave_complex_sparse ( X );
+}   
+
+DEFBINOP( s_cs_sub, sparse, complex_sparse)
+{   
+   DEBUGMSG("complex_sparse - s_cs_sub");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_complex_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( Complex, - , 1 )
+   return new octave_complex_sparse ( X );
+}   
+
+// only implement comparison operator !=
+DEFBINOP( cs_cs_ne, sparse, sparse)
+{
+   DEBUGMSG("complex_sparse - cs_cs_ne");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_complex_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( Complex, != , 1 )
+   return new octave_complex_sparse ( X );
+}
+
+DEFBINOP( cs_s_ne, complex_sparse, sparse)
+{   
+   DEBUGMSG("complex_sparse - cs_s_ne");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( Complex, != , 1 )
+   return new octave_complex_sparse ( X );
+}   
+
+DEFBINOP( s_cs_ne, sparse, complex_sparse)
+{   
+   DEBUGMSG("complex_sparse - s_cs_ne");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_complex_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( Complex, != , 1 )
+   return new octave_complex_sparse ( X );
+}   
+
+//
+// Element multiply sparse by sparse, return a sparse matrix
+//
+DEFBINOP( cs_cs_el_mul, complex_sparse, complex_sparse)
+{
+   DEBUGMSG("sparse - cs_cs_el_mul");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_complex_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( B )
+   int nnz = MIN( NCFA->nnz , NCFB->nnz );
+   SPARSE_EL_OP ( Complex,  * , 0 )
+   return new octave_complex_sparse ( X );
+}
+
+DEFBINOP( cs_s_el_mul, complex_sparse, sparse)
+{
+   DEBUGMSG("sparse - cs_s_el_mul");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   int nnz = MIN( NCFA->nnz , NCFB->nnz );
+   SPARSE_EL_OP ( Complex,  * , 0 )
+   return new octave_complex_sparse ( X );
+}
+
+DEFBINOP( s_cs_el_mul, sparse, complex_sparse)
+{
+   DEBUGMSG("sparse - s_cs_el_mul");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_complex_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( B )
+   int nnz = MIN( NCFA->nnz , NCFB->nnz );
+   SPARSE_EL_OP ( Complex,  * , 0 )
+   return new octave_complex_sparse ( X );
+}
+
+//
+// Element multiply sparse by full, return a sparse matrix
+//
+
+DEFBINOP( cf_cs_el_mul, complex_matrix, complex_sparse )
+{
+   DEBUGMSG("sparse - cf_cs_el_mul");
+   CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_sparse&);
+   SuperMatrix  A= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   const ComplexMatrix B= v1.complex_matrix_value(); int Bnr= B.rows(); int Bnc= B.cols();
+   int nnz= NCFA->nnz;
+   SPARSE_MATRIX_EL_OP( Complex , * )
+   return new octave_complex_sparse ( X );
+}   
+
+DEFBINOP( cf_s_el_mul, complex_matrix, sparse )
+{
+   DEBUGMSG("sparse - cf_s_el_mul");
+   CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_sparse&);
+   SuperMatrix  A= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   const ComplexMatrix B= v1.complex_matrix_value(); int Bnr= B.rows(); int Bnc= B.cols();
+   int nnz= NCFA->nnz;
+   SPARSE_MATRIX_EL_OP( Complex , * )
+   return new octave_complex_sparse ( X );
+}   
+
+DEFBINOP( f_cs_el_mul, matrix, complex_sparse )
+{
+   DEBUGMSG("sparse - f_cs_el_mul");
+   CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_sparse&);
+   SuperMatrix  A= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   const Matrix B= v1.matrix_value(); int Bnr= B.rows(); int Bnc= B.cols();
+   int nnz= NCFA->nnz;
+   SPARSE_MATRIX_EL_OP( Complex , * )
+   return new octave_complex_sparse ( X );
+}   
+
+DEFBINOP( cs_cf_el_mul, complex_sparse, complex_matrix)
+{
+   DEBUGMSG("sparse - cs_cf_el_mul");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_complex_matrix&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   const ComplexMatrix B= v2.complex_matrix_value(); int Bnr= B.rows(); int Bnc= B.cols();
+   int nnz= NCFA->nnz;
+   SPARSE_MATRIX_EL_OP( Complex , * )
+   return new octave_complex_sparse ( X );
+}   
+
+DEFBINOP( s_cf_el_mul, sparse, complex_matrix)
+{
+   DEBUGMSG("sparse - s_cf_el_mul");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_complex_matrix&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   const ComplexMatrix B= v2.complex_matrix_value(); int Bnr= B.rows(); int Bnc= B.cols();
+   int nnz= NCFA->nnz;
+   SPARSE_MATRIX_EL_OP( Complex , * )
+   return new octave_complex_sparse ( X );
+}   
+
+DEFBINOP( cs_f_el_mul, complex_sparse, matrix)
+{
+   DEBUGMSG("sparse - cs_f_el_mul");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_matrix&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   const Matrix B= v2.matrix_value(); int Bnr= B.rows(); int Bnc= B.cols();
+   int nnz= NCFA->nnz;
+   SPARSE_MATRIX_EL_OP( Complex , * )
+   return new octave_complex_sparse ( X );
+}   
+
+DEFBINOP( cs_cf_mul, complex_sparse, complex_matrix)
+{
+   DEBUGMSG("sparse - cs_cf_mul");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_complex_matrix&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   const ComplexMatrix B= v2.complex_matrix_value(); int Bnr= B.rows(); int Bnc= B.cols();
+   SPARSE_MATRIX_MUL( ComplexMatrix, Complex )
+   return X;
+}   
+
+DEFBINOP( cs_f_mul, complex_sparse, matrix)
+{
+   DEBUGMSG("sparse - cs_f_mul");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_matrix&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   const Matrix B= v2.matrix_value(); int Bnr= B.rows(); int Bnc= B.cols();
+   SPARSE_MATRIX_MUL( ComplexMatrix, Complex )
+   return X;
+}   
+
+DEFBINOP( s_cf_mul, sparse, complex_matrix)
+{
+   DEBUGMSG("sparse - s_cf_mul");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_complex_matrix&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   const ComplexMatrix B= v2.complex_matrix_value(); int Bnr= B.rows(); int Bnc= B.cols();
+   SPARSE_MATRIX_MUL( ComplexMatrix, Complex )
+   return X;
+}   
+
+DEFBINOP( cf_cs_mul, complex_matrix, complex_sparse)
+{
+   DEBUGMSG("sparse - cf_cs_mul");
+   CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_sparse&);
+   const ComplexMatrix A= v1.complex_matrix_value(); int Anr= A.rows(); int Anc= A.cols();
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( B )
+   MATRIX_SPARSE_MUL( ComplexMatrix, Complex )
+   return X;
+}   
+
+DEFBINOP( f_cs_mul, matrix, complex_sparse)
+{
+   DEBUGMSG("sparse - f_cs_mul");
+   CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_sparse&);
+   const Matrix A= v1.matrix_value(); int Anr= A.rows(); int Anc= A.cols();
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( B )
+   MATRIX_SPARSE_MUL( ComplexMatrix, Complex )
+   return X;
+}   
+
+DEFBINOP( cf_s_mul, complex_matrix, sparse)
+{
+   DEBUGMSG("sparse - cf_s_mul");
+   CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_sparse&);
+   const ComplexMatrix A= v1.complex_matrix_value(); int Anr= A.rows(); int Anc= A.cols();
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   MATRIX_SPARSE_MUL( ComplexMatrix, Complex )
+   return X;
+}   
+
+DEFBINOP( cs_cs_mul, complex_sparse, complex_sparse)
+{
+   DEBUGMSG("sparse - cs_cs_mul");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_complex_sparse&);
+   SuperMatrix   A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   SuperMatrix   B= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( B )
+   SPARSE_SPARSE_MUL( Complex )
+   return new octave_complex_sparse ( X );
+}
+
+DEFBINOP( s_cs_mul, sparse, complex_sparse)
+{
+   DEBUGMSG("sparse - s_cs_mul");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_complex_sparse&);
+   SuperMatrix   A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   SuperMatrix   B= v2.super_matrix(); DEFINE_SP_POINTERS_CPLX( B )
+   SPARSE_SPARSE_MUL( Complex )
+   return new octave_complex_sparse ( X );
+}
+
+DEFBINOP( cs_s_mul, complex_sparse, sparse)
+{
+   DEBUGMSG("sparse - cs_s_mul");
+   CAST_BINOP_ARGS (const octave_complex_sparse&, const octave_sparse&);
+   SuperMatrix   A= v1.super_matrix(); DEFINE_SP_POINTERS_CPLX( A )
+   SuperMatrix   B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   SPARSE_SPARSE_MUL( Complex )
+   return new octave_complex_sparse ( X );
+}
+
+#if 0
+
+// TODO: This isn't an efficient solution
+//  to take the inverse and multiply,
+//  on the other hand, I can rarely see this being
+//  a useful thing to do anyway
+DEFBINOP( f_s_ldiv, matrix, sparse) {
+   DEBUGMSG("complex_sparse - f_s_ldiv");
+   CAST_BINOP_ARGS ( const octave_matrix&, const octave_complex_sparse&);
+   const Matrix  A= v1.matrix_value();
+   SuperMatrix   B= v2.super_matrix();
+   return f_s_multiply(A.inverse() , B);
+} // f_s_ldiv 
+
+// sparse \ sparse solve
+//
+// Note: there are more efficient implemetations,
+//       but this works 
+//
+// There is a wierd problem here,
+// it should be possible to multiply s=r*v2;
+// but that doesn't work
+//
+DEFBINOP( s_s_ldiv, sparse, sparse) {
+   DEBUGMSG("complex_sparse - s_s_ldiv");
+   CAST_BINOP_ARGS ( const octave_complex_sparse&, const octave_complex_sparse&);
+   SuperMatrix   A= v1.super_matrix();
+   octave_value  B= new octave_complex_sparse( v2.super_matrix() );
+   int n = A.ncol;
+   int perm_c[n];
+   int permc_spec=3;
+   octave_value_list Ai= oct_sparse_inverse( A, perm_c, permc_spec );
+   octave_value retval= Ai(0)*Ai(1)*Ai(2)*Ai(3) * B;
+   
+   return retval;
+} // f_s_ldiv 
+
+#endif
+
+// 
+// Sparse \ Full solve
+// TODO: SuperMatrix provides more functionality into a solvex
+//       routine, but how to we implement this in octave?
+//
+static ComplexMatrix
+do_cs_cf_ldiv( SuperMatrix A, ComplexMatrix M )
+{
+   int Anr= A.nrow;
+   int Anc= A.ncol;
+   int Bnr= M.rows();
+   int Bnc= M.cols();
+   if (Anc != Bnr) {
+      gripe_nonconformant ("operator \\", Anr, Anc, Bnr, Bnc);
+   } else {
+      assert (Anc == Bnr);
+      SuperMatrix L,U,B;
+      doublecomplex * coef= (doublecomplex *) M.fortran_vec();
+   
+      zCreate_Dense_Matrix(&B, Bnr, Bnc, coef, Bnr, DN, _Z, GE);
+      
+      int permc_spec = 3;
+      int perm_c[ Anc ];
+      int perm_r[ Anr ];
+      oct_sparse_do_permc( permc_spec, perm_c, A );
+   
+      int info;
+      zgssv(&A, perm_c, perm_r, &L, &U, &B, &info);
+   
+      if (info !=0 )
+         SP_FATAL_ERR("Factorization problem: dgssv");
+   
+      Destroy_SuperMatrix_Store( &L );
+      Destroy_SuperMatrix_Store( &U );
+   }
+
+   return M;
+}
+
+DEFBINOP( cs_cf_ldiv, complex_sparse, complex_matrix)
+{
+   DEBUGMSG("complex_sparse - cs_cf_ldiv");
+
+   CAST_BINOP_ARGS ( const octave_complex_sparse&, const octave_complex_matrix&);
+   SuperMatrix   A= v1.super_matrix();
+   ComplexMatrix M= v2.complex_matrix_value();
+   return do_cs_cf_ldiv( A, M );
+}   
+
+DEFBINOP( cs_f_ldiv, complex_sparse, matrix)
+{
+   DEBUGMSG("complex_sparse - cs_f_ldiv");
+
+   CAST_BINOP_ARGS ( const octave_complex_sparse&, const octave_matrix&);
+   SuperMatrix   A= v1.super_matrix();
+   ComplexMatrix M= v2.complex_matrix_value();
+   return do_cs_cf_ldiv( A, M );
+}   
+
+SuperMatrix assemble_sparse( int n, int m,
+                             ComplexColumnVector& coefA,
+                             ColumnVector& ridxA,
+                             ColumnVector& cidxA )
+{
+   DEBUGMSG("complex_sparse - assemble_sparse");
+   ASSEMBLE_SPARSE( Complex )
+   return X;
+}      
+
+SuperMatrix oct_matrix_to_sparse(const ComplexMatrix & A) {      
+   DEBUGMSG("complex_sparse - matrix_to_sparse");
+   int Anr= A.rows();
+   int Anc= A.cols();
+   MATRIX_TO_SPARSE( Complex )
+   return X;
+}
+
+void install_complex_sparse_ops() {
+   //
+   // unitary operations
+   //
+   INSTALL_UNOP  (op_transpose, octave_complex_sparse, transpose);
+   INSTALL_UNOP  (op_hermitian, octave_complex_sparse, hermitian);
+   INSTALL_UNOP  (op_uminus,    octave_complex_sparse, uminus);
+
+   //
+   // binary operations: sparse with scalar
+   //
+
+   INSTALL_BINOP (op_mul,      octave_complex_sparse, octave_scalar,         s_n_mul);
+   INSTALL_BINOP (op_mul,      octave_scalar,         octave_complex_sparse, n_s_mul);
+   INSTALL_BINOP (op_el_mul,   octave_complex_sparse, octave_scalar,         s_n_mul);
+   INSTALL_BINOP (op_el_mul,   octave_scalar,         octave_complex_sparse, n_s_mul);
+   INSTALL_BINOP (op_div,      octave_complex_sparse, octave_scalar,         s_n_div);
+   INSTALL_BINOP (op_ldiv,     octave_scalar,         octave_complex_sparse, n_s_ldiv);
+
+   INSTALL_BINOP (op_mul,      octave_complex_sparse, octave_complex,        s_c_mul);
+   INSTALL_BINOP (op_mul,      octave_complex,        octave_complex_sparse, c_s_mul);
+   INSTALL_BINOP (op_el_mul,   octave_complex_sparse, octave_complex,        s_c_mul);
+   INSTALL_BINOP (op_el_mul,   octave_complex,        octave_complex_sparse, c_s_mul);
+   INSTALL_BINOP (op_div,      octave_complex_sparse, octave_complex,        s_c_div);
+   INSTALL_BINOP (op_ldiv,     octave_complex,        octave_complex_sparse, c_s_ldiv);
+
+   //
+   // binary operations: sparse with matrix 
+   //  and sparse with sparse
+   //
+   INSTALL_BINOP (op_ldiv,     octave_complex_sparse, octave_complex_matrix, cs_cf_ldiv);
+   INSTALL_BINOP (op_ldiv,     octave_complex_sparse, octave_matrix,         cs_f_ldiv);
+#if 0   
+   INSTALL_BINOP (op_ldiv,     octave_matrix, octave_complex_sparse, f_s_ldiv);
+   INSTALL_BINOP (op_ldiv,     octave_complex_sparse, octave_complex_sparse, s_s_ldiv);
+#endif   
+   INSTALL_BINOP (op_ne,       octave_complex_sparse, octave_complex_sparse, cs_cs_ne);
+   INSTALL_BINOP (op_ne,       octave_complex_sparse, octave_sparse,         cs_s_ne);
+   INSTALL_BINOP (op_ne,       octave_sparse,         octave_complex_sparse, s_cs_ne);
+
+   INSTALL_BINOP (op_add,      octave_complex_sparse, octave_complex_sparse, cs_cs_add);
+   INSTALL_BINOP (op_add,      octave_complex_sparse, octave_sparse,         cs_s_add);
+   INSTALL_BINOP (op_add,      octave_sparse,         octave_complex_sparse, s_cs_add);
+
+   INSTALL_BINOP (op_sub,      octave_complex_sparse, octave_complex_sparse, cs_cs_sub);
+   INSTALL_BINOP (op_sub,      octave_complex_sparse, octave_sparse,         cs_s_sub);
+   INSTALL_BINOP (op_sub,      octave_sparse,         octave_complex_sparse, s_cs_sub);
+
+   INSTALL_BINOP (op_el_mul,   octave_complex_sparse, octave_complex_sparse, cs_cs_el_mul);
+   INSTALL_BINOP (op_el_mul,   octave_complex_sparse, octave_sparse,         cs_s_el_mul);
+   INSTALL_BINOP (op_el_mul,   octave_sparse,         octave_complex_sparse, s_cs_el_mul);
+
+   INSTALL_BINOP (op_el_mul,   octave_complex_matrix, octave_sparse,         cf_s_el_mul);
+   INSTALL_BINOP (op_el_mul,   octave_complex_matrix, octave_complex_sparse, cf_cs_el_mul);
+   INSTALL_BINOP (op_el_mul,   octave_matrix,         octave_complex_sparse, f_cs_el_mul);
+
+   INSTALL_BINOP (op_el_mul,   octave_complex_sparse, octave_complex_matrix, cs_cf_el_mul);
+   INSTALL_BINOP (op_el_mul,   octave_complex_sparse, octave_matrix,         cs_f_el_mul);
+   INSTALL_BINOP (op_el_mul,   octave_sparse,         octave_complex_matrix, s_cf_el_mul);
+
+   INSTALL_BINOP (op_mul,      octave_complex_sparse, octave_matrix,         cs_f_mul);
+   INSTALL_BINOP (op_mul,      octave_complex_sparse, octave_complex_matrix, cs_cf_mul);
+   INSTALL_BINOP (op_mul,      octave_sparse,         octave_complex_matrix, s_cf_mul);
+
+   INSTALL_BINOP (op_mul,      octave_complex_matrix, octave_complex_sparse, cf_cs_mul);
+   INSTALL_BINOP (op_mul,      octave_complex_matrix, octave_sparse,         cf_s_mul);
+   INSTALL_BINOP (op_mul,      octave_matrix,         octave_complex_sparse, f_cs_mul);
+
+   INSTALL_BINOP (op_mul,      octave_complex_sparse, octave_complex_sparse, cs_cs_mul);
+   INSTALL_BINOP (op_mul,      octave_complex_sparse, octave_sparse,         cs_s_mul);
+   INSTALL_BINOP (op_mul,      octave_sparse,         octave_complex_sparse, s_cs_mul);
+}
+
+/*
+ * $Log$
+ * Revision 1.1  2001/10/10 19:54:49  pkienzle
+ * Initial revision
+ *
+ * Revision 1.6  2001/04/04 02:13:46  aadler
+ * complete complex_sparse, templates, fix memory leaks
+ *
+ * Revision 1.5  2001/03/30 04:36:30  aadler
+ * added multiply, solve, and sparse creation
+ *
+ * Revision 1.4  2001/03/27 03:45:20  aadler
+ * use templates for mul, add, sub, el_mul operations
+ *
+ * Revision 1.3  2001/03/15 15:47:58  aadler
+ * cleaned up duplicated code by using "defined" templates.
+ * used default numerical conversions
+ *
+ * Revision 1.2  2001/03/06 03:20:12  aadler
+ * added automatic numeric_conversion_function
+ *
+ * Revision 1.1  2001/02/27 03:01:51  aadler
+ * added rudimentary complex matrix support
+ *
+ * Revision 1.1  2000/12/18 03:31:16  aadler
+ * Split code to multiple files
+ * added sparse inverse
+ *
+ */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/fem_test.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,208 @@
+% Sparse function test routing
+% Copyright (C) 1998 Andy Adler.
+% This code has no warranty whatsoever.
+% You may do what you like with this code as long as you leave this copyright
+% in place.  If you modify the code then include a notice saying so.
+%
+% This code comes from my thesis work. Its a finite element model
+%  of the voltage distribution in a cylindrical body with current applied
+%  at the boundary. The complete model was published in
+%  "Electrical Impedance Tomography: Regularized Imaging and Contrast
+%   Detection", A.Adler, R.Guardo, IEEE Trans Med Img, 15(2),170-179
+%
+% $Id$
+
+% octave commands, but OK in matlab too   
+   do_fortran_indexing= 1;
+   empty_list_elements_ok = 1;
+
+TESTTIMES= 5;
+dotheplot=0;
+
+%increase N by multiples of 4 to do a larger test
+    N=  8;
+%increase niveaux to do a larger test
+    niveaux= [-.2:.1:.2]' ;
+
+    pos_i= [0 1];
+    elec=16;
+    ELEM=[];
+    NODE= [0;0];
+    int=1;
+    for k=1:N
+      phi= (0:4*k-1)*pi/2/k;
+      NODE= [NODE k/N*[sin(phi);cos(phi)]];
+
+      ext= 2*(k*k-k+1);
+      idxe=[0:k-1; 1:k];
+      idxi=[0:k-1]; 
+      elem= [ ext+idxe ext+2*k+[-idxe idxe] ext+rem(4*k-idxe,4*k) ...
+              ext+idxe ext+2*k+[-idxe idxe] ext+rem(4*k-idxe,4*k);
+              int+idxi int+2*(k-1)+[-idxi idxi] ... 
+                          int+rem(4*(k-1)-idxi, 4*(k-1)+(k==1) ) ...
+              ext+4*k+1+idxi ext+6*k+[1-idxi 3+idxi] ext+8*k+3-idxi ];
+      for j=1:k
+        r1= rem(j+k-1,3)+1;
+        r2= rem(j+k,3)+1;
+        r3= 6-r1-r2;
+        elem([r1 r2 r3],j+k*(0:7) )= elem(:,j+k*(0:7));
+      end
+  
+      ELEM=[ ELEM elem(:,1:(8-4*(k==N))*k) ];
+      int=ext;
+    end %for k=1:N
+  
+    MES= ext+N*4/elec*([0:elec-1]);
+ 
+  j=pos_i(1); k=floor(j);
+  MES=[MES( 1+rem( (0:elec-1)+k,elec) )+floor(MES(1:2)*[-1;1]*(j-k));
+       MES( 1+rem( (1:elec)+k,elec) )+floor(MES(1:2)*[-1;1]*(j-k)) ];
+
+  cour= [ MES(1,:)' MES(1,1+rem(elec+(0:elec-1)+pos_i*[-1;1],elec) )'; 
+           ones(elec,1)*[-1 1] ];
+
+  QQCirC= [zeros(ext-1,1);cos(2*pi*(0:4/N:elec-.01)'/elec)];
+  QQCirC= 2*QQCirC/sum(abs(QQCirC));
+  if exist('niveaux')
+    QQCirC= QQCirC*([-1 1]*niveaux([1 length(niveaux)]))/length(niveaux);
+  end
+  volt= [1; zeros(elec,1)];
+
+  ELS=rem(rem(0:elec^2-1,elec)-floor((0:elec^2-1)/elec)+elec,elec)';
+  ELS=~any(rem( elec+[-1 0 [-1 0]+pos_i*[-1;1] ] ,elec)' ...
+		     *ones(1,elec^2)==ones(4,1)*ELS')';
+
+
+d= size(ELEM,1);       %dimentions+1
+n= size(NODE,2);        %NODEs
+e= size(ELEM,2);        %ELEMents     
+
+if dotheplot
+% octave commands, we use eval so it doesn't fail in Matlab
+   eval('gset nokey;','1');
+   fleche= [1.02 0;1.06 .05;1.06 .02;1.1 .02; ...
+	  1.1 -.02; 1.06 -.02;1.06 -.05;1.02 0];
+   jjj= .95;
+   if ~isempty(MES)
+     xy=NODE(:,MES(1,:));
+   end
+   xxx=zeros(3,e); xxx(:)=NODE(1,ELEM(:));
+   xxx= jjj*xxx+ (1-jjj)*ones(3,1)*mean(xxx);
+   yyy=zeros(3,e); yyy(:)=NODE(2,ELEM(:));
+   yyy= jjj*yyy+ (1-jjj)*ones(3,1)*mean(yyy);
+   plot([xxx;xxx(1,:)],[yyy;yyy(1,:)],'b', ...
+           fleche*xy,fleche*[0 1;-1 0]*xy,'r');
+   
+   axis([ [-1.1 1.1]*max(NODE(1,:)) [-1.1 1.1]*max(NODE(2,:)) ])
+end % plot mesh
+if exist('niveaux')
+  node=NODE;
+  elem= [ELEM([1 1 2 3 ],:) ...
+         ELEM([2 1 2 3],:) ELEM([3 2 1 3],:)]; 
+  NODE= [node; niveaux(1)*ones(1,n) ];
+  ELEM= [];
+ 
+  for k=2:length(niveaux);
+    NODE=[NODE ,[node; niveaux(k)*ones(1,n)] ];
+    ELEM= [ELEM,(elem + ...
+       [[(k-1)*n*ones(1,e);(k-2)*n*ones(3,e)] ...
+        [(k-1)*n*ones(2,e);(k-2)*n*ones(2,e)] ...  
+        [(k-1)*n*ones(3,e);(k-2)*n*ones(1,e)]] ) ];
+  end %for k
+
+  MES= MES + floor(length(niveaux)/2)*n;
+  QQCirC= QQCirC*ones(1, length(niveaux)); QQCirC= QQCirC(:);
+  cour(1:elec,:)= cour(1:elec,:)+ floor(length(niveaux)/2)*n;
+
+end %if exist('niveaux')
+
+d= size(ELEM,1);       %dimentions+1
+n= size(NODE,2);        %NODEs
+e= size(ELEM,2);        %ELEMents     
+p= size(volt,1)-1;
+
+CC= sparse((1:d*e),ELEM(:),ones(d*e,1), d*e, n);
+
+sa= zeros(d*e,d);
+for j=1:e
+  a=  inv([ ones(d,1) NODE( :, ELEM(:,j) )' ]);
+  sa(d*(j-1)+1:d*j,:)= a(2:d,:)'*a(2:d,:)/(d-1)/(d-2)/abs(det(a));
+end %for j=1:ELEMs 
+ridx= ones(d,1)*(1:e)*d;
+ridx= ridx(:)*ones(1,d) + ones(d*e,1)*[-d+1:0];
+cidx= 1:d*e;
+SS= sparse( cidx'*ones(1,d), ridx, sa, d*e, d*e);
+
+QQ=sparse(cour(1:p,:),(1:p)'*ones(1,size(cour,2)), ...
+                     cour(p+1:2*p,:),n,p );
+
+
+if  0 %OCTAVE
+# this code uses the first syntax for
+# octave sparse
+   CCt=       spfun(CC,'trans');
+   CCtSS=     spfun(CCt,'mul',SS);
+   ZZ=        spfun(CCtSS,'mul',CC);
+   ZZs=       spfun(ZZ,'extract',2,n,2,n);
+   QF=        full(spfun(QQ,'extract',2,n,1,p));
+   fprintf('Solving Finite Element sparse eqn, n=%d nnz=%d density=%f\n', ...
+            n, nnz(ZZ), nnz(ZZ)/n^2 );
+   t0= clock;
+   for i=1:TESTTIMES
+      VV=        spfun(ZZs,'solve',QF,2);
+   end
+   tasktime= etime(clock,t0);
+else
+   ZZ=        CC'*SS*CC;
+   ZZs=       ZZ(2:n,2:n);
+   QF=        full(QQ(2:n,:));
+%  QF=        (QQ(2:n,:));
+   fprintf('Solving Finite Element sparse eqn, n=%d nnz=%d density=%f\n', ...
+            n, nnz(ZZ), nnz(ZZ)/n^2 );
+   t0= clock;
+   for i=1:TESTTIMES
+      VV=        ZZs\QF;
+   end
+   tasktime= etime(clock,t0);
+end
+
+
+checkval= full( VV(MES(1,:),1)-VV(MES(2,:),1) );
+goldvalue= [ -0.918243;  0.555779;  0.148452;  0.078826;
+              0.052132;  0.040116;  0.034141;  0.031872;
+              0.031279;  0.033594;  0.039429;  0.052189;
+              0.078377;  0.149426;  0.596195; -1.003565];
+              
+rdif= sqrt(mean((checkval-goldvalue).^2)) / sqrt(mean(checkval.^2));
+if rdif > 1e-5
+   fprintf('Sparse FEM solution fails');
+end
+fprintf('Time per iteration= %f s\n', tasktime/ TESTTIMES);
+fprintf('Your machine is %f faster than a 486dx100!\n',  ...
+         4.45*TESTTIMES/tasktime );
+
+#ZZt=ZZ'; tt=time; for i = 1:100; x= ZZ*ZZt; end ; (time-tt)/100
+%  ans = 0.039929 % 0.52245
+
+% 
+% Results:
+%    11 Nov 00: Your machine is 16.501822 faster than a 486dx100!
+%
+% $Log$
+% Revision 1.1  2001/10/10 19:54:49  pkienzle
+% Initial revision
+%
+% Revision 1.4  2001/04/04 02:13:46  aadler
+% complete complex_sparse, templates, fix memory leaks
+%
+% Revision 1.3  2001/03/30 04:36:30  aadler
+% added multiply, solve, and sparse creation
+%
+% Revision 1.2  2000/12/18 03:31:16  aadler
+% Split code to multiple files
+% added sparse inverse
+%
+% Revision 1.1  2000/11/11 02:47:11  aadler
+% DLD functions for sparse support in octave
+%
+%
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/make_sparse.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,275 @@
+/*
+Sparse matrix functionality for octave, based on the SuperLU package  
+Copyright (C) 1998-2000 Andy Adler
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Octave; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+$Id$
+
+*/
+
+#define  SPARSE_COMPLEX_CODE
+#include "make_sparse.h"
+//
+//   These functions override those in SuperLU/SRC/util.c
+//
+
+void *
+oct_sparse_malloc(int size) {
+#if 1   
+   return malloc(size);
+#else
+   void * vp= malloc( size );
+   printf ("allocated %04X : %d\n", (int) vp, size);
+   return vp;
+#endif   
+}  
+
+void
+oct_sparse_fatalerr(char *msg) {
+   SP_FATAL_ERR( msg );
+}  
+
+void
+oct_sparse_free(void * addr) {
+#if 1
+   if (addr) free( addr );
+#else   
+   DEBUGMSG("sparse - oct_sparse_free");
+   printf ("freeing %04X\n", (int) addr );
+   free( addr );
+#endif   
+}  
+
+
+//
+// Utility methods for sparse ops
+//
+
+void
+oct_sparse_expand_bounds( int lim, int& bound,
+                          int*& idx,
+                          void*& coef, int varsize)
+{   
+   const int mem_expand = 2;
+
+   DEBUGMSG("growing bounds"); 
+   bound*= mem_expand;
+   int *   t_idx = (int  *) malloc((bound) * sizeof(int)); 
+   void * t_coef = (void *) malloc((bound) * varsize    ); 
+   if ((t_idx==NULL) || (t_coef == NULL) ) 
+      SP_FATAL_ERR("memory error in check_bounds");
+ 
+   memcpy( t_idx , idx , lim*sizeof(int) );
+   memcpy( t_coef, coef, lim*varsize     );
+
+   free( idx);
+   idx= t_idx;
+   free( coef);
+   coef= t_coef;
+}      
+
+
+void
+oct_sparse_maybe_shrink( int lim, int bound,
+                         int*& idx,
+                         void*& coef, int varsize) {
+   if ( (lim < bound) && (lim > 0) ) {
+      idx = (int    *) realloc( idx,  lim*sizeof(int) );
+      coef= (void   *) realloc( coef, lim*varsize );
+      assert (idx != NULL);
+      assert (coef != NULL);
+   }
+   else if (lim==0) {      
+      free( idx ); idx= NULL;
+      free( coef); coef=NULL;
+   }
+}   
+
+void
+oct_sparse_Destroy_SuperMatrix( SuperMatrix X) {
+   switch( X.Stype ) { 
+      case NC:  Destroy_CompCol_Matrix(&X);   break;
+      case DN:  Destroy_Dense_Matrix(&X);     break;
+      case SC:  Destroy_SuperNode_Matrix(&X); break;
+      case NCP: Destroy_CompCol_Permuted(&X); break;
+      default:  SP_FATAL_ERR("Bad SuperMatrix Free"); 
+   }
+}
+
+#ifdef ANDYS_SEGFAULT_OVERRIDE
+#include <signal.h>
+#endif
+
+DEFUN_DLD (sparse, args, ,
+  "sparse_val = sparse (...)\n\
+SPARSE: create a sparse matrix\n\
+\n\
+sparse can be called in the following ways:\n\
+\n\
+1: S = sparse(A), where 'A' is a full matrix\n\
+\n\
+2: S = sparse(i,j,s,m,n,nzmax), where\n\
+        i,j   are integer index vectors (1 x nnz)\n\
+        s     is the vector of real or complex entries (1 x nnz)\n\
+        m,n   are the scalar dimentions of S\n\
+        nzmax is ignored (for compatability with Matlab)\n\
+\n\
+3: S = sparse(i,j,s,m,n),     same as (2) above\n\
+\n\
+4: S=  sparse(i,j,s),         uses m=max(i), n=max(j)\n\
+\n\
+5: S=  sparse(m,n),           does sparse([],[],[],m,n,0)\n\
+\n\
+s, and i or j may be scalars, in which case they are expanded\n\
+so they all have the same length ")
+{
+#ifdef ANDYS_SEGFAULT_OVERRIDE
+signal( SIGSEGV, SIG_DFL );
+#endif
+   
+   static bool sparse_type_loaded         = false;
+   static bool complex_sparse_type_loaded = false;
+
+   octave_value retval;
+
+   int nargin= args.length();
+   if (nargin < 1) {
+      print_usage ("sparse");
+      return retval;
+   }
+
+// note: sparse_type needs to be loaded in all cases,
+// because complex_sparse * sparse operations need to be defined
+   if (! sparse_type_loaded) {
+      octave_sparse::register_type ();
+
+#ifdef VERBOSE
+      cout << "installing sparse type at type-id = "
+           << octave_sparse::static_type_id () << "\n";
+#endif          
+      install_sparse_ops() ;
+      sparse_type_loaded= true;
+   }
+
+   bool use_complex = false;
+   if (nargin > 2)
+      use_complex= args(2).is_complex_type();
+   else
+      use_complex= args(0).is_complex_type();
+
+
+   if (use_complex) {
+      if (! complex_sparse_type_loaded) {
+         octave_complex_sparse::register_type ();
+
+#ifdef VERBOSE
+         cout << "installing complex sparse type at type-id = "
+              << octave_complex_sparse::static_type_id () << "\n";
+#endif          
+         install_complex_sparse_ops() ;
+         complex_sparse_type_loaded= true;
+
+         assert( 0==complex_sparse_verify_doublecomplex_type() );
+      }
+   }
+
+   if (nargin == 1) {
+      if (use_complex) {
+         ComplexMatrix A = args(0).complex_matrix_value ();
+         SuperMatrix sm= oct_matrix_to_sparse( A ) ;
+         retval = new octave_complex_sparse ( sm );
+      } else {
+         Matrix A = args(0).matrix_value ();
+         SuperMatrix sm= oct_matrix_to_sparse( A ) ;
+         retval = new octave_sparse ( sm );
+      }
+   }
+   else {
+      int m=0,n=0;
+      ColumnVector coefA, ridxA, cidxA;
+      ComplexColumnVector coefAC;
+
+      if (nargin == 2) {
+         m= (int) args(0).double_value();
+         n= (int) args(1).double_value();
+         cidxA = ColumnVector ();
+         ridxA = ColumnVector ();
+         coefA = ColumnVector ();
+      }
+      else {
+// 
+//  I use this clumsy construction so that we can use
+//  any orientation of args
+//
+         { ColumnVector x( args(0).vector_value() ); ridxA= x; }
+         { ColumnVector x( args(1).vector_value() ); cidxA= x; }
+         if (use_complex) 
+            { ComplexColumnVector x( args(2).complex_vector_value() ); coefAC= x; }
+         else
+            { ColumnVector x( args(2).vector_value() ); coefA= x; }
+
+         if (nargin == 3) {
+            m= (int) ridxA.max();
+            n= (int) cidxA.max();
+         } else {
+            m= (int) args(3).double_value();
+            n= (int) args(4).double_value();
+         }
+      }
+
+      if (use_complex) 
+         retval = new octave_complex_sparse (
+               assemble_sparse( n, m, coefAC, ridxA, cidxA ) );
+      else
+         retval = new octave_sparse (
+               assemble_sparse( n, m, coefA, ridxA, cidxA ) );
+   }
+
+   return retval;
+}
+
+
+DEFINE_OCTAVE_ALLOCATOR (octave_sparse);
+
+DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_sparse, "sparse");
+
+DEFINE_OCTAVE_ALLOCATOR (octave_complex_sparse);
+
+DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_complex_sparse, "complex_sparse");
+/*
+ * $Log$
+ * Revision 1.1  2001/10/10 19:54:49  pkienzle
+ * Initial revision
+ *
+ * Revision 1.6  2001/04/04 02:13:46  aadler
+ * complete complex_sparse, templates, fix memory leaks
+ *
+ * Revision 1.5  2001/03/30 04:36:30  aadler
+ * added multiply, solve, and sparse creation
+ *
+ * Revision 1.4  2001/03/15 15:47:58  aadler
+ * cleaned up duplicated code by using "defined" templates.
+ * used default numerical conversions
+ *
+ * Revision 1.3  2001/02/27 03:01:52  aadler
+ * added rudimentary complex matrix support
+ *
+ * Revision 1.2  2000/12/18 03:31:16  aadler
+ * Split code to multiple files
+ * added sparse inverse
+ *
+ */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/make_sparse.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,391 @@
+/*
+
+Copyright (C) 1999 Andy Adler
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Octave; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+$Id$
+
+$Log$
+Revision 1.1  2001/10/10 19:54:49  pkienzle
+Initial revision
+
+Revision 1.9  2001/04/04 02:13:46  aadler
+complete complex_sparse, templates, fix memory leaks
+
+Revision 1.8  2001/03/30 04:36:30  aadler
+added multiply, solve, and sparse creation
+
+Revision 1.7  2001/03/27 03:45:20  aadler
+use templates for mul, add, sub, el_mul operations
+
+Revision 1.6  2001/03/15 15:47:58  aadler
+cleaned up duplicated code by using "defined" templates.
+used default numerical conversions
+
+Revision 1.5  2001/03/06 03:20:12  aadler
+added automatic numeric_conversion_function
+
+Revision 1.4  2001/02/27 03:01:52  aadler
+added rudimentary complex matrix support
+
+Revision 1.3  2000/12/30 03:22:58  aadler
+added fatal error handling
+Thanks to Paul Kienzle for his suggestions
+
+Revision 1.2  2000/12/18 03:31:16  aadler
+Split code to multiple files
+added sparse inverse
+
+Revision 1.1  2000/11/11 02:47:11  aadler
+DLD functions for sparse support in octave
+
+*/
+
+#ifdef VERBOSE
+#  define DEBUGMSG(x) printf("DEBUG:" x "\n")
+#else
+#  define DEBUGMSG(x) 
+#endif
+
+// Thanks to To: Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+// for help with error handling 
+#define SP_FATAL_ERR(str) { error("sparse: %s", str);  \
+                            jump_to_top_level ();  \
+                            panic_impossible (); }
+
+#include <octave/config.h>
+
+#include <cstdlib>
+
+#include <string>
+
+class ostream;
+
+#include <octave/lo-utils.h>
+#include <octave/mx-base.h>
+#include <octave/str-vec.h>
+
+#include <octave/defun-dld.h>
+#include <octave/error.h>
+#include <octave/gripes.h>
+#include <octave/lo-mappers.h>
+#include <octave/oct-obj.h>
+#include <octave/ops.h>
+#include <octave/ov-base.h>
+#include <octave/ov-typeinfo.h>
+#include <octave/ov.h>
+#include <octave/ov-scalar.h>
+#include <octave/ov-complex.h>
+#include <octave/ov-re-mat.h>
+#include <octave/ov-cx-mat.h>
+#include <octave/pager.h>
+#include <octave/pr-output.h>
+#include <octave/symtab.h>
+#include <octave/variables.h>
+
+#include <octave/utils.h>
+
+// this is a pain, but the
+// complex and double definitions don't work together
+#if    defined( SPARSE_DOUBLE_CODE )
+#  include "dsp_defs.h"
+#elif  defined( SPARSE_COMPLEX_CODE )
+#  include "zsp_defs.h"
+#else
+#  include "supermatrix.h"
+#endif                            
+
+class Octave_map;
+class octave_value_list;
+
+class tree_walker;
+
+//
+// complex sparse class definition
+//
+class
+octave_complex_sparse : public octave_base_value
+{
+public:
+
+   octave_complex_sparse (SuperMatrix A );
+  ~octave_complex_sparse (void);
+   octave_complex_sparse (const octave_complex_sparse& S);
+
+   octave_value *clone (void) ;
+   octave_complex_sparse sparse_value (bool = false) const ;
+   SuperMatrix   super_matrix (bool = false) const ;
+
+   int rows    (void) const ;
+   int columns (void) const ;
+   int nnz     (void) const ;
+
+   bool is_defined (void) const ;
+   bool is_real_scalar (void) const ;
+
+   octave_value any (void) const ;
+   octave_value all (void) const ;
+
+   bool is_real_type (void) const;
+   bool is_scalar_type (void) const;
+   bool is_numeric_type (void) const;
+   bool valid_as_scalar_index (void) const;
+   bool valid_as_zero_index (void) const;
+   bool is_true (void) const;
+
+   ComplexMatrix complex_matrix_value (bool = false) const;
+   octave_value uminus (void) const ;
+   octave_value hermitian (void) const ;
+   octave_value transpose (void) const ;
+
+#if 0
+   octave_value extract (int r1, int c1, int r2, int c2) const ;
+   octave_value_list do_multi_index_op (int, const octave_value_list& idx);
+
+   
+#endif
+   void print (ostream& os, bool pr_as_read_syntax = false) const ;
+
+   type_conv_fcn numeric_conversion_function (void) const;
+
+private:
+   SuperMatrix X ;
+
+   DECLARE_OCTAVE_ALLOCATOR
+   DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA
+
+}; // class octave_complex_sparse
+
+//
+// sparse class definition
+//
+class
+octave_sparse : public octave_base_value
+{
+public:
+
+   octave_sparse (SuperMatrix A );
+  ~octave_sparse (void);
+   octave_sparse (const octave_sparse& S);
+
+   octave_value *clone (void) ;
+   octave_sparse sparse_value (bool = false) const ;
+   SuperMatrix   super_matrix (bool = false) const ;
+
+   octave_complex_sparse complex_sparse_value (bool = false) const;
+
+   int rows    (void) const ;
+   int columns (void) const ;
+   int nnz     (void) const ;
+
+   bool is_defined (void) const ;
+   bool is_real_scalar (void) const ;
+
+   octave_value any (void) const ;
+   octave_value all (void) const ;
+
+   bool is_real_type (void) const;
+   bool is_scalar_type (void) const;
+   bool is_numeric_type (void) const;
+   bool valid_as_scalar_index (void) const;
+   bool valid_as_zero_index (void) const;
+   bool is_true (void) const;
+// double double_value (bool = false) const;
+
+   Matrix matrix_value (bool = false) const;
+   octave_value uminus (void) const ;
+   octave_value hermitian (void) const ;
+   octave_value transpose (void) const ;
+
+   octave_value extract (int r1, int c1, int r2, int c2) const ;
+   octave_value_list do_multi_index_op (int, const octave_value_list& idx);
+
+   void print (ostream& os, bool pr_as_read_syntax = false) const ;
+
+   type_conv_fcn numeric_conversion_function (void) const;
+
+private:
+   SuperMatrix X ;
+
+   DECLARE_OCTAVE_ALLOCATOR
+   DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA
+
+}; // class octave_sparse
+
+
+#include "util.h"
+
+
+//
+// these functions override functions in SuperLU
+//  so we need to provide them here
+//
+#ifdef __cplusplus
+extern "C" {
+#endif   
+void *
+oct_sparse_malloc(int size);
+
+void
+oct_sparse_fatalerr(char *msg);
+
+void
+oct_sparse_free(void * addr);
+#ifdef __cplusplus
+} 
+#endif   
+
+void
+oct_sparse_Destroy_SuperMatrix( SuperMatrix X) ;
+
+Matrix
+oct_sparse_to_full ( SuperMatrix X ) ;
+
+SuperMatrix
+oct_sparse_transpose ( SuperMatrix X ) ;
+
+SuperMatrix
+oct_matrix_to_sparse(const Matrix & A) ;
+
+SuperMatrix
+oct_matrix_to_sparse(const ComplexMatrix & A) ;
+
+void
+oct_sparse_do_permc( int permc_spec, int perm_c[], 
+                     SuperMatrix A ) ;
+
+SuperMatrix
+sp_inv_uppertriang( SuperMatrix U);
+
+#if NDEBUG
+#define oct_sparse_verify_supermatrix(X);
+#else
+void
+oct_sparse_verify_supermatrix( SuperMatrix X);
+#endif
+
+
+SuperMatrix assemble_sparse( int n, int m,
+                             ColumnVector& coefA,
+                             ColumnVector& ridxA,
+                             ColumnVector& cidxA ) ;
+
+SuperMatrix assemble_sparse( int n, int m,
+                             ComplexColumnVector& coefA,
+                             ColumnVector& ridxA,
+                             ColumnVector& cidxA ) ;
+
+octave_value_list
+oct_sparse_inverse( SuperMatrix A,
+                    int* perm_c,
+                    int permc_spec) ;
+
+void install_sparse_ops() ;
+void install_complex_sparse_ops() ;
+
+// functions to grow and shrink allocations
+
+void oct_sparse_expand_bounds( int lim, int& bound,
+                               int*& idx,
+                               void*& coef, int varsize);
+
+inline void
+check_bounds( int lim, int& bound, int*& idx, double*& coef)
+{   
+   if (lim==bound) 
+      oct_sparse_expand_bounds( lim, bound, idx,
+                  (void *&) coef, sizeof(double));
+}      
+
+inline void
+check_bounds( int lim, int& bound, int*& idx, Complex*& coef)
+{   
+   if (lim==bound) 
+      oct_sparse_expand_bounds( lim, bound, idx,
+                  (void *&) coef, sizeof(Complex));
+}      
+
+
+void oct_sparse_maybe_shrink( int lim, int bound,
+                              int*& idx,
+                              void*& coef, int varsize ) ;
+
+inline void
+maybe_shrink( int lim, int bound, int*& idx, double*& coef) {
+   oct_sparse_maybe_shrink( lim, bound, idx,
+                            (void *&) coef, sizeof(double));
+}   
+
+inline void
+maybe_shrink( int lim, int bound, int*& idx, Complex*& coef) {
+   oct_sparse_maybe_shrink( lim, bound, idx,
+                            (void *&) coef, sizeof(Complex));
+}   
+
+SuperMatrix
+create_SuperMatrix( int nr, int nc, int nnz,
+                    double * coef,
+                    int * ridx,
+                    int * cidx );
+
+SuperMatrix
+create_SuperMatrix( int nr, int nc, int nnz,
+                    Complex * coef,
+                    int * ridx,
+                    int * cidx );
+
+int
+complex_sparse_verify_doublecomplex_type(void);
+
+
+// comparison function for sort in make_sparse
+typedef struct { unsigned long val;
+                 unsigned long idx; } sort_idxl;   
+
+inline int
+sidxl_comp(const void *i,const void*j )
+{
+   return (((sort_idxl *) i)->val) - (((sort_idxl *) j)->val) ;
+}
+
+// declare pointers from which we will build a SuperMatrix
+#define DECLARE_SP_POINTERS_REAL( A ) DECLARE_SP_POINTERS( A, double )
+#define DECLARE_SP_POINTERS_CPLX( A ) DECLARE_SP_POINTERS( A, Complex )
+
+#define DECLARE_SP_POINTERS( A , type) \
+   type * coef ## A ; \
+   int  * ridx ## A ; \
+   int  * cidx ## A ;
+
+// check that we have a correctly typed NC SuperMatrix,
+// and define pointers to the data members
+#define DEFINE_SP_POINTERS_REAL( A ) DEFINE_SP_POINTERS( A, double, _D )
+#define DEFINE_SP_POINTERS_CPLX( A ) DEFINE_SP_POINTERS( A, Complex , _Z )
+
+#define DEFINE_SP_POINTERS( A, type, Dtypedef ) \
+   assert( (A).Stype == NC); \
+   assert( (A).Dtype == Dtypedef ); \
+   NCformat * NCF ## A= (NCformat *) (A).Store; \
+   type * coef ## A = (type *) NCF ## A->nzval; \
+   int  * ridx ## A =          NCF ## A->rowind; \
+   int  * cidx ## A =          NCF ## A->colptr; \
+   int A ## nr= (A).nrow; \
+   int A ## nc= (A).ncol;
+
+#ifdef USE_DMALLOC
+#include <dmalloc.h>
+#endif 
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/sp_test.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,675 @@
+%!/usr/local/bin/octave -qf 
+% Test script for the build of the octave sparse functions
+%
+% Copyright (C) 1998,1999 Andy Adler
+% 
+%    This program is free software; you can redistribute it and/or
+% modify it under the terms of the GNU General Public License as
+% published by the Free Software Foundation; either version 2 of
+% the License, or (at your option) any later version.
+%    This program is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+% GNU General Public License for more details.
+%    You should have received a copy of the GNU General Public
+% License along with this program; if not, write to the Free Software
+% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+%
+% $Id$
+
+OCTAVE=  exist('__OCTAVE_VERSION__');
+do_fortran_indexing= 1;
+prefer_zero_one_indexing= 0;
+page_screen_output=1;
+SZ=10;
+NTRIES=1.0;
+
+res=zeros(1,200); # should be enough space
+
+for tries = 1:NTRIES;
+
+# print some relevant info from ps
+if 1
+   printf("t=%03d: %s", tries, system(["ps -uh ", num2str(getpid)],1 ) );
+endif
+
+% choose some random sizes for the test matrices   
+   sz=floor(abs(randn(1,5))*SZ + 1);
+   sz1= sz(1); sz2=sz(2); sz3=sz(3); sz4=sz(4); sz5=sz(5);
+   sz12= sz1*sz2;
+   sz23= sz2*sz3;
+
+% choose random test matrices
+   arf=zeros( sz1,sz2 );
+   nz= sz12*rand(1)/2+1;
+   arf(ceil(rand(nz,1)*sz12))=randn(nz,1);
+
+   brf=zeros( sz1,sz2 );
+   nz= sz12*rand(1)/2+1;
+   brf(ceil(rand(nz,1)*sz12))=randn(nz,1);
+
+   crf=zeros( sz2,sz3 );
+   nz= sz23*rand(1)/2+1;
+   crf(ceil(rand(nz,1)*sz23))=randn(nz,1);
+
+   while (1)
+% Choose eye to try to force a non singular a 
+% I wish we could turn off warnings here!
+      drf=eye(sz4) * 1e-4;
+      nz= sz4^2 *rand(1)/2;
+      drf(ceil(rand(nz,1)*sz4^2))=randn(nz,1);
+
+      if abs(det(drf)) >1e-10 ; break ; end
+   end
+   erf= rand(sz4,ceil(rand(1)*4));
+
+% choose a number != 0
+   while (1)
+      frn= randn;
+      if (abs(frn) >=1e-2) break; end
+   end
+
+% complex sparse
+   acf=zeros( sz1,sz2 );
+   nz= sz12*rand(1)/2+1;
+   acf(ceil(rand(nz,1)*sz12))=randn(nz,1) + 1i*randn(nz,1);
+
+   bcf=zeros( sz1,sz2 );
+   nz= sz12*rand(1)/2+1;
+   bcf(ceil(rand(nz,1)*sz12))=randn(nz,1) + 1i*randn(nz,1);
+
+   ccf=zeros( sz2,sz3 );
+   nz= sz23*rand(1)/2+1;
+   ccf(ceil(rand(nz,1)*sz23))=randn(nz,1) + 1i*randn(nz,1);
+
+   while (1)
+% Choose eye to try to force a non singular a 
+% I wish we could turn off warnings here!
+      dcf=eye(sz4) * 1e-4;
+      nz= sz4^2 *rand(1)/2;
+      dcf(ceil(rand(nz,1)*sz4^2))=randn(nz,1) + 1i*randn(nz,1);
+
+      if abs(det(dcf)) >1e-10 ; break ; end
+   end
+   ecf= randn(sz4,sz5) + 1i*randn(sz4,sz5);
+
+   fcn= frn+ 1i*randn;
+
+% generate L and U masks
+   [xx,yy]=meshgrid( 1:sz4, -( 1:sz4) );
+   LL= xx+yy<=0;
+   UU= xx+yy>=0;
+
+% select masks
+   selx= ceil( sz2*rand(1,2*ceil( rand(1)*sz2 )) );
+   sely= ceil( sz1*rand(1,2*ceil( rand(1)*sz1 )) );
+   sel1= ceil(sz12*rand(1,2*ceil( rand(1)*sz12 )))';
+
+
+
+   ars= sparse(arf);
+   brs= sparse(brf);
+   crs= sparse(crf);
+   drs= sparse(drf);
+   ers= sparse(erf);
+
+
+   acs= sparse(acf);
+   bcs= sparse(bcf);
+   ccs= sparse(ccf);
+   dcs= sparse(dcf);
+   ecs= sparse(ecf);
+
+   i=1   ;     % i=  1
+
+%
+% test sparse assembly and disassembly
+%
+   res(i)= res(i)     +all(all( ars == ars ));
+   i=i+1 ;     % i=  2
+   res(i)= res(i)     +all(all( ars == arf ));
+   i=i+1 ;     % i=  3
+   res(i)= res(i)     +all(all( arf == ars ));
+   i=i+1 ;     % i=  4
+   res(i)= res(i)     +all(all( acs == acs ));
+   i=i+1 ;     % i=  5
+   res(i)= res(i)     +all(all( acs == acf ));
+   i=i+1 ;     % i=  6
+   res(i)= res(i)     +all(all( acf == acs ));
+   i=i+1 ;     % i=  7
+
+   [ii,jj,vv,nr,nc] = spfind( ars );
+   res(i)= res(i)     +all(all( arf == full( sparse(ii,jj,vv,nr,nc) ) ));
+   i=i+1 ;     % i=  8
+   [ii,jj,vv,nr,nc] = spfind( acs );
+   res(i)= res(i)     +all(all( acf == full( sparse(ii,jj,vv,nr,nc) ) ));
+   i=i+1 ;     % i=  9
+   res(i)= res(i)     +( nnz(ars) == sum(sum( arf!=0 )) );
+   i=i+1 ;     % i= 10
+   res(i)= res(i)     +   (  nnz(ars) == nnz(arf));  
+   i=i+1 ;     % i= 11
+   res(i)= res(i)     +( nnz(acs) == sum(sum( acf!=0 )) );
+   i=i+1 ;     % i= 12
+   res(i)= res(i)     +   (  nnz(acs) == nnz(acf));  
+   i=i+1 ;     % i= 13
+%    
+% test sparse op scalar operations
+%
+   res(i)= res(i)     +all(all( (ars==frn) == (arf==frn) ));
+   i=i+1 ;     % i= 14
+   res(i)= res(i)     +all(all( (frn==ars) == (frn==arf) ));
+   i=i+1 ;     % i= 15
+   res(i)= res(i)     +all(all( (frn+ars) == (frn+arf) ));
+   i=i+1 ;     % i= 16
+   res(i)= res(i)     +all(all( (ars+frn) == (arf+frn) ));
+   i=i+1 ;     % i= 17
+   res(i)= res(i)     +all(all( (frn-ars) == (frn-arf) ));
+   i=i+1 ;     % i= 18
+   res(i)= res(i)     +all(all( (ars-frn) == (arf-frn) ));
+   i=i+1 ;     % i= 19
+   res(i)= res(i)     +all(all( (frn*ars) == (frn*arf) ));
+   i=i+1 ;     % i= 20
+   res(i)= res(i)     +all(all( (ars*frn) == (arf*frn) ));
+   i=i+1 ;     % i= 21
+   res(i)= res(i)     +all(all( (frn.*ars) == (frn.*arf) ));
+   i=i+1 ;     % i= 22
+   res(i)= res(i)     +all(all( (ars.*frn) == (arf.*frn) ));
+   i=i+1 ;     % i= 23
+   res(i)= res(i)     +all(all( abs( (frn\ars) - (frn\arf) )<1e-13 ));
+   i=i+1 ;     % i= 24
+   res(i)= res(i)     +all(all( abs( (ars/frn) - (arf/frn) )<1e-13 ));
+   i=i+1 ;     % i= 25
+%    
+% test sparse op complex scalar operations
+%
+   res(i)= res(i)     +all(all( (ars==fcn) == (arf==fcn) ));
+   i=i+1 ;     % i= 26
+   res(i)= res(i)     +all(all( (fcn==ars) == (fcn==arf) ));
+   i=i+1 ;     % i= 27
+   res(i)= res(i)     +all(all( (fcn+ars) == (fcn+arf) ));
+   i=i+1 ;     % i= 28
+   res(i)= res(i)     +all(all( (ars+fcn) == (arf+fcn) ));
+   i=i+1 ;     % i= 29
+   res(i)= res(i)     +all(all( (fcn-ars) == (fcn-arf) ));
+   i=i+1 ;     % i= 30
+   res(i)= res(i)     +all(all( (ars-fcn) == (arf-fcn) ));
+   i=i+1 ;     % i= 31
+   res(i)= res(i)     +all(all( (fcn*ars) == (fcn*arf) ));
+   i=i+1 ;     % i= 32
+   res(i)= res(i)     +all(all( (ars*fcn) == (arf*fcn) ));
+   i=i+1 ;     % i= 33
+   res(i)= res(i)     +all(all( (fcn.*ars) == (fcn.*arf) ));
+   i=i+1 ;     % i= 34
+   res(i)= res(i)     +all(all( (ars.*fcn) == (arf.*fcn) ));
+   i=i+1 ;     % i= 35
+   res(i)= res(i)     +all(all( abs( (fcn\ars) - (fcn\arf) )<1e-13 ));
+   i=i+1 ;     % i= 36
+   res(i)= res(i)     +all(all( abs( (ars/fcn) - (arf/fcn) )<1e-13 ));
+   i=i+1 ;     % i= 37
+%    
+% test complex sparse op scalar operations
+%
+   res(i)= res(i)     +all(all( (acs==frn) == (acf==frn) ));
+   i=i+1 ;     % i= 38
+   res(i)= res(i)     +all(all( (frn==acs) == (frn==acf) ));
+   i=i+1 ;     % i= 39
+   res(i)= res(i)     +all(all( (frn+acs) == (frn+acf) ));
+   i=i+1 ;     % i= 40
+   res(i)= res(i)     +all(all( (acs+frn) == (acf+frn) ));
+   i=i+1 ;     % i= 41
+   res(i)= res(i)     +all(all( (frn-acs) == (frn-acf) ));
+   i=i+1 ;     % i= 42
+   res(i)= res(i)     +all(all( (acs-frn) == (acf-frn) ));
+   i=i+1 ;     % i= 43
+   res(i)= res(i)     +all(all( (frn*acs) == (frn*acf) ));
+   i=i+1 ;     % i= 44
+   res(i)= res(i)     +all(all( (acs*frn) == (acf*frn) ));
+   i=i+1 ;     % i= 45
+   res(i)= res(i)     +all(all( (frn.*acs) == (frn.*acf) ));
+   i=i+1 ;     % i= 46
+   res(i)= res(i)     +all(all( (acs.*frn) == (acf.*frn) ));
+   i=i+1 ;     % i= 47
+   res(i)= res(i)     +all(all( abs( (frn\acs) - (frn\acf) )<1e-13 ));
+   i=i+1 ;     % i= 48
+   res(i)= res(i)     +all(all( abs( (acs/frn) - (acf/frn) )<1e-13 ));
+   i=i+1 ;     % i= 49
+%    
+% test complex sparse op complex scalar operations
+%
+   res(i)= res(i)     +all(all( (acs==fcn) == (acf==fcn) ));
+   i=i+1 ;     % i= 50
+   res(i)= res(i)     +all(all( (fcn==acs) == (fcn==acf) ));
+   i=i+1 ;     % i= 51
+   res(i)= res(i)     +all(all( (fcn+acs) == (fcn+acf) ));
+   i=i+1 ;     % i= 52
+   res(i)= res(i)     +all(all( (acs+fcn) == (acf+fcn) ));
+   i=i+1 ;     % i= 53
+   res(i)= res(i)     +all(all( (fcn-acs) == (fcn-acf) ));
+   i=i+1 ;     % i= 54
+   res(i)= res(i)     +all(all( (acs-fcn) == (acf-fcn) ));
+   i=i+1 ;     % i= 55
+   res(i)= res(i)     +all(all( (fcn*acs) == (fcn*acf) ));
+   i=i+1 ;     % i= 56
+   res(i)= res(i)     +all(all( (acs*fcn) == (acf*fcn) ));
+   i=i+1 ;     % i= 57
+   res(i)= res(i)     +all(all( (fcn.*acs) == (fcn.*acf) ));
+   i=i+1 ;     % i= 58
+   res(i)= res(i)     +all(all( (acs.*fcn) == (acf.*fcn) ));
+   i=i+1 ;     % i= 59
+   res(i)= res(i)     +all(all( abs( (fcn\acs) - (fcn\acf) )<1e-13 ));
+   i=i+1 ;     % i= 60
+   res(i)= res(i)     +all(all( abs( (acs/fcn) - (acf/fcn) )<1e-13 ));
+   i=i+1 ;     % i= 61
+
+%
+% sparse uary ops
+%
+   res(i)= res(i)     +all(all( ars.' ==  arf.' ));  
+   i=i+1 ;     % i= 62
+   res(i)= res(i)     +all(all( ars'  ==  arf' ));  
+   i=i+1 ;     % i= 63
+   res(i)= res(i)     +all(all( -ars  == -arf ));  
+   i=i+1 ;     % i= 64
+   res(i)= res(i)     +all(all( ~ars  == ~arf ));  
+   i=i+1 ;     % i= 65
+%
+% complex sparse uary ops
+%
+   res(i)= res(i)     +all(all( acs.' ==  acf.' ));  
+   i=i+1 ;     % i= 66
+   res(i)= res(i)     +all(all( acs'  ==  acf' ));  
+   i=i+1 ;     % i= 67
+   res(i)= res(i)     +all(all( -acs  == -acf ));  
+   i=i+1 ;     % i= 68
+   res(i)= res(i)     +all(all( ~acs  == ~acf ));  
+   i=i+1 ;     % i= 69
+
+%
+% sparse op sparse and  sparse op matrix
+%
+
+   df_ef= drf\erf;
+   mag =  1e-12*mean( df_ef(:))*sqrt(prod(size(df_ef)));
+   # FIXME: this breaks if drs is 1x1
+   rdif= abs(drs\erf - df_ef) < abs(mag*df_ef);
+   res(i)= res(i)     +all(all( rdif ));
+   i=i+1 ;     % i= 70
+
+   rdif= abs(drf\ers - df_ef) < abs(mag*df_ef);
+   res(i)= res(i)     +all(all( rdif ));
+   i=i+1 ;     % i= 71
+
+   rdif= abs(drs\ers - df_ef) < abs(mag*df_ef);
+   res(i)= res(i)     +all(all( rdif ));
+   i=i+1 ;     % i= 72
+
+   res(i)= res(i)     +all(all( ars+brs == arf+brf )); 
+   i=i+1 ;     % i= 73
+   res(i)= res(i)     +all(all( arf+brs == arf+brf ));  
+   i=i+1 ;     % i= 74
+   res(i)= res(i)     +all(all( ars+brf == arf+brf ));  
+   i=i+1 ;     % i= 75
+   res(i)= res(i)     +all(all( ars-brs == arf-brf ));  
+   i=i+1 ;     % i= 76
+   res(i)= res(i)     +all(all( arf-brs == arf-brf ));  
+   i=i+1 ;     % i= 77
+   res(i)= res(i)     +all(all( ars-brf == arf-brf ));  
+   i=i+1 ;     % i= 78
+   res(i)= res(i)     +all(all( (ars>brs) == (arf>brf) ));  
+   i=i+1 ;     % i= 79
+   res(i)= res(i)     +all(all( (ars<brs) == (arf<brf) ));  
+   i=i+1 ;     % i= 80
+   res(i)= res(i)     +all(all( (ars!=brs) == (arf!=brf) ));  
+   i=i+1 ;     % i= 81
+   res(i)= res(i)     +all(all( (ars>=brs) == (arf>=brf) ));  
+   i=i+1 ;     % i= 82
+   res(i)= res(i)     +all(all( (ars<=brs) == (arf<=brf) ));  
+   i=i+1 ;     % i= 83
+   res(i)= res(i)     +all(all( (ars==brs) == (arf==brf) ));  
+   i=i+1 ;     % i= 84
+   res(i)= res(i)     +all(all( ars.*brs == arf.*brf ));  
+   i=i+1 ;     % i= 85
+   res(i)= res(i)     +all(all( arf.*brs == arf.*brf ));  
+   i=i+1 ;     % i= 86
+   res(i)= res(i)     +all(all( ars.*brf == arf.*brf ));  
+   i=i+1 ;     % i= 87
+   res(i)= res(i)     +all(all( ars*crs == arf*crf ));  
+   i=i+1 ;     % i= 88
+   res(i)= res(i)     +all(all( arf*crs == arf*crf ));  
+   i=i+1 ;     % i= 89
+   res(i)= res(i)     +all(all( ars*crf == arf*crf ));  
+   i=i+1 ;     % i= 90
+
+%
+% sparse op complex sparse and  sparse op complex matrix
+%
+
+   df_ef= drf\ecf;
+   mag =  1e-12*mean( df_ef(:))*sqrt(prod(size(df_ef)));
+   # FIXME: this breaks if drs is 1x1
+   rdif= abs(drs\ecf - df_ef) < abs(mag*df_ef);
+   res(i)= res(i)     +all(all( rdif ));
+   i=i+1 ;     % i= 91
+
+   rdif= abs(drf\ecs - df_ef) < abs(mag*df_ef);
+   res(i)= res(i)     +all(all( rdif ));
+   i=i+1 ;     % i= 92
+
+# TODO: not avail yet
+#  rdif= abs(drs\ecs - df_ef) < abs(mag*df_ef);
+#  res(i)= res(i)     +all(all( rdif ));
+#  i=i+1 ;     % i= 93
+
+   res(i)= res(i)     +all(all( ars+bcs == arf+bcf )); 
+   i=i+1 ;     % i= 94
+   res(i)= res(i)     +all(all( arf+bcs == arf+bcf ));  
+   i=i+1 ;     % i= 95
+   res(i)= res(i)     +all(all( ars+bcf == arf+bcf ));  
+   i=i+1 ;     % i= 96
+   res(i)= res(i)     +all(all( ars-bcs == arf-bcf ));  
+   i=i+1 ;     % i= 97
+   res(i)= res(i)     +all(all( arf-bcs == arf-bcf ));  
+   i=i+1 ;     % i= 98
+   res(i)= res(i)     +all(all( ars-bcf == arf-bcf ));  
+   i=i+1 ;     % i= 99
+   res(i)= res(i)     +all(all( (ars>bcs) == (arf>bcf) ));  
+   i=i+1 ;     % i=100
+   res(i)= res(i)     +all(all( (ars<bcs) == (arf<bcf) ));  
+   i=i+1 ;     % i=101
+   res(i)= res(i)     +all(all( (ars!=bcs) == (arf!=bcf) ));  
+   i=i+1 ;     % i=102
+   res(i)= res(i)     +all(all( (ars>=bcs) == (arf>=bcf) ));  
+   i=i+1 ;     % i=103
+   res(i)= res(i)     +all(all( (ars<=bcs) == (arf<=bcf) ));  
+   i=i+1 ;     % i=104
+   res(i)= res(i)     +all(all( (ars==bcs) == (arf==bcf) ));  
+   i=i+1 ;     % i=105
+   res(i)= res(i)     +all(all( ars.*bcs == arf.*bcf ));  
+   i=i+1 ;     % i=106
+   res(i)= res(i)     +all(all( arf.*bcs == arf.*bcf ));  
+   i=i+1 ;     % i=107
+   res(i)= res(i)     +all(all( ars.*bcf == arf.*bcf ));  
+   i=i+1 ;     % i=108
+   res(i)= res(i)     +all(all( ars*ccs == arf*ccf ));  
+   i=i+1 ;     % i=109
+   res(i)= res(i)     +all(all( arf*ccs == arf*ccf ));  
+   i=i+1 ;     % i=110
+   res(i)= res(i)     +all(all( ars*ccf == arf*ccf ));  
+   i=i+1 ;     % i=111
+
+%
+% complex sparse op sparse and  complex sparse op matrix
+%
+
+   df_ef= dcf\erf;
+   mag =  1e-12*mean( df_ef(:))*sqrt(prod(size(df_ef)));
+   # FIXME: this breaks if drs is 1x1
+   rdif= abs(dcs\erf - df_ef) < abs(mag*df_ef);
+   res(i)= res(i)     +all(all( rdif ));
+   i=i+1 ;     % i=112
+
+   rdif= abs(dcf\ers - df_ef) < abs(mag*df_ef);
+   res(i)= res(i)     +all(all( rdif ));
+   i=i+1 ;     % i=113
+
+# TODO: not avail yet
+#  rdif= abs(dcs\ers - df_ef) < abs(mag*df_ef);
+#  res(i)= res(i)     +all(all( rdif ));
+#  i=i+1 ;     % i=114
+
+   res(i)= res(i)     +all(all( acs+brs == acf+brf )); 
+   i=i+1 ;     % i=115
+   res(i)= res(i)     +all(all( acf+brs == acf+brf ));  
+   i=i+1 ;     % i=116
+   res(i)= res(i)     +all(all( acs+brf == acf+brf ));  
+   i=i+1 ;     % i=117
+   res(i)= res(i)     +all(all( acs-brs == acf-brf ));  
+   i=i+1 ;     % i=118
+   res(i)= res(i)     +all(all( acf-brs == acf-brf ));  
+   i=i+1 ;     % i=119
+   res(i)= res(i)     +all(all( acs-brf == acf-brf ));  
+   i=i+1 ;     % i=120
+   res(i)= res(i)     +all(all( (acs>brs) == (acf>brf) ));  
+   i=i+1 ;     % i=121
+   res(i)= res(i)     +all(all( (acs<brs) == (acf<brf) ));  
+   i=i+1 ;     % i=122
+   res(i)= res(i)     +all(all( (acs!=brs) == (acf!=brf) ));  
+   i=i+1 ;     % i=123
+   res(i)= res(i)     +all(all( (acs>=brs) == (acf>=brf) ));  
+   i=i+1 ;     % i=124
+   res(i)= res(i)     +all(all( (acs<=brs) == (acf<=brf) ));  
+   i=i+1 ;     % i=125
+   res(i)= res(i)     +all(all( (acs==brs) == (acf==brf) ));  
+   i=i+1 ;     % i=126
+   res(i)= res(i)     +all(all( acs.*brs == acf.*brf ));  
+   i=i+1 ;     % i=127
+   res(i)= res(i)     +all(all( acf.*brs == acf.*brf ));  
+   i=i+1 ;     % i=128
+   res(i)= res(i)     +all(all( acs.*brf == acf.*brf ));  
+   i=i+1 ;     % i=129
+   res(i)= res(i)     +all(all( acs*crs == acf*crf ));  
+   i=i+1 ;     % i=130
+   res(i)= res(i)     +all(all( acf*crs == acf*crf ));  
+   i=i+1 ;     % i=131
+   res(i)= res(i)     +all(all( acs*crf == acf*crf ));  
+   i=i+1 ;     % i=132
+
+%
+% complex sparse op complex sparse and  complex sparse op complex matrix
+%
+
+   df_ef= dcf\ecf;
+   mag =  1e-12*mean( df_ef(:))*sqrt(prod(size(df_ef)));
+   # FIXME: this breaks if drs is 1x1
+   rdif= abs(dcs\ecf - df_ef) < abs(mag*df_ef);
+   res(i)= res(i)     +all(all( rdif ));
+   i=i+1 ;     % i=133
+
+   rdif= abs(dcf\ecs - df_ef) < abs(mag*df_ef);
+   res(i)= res(i)     +all(all( rdif ));
+   i=i+1 ;     % i=134
+
+# TODO: not avail yet
+#  rdif= abs(dcs\ecs - df_ef) < abs(mag*df_ef);
+#  res(i)= res(i)     +all(all( rdif ));
+#  i=i+1 ;     % i=135
+
+   res(i)= res(i)     +all(all( acs+bcs == acf+bcf )); 
+   i=i+1 ;     % i=136
+   res(i)= res(i)     +all(all( acf+bcs == acf+bcf ));  
+   i=i+1 ;     % i=137
+   res(i)= res(i)     +all(all( acs+bcf == acf+bcf ));  
+   i=i+1 ;     % i=138
+   res(i)= res(i)     +all(all( acs-bcs == acf-bcf ));  
+   i=i+1 ;     % i=139
+   res(i)= res(i)     +all(all( acf-bcs == acf-bcf ));  
+   i=i+1 ;     % i=140
+   res(i)= res(i)     +all(all( acs-bcf == acf-bcf ));  
+   i=i+1 ;     % i=141
+   res(i)= res(i)     +all(all( (acs>bcs) == (acf>bcf) ));  
+   i=i+1 ;     % i=142
+   res(i)= res(i)     +all(all( (acs<bcs) == (acf<bcf) ));  
+   i=i+1 ;     % i=143
+   res(i)= res(i)     +all(all( (acs!=bcs) == (acf!=bcf) ));  
+   i=i+1 ;     % i=144
+   res(i)= res(i)     +all(all( (acs>=bcs) == (acf>=bcf) ));  
+   i=i+1 ;     % i=145
+   res(i)= res(i)     +all(all( (acs<=bcs) == (acf<=bcf) ));  
+   i=i+1 ;     % i=146
+   res(i)= res(i)     +all(all( (acs==bcs) == (acf==bcf) ));  
+   i=i+1 ;     % i=147
+   res(i)= res(i)     +all(all( acs.*bcs == acf.*bcf ));  
+   i=i+1 ;     % i=148
+   res(i)= res(i)     +all(all( acf.*bcs == acf.*bcf ));  
+   i=i+1 ;     % i=149
+   res(i)= res(i)     +all(all( acs.*bcf == acf.*bcf ));  
+   i=i+1 ;     % i=150
+   res(i)= res(i)     +all(all( acs*ccs == acf*ccf ));  
+   i=i+1 ;     % i=151
+   res(i)= res(i)     +all(all( acf*ccs == acf*ccf ));  
+   i=i+1 ;     % i=152
+   res(i)= res(i)     +all(all( acs*ccf == acf*ccf ));  
+   i=i+1 ;     % i=153
+
+%
+% sparse select operations
+%
+   %this is necessary until we get the orientations sorted
+   r1= ars(sel1); r2=arf(sel1);
+   res(i)= res(i)     +all( r1(:) == r2(:) );
+%  res(i)= res(i)     +all( ars(sel1) == arf(sel1 ));
+   i=i+1 ;     % i=154
+   res(i)= res(i)     +all( ars(:) == arf(:));
+   i=i+1 ;     % i=155
+   res(i)= res(i)     +all(all( ars(sely,selx) == arf(sely,selx) ));
+   i=i+1 ;     % i=156
+   res(i)= res(i)     +all(all( ars( :  ,selx) == arf( :  ,selx) ));
+   i=i+1 ;     % i=157
+   res(i)= res(i)     +all(all( ars(sely, :  ) == arf(sely, :  ) ));
+   i=i+1 ;     % i=158
+   res(i)= res(i)     +all(all( ars(:,:) == arf(:,:) ));
+   i=i+1 ;     % i=159
+
+%
+% sparse select operations
+%
+% TODO
+
+%
+% sparse LU and inverse
+%
+   mag = 1e-12;
+   [Lf2,Uf2]     =   lu( drf );
+   [Lf4,Uf4,Pf4] =   lu( drf );
+
+   if OCTAVE
+      [Ls2,Us2]     = splu( drs );
+   else
+      [Ls2,Us2]     = lu( drs );
+   end
+
+% LU decomp may be different but U must be Upper and LU==d
+   res(i)= res(i) + all( [  ...
+               all(all( abs(Ls2*Us2 - Lf2*Uf2 )< mag )) ; ...
+                      1 ] );
+   i=i+1 ;     % i=160
+                                        
+   if OCTAVE
+      [Ls4,Us4,PsR,PsC] = splu( drs );
+      res(i)= res(i) + ...
+            all([ all(all(abs( PsR'*Ls4*Us4*PsC  - Pf4'*Lf4*Uf4 )<mag)) ;
+                  all(all(abs( PsR'*Ls4*Us4*PsC  - drf )< mag)) ;
+                  all(all( Ls4 .* LL == Ls4 )) ;
+                  all(all( Us4 .* UU == Us4 )) ] );
+   elseif 0
+      [Ls4,Us4,Ps4] = lu( drs );
+      res(i)= res(i) + ...
+            all([ all(all(abs( Ps4'*Ls4*Us4 - Pf4'*Lf4*Uf4 )<mag)) ;
+                  all(all(abs( Ps4'*Ls4*Us4 - drf )< mag)) ;
+                  all(all( Ls4 .* LL == Ls4 )) ;
+                  all(all( Us4 .* UU == Us4 )) ] );
+   end
+
+   i=i+1 ;     % i=161
+
+%  [Ls4,Us4,PsR,PsC,p1,p2] = splu( drs );
+if 0 % test code for old spinv
+   [dsi,Ls4,Lt,iL,Us4,iUt,iU] = spinv( drs );
+   mag= 1e-10;
+   res(i)= res(i) + all( [ ...
+           all(all( abs( inv(Ls4) - iL ) <= mag*(1+abs(inv(Ls4))) )),
+           all(all( abs( inv(Us4) - iU ) <= mag*(1+abs(inv(Us4))) ))
+           ]);
+   if ~all(all( abs( inv(Ls4) - iL ) < mag*(1+abs(inv(Ls4))) ));
+      printf('%d:L size=%d\n', tries, size(iU,1));
+      keyboard
+   end 
+   if ~all(all( abs( inv(Us4) - iU ) < mag*(1+abs(inv(Us4))) ));
+      printf('%d:U size=%d\n', tries, size(iU,1));
+           abs( inv(Us4) - iU ) <= mag*(1+abs(inv(iU)))
+      keyboard
+   end 
+endif #0   
+
+   dsi = spinv( drs );
+   mag= 1e-10;
+   res(i)= res(i) + all(all( ...
+           abs( inv(drf) - dsi ) <= mag*(1+abs(inv(drf))) ));
+   i=i+1 ;     % i=162
+
+   if OCTAVE
+      res(i)= res(i)    +all( spfind(ars) == find(arf) );
+      [I,J,S,N,M]= spfind(ars);
+   else
+      res(i)= res(i)    +all( find(ars) == find(arf) );
+      [I,J,S]= find(ars);
+      [N,M]  = size(ars);
+   end
+   i=i+1 ;     % i=163
+
+   asnew= sparse(I,J,S,N,M);
+   res(i)= res(i)    +all( all( asnew == ars ));
+   i=i+1 ;     % i=164
+
+%
+% complex sparse LU and inverse
+%
+% TODO
+
+end 
+
+res= res(1:i-1);
+
+printf( ...
+    '%d operations tested sucessfully for %d iterations\n', ...
+    sum( res==NTRIES) , NTRIES );
+
+for i=find( res~= NTRIES)
+   printf( [ 'operation #%d in sp_test.m exceeds error tolerance ', ...
+             'with probability %5.2f%%\n' ], ...
+    i, 100*(1 - res(i)/NTRIES) );
+end           
+
+% clear up variables - so dmalloc works
+clear L* U* a* b* c* d* e* P*
+
+%
+% $Log$
+% Revision 1.1  2001/10/10 19:54:49  pkienzle
+% Initial revision
+%
+% Revision 1.7  2001/04/08 20:14:34  aadler
+% test cases for complex sparse
+%
+% Revision 1.6  2001/04/04 02:13:46  aadler
+% complete complex_sparse, templates, fix memory leaks
+%
+% Revision 1.5  2001/03/30 04:36:30  aadler
+% added multiply, solve, and sparse creation
+%
+% Revision 1.4  2001/03/15 15:47:58  aadler
+% cleaned up duplicated code by using "defined" templates.
+% used default numerical conversions
+%
+% Revision 1.3  2001/02/27 03:01:52  aadler
+% added rudimentary complex matrix support
+%
+% Revision 1.2  2000/12/18 03:31:16  aadler
+% Split code to multiple files
+% added sparse inverse
+%
+% Revision 1.1  2000/11/11 02:47:11  aadler
+% DLD functions for sparse support in octave
+%
+% Revision 1.3  2000/08/02 01:17:51  andy
+% more careful tests including vaguely pathological cases
+%
+% Revision 1.2  2000/06/23 03:25:28  andy
+% functions for sparse op scalar
+%
+% Revision 1.1  2000/04/01 02:42:02  andy
+% Initial revision
+%
+% numbering of tests: (vim cmd)
+% %perld BEGIN{$i=0};s/[#%] i=( *\d*) *$/sprintf("%% i=%2d",++$i)/e 
+%
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/sparse_full.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,220 @@
+/*
+Sparse matrix functionality for octave, based on the SuperLU package  
+Copyright (C) 1998-2000 Andy Adler
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Octave; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+$Id$
+
+*/
+
+#include "make_sparse.h"
+
+
+//
+// full
+//
+DEFUN_DLD (full, args, ,
+"FM= full (SM)\n"
+" returns a full storage matrix from a sparse one")
+{
+  octave_value_list retval;
+
+  if (args.length() < 1) {
+     print_usage ("full");
+     return retval;
+  }
+
+  if (args(0).type_name () == "sparse") {
+     const octave_value& rep = args(0).get_rep ();
+
+     Matrix M = ((const octave_sparse&) rep) . matrix_value ();
+     retval(0)= M;
+  } else
+  if (args(0).type_name () == "complex_sparse") {
+     const octave_value& rep = args(0).get_rep ();
+
+     ComplexMatrix M = ((const octave_sparse&) rep) . complex_matrix_value ();
+     retval(0)= M;
+  } else
+  if (args(0).type_name () == "matrix") {
+     retval(0)= args(0).matrix_value();
+  } else
+  if (args(0).type_name () == "complex matrix") {
+     retval(0)= args(0).complex_matrix_value();
+  } else
+    gripe_wrong_type_arg ("full", args(0));
+
+  return retval;
+}
+
+//
+// nnz
+//
+DEFUN_DLD (nnz, args, ,
+"int= nnz (SM)\n"
+" returns number of non zero elements in SM")
+{
+  octave_value_list retval;
+
+  if (args.length() < 1) {
+     print_usage ("nnz");
+     return retval;
+  }
+
+  if (args(0).type_name () == "sparse") {
+     const octave_value& rep = args(0).get_rep ();
+
+     retval(0)= (double) ((const octave_sparse&) rep) . nnz ();
+  } else
+  if (args(0).type_name () == "complex_sparse") {
+     const octave_value& rep = args(0).get_rep ();
+
+     retval(0)= (double) ((const octave_complex_sparse&) rep) . nnz ();
+  } else
+  if (args(0).type_name () == "complex matrix") {
+     const ComplexMatrix M = args(0).complex_matrix_value();
+     int nnz= 0;
+     for( int i=0; i< M.rows(); i++)
+        for( int j=0; j< M.cols(); j++)
+           if (M(i,j)!=0) nnz++;
+     retval(0)= (double) nnz;
+  } else
+  if (args(0).type_name () == "matrix") {
+     const Matrix M = args(0).matrix_value();
+     int nnz= 0;
+     for( int i=0; i< M.rows(); i++)
+        for( int j=0; j< M.cols(); j++)
+           if (M(i,j)!=0) nnz++;
+     retval(0)= (double) nnz;
+  } else
+     gripe_wrong_type_arg ("nnz", args(0));
+
+  return retval;
+}
+
+//
+// spfind - find elements in sparse matrices
+//
+DEFUN_DLD (spfind, args, nargout ,
+  "[...] = spfind (...)\n\
+SPFIND: a sparse version of the find operator\n\
+   x = spfind( a )                 \n\
+      is analagous to x= find(A(:)) \n\
+      where A= full(a)\n\
+   [i,j.v,nr,nc] = spfind( a )\n\
+      give column vectors i j v such that\n\
+      a= sparse(i,j,v,nr,nc)\n\
+  ")
+{
+   octave_value_list retval;
+   octave_value tmp;
+   int nargin = args.length ();
+
+   if (nargin != 1) {
+      print_usage ("spfull");
+      return retval;
+   }
+      
+
+   bool is_sparse=      args(0).type_name () == "sparse";
+   bool is_cplx_sparse= args(0).type_name () == "complex_sparse";
+
+   if ( is_sparse || is_cplx_sparse ) {
+      const octave_value& rep = args(0).get_rep ();
+ 
+      SuperMatrix A = ((const octave_sparse&) rep) . super_matrix ();
+      assert( (A).Stype == NC); 
+      NCformat * NCFA= (NCformat *) (A).Store;
+      int  * ridxA =          NCFA->rowind;
+      int  * cidxA =          NCFA->colptr;
+      int Anr= (A).nrow; 
+      int Anc= (A).ncol;
+      int nnz = NCFA->nnz;
+
+      if (nargout<=1) {
+         ColumnVector I (nnz);
+         for (int i=0, cx=0; i< Anc; i++)
+            for (int j= cidxA[i]; j< cidxA[i+1]; j++ ) 
+               I( cx++ ) = (double) ( (ridxA[j]+1) + i*Anr );
+
+         // orientation rules - 
+         //   I is column unless matrix is a rowvector
+         if (Anr == 1)
+            retval(0)= I.transpose();
+         else
+            retval(0)= I;
+
+      } else
+      {
+         ColumnVector I (nnz), J (nnz);
+
+         for (int i=0,cx=0; i< Anc; i++)
+            for (int j= cidxA[i]; j< cidxA[i+1]; j++ ) {
+               I( cx ) = (double) ridxA[j]+1;
+               J( cx ) = (double) i+1;
+               cx++;
+            }
+
+         retval(0)= I;
+         retval(1)= J;
+         retval(3)= (double) Anr;
+         retval(4)= (double) Anc;
+
+         if (is_sparse) {
+            assert( A.Dtype == _D );
+            ColumnVector S (nnz);
+            double * coefA = (double *) NCFA->nzval;
+            for (int i=0,cx=0; i< Anc; i++)
+               for (int j= cidxA[i]; j< cidxA[i+1]; j++ ) 
+                  S( cx++ ) =          coefA[j];
+            retval(2)= S;
+         } else
+         {
+            assert( A.Dtype == _Z );
+            ComplexColumnVector S (nnz);
+            Complex * coefA = (Complex *) NCFA->nzval;
+            for (int i=0,cx=0; i< Anc; i++)
+               for (int j= cidxA[i]; j< cidxA[i+1]; j++ ) 
+                  S( cx++ ) =          coefA[j];
+            retval(2)= S;
+         }
+
+            
+      } // if nargout
+   }
+   else
+     gripe_wrong_type_arg ("spfind", args(0));
+
+   return retval;
+}
+
+/*
+ * $Log$
+ * Revision 1.1  2001/10/10 19:54:49  pkienzle
+ * Initial revision
+ *
+ * Revision 1.3  2001/04/08 20:18:19  aadler
+ * complex sparse support
+ *
+ * Revision 1.2  2001/02/27 03:01:52  aadler
+ * added rudimentary complex matrix support
+ *
+ * Revision 1.1  2000/12/18 03:31:16  aadler
+ * Split code to multiple files
+ * added sparse inverse
+ *
+ */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/sparse_inv.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,671 @@
+/*
+Sparse matrix functionality for octave, based on the SuperLU package  
+Copyright (C) 1998-2000 Andy Adler
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Octave; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+$Id$
+
+*/
+
+#define SPARSE_DOUBLE_CODE
+#include "make_sparse.h"
+
+
+//
+// perform a sanity check on calculated SuperMatrices
+//
+#ifndef NDEBUG
+void
+oct_sparse_verify_supermatrix( SuperMatrix X) 
+{  
+   DEBUGMSG("verify_supermatrix");
+   DEFINE_SP_POINTERS_REAL( X )
+   int    nnz= NCFX->nnz;
+   int    cx=0;
+   for ( int i=0; i < Xnr ; i++) {
+      assert( cidxX[i] >= 0);
+      assert( cidxX[i] <  nnz);
+      assert( cidxX[i] <=  cidxX[i+1]);
+      for( int j= cidxX[i];
+               j< cidxX[i+1];
+               j++ ) {
+         assert( ridxX[j] >= 0);
+         assert( ridxX[j] <  Xnc);
+         assert( coefX[j] !=  0); // don't keep zero values
+         if (j> cidxX[i])
+            assert( ridxX[j-1] < ridxX[j] );
+         cx++;
+      } // for j
+   } // for i
+   assert (cx==nnz);
+}   
+#endif // NDEBUG         
+
+//
+// Fix the row ordering problems that
+// LUExtract seems to cause
+// NOTE: we don't try to fix other structural errors
+//    in the generated matrices, but we bail out
+//    if we find any. This should work since I 
+//    haven't seen any problems other than ordering
+//
+// NOTE: The right way to fix this, of course, is to
+//    track down the bug in the superlu codebase.
+
+// define a struct and qsort
+// comparison function to do the reordering
+typedef struct { unsigned int idx;
+                 double       val; } fixrow_sort;
+
+static inline int
+fixrow_comp( const void *i, const void *j) 
+{
+   return  ((fixrow_sort *) i)->idx -
+           ((fixrow_sort *) j)->idx ;
+}   
+
+void
+fix_row_order( SuperMatrix X )
+{
+   DEBUGMSG("fix_row_order");
+   DEFINE_SP_POINTERS_REAL( X )
+   int    nnz= NCFX->nnz;
+
+   for ( int i=0; i < Xnr ; i++) {
+      assert( cidxX[i] >= 0);
+      assert( cidxX[i] <  nnz);
+      assert( cidxX[i] <=  cidxX[i+1]);
+      int reorder=0;
+      for( int j= cidxX[i];
+               j< cidxX[i+1];
+               j++ ) {
+         assert( ridxX[j] >= 0);
+         assert( ridxX[j] <  Xnc);
+         assert( coefX[j] !=  0); // don't keep zero values
+         if (j> cidxX[i])
+            if ( ridxX[j-1] > ridxX[j] )
+               reorder=1;
+      } // for j
+      if(reorder) {
+         int snum= cidxX[i+1] - cidxX[i];
+         fixrow_sort arry[snum];
+         // copy to the sort struct
+         for( int k=0,
+                  j= cidxX[i];
+                  j< cidxX[i+1];
+                  j++ ) {
+            arry[k].idx= ridxX[j];
+            arry[k].val= coefX[j];
+            k++;
+         }
+         qsort( arry, snum, sizeof(fixrow_sort), fixrow_comp );
+         // copy back to the position
+         for( int k=0,
+                  j= cidxX[i];
+                  j< cidxX[i+1];
+                  j++ ) {
+            ridxX[j]= arry[k].idx;
+            coefX[j]= arry[k].val;
+            k++;
+         }
+      }
+   } // for i
+}   
+
+//
+// This routine converts from the SuperNodal Matrices
+// L,U to the Comp Col format.
+//
+// It is modified from SuperLU/MATLAB/mexsuperlu.c
+//
+// It seems to produce badly formatted U. ie the
+//   row indeces are unsorted.
+// Need to call function to fix this.
+//
+
+static void
+LUextract(SuperMatrix *L, SuperMatrix *U, double *Lval, int *Lrow,
+          int *Lcol, double *Uval, int *Urow, int *Ucol, int *snnzL,
+          int *snnzU)
+{
+   DEBUGMSG("LUextract");
+   int         i, j, k;
+   int         upper;
+   int         fsupc, istart, nsupr;
+   int         lastl = 0, lastu = 0;
+   double      *SNptr;
+
+   SCformat * Lstore = (SCformat *) L->Store;
+   NCformat * Ustore = (NCformat *) U->Store;
+   Lcol[0] = 0;
+   Ucol[0] = 0;
+   
+   /* for each supernode */
+   for (k = 0; k <= Lstore->nsuper; ++k) {
+       
+       fsupc = L_FST_SUPC(k);
+       istart = L_SUB_START(fsupc);
+       nsupr = L_SUB_START(fsupc+1) - istart;
+       upper = 1;
+       
+       /* for each column in the supernode */
+       for (j = fsupc; j < L_FST_SUPC(k+1); ++j) {
+           SNptr = &((double*)Lstore->nzval)[L_NZ_START(j)];
+
+           /* Extract U */
+           for (i = U_NZ_START(j); i < U_NZ_START(j+1); ++i) {
+               Uval[lastu] = ((double*)Ustore->nzval)[i];
+               if (Uval[lastu] != 0.0) Urow[lastu++] = U_SUB(i);
+           }
+           /* upper triangle in the supernode */
+           for (i = 0; i < upper; ++i) {
+               Uval[lastu] = SNptr[i];
+               if (Uval[lastu] != 0.0) Urow[lastu++] = L_SUB(istart+i);
+           }
+           Ucol[j+1] = lastu;
+
+           /* Extract L */
+           Lval[lastl] = 1.0; /* unit diagonal */
+           Lrow[lastl++] = L_SUB(istart + upper - 1);
+           for (i = upper; i < nsupr; ++i) {
+               Lval[lastl] = SNptr[i];
+                /* Matlab doesn't like explicit zero. */
+               if (Lval[lastl] != 0.0) Lrow[lastl++] = L_SUB(istart+i);
+           }
+           Lcol[j+1] = lastl;
+
+           ++upper;
+           
+       } /* for j ... */
+       
+   } /* for k ... */
+
+   *snnzL = lastl;
+   *snnzU = lastu;
+}
+
+static void
+sparse_LU_fact(SuperMatrix A,
+               SuperMatrix *LC,
+               SuperMatrix *UC,
+               int * perm_c,
+               int * perm_r, 
+               int permc_spec ) 
+{
+   DEBUGMSG("sparse_LU_fact");
+   int m = A.nrow;
+   int n = A.ncol;
+   char   refact[1] = {'N'};
+   double thresh    = 1.0;     // diagonal pivoting threshold 
+   double drop_tol  = 0.0;     // drop tolerance parameter 
+   int    info;
+   int    panel_size = sp_ienv(1);
+   int    relax      = sp_ienv(2);
+   int    etree[n];
+   SuperMatrix Ac;
+   SuperMatrix L,U;
+
+   StatInit(panel_size, relax);
+
+   oct_sparse_do_permc( permc_spec, perm_c, A);
+   // Apply column perm to A and compute etree.
+   sp_preorder(refact, &A, perm_c, etree, &Ac);
+
+   dgstrf(refact, &Ac, thresh, drop_tol, relax, panel_size, etree,
+           NULL, 0, perm_r, perm_c, &L, &U, &info);
+   if ( info < 0 )
+      SP_FATAL_ERR ("LU factorization error");
+
+   int      snnzL, snnzU;
+
+   int      nnzL = ((SCformat*)L.Store)->nnz;
+   double * Lval = (double *) malloc( nnzL * sizeof(double) );
+   int    * Lrow = (   int *) malloc( nnzL * sizeof(   int) );
+   int    * Lcol = (   int *) malloc( (n+1)* sizeof(   int) );
+
+   int      nnzU = ((NCformat*)U.Store)->nnz;
+   double * Uval = (double *) malloc( nnzU * sizeof(double) );
+   int    * Urow = (   int *) malloc( nnzU * sizeof(   int) );
+   int    * Ucol = (   int *) malloc( (n+1)* sizeof(   int) );
+
+   LUextract(&L, &U, Lval, Lrow, Lcol, Uval, Urow, Ucol, &snnzL, &snnzU);
+   // we need to use the snnz values (squeezed vs. unsqueezed)
+   dCreate_CompCol_Matrix(LC, m, n, snnzL, Lval, Lrow, Lcol, NC, _D, GE);
+   dCreate_CompCol_Matrix(UC, m, n, snnzU, Uval, Urow, Ucol, NC, _D, GE);
+
+   fix_row_order( *LC );
+   fix_row_order( *UC );
+   
+   oct_sparse_Destroy_SuperMatrix( L ) ;
+   oct_sparse_Destroy_SuperMatrix( U ) ;
+   oct_sparse_Destroy_SuperMatrix( Ac ) ;
+   StatFree();
+
+#if 0
+   printf("verify A\n");  oct_sparse_verify_supermatrix( A );
+   printf("verify LC\n"); oct_sparse_verify_supermatrix( *LC );
+   printf("verify UC\n"); oct_sparse_verify_supermatrix( *UC );
+#endif   
+
+} // sparse_LU_fact(
+
+// calculate the inverse of an 
+//  upper triangular sparse matrix
+//
+// iUt = inv(U)
+//  Note that the transpose is returned
+//
+// CODE:
+//
+//  note that the input matrix is accesses in
+//  row major order, and the output is accessed
+//  in column major. This is the reason that the
+//  output matrix is the transpose of the input
+//
+// I= eye( size(A) );
+// for n=1:N  # across
+//    for m= n+1:N # down
+//       v=0;
+//       for i= m-1:-1:n
+//          v=v- A(m,i)*I(i,n);
+//       end
+//       I(m,n)= v/A(m,m);
+//    end
+//    I(:,n)= I(:,n)/A(n,n);    <- for non unit norm
+// end   
+SuperMatrix
+sp_inv_uppertriang( SuperMatrix U)
+{
+   DEBUGMSG("sp_inv_uppertriang");
+   DEFINE_SP_POINTERS_REAL( U )
+   int    nnzU= NCFU->nnz;
+   // we need to be careful here,
+   // U is uppertriangular, but we're treating
+   // it as though it is a lower triag matrix in NR form
+
+// if ( Unc != Unr) SP_FATAL_ERR("sp_inv_uppertriang: nr!=nc");
+   assert ( Unc == Unr );
+
+   SuperMatrix   X;
+   DECLARE_SP_POINTERS_REAL( X )
+
+   // estimate inverse nnz= input nnz
+   int    nnz = NCFU->nnz;
+   ridxX = intMalloc   (nnz);
+   coefX = doubleMalloc(nnz);
+   cidxX = intMalloc   (Unc+1);
+
+   int cx= 0;
+
+   // iterate accross columns of output matrix
+   for ( int n=0; n < Unr ; n++) {
+      // place the 1 in the identity position
+      int cx_colstart= cx;
+
+      cidxX[n]= cx;
+      check_bounds( cx, nnz, ridxX, coefX );
+      ridxX[cx]= n;
+      coefX[cx]= 1.0;
+      cx++;
+
+      // iterate accross columns of input matrix
+      for ( int m= n+1; m< Unr; m++) {
+         double v=0;
+         // iterate to calculate sum
+         int colXp= cidxX[n];
+         int colUp= cidxU[m];
+
+         int rpX, rpU;
+         do {
+            rpX= ridxX [ colXp ];
+            rpU= ridxU [ colUp ];
+
+#if 0
+            int scolXp=colXp;
+            int scolUp=colUp;
+#endif            
+            if (rpX < rpU) {
+               colXp++;
+            } else
+            if (rpX > rpU) {
+               colUp++;
+            } else {
+               assert(rpX == rpU);
+               assert(rpX >= n);
+
+               v-= coefX[ colXp ]*coefU[ colUp ];
+               colXp++; 
+               colUp++;
+            } 
+#if 0            
+            printf("n=%d, m=%d, X[%d]=%7.4f U[%d]=%7.4f cXp=%d cUp=%d v=%7.4f\n",
+                  n,m, rpX, coefX[ scolXp ], rpU, coefU[ scolUp ],
+               scolXp,scolUp, v);
+#endif            
+
+         } while ((rpX<m) && (rpU<m) && (colXp<cx) && (colUp<nnzU));
+
+         // get A(m,m)
+         colUp= cidxU[m+1]-1;
+//       if (ridxU[ colUp ] != m) SP_FATAL_ERR("sp_inv_uppertriang: not Utriang input");
+         // assert fails if U is not upper triangular
+         assert (ridxU[ colUp ] == m );
+
+         double pivot= coefU[ colUp ];
+         if (pivot == 0) gripe_divide_by_zero ();
+
+         if (v!=0) {
+            check_bounds( cx, nnz, ridxX, coefX );
+            ridxX[cx]= m;
+            coefX[cx]= v / pivot;
+            cx++;
+         }
+      } // for m
+
+      // get A(m,m)
+      int colUp= cidxU[n+1]-1;
+//    if (ridxU[ colUp ] != n) SP_FATAL_ERR("sp_inv_uppertriang: not Utriang input");
+      // assert fails if U is not upper triangular
+      assert (ridxU[ colUp ] == n );
+      double pivot= coefU[ colUp ];
+      if (pivot == 0) gripe_divide_by_zero ();
+
+      if (pivot!=1.0)
+         for( int i= cx_colstart; i< cx; i++) 
+            coefX[i]/= pivot;
+
+   } // for n
+   cidxX[Unr]= cx;
+
+   maybe_shrink( cx, nnz, ridxX, coefX );
+   dCreate_CompCol_Matrix(&X, Unr, Unc, cx,
+                          coefX, ridxX, cidxX, NC, _D, GE);
+   return X;
+}                   
+
+
+DEFUN_DLD (splu, args, nargout ,
+  "[L,U,Prow, Pcol] = splu( a ,p);\n\
+SPLU : Sparse Matrix LU factorization\n\
+\n\
+With one input and two or three outputs, SPLU has the same effect as LU,\n\
+Except that row and column permutations are returned\n\
+\n\
+[L,U,Pr,Pc] = splu(A) \n\
+          returns unit lower triangular L, upper triangular U,\n\
+          and permutation matrices Pr,Pc with Pr*A*Pc' = L*U.\n\
+[Lp,Up] = superlu(A) returns permuted triangular L and upper triangular U\n\
+          with A = L*U.\n\
+          here Pr*Lp = L  and Up*Pc = U
+\n\
+Note: 2nd input funcionality has not been verified\n\
+With a second input, the columns of A are permuted before factoring:\n\
+\n\
+[L,U,P] = superlu(A,psparse) returns triangular L and U and permutation\n\
+          prow with P*A(:,psparse) = L*U.\n\
+[L,U] = superlu(A,psparse) returns permuted triangular L and triangular U\n\
+          with A(:,psparse) = L*U.\n\
+Here psparse will normally be a user-supplied permutation matrix or vector\n\
+to be applied to the columns of A for sparsity. \n\
+  ")
+{
+   octave_value_list retval;
+   octave_value tmp;
+   int nargin = args.length ();
+
+   if (args.length() < 1) {
+      print_usage ("splu");
+      return retval;
+   }
+ 
+   if (args(0).type_name () == "sparse") {
+      const octave_value& rep = args(0).get_rep ();
+ 
+      SuperMatrix A = ((const octave_sparse&) rep) . super_matrix ();
+      SuperMatrix L, U;
+      int m = A.nrow;
+      int n = A.ncol;
+      if (m != n)
+         SP_FATAL_ERR("Input matrix must be square");
+
+      int perm_c[n];
+      int permc_spec=3;
+      if (nargin ==2) {
+
+         ColumnVector permcidx = args(1).column_vector_value();
+         for( int i= 0; i< n ; i++ ) 
+            perm_c[i]= (int) permcidx(i) - 1;
+         permc_spec= -1; //permc is perselected
+      }
+
+      int perm_r[m];
+      sparse_LU_fact( A, &L, &U, perm_c, perm_r, permc_spec);
+
+      octave_value LS= new octave_sparse( L );
+      octave_value US= new octave_sparse( U );
+
+// Build the permutation matrix
+//  remember to add 1 because assemble_sparse is 1 based
+      ColumnVector ridxPr(m), cidxPr(m), coefPr(m);
+      for (int i=0; i<m; i++) {
+         ridxPr(i)= (double) i + 1;
+         cidxPr(i)= (double) perm_r[i] + 1; 
+         coefPr(i)= 1.0;
+      }
+
+      ColumnVector ridxPc(n), cidxPc(n), coefPc(n);
+      for (int i=0; i<m; i++) {
+         ridxPc(i)= (double) i + 1;
+         cidxPc(i)= (double) perm_c[i] + 1; 
+         coefPc(i)= 1.0;
+      }
+      
+      if (nargout ==2 ) {
+         octave_value PrT= new octave_sparse (
+               assemble_sparse( m, m, coefPr, ridxPr, cidxPr ) );
+         octave_value Pc = new octave_sparse (
+               assemble_sparse( n, n, coefPc, cidxPc, ridxPc ) );
+         retval(0)= PrT*LS;
+         retval(1)= US*Pc ;
+      } else
+      if (nargout >2 ) {
+         //build PS backwards to get the transpose
+         octave_value Pr = new octave_sparse (
+               assemble_sparse( m, m, coefPr, cidxPr, ridxPr ) );
+         octave_value Pc = new octave_sparse (
+               assemble_sparse( n, n, coefPc, cidxPc, ridxPc ) );
+         retval(0)= LS;
+         retval(1)= US;
+         retval(2)= Pr;
+         retval(3)= Pc;
+      }
+   }
+   else
+     gripe_wrong_type_arg ("splu", args(0));
+
+   return retval;
+}
+
+
+//
+// calculate the pieces of the sparse_inverse
+//
+// Math: 
+//  Since A= PrT*LS*US*Pc
+//  inv(A)= inv(Pc)*inv(US)*inv(LS)*inv(PrT)
+//  inv(a)=   PcT * inv(US)*inv(LS)* Pr
+//
+//  output is { PcT, inv(US), inv(LS) , Pr }
+//
+// The simplest way to call this is:
+//    int n = A.ncol;
+//    int perm_c[n];
+//    int permc_spec=3;
+//    oct_sparse_inverse( A, perm_c, perm_c_spec )
+//
+octave_value_list
+oct_sparse_inverse( SuperMatrix A,
+                    int* perm_c,
+                    int permc_spec
+      ) {
+   octave_value_list retval;
+   SuperMatrix L, U;
+
+   if (A.ncol != A.nrow) SP_FATAL_ERR("Input matrix must be square");
+
+   int n= A.ncol;
+   int m= A.nrow;
+   assert(n == m);
+
+   int perm_r[m];
+   sparse_LU_fact( A, &L, &U, perm_c, perm_r, permc_spec);
+
+// Build the permutation matrix
+//  remember to add 1 because assemble_sparse is 1 based
+   ColumnVector ridxPr(m), cidxPr(m), coefPr(m);
+   for (int i=0; i<m; i++) {
+      ridxPr(i)= (double) i + 1;
+      cidxPr(i)= (double) perm_r[i] + 1; 
+      coefPr(i)= 1.0;
+   }
+
+   ColumnVector ridxPc(n), cidxPc(n), coefPc(n);
+   for (int i=0; i<m; i++) {
+      ridxPc(i)= (double) i + 1;
+      cidxPc(i)= (double) perm_c[i] + 1; 
+      coefPc(i)= 1.0;
+   }
+   
+   octave_value Pr = new octave_sparse (
+         assemble_sparse( m, m, coefPr, cidxPr, ridxPr ) );
+   octave_value PcT= new octave_sparse (
+         assemble_sparse( n, n, coefPc, ridxPc, cidxPc ) );
+
+   SuperMatrix Lt= oct_sparse_transpose( L );
+   SuperMatrix iL= sp_inv_uppertriang( Lt );
+   SuperMatrix iUt= sp_inv_uppertriang( U );
+   SuperMatrix iU= oct_sparse_transpose( iUt );
+
+   oct_sparse_Destroy_SuperMatrix( L);
+   oct_sparse_Destroy_SuperMatrix( Lt);
+   oct_sparse_Destroy_SuperMatrix( U);
+   oct_sparse_Destroy_SuperMatrix( iUt);
+
+   octave_value iLS =  new octave_sparse( iL );
+   octave_value iUS =  new octave_sparse( iU );
+
+   retval(0)= PcT;
+   retval(1)= iUS;
+   retval(2)= iLS;
+   retval(3)= Pr;
+
+   return retval;
+}   
+
+   
+#ifdef VERBOSE   
+// this is for debugging memory leaks
+DEFUN_DLD (spdump, args, , "dump sparse")
+{
+   octave_value_list retval;
+   if (args(0).type_name () == "sparse") {
+      const octave_value& rep = args(0).get_rep ();
+      SuperMatrix A = ((const octave_sparse&) rep) . super_matrix ();
+
+      printf("A->%08X<-\n", (unsigned int) ((NCformat *)A.Store)->rowind );
+      printf("A->%08X<-\n", (unsigned int) ((NCformat *)A.Store)->colptr );
+      printf("A->%08X<-\n", (unsigned int) ((NCformat *)A.Store)->nzval );
+      printf("A->%08X<-\n", (unsigned int) A.Store );
+   }
+   return retval;
+}   
+#endif
+
+
+DEFUN_DLD (spinv, args, nargout ,
+  "[ainv] = spinv( a );\n\
+SPINV : Sparse Matrix inverse\n\
+    ainv is the inverse of a\n\
+or
+   [ainv] = spinv( a,p );\n\
+where p is a specified permutation for the columns of a\n\
+Here psparse will normally be a user-supplied permutation matrix or vector\n\
+to be applied to the columns of A for sparsity. \n\
+\n\
+Note: 2nd input funcionality has not been verified\n\
+With a second input, the columns of A are permuted before factoring:\n\
+\n\
+Note 2: It is significantly more accurate and faster to do
+    x=a\\b\n\
+rather than
+    x=spinv(a)*b\n\
+  ")
+{
+   octave_value_list retval;
+   octave_value tmp;
+   int nargin = args.length ();
+
+   if (args.length() < 1) {
+      print_usage ("spinv");
+      return retval;
+   }
+ 
+   if (args(0).type_name () == "sparse") {
+      const octave_value& rep = args(0).get_rep ();
+ 
+      SuperMatrix A = ((const octave_sparse&) rep) . super_matrix ();
+
+      int n = A.ncol;
+
+      int perm_c[n];
+      int permc_spec=3;
+
+      if (nargin ==2) {
+         ColumnVector permcidx ( args(1).vector_value() );
+         for( int i= 0; i< n ; i++ ) 
+            perm_c[i]= (int) permcidx(i) - 1;
+         permc_spec= -1; //permc is preselected
+      }
+
+      octave_value_list Ai =
+         oct_sparse_inverse( A, perm_c, permc_spec );
+
+      retval(0)= Ai(0) * Ai(1) * Ai(2) * Ai(3);
+
+   }
+   else
+     gripe_wrong_type_arg ("spinv", args(0));
+
+   return retval;
+}
+
+/*
+ * $Log$
+ * Revision 1.1  2001/10/10 19:54:49  pkienzle
+ * Initial revision
+ *
+ * Revision 1.3  2001/04/04 02:13:46  aadler
+ * complete complex_sparse, templates, fix memory leaks
+ *
+ * Revision 1.2  2001/02/27 03:01:52  aadler
+ * added rudimentary complex matrix support
+ *
+ * Revision 1.1  2000/12/18 03:31:16  aadler
+ * Split code to multiple files
+ * added sparse inverse
+ *
+ */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/sparse_ops.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,1013 @@
+/*
+Sparse matrix functionality for octave, based on the
+   SuperLU package  
+Copyright (C) 1998-2000 Andy Adler
+
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Octave; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+$Id$
+
+*/
+
+#define SPARSE_DOUBLE_CODE
+#include "make_sparse.h"
+#include "sparse_ops.h"
+
+
+SuperMatrix
+create_SuperMatrix( int nr, int nc, int nnz,
+                    double * coef,
+                    int * ridx,
+                    int * cidx )
+{
+   SuperMatrix  X;
+   dCreate_CompCol_Matrix(&X, nr, nc, nnz,
+                          coef,
+                          ridx, cidx, NC, _D, GE);
+   return X;
+}
+
+
+// assemble a sparse matrix from elements
+//   called by > 1 args for sparse
+// NOTE: index vectors are 1 based!
+SuperMatrix assemble_sparse( int n, int m,
+                             ColumnVector& coefA,
+                             ColumnVector& ridxA,
+                             ColumnVector& cidxA )
+{
+   DEBUGMSG("sparse - assemble_sparse");
+   ASSEMBLE_SPARSE( double )
+   return X;
+}      
+
+
+//
+// Octave sparse methods
+//
+
+inline
+octave_sparse::octave_sparse (SuperMatrix A )
+{
+      DEBUGMSG("sparse( SuperMatrix A)");
+      X= A;
+}
+
+inline
+octave_sparse::~octave_sparse (void)
+{
+   DEBUGMSG("sparse destructor");
+   oct_sparse_Destroy_SuperMatrix( X ) ;
+}
+
+//NOTE: I'm not sure when this will get called,
+//      so I don't know what to do
+inline
+octave_sparse::octave_sparse (const octave_sparse& S)
+{
+   DEBUGMSG("sparse copy-constructor");
+   X= S.super_matrix();
+}   
+
+inline octave_value *
+octave_sparse::clone (void)
+{
+   DEBUGMSG("sparse - clone");
+   return new octave_sparse (*this);
+}
+
+inline octave_sparse
+octave_sparse::sparse_value (bool = false) const {
+   DEBUGMSG("sparse_value");
+   return  (*this);
+}
+
+SuperMatrix
+octave_sparse::super_matrix (bool = false) const {
+   return X;
+}
+
+
+int octave_sparse::rows    (void) const {
+   return X.nrow;
+}
+int octave_sparse::columns (void) const {
+   return X.ncol;
+}
+
+int octave_sparse::nnz     (void) const {
+   NCformat * NCF  = (NCformat * ) X.Store;
+   return   NCF->nnz ;
+}
+
+Matrix
+oct_sparse_to_full ( SuperMatrix X ) {
+   DEBUGMSG("sparse - sparse_to_full");
+   DEFINE_SP_POINTERS_REAL( X )
+   
+   Matrix M( Xnr, Xnc );
+   for (int j=0; j< Xnc; j++) {
+      for (int i=0; i< Xnr; i++) M(i,j)= 0;
+   
+      for (int i= cidxX[j]; i< cidxX[j+1]; i++) 
+         M( ridxX[i],j)= coefX[i];
+   } // for i
+   return M;
+}   
+
+// type conversion functions
+
+static octave_value *
+default_numeric_conversion_function (const octave_value& a)
+{
+   DEBUGMSG("sparse - default_numeric_conversion_function");
+   CAST_CONV_ARG (const octave_sparse&);
+   return new octave_matrix (v.matrix_value ());
+}
+ 
+type_conv_fcn
+octave_sparse::numeric_conversion_function (void) const
+{
+   DEBUGMSG("sparse - numeric_conversion_function");
+   return default_numeric_conversion_function;
+}
+
+//idx_vector index_vector (void) const { return idx_vector ((double) iv); }
+
+octave_value octave_sparse::any (void) const {
+   DEBUGMSG("sparse - any");
+   Matrix M= oct_sparse_to_full( X );
+   return M.any();
+}
+
+octave_value octave_sparse::all (void) const {
+   DEBUGMSG("sparse - all");
+   Matrix M= oct_sparse_to_full( X );
+   return M.all();
+}
+
+bool octave_sparse::is_defined    (void) const  { return true; }
+bool octave_sparse::is_real_scalar (void) const { return false; }
+bool octave_sparse::is_real_type (void) const { return true; }
+bool octave_sparse::is_scalar_type (void) const { return false; }
+bool octave_sparse::is_numeric_type (void) const { return true; }
+
+bool octave_sparse::valid_as_scalar_index (void) const { return false; }
+
+bool octave_sparse::valid_as_zero_index (void) const { return false; }
+
+//A matrix is true if it is all non zero
+bool octave_sparse::is_true (void) const {
+   DEBUGMSG("sparse - is_true");
+   NCformat * NCF  = (NCformat * ) X.Store;
+   return (X.nrow * X.ncol == NCF->nnz );
+}
+
+
+// rebuild a full matrix from a sparse one
+// this functionality is accessed through 'full'
+Matrix
+octave_sparse::matrix_value (bool = false) const {
+   DEBUGMSG("sparse - matrix_value");
+   Matrix M= oct_sparse_to_full( X );
+   return M;
+}
+
+octave_value octave_sparse::uminus (void) const {
+   DEFINE_SP_POINTERS_REAL( X )
+   int nnz= NCFX->nnz;
+
+   double *coefB = doubleMalloc(nnz);
+   int *   ridxB = intMalloc(nnz);
+   int *   cidxB = intMalloc(X.ncol+1);
+
+   for ( int i=0; i<=Xnc; i++) 
+      cidxB[i]=  cidxX[i];
+
+   for ( int i=0; i< nnz; i++) {
+      coefB[i]= -coefX[i];
+      ridxB[i]=  ridxX[i];
+   }
+   
+   SuperMatrix B= create_SuperMatrix( Xnr, Xnc, nnz, coefB, ridxB, cidxB );
+   return new octave_sparse ( B );
+} // octave_value uminus (void) const {
+
+UNOPDECL (uminus, a ) 
+{ 
+   DEBUGMSG("sparse - uminus");
+   CAST_UNOP_ARG (const octave_sparse&); 
+   return v.uminus();
+}   
+
+SuperMatrix
+oct_sparse_transpose ( SuperMatrix X ) {
+   DEFINE_SP_POINTERS_REAL( X )
+   int nnz= NCFX->nnz;
+
+   DECLARE_SP_POINTERS_REAL( B )
+
+   dCompRow_to_CompCol( Xnc, Xnr, nnz, coefX, ridxX, cidxX,
+                             &coefB, &ridxB, &cidxB);
+   
+   SuperMatrix B= create_SuperMatrix( Xnc, Xnr, nnz, coefB, ridxB, cidxB );
+   return B;
+}   
+
+octave_value octave_sparse::transpose (void) const {
+   return new octave_sparse ( oct_sparse_transpose( X ) );
+} // octave_sparse::transpose (void) const {
+
+UNOPDECL (transpose, a)
+{
+   DEBUGMSG("sparse - transpose");
+   CAST_UNOP_ARG (const octave_sparse&); 
+   return v.transpose();
+} // transpose
+
+// hermitian is same as transpose for real sparse
+UNOPDECL (hermitian, a)
+{
+   DEBUGMSG("sparse - hermitian");
+   CAST_UNOP_ARG (const octave_sparse&); 
+   return v.transpose();
+} // hermitian
+
+typedef struct { long val;
+                 long idx; } sort_idx;   
+// comparison function for sort in index
+static inline int
+ixp_comp(const void *i,const void*j )
+{
+   return (((sort_idx *) i)->val) - (((sort_idx *) j)->val);
+}
+
+// generates a sort of idxv with the sort index
+// note that sidx[] must have space for idxv.length elements
+static inline void
+sort_with_idx (sort_idx * sidx, const idx_vector& idxv, long ixl) 
+{
+   if (idxv.is_colon() ) {
+      for (int i=0; i< ixl; i++) {
+         sidx[i].val= i;
+         sidx[i].idx= i;
+      }
+   }
+   else {
+      for (int i=0; i< ixl; i++) {
+         sidx[i].val= idxv(i);
+         sidx[i].idx= i;
+      }
+
+      qsort( sidx, ixl, sizeof(sort_idx), ixp_comp );
+   }
+}   
+
+// Return a full vector output
+// Does it make sense to output a sparse matrix here?
+static ColumnVector
+sparse_index_oneidx ( SuperMatrix X, const idx_vector ix) {
+   DEBUGMSG("sparse_index_oneidx");
+   DEFINE_SP_POINTERS_REAL( X )
+   long      ixl; 
+
+   if (ix.is_colon() ) 
+      ixl= Xnr*Xnc;
+   else  
+      ixl= ix.length(-1); 
+
+   sort_idx ixp[ ixl ];
+   sort_with_idx (ixp, ix, ixl);
+
+   ColumnVector O( ixl );
+   long ip= -Xnr; // previous column position
+   long jj=0,jl=0;
+   for (long k=0; k< ixl; k++) {
+      long ii  = ixp[k].val;
+      long kout= ixp[k].idx;
+
+      if ( ii<0 || ii>=Xnr*Xnc) 
+         SP_FATAL_ERR("invalid matrix index");
+ 
+      int rown= ii/Xnr;
+      if ( rown > ip/Xnr ) { // we've moved to a new column
+         jl= cidxX[rown];
+         jj= cidxX[rown+1];
+      }
+
+      while ( ridxX[jl] < ii%Xnr && jl < jj ) jl++;
+
+      if ( ridxX[jl] == ii%Xnr && jl<jj ) 
+         O( kout ) = coefX[jl] ;
+      else
+         O( kout ) = 0 ;
+
+      ip=ii;
+   }
+   return O;
+} // sparse_index_oneidx (
+
+
+static SuperMatrix
+sparse_index_twoidx ( SuperMatrix X,
+                      const idx_vector ix,
+                      const idx_vector jx) {
+   DEBUGMSG("sparse_index_twoidx");
+   DEFINE_SP_POINTERS_REAL( X )
+
+   int ixl,jxl;
+   if (ix.is_colon() )      ixl= Xnr;
+   else                     ixl= ix.length(-1); 
+
+   if (jx.is_colon() )      jxl= Xnc;
+   else                     jxl= jx.length(-1); 
+
+   sort_idx ixp[ ixl ];
+   sort_with_idx (ixp, ix, ixl);
+
+   // extimate the nnz in the output matrix
+   int nnz = (int) ceil( (NCFX->nnz) * (1.0*ixl / Xnr) * (1.0*jxl / Xnc) ); 
+
+   double * coefB = doubleMalloc(nnz);
+   int    * ridxB = intMalloc   (nnz);
+   int    * cidxB = intMalloc   (jxl+1);  cidxB[0]= 0;
+
+   double tcol[ixl];  // a column of the extracted matrix
+
+   int cx= 0, ll=0;
+   int ip= -Xnc; // previous column position
+   for (int l=0; l< jxl; l++) {
+      if (jx.is_colon() )    ll= l;
+      else                   ll= jx(l);
+
+      if ( ll<0 || ll>=Xnc) 
+            SP_FATAL_ERR("invalid matrix index (x index)");
+
+      int jl= cidxX[ll];
+      int jj= cidxX[ll+1];
+      for (long k=0; k< ixl; k++) {
+         long ii  = ixp[k].val;
+         long kout= ixp[k].idx;
+   
+         if ( ii<0 || ii>=Xnr) 
+            SP_FATAL_ERR("invalid matrix index (x index)");
+
+         while ( ridxX[jl] < ii && jl < jj ) jl++;
+
+
+         if ( ridxX[jl] == ii && jl<jj ) 
+            tcol[ kout ] = coefX[jl] ;
+         else
+            tcol[ kout ] = 0 ;
+
+         ip=ii;
+   
+      } // for k
+      for (int j=0; j<ixl; j++) {
+         if (tcol[j] !=0 ) {
+            check_bounds( cx, nnz, ridxB, coefB );
+            ridxB[cx]= j;
+            coefB[cx]= tcol[j];
+            cx++;
+         }
+      }
+      cidxB[l+1]= cx;
+   } // for l
+
+   maybe_shrink( cx, nnz, ridxB, coefB );
+
+   SuperMatrix B= create_SuperMatrix( ixl, jxl, cx, coefB, ridxB, cidxB );
+   return B;                          
+} // sparse_index_twoidx (
+
+// indexing operations
+octave_value_list
+octave_sparse::do_multi_index_op (int, const octave_value_list& idx) 
+{
+   DEBUGMSG("sparse - index op");
+   octave_value retval;
+   
+   if ( idx.length () == 1) {
+      const idx_vector ix = idx (0).index_vector ();
+      ColumnVector O= sparse_index_oneidx( X, ix );
+
+      // the rules are complicated here X(Y):
+      // X is matrix: result is same shape as Y
+      // X is vector: result is same orientation as X
+      // X is scalar: result is column orientation
+
+// printf("idx(0) [%d x %d]\n", idx(0).rows(), idx(0).columns() );
+      if (1)  retval= O;
+      else                         retval= O.transpose();
+   } else
+   if ( idx.length () == 2) {
+      const idx_vector ix = idx (0).index_vector ();
+      const idx_vector jx = idx (1).index_vector ();
+
+      retval= new octave_sparse ( 
+                  sparse_index_twoidx ( X, ix, jx ));
+   } else
+      SP_FATAL_ERR("need 1 or 2 indices for sparse indexing operations");
+
+   return retval;
+} // octave_sparse::do_index_op
+
+
+octave_value
+octave_sparse::extract (int r1, int c1, int r2, int c2) const {
+   DEBUGMSG("sparse - extract");
+   DEFINE_SP_POINTERS_REAL( X )
+
+// estimate the nnz needed is the A->nnz times the
+//  fraction of the matrix selected
+   if (r1 > r2) { int tmp = r1; r1 = r2; r2 = tmp; }
+   if (c1 > c2) { int tmp = c1; c1 = c2; c2 = tmp; }
+   int m= r1-r2+1;
+   int n= c1-c2+1;
+
+   int nnz = (int) ceil( (NCFX->nnz) * (1.0*m / Xnr)
+                                     * (1.0*n / Xnc) ); 
+
+   double * coefB = doubleMalloc(nnz);
+   int    * ridxB = intMalloc   (nnz);
+   int    * cidxB = intMalloc   (n+1);  cidxB[0]= 0;
+
+   int cx= 0;
+   for (int i=0, ii= c1; i < n ; i++, ii++) {
+      for ( int j= cidxX[ii]; j< cidxX[ii+1]; j++) {
+         int row = ridxX[ j ];
+         if ( row>= r1 && row<=r2 && coefX[j] !=0 ) {
+            check_bounds( cx, nnz, ridxB, coefB );
+            ridxB[ cx ]= row - r1;
+            coefB[ cx ]= coefX[ j ];
+            cx++;
+         } // if row
+      } //for j
+
+      cidxX[i+1] = cx;
+   } // for ( i=0
+
+   maybe_shrink( cx, nnz, ridxX, coefX );
+
+   SuperMatrix B= create_SuperMatrix( m, n, cx, coefB, ridxB, cidxB );
+   return new octave_sparse ( B );
+} // octave_sparse::extract (int r1, int c1, int r2, int c2) const {
+
+void
+octave_sparse::print (ostream& os, bool pr_as_read_syntax ) const
+{
+   DEBUGMSG("sparse - print");
+#if 0
+// I find the SuperLU print function to be ugly and clumsy
+   dPrint_CompCol_Matrix("octave sparse", &X);
+#else      
+   DEFINE_SP_POINTERS_REAL( X )
+   int nnz = NCFX->nnz;
+   
+   os << "Compressed Column Sparse (rows=" << Xnr <<
+                                 ", cols=" << Xnc <<
+                                 ", nnz=" << nnz << ")\n";
+   // add one to the printed indices to go from
+   //  zero-based to one-based arrays
+   for (int j=0; j< Xnc; j++) 
+      for (int i= cidxX[j]; i< cidxX[j+1]; i++) 
+         os << "  (" << ridxX[i]+1 <<
+               " , "  << j+1 << ") -> " << coefX[i] << "\n";
+#endif                  
+} // print
+
+//
+// sparse by scalar  operations
+//
+
+octave_value
+sparse_scalar_multiply (const octave_sparse& spar,
+                        const octave_scalar& scal)
+{
+  DEBUGMSG("sparse - sparse_scalar_multiply");
+  double s= scal.scalar_value();
+
+  SuperMatrix X= spar.super_matrix();
+  DEFINE_SP_POINTERS_REAL( X )
+  int nnz= NCFX->nnz;
+
+  double *coefB = doubleMalloc(nnz);
+  int *   ridxB = intMalloc(nnz);
+  int *   cidxB = intMalloc(X.ncol+1);
+
+  for ( int i=0; i<=Xnc; i++)
+     cidxB[i]=  cidxX[i];
+
+  for ( int i=0; i< nnz; i++) {
+     coefB[i]=  coefX[i] * s;
+     ridxB[i]=  ridxX[i];
+  }
+
+  SuperMatrix B= create_SuperMatrix( Xnr, Xnc, nnz, coefB, ridxB, cidxB );
+  return new octave_sparse ( B );
+}
+
+DEFBINOP (s_n_mul, sparse, scalar) {
+  CAST_BINOP_ARGS (const octave_sparse&, const octave_scalar&);
+  return sparse_scalar_multiply (v1, v2);
+}  
+
+DEFBINOP (n_s_mul, scalar, sparse) {
+  CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse&);
+  return sparse_scalar_multiply (v2, v1);
+}  
+
+DEFBINOP (s_n_div, sparse, scalar) {
+  CAST_BINOP_ARGS (const octave_sparse&, const octave_scalar&);
+  double d = v2.scalar_value ();
+  if (d == 0) gripe_divide_by_zero ();
+
+  return sparse_scalar_multiply (v1, 1 / d);
+}  
+
+DEFBINOP (n_s_ldiv, scalar, sparse) {
+  CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse&);
+  double d = v1.scalar_value ();
+  if (d == 0) gripe_divide_by_zero ();
+
+  return sparse_scalar_multiply (v2, 1 / d);
+}  
+
+//
+// sparse by matrix  operations
+//
+
+
+DEFBINOP( s_s_add, sparse, sparse)
+{
+   DEBUGMSG("sparse - s_s_add");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( double,  + , 1 )
+   return new octave_sparse ( X );
+}
+
+DEFBINOP( s_s_sub, sparse, sparse)
+{
+   DEBUGMSG("sparse - s_s_sub");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( double,  - , 1 )
+   return new octave_sparse ( X );
+}
+
+// only implement comparison operators >, < , and !=
+// the others will return full matrices
+
+DEFBINOP( s_s_gt, sparse, sparse)
+{
+   DEBUGMSG("sparse - s_s_gt");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( double,  > , 1 )
+   return new octave_sparse ( X );
+}
+
+DEFBINOP( s_s_lt, sparse, sparse)
+{
+   DEBUGMSG("sparse - s_s_lt");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( double,  < , 1 )
+   return new octave_sparse ( X );
+}
+
+DEFBINOP( s_s_ne, sparse, sparse)
+{
+   DEBUGMSG("sparse - s_s_ne");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   int nnz = NCFA->nnz + NCFB->nnz ; // nnz must be <= nnzA + nnzB
+   SPARSE_EL_OP ( double, != , 1 )
+   return new octave_sparse ( X );
+}
+
+//
+// Element multiply sparse by full, return a sparse matrix
+//
+DEFBINOP( s_f_el_mul, sparse, matrix )
+{
+   DEBUGMSG("sparse - s_f_el_mul");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_matrix&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   const Matrix B= v2.matrix_value(); int Bnr= B.rows(); int Bnc= B.cols();
+   int nnz= NCFA->nnz;
+   SPARSE_MATRIX_EL_OP( double , * )
+   return new octave_sparse ( X );
+}   
+
+DEFBINOP( f_s_el_mul, matrix, sparse )
+{
+   DEBUGMSG("sparse - f_s_el_mul");
+   CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse&);
+   SuperMatrix  A= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   const Matrix B= v1.matrix_value(); int Bnr= B.rows(); int Bnc= B.cols();
+   int nnz= NCFA->nnz;
+   SPARSE_MATRIX_EL_OP( double , * )
+   return new octave_sparse ( X );
+}   
+   
+//
+// Element multiply sparse by sparse, return a sparse matrix
+//
+DEFBINOP( s_s_el_mul, sparse, sparse)
+{
+   DEBUGMSG("sparse - s_s_el_mul");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_sparse&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   int nnz = MIN( NCFA->nnz , NCFB->nnz );
+   SPARSE_EL_OP ( double,  * , 0 )
+   return new octave_sparse ( X );
+}
+
+
+//
+// Multiply sparse by full, return a full matrix
+//  (I suppose it's possible that in some cases it makes
+//   more sense to return a sparse matrix, but offhand,
+//   I can't imagine any real examples. Email me if you can.)
+
+DEFBINOP( s_f_mul, sparse, matrix)
+{
+   DEBUGMSG("sparse - s_f_mul");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_matrix&);
+   SuperMatrix  A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   const Matrix B= v2.matrix_value(); int Bnr= B.rows(); int Bnc= B.cols();
+   SPARSE_MATRIX_MUL( Matrix, double )
+   return X;
+}   
+
+DEFBINOP( f_s_mul, matrix, sparse)
+{
+   DEBUGMSG("sparse - f_s_mul");
+   CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse&);
+   const Matrix A= v1.matrix_value(); int Anr= A.rows(); int Anc= A.cols();
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   MATRIX_SPARSE_MUL( Matrix, double )
+   return X;
+}   
+
+
+#if 0
+// I would have thought this was a fairly efficient
+// s_s multiply - but it's 10 times worse than the other
+// TODO - figure out why
+
+DEFBINOP( s_s_mul, sparse, sparse)
+{
+   DEBUGMSG("sparse - s_s_mul");
+
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_sparse&);
+   SuperMatrix   T= v1.super_matrix();
+   DEFINE_SP_POINTERS_REAL( T )
+   DECLARE_SP_POINTERS_REAL( A )
+   dCompRow_to_CompCol( Tnc, Tnr, NCFT->nnz, coefT, ridxT, cidxT,
+                             &coefA, &ridxA, &cidxA);
+   int Anr= Tnc; int Anc= Tnr;                             
+ 
+   SuperMatrix   B= v2.super_matrix();
+   DEFINE_SP_POINTERS_REAL( B )
+   DECLARE_SP_POINTERS_REAL( X )
+
+   assert (Anr == Bnr ); // since A = T'
+
+// A fairly arbitrary estimate for the nnz   
+   int nnz =  NCFT->nnz + NCFB->nnz ;
+   ridxX = intMalloc   (nnz);
+   coefX = doubleMalloc(nnz);
+   cidxX = intMalloc   (Bnc+1);  cidxX[0]= 0;
+
+   int jx= 0;
+   for (int j= 0 ; j < Bnc ; j++ ) {
+      for (int i= 0 ; i < Anc ; i++ ) {
+         int  ja= cidxA[ i ];
+         int  ja_max= cidxA[ i+1 ];
+         bool ja_lt_max= ja < ja_max;
+         int  ridxA_ja= ridxA[ ja ];
+       
+         int  jb= cidxB[ j ];
+         int  jb_max= cidxB[ j+1 ];
+         bool jb_lt_max= jb < jb_max;
+         int  ridxB_jb= ridxB[ jb ];
+       
+         double tmpval= 0.0;
+         while( ja_lt_max && jb_lt_max ) {
+       
+            if( ridxA_ja < ridxB_jb )
+            {
+               ja++; ridxA_ja= ridxA[ ja ]; ja_lt_max= ja < ja_max;
+            } else
+            if( ridxB_jb < ridxA_ja)
+            {
+               jb++; ridxB_jb= ridxB[ jb ]; jb_lt_max= jb < jb_max;
+            } else
+            {
+               assert( ridxA_ja == ridxB_jb );
+               tmpval+= coefA[ ja ] * coefB[ jb ];
+               ja++; ridxA_ja= ridxA[ ja ]; ja_lt_max= ja < ja_max;
+               jb++; ridxB_jb= ridxB[ jb ]; jb_lt_max= jb < jb_max;
+            }
+         } 
+
+         if (tmpval != 0.0) {
+            check_bounds( jx, nnz, ridxX, coefX );
+            coefX[ jx ] = tmpval;
+            ridxX[ jx ] = i;
+            jx++;
+         }
+       
+      }
+      cidxX[j+1] = jx; 
+   }
+
+   maybe_shrink( jx, nnz, ridxX, coefX );
+   SuperMatrix  X= create_SuperMatrix( Anc, Bnc, jx, coefX, ridxX, cidxX );
+   return new octave_sparse ( X );
+} // s_s_mul (const octave_value& a1, const octave_value& a2)
+#endif
+
+DEFBINOP( s_s_mul, sparse, sparse)
+{
+   DEBUGMSG("sparse - s_s_mul");
+   CAST_BINOP_ARGS (const octave_sparse&, const octave_sparse&);
+   SuperMatrix   A= v1.super_matrix(); DEFINE_SP_POINTERS_REAL( A )
+   SuperMatrix   B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   SPARSE_SPARSE_MUL( double )
+   return new octave_sparse ( X );
+}
+
+// TODO: This isn't an efficient solution
+//  to take the inverse and multiply,
+//  on the other hand, I can rarely see this being
+//  a useful thing to do anyway
+DEFBINOP( f_s_ldiv, matrix, sparse) {
+   DEBUGMSG("sparse - f_s_ldiv");
+   CAST_BINOP_ARGS ( const octave_matrix&, const octave_sparse&);
+   const Matrix A= v1.matrix_value().inverse();
+   int Anr= A.rows(); int Anc= A.cols();
+   SuperMatrix  B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+   MATRIX_SPARSE_MUL( Matrix, double )
+   return X;
+} // f_s_ldiv 
+
+// sparse \ sparse solve
+//
+// Note: there are more efficient implemetations,
+//       but this works 
+//
+// There is a wierd problem here,
+// it should be possible to multiply s=r*v2;
+// but that doesn't work
+//
+// TODO: the casting here is pretty hideous
+DEFBINOP( s_s_ldiv, sparse, sparse) {
+   DEBUGMSG("sparse - s_s_ldiv");
+   CAST_BINOP_ARGS ( const octave_sparse&, const octave_sparse&);
+   SuperMatrix   S= v1.super_matrix();
+   SuperMatrix   B= v2.super_matrix(); DEFINE_SP_POINTERS_REAL( B )
+// octave_value  B= new octave_sparse( v2.super_matrix() );
+   int n = S.ncol;
+   int perm_c[n];
+   int permc_spec=3;
+   octave_value_list Si= oct_sparse_inverse( S, perm_c, permc_spec );
+   octave_value inv= Si(0)*Si(1)*Si(2)*Si(3);
+   const octave_value& rep = inv.get_rep ();
+   SuperMatrix A = ((const octave_sparse&) rep) . super_matrix ();
+   DEFINE_SP_POINTERS_REAL( A )
+   SPARSE_SPARSE_MUL( double )
+   return new octave_sparse ( X );
+} // f_s_ldiv 
+
+
+// This is a wrapper around the SuperLU get_perm_c function
+//  that does some bug fixes and allows extra conditions
+//
+// Get column permutation vector perm_c[], according to permc_spec:
+//   permc_spec = 0: use the natural ordering 
+//   permc_spec = 1: use minimum degree ordering on structure of A'*A
+//   permc_spec = 2: use minimum degree ordering on structure of A'+A
+//   permc_spec = 3: use column approximate minimum degree
+//    	
+// my guesses on the choice of permc_spec
+//           ==1 the recomended choice for arbitrary matrices,
+//           ==2 for matrices close to structurally symetrical
+//           ==3 what Matlab seems to use 
+//
+// if permc_spec== -1, then there is a user specified permc provided
+//
+void oct_sparse_do_permc( int permc_spec, int perm_c[], 
+                     SuperMatrix A ) {
+   int Anr= A.nrow;
+   int Anc= A.ncol;
+
+   if ( permc_spec < 0 ) {
+      SP_FATAL_ERR("sparse solve: haven't implemented user specified permc");
+//    perm_c = perm_c_in;
+   } 
+   else {
+//
+// KLUDGE: get_perm_c breaks (ie segfaults) if the Matrix is not
+// sufficiently sparse. It seems that this is when nnz > 0.4*(m*n)
+//
+// So we check for this case and substitute a perm_c with no
+// reordering (You don't really want to use Sparse Matrices in
+// this case anyway, but at least the tool shouldn't break)
+//
+#ifdef VERBOSE   
+   printf("sparse ratio %d : %d -> %f \n:", 
+           ((NCformat *) A.Store)->nnz , (Anc*Anr)   ,   
+  (double) ((NCformat *) A.Store)->nnz / (Anc*Anr) );
+#endif // VERBOSE   
+
+      if ( ((NCformat *) A.Store)->nnz >= 0.40*(Anc*Anr) )  {
+         for (int i=0 ; i< Anc ; i++)
+            perm_c[i]= i;
+      } else {
+         get_perm_c(permc_spec, &A, perm_c);
+      }
+   }
+} // static int do_permc( int permc_spec, int permc[], 
+
+// 
+// Sparse \ Full solve
+// TODO: SuperMatrix provides more functionality into a solvex
+//       routine, but how to we implement this in octave?
+//
+//static octave_value
+//s_f_ldiv (const octave_value& a1, const octave_value& a2)
+DEFBINOP( s_f_ldiv, sparse, matrix)
+{
+   DEBUGMSG("sparse - s_f_ldiv");
+
+   CAST_BINOP_ARGS ( const octave_sparse&, const octave_matrix&);
+   SuperMatrix   A= v1.super_matrix();
+         Matrix  M= v2.matrix_value();
+   int Anr= A.nrow;
+   int Anc= A.ncol;
+   int Bnr= M.rows();
+   int Bnc= M.cols();
+
+   if (Anc != Bnr) {
+      gripe_nonconformant ("operator \\", Anr, Anc, Bnr, Bnc);
+   } else {
+      assert (Anc == Bnr);
+      SuperMatrix L,U,B;
+      double * coef= M.fortran_vec();
+   
+      dCreate_Dense_Matrix(&B, Bnr, Bnc, coef, Bnr, DN, _D, GE);
+   
+      int permc_spec = 3;
+      int perm_c[ Anc ];
+      int perm_r[ Anr ];
+      oct_sparse_do_permc( permc_spec, perm_c, A );
+   
+      int info;
+      dgssv(&A, perm_c, perm_r, &L, &U, &B, &info);
+   
+      if (info !=0 )
+         SP_FATAL_ERR("Factorization problem: dgssv");
+   
+      Destroy_SuperMatrix_Store( &B );
+      oct_sparse_Destroy_SuperMatrix( L ) ;
+      oct_sparse_Destroy_SuperMatrix( U ) ;
+   }
+
+   return M;
+}
+
+SuperMatrix oct_matrix_to_sparse(const Matrix & A) {      
+   DEBUGMSG("sparse - matrix_to_sparse");
+   int Anr= A.rows();
+   int Anc= A.cols();
+   MATRIX_TO_SPARSE( double )
+   return X;
+}
+
+#if 0
+// Calculate nnz
+   int nnz=0;
+   for (int j= 0; j<n ; j++ ) 
+      for (int i= 0; i<m ; i++ ) 
+         if (A(i,j) !=0) nnz++;
+       
+// if (nnz==0) SP_FATAL_ERR("sparse: can't handle empty sparse (yet)");
+
+   double * coef = (double *) malloc ( nnz * sizeof(double) );
+   int    * ridx = (int    *) malloc ( nnz * sizeof(int) );
+   int    * cidx = (int    *) malloc ((n+1)* sizeof(int) );  cidx[0]= 0;
+
+   int cx=0;
+   for (int j= 0; j<n ; j++ ) {
+      for (int i= 0; i<m ; i++ ) {
+         double tmpval= A(i,j);
+         if (tmpval != 0) {
+            ridx[ cx ]= i;
+            coef[ cx ]= tmpval;
+            cx++;
+         } // if tmpval
+      } // for i
+      cidx[j+1]= cx;
+   } // for i
+
+   SuperMatrix S= create_SuperMatrix( m, n, cx, coef, ridx, cidx );
+   return S;
+#endif   
+
+void install_sparse_ops() {
+   //
+   // unitary operations
+   //
+   INSTALL_UNOP  (op_transpose, octave_sparse, transpose);
+   INSTALL_UNOP  (op_hermitian, octave_sparse, hermitian);
+   INSTALL_UNOP  (op_uminus,    octave_sparse, uminus);
+
+   //
+   // binary operations: sparse with scalar
+   //
+   INSTALL_BINOP (op_mul,      octave_sparse, octave_scalar, s_n_mul);
+   INSTALL_BINOP (op_mul,      octave_scalar, octave_sparse, n_s_mul);
+   INSTALL_BINOP (op_el_mul,   octave_sparse, octave_scalar, s_n_mul);
+   INSTALL_BINOP (op_el_mul,   octave_scalar, octave_sparse, n_s_mul);
+
+   INSTALL_BINOP (op_div,      octave_sparse, octave_scalar, s_n_div);
+   INSTALL_BINOP (op_ldiv,     octave_scalar, octave_sparse, n_s_ldiv);
+
+   //
+   // binary operations: sparse with matrix 
+   //  and sparse with sparse
+   //
+   INSTALL_BINOP (op_gt ,      octave_sparse, octave_sparse, s_s_gt);
+   INSTALL_BINOP (op_lt ,      octave_sparse, octave_sparse, s_s_lt);
+   INSTALL_BINOP (op_ne ,      octave_sparse, octave_sparse, s_s_ne);
+
+   INSTALL_BINOP (op_ldiv,     octave_sparse, octave_matrix, s_f_ldiv);
+   INSTALL_BINOP (op_ldiv,     octave_matrix, octave_sparse, f_s_ldiv);
+   INSTALL_BINOP (op_ldiv,     octave_sparse, octave_sparse, s_s_ldiv);
+   INSTALL_BINOP (op_add,      octave_sparse, octave_sparse, s_s_add);
+   INSTALL_BINOP (op_sub,      octave_sparse, octave_sparse, s_s_sub);
+   INSTALL_BINOP (op_el_mul,   octave_matrix, octave_sparse, f_s_el_mul);
+   INSTALL_BINOP (op_el_mul,   octave_sparse, octave_matrix, s_f_el_mul);
+   INSTALL_BINOP (op_el_mul,   octave_sparse, octave_sparse, s_s_el_mul);
+   INSTALL_BINOP (op_mul,      octave_sparse, octave_matrix, s_f_mul);
+   INSTALL_BINOP (op_mul,      octave_matrix, octave_sparse, f_s_mul);
+   INSTALL_BINOP (op_mul,      octave_sparse, octave_sparse, s_s_mul);
+}
+
+/*
+ * $Log$
+ * Revision 1.1  2001/10/10 19:54:49  pkienzle
+ * Initial revision
+ *
+ * Revision 1.7  2001/04/04 02:13:46  aadler
+ * complete complex_sparse, templates, fix memory leaks
+ *
+ * Revision 1.6  2001/03/30 04:36:30  aadler
+ * added multiply, solve, and sparse creation
+ *
+ * Revision 1.5  2001/03/27 03:45:20  aadler
+ * use templates for mul, add, sub, el_mul operations
+ *
+ * Revision 1.4  2001/03/15 15:47:58  aadler
+ * cleaned up duplicated code by using "defined" templates.
+ * used default numerical conversions
+ *
+ * Revision 1.3  2001/03/06 03:20:12  aadler
+ * added automatic numeric_conversion_function
+ *
+ * Revision 1.2  2001/02/27 03:01:52  aadler
+ * added rudimentary complex matrix support
+ *
+ * Revision 1.1  2000/12/18 03:31:16  aadler
+ * Split code to multiple files
+ * added sparse inverse
+ *
+ */
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/sparse_ops.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,285 @@
+/*
+
+Copyright (C) 1999 Andy Adler
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Octave; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+$Id$
+
+$Log$
+Revision 1.1  2001/10/10 19:54:49  pkienzle
+Initial revision
+
+Revision 1.2  2001/04/04 02:13:46  aadler
+complete complex_sparse, templates, fix memory leaks
+
+Revision 1.1  2001/03/30 04:34:23  aadler
+"template" functions for sparse operations
+
+
+*/
+
+
+// I would like to do this with templates,
+// but I don't think you can specify operators
+//
+// TYPX -> output type ( Complex or double)
+// _OP_ -> operation to implement ( + , - , != , .* )
+// A_B_INTERACT -> evaluate operations where A or B ==0 
+//
+// I'm assuming that compiler optimization will remove
+// the if (0) and x+0 operations
+#define SPARSE_EL_OP( TYPX, _OP_, A_B_INTERACT ) \
+   SuperMatrix X; \
+   if ( (Anc != Bnc) || (Anr != Bnr) ) { \
+      gripe_nonconformant ("operator " #_OP_, Anr, Anc, Bnr, Bnc); \
+   } else { \
+      assert(Anr == Bnr); assert(Anc == Bnc); \
+      TYPX* coefX= (TYPX*)malloc( nnz  * sizeof(TYPX)); \
+      int * ridxX= (int *)malloc( nnz  * sizeof(int) ); \
+      int * cidxX= (int *)malloc((Anc+1)*sizeof(int)); cidxX[0]= 0; \
+ \
+      int jx= 0; \
+      for (int i= 0 ; i < Anc ; i++ ) { \
+         int  ja= cidxA[ i ]; \
+         int  ja_max= cidxA[ i+1 ]; \
+         bool ja_lt_max= ja < ja_max; \
+         int  ridxA_ja= ridxA[ ja ]; \
+ \
+         int  jb= cidxB[ i ]; \
+         int  jb_max= cidxB[ i+1 ]; \
+         bool jb_lt_max= jb < jb_max; \
+         int  ridxB_jb= ridxB[ jb ]; \
+ \
+         while( ja_lt_max || jb_lt_max ) { \
+            if( ( !jb_lt_max ) || \
+                ((ridxA_ja < ridxB_jb) && ja_lt_max ) ) \
+            { \
+               if (A_B_INTERACT) { \
+                  ridxX[ jx ] = ridxA_ja; \
+                  coefX[ jx ] = coefA[ ja ] _OP_ 0.0; \
+                  jx++; \
+               } \
+               ja++; ridxA_ja= ridxA[ ja ]; ja_lt_max= ja < ja_max; \
+            } else \
+            if( ( !ja_lt_max ) || \
+               ((ridxB_jb < ridxA_ja) && jb_lt_max ) ) \
+            { \
+               if (A_B_INTERACT) { \
+                  ridxX[ jx ] = ridxB_jb; \
+                  coefX[ jx ] = 0.0 _OP_ coefB[ jb ]; \
+                  jx++; \
+               } \
+               jb++; ridxB_jb= ridxB[ jb ]; jb_lt_max= jb < jb_max; \
+            } else \
+            { \
+               assert( ridxA_ja == ridxB_jb ); \
+               TYPX tmpval= coefA[ ja ] _OP_ coefB[ jb ]; \
+               if (tmpval !=0.0) { \
+                  coefX[ jx ] = tmpval; \
+                  ridxX[ jx ] = ridxA_ja; \
+                  jx++; \
+               } \
+               ja++; ridxA_ja= ridxA[ ja ]; ja_lt_max= ja < ja_max; \
+               jb++; ridxB_jb= ridxB[ jb ]; jb_lt_max= jb < jb_max; \
+            } \
+         }  \
+         cidxX[i+1] = jx;  \
+      } \
+      maybe_shrink( jx, nnz, ridxX, coefX ); \
+      X= create_SuperMatrix( Anr, Anc, jx, coefX, ridxX, cidxX ); \
+   }
+
+
+#define SPARSE_MATRIX_EL_OP( TYPX, _OP_ ) \
+   SuperMatrix X; \
+   if ( (Anc != Bnc) || (Anr != Bnr) ) { \
+      gripe_nonconformant ("operator .*", Anr, Anc, Bnr, Bnc); \
+   } else { \
+      assert(Anr == Bnr); assert(Anc == Bnc); \
+      TYPX* coefX= (TYPX*)malloc( nnz  * sizeof(TYPX)); \
+      int * ridxX= (int *)malloc( nnz  * sizeof(int) ); \
+      int * cidxX= (int *)malloc((Anc+1)*sizeof(int)); cidxX[0]= 0; \
+ \
+      int cx= 0; \
+      for (int i=0; i < Anc ; i++) { \
+         for (int j= cidxA[i]  ; \
+                  j< cidxA[i+1]; j++) { \
+            int  rowidx = ridxA[j]; \
+            TYPX tmpval = B(rowidx,i); \
+            if (tmpval != 0.0) { \
+               ridxX[ cx ] = rowidx; \
+               coefX[ cx ] = tmpval * coefA[ j ]; \
+               cx++; \
+            } \
+         } \
+         cidxX[i+1] = cx;  \
+      } \
+      maybe_shrink( cx, nnz, ridxX, coefX ); \
+      X= create_SuperMatrix( Anr, Anc, cx, coefX, ridxX, cidxX ); \
+   }
+
+// multiply type ops
+#define SPARSE_MATRIX_MUL( TYPM, TYPX) \
+   TYPM X (Anr , Bnc);  \
+   if (Anc != Bnr) { \
+      gripe_nonconformant ("operator *", Anr, Anc, Bnr, Bnc); \
+   } else { \
+      assert (Anc == Bnr); \
+      for (int i=0; i< Anr; i++ ) \
+         for (int j=0; j< Bnc; j++ ) \
+            X.elem(i,j)=0; \
+      for ( int i=0; i < Anc ; i++) { \
+         for ( int j= cidxA[i]; j< cidxA[i+1]; j++) { \
+            int  col = ridxA[j]; \
+            TYPX tmpval = coefA[j]; \
+            for ( int k=0 ; k< Bnc; k++) { \
+               X.elem(col , k)+= tmpval * B(i,k); \
+            } \
+         } \
+      } \
+   }
+
+#define MATRIX_SPARSE_MUL( TYPM, TYPX ) \
+   TYPM X (Anr , Bnc);  \
+   if (Anc != Bnr) { \
+      gripe_nonconformant ("operator *", Anr, Anc, Bnr, Bnc); \
+   } else { \
+      assert (Anc == Bnr); \
+      for (int i=0; i< Anr; i++ ) \
+         for (int j=0; j< Bnc; j++ ) \
+            X.elem(i,j)=0; \
+      for ( int i=0; i < Bnc ; i++) { \
+         for ( int j= cidxB[i]; j< cidxB[i+1]; j++) { \
+            int  col = ridxB[j]; \
+            TYPX tmpval = coefB[j]; \
+            for ( int k=0 ; k< Anr; k++) { \
+               X(k, i)+= A(k,col) * tmpval; \
+            } \
+         } \
+      } \
+   }
+
+//
+// Multiply sparse by sparse, element by element
+// This algorithm allocates a full column of the output
+// matrix. Hopefully that won't be a storage problem.
+//
+// TODO: allocate a row or column depending on the larger
+//       dimention.
+//
+// I'm sure there are good sparse multiplication algorithms
+//   available in the litterature. I invented this one
+//   to fill a gap. Tell me if you know of better ones.
+//
+#define SPARSE_SPARSE_MUL( TYPX ) \
+   SuperMatrix X; \
+   if (Anc != Bnr) { \
+      gripe_nonconformant ("operator *", Anr, Anc, Bnr, Bnc); \
+   } else { \
+      assert (Anc == Bnr ); \
+      int nnz =  NCFA->nnz + NCFB->nnz ; \
+      TYPX* coefX= (TYPX*)malloc( nnz  * sizeof(TYPX)); \
+      int * ridxX= (int *)malloc( nnz  * sizeof(int) ); \
+      int * cidxX= (int *)malloc((Bnc+1)*sizeof(int)); cidxX[0]= 0; \
+ \
+      TYPX * Xcol= (TYPX*)malloc( Anr  * sizeof(TYPX)); \
+      int cx= 0; \
+      for ( int i=0; i < Bnc ; i++) { \
+         for (int k=0; k<Anr; k++) Xcol[k]= 0; \
+         for (int j= cidxB[i]; j< cidxB[i+1]; j++) { \
+            int  col= ridxB[j]; \
+            TYPX tmpval = coefB[j]; \
+            for (int k= cidxA[col] ; k< cidxA[col+1]; k++)  \
+               Xcol[ ridxA[k] ]+= tmpval * coefA[k]; \
+         } \
+         for (int k=0; k<Anr; k++)  \
+            if ( Xcol[k] !=0 ) { \
+               check_bounds( cx, nnz, ridxX, coefX ); \
+               ridxX[ cx ]= k; \
+               coefX[ cx ]= Xcol[k]; \
+               cx++; \
+            } \
+         cidxX[i+1] = cx; \
+      } \
+      free( Xcol ); \
+      maybe_shrink( cx, nnz, ridxX, coefX ); \
+      X= create_SuperMatrix( Anr, Bnc, cx, coefX, ridxX, cidxX ); \
+   } 
+
+// assemble a sparse matrix from elements
+//   called by > 1 args for sparse
+// NOTE: index vectors are 1 based!
+//
+// NOTE2: be careful about when we convert ri to int,
+// otherwise the maximum matrix size will be m*n < maxint/2
+#define ASSEMBLE_SPARSE( TYPX ) \
+   int  nnz= MAX( ridxA.length(), cidxA.length() ); \
+   TYPX* coefX= (TYPX*)malloc( nnz  * sizeof(TYPX)); \
+   int * ridxX= (int *)malloc( nnz  * sizeof(int) ); \
+   int * cidxX= (int *)malloc( (n+1)* sizeof(int)); cidxX[0]= 0; \
+ \
+   bool ri_scalar = (ridxA.length() == 1); \
+   bool ci_scalar = (cidxA.length() == 1); \
+   bool cf_scalar = (coefA.length() == 1); \
+ \
+   sort_idxl idx[ nnz ]; \
+   for (int i=0; i<nnz; i++) { \
+      idx[i].val = (unsigned long) ( \
+                ( ri_scalar ? ridxA(0) : ridxA(i) ) - 1 + \
+           m * (( ci_scalar ? cidxA(0) : cidxA(i) ) - 1) );  \
+      idx[i].idx = i; \
+   } \
+ \
+   qsort( idx, nnz, sizeof(sort_idxl), sidxl_comp ); \
+    \
+   int cx= 0; \
+   for (int i=0; i<nnz; i++) { \
+      unsigned long ii= (int) idx[i].idx; \
+      coefX[i]=      ( cf_scalar ? coefA(0) : coefA(ii) ); \
+      double ri  =   ( ri_scalar ? ridxA(0) : ridxA(ii) ) - 1 ; \
+      ridxX[i]= (int) (ri - ((int) (ri/m))*m ) ; \
+      int ci  = (int)( ci_scalar ? cidxA(0) : cidxA(ii) ) - 1 ; \
+      while( cx < ci ) cidxX[++cx]= i; \
+   } \
+   while( cx < n ) cidxX[++cx]= nnz; \
+ \
+   SuperMatrix X= create_SuperMatrix( m, n, nnz, coefX, ridxX, cidxX );
+
+// assemble a sparse matrix from full
+//   called by one arg for sparse
+// start with an initial estimate for nnz and
+// work with it.
+#define MATRIX_TO_SPARSE( TYPX ) \
+   int nnz= 100; \
+   TYPX * coef = (TYPX *) malloc ( nnz   * sizeof(TYPX) ); \
+   int  * ridx = (int  *) malloc ( nnz   * sizeof(int) ); \
+   int  * cidx = (int  *) malloc ((Anc+1)* sizeof(int) );  cidx[0]= 0; \
+   int jx=0; \
+   for (int j= 0; j<Anc ; j++ ) { \
+      for (int i= 0; i<Anr ; i++ ) { \
+         TYPX tmpval= A(i,j); \
+         if (tmpval != 0) { \
+            check_bounds( jx, nnz, ridx, coef ); \
+            ridx[ jx ]= i; \
+            coef[ jx ]= tmpval; \
+            jx++; \
+         } \
+      } \
+      cidx[j+1]= jx; \
+   } \
+   maybe_shrink( jx, nnz, ridx, coef ); \
+   SuperMatrix X= create_SuperMatrix( Anr, Anc, jx, coef, ridx, cidx );
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/sparse/superlu2.0patch.diff	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,84 @@
+# Patch for SuperLU version 2.0 for the octave spare functions
+# $Id$
+#
+# Instructions:
+#
+# 0. Note, If you got the SuperLU directory with your download,
+#      then you don't need this patch
+#
+# 1. Download SuperLU from one of the following sites
+#                          http://www.netlib.org/scalapack/prototype
+#                          ftp://ftp.cs.berkeley/pub/src/lapack/SuperLU
+#                          http://www.nersc.gov/~xiaoye/SuperLU/
+#
+# 2. Unpack SuperLU into the directory you'll be building the
+#     octave sparse functions from
+#
+# 3. Apply the patch
+#           patch -p0 < superlu2.0patch.diff
+#
+# 4. Build the octave sparse functions
+#           run make in the octave sparse functions directory
+#           NOTE: do not run the SuperLU makefiles - 
+#                it doesn't build the right objects into the library
+#
+diff -Naur SuperLU-v2.0/SRC/get_perm_c.c SuperLU/SRC/get_perm_c.c
+--- SuperLU-v2.0/SRC/get_perm_c.c	Wed Aug 11 13:48:15 1999
++++ SuperLU/SRC/get_perm_c.c	Sat Dec 11 21:10:53 1999
+@@ -373,12 +373,16 @@
+     switch ( ispec ) {
+         case 0: /* Natural ordering */
+ 	      for (i = 0; i < n; ++i) perm_c[i] = i;
++#ifdef VERBOSE                     
+ 	      printf("Use natural column ordering.\n");
++#endif              
+ 	      return;
+         case 1: /* Minimum degree ordering on A'*A */
+ 	      getata(m, n, Astore->nnz, Astore->colptr, Astore->rowind,
+ 		     &bnz, &b_colptr, &b_rowind);
++#ifdef VERBOSE                     
+ 	      printf("Use minimum degree ordering on A'*A.\n");
++#endif              
+ 	      t = SuperLU_timer_() - t;
+ 	      /*printf("Form A'*A time = %8.3f\n", t);*/
+ 	      break;
+@@ -386,14 +390,18 @@
+ 	      if ( m != n ) ABORT("Matrix is not square");
+ 	      a_plus_at(n, Astore->nnz, Astore->colptr, Astore->rowind,
+ 			&bnz, &b_colptr, &b_rowind);
++#ifdef VERBOSE                     
+ 	      printf("Use minimum degree ordering on A'+A.\n");
++#endif
+ 	      t = SuperLU_timer_() - t;
+ 	      /*printf("Form A'+A time = %8.3f\n", t);*/
+ 	      break;
+         case 3: /* Approximate minimum degree column ordering. */
+ 	      get_colamd(m, n, Astore->nnz, Astore->colptr, Astore->rowind,
+ 			 perm_c);
++#ifdef VERBOSE                     
+ 	      printf(".. Use approximate minimum degree column ordering.\n");
++#endif              
+ 	      return; 
+         default:
+ 	      ABORT("Invalid ISPEC");
+diff -Naur SuperLU-v2.0/SRC/util.c SuperLU/SRC/util.c
+--- SuperLU-v2.0/SRC/util.c	Thu Aug  5 15:23:11 1999
++++ SuperLU/SRC/util.c	Sat Dec 11 16:11:26 1999
+@@ -229,6 +229,8 @@
+ void
+ PrintStat(SuperLUStat_t *SuperLUStat)
+ {
++/* mods by aadler, dec 99*/
++#ifdef VERBOSE
+     double         *utime;
+     flops_t        *ops;
+ 
+@@ -243,7 +245,7 @@
+     if ( utime[SOLVE] != 0.0 )
+       printf("Solve flops = %e\tMflops = %8.2f\n", ops[SOLVE],
+ 	     ops[SOLVE]*1e-6/utime[SOLVE]);
+-
++#endif // VERBOSE
+ }
+ 
+ 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/specfun/ellipj.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,190 @@
+## Copyright (C) 2001 David Billinghurst
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or   
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Compute the Jacobi elliptic functions sn(u|m), cn(u|m) and dn(u|m)
+## for argument u and parameter m.
+##
+## usage: [sn,cn,dn] = ellipj(u,m[,tol])
+##
+## u and m must be real arrays of same size.  Either or both can be
+## scalars. m is restricted to 0 <= m <= 1.
+##
+## WARNING: the approximation blows up for abs(U)>20 near m=1.
+##
+## tol is accepted for compatibility, but ignored
+##
+## Ref: Abramowitz, Milton and Stegun, Irene A
+##      Handbook of Mathematical Functions, Dover, 1965
+##      Chapter 16 (Sections 16.4, 16.13 and 16.15)
+##
+## Example
+##    m = linspace(0,1,200); u=linspace(-10,10,200);
+##    M = ones(length(u),1) * m; U = u' * ones(1,length(m));
+##    [sn, cn, dn] = ellipj(U,M);
+##    imagesc(sn);
+##
+## See also: ellipke
+
+## Author: David Billinghurst <David.Billinghurst@riotinto.com>
+## Created: 31 January 2001
+## 2001-02-01 Paul Kienzle
+##   * vectorized
+##   * added demos
+##   * included function name in error messages
+
+function [sn, cn, dn] = ellipj (u, m)
+
+  if nargin < 2 || nargin > 3 
+    usage("[sn, cn, dn] = ellipj (u, m)"); 
+  endif
+  if size(u,1) != size(m,1) || size(u,2) != size(m,2), 
+    error("ellipj must have same shape for u and m");
+  endif
+
+  sn=cn=dn=phi=zeros(size(u));
+  m = m(:); u=u(:);
+
+  if !all(isreal(m) & isreal(u))
+    error("ellipj must have real u and m");
+  endif
+  if any(m < 0.0 | m > 1.0), 
+    error("ellipj must have m in the range [0,1]");
+  endif
+
+  lo = sqrt(eps);
+  hi = 1-sqrt(eps);
+
+  dfi = do_fortran_indexing;
+  unwind_protect
+    do_fortran_indexing = 1;
+  
+    ## For small m, ( Abramowitz and Stegun, Section 16.13 )
+    idx = find(m < lo);
+    if !isempty(idx)
+      uidx = u(idx);
+      midx = m(idx);
+      sin_u = sin(uidx);
+      cos_u = cos(uidx);
+      t = 0.25 * midx .* (uidx - sin_u.*cos_u);
+      sn(idx) = sin_u - t.*cos_u;
+      cn(idx) = cos_u + t.*sin_u;
+      dn(idx) = 1.0 - 0.5*midx.*sin_u.*sin_u;
+    endif
+    
+    ## For m1 = (1-m) small ( Abramowitz and Stegun, Section 16.15 )
+    idx = find( m >= hi );
+    if !isempty(idx)
+      uidx = u(idx);
+      sinh_u = sinh(uidx);
+      cosh_u = cosh(uidx);
+      tanh_u = tanh(uidx);
+      sech_u = 1.0./cosh_u;
+      sechm1over4 = 0.25 * (1.0 - m(idx)) ./ cosh_u;
+      sinhcosh = sinh_u.*cosh_u;
+      sn(idx) = tanh_u + sechm1over4 .* (sinhcosh-uidx) .* sech_u;
+      cn(idx) = sech_u - sechm1over4 .* (sinhcosh-uidx) .* tanh_u;
+      dn(idx) = sech_u + sechm1over4 .* (sinhcosh+uidx) .* tanh_u;
+    endif
+    
+    ## Arithmetic-Geometric Mean (AGM) algorithm
+    ## ( Abramowitz and Stegun, Section 16.4 )
+    idx = find ( lo <= m & m < hi );
+    if !isempty(idx)
+      Nmax = 16;
+      c = a = zeros(length(idx),Nmax);
+      a(:,1) = ones(length(idx),1);
+      b = sqrt(1.0 - m(idx));
+      c(:,1) = sqrt(m(idx));
+      for n = 2:Nmax
+      	a(:,n) = (a(:,n-1) + b) / 2.0;
+      	c(:,n) = (a(:,n-1) - b) / 2.0;
+      	b = sqrt ( a(:,n-1) .* b);
+      	if all (c(:,n)./a(:,n) < eps), break; endif
+      endfor
+      if n >= Nmax
+      	error("ellipj: Not enough workspace"); 
+      endif
+      phi = 2.^(n-1) * a(:,n) .* u(idx);
+      for j=n:-1:2
+      	t = phi;
+      	phi = ( asin ( (c(:,j)./a(:,j)) .* sin(phi)) + phi ) / 2;
+      endfor
+      
+      sn(idx) = sin(phi);
+      cn(idx) = cos(phi);
+      dn(idx) = cos(phi)./cos(t-phi);
+    endif
+  unwind_protect_cleanup
+    do_fortran_indexing = dfi;
+  end_unwind_protect
+endfunction
+
+%!demo
+%! N = 150;
+%! % m = [1-logspace(0,log(eps),N-1), 1]; ## m near 1
+%! % m = [0, logspace(log(eps),0,N-1)];   ## m near 0
+%!   m = linspace(0,1,N);                 ## m equally spaced
+%! u = linspace(-20,20,N);
+%! M = ones(length(u),1) * m;
+%! U = u' * ones(1, length(m));
+%! [sn, cn, dn] = ellipj(U,M);
+%! c = colormap; colormap(hot(64)); 
+%! image(m,u,32*clip(sn,[-1,1])+32,1); 
+%! image(m,u,32*clip(cn,[-1,1])+32,1); 
+%! image(m,u,32*clip(dn,[-1,1])+32,1);
+%! colormap(c);
+
+%!demo
+%! N = 200;
+%! % m = [1-logspace(0,log(eps),N-1), 1]; ## m near 1
+%! % m = [0, logspace(log(eps),0,N-1)];   ## m near 0
+%!   m = linspace(0,1,N);                 ## m equally spaced
+%! u = linspace(0,20,5);
+%! M = ones(length(u),1) * m;
+%! U = u' * ones(1, length(m));
+%! [sn, cn, dn] = ellipj(U,M);
+%! grid("on"); 
+%! subplot(131); title("sn"); semilogx(m, sn, ";;");
+%! subplot(132); title("cn"); semilogx(m, cn, ";;");
+%! subplot(133); title("dn"); semilogx(m, dn, ";;");
+%! oneplot; grid("off"); title("");
+
+%!test
+%! ## Test Jacobi elliptic functions
+%! ## against "exact" solution from Mathematica 3.0
+%! ## David Billinghurst <David.Billinghurst@riotinto.com>
+%! ## 1 February 2001
+%! u = [ 0.25; 0.25; 0.20; 0.20; 0.672; 0.5];
+%! m = [ 0.0;  1.0;  0.19; 0.81; 0.36;  0.9999999999];
+%! S = [ sin(0.25); tanh(0.25);
+%!  0.19842311013970879516;
+%!  0.19762082367187648571;
+%!  0.6095196917919021945;
+%!  0.4621171572617320908 ];
+%! C = [ cos(0.25); sech(0.25);
+%!  0.9801164570409401062;
+%!  0.9802785369736752032;
+%!  0.7927709286533560550;
+%!  0.8868188839691764094 ];
+%! D = [ 1.0;  sech(0.25);
+%!  0.9962526643271134302;
+%!  0.9840560289645665155;
+%!  0.9307281387786906491;
+%!  0.8868188839812167635 ];
+%! [sn,cn,dn] = ellipj(u,m);
+%! assert(sn,S,8*eps);
+%! assert(cn,C,8*eps);
+%! assert(dn,D,8*eps);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/specfun/ellipke.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,122 @@
+## Copyright (C) 2001 David Billinghurst
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or   
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Compute:
+##     complete elliptic integral of first K(m) 
+##     complete elliptic integral of second E(m)    
+##
+## usage: [k,e] = ellipke(m[,tol])
+## 
+## m is either real array or scalar with 0 <= m <= 1
+## 
+## tol  Ignored. 
+##      (Matlab uses this to allow faster, less accurate approximation)
+##
+## Ref: Abramowitz, Milton and Stegun, Irene A
+##      Handbook of Mathematical Functions, Dover, 1965
+##      Chapter 17
+##
+## See also: ellipj
+
+## Author: David Billinghurst <David.Billinghurst@riotinto.com>
+## Created: 31 January 2001
+## 2001-02-01 Paul Kienzle
+##   * vectorized
+##   * included function name in error messages
+
+function [k,e] = ellipke( m )
+
+  if (nargin < 1 || nargin > 2)
+    usage("[k, e] = ellipke (m)");
+  endif
+
+  k = e = zeros(size(m));
+  m = m(:);
+  if any(~isreal(m))
+    error("ellipke must have real m"); 
+  endif
+  if any(m<0) || any(m>1)
+    error("ellipke must have m in the range [0,1]");
+  endif
+
+  Nmax = 16;
+  dfi = do_fortran_indexing;
+  unwind_protect
+    do_fortran_indexing = 1;
+
+    idx = find(m == 1);
+    if (!isempty(idx))
+      k(idx) = Inf;
+      e(idx) = 1.0;
+    endif
+
+    ## Arithmetic-Geometric Mean (AGM) algorithm
+    ## ( Abramowitz and Stegun, Section 17.6 )
+    idx = find(m != 1);
+    if (!isempty(idx))
+      a = ones(length(idx),1);
+      b = sqrt(1.0-m(idx));
+      c = sqrt(m(idx));
+      f = 0.5;
+      sum = f*c.*c;
+      for n = 2:Nmax
+        t = (a+b)/2;
+        c = (a-b)/2;
+        b = sqrt(a.*b);
+        a = t;
+        f = f * 2;
+        sum = sum + f*c.*c;
+        if all(c./a < eps), break; endif
+      endfor
+      if n >= Nmax, error("ellipke: not enough workspace"); endif
+      k(idx) = 0.5*pi./a;
+      e(idx) = 0.5*pi.*(1.0-sum)./a;
+    endif
+  unwind_protect_cleanup
+    do_fortran_indexing = dfi;
+  end_unwind_protect
+
+endfunction
+
+%!test
+%! ## Test complete elliptic functions of first and second kind
+%! ## against "exact" solution from Mathematica 3.0
+%! ##
+%! ## David Billinghurst <David.Billinghurst@riotinto.com>
+%! ## 1 February 2001
+%! m = [0.0; 0.01; 0.1; 0.5; 0.9; 0.99; 1.0 ];
+%! [k,e] = ellipke(m);
+%!
+%! # K(1.0) is really infinity - see below
+%! K = [ 
+%!  1.5707963267948966192;
+%!  1.5747455615173559527;
+%!  1.6124413487202193982;
+%!  1.8540746773013719184;
+%!  2.5780921133481731882;
+%!  3.6956373629898746778;
+%!  0.0 ];
+%! E = [
+%!  1.5707963267948966192;
+%!  1.5668619420216682912;
+%!  1.5307576368977632025;
+%!  1.3506438810476755025;
+%!  1.1047747327040733261;
+%!  1.0159935450252239356;
+%!  1.0 ];
+%! if k(7)==Inf, k(7)=0.0; endif;
+%! assert(K,k,8*eps);
+%! assert(E,e,8*eps);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/specfun/expint.f	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,847 @@
+      SUBROUTINE EXPINT(X, N, KODE, M, TOL, EN, IERR)                   EXP   10
+C
+C     WRITTEN BY D.E. AMOS, SANDIA LABORATORIES, ALBUQUERQUE, NM, 87185
+C
+C     REFERENCE
+C         COMPUTATION OF EXPONENTIAL INTEGRALS BY D.E. AMOS, ACM
+C         TRANS. MATH SOFTWARE, 1980
+C
+C     ABSTRACT
+C         EXPINT COMPUTES M MEMBER SEQUENCES OF EXPONENTIAL INTEGRALS
+C         E(N+K,X), K=0,1,...,M-1 FOR N.GE.1 AND X.GE.0.  THE POWER
+C         SERIES IS IMPLEMENTED FOR X.LE.XCUT AND THE CONFLUENT
+C         HYPERGEOMETRIC REPRESENTATION
+C
+C                     E(A,X) = EXP(-X)*(X**(A-1))*U(A,A,X)
+C
+C         IS COMPUTED FOR X.GT.XCUT. SINCE SEQUENCES ARE COMPUTED IN A
+C         STABLE FASHION BY RECURRING AWAY FROM X, A IS SELECTED AS THE
+C         INTEGER CLOSEST TO X WITHIN THE CONSTRAINT N.LE.A.LE.N+M-1.
+C         FOR THE U COMPUTATION  A IS FURTHER MODIFIED TO BE THE
+C         NEAREST EVEN INTEGER. INDICES ARE CARRIED FORWARD OR
+C         BACKWARD BY THE TWO TERM RECURSION RELATION
+C
+C                     K*E(K+1,X) + X*E(K,X) = EXP(-X)
+C
+C         ONCE E(A,X) IS COMPUTED. THE U FUNCTION IS COMPUTED BY MEANS
+C         OF THE BACKWARD RECURSIVE MILLER ALGORITHM APPLIED TO THE
+C         THREE TERM CONTIGUOUS RELATION FOR U(A+K,A,X), K=0,1,...
+C         THIS PRODUCES ACCURATE RATIOS AND DETERMINES U(A+K,A,X),AND
+C         HENCE E(A,X), TO WITHIN A MULTIPLICATIVE CONSTANT C.
+C         ANOTHER CONTIGUOUS RELATION APPLIED TO C*U(A,A,X) AND
+C         C*U(A+1,A,X) GETS C*U(A+1,A+1,X), A QUANTITY PROPORTIONAL TO
+C         E(A+1,X). THE NORMALIZING CONSTANT C IS OBTAINED FROM THE
+C         TWO TERM RECURSION RELATION ABOVE WITH K=A.
+C
+C         MACHINE DEPENDENT PARAMETERS - XCUT, XLIM, ETOL, EULER, DIGAM
+C
+C         EXPINT WRITES ERROR DIAGNOSTICS TO LOGICAL UNIT 3
+C
+C     DESCRIPTION OF ARGUMENTS
+C
+C         INPUT
+C           X       X.GT.0.0 FOR N=1 AND  X.GE.0.0 FOR N.GE.2
+C           N       ORDER OF THE FIRST MEMBER OF THE SEQUENCE, N.GE.1
+C           KODE    A SELECTION PARAMETER FOR SCALED VALUES
+C                   KODE=1   RETURNS        E(N+K,X), K=0,1,...,M-1.
+C                       =2   RETURNS EXP(X)*E(N+K,X), K=0,1,...,M-1.
+C           M       NUMBER OF EXPONENTIAL INTEGRALS IN THE SEQUENCE,
+C                   M.GE.1
+C           TOL     RELATIVE ACCURACY WANTED, ETOL.LE.TOL.LE.0.1
+C                   ETOL=1.E-12
+C
+C         OUTPUT
+C           EN      A VECTOR OF DIMENSION AT LEAST M CONTAINING VALUES
+C                   EN(K) = E(N+K-1,X) OR EXP(X)*E(N+K-1,X), K=1,M
+C                   DEPENDING ON KODE
+C           IERR    UNDERFLOW INDICATOR
+C                   IERR=0   A NORMAL RETURN
+C                       =1   X EXCEEDS XLIM AND AN UNDERFLOW OCCURS.
+C                            EN(K)=0.0 , K=1,M RETURNED ON KODE=1
+C                            XLIM=667.
+C
+C     ERROR CONDITIONS
+C         AN IMPROPER INPUT PARAMETER IS A FATAL ERROR
+C         UNDERFLOW IS A NON FATAL ERROR. ZERO ANSWERS ARE RETURNED.
+C
+      DIMENSION EN(1), A(99), B(99), Y(2)
+C
+      DATA XCUT, XLIM, ETOL /2.0E0,667.0E0,1.0E-12/
+      DATA EULER /-5.77215664901533E-01/
+      DATA LUN /3/
+C
+      IF (N.LT.1) GO TO 260
+      IF (KODE.LT.1 .OR. KODE.GT.2) GO TO 270
+      IF (M.LT.1) GO TO 280
+      IF (TOL.LT.ETOL .OR. TOL.GT.0.1E0) GO TO 290
+C
+      IERR = 0
+      IF (X.GT.XCUT) GO TO 100
+      IF (X.LT.0.0E0) GO TO 300
+      IF (X.EQ.0.0E0 .AND. N.EQ.1) GO TO 310
+      IF (X.EQ.0.0E0 .AND. N.GT.1) GO TO 80
+C
+C     SERIES FOR E(N,X) FOR X.LE.XCUT
+C
+      IX = INT(X+0.5E0)
+C     ICASE=1 MEANS INTEGER CLOSEST TO X IS 2 AND N=1
+C     ICASE=2 MEANS INTEGER CLOSEST TO X IS 0,1, OR 2 AND N.GE.2
+      ICASE = 2
+      IF (IX.GT.N) ICASE = 1
+      NM = N - ICASE + 1
+      ND = NM + 1
+      IND = 3 - ICASE
+      MU = M - IND
+      ML = 1
+      KS = ND
+      FNM = FLOAT(NM)
+      S = 0.0E0
+      XTOL = 3.0E0*TOL
+      IF (ND.EQ.1) GO TO 10
+      XTOL = 0.3333E0*TOL
+      S = 1.0E0/FNM
+   10 CONTINUE
+      AA = 1.0E0
+      AK = 1.0E0
+      DO 50 I=1,35
+        AA = -AA*X/AK
+        IF (I.EQ.NM) GO TO 30
+        S = S - AA/(AK-FNM)
+        IF (ABS(AA).LE.XTOL*ABS(S)) GO TO 20
+        AK = AK + 1.0E0
+        GO TO 50
+   20   CONTINUE
+        IF (I.LT.2) GO TO 40
+        IF (ND-2.GT.I .OR. I.GT.ND-1) GO TO 60
+        AK = AK + 1.0E0
+        GO TO 50
+   30   S = S + AA*(-ALOG(X)+DIGAM(ND))
+        XTOL = 3.0E0*TOL
+   40   AK = AK + 1.0E0
+   50 CONTINUE
+      GO TO 320
+   60 IF (ND.EQ.1) S = S + (-ALOG(X)+EULER)
+      IF (KODE.EQ.2) S = S*EXP(X)
+      EN(1) = S
+      EMX = 1.0E0
+      IF (M.EQ.1) GO TO 70
+      EN(IND) = S
+      AA = FLOAT(KS)
+      IF (KODE.EQ.1) EMX = EXP(-X)
+      GO TO (220, 240), ICASE
+   70 IF (ICASE.EQ.2) RETURN
+      IF (KODE.EQ.1) EMX = EXP(-X)
+      EN(1) = (EMX-S)/X
+      RETURN
+   80 CONTINUE
+      DO 90 I=1,M
+        EN(I) = 1.0E0/FLOAT(N+I-2)
+   90 CONTINUE
+      RETURN
+C
+C     BACKWARD RECURSIVE MILLER ALGORITHM FOR
+C              E(N,X)=EXP(-X)*(X**(N-1))*U(N,N,X)
+C     WITH RECURSION AWAY FROM N=INTEGER CLOSEST TO X.
+C     U(A,B,X) IS THE SECOND CONFLUENT HYPERGEOMETRIC FUNCTION
+C
+  100 CONTINUE
+      EMX = 1.0E0
+      IF (KODE.EQ.2) GO TO 130
+      IF (X.LE.XLIM) GO TO 120
+      IERR = 1
+      DO 110 I=1,M
+        EN(I) = 0.0E0
+  110 CONTINUE
+      RETURN
+  120 EMX = EXP(-X)
+  130 CONTINUE
+      IX = INT(X+0.5E0)
+      KN = N + M - 1
+      IF (KN.LE.IX) GO TO 140
+      IF (N.LT.IX .AND. IX.LT.KN) GO TO 170
+      IF (N.GE.IX) GO TO 160
+      GO TO 340
+  140 ICASE = 1
+      KS = KN
+      ML = M - 1
+      MU = -1
+      IND = M
+      IF (KN.GT.1) GO TO 180
+  150 KS = 2
+      ICASE = 3
+      GO TO 180
+  160 ICASE = 2
+      IND = 1
+      KS = N
+      MU = M - 1
+      IF (N.GT.1) GO TO 180
+      IF (KN.EQ.1) GO TO 150
+      IX = 2
+  170 ICASE = 1
+      KS = IX
+      ML = IX - N
+      IND = ML + 1
+      MU = KN - IX
+  180 CONTINUE
+      IK = KS/2
+      AH = FLOAT(IK)
+      JSET = 1 + KS - (IK+IK)
+C     START COMPUTATION FOR
+C              EN(IND) = C*U( A , A ,X)    JSET=1
+C              EN(IND) = C*U(A+1,A+1,X)    JSET=2
+C     FOR AN EVEN INTEGER A.
+      IC = 0
+      AA = AH + AH
+      AAMS = AA - 1.0E0
+      AAMS = AAMS*AAMS
+      TX = X + X
+      FX = TX + TX
+      AK = AH
+      XTOL = TOL
+      IF (TOL.LE.1.0E-3) XTOL = 20.0E0*TOL
+      CT = AAMS + FX*AH
+      EM = (AH+1.0E0)/((X+AA)*XTOL*SQRT(CT))
+      BK = AA
+      CC = AH*AH
+C     FORWARD RECURSION FOR P(IC),P(IC+1) AND INDEX IC FOR BACKWARD
+C     RECURSION
+      P1 = 0.0E0
+      P2 = 1.0E0
+  190 CONTINUE
+      IF (IC.EQ.99) GO TO 330
+      IC = IC + 1
+      AK = AK + 1.0E0
+      AT = BK/(BK+AK+CC+FLOAT(IC))
+      BK = BK + AK + AK
+      A(IC) = AT
+      BT = (AK+AK+X)/(AK+1.0E0)
+      B(IC) = BT
+      PT = P2
+      P2 = BT*P2 - AT*P1
+      P1 = PT
+      CT = CT + FX
+      EM = EM*AT*(1.0E0-TX/CT)
+      IF (EM*(AK+1.0E0).GT.P1*P1) GO TO 190
+      ICT = IC
+      KK = IC + 1
+      BT = TX/(CT+FX)
+      Y2 = (BK/(BK+CC+FLOAT(KK)))*(P1/P2)*(1.0E0-BT+0.375E0*BT*BT)
+      Y1 = 1.0E0
+C     BACKWARD RECURRENCE FOR
+C              Y1=             C*U( A ,A,X)
+C              Y2= C*(A/(1+A/2))*U(A+1,A,X)
+      DO 200 K=1,ICT
+        KK = KK - 1
+        YT = Y1
+        Y1 = (B(KK)*Y1-Y2)/A(KK)
+        Y2 = YT
+  200 CONTINUE
+C     THE CONTIGUOUS RELATION
+C              X*U(B,C+1,X)=(C-B)*U(B,C,X)+U(B-1,C,X)
+C     WITH  B=A+1 , C=A IS USED FOR
+C              Y(2) = C * U(A+1,A+1,X)
+C     X IS INCORPORATED INTO THE NORMALIZING RELATION FOR CNORM.
+      PT=Y2/Y1
+      CNORM=1.0E0-PT*(AH+1.0E0)/AA
+      Y(1)=1.0E0/(CNORM*AA+X)
+      Y(2)=CNORM*Y(1)
+      IF (ICASE.EQ.3) GO TO 210
+      EN(IND) =   EMX*Y(JSET)
+      IF (M.EQ.1) RETURN
+      AA = FLOAT(KS)
+      GO TO (220, 240), ICASE
+C
+C     RECURSION SECTION  N*E(N+1,X) + X*E(N,X)=EMX
+C
+  210 EN(1) = EMX*(1.0E0-Y(1))/X
+      RETURN
+  220 K = IND - 1
+      DO 230 I=1,ML
+        AA = AA - 1.0E0
+        EN(K) = (EMX-AA*EN(K+1))/X
+        K = K - 1
+  230 CONTINUE
+      IF (MU.LE.0) RETURN
+      AA = FLOAT(KS)
+  240 K = IND
+      DO 250 I=1,MU
+        EN(K+1) = (EMX-X*EN(K))/AA
+        AA = AA + 1.0E0
+        K = K + 1
+  250 CONTINUE
+      RETURN
+C
+C
+  260 WRITE (LUN,99999)
+      RETURN
+  270 WRITE (LUN,99998)
+      RETURN
+  280 WRITE (LUN,99997)
+      RETURN
+  290 WRITE (LUN,99996)
+      RETURN
+  300 WRITE (LUN,99995)
+      RETURN
+  310 WRITE (LUN,99994)
+      RETURN
+  320 WRITE (LUN,99993)
+      RETURN
+  330 WRITE (LUN,99992)
+      RETURN
+  340 WRITE (LUN,99991)
+      RETURN
+99999 FORMAT (32H IN EXPINT, N NOT GREATER THAN 0)
+99998 FORMAT (27H IN EXPINT, KODE NOT 1 OR 2)
+99997 FORMAT (32H IN EXPINT, M NOT GREATER THAN 0)
+99996 FORMAT (33H IN EXPINT, TOL NOT WITHIN LIMITS)
+99995 FORMAT (37H IN EXPINT, X IS NOT ZERO OR POSITIVE)
+99994 FORMAT (46H IN EXPINT, THE EXPONENTIAL INTEGRAL IS NOT DE,
+     * 21HFINED FOR X=0 AND N=1)
+99993 FORMAT (46H IN EXPINT, RELATIVE ERROR TEST FOR SERIES TER,
+     * 28HMINATION NOT MET IN 36 TERMS)
+99992 FORMAT (46H IN EXPINT, TERMINATION TEST FOR MILLER ALGORI,
+     * 23HTHM NOT MET IN 99 STEPS)
+99991 FORMAT (46H IN EXPINT, AN ERROR IN PLACING INT(X+0.5) WIT,
+     * 47HH RESPECT TO N AND N+M-1 OCCURRED FOR X.GT.XCUT)
+      END
+      FUNCTION DIGAM(N)                                                 DIG   10
+C
+C     THIS SUBROUTINE RETURNS VALUES OF PSI(X)=DERIVATIVE OF LOG
+C     GAMMA(X), X.GT.0.0 AT INTEGER ARGUMENTS. A TABLE LOOK-UP IS
+C     PERFORMED FOR N.LE.100, AND THE ASYMPTOTIC EXPANSION IS
+C     EVALUATED FOR N.GT.100.
+C
+      DIMENSION B(4), C(100), C1(32), C2(27), C3(22), C4(19)
+      EQUIVALENCE (C(1),C1(1))
+      EQUIVALENCE (C(33),C2(1))
+      EQUIVALENCE (C(60),C3(1))
+      EQUIVALENCE (C(82),C4(1))
+C
+      DATA C1 /-5.7721566490153E-01,4.22784335098467E-01,
+     * 9.22784335098467E-01,1.25611766843180E+00,1.50611766843180E+00,
+     * 1.70611766843180E+00,1.87278433509847E+00,2.01564147795561E+00,
+     * 2.14064147795561E+00,2.25175258906672E+00,2.35175258906672E+00,
+     * 2.44266167997581E+00,2.52599501330915E+00,2.60291809023222E+00,
+     * 2.67434666166079E+00,2.74101332832746E+00,2.80351332832746E+00,
+     * 2.86233685773923E+00,2.91789241329478E+00,2.97052399224215E+00,
+     * 3.02052399224215E+00,3.06814303986120E+00,3.11359758531574E+00,
+     * 3.15707584618531E+00,3.19874251285197E+00,3.23874251285197E+00,
+     * 3.27720405131351E+00,3.31424108835055E+00,3.34995537406484E+00,
+     * 3.38443813268552E+00,3.41777146601886E+00,3.45002953053499E+00/
+      DATA C2 /3.48127953053499E+00,3.51158256083802E+00,
+     * 3.54099432554390E+00,3.56956575411533E+00,3.59734353189311E+00,
+     * 3.62437055892013E+00,3.65068634839382E+00,3.67632737403484E+00,
+     * 3.70132737403484E+00,3.72571761793728E+00,3.74952714174681E+00,
+     * 3.77278295570029E+00,3.79551022842757E+00,3.81773245064979E+00,
+     * 3.83947158108457E+00,3.86074817682925E+00,3.88158151016259E+00,
+     * 3.90198967342789E+00,3.92198967342789E+00,3.94159751656515E+00,
+     * 3.96082828579592E+00,3.97969621032422E+00,3.99821472884274E+00,
+     * 4.01639654702455E+00,4.03425368988170E+00,4.05179754953082E+00,
+     * 4.06903892884117E+00/
+      DATA C3 /4.08598808138354E+00,4.10265474805020E+00,
+     * 4.11904819067316E+00,4.13517722293122E+00,4.15105023880424E+00,
+     * 4.16667523880424E+00,4.18205985418885E+00,4.19721136934037E+00,
+     * 4.21213674247470E+00,4.22684262482764E+00,4.24133537845082E+00,
+     * 4.25562109273654E+00,4.26970559977879E+00,4.28359448866768E+00,
+     * 4.29729311880467E+00,4.31080663231818E+00,4.32413996565151E+00,
+     * 4.33729786038836E+00,4.35028487337537E+00,4.36310538619588E+00,
+     * 4.37576361404398E+00,4.38826361404398E+00/
+      DATA C4 /4.40060929305633E+00,4.41280441500755E+00,
+     * 4.42485260777863E+00,4.43675736968340E+00,4.44852207556575E+00,
+     * 4.46014998254249E+00,4.47164423541606E+00,4.48300787177969E+00,
+     * 4.49424382683587E+00,4.50535493794698E+00,4.51634394893599E+00,
+     * 4.52721351415338E+00,4.53796620232543E+00,4.54860450019777E+00,
+     * 4.55913081598724E+00,4.56954748265391E+00,4.57985676100442E+00,
+     * 4.59006084263708E+00,4.60016185273809E+00/
+C
+      DATA B /1.66666666666667E-01,-3.33333333333333E-02,
+     * 2.38095238095238E-02,-3.33333333333333E-02/
+C
+      IF (N.GT.100) GO TO 10
+      DIGAM = C(N)
+      RETURN
+   10 FN = N
+      AX = 1.0E0
+      AK = 2.0E0
+      S = -0.5E0/FN
+      IF (FN.GT.1.E+8) GO TO 30
+      FN2 = FN*FN
+      DO 20 K=1,3
+        AX = AX*FN2
+        S = S - B(K)/(AX*AK)
+        AK = AK + 2.0E0
+   20 CONTINUE
+   30 CONTINUE
+      DIGAM = S + ALOG(FN)
+      RETURN
+      END
+C     PROGRAM TSTEXP(INPUT,OUTPUT,TAPE3=OUTPUT)                         00000010
+C                                                                       00000020
+C     PROGRAM TO TEST SUBROUTINE EXPINT AGAINST AN ADAPTIVE QUADRATURE. 00000030
+C     PARAMETER VALUES ARE PRINTED AND, IN THE EVENT THAT THE RELATIVE  00000040
+C     ERROR TEST IS NOT SATISFIED, X, ERROR, N, AND KODE ARE ALSO       00000050
+C     PRINTED. AN OUTPUT WITH ONLY PARAMETER VALUES INDICATES THAT ALL  00000060
+C     TESTS WERE PASSED. GAUS8 COMPUTES THE QUADRATURES.                00000070
+C                                                                       00000080
+      DIMENSION XTOL(10), EN(50), EV(50)                                00000090
+      IOUT = 3                                                          00000100
+      NL = 1                                                            00000110
+      NU = 16                                                           00000120
+      NINC = 5                                                          00000130
+      ML = 1                                                            00000140
+      MU = 25                                                           00000150
+      MINC = 8                                                          00000160
+      KM = 5                                                            00000170
+      JL = 1                                                            00000180
+      JU = 40                                                           00000190
+      JINC = 3                                                          00000200
+      XTOL(1) = 1.0E-2                                                  00000210
+      DO 10 I=2,3                                                       00000220
+        XTOL(I) = XTOL(I-1)*1.0E-3                                      00000230
+   10 CONTINUE                                                          00000240
+      DO 80 IT=1,3                                                      00000250
+        TOL = XTOL(IT)                                                  00000260
+        TOLA = AMAX1(1.0E-12,TOL/10.0E0)                                00000270
+        BTOL = TOL                                                      00000280
+        WRITE (IOUT,99999) TOL                                          00000290
+        DO 70 M=ML,MU,MINC                                              00000300
+          WRITE (IOUT,99998) M                                          00000310
+          DO 60 N=NL,NU,NINC                                            00000320
+            WRITE (IOUT,99997) N                                        00000330
+            DO 50 J=JL,JU,JINC                                          00000340
+              X = FLOAT(J-1)/5.0E0                                      00000350
+              EX = EXP(-X)                                              00000360
+              IF (X.EQ.0. .AND. N.EQ.1) GO TO 50                        00000370
+              CALL EXPINT(X, N, 1, M, TOL, EN, IERR)                    00000380
+              CALL EXPINT(X, N, 2, M, TOL, EV, IERR)                    00000390
+              DO 40 K=1,M,KM                                            00000400
+                IF (X.GT.0.) GO TO 20                                   00000410
+                IF (N+K.EQ.2) GO TO 40                                  00000420
+                Y = 1.0E0/FLOAT(N+K-2)                                  00000430
+                YY = Y                                                  00000440
+                GO TO 30                                                00000450
+   20           CONTINUE                                                00000460
+                NN = N + K - 1                                          00000470
+                YY = EINT(NN,X,TOLA,2)                                  00000480
+                Y = YY*EX                                               00000490
+   30           CONTINUE                                                00000500
+                ER = ABS((Y-EN(K))/Y)                                   00000510
+                KODE = 1                                                00000520
+                IF (ER.GT.BTOL) WRITE (IOUT,99996) X, ER, NN, KODE      00000530
+                KODE = 2                                                00000540
+                ERR = ABS((YY-EV(K))/YY)                                00000550
+                IF (ERR.GT.BTOL) WRITE (IOUT,99996) X, ERR, NN, KODE    00000560
+   40         CONTINUE                                                  00000570
+   50       CONTINUE                                                    00000580
+   60     CONTINUE                                                      00000590
+   70   CONTINUE                                                        00000600
+   80 CONTINUE                                                          00000610
+      STOP                                                              00000620
+99999 FORMAT (1H0, 5H TOL=, E15.4/)                                     00000630
+99998 FORMAT (1H0, 2HM=, I5/)                                           00000640
+99997 FORMAT (3X, 2HN=, I5)                                             00000650
+99996 FORMAT (2E15.6, 2I5)                                              00000660
+      END                                                               00000670
+      FUNCTION EINT(N, X, TOL, KODE)                                    00000680
+      COMMON /GEINT/ XX, FN
+      EXTERNAL FEINT
+      XX = X
+      FN = N
+      SIG = 1.0E0
+      S = 0.0E0
+      TOLA = TOL
+      B = X
+   10 CONTINUE
+      A = B
+      REL = TOL
+      B = B + SIG
+      CALL GAUS8(FEINT, A, B, REL, ANS, IERR)
+      S = S + ANS
+      IF (ABS(ANS).LT.S*TOLA) GO TO 20
+      GO TO 10
+   20 EINT = S*EXP((FN-1.0E0)*ALOG(X)-FLOAT(2-KODE)*X)
+      RETURN
+      END
+      FUNCTION FEINT(T)                                                 00000880
+      COMMON /GEINT/ XX, FN
+      FEINT = EXP(-T+XX-FN*ALOG(T))
+      RETURN
+      END
+      SUBROUTINE GAUS8  (FUN,A,B,ERR,ANS,IERR)                          00000930
+C
+C     BY RONDALL E JONES, SANDIA LABORATORIES
+C     SALIENT FEATURES -- INTERVAL BISECTION, COMBINED RELATIVE/ABSOLUTE
+C     ERROR CONTROL, COMPUTED MAXIMUM REFINEMENT LEVEL WHEN A IS
+C     CLOSE TO B.
+C
+C     ABSTRACT
+C        GAUS8 INTEGRATES REAL FUNCTIONS OF ONE VARIABLE OVER FINITE
+C        INTERVALS, USING AN ADAPTIVE 8-POINT LEGENDRE-GAUSS ALGORITHM.
+C        GAUS8 IS INTENDED PRIMARILY FOR HIGH ACCURACY INTEGRATION
+C        OR INTEGRATION OF SMOOTH FUNCTIONS.  FOR LOWER ACCURACY
+C        INTEGRATION OF FUNCTIONS WHICH ARE NOT VERY SMOOTH,
+C        EITHER QNC3 OR QNC7 MAY BE MORE EFFICIENT.
+C
+C     DESCRIPTION OF ARGUMENTS
+C
+C        INPUT--
+C        FUN - NAME OF EXTERNAL FUNCTION TO BE INTEGRATED.  THIS NAME
+C              MUST BE IN AN EXTERNAL STATEMENT IN THE CALLING PROGRAM.
+C              FUN MUST BE A FUNCTION OF ONE REAL ARGUMENT.  THE VALUE
+C              OF THE ARGUMENT TO FUN IS THE VARIABLE OF INTEGRATION
+C              WHICH RANGES FROM A TO B.
+C        A   - LOWER LIMIT OF INTEGRAL
+C        B   - UPPER LIMIT OF INTEGRAL (MAY BE LESS THAN A)
+C        ERR - IS A REQUESTED ERROR TOLERANCE.  NORMALLY PICK A VALUE OF
+C              ABS(ERR).LT.1.E-3.  ANS WILL NORMALLY HAVE NO MORE ERROR
+C              THAN ABS(ERR) TIMES THE INTEGRAL OF THE ABSOLUTE VALUE
+C              OF FUN(X).  USUALLY, SMALLER VALUES FOR ERR YIELD
+C              MORE ACCURACY AND REQUIRE MORE FUNCTION EVALUATIONS.
+C              A NEGATIVE VALUE FOR ERR CAUSES AN ESTIMATE OF THE
+C              ABSOLUTE ERROR IN ANS TO BE RETURNED IN ERR.
+C
+C        OUTPUT--
+C        ERR - WILL BE AN ESTIMATE OF THE ERROR IN ANS IF THE INPUT
+C              VALUE OF ERR WAS NEGATIVE.  THE ESTIMATED ERROR IS SOLELY
+C              FOR INFORMATION TO THE USER AND SHOULD NOT BE USED AS
+C              A CORRECTION TO THE COMPUTED INTEGRAL.
+C        ANS - COMPUTED VALUE OF INTEGRAL
+C        IERR- A STATUS CODE
+C            --NORMAL CODES
+C               1 ANS MOST LIKELY MEETS REQUESTED ERROR TOLERANCE,
+C                 OR A=B.
+C              -1 A AND B ARE TOO NEARLY EQUAL TO ALLOW NORMAL
+C                 INTEGRATION.  ANS IS SET TO ZERO.
+C            --ABNORMAL CODE
+C               2 ANS PROBABLY DOES NOT MEET REQUESTED ERROR TOLERANCE.
+C
+C
+C
+C     GAUS8  USES SUBROUTINES ERRCHK, ERRGET, ERRPRT, ERXSET, ERSTGT
+C     COMPILE DECKS GAUS8, ERRCHK
+C
+      DIMENSION AA(30),HH(30),LR(30),VL(30),GR(30)
+      DATA X1,X2,X3,X4/0.18343 46424 95650 , 0.52553 24099 16329 ,
+     1                 0.79666 64774 13627 , 0.96028 98564 97536 /
+      DATA W1,W2,W3,W4/0.36268 37833 78362 , 0.31370 66458 77887 ,
+     1                 0.22238 10344 53374 , 0.10122 85362 90376 /
+      DATA SQ2/1.41421356/,ICALL/0/
+      DATA NLMN/1/,NLMX/30/,KMX/5000/,KML/6/,NBITS/48/
+      G8(X,H) = H*( (W1*(FUN(X-X1*H)+FUN(X+X1*H))
+     1              +W2*(FUN(X-X2*H)+FUN(X+X2*H)))
+     2             +(W3*(FUN(X-X3*H)+FUN(X+X3*H))
+     3              +W4*(FUN(X-X4*H)+FUN(X+X4*H))) )
+C
+C     INITIALIZE
+C
+      IF(ICALL.NE.0)CALL ERRCHK(-71,71H*****GAUS8 CALLED RECURSIVELY.  R
+     1ECURSIVE CALLS ARE ILLEGAL IN FORTRAN. )
+      ICALL = 1
+      ANS = 0.0
+      IERR = 1
+      CE = 0.0
+      IF (A.EQ.B) GO TO 35
+      LMX = NLMX
+      LMN = NLMN
+      IF (B.EQ.0.0) GO TO 4
+      IF (SIGN(1.0,B)*A.LE.0.0) GO TO 4
+      C = ABS(1.0-A/B)
+      IF (C.GT.0.1) GO TO 4
+      IF (C.LE.0.0) GO TO 35
+      NIB = 0.5-ALOG(C)/ALOG(2.0)
+      LMX = MIN0(NLMX , NBITS-NIB-7)
+      IF (LMX.LT.1) GO TO 32
+      LMN = MIN0(LMN,LMX)
+    4 TOL = AMAX1(ABS(ERR),2.0**(5-NBITS))/2.0
+      IF (ERR.EQ.0.0) TOL = 0.5E-6
+      EPS = TOL
+      HH(1) = (B-A)/4.0
+      AA(1) = A
+      LR(1) = 1
+      L = 1
+      EST = G8(AA(L)+2.0*HH(L),2.0*HH(L))
+      K = 8
+      AREA = ABS(EST)
+      EF = 0.5
+      MXL = 0
+C
+C     COMPUTE REFINED ESTIMATES, ESTIMATE THE ERROR, ETC.
+C
+    5 GL = G8(AA(L)+HH(L),HH(L))
+      GR(L) = G8(AA(L)+3.0*HH(L),HH(L))
+      K = K+16
+      AREA = AREA+(ABS(GL)+ABS(GR(L))-ABS(EST))
+C     IF (L.LT.LMN) GO TO 11
+      GLR = GL+GR(L)
+      EE = ABS(EST-GLR)*EF
+      AE = AMAX1(EPS*AREA,TOL*ABS(GLR))
+      IF (EE-AE) 8,8,10
+    7 MXL = 1
+    8 CE = CE + (EST-GLR)
+      IF (LR(L)) 15,15,20
+C
+C     CONSIDER THE LEFT HALF OF THIS LEVEL
+C
+   10 IF (K.GT.KMX) LMX = KML
+      IF (L.GE.LMX) GO TO 7
+   11 L = L+1
+      EPS = EPS*0.5
+      EF = EF/SQ2
+      HH(L) = HH(L-1)*0.5
+      LR(L) = -1
+      AA(L) = AA(L-1)
+      EST = GL
+      GO TO 5
+C
+C     PROCEED TO RIGHT HALF AT THIS LEVEL
+C
+   15 VL(L) = GLR
+   16 EST = GR(L-1)
+      LR(L) = 1
+      AA(L) = AA(L)+4.0*HH(L)
+      GO TO 5
+C
+C     RETURN ONE LEVEL
+C
+   20 VR = GLR
+   22 IF (L.LE.1) GO TO 30
+      L = L-1
+      EPS = EPS*2.0
+      EF = EF*SQ2
+      IF (LR(L)) 24,24,26
+   24 VL(L) = VL(L+1)+VR
+      GO TO 16
+   26 VR = VL(L+1)+VR
+      GO TO 22
+C
+C      EXIT
+C
+   30 ANS = VR
+      IF ((MXL.EQ.0).OR.(ABS(CE).LE.2.0*TOL*AREA)) GO TO 35
+      IERR = 2
+      CALL ERRCHK(51,51HIN GAUS8 , ANS IS PROBABLY INSUFFICIENTLY ACCURA
+     1TE.)
+      GO TO 35
+   32 IERR =-1
+      CALL ONECHK(-70,70HTHE FOLLOWING TEMPORARY INFORMATIVE DIAGNOSTIC
+     + WILL APPEAR ONLY ONCE. )
+      CALLONECHK(-102,102HIN GAUS8 , A AND B ARE TOO NEARLY EQUAL TO ALL
+     1OW NORMAL INTEGRATION.  ANS IS SET TO ZERO, AND IERR=-1.)
+   35 ICALL = 0
+      IF (ERR.LT.0.0) ERR = CE
+      RETURN
+      END
+      SUBROUTINE ERRCHK(NCHARS,NARRAY)                                  00002570
+C
+C     SANDIA MATHEMATICAL PROGRAM LIBRARY
+C     APPLIED MATHEMATICS DIVISION 2642
+C     SANDIA LABORATORIES
+C     ALBUQUERQUE, NEW MEXICO 87115
+C
+C     SIMPLIFIED VERSION FOR STAND-ALONE USE.     APRIL 1977
+C
+C     ABSTRACT
+C         THE ROUTINES ERRCHK, ERXSET, AND ERRGET TOGETHER PROVIDE
+C         A UNIFORM METHOD WITH SEVERAL OPTIONS FOR THE PROCESSING
+C         OF DIAGNOSTICS AND WARNING MESSAGES WHICH ORIGINATE
+C         IN THE MATHEMATICAL PROGRAM LIBRARY ROUTINES.
+C         ERRCHK IS THE CENTRAL ROUTINE, WHICH ACTUALLY PROCESSES
+C         MESSAGES.
+C
+C     DESCRIPTION OF ARGUMENTS
+C         NCHARS - NUMBER OF CHARACTERS IN HOLLERITH MESSAGE.
+C                  IF NCHARS IS NEGATED, ERRCHK WILL UNCONDITIONALLY
+C                  PRINT THE MESSAGE AND STOP EXECUTION.  OTHERWISE,
+C                  THE BEHAVIOR OF ERRCHK MAY BE CONTROLLED BY
+C                  AN APPROPRIATE CALL TO ERXSET.
+C         NARRAY - NAME OF ARRAY OR VARIABLE CONTAINING THE MESSAGE,
+C                  OR ELSE A LITERAL HOLLERITH CONSTANT CONTAINING
+C                  THE MESSAGE.  BY CONVENTION, ALL MESSAGES SHOULD
+C                  BEGIN WITH *IN SUBNAM, ...*, WHERE SUBNAM IS THE
+C                  NAME OF THE ROUTINE CALLING ERRCHK.
+C
+C     EXAMPLES
+C         1. TO ALLOW CONTROL BY CALLING ERXSET, USE
+C            CALL ERRCHK(30,30HIN QUAD, INVALID VALUE OF ERR.)
+C         2. TO UNCONDITIONALLY PRINT A MESSAGE AND STOP EXECUTION, USE
+C            CALL ERRCHK(-30,30HIN QUAD, INVALID VALUE OF ERR.)
+C
+C
+C
+C     ERRCHK USES SUBROUTINES ERRGET, ERRPRT, ERXSET, ERSTGT
+C     COMPILE DECKS ERRCHK
+C
+      DIMENSION NARRAY(14)
+C
+      IOUT=6
+      CALL ERRGET(NF,NT)
+C     IF ERRCHK WAS CALLED WITH NEGATIVE CHARACTER COUNT, SET FATAL FLAG
+      IF (NCHARS.LT.0) NF = -1
+C     IF MESSAGES ARE TO BE SUPPRESSED, RETURN
+      IF (NF.EQ.0) RETURN
+C     IF CHARACTER COUNT IS INVALID, STOP
+C     IF (NCHARS.EQ.0) PRINT 5
+      IF (NCHARS .EQ. 0) WRITE (IOUT,5)
+    5 FORMAT(/31H ERRCHK WAS CALLED INCORRECTLY.)
+      IF (NCHARS.EQ.0) STOP
+C     PRINT MESSAGE
+      CALL ERRPRT(IABS(NCHARS),NARRAY)
+C     IF LAST MESSAGE, SAY SO
+C     IF (NF.EQ.1) PRINT 10
+      IF (NF .EQ. 1) WRITE (IOUT,10)
+   10 FORMAT (30H ERRCHK MESSAGE LIMIT REACHED.)
+C     PRINT TRACE-BACK IF ASKED TO
+C     IF ((NT.GT.0).OR.(NF.LT.0)) CALL SYSTEM ROUTINE FOR TRACEBACK
+C     DECREMENT MESSAGE COUNT
+      IF (NF.GT.0) NF = NF-1
+      CALL ERXSET(NF,NT)
+C     IF ALL IS WELL, RETURN
+      IF (NF.GE.0) RETURN
+C     IF THIS MESSAGE IS SUPPRESSABLE BY AN ERXSET CALL,
+C     THEN EXPLAIN ERXSET USAGE.
+C     IF (NCHARS.GT.0) PRINT 15
+      IF (NCHARS .GT. 0) WRITE (IOUT,15)
+   15 FORMAT (/13H *** NOTE ***
+     1/53H TO MAKE THE ERROR MESSAGE PRINTED ABOVE BE NONFATAL,
+     2/39H OR TO SUPPRESS THE MESSAGE COMPLETELY,
+     3/37H INSERT AN APPROPRIATE CALL TO ERXSET
+     4,30H AT THE START OF YOUR PROGRAM.
+     5/62H FOR EXAMPLE, TO PRINT UP TO 10 NONFATAL WARNING MESSAGES, USE
+     6/27H          CALL ERXSET(10,0)    )
+C     PRINT 20
+      WRITE (IOUT,20)
+   20 FORMAT (/28H PROGRAM ABORT DUE TO ERROR.)
+      STOP
+      END
+      SUBROUTINE ONECHK(NCHARS,NARRAY)                                  00003390
+C
+C     ABSTRACT
+C         ONECHK IS A COMPANION ROUTINE OF ERRCHK.  IT IS CALLED
+C         JUST LIKE ERRCHK, AND MESSAGES FROM IT MAY BE SUPPRESSED
+C         BY AN APPROPRIATE CALL TO ERXSET.  IT DIFFERS FROM ERRCHK
+C         IN THAT EACH CALL TO ONECHK WILL PRODUCE NO MORE THAN ONE
+C         PRINTED MESSAGE, REGARDLESS OF HOW MANY TIMES THAT CALL IS
+C         EXECUTED, AND ONECHK NEVER TERMINATES EXECUTION.
+C         ITS PURPOSE IS TO PROVIDE ONE-TIME-ONLY INFORMATIVE
+C         DIAGNOSTICS.
+C
+C     DESCRIPTION OF ARGUMENTS
+C         NCHARS - NUMBER OF CHARACTERS IN THE MESSAGE.
+C                  IF NEGATED, THE MESSAGE WILL BE PRINTED (ONCE) EVEN
+C                  IF NFATAL HAS BEEN SET TO 0 (SEE ERXSET).
+C         NARRAY - SAME AS IN ERRCHK
+C
+C
+C
+C     ONECHK USES SUBROUTINES ERRGET, ERRPRT, ERXSET, ERSTGT
+C     COMPILE DECKS ERRCHK
+C
+      DIMENSION NARRAY(14)
+      DATA NFLAG/4H.$,*/
+      IF (NARRAY(1).EQ.NFLAG) RETURN
+      CALL ERRGET(NF,NT)
+      IF ((NF.EQ.0).AND.(NCHARS.GT.0)) RETURN
+      CALL ERRPRT (59,59HTHE FOLLOWING INFORMATIVE DIAGNOSTIC WILL APPEA
+     1R ONLY ONCE.)
+      CALL ERRPRT(IABS(NCHARS),NARRAY)
+      IF (NF.GT.0) NF = NF-1
+      CALL ERXSET(NF,NT)
+      NARRAY(1) = NFLAG
+      RETURN
+      END
+      SUBROUTINE ERRPRT(NCHARS,NARRAY)                                  00003750
+C
+C     UTILITY ROUTINE TO SIMPLY PRINT THE HOLLERITH MESSAGE IN NARRAY,
+C     WHOSE LENGTH IS NCHARS CHARACTERS.
+C
+      DIMENSION NARRAY(14)
+C
+C     NOTE - NCH MUST BE THE NUMBER OF HOLLERITH CHARACTERS STORED
+C     PER WORD.  IF NCH IS CHANGED, FORMAT 1 MUST ALSO BE
+C     CHANGED CORRESPONDINGLY.
+C
+      IOUT=6
+      NCH = 10
+C     FOR LINE PRINTERS, USE
+    1 FORMAT (1X,13A10)
+C     FOR DATA TERMINALS, USE
+C   1 FORMAT (1X,7A10)
+      NWORDS = (NCHARS+NCH-1)/NCH
+C     PRINT 1,(NARRAY(I),I=1,NWORDS)
+      WRITE (IOUT,1) (NARRAY(I),I=1,NWORDS)
+      RETURN
+      END
+      SUBROUTINE ERXSET(NFATAL,NTRACE)                                  00003970
+C
+C     ABSTRACT
+C         ERXSET IS A COMPANION ROUTINE TO SUBROUTINE ERRCHK.
+C         ERXSET ASSIGNS THE VALUES OF NFATAL AND NTRACE RESPECTIVELY
+C         TO NF AND NT IN COMMON BLOCK MLBLK0 THEREBY SPECIFYING THE
+C         STATE OF THE OPTIONS WHICH CONTROL THE EXECUTION OF ERRCHK.
+C
+C     DESCRIPTION OF ARGUMENTS
+C         BOTH ARGUMENTS ARE INPUT ARGUMENTS OF DATA TYPE INTEGER.
+C         NFATAL - IS A FATAL-ERROR / MESSAGE-LIMIT FLAG. A NEGATIVE
+C                  VALUE DENOTES THAT DETECTED DIFFICULTIES ARE TO BE
+C                  TREATED AS FATAL ERRORS.  NONNEGATIVE MEANS NONFATAL.
+C                  A NONNEGATIVE VALUE IS THE MAXIMUM NUMBER OF NONFATAL
+C                  WARNING MESSAGES WHICH WILL BE PRINTED BY ERRCHK,
+C                  AFTER WHICH NONFATAL MESSAGES WILL NOT BE PRINTED.
+C                  (DEFAULT VALUE IS -1.)
+C         NTRACE - .GE.1 WILL CAUSE A TRACE-BACK TO BE GIVEN,
+C                        IF THIS FEATURE IS IMPLEMENTED ON THIS SYSTEM.
+C                  .LE.0 WILL SUPPRESS ANY TRACE-BACK, EXCEPT FOR
+C                        CASES WHEN EXECUTION IS TERMINATED.
+C                  (DEFAULT VALUE IS 0.)
+C
+C         *NOTE* -- SOME CALLS TO ERRCHK WILL CAUSE UNCONDITIONAL
+C         TERMINATION OF EXECUTION.  ERXSET HAS NO EFFECT ON SUCH CALLS.
+C
+C     EXAMPLES
+C         1. TO PRINT UP TO 100 MESSAGES AS NONFATAL WARNINGS USE
+C            CALL ERXSET(100,0)
+C         2. TO SUPPRESS ALL MATHLIB WARNING MESSAGES USE
+C            CALL ERXSET(0,0)
+C
+C
+C
+C     ERXSET USES SUBROUTINES ERSTGT
+C     COMPILE DECKS ERRCHK
+C
+      CALL ERSTGT(0,NFATAL,NTRACE)
+      RETURN
+      END
+      SUBROUTINE ERRGET(NFATAL,NTRACE)                                  00004370
+C
+C     ABSTRACT
+C         ERRGET IS A COMPANION ROUTINE TO SUBROUTINE ERRCHK.
+C         ERRGET ASSIGNS TO NFATAL AND NTRACE RESPECTIVELY THE VALUES
+C         OF NF AND NT IN COMMON BLOCK MLBLK0 THEREBY ASCERTAINING THE
+C         STATE OF THE OPTIONS WHICH CONTROL THE EXECUTION OF ERRCHK.
+C
+C     DESCRIPTION OF ARGUMENTS
+C     DESCRIPTION OF ARGUMENTS
+C         BOTH ARGUMENTS ARE OUTPUT ARGUMENTS OF DATA TYPE INTEGER.
+C         NFATAL - CURRENT VALUE OF NF (SEE DESCRIPTION OF ERXSET.)
+C         NTRACE - CURRENT VALUE OF NT (SEE DESCRIPTION OF ERXSET.)
+C
+      CALL ERSTGT(1,NFATAL,NTRACE)
+      RETURN
+      END
+      SUBROUTINE ERSTGT(K,NFATAL,NTRACE)                                00004530
+C
+C     THIS ROUTINE IS A SLAVE TO ERRGET AND ERRSET WHICH KEEPS
+C     THE FLAGS AS LOCAL VARIABLES.
+C
+C     *** IF LOCAL VARIABLES ARE NOT NORMALLY RETAINED BETWEEN
+C     CALLS ON THIS SYSTEM, THE VARIABLES LNF AND LNT CAN BE
+C     PLACED IN A COMMON BLOCK AND PRESET TO THE FOLLOWING
+C     VALUES IN THE MAIN PROGRAM.
+C
+      DATA LNF/-1/,LNT/0/
+      IF (K.LE.0) LNF = NFATAL
+      IF (K.LE.0) LNT = NTRACE
+      IF (K.GT.0) NFATAL = LNF
+      IF (K.GT.0) NTRACE = LNT
+      RETURN
+      END
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/specfun/factor.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,41 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} factor (@var{n})
+## Return prime factorization of @var{n}.  If n==1, returns 1.
+## @end deftypefn
+
+## Author: Paul Kienzle
+
+function x = factor(n)
+  if n < 4
+    x = n;
+  else
+    p = primes(sqrt(n));
+    q = n./p;
+    idx = find (q == fix(q));
+    if isempty(idx)
+      x = n;
+    else
+      x = p(idx);
+      q = factor(n/prod(p(idx)));
+      if q != 1
+	x = sort([x, q]);
+      endif
+    endif
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/specfun/factorial.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,21 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## factorial(n)
+##   ==prod(1:n)
+function x = factorial(n)
+  x = prod(2:n);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/specfun/gammaln.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,21 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## Y=gammaln(Z)
+##    alias for lgamma.
+function Y=gammaln(Z)
+  Y = lgamma(Z);
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/specfun/isprime.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,45 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: isprime(n)
+## Return true if n is a prime number, false otherwise.
+##
+## Something like the following is much faster if you need to test a lot
+## of small numbers:
+##    t = ismember (n, primes (max (n (:))));
+## If max(n) is very large, then you should be using special purpose 
+## factorization code.
+##
+## See also: primes, factor, gcd, lcm
+
+function t = isprime(n)
+  if !is_scalar(n)
+    [nr, nc] = size(n);
+    t = n;
+    for i=1:nr
+      for j=1:nc
+	t(i,j) = isprime(t(i,j));
+      endfor
+    endfor
+  elseif (n != fix(n) || n < 2)
+    t = 0;
+  elseif n < 4
+    t = 1;
+  else
+    q = n./[2:sqrt(n)];
+    t = all (q != fix(q));
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/specfun/legendre.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,120 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{L} =}legendre (@var{n},@var{X})
+## Legendre Function of degree n and order m
+## where all values for m = 0..@var{n} are returned.
+## @var{n} must be a scalar in the range [0..255].
+## The return value has one dimension more than @var{x}.
+##
+## @example
+## The Legendre Function of degree n and order m
+##
+## @group
+##  m        m       2  m/2   d^m
+## P(x) = (-1) * (1-x  )    * ----  P (x)
+##  n                         dx^m   n
+## @end group
+##
+## with:
+## Legendre Polynom of degree n
+##
+## @group
+##           1     d^n   2    n
+## P (x) = ------ [----(x - 1)  ] 
+##  n      2^n n!  dx^n
+## @end group
+##
+## legendre(3,[-1.0 -0.9 -0.8]) returns the matrix
+##
+## @group
+##  x  |   -1.0   |   -0.9   |  -0.8
+## ------------------------------------
+## m=0 | -1.00000 | -0.47250 | -0.08000
+## m=1 |  0.00000 | -1.99420 | -1.98000
+## m=2 |  0.00000 | -2.56500 | -4.32000
+## m=3 |  0.00000 | -1.24229 | -3.24000 
+## @end group
+## @end example
+## @end deftypefn
+
+## Author:	Kai Habel <kai.habel@gmx.de>
+
+function L = legendre (n,x)
+  dfi = do_fortran_indexing;
+  unwind_protect
+    do_fortran_indexing = 1;
+    warning ("legendre is unstable for higher orders");
+    if (nargin != 2)
+      usage ("legendre(n,x)");
+    endif
+
+    if !(is_scalar (n) && n >= 0 && n < 256 && n == fix (n))
+      error ("n must be a scalar n=[0...255]");
+    endif
+
+    if !(is_vector (x) && all (x >= -1 && x <= 1))
+      error ("x must be vector in range -1<=x<=1");
+    endif
+    if (n == 0)
+      L = ones (size (x));
+    elseif (n == 1)
+      L = [x; -x .* sqrt(1 - x .^ 2)];
+    else
+      i = 0:n;
+      a = (-1) .^ i .* bincoeff (n, i);
+      p = [a; zeros(size (a))];
+      p = p(:);
+      p(length (p)) = [];
+      #p contains the polynom (x^2-1)^n
+
+      #now create a vector with 1/(2.^n*n!)*(d/dx).^n
+      d = [((n + rem(n, 2)):-1:(rem (n, 2) + 1)); 2 * ones(fix (n / 2), n)];
+      d = cumsum (d);
+      d = [fliplr(prod (d'))];
+      d = [d; zeros(1, length (d))];
+      d = d(1:n + 1) ./ (2 ^ n *prod (1:n));
+
+      Lp = d' .* p(1:length (d));
+      #Lp contains the Legendre Polynom of degree n
+
+      # now create a polynom matrix with d/dx^m for m=0..n
+      d2 = flipud (triu (ones (n)));
+      d2 = cumsum (d2);
+      d2 = fliplr (cumprod (flipud (d2)));
+      d3 = fliplr (triu (ones (n + 1)));
+      d3(2:n + 1, 1:n) = d2;
+
+      # multiply for each m (d/dx)^m with Lp(n,x)
+      # and evaluate at x
+      Y = zeros(n + 1, length (x));
+      [dr, dc] = size (d3);
+      for m = 0:dr - 1
+        Y(m + 1, :) = polyval (d3(m + 1, 1:(dc - m)) .* Lp(1:(dc - m))', x);
+      endfor
+
+      # calculate (-1)^m*(1-x^2)^(m/2)	for m=0..n at x
+      # and multiply with (d/dx)^m(Pnx)
+      l = length (x);
+      X = kron ((1 - x(:) .^ 2)', ones (n + 1, 1));
+      M = kron ((0:n)', ones (1, l));
+      L = X .^ (M / 2) .* (-1) .^ M .* Y;
+    endif
+  unwind_protect_cleanup
+    do_fortran_indexing = dfi;
+  end_unwind_protect
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/specfun/mod.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,75 @@
+## Copyright (C) 1999-2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: r = mod(x,y)
+##
+## Compute modulo function, handling negative number correctly; i.e., 
+## mod(-1,3) is 2, not -1 as rem(-1,3) returns. 
+## 
+## Note that mod(x,0) returns x.
+
+## Author: Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+## Modified by: Teemu Ikonen <tpikonen@pcu.helsinki.fi>
+
+function r=mod(x,y)
+
+  if nargin != 2,
+    usage("r=mod(x,y)");
+  endif
+
+  nz = y != 0.0;
+  if all(all(nz))
+    r = x - floor(x./y).*y;
+  elseif is_scalar(y)
+    r = x;
+  elseif is_scalar(x)
+    dfi = do_fortran_indexing;
+    unwind_protect
+      do_fortran_indexing = 1;
+      r = x*ones(size(y));
+      y = y(nz);
+      r(nz) = x - floor(x./y).*y;
+    unwind_protect_cleanup
+      do_fortran_indexing = 0;
+    end_unwind_protect
+  else
+    dfi = do_fortran_indexing;
+    unwind_protect
+      do_fortran_indexing = 1;
+      r = x;
+      x = x(nz);
+      y = y(nz);
+      r(nz) = x - floor(x./y).*y;
+    unwind_protect_cleanup
+      do_fortran_indexing = 0;
+    end_unwind_protect
+  endif
+
+endfunction;
+  
+%!assert (mod(5, 3), 2);
+%!assert (mod(-5, 3), 1);
+%!assert (mod(0, 3), 0);
+%!assert (isempty(mod([], [])));
+%!assert (mod([-5, 5, 0], [3, 3, 3]), [1, 2, 0]);
+%!assert (mod([-5; 5; 0], [3; 3; 3]), [1; 2; 0]);
+%!assert (mod([-5, 5; 0, 3], [3, 3 ; 3, 1]), [1, 2 ; 0, 0]);
+%!assert (mod(5, 0), 5);
+%!assert (mod(-5, 0), -5);
+%!assert (mod([-5, 5, 0], [3, 0, 3]), [1, 5, 0]);
+%!assert (mod([-5; 5; 0], [3; 0; 3]), [1; 5; 0]);
+%!assert (mod([-5, 5; 0, 3], [3, 0 ; 3, 1]), [1, 5 ; 0, 0]);
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/specfun/nchoosek.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,69 @@
+## Copyright (c) 1998 Mike Brookes
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## c = nchoosek(n, k)
+##    return c = n!/(k! (n-k)!)
+## A = nchoosek(v, k)
+##    generate all combinations of the elements of vector v taken k at a
+##    time, one row per combination. The resulting A has size
+##    nchoosek(n,k) x k, where n is the length of v.
+
+## Author: Mike Brookes <mike.brookes@ic.ac.uk>
+## From VOICEBOX <http://www.ee.ic.ac.uk/hp/staff/dmb/voicebox/voicebox.html>
+## 2001-02-28 Paul Kienzle
+##    * converted for use in Octave
+##    * renamed from choosenk to nchoosek for compatibility
+##    * choose from vector rather than generating choice indices
+
+function A = nchoosek(v,k)
+
+  if (nargin != 2)
+    usage("A = nchoosek(v,k)");
+  endif
+
+  n = length(v);
+  if n == 1
+    A = prod(k+1:v)/prod(1:v-k);
+  elseif k == 0
+    A = [];
+  elseif k == 1
+    A = v(:);
+  elseif k == n-1
+    A = v(:).';
+    A = reshape (A(ones(n-1,1),:), n, n-1);
+  elseif k == n
+    A = v(:)';
+  else
+    v = v(:);
+    kk = min(k,n-k);
+    n1 = n+1;
+    m = prod(n1-kk:n) / prod(1:kk);
+    x = zeros (m,k);
+    f = n1-k;
+    A(1:f,k) = v(k:n);
+    for a = k-1:-1:1
+      d = h = f;
+      A(1:f,a) = v(a);
+      for b = a+1 : a+n-k
+        d = d*(n1+a-b-k)/(n1-b);
+        e = f+1;
+        f = e+d-1;
+        A(e:f,a) = v(b);
+        A(e:f,a+1:k) = A(h-d+1:h,a+1:k);
+      end
+    end
+  endif
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/specfun/perms.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,38 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## A = perms(v)
+##    generate all permutations of v, one row per permutation.
+##    The resulting A has size n! x n, where n is the length of v
+##    so keep v small!
+function A = perms(v)
+  n = length(v);
+  if (n == 1)
+    A = v;
+  else
+    B = perms(v(1:n-1));
+    Bidx = 1:size(B,1);
+    A = v(n) * ones(prod(2:n), n);
+    A (Bidx, 1:n-1) = B;
+    k = size(B,1);
+    for i = n-1:-1:2
+      A (k+Bidx, 1:i-1) = B(Bidx, 1:i-1);
+      A (k+Bidx, i+1:n) = B(Bidx, i:n-1);
+      k = k + size(B,1);
+    end
+    A (k+Bidx, 2:n) = B;
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/specfun/primes.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,73 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} primes (@var{n})
+## Return all primes up to @var{n}.  
+##
+## Note that if you need a specific number of primes, you can use the
+## fact the distance from one prime to the next is on average
+## proportional to the logarithm of the prime.  Integrating, you find
+## that there are about @math{k} primes less than @math{k \log ( 5 k )}.
+##
+## The algorithm used is called the Sieve of Erastothenes.
+## @end deftypefn
+
+## Author: Paul Kienzle, Francesco Potortì and Dirk Laurie
+
+function x=primes(p)
+  if nargin != 1
+    usage("p = primes(n)");
+  endif
+  if (p > 100000)
+    ## optimization: 1/6 less memory, and much faster (asymptotically)
+    ## 100000 happens to be the cross-over point for Paul's machine;
+    ## below this the more direct code below is faster.  At the limit
+    ## of memory in Paul's machine, this saves .7 seconds out of 7 for
+    ## p=3e6.  Hardly worthwhile, but Dirk reports better numbers.
+    lenm = floor((p+1)/6);        # length of the 6n-1 sieve
+    lenp = floor((p-1)/6);        # length of the 6n+1 sieve
+    sievem = ones (1, lenm);      # assume every number of form 6n-1 is prime
+    sievep = ones (1, lenp);      # assume every number of form 6n+1 is prime
+    for i=1:(sqrt(p)+1)/6         # check up to sqrt(p)
+      if (sievem(i))              # if i is prime, eliminate multiples of i
+        sievem(7*i-1:6*i-1:lenm) = 0;
+        sievep(5*i-1:6*i-1:lenp) = 0;
+      endif                       # if i is prime, eliminate multiples of i
+      if (sievep(i))
+        sievep(7*i+1:6*i+1:lenp) = 0;
+        sievem(5*i+1:6*i+1:lenm) = 0;
+      endif
+    endfor
+    x = sort([2, 3, 6*find(sievem)-1, 6*find(sievep)+1]);
+  elseif (p > 352) # nothing magical about 352; just has to be greater than 2
+    len = floor((p-1)/2);         # length of the sieve
+    sieve = ones (1, len);        # assume every odd number is prime
+    for i=1:(sqrt(p)-1)/2         # check up to sqrt(p)
+      if (sieve(i))               # if i is prime, eliminate multiples of i
+        sieve(3*i+1:2*i+1:len) = 0; # do it
+      endif
+    endfor
+    x = [2, 1+2*find(sieve)];     # primes remaining after sieve
+  else
+    a=[2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, \
+       61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127,   \
+       131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193,\
+       197, 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269,\
+       271, 277, 281, 283, 293, 307, 311, 313, 317, 331, 337, 347, 349];
+    x = x (x<=p);
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/special-matrix/magic.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,74 @@
+## Copyright (C) 1999-2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## magic(n)
+## Create an n-by-n magic square.
+## Note that magic(2) is undefined since there is no 2x2 magic square.
+
+function A = magic(n)
+
+  if nargin != 1 || n != floor(n) || n < 0 || n == 2
+    usage("magic (n), n != 2");
+  endif
+
+  if (n == 0)
+
+    A=[];
+
+  elseif (mod(n,2) == 1)
+
+    shift = floor((0:n*n-1)/n);
+    c = mod ([1:n*n] - shift + (n-3)/2, n);
+    r = mod ([n*n:-1:1] + 2*shift, n);
+    A (c*n+r+1) = 1:n*n;
+    A = reshape (A, n, n);
+
+  elseif (mod(n,4) == 0)
+
+    A = reshape (1:n*n, n, n)';
+    I = [ 1:4:n, 4:4:n ]; J = fliplr(I);
+    A (I, I) = A (J, J);
+    I = [ 2:4:n, 3:4:n ]; J = fliplr(I);
+    A (I, I) = A (J, J);
+
+  elseif (mod(n,4) == 2)
+
+    m = n/2;
+    A = magic (m);
+    A = [ A, A+2*m*m; A+3*m*m, A+m*m ];
+    k = (m-1)/2;
+    if (k>1)
+      I = [ 1 : m ];
+      J = [ 2:k, n-k+2:n ];
+      A ([I,I+m], J) = A ([I+m,I], J);
+    endif
+    I = [1:k, k+2:m];
+    A ([I,I+m], 1) = A ([I+m,I], 1);
+    I = k + 1;
+    A ([I,I+m], I) = A ([I+m,I], I);
+  
+  endif
+
+endfunction
+
+%!test
+%! for i=3:30
+%!   A=magic(i);
+%!   assert(norm(diff([sum(diag(A)),sum(diag(flipud(A))),sum(A),sum(A')])),0)
+%! endfor
+%!assert(isempty(magic(0)));
+%!assert(magic(1),1);
+%!error magic(2)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/special-matrix/pascal.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,68 @@
+## Copyright (C) 1999 Peter Ekberg
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## usage: pascal (n, t)
+##
+## Return the Pascal matrix of order n if t=0.
+## t defaults to 0.
+## Return lower triangular Cholesky factor of the Pascal matrix if t=1.
+## Return a transposed and permuted version of pascal(n,1) if t=2.
+##
+## pascal(n,1)^2 == eye(n)
+## pascal(n,2)^3 == eye(n)
+##
+## See also: hankel, vander, sylvester_matrix, hilb, invhilb, toeplitz
+##           hadamard, wilkinson, rosser, compan
+
+## Author: peda
+
+function retval = pascal (n, t)
+
+  if (nargin > 2) || (nargin == 0)
+    usage ("pascal (n, t)");
+  endif
+
+  if (nargin == 1)
+    t = 0;
+  endif
+
+  if !is_scalar (n) || !is_scalar (t)
+    error ("pascal expecting scalar arguments, found something else");
+  endif
+
+  retval = diag((-1).^[0:n-1]);
+  retval(:,1) = ones(n, 1);
+
+  for j=2:n-1
+    for i=j+1:n
+      retval(i,j) = retval(i-1,j) - retval(i-1,j-1);
+    endfor
+  endfor
+
+  if (t==0)
+    retval = retval*retval';
+  elseif (t==2)
+    retval = retval';
+    retval = retval(n:-1:1,:);
+    retval(:,n) = -retval(:,n);
+    retval(n,:) = -retval(n,:);
+    if (rem(n,2) != 1)
+      retval = -retval;
+    endif
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/special-matrix/rosser.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,42 @@
+## Copyright (C) 1999 Peter Ekberg
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## usage: rosser
+##
+## Return the Rosser matrix.
+##
+## See also: hankel, vander, sylvester_matrix, hilb, invhilb, toeplitz
+##           hadamard, wilkinson, compan, pascal
+
+## Author: peda
+
+function retval = rosser
+
+  if (nargin != 0)
+    usage ("rosser");
+  endif
+
+  retval = [
+    611,   196,  -192,   407,    -8,   -52,   -49,    29;
+    196,   899,   113,  -192,   -71,   -43,    -8,   -44;
+   -192,   113,   899,   196,    61,    49,     8,    52;
+    407,  -192,   196,   611,     8,    44,    59,   -23;
+     -8,   -71,    61,     8,   411,  -599,   208,   208;
+    -52,   -43,    49,    44,  -599,   411,   208,   208;
+    -49,    -8,     8,    59,   208,   208,    99,  -911;
+     29,   -44,    52,   -23,   208,   208,  -911,    99; ];
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/special-matrix/wilkinson.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,42 @@
+## Copyright (C) 1999 Peter Ekberg
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## usage: wilkinson (n)
+##
+## Return the Wilkinson matrix of order n.
+##
+## See also: hankel, vander, sylvester_matrix, hilb, invhilb, toeplitz
+##           hadamard, rosser, compan, pascal
+
+## Author: peda
+
+function retval = wilkinson (n)
+
+  if (nargin != 1)
+    usage ("wilkinson (n)");
+  endif
+
+  nmax = length (n);
+  if ~(nmax == 1)
+    error ("wilkinson: expecting scalar argument, found something else");
+  endif
+
+  side = ones(n-1,1);
+  center = abs(-(n-1)/2:(n-1)/2);
+  retval = diag(side, -1) + diag(center) + diag(side, 1);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,12 @@
+include ../../Makeconf
+
+PROGS = trisolve.oct
+
+all: $(PROGS)
+
+trisolve.oct:
+	$(MKOCTFILE) -v trisolve.cc \
+	dgtsv.f  dptsv.f  dpttrf.f  dpttrs.f  dptts2.f
+
+clean: 
+	$(RM) *.o $(PROGS) octave-core core *~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/csape.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,236 @@
+## Copyright (C) 2000,2001  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{pp} = } csape (@var{x}, @var{y}, @var{cond}, @var{valc})
+## cubic spline interpolation with various end conditions.
+## creates the pp-form of the cubic spline.
+##
+## the following end conditions as given in @var{cond} are possible. 
+## @table @asis
+## @item 'complete'    
+##    match slopes at first and last point as given in @var{valc}
+## @item 'not-a-knot'     
+##    third derivatives are continuous at the second and second last point
+## @item 'periodic' 
+##    match first and second derivative of first and last point
+## @item 'second'
+##    match second derivative at first and last point as given in @var{valc}
+## @item 'variational'
+##    set second derivative at first and last point to zero (natural cubic spline)
+## @end table
+##
+## @seealso{ppval, spline}
+## @end deftypefn
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+## Date: 23. nov 2000
+## Algorithms taken from G. Engeln-Muellges, F. Uhlig:
+## "Numerical Algorithms with C", Springer, 1996
+
+## Paul Kienzle, 19. feb 2001,  csape supports now matrix y value
+
+function pp = csape (x, y, cond, valc)
+
+  x = x(:);
+  n = length(x);
+
+  transpose = (columns(y) == n);
+  if (transpose) y = y'; endif
+
+  a = y;
+  b = c = zeros (size (y));
+  h = diff (x);
+  idx = ones (columns(y),1);
+
+  if (nargin < 3 || strcmp(cond,"complete"))
+    # specified first derivative at end point
+    if (nargin < 4)
+      valc = [0, 0];
+    endif
+
+    dg = 2 * (h(1:n - 2) .+ h(2:n - 1));
+    dg(1) = dg(1) - 0.5 * h(1);
+    dg(n - 2) = dg(n-2) - 0.5 * h(n - 1);
+
+    e = h(2:n - 2);
+
+    g = 3 * diff (a(2:n,:)) ./ h(2:n - 1,idx)\
+      - 3 * diff (a(1:n - 1,:)) ./ h(1:n - 2,idx);
+    g(1,:) = 3 * (a(3,:) - a(2,:)) / h(2) \
+        - 3 / 2 * (3 * (a(2,:) - a(1,:)) / h(1) - valc(1));
+    g(n - 2,:) = 3 / 2 * (3 * (a(n,:) - a(n - 1,:)) / h(n - 1) - valc(2))\
+        - 3 * (a(n - 1,:) - a(n - 2,:)) / h(n - 2);
+
+    c(2:n - 1,:) = trisolve(dg,e,g);
+    c(1,:) = (3 / h(1) * (a(2,:) - a(1,:)) - 3 * valc(1) 
+	      - c(2,:) * h(1)) / (2 * h(1)); 
+    c(n,:) = - (3 / h(n - 1) * (a(n,:) - a(n - 1,:)) - 3 * valc(2) 
+		+ c(n - 1,:) * h(n - 1)) / (2 * h(n - 1));
+    b(1:n - 1,:) = diff (a) ./ h(1:n - 1, idx)\
+      - h(1:n - 1,idx) / 3 .* (c(2:n,:) + 2 * c(1:n - 1,:));
+    d = diff (c) ./ (3 * h(1:n - 1, idx));
+
+  elseif (strcmp(cond,"variational") || strcmp(cond,"second"))
+
+    if ((nargin < 4) || strcmp(cond,"variational"))
+      ## set second derivatives at end points to zero
+      valc = [0, 0];
+    endif
+
+    c(1,:) = valc(1) / 2;
+    c(n,:) = valc(2) / 2;
+
+    g = 3 * diff (a(2:n,:)) ./ h(2:n - 1, idx)\
+      - 3 * diff (a(1:n - 1,:)) ./ h(1:n - 2, idx);
+
+    g(1,:) = g(1,:) - h(1) * c(1,:);
+    g(n - 2,:) = g(n-2,:) - h(n - 1) * c(n,:);
+
+    dg = 2 * (h(1:n - 2) .+ h(2:n - 1));
+    e = h(2:n - 2); 
+    
+    c(2:n - 1,:) = trisolve (dg,e,g);
+    b(1:n - 1,:) = diff (a) ./ h(1:n - 1,idx)\
+      - h(1:n - 1,idx) / 3 .* (c(2:n,:) + 2 * c(1:n - 1,:));
+    d = diff (c) ./ (3 * h(1:n - 1, idx));
+  
+  elseif (strcmp(cond,"periodic"))
+
+    h = [h; h(1)];
+
+    ## XXX FIXME XXX --- the following gives a smoother periodic transition:
+    ##    a(n,:) = a(1,:) = ( a(n,:) + a(1,:) ) / 2;
+    a(n,:) = a(1,:);
+
+    tmp = diff (shift ([a; a(2,:)], -1));
+    g = 3 * tmp(1:n - 1,:) ./ h(2:n,idx)\
+      - 3 * diff (a) ./ h(1:n - 1,idx);
+
+    if (n > 3)
+      dg = 2 * (h(1:n - 1) .+ h(2:n));
+      e = h(2:n - 1);
+      c(2:n,idx) = trisolve(dg,e,g,h(1),h(1));
+    elseif (n == 3)
+      A = [2 * (h(1) + h(2)), (h(1) + h(2));
+          (h(1) + h(2)), 2 * (h(1) + h(2))];
+      c(2:n,idx) = A \ g;
+    endif
+
+    c(1,:) = c(n,:);
+    b = diff (a) ./ h(1:n - 1,idx)\
+      - h(1:n - 1,idx) / 3 .* (c(2:n,:) + 2 * c(1:n - 1,:));
+    b(n,:) = b(1,:);
+    d = diff (c) ./ (3 * h(1:n - 1, idx));
+    d(n,:) = d(1,:);
+
+  elseif (strcmp(cond,"not-a-knot"))
+
+    if (n > 4)
+
+      dg = 2 * (h(1:n - 2) .+ h(2:n - 1));
+      dg(1) = dg(1) - h(1);
+      dg(n - 2) = dg(n-2) - h(n - 1);
+
+      ldg = udg = h(2:n - 2);
+      udg(1) = udg(1) - h(1);
+      ldg(n - 3) = ldg(n-3) - h(n - 1);
+ 
+    elseif (n == 4)
+
+      dg = [h(1) + 2 * h(2), 2 * h(2) + h(3)];
+      ldg = h(2) - h(3);
+      udg = h(2) - h(1);
+
+    endif
+    g = zeros(n - 2,columns(y));
+    g(1,:) = 3 / (h(1) + h(2)) * (a(3,:) - a(2,:)\
+          - h(2) / h(1) * (a(2,:) - a(1,:)));
+    if (n > 4)
+      g(2:n - 3,:) = 3 * diff (a(3:n - 1,:)) ./ h(2:n - 3,idx)\
+        - 3 * diff (a(2:n - 2,:)) ./ h(1:n - 4,idx);
+    endif
+    g(n - 2,:) = 3 / (h(n - 1) + h(n - 2)) *\
+ 	(h(n - 2) / h(n - 1) * (a(n,:) - a(n - 1,:)) -\
+	 (a(n - 1,:) - a(n - 2,:)));
+    c(2:n - 1,:) = trisolve(ldg,dg,udg,g);
+    c(1,:) = c(2,:) + h(1) / h(2) * (c(2,:) - c(3,:));
+    c(n,:) = c(n - 1,:) + h(n - 1) / h(n - 2) * (c(n - 1,:) - c(n - 2,:));
+    b = diff (a) ./ h(1:n - 1, idx)\
+      - h(1:n - 1, idx) / 3 .* (c(2:n,:) + 2 * c(1:n - 1,:));
+    d = diff (c) ./ (3 * h(1:n - 1, idx));
+
+  else
+    msg = sprintf("unknown end condition: %s",cond);
+    error (msg);
+  endif
+
+  d = d(1:n-1,:); c=c(1:n-1,:); b=b(1:n-1,:); a=a(1:n-1,:);
+  coeffs = [d(:), c(:), b(:), a(:)];
+  pp = mkpp (x, coeffs);
+
+endfunction
+
+
+%!shared x,y,cond
+%! x = linspace(0,2*pi,15)'; y = sin(x);
+
+%!assert (ppval(csape(x,y),x), y, 10*eps);
+%!assert (ppval(csape(x,y),x'), y', 10*eps);
+%!assert (ppval(csape(x',y'),x'), y', 10*eps);
+%!assert (ppval(csape(x',y'),x), y, 10*eps);
+%!assert (ppval(csape(x,[y,y]),x), \
+%!	  [ppval(csape(x,y),x),ppval(csape(x,y),x)], 10*eps)
+
+%!test cond='complete';
+%!assert (ppval(csape(x,y,cond),x), y, 10*eps);
+%!assert (ppval(csape(x,y,cond),x'), y', 10*eps);
+%!assert (ppval(csape(x',y',cond),x'), y', 10*eps);
+%!assert (ppval(csape(x',y',cond),x), y, 10*eps);
+%!assert (ppval(csape(x,[y,y],cond),x), \
+%!	  [ppval(csape(x,y,cond),x),ppval(csape(x,y,cond),x)], 10*eps)
+
+%!test cond='variational';
+%!assert (ppval(csape(x,y,cond),x), y, 10*eps);
+%!assert (ppval(csape(x,y,cond),x'), y', 10*eps);
+%!assert (ppval(csape(x',y',cond),x'), y', 10*eps);
+%!assert (ppval(csape(x',y',cond),x), y, 10*eps);
+%!assert (ppval(csape(x,[y,y],cond),x), \
+%!	  [ppval(csape(x,y,cond),x),ppval(csape(x,y,cond),x)], 10*eps)
+
+%!test cond='second';
+%!assert (ppval(csape(x,y,cond),x), y, 10*eps);
+%!assert (ppval(csape(x,y,cond),x'), y', 10*eps);
+%!assert (ppval(csape(x',y',cond),x'), y', 10*eps);
+%!assert (ppval(csape(x',y',cond),x), y, 10*eps);
+%!assert (ppval(csape(x,[y,y],cond),x), \
+%!	  [ppval(csape(x,y,cond),x),ppval(csape(x,y,cond),x)], 10*eps)
+
+%!test cond='periodic';
+%!assert (ppval(csape(x,y,cond),x), y, 10*eps);
+%!assert (ppval(csape(x,y,cond),x'), y', 10*eps);
+%!assert (ppval(csape(x',y',cond),x'), y', 10*eps);
+%!assert (ppval(csape(x',y',cond),x), y, 10*eps);
+%!assert (ppval(csape(x,[y,y],cond),x), \
+%!	  [ppval(csape(x,y,cond),x),ppval(csape(x,y,cond),x)], 10*eps)
+
+%!test cond='not-a-knot';
+%!assert (ppval(csape(x,y,cond),x), y, 10*eps);
+%!assert (ppval(csape(x,y,cond),x'), y', 10*eps);
+%!assert (ppval(csape(x',y',cond),x'), y', 10*eps);
+%!assert (ppval(csape(x',y',cond),x), y, 10*eps);
+%!assert (ppval(csape(x,[y,y],cond),x), \
+%!	  [ppval(csape(x,y,cond),x),ppval(csape(x,y,cond),x)], 10*eps)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/csapi.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,36 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{pp} = } csapi (@var{x}, @var{y})
+## @deftypefnx {Function File} {@var{yi} = } csapi (@var{x}, @var{y}, @var{xi})
+## cubic spline interpolation
+##
+## @seealso{ppval, spline, csape}
+## @end deftypefn
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+## Date: 3. dec 2000
+
+function ret = csapi (x, y, xi)
+
+  ret = csape(x,y,'not-a-knot');
+
+  if (nargin == 3)
+    ret = ppval(ret,xi);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/dgtsv.f	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,263 @@
+      SUBROUTINE DGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
+*
+*  -- LAPACK routine (version 3.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Courant Institute, Argonne National Lab, and Rice University
+*     October 31, 1999
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDB, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   B( LDB, * ), D( * ), DL( * ), DU( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DGTSV  solves the equation
+*
+*     A*X = B,
+*
+*  where A is an n by n tridiagonal matrix, by Gaussian elimination with
+*  partial pivoting.
+*
+*  Note that the equation  A'*X = B  may be solved by interchanging the
+*  order of the arguments DU and DL.
+*
+*  Arguments
+*  =========
+*
+*  N       (input) INTEGER
+*          The order of the matrix A.  N >= 0.
+*
+*  NRHS    (input) INTEGER
+*          The number of right hand sides, i.e., the number of columns
+*          of the matrix B.  NRHS >= 0.
+*
+*  DL      (input/output) DOUBLE PRECISION array, dimension (N-1)
+*          On entry, DL must contain the (n-1) sub-diagonal elements of
+*          A.
+*
+*          On exit, DL is overwritten by the (n-2) elements of the
+*          second super-diagonal of the upper triangular matrix U from
+*          the LU factorization of A, in DL(1), ..., DL(n-2).
+*
+*  D       (input/output) DOUBLE PRECISION array, dimension (N)
+*          On entry, D must contain the diagonal elements of A.
+*
+*          On exit, D is overwritten by the n diagonal elements of U.
+*
+*  DU      (input/output) DOUBLE PRECISION array, dimension (N-1)
+*          On entry, DU must contain the (n-1) super-diagonal elements
+*          of A.
+*
+*          On exit, DU is overwritten by the (n-1) elements of the first
+*          super-diagonal of U.
+*
+*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+*          On entry, the N by NRHS matrix of right hand side matrix B.
+*          On exit, if INFO = 0, the N by NRHS solution matrix X.
+*
+*  LDB     (input) INTEGER
+*          The leading dimension of the array B.  LDB >= max(1,N).
+*
+*  INFO    (output) INTEGER
+*          = 0: successful exit
+*          < 0: if INFO = -i, the i-th argument had an illegal value
+*          > 0: if INFO = i, U(i,i) is exactly zero, and the solution
+*               has not been computed.  The factorization has not been
+*               completed unless i = N.
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER          ( ZERO = 0.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, J
+      DOUBLE PRECISION   FACT, TEMP
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      IF( N.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -7
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DGTSV ', -INFO )
+         RETURN
+      END IF
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( NRHS.EQ.1 ) THEN
+         DO 10 I = 1, N - 2
+            IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
+*
+*              No row interchange required
+*
+               IF( D( I ).NE.ZERO ) THEN
+                  FACT = DL( I ) / D( I )
+                  D( I+1 ) = D( I+1 ) - FACT*DU( I )
+                  B( I+1, 1 ) = B( I+1, 1 ) - FACT*B( I, 1 )
+               ELSE
+                  INFO = I
+                  RETURN
+               END IF
+               DL( I ) = ZERO
+            ELSE
+*
+*              Interchange rows I and I+1
+*
+               FACT = D( I ) / DL( I )
+               D( I ) = DL( I )
+               TEMP = D( I+1 )
+               D( I+1 ) = DU( I ) - FACT*TEMP
+               DL( I ) = DU( I+1 )
+               DU( I+1 ) = -FACT*DL( I )
+               DU( I ) = TEMP
+               TEMP = B( I, 1 )
+               B( I, 1 ) = B( I+1, 1 )
+               B( I+1, 1 ) = TEMP - FACT*B( I+1, 1 )
+            END IF
+   10    CONTINUE
+         IF( N.GT.1 ) THEN
+            I = N - 1
+            IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
+               IF( D( I ).NE.ZERO ) THEN
+                  FACT = DL( I ) / D( I )
+                  D( I+1 ) = D( I+1 ) - FACT*DU( I )
+                  B( I+1, 1 ) = B( I+1, 1 ) - FACT*B( I, 1 )
+               ELSE
+                  INFO = I
+                  RETURN
+               END IF
+            ELSE
+               FACT = D( I ) / DL( I )
+               D( I ) = DL( I )
+               TEMP = D( I+1 )
+               D( I+1 ) = DU( I ) - FACT*TEMP
+               DU( I ) = TEMP
+               TEMP = B( I, 1 )
+               B( I, 1 ) = B( I+1, 1 )
+               B( I+1, 1 ) = TEMP - FACT*B( I+1, 1 )
+            END IF
+         END IF
+         IF( D( N ).EQ.ZERO ) THEN
+            INFO = N
+            RETURN
+         END IF
+      ELSE
+         DO 40 I = 1, N - 2
+            IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
+*
+*              No row interchange required
+*
+               IF( D( I ).NE.ZERO ) THEN
+                  FACT = DL( I ) / D( I )
+                  D( I+1 ) = D( I+1 ) - FACT*DU( I )
+                  DO 20 J = 1, NRHS
+                     B( I+1, J ) = B( I+1, J ) - FACT*B( I, J )
+   20             CONTINUE
+               ELSE
+                  INFO = I
+                  RETURN
+               END IF
+               DL( I ) = ZERO
+            ELSE
+*
+*              Interchange rows I and I+1
+*
+               FACT = D( I ) / DL( I )
+               D( I ) = DL( I )
+               TEMP = D( I+1 )
+               D( I+1 ) = DU( I ) - FACT*TEMP
+               DL( I ) = DU( I+1 )
+               DU( I+1 ) = -FACT*DL( I )
+               DU( I ) = TEMP
+               DO 30 J = 1, NRHS
+                  TEMP = B( I, J )
+                  B( I, J ) = B( I+1, J )
+                  B( I+1, J ) = TEMP - FACT*B( I+1, J )
+   30          CONTINUE
+            END IF
+   40    CONTINUE
+         IF( N.GT.1 ) THEN
+            I = N - 1
+            IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
+               IF( D( I ).NE.ZERO ) THEN
+                  FACT = DL( I ) / D( I )
+                  D( I+1 ) = D( I+1 ) - FACT*DU( I )
+                  DO 50 J = 1, NRHS
+                     B( I+1, J ) = B( I+1, J ) - FACT*B( I, J )
+   50             CONTINUE
+               ELSE
+                  INFO = I
+                  RETURN
+               END IF
+            ELSE
+               FACT = D( I ) / DL( I )
+               D( I ) = DL( I )
+               TEMP = D( I+1 )
+               D( I+1 ) = DU( I ) - FACT*TEMP
+               DU( I ) = TEMP
+               DO 60 J = 1, NRHS
+                  TEMP = B( I, J )
+                  B( I, J ) = B( I+1, J )
+                  B( I+1, J ) = TEMP - FACT*B( I+1, J )
+   60          CONTINUE
+            END IF
+         END IF
+         IF( D( N ).EQ.ZERO ) THEN
+            INFO = N
+            RETURN
+         END IF
+      END IF
+*
+*     Back solve with the matrix U from the factorization.
+*
+      IF( NRHS.LE.2 ) THEN
+         J = 1
+   70    CONTINUE
+         B( N, J ) = B( N, J ) / D( N )
+         IF( N.GT.1 )
+     $      B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) / D( N-1 )
+         DO 80 I = N - 2, 1, -1
+            B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DL( I )*
+     $                  B( I+2, J ) ) / D( I )
+   80    CONTINUE
+         IF( J.LT.NRHS ) THEN
+            J = J + 1
+            GO TO 70
+         END IF
+      ELSE
+         DO 100 J = 1, NRHS
+            B( N, J ) = B( N, J ) / D( N )
+            IF( N.GT.1 )
+     $         B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
+     $                       D( N-1 )
+            DO 90 I = N - 2, 1, -1
+               B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DL( I )*
+     $                     B( I+2, J ) ) / D( I )
+   90       CONTINUE
+  100    CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of DGTSV
+*
+      END
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/dptsv.f	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,100 @@
+      SUBROUTINE DPTSV( N, NRHS, D, E, B, LDB, INFO )
+*
+*  -- LAPACK routine (version 3.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Courant Institute, Argonne National Lab, and Rice University
+*     February 25, 1997
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDB, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   B( LDB, * ), D( * ), E( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DPTSV computes the solution to a real system of linear equations
+*  A*X = B, where A is an N-by-N symmetric positive definite tridiagonal
+*  matrix, and X and B are N-by-NRHS matrices.
+*
+*  A is factored as A = L*D*L**T, and the factored form of A is then
+*  used to solve the system of equations.
+*
+*  Arguments
+*  =========
+*
+*  N       (input) INTEGER
+*          The order of the matrix A.  N >= 0.
+*
+*  NRHS    (input) INTEGER
+*          The number of right hand sides, i.e., the number of columns
+*          of the matrix B.  NRHS >= 0.
+*
+*  D       (input/output) DOUBLE PRECISION array, dimension (N)
+*          On entry, the n diagonal elements of the tridiagonal matrix
+*          A.  On exit, the n diagonal elements of the diagonal matrix
+*          D from the factorization A = L*D*L**T.
+*
+*  E       (input/output) DOUBLE PRECISION array, dimension (N-1)
+*          On entry, the (n-1) subdiagonal elements of the tridiagonal
+*          matrix A.  On exit, the (n-1) subdiagonal elements of the
+*          unit bidiagonal factor L from the L*D*L**T factorization of
+*          A.  (E can also be regarded as the superdiagonal of the unit
+*          bidiagonal factor U from the U**T*D*U factorization of A.)
+*
+*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+*          On entry, the N-by-NRHS right hand side matrix B.
+*          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+*
+*  LDB     (input) INTEGER
+*          The leading dimension of the array B.  LDB >= max(1,N).
+*
+*  INFO    (output) INTEGER
+*          = 0:  successful exit
+*          < 0:  if INFO = -i, the i-th argument had an illegal value
+*          > 0:  if INFO = i, the leading minor of order i is not
+*                positive definite, and the solution has not been
+*                computed.  The factorization has not been completed
+*                unless i = N.
+*
+*  =====================================================================
+*
+*     .. External Subroutines ..
+      EXTERNAL           DPTTRF, DPTTRS, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF( N.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DPTSV ', -INFO )
+         RETURN
+      END IF
+*
+*     Compute the L*D*L' (or U'*D*U) factorization of A.
+*
+      CALL DPTTRF( N, D, E, INFO )
+      IF( INFO.EQ.0 ) THEN
+*
+*        Solve the system A*X = B, overwriting B with X.
+*
+         CALL DPTTRS( N, NRHS, D, E, B, LDB, INFO )
+      END IF
+      RETURN
+*
+*     End of DPTSV
+*
+      END
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/dpttrf.f	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,153 @@
+      SUBROUTINE DPTTRF( N, D, E, INFO )
+*
+*  -- LAPACK routine (version 3.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Courant Institute, Argonne National Lab, and Rice University
+*     June 30, 1999
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   D( * ), E( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DPTTRF computes the L*D*L' factorization of a real symmetric
+*  positive definite tridiagonal matrix A.  The factorization may also
+*  be regarded as having the form A = U'*D*U.
+*
+*  Arguments
+*  =========
+*
+*  N       (input) INTEGER
+*          The order of the matrix A.  N >= 0.
+*
+*  D       (input/output) DOUBLE PRECISION array, dimension (N)
+*          On entry, the n diagonal elements of the tridiagonal matrix
+*          A.  On exit, the n diagonal elements of the diagonal matrix
+*          D from the L*D*L' factorization of A.
+*
+*  E       (input/output) DOUBLE PRECISION array, dimension (N-1)
+*          On entry, the (n-1) subdiagonal elements of the tridiagonal
+*          matrix A.  On exit, the (n-1) subdiagonal elements of the
+*          unit bidiagonal factor L from the L*D*L' factorization of A.
+*          E can also be regarded as the superdiagonal of the unit
+*          bidiagonal factor U from the U'*D*U factorization of A.
+*
+*  INFO    (output) INTEGER
+*          = 0: successful exit
+*          < 0: if INFO = -k, the k-th argument had an illegal value
+*          > 0: if INFO = k, the leading minor of order k is not
+*               positive definite; if k < N, the factorization could not
+*               be completed, while if k = N, the factorization was
+*               completed, but D(N) = 0.
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER          ( ZERO = 0.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, I4
+      DOUBLE PRECISION   EI
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF( N.LT.0 ) THEN
+         INFO = -1
+         CALL XERBLA( 'DPTTRF', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     Compute the L*D*L' (or U'*D*U) factorization of A.
+*
+      I4 = MOD( N-1, 4 )
+      DO 10 I = 1, I4
+         IF( D( I ).LE.ZERO ) THEN
+            INFO = I
+            GO TO 30
+         END IF
+         EI = E( I )
+         E( I ) = EI / D( I )
+         D( I+1 ) = D( I+1 ) - E( I )*EI
+   10 CONTINUE
+*
+      DO 20 I = I4 + 1, N - 4, 4
+*
+*        Drop out of the loop if d(i) <= 0: the matrix is not positive
+*        definite.
+*
+         IF( D( I ).LE.ZERO ) THEN
+            INFO = I
+            GO TO 30
+         END IF
+*
+*        Solve for e(i) and d(i+1).
+*
+         EI = E( I )
+         E( I ) = EI / D( I )
+         D( I+1 ) = D( I+1 ) - E( I )*EI
+*
+         IF( D( I+1 ).LE.ZERO ) THEN
+            INFO = I + 1
+            GO TO 30
+         END IF
+*
+*        Solve for e(i+1) and d(i+2).
+*
+         EI = E( I+1 )
+         E( I+1 ) = EI / D( I+1 )
+         D( I+2 ) = D( I+2 ) - E( I+1 )*EI
+*
+         IF( D( I+2 ).LE.ZERO ) THEN
+            INFO = I + 2
+            GO TO 30
+         END IF
+*
+*        Solve for e(i+2) and d(i+3).
+*
+         EI = E( I+2 )
+         E( I+2 ) = EI / D( I+2 )
+         D( I+3 ) = D( I+3 ) - E( I+2 )*EI
+*
+         IF( D( I+3 ).LE.ZERO ) THEN
+            INFO = I + 3
+            GO TO 30
+         END IF
+*
+*        Solve for e(i+3) and d(i+4).
+*
+         EI = E( I+3 )
+         E( I+3 ) = EI / D( I+3 )
+         D( I+4 ) = D( I+4 ) - E( I+3 )*EI
+   20 CONTINUE
+*
+*     Check d(n) for positive definiteness.
+*
+      IF( D( N ).LE.ZERO )
+     $   INFO = N
+*
+   30 CONTINUE
+      RETURN
+*
+*     End of DPTTRF
+*
+      END
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/dpttrs.f	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,115 @@
+      SUBROUTINE DPTTRS( N, NRHS, D, E, B, LDB, INFO )
+*
+*  -- LAPACK routine (version 3.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Courant Institute, Argonne National Lab, and Rice University
+*     June 30, 1999
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDB, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   B( LDB, * ), D( * ), E( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DPTTRS solves a tridiagonal system of the form
+*     A * X = B
+*  using the L*D*L' factorization of A computed by DPTTRF.  D is a
+*  diagonal matrix specified in the vector D, L is a unit bidiagonal
+*  matrix whose subdiagonal is specified in the vector E, and X and B
+*  are N by NRHS matrices.
+*
+*  Arguments
+*  =========
+*
+*  N       (input) INTEGER
+*          The order of the tridiagonal matrix A.  N >= 0.
+*
+*  NRHS    (input) INTEGER
+*          The number of right hand sides, i.e., the number of columns
+*          of the matrix B.  NRHS >= 0.
+*
+*  D       (input) DOUBLE PRECISION array, dimension (N)
+*          The n diagonal elements of the diagonal matrix D from the
+*          L*D*L' factorization of A.
+*
+*  E       (input) DOUBLE PRECISION array, dimension (N-1)
+*          The (n-1) subdiagonal elements of the unit bidiagonal factor
+*          L from the L*D*L' factorization of A.  E can also be regarded
+*          as the superdiagonal of the unit bidiagonal factor U from the
+*          factorization A = U'*D*U.
+*
+*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+*          On entry, the right hand side vectors B for the system of
+*          linear equations.
+*          On exit, the solution vectors, X.
+*
+*  LDB     (input) INTEGER
+*          The leading dimension of the array B.  LDB >= max(1,N).
+*
+*  INFO    (output) INTEGER
+*          = 0: successful exit
+*          < 0: if INFO = -k, the k-th argument had an illegal value
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER            J, JB, NB
+*     ..
+*     .. External Functions ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DPTTS2, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments.
+*
+      INFO = 0
+      IF( N.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DPTTRS', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 .OR. NRHS.EQ.0 )
+     $   RETURN
+*
+*     Determine the number of right-hand sides to solve at a time.
+*
+      IF( NRHS.EQ.1 ) THEN
+         NB = 1
+      ELSE
+         NB = MAX( 1, ILAENV( 1, 'DPTTRS', ' ', N, NRHS, -1, -1 ) )
+      END IF
+*
+      IF( NB.GE.NRHS ) THEN
+         CALL DPTTS2( N, NRHS, D, E, B, LDB )
+      ELSE
+         DO 10 J = 1, NRHS, NB
+            JB = MIN( NRHS-J+1, NB )
+            CALL DPTTS2( N, JB, D, E, B( 1, J ), LDB )
+   10    CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of DPTTRS
+*
+      END
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/dptts2.f	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,94 @@
+      SUBROUTINE DPTTS2( N, NRHS, D, E, B, LDB )
+*
+*  -- LAPACK routine (version 3.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Courant Institute, Argonne National Lab, and Rice University
+*     June 30, 1999
+*
+*     .. Scalar Arguments ..
+      INTEGER            LDB, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   B( LDB, * ), D( * ), E( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DPTTS2 solves a tridiagonal system of the form
+*     A * X = B
+*  using the L*D*L' factorization of A computed by DPTTRF.  D is a
+*  diagonal matrix specified in the vector D, L is a unit bidiagonal
+*  matrix whose subdiagonal is specified in the vector E, and X and B
+*  are N by NRHS matrices.
+*
+*  Arguments
+*  =========
+*
+*  N       (input) INTEGER
+*          The order of the tridiagonal matrix A.  N >= 0.
+*
+*  NRHS    (input) INTEGER
+*          The number of right hand sides, i.e., the number of columns
+*          of the matrix B.  NRHS >= 0.
+*
+*  D       (input) DOUBLE PRECISION array, dimension (N)
+*          The n diagonal elements of the diagonal matrix D from the
+*          L*D*L' factorization of A.
+*
+*  E       (input) DOUBLE PRECISION array, dimension (N-1)
+*          The (n-1) subdiagonal elements of the unit bidiagonal factor
+*          L from the L*D*L' factorization of A.  E can also be regarded
+*          as the superdiagonal of the unit bidiagonal factor U from the
+*          factorization A = U'*D*U.
+*
+*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+*          On entry, the right hand side vectors B for the system of
+*          linear equations.
+*          On exit, the solution vectors, X.
+*
+*  LDB     (input) INTEGER
+*          The leading dimension of the array B.  LDB >= max(1,N).
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER            I, J
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DSCAL
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick return if possible
+*
+      IF( N.LE.1 ) THEN
+         IF( N.EQ.1 )
+     $      CALL DSCAL( NRHS, 1.D0 / D( 1 ), B, LDB )
+         RETURN
+      END IF
+*
+*     Solve A * X = B using the factorization A = L*D*L',
+*     overwriting each right hand side vector with its solution.
+*
+      DO 30 J = 1, NRHS
+*
+*           Solve L * x = b.
+*
+         DO 10 I = 2, N
+            B( I, J ) = B( I, J ) - B( I-1, J )*E( I-1 )
+   10    CONTINUE
+*
+*           Solve D * L' * x = b.
+*
+         B( N, J ) = B( N, J ) / D( N )
+         DO 20 I = N - 1, 1, -1
+            B( I, J ) = B( I, J ) / D( I ) - B( I+1, J )*E( I )
+   20    CONTINUE
+   30 CONTINUE
+*
+      RETURN
+*
+*     End of DPTTS2
+*
+      END
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/fnder.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,50 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} { } fnder (@var{pp}, @var(order))
+## differentiate the spline in pp-form 
+##
+## @seealso{ppval}
+## @end deftypefn
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+## Date: 20. feb 2001
+
+function dpp = fnder (pp, o)
+
+  if (nargin < 1 || nargin > 2)
+    usage ("fnder (pp [, order])");
+  endif
+  if (nargin < 2)
+    o = 1;
+  endif
+  
+  P = pp.P;
+  c = columns (P);
+  r = rows (P);
+
+  for i = 1:o
+    #pp.P = polyder (pp.P); matrix capable polyder is needed.
+    P = P(:, 1:c - 1) .* kron ((c - 1):- 1:1, ones (r,1));
+    c = columns (P);
+  endfor
+
+  dpp = pp;
+  dpp.P = P;
+  dpp.k = c;
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/fnplt.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,61 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} { } fnplt (@var{pp}, '@var(plt)')
+## plots spline 
+##
+## @seealso{ppval, spline, csape}
+## @end deftypefn
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+## Date: 3. dec 2000
+## 2001-02-19 Paul Kienzle
+##   * use pp.x rather than just x in linspace; add plt parameter
+##   * return points instead of plotting them if desired
+##   * also plot control points
+##   * added demo
+
+function [x, y] = fnplt (pp, plt)
+
+  if (nargin < 1 || nargin > 2)
+    usage ("[x, y] = fnplt (pp [, plotstring])");
+  endif
+  if (nargin < 2)
+    plt = "r;;";
+  endif
+  xi = linspace(min(pp.x),max(pp.x),256)';
+  pts = ppval(pp,xi);
+  if nargout == 2
+    x = xi;
+    y = pts;
+  elseif nargout == 1
+    x = [xi, pts];
+  else
+    plot(xi,pts,plt,pp.x,ppval(pp,pp.x),"bx;;");
+  endif
+
+endfunction
+
+%!demo
+%! x = [ 0; sort(rand(25,1)); 1 ];
+%! pp = csape (x, sin (2*pi*3*x), 'periodic');
+%! axis([0,1,-2,2]); 
+%! title('Periodic spline reconstruction of randomly sampled sine');
+%! fnplt (pp,'r;reconstruction;'); 
+%! t=linspace(0,1,100); y=sin(2*pi*3*t);
+%! hold on; plot(t,y,'g;ideal;'); hold off;
+%! axis; title("");
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/mkpp.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,54 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: pp = mkpp(x, P)
+## Construct a piece-wise polynomial structure from sample points x and
+## coefficients P.  The ith row of P, P(i,:), contains the coefficients 
+## for the polynomial over the ith interval, ordered from highest to 
+## lowest. There must be one row for each interval in x, so 
+## rows(P) == length(x)-1.  
+##
+## You can concatenate multiple polynomials of the same order over the 
+## same set of intervals using P = [ P1 ; P2 ; ... ; Pd ].  In this case,
+## rows(P) == d*(length(x)-1).
+##
+## mkpp(x, P, d) is provided for compatibility, but if d is not specified
+## it will be computed as round(rows(P)/(length(x)-1)) instead of defaulting
+## to 1.
+
+function pp = mkpp(x, P, d)
+  if nargin < 2 || nargin > 3
+    usage("pp = mkpp(x,P,d)");
+  endif
+  pp.x = x(:);
+  pp.P = P;
+  pp.n = length(x) - 1;
+  pp.k = columns(P);
+  if nargin < 3, d = round(rows(P)/pp.n); endif
+  pp.d = d;
+  if (pp.n*d != rows(P))
+    error("mkpp: num intervals in x doesn't match num polynomials in P");
+  endif
+endfunction
+
+%!demo # linear interpolation
+%! x=linspace(0,pi,5)'; 
+%! t=[sin(x),cos(x)];
+%! m=diff(t)./(x(2)-x(1)); 
+%! b=t(1:4,:);
+%! pp = mkpp(x, [m(:),b(:)]);
+%! xi=linspace(0,pi,50);
+%! plot(x,t,"x;control;",xi,ppval(pp,xi),";interp;");
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/pchip.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,87 @@
+## Copyright (C) 2001  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{pp} = } pchip (@var{x}, @var{y})
+## @deftypefnx {Function File} {@var{yi} = } pchip (@var{x}, @var{y}, @var{xi})
+## piecewise cubic hermite interpolating polynom.
+## pchip preserves the monotonicity of (x,y)
+##
+## @seealso{ppval, spline, csape}
+## @end deftypefn
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+## Date: 9. mar 2001
+## 2001-04-03 Paul Kienzle
+##   * move (:) from definition of l,r to use of l,r so it works with 2.0
+
+## S_k = a_k + b_k*x + c_k*x^2 + d_k*x^3; (spline polynom)
+##
+## 4 conditions:
+## S_k(x_k) = y_k;
+## S_k(x_k+1) = y_k+1;
+## S_k'(x_k) = y_k';
+## S_k'(x_k+1) = y_k+1';
+##
+## 22. april 2001: Hmm, something is wrong, it seems pchip doesn't 
+## preserve the monotonicity, as expected. So if _you_ know how to
+## do it right, please contact me. Kai
+
+function ret = pchip (x, y, xi)
+
+  if (nargin < 2 || nargin > 3)
+    usage ("pchip (x, y, [xi])");
+  endif
+
+  x = x(:);
+  n = length (x);
+
+  if (columns(y) == n) y = y'; endif
+
+  [ry,cy] = size (y);
+  if (cy > 1)
+    h = kron (diff (x), ones (1, cy));
+  else
+    h = diff (x);
+  endif
+
+  a = y;
+  
+  dy = diff (y) ./ h;
+  t = diff (sign (dy)) == 0;
+  l = dy(1:n - 2, :);
+  r = dy(2:n - 1, :);
+  b = zeros (size (y));
+  s = reshape (0.5 * (l(:) + r(:)), ry - 2, cy);
+  b(2:ry - 1,:) = s .* t;
+
+  c = - (b(2:n, :) + 2 * b(1:n - 1, :)) ./ h + 3 * diff (a) ./ h .^ 2;
+
+  d = (b(1:n - 1, :) + b(2:n, :)) ./ h.^2 - 2 * diff (a) ./ h.^3;
+
+  d = d(1:n - 1, :); c = c(1:n - 1, :);
+  b = b(1:n - 1, :); a = a(1:n - 1, :);
+
+  coeffs = [d(:), c(:), b(:), a(:)];
+  pp = mkpp (x, coeffs);
+
+  if (nargin == 2)
+    ret = pp;
+  else
+    ret = ppval(pp,xi);
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/ppval.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,48 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: yi = ppval(pp, xi)
+## Evaluate piece-wise polynomial pp and points xi.  If pp.d > 1,
+## the returned yi will be a matrix of size rows(xi) by pp.d, or
+## its transpose if xi is a row vector.
+
+function yi = ppval(pp, xi)
+  if nargin != 2
+    usage("yi = ppval(pp, xi)")
+  endif
+  if !isstruct(pp)
+    error("ppval: expects a pp structure");
+  endif
+  if (isempty (xi))
+    yi = [];
+  else
+    transposed = (rows(xi) == 1);
+    [nr, nc] = size(xi);
+    xi = xi(:);
+    idx = lookup(pp.x(2:pp.n), xi) + 1;
+    dx = xi - pp.x(idx);
+    dx = dx(:,ones(1,pp.d));
+    c = reshape (pp.P(:, 1), pp.n, pp.d);
+    yi = c(idx, :);
+    for i  = 2 : pp.k;
+      c = reshape (pp.P(:, i), pp.n, pp.d);
+      yi = yi .* dx + c(idx, :);
+    endfor
+    if (transposed)
+      yi = yi.';
+    endif
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/spline.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,59 @@
+## Copyright (C) 2000  Kai Habel
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{pp} = } spline (@var{x}, @var{y})
+## @deftypefnx {Function File} {@var{yi} = } spline (@var{x}, @var{y}, @var{xi})
+## cubic spline interpolation
+##
+## @seealso{ppval, csapi, csape}
+## @end deftypefn
+
+
+## Author:  Kai Habel <kai.habel@gmx.de>
+## Date: 3. dec 2000
+## 2001-02-08 Paul Kienzle
+##   * copied from csapi.m
+
+function ret = spline (x, y, xi)
+
+  ret = csape (x, y, 'not-a-knot');
+
+  if (nargin == 3)
+    ret = ppval (ret, xi);
+  endif
+
+endfunction
+
+%!demo
+%! x = 0:10; y = sin(x);
+%! xspline = 0:0.1:10; yspline = spline(x,y,xspline);
+%! title("spline fit to points from sin(x)");
+%! plot(xspline,sin(xspline),";original;",...
+%!      xspline,yspline,"-;interpolation;",...
+%!      x,y,"+;interpolation points;");
+%! %--------------------------------------------------------
+%! % confirm that interpolated function matches the original
+
+%!shared x,y
+%! x = [0:10]'; y = sin(x);
+%!assert (spline(x,y,x), y);
+%!assert (spline(x,y,x'), y');
+%!assert (spline(x',y',x'), y');
+%!assert (spline(x',y',x), y);
+%!assert (isempty(spline(x',y',[])));
+%!assert (isempty(spline(x,y,[])));
+%!assert (spline(x,[y,y],x), [spline(x,y,x),spline(x,y,x)])
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/trisolve.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,255 @@
+/* Copyright (C) 2001  Kai Habel
+**
+** This program is free software; you can redistribute it and/or modify
+** it under the terms of the GNU General Public License as published by
+** the Free Software Foundation; either version 2 of the License, or
+** (at your option) any later version.
+**
+** This program is distributed in the hope that it will be useful,
+** but WITHOUT ANY WARRANTY; without even the implied warranty of
+** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+** GNU General Public License for more details.
+**
+** You should have received a copy of the GNU General Public License
+** along with this program; if not, write to the Free Software
+** Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## 2001-02-19 Paul Kienzle
+##    * common interface trisolve() for +/- cyclic, +/- symmetric
+*/
+
+#include <octave/oct.h>
+#include <octave/f77-fcn.h>
+
+// LAPACK 3.0 functions not in libcruft
+extern "C" {
+  extern int F77_FCN (dgtsv, DGTSV)
+    (const int &n, const int &nrhs, double *l, 
+	  double *d, double *u, double *b, const int &ldb, int *info);
+
+  extern int F77_FCN (dptsv, DPTSV)
+    (const int &n, const int &nrhs, double *d, 
+	  double *e, double *b, const int &ldb, int *info);
+}
+
+DEFUN_DLD(trisolve, args, ,"\
+x = trisolve(d,e,b)\n\n\
+Solves the symmetric positive definite tridiagonal system:\n\
+  / d1 e1  0  . . .  0    0 \\     / b11 b12 . . . b1k \\\n\
+  | e1 d2 e2  . . .  0    0 |     | b21 b22 . . . b2k |\n\
+  |  0 e2 d3  . . .  0    0 | x = | b31 b22 . . . b3k |\n\
+  |           . . .         |     |         . . .     |\n\
+  \\  0  0  0  . . . en-1 dn /     \\ bn1 bn2 . . . bnk /\n\n\
+If the system is not positive definite, then use the following form.\n\n
+x = trisolve(l,d,u,b)\n\n\
+Solves the tridiagonal system:\n\
+  / d1 u1  0  . . .  0    0 \\     / b11 b12 . . . b1k \\\n\
+  | l1 d2 u2  . . .  0    0 |     | b21 b22 . . . b2k |\n\
+  |  0 l2 d3  . . .  0    0 | x = | b31 b22 . . . b3k |\n\
+  |           . . .         |     |         . . .     |\n\
+  \\  0  0  0  . . . ln-1 dn /     \\ bn1 bn2 . . . bnk /\n\n\
+x = trisolve(d,e,b,cl,cu)\n\n\
+Solves the cyclic system with symmetric positive definite tridiagonal:\n\
+  / d1 e1  0  . . .  0   cu \\     / b11 b12 . . . b1k \\\n\
+  | e1 d2 e2  . . .  0    0 |     | b21 b22 . . . b2k |\n\
+  |  0 e2 d3  . . .  0    0 | x = | b31 b22 . . . b3k |\n\
+  |           . . .         |     |         . . .     |\n\
+  \\ cl  0  0  . . . en-1 dn /     \\ bn1 bn2 . . . bnk /\n\n\
+If the system is not positive definite, then use the following form.\n\n
+x = trisolve(l,d,u,b,cl,cu)\n\n\
+Solves the cyclic tridiagonal system:\n\
+  / d1 u1  0  . . .  0   cu \\     / b11 b12 . . . b1k \\\n\
+  | l1 d2 u2  . . .  0    0 |     | b21 b22 . . . b2k |\n\
+  |  0 l2 d3  . . .  0    0 | x = | b31 b22 . . . b3k |\n\
+  |           . . .         |     |         . . .     |\n\
+  \\ cl  0  0  . . . ln-1 dn /     \\ bn1 bn2 . . . bnk /\n\n\
+Uses LAPACK routines DGTSVX or DPTSVX to solve the tridiagonal\n\
+system.  Uses the Sherman-Morrison formula to extend the solution\n\
+to the cyclic system. See Numerical Recipes, pp 73-75\n\
+<http://lib-www.lanl.gov/numerical/bookc/c2-7.pdf>\n\
+")
+{
+  octave_value_list retval;
+  const int nargin = args.length();
+
+  if (nargin == 3)
+    {
+      ColumnVector d(args(0).vector_value());
+      ColumnVector e(args(1).vector_value());
+      Matrix b(args(2).matrix_value());
+      if ( error_state ) return retval;
+
+      int n = d.length();
+      int nrhs = b.columns();
+      if (e.length() != n-1)
+	{
+	  error ("trisolve: e must be one shorter than d");
+	  return retval;
+	}
+      if (b.rows() != n)
+	{
+	  error ("trisolve: b must have same number of rows as d");
+	  return retval;
+	}
+
+      int info;
+      F77_FCN (dptsv, DPTSV) (n, nrhs, d.fortran_vec(), e.fortran_vec(), 
+			      b.fortran_vec(), n, &info);
+       
+      if (info > 0)
+	error ("trisolve: not positive definite---use trisolve(e,d,e,b).");
+      else if (info < 0) // will never happen
+	error ("trisolve: lapack dptsv called incorrectly.");
+      else
+	retval(0) = b;
+
+    }
+  else if (nargin == 5)
+    {
+      ColumnVector d(args(0).vector_value());
+      ColumnVector e(args(1).vector_value());
+      Matrix b(args(2).matrix_value());
+      double cl = args(3).double_value();
+      double cu = args(4).double_value();
+      if ( error_state ) return retval;
+
+      int n = d.length();
+      int nrhs = b.columns();
+      if (e.length() != n-1)
+	{
+	  error ("trisolve: e must be one shorter than d");
+	  return retval;
+	}
+      if (b.rows() != n)
+	{
+	  error ("trisolve: b must have same number of rows as d");
+	  return retval;
+	}
+
+      double gamma = -d(0);
+      d(0) -= gamma;
+      d(n-1) -= cl * cu / gamma;
+      Matrix z(n, nrhs+1, 0);
+      z(0,0) = gamma;
+      z(n-1,0) = cl;
+      z.insert(b, 0, 1);
+
+      int info;
+      F77_FCN (dptsv, DPTSV) (n, nrhs+1, d.fortran_vec(), e.fortran_vec(), 
+			      z.fortran_vec(), n, &info);
+
+      if (info == 0)
+	{
+	  for (int i = 1; i <= nrhs; i++)
+	    {
+	      const double fact =
+		(z(0,i) + cu*z(n-1,i)/gamma)
+		/ (1.0 + z(0,0) + cu*z(n-1,0)/gamma);
+	      for (int j = 0; j < n; j++) b(j,i-1) = z(j,i) - fact * z(j,0);
+	    }
+	}
+      
+      if (info > 0)
+	error ("trisolve: not positive definite---use trisolve(e,d,e,b,cl,cu).");
+      else if (info < 0) // will never happen
+	error ("trisolve: lapack dptsv called incorrectly.");
+      else
+	retval(0) = b;
+
+    }
+  else if (nargin == 4)
+    {
+      ColumnVector l(args(0).vector_value());
+      ColumnVector d(args(1).vector_value());
+      ColumnVector u(args(2).vector_value());
+      Matrix b(args(3).matrix_value());
+      if ( error_state ) return retval;
+
+      int n = d.length();
+      int nrhs = b.columns();
+      if (u.length() != n-1 || l.length() != n-1)
+	{
+	  error ("trisolve: l,u must be one shorter than d");
+	  return retval;
+	}
+      if (b.rows() != n)
+	{
+	  error ("trisolve: b must have same number of rows as d");
+	  return retval;
+	}
+
+      int info;
+      F77_FCN (dgtsv, DGTSV) (n, nrhs, l.fortran_vec(), d.fortran_vec(), 
+			      u.fortran_vec(), b.fortran_vec(), n, &info);
+       
+      if (info > 0)
+	error ("trisolve: singular system.");
+      else if (info < 0) // will never happen
+	error ("trisolve: lapack dptsv called incorrectly.");
+      else
+	retval(0) = b;
+
+    }
+  else if (nargin == 6)
+    {
+      ColumnVector l(args(0).vector_value());
+      ColumnVector d(args(1).vector_value());
+      ColumnVector u(args(2).vector_value());
+      Matrix b(args(3).matrix_value());
+      double cl = args(4).double_value();
+      double cu = args(5).double_value();
+      if ( error_state ) return retval;
+
+      int n = d.length();
+      int nrhs = b.columns();
+      if (u.length() != n-1 || l.length() != n-1)
+	{
+	  error ("trisolve: l,u must be one shorter than d");
+	  return retval;
+	}
+      if (b.rows() != n)
+	{
+	  error ("trisolve: b must have same number of rows as d");
+	  return retval;
+	}
+
+      double gamma = -d(0);
+      d(0) -= gamma;
+      d(n-1) -= cl * cu / gamma;
+      Matrix z(n, nrhs+1, 0);
+      z(0,0) = gamma;
+      z(n-1,0) = cl;
+      z.insert(b, 0, 1);
+
+      int info;
+      F77_FCN (dgtsv, DGTSV) (n, nrhs+1, l.fortran_vec(), d.fortran_vec(), 
+			      u.fortran_vec(), z.fortran_vec(), n, &info);
+
+      if (info == 0)
+	{
+	  for (int i = 1; i <= nrhs; i++)
+	    {
+	      const double fact =
+		(z(0,i) + cu*z(n-1,i)/gamma)
+		/ (1.0 + z(0,0) + cu*z(n-1,0)/gamma);
+	      for (int j = 0; j < n; j++) b(j,i-1) = z(j,i) - fact * z(j,0);
+	    }
+	}
+      
+      if (info > 0)
+	error ("trisolve: singular system.");
+      else if (info < 0) // will never happen
+	error ("trisolve: lapack dptsv called incorrectly.");
+      else
+	retval(0) = b;
+
+    }
+  else
+    {
+      print_usage("trisolve");
+      return retval;
+    }
+
+  return retval;
+
+}
Binary file main/splines/trisolve.tst has changed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/splines/unmkpp.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,43 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [x, P, n, k, d] = unmkpp(pp)
+## Extract the components of a pp structure.  They are as follows:
+##   x: sample points
+##   P: polynomial coefficients for points in sample interval
+##      P(i,:) contains the coefficients for the polynomial over interval i
+##      ordered from highest to lowest.  If d > 1, P(r,i,:) contains the
+##      coeffients for the r-th polynomial defined on interval i.  However
+##      octave does not support 3-dimensional matrices, so define:
+##      	c = reshape (P(:, j), n, d);
+##	Now c(i,r) is j-th coefficient of the r-th polynomial over the
+##      i-th interval.
+##   n: number of polynomial pieces
+##   k: order of the polynomial + 1
+##   d: number of polynomials defined for each interval
+function [x, P, n, k, d] = unmkpp(pp)
+  if nargin == 0
+    usage("[x, P, n, k, d] = unmkpp(pp)")
+  endif
+  if !isstruct(pp)
+    error("unmkpp: expecting piecewise polynomial structure");
+  endif
+  x = pp.x;
+  P = pp.P;
+  n = pp.n;
+  k = pp.k;
+  d = pp.d;
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/statistics/geomean.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,19 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+function a = geomean(x)
+  a = mean(x, "g");
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/statistics/harmmean.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,19 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+function a = harmmean(x)
+  a = mean(x, "h");
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/statistics/mad.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,27 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## a = mad(X)
+##    mean absolute deviation of X
+function a = mad(X)
+  if nargin != 1
+    usage("a = mad (X)");
+  elseif all (size (X) > 1)
+    a = mean (abs (X - ones(size(X,1),1) * mean(X)));
+  else
+    a = mean (abs (X - mean(X)));
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/statistics/nanmax.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,36 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## [v, idx] = nanmax(X [, dim]);
+## nanmax is identical to the max function except that NaN values are
+## treated as -Inf, and so are ignored.  If all values are NaN, the
+## maximum is returned as -Inf. [Is this behaviour compatible?]
+##
+## See also: nansum, nanmin, nanmean, nanmedian
+function [v, idx] = nanmax (X, ...)
+  if nargin < 1
+    usage ("[v, idx] = nanmax(X [, dim])");
+  else
+    dfi = do_fortran_indexing;
+    unwind_protect
+      do_fortran_indexing = 1;
+      X(isnan(X)) = -Inf;
+      [v,idx] = max (X, all_va_args);
+    unwind_protect_cleanup
+      do_fortran_indexing = dfi;
+    end_unwind_protect
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/statistics/nanmean.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,38 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## v = nanmean(X [, dim]);
+## nanmean is identical to the mean function except that NaN values are
+## ignored.  If all values are NaN, the mean is returned as NaN. 
+## [Is this behaviour compatible?]
+##
+## See also: nanmin, nanmax, nansum, nanmedian
+function v = nanmean (X, ...)
+  if nargin < 1
+    usage ("v = nanmean(X [, dim])");
+  else
+    dfi = do_fortran_indexing;
+    unwind_protect
+      do_fortran_indexing = 1;
+      n = sum (!isnan(X), all_va_args);
+      n(n == 0) = NaN;
+      X(isnan(X)) = 0;
+      v = sum (X, all_va_args) ./ n;
+    unwind_protect_cleanup
+      do_fortran_indexing = dfi;
+    end_unwind_protect
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/statistics/nanmedian.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,67 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## v = nanmedian(X [, dim]);
+## nanmedian is identical to the median function except that NaN values are
+## ignored.  If all values are NaN, the median is returned as NaN. 
+## [Is this behaviour compatible?]
+##
+## See also: nanmin, nanmax, nansum, nanmean
+function v = nanmedian (X, dim)
+  if nargin < 1 || nargin > 2
+    usage ("v = nanmean(X [, dim])");
+  else
+    if nargin == 1
+      if size(X,1) == 1
+	dim = 2; 
+      else
+        dim = 1;
+      endif
+    endif
+    if (dim == 2) X = X.'; endif
+    dfi = do_fortran_indexing;
+    unwind_protect
+      do_fortran_indexing = 1;
+      ## Find lengths of datasets after excluding NaNs; valid datasets
+      ## are those that are not empty after you remove all the NaNs
+      n = size(X,1) - sum (isnan(X));
+      valid = find(n!=0);
+
+      ## Extract all non-empty datasets and sort, replacing NaN with Inf
+      ## so that the invalid elements go toward the ends of the columns
+      X (isnan(X)) = Inf;
+      X = sort ( X (:, valid) );
+
+      ## Determine the offset for each remaining column in single index mode
+      colidx = (0:size(X,2)-1)*size(X,1);
+
+      ## Assume the median for all datasets will be NaNs
+      v = NaN*ones(size(n));
+
+      ## Average the two central values of the sorted list to compute
+      ## the median, but only do so for valid rows.  If the dataset
+      ## is odd length, the single central value will be used twice.
+      ## E.g., 
+      ##   for n==5, ceil(2.5+0.4) is 3 and floor(2.5+0.6) is also 3
+      ##   for n==6, ceil(3.0+0.4) is 4 and floor(3.0+0.6) is 3
+      v(valid) = ( X (colidx + floor(n(valid)./2+0.6)) ...
+		 + X (colidx + ceil(n(valid)./2+0.4)) ) ./ 2;
+    unwind_protect_cleanup
+      do_fortran_indexing = dfi;
+    end_unwind_protect
+    if (dim == 2) v = v.'; endif
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/statistics/nanmin.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,36 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## [v, idx] = nanmin (X [, dim]);
+## nanmin is identical to the min function except that NaN values are
+## treated as Inf, and so are ignored.  If all values are NaN, the
+## minimum is returned as Inf. [Is this behaviour compatible?]
+##
+## See also: nansum, nanmax, nanmean, nanmedian
+function [v, idx] = nanmin (X, ...)
+  if nargin < 1
+    usage ("[v, idx] = nanmin (X [, dim])");
+  else
+    dfi = do_fortran_indexing;
+    unwind_protect
+      do_fortran_indexing = 1;
+      X(isnan(X)) = Inf;
+      [v, idx] = min (X, all_va_args);
+    unwind_protect_cleanup
+      do_fortran_indexing = dfi;
+    end_unwind_protect
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/statistics/nanstd.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,68 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## v = nanstd(X [, dim]);
+## nanstd is identical to the std function except that NaN values are
+## ignored.  If all values are NaN, the std is returned as NaN. If there
+## is only a single non-NaN value, the std is returned as 0. 
+## [Is this behaviour compatible?]
+##
+## See also: nanmin, nanmax, nansum, nanmedian, nanmean
+function v = nanstd (X, dim)
+  if nargin < 1
+    usage ("v = nanstd(X [, dim])");
+  else
+    if nargin == 1
+      if size(X,1) == 1
+	dim = 2; 
+      else
+        dim = 1;
+      endif
+    endif
+    if (dim == 2) X = X.'; endif
+    dfi = do_fortran_indexing;
+    wdz = warn_divide_by_zero;
+    unwind_protect
+      do_fortran_indexing = 1;
+      warn_divide_by_zero = 0;
+
+      ## determine the number of non-missing points in each data set
+      n = sum (!isnan(X));
+
+      ## replace missing data with zero and compute the mean
+      X(isnan(X)) = 0;
+      meanX = sum (X) ./ n;
+
+      ## subtract the mean from the data and compute the sum squared
+      v = sumsq (X - ones(size(X,1), 1) * meanX);
+
+      ## because the missing data was set to zero each missing data
+      ## point will contribute (-meanX)^2 to sumsq, so remove these
+      v = v - (meanX .^ 2) .* (size(X,1) - n);
+
+      ## compute the standard deviation from the corrected sumsq
+      v = sqrt ( v ./ (n - 1) );
+
+      ## set special values of std for n=0 and n=1
+      ## v(n == 0) = NaN;  # meanX = 0/0 -> NaN above, so not necessary
+      v(n == 1) = 0;
+    unwind_protect_cleanup
+      do_fortran_indexing = dfi;
+      warn_divide_by_zero = wdz;
+    end_unwind_protect
+    if (dim == 2) v = v.'; endif
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/statistics/nansum.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,36 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## v = nansum (X [, dim]);
+## nansum is identical to the sum function except that NaN values are
+## treated as 0 and so ignored.  If all values are NaN, the sum is 
+## returned as 0. [Is this behaviour compatible?]
+##
+## See also: nanmin, nanmax, nanmean, nanmedian
+function v = nansum (X, ...)
+  if nargin < 1
+    usage ("v = nansum (X [, dim])");
+  else
+    dfi = do_fortran_indexing;
+    unwind_protect
+      do_fortran_indexing = 1;
+      X(isnan(X)) = 0;
+      v = sum (X, all_va_args);
+    unwind_protect_cleanup
+      do_fortran_indexing = dfi;
+    end_unwind_protect
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/statistics/prctile.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,39 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## A = prctile(X,p)
+##
+## Computes the value associated with the p-th percentile of X.  If X is
+## a matrix, computes p for each column of X.  If p is a vector, the
+## returned value is a matrix with one row for each element of p and one
+## column for each column of X.
+##
+## The first and last values are pegged at 0 percent and 100 percent
+## respectively, and the rest of the values are uniformly spaced between
+## them, with linear interpolation between the points.  This is
+## consistent with the definition of quantile given in the R statistics
+## package, but inconsistent with that of the statistics toolbox from
+## Matlab.
+function a = prctile(x, p)
+  if nargin != 2
+    usage("a = prctile(x,p)");
+  endif
+  y = sort(x);
+  if size (y,1) == 1, y = y(:); endif
+  trim = 1 + (size(y,1)-1)*p(:)*0.01;
+  delta = (trim - floor(trim))*ones(1,size(y,2));
+  a = y(floor(trim), :) .* delta + y(ceil(trim), :) .* (1-delta);
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/statistics/trimmean.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,32 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## a = trimmean(x,p)
+##    mean of x excluding highest and lowest p% of the data
+##
+## E.g.,
+##    mean([-inf 1:9 inf]) is NaN
+##    trimmean([-inf 1:9 inf], 10) is 5
+function a = trimmean(x, p)
+  if nargin != 2
+    usage("a = trimmean(x,p)");
+  endif
+  y = sort(x);
+  if size (y,1) == 1, y = y.'; endif
+  trim = round(size(y,1)*p*0.01);
+  rng = 1+trim : size(y,1)-trim;
+  a = mean ( y (rng, :) );
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/statistics/zscore.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,29 @@
+## Copyright (C) 2001 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## A = zscore (X)
+## compute the z-score of each element of X relative to the data in the
+## columns of X.  The z-score for a single data point x_i is:
+##    (x_i - mean(x))/std(x)
+function A = zscore(X)
+  if nargin != 1
+    usage("zscore(X)");
+  elseif any(size(X) == 1)
+    A = (X - mean(X)) ./ std(X);
+  else
+    A = (X - ones(size(X,1),1)*mean(X)) ./ (ones(size(X,1),1)*std(X));
+  endif
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/strings/mat2str.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,45 @@
+## Copyright (C) 1996 John W. Eaton
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## usage: mat2str (x)
+##
+## Format x as a string suitable for use in eval.
+##
+## See also: sprintf, int2str
+
+## Author: jwe
+## Modified by: Ariel Tankus, 15.6.98 .
+## Modified by: Paul Kienzle, 15.7.00, to handle matrices. 
+
+function retval = mat2str (x)
+
+  if (nargin == 1)
+    [nr, nc] = size(x);
+    if (nr*nc == 1)
+      retval = sprintf ("%.100g", x);
+    else
+      retval = sprintf (" %.100g,", x.');
+      retval(1) = "[";
+      retval(length(retval)) = "]";
+      idx = find (retval == ",");
+      retval(idx(nc:nc:length(idx))) = ";";
+    endif
+  else
+    usage ("mat2str (x)");
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/strings/strcmpi.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,40 @@
+## Copyright (C) 2000  Bill Lash
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: strcmpi (s1, s2)
+##
+## Compare two strings, ignoring case, returning 1 if
+## they are the same, and 0 otherwise.
+##
+## Note: For compatibility with Matlab, Octave's strcmpi function
+## returns 1 if the strings are equal, and 0 otherwise.  This is
+## just the opposite of the corresponding C library function.
+
+## Author: Bill Lash (lash@tellabs.com)
+
+function status = strcmpi(s1, s2)
+
+  if (nargin != 2)
+    usage ("strcmpi (s, t)");
+  endif
+
+  status = 0;		# Assume strings are different
+  if (isstr (s1) && isstr(s2))
+    status = strcmp(upper(s1),upper(s2));
+  endif
+
+endfunction
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/strings/strmatch.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,52 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: strmatch(s, A [, 'exact'])
+## Determines which entries of string matrix A match string s.  If
+## 'exact' is not given, then s only needs to match A up to the length
+## of s.  Null characters match blanks. Results are returned as a column
+## vector.
+function idx = strmatch(s,A,exact)
+  if (nargin < 2 || nargin > 3)
+    usage("strmatch(s,A,'exact')");
+  endif
+
+  istno = implicit_str_to_num_ok;
+  dfi = do_fortran_indexing;
+  unwind_protect
+    implicit_str_to_num_ok = 1;
+    do_fortran_indexing = 1;
+
+    [nr, nc] = size (A);
+    if (length (s) > nc)
+      idx = [];
+    else
+      if (nargin == 3 && length(s) < nc) s(1,nc) = ' '; endif
+      s (s==0) = ' ';
+      A (A==0) = ' ';
+      match = s(ones(size(A,1),1),:) == A(:,1:length(s));
+      if (length(s) == 1)
+	idx = find(match);
+      else
+      	idx = find(all(match')');
+      endif
+    endif
+
+  unwind_protect_cleanup
+    implicit_str_to_num_ok = istno;
+    do_fortran_indexing = dfi;
+  end_unwind_protect
+endfunction    
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/strings/strncmp.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,51 @@
+## Copyright (C) 2000  Bill Lash
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: strncmp (s1, s2, n)
+##
+## Compare the first n characters of two strings, returning 1 if
+## they are the same, and 0 otherwise.
+##
+## Note: For compatibility with Matlab, Octave's strncmp function
+## returns 1 if the strings are equal, and 0 otherwise.  This is
+## just the opposite of the corresponding C library function.
+
+## Author: Bill Lash (lash@tellabs.com)
+
+function status = strncmp(s1, s2, n)
+
+  if (nargin != 3)
+    usage ("strncmp (s, t, n)");
+  endif
+
+  status = 0;		# Assume strings are different
+  if (isstr (s1) && isstr(s2))
+    c1 = columns (s1);
+    c2 = columns (s2);
+    if (n < 1)		
+			# Comparing less than 1 character of the string
+      status = 0;	# will always say they are not equal (for Matlab
+		        # compatibility
+
+    elseif ((n <= c1) && (n <= c2))
+       status = strcmp(s1(:,1:n),s2(:,1:n));
+    else 
+       status = 0;
+    endif
+  endif
+
+endfunction
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/strings/strncmpi.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,40 @@
+## Copyright (C) 2000  Bill Lash
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: strncmpi (s1, s2, n)
+##
+## Compare the first n characters of two strings, ignoring case, 
+## returning 1 if they are the same, and 0 otherwise.
+##
+## Note: For compatibility with Matlab, Octave's strncmpi function
+## returns 1 if the strings are equal, and 0 otherwise.  This is
+## just the opposite of the corresponding C library function.
+
+## Author: Bill Lash (lash@tellabs.com)
+
+function status = strncmpi(s1, s2, n)
+
+  if (nargin != 3)
+    usage ("strncmpi (s, t, n)");
+  endif
+
+  status = 0;		# Assume strings are different
+  if (isstr (s1) && isstr(s2))
+    status = strncmp(upper(s1),upper(s2),n);
+  endif
+
+endfunction
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/strings/strtok.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,122 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## usage: [tok, rem] = strtok(str, delim)
+## 
+## Find all characters up to but not including the first character which
+## is in the string delim.  If rem is requested, it contains the
+## remainder of the string, starting at the first deliminator. Leading
+## delimiters are ignored.  If delim is not specified, space is assumed.
+
+## TODO: check what to do for a null delimiter
+function [tok, rem] = strtok(str, delim)
+
+  if nargin<1 || nargin > 2
+    usage("[tok, rem] = strtok(str, delim)");
+  endif
+  if nargin < 2 || isempty(delim), delim = " "; endif
+
+  if isempty(str)
+    tok = rem = "";
+  elseif length(delim) > 3
+    start = 1;
+    len = length(str);
+    while start<=len
+      if all(str(start) != delim), break; endif
+      start++;
+    endwhile
+    stop = start;
+    while stop<=len
+      if any(str(stop) == delim), break; endif
+      stop++;
+    endwhile
+    tok = str(start:stop-1);
+    rem = str(stop:len);
+  else
+    if length(delim)==1
+      idx = find(str == delim);
+    elseif length(delim)==2
+      idx = find(str == delim(1) | str==delim(2));
+    else
+      idx = find(str == delim(1) | str==delim(2) | str==delim(3));
+    endif
+    if isempty(idx)
+      tok = str;
+      rem = "";
+    else
+      skip = find(idx != 1:length(idx)); # find first non-leading delimiter
+      if isempty(skip)
+      	tok = str(idx(length(idx))+1:length(str));
+      	rem = "";
+      else
+      	tok = str(skip(1):idx(skip(1))-1);
+      	rem = str(idx(skip(1)):length(str));
+      endif
+    endif
+  endif
+
+endfunction
+
+%!demo
+%! strtok("this is the life")
+%! % split at the first space, returning "this"
+
+%!demo
+%! s = "14*27+31"
+%! while 1
+%!   [t,s] = strtok(s, "+-*/");
+%!   printf("<%s>", t);
+%!   if isempty(s), break; endif
+%!   printf("<%s>", s(1));
+%! endwhile
+%! printf("\n");
+%! % ----------------------------------------------------
+%! % Demonstrates processing of an entire string split on
+%! % a variety of delimiters. Tokens and delimiters are 
+%! % printed one after another in angle brackets.  The
+%! % string is:
+
+%!# test the tokens for all cases
+%!assert(strtok(""), "");             # no string
+%!assert(strtok("this"), "this");     # no delimiter in string
+%!assert(strtok("this "), "this");    # delimiter at end
+%!assert(strtok("this is"), "this");  # delimiter in middle
+%!assert(strtok(" this"), "this");    # delimiter at start
+%!assert(strtok(" this "), "this");   # delimiter at start and end
+%!assert(strtok(" "), "");            # delimiter only
+
+%!# test the remainder for all cases
+%!test [t,r] = strtok(""); assert(r, "");
+%!test [t,r] = strtok("this"); assert(r, "");
+%!test [t,r] = strtok("this "); assert(r, " ");
+%!test [t,r] = strtok("this is"); assert(r, " is");
+%!test [t,r] = strtok(" this"); assert(r, "");
+%!test [t,r] = strtok(" this "); assert(r, " ");
+%!test [t,r] = strtok(" "); assert(r, "");
+
+%!# simple check with 2 and 3 delimeters
+%!assert(strtok("this is", "i "), "th");
+%!assert(strtok("this is", "ij "), "th");
+
+%!# test all cases for 4 delimiters since a different 
+%!# algorithm is used when more than 3 delimiters
+%!assert(strtok("","jkl "), "");
+%!assert(strtok("this","jkl "), "this");
+%!assert(strtok("this ","jkl "), "this");
+%!assert(strtok("this is","jkl "), "this");
+%!assert(strtok(" this","jkl "), "this");
+%!assert(strtok(" this ","jkl "), "this");
+%!assert(strtok(" ","jkl "), "");
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/strings/strvcat.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,66 @@
+## Copyright (C) 1996 Kurt Hornik
+##
+## This program is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} strvcat (@var{s_1}, @dots{}, @var{s_n})
+## Return a matrix containing the strings @var{s_1}, @dots{}, @var{s_n} as
+## its rows.  Each string is padded with blanks in order to form a valid
+## matrix.  Unlike @var{str2mat}, empty strings are ignored.
+##
+## @end deftypefn
+
+## Author: Kurt Hornik <A HREF="mailto:Kurt.Hornik@ci.tuwien.ac.at">Kurt.Hornik@ci.tuwien.ac.at</A>
+## Adapted-By: jwe
+## Modified: Paul Kienzle <pkienzle@kienzle.powernet.co.uk> converted
+##           str2mat to strvcat.  Same function except that strvcat
+##           ignores empty strings.
+
+function retval = strvcat (...)
+
+  if (nargin == 0)
+    usage ("strvcat (s1, ...)");
+  endif
+
+  va_start ();
+
+  nr = zeros (nargin, 1);
+  nc = zeros (nargin, 1);
+  for k = 1 : nargin
+    s = va_arg ();
+    [nr(k), nc(k)] = size (s);
+  endfor
+
+  retval_nr = sum (nr);
+  retval_nc = max (nc);
+
+  retval = setstr (ones (retval_nr, retval_nc) * toascii (" "));
+
+  va_start ();
+
+  row_offset = 0;
+  for k = 1 : nargin
+    s = va_arg ();
+    if (! isstr (s))
+      s = setstr (s);
+    endif
+    if (nc(k) > 0)
+      retval ((row_offset + 1) : (row_offset + nr(k)), 1:nc(k)) = s;
+    endif
+    row_offset = row_offset + nr(k);
+  endfor
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/struct/README	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,20 @@
+#  Octave functions for manipulating structures
+#
+#  Etienne Grossmann (etienne@isr.ist.utl.pt), 1999,2000
+
+#  With modifications by Paul Kienzle:
+#    remove cmpstruct, fields, test_struct, catstruct
+#    add fieldnames
+#    signal errors rather than trapping to the keyboard
+#  See http://anonimo.isr.ist.utl.pt/~etienne/octave/ for the originals
+
+#  Note: interface does not exactly match matlab
+#  rmfield must be able to accept a cell array or string array of names
+#  struct/getfield/setfield must be able to handle arrays of structures 
+#     (not possible since octave doesn't handle arrays of structures)
+#  fieldnames must return a cell array 
+#     (not possible since octave doesn't handle cell arrays)
+#  struct2cell missing
+#     (not possible since octave doesn't handle cell arrays)
+#  isfield added
+#     (how do you do this in Matlab?)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/struct/fieldnames.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,27 @@
+## f = fieldnames(s)
+## 
+## When s is a structure, fieldnames(s) returns a list of the field names 
+## used in s.  When s is not a structure, fieldnames(s) returns the
+## empty list.  Note that this function exists for compatibility with
+## Matlab.  Since Octave lacks the dereferencing operator f{i}, you must
+## replace all dereferences in your script with nth(f,i).  The function 
+## nth is easily implemented in Matlab as:
+##
+## function x = nth(f,i)
+##    x = f{i};
+##
+## See also cmpstruct, getfield, setfield, rmfield, isfield, isstruct,
+## struct. 
+
+## TODO: return a cell array instead of a list
+
+## Author:        Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+## Based on fields.m by Etienne Grossmann  <etienne@isr.ist.utl.pt>
+
+function f = fieldnames(s)
+  f = list() ;
+  i = 1 ;
+  for [val, key] = s
+    f(i++) = key ;
+  end
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/struct/getfield.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,28 @@
+## Copyright (C) 2000  Etienne Grossman
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+##        v = getfield(s,key) = s.key
+## 
+## For m****b compatibility and flexibility.
+##
+## See also cmpstruct, fields, setfield, rmfield, isfield, isstruct,
+## struct. 
+
+## Author:        Etienne Grossmann  <etienne@isr.ist.utl.pt>
+## Last modified: January 2000
+
+function v = getfield(s,key)
+eval(['v=s.',key,';']);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/struct/isfield.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,37 @@
+## Copyright (C) 2000  Etienne Grossman
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+##       y = isfield(x,k)
+##
+## Returns 1 if x is a struct and k a string, and x.k exists.
+## Returns 0 otherwise. 
+##
+## For m****b compat and flexibility.
+##
+## See also cmpstruct, fields, setfield, rmfield, getfield, isstruct,
+## struct. 
+
+## Author:        Etienne Grossmann  <etienne@isr.ist.utl.pt>
+## Last modified: January 2000
+
+function y = isfield(x,k)
+  if is_struct(x)
+    y = struct_contains (x, k);  
+    ## eval(sprintf('x.%s;y=1;',k),'y=0;');
+  else
+    y = 0 ;
+  end
+end
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/struct/isstruct.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,29 @@
+## Copyright (C) 2000  Etienne Grossman
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+##        s = isstruct(x) = is_struct(x) 
+## 
+## For m****b compatibility only.
+## 
+## See also cmpstruct, fields, setfield, rmfield, getfield, isfield,
+## struct. 
+##
+
+## Author:        Etienne Grossmann  <etienne@isr.ist.utl.pt>
+## Last modified: January 2000
+
+function s = isstruct(x)
+s = is_struct(x) ;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/struct/rmfield.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,55 @@
+## Copyright (C) 2000  Etienne Grossman
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+##        t = rmfield(s,key1,...)
+## 
+## Removes key1, key2, ...  from structure s. 
+## Return s if s is not a struct. Any better behavior?
+## 
+## For m****b compatibility and flexibility. 
+##
+## Basically, does a 'filtering' copy of s.
+##
+## See also cmpstruct, fields, setfield, isstruct, getfield, isfield,
+## catstruct and struct. 
+##
+
+## Author:        Etienne Grossmann  <etienne@isr.ist.utl.pt>
+## Last modified: January 2000
+## November 2000: Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##     return error rather than trapping to keyboard
+
+function t = rmfield(s,...)
+if ! is_struct(s) ,			
+  t = s ;
+  return
+end
+va_start() ; 
+rmf = ' ' ;
+nargin-- ;
+while nargin-- ,
+  tmp = va_arg() ;
+  if ! isstr(tmp) ,
+    error('rmfield: called with non-string key');
+  else
+    rmf = [rmf,tmp,' '] ;
+  end
+end
+for [val, key] = s ,
+  if ! index(rmf,[' ',key,' ']) ,	% Check if key is wanted
+    eval(['t.',key,'=val;']) ;		% Copy
+  end
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/struct/setfield.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,47 @@
+## Copyright (C) 2000  Etienne Grossman
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+##        s = setfield(s,'key1',value1,...)
+## 
+## Sets s.key1 = value1,  s.key2 = value2, ... and returns s.
+## 
+## For m****b compatibility and flexibility.
+## 
+## See also cmpstruct, fields, rmfield, isstruct, getfield, isfield,
+## struct. 
+## 
+
+## Author:        Etienne Grossmann  <etienne@isr.ist.utl.pt>
+## Last modified: January 2000
+## November 2000: Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##     return error rather than trapping to keyboard
+
+function s = setfield(s,...)
+va_start() ; 
+nargin-- ;
+while nargin-- ,
+  tmp = va_arg() ;
+  if ! isstr(tmp) ,
+    error('setfield: called with non-string key') ; 
+  else
+    if ! nargin-- ,
+      error('setfield: called with odd number of arguments\n') ; 
+    else
+      value = va_arg() ;
+      eval( ['s.',tmp,'=value;'] ) ;
+    end
+  end
+end
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/struct/struct.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,45 @@
+## Copyright (C) 2000  Etienne Grossman
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+##       s = struct(key1,val1,...)
+## 
+## Returns a struct such that s.key1 = val1 , s.key2 = val2 ...
+##    
+## For m****b compatibility.
+##
+## See also fields, getfield, setfield, rmfield, isfield, isstruct,
+## cmpstruct, struct_size. 
+
+## Author:        Etienne Grossmann  <etienne@isr.ist.utl.pt>
+## Last modified: January 2000
+## November 2000: Paul Kienzle <pkienzle@kienzle.powernet.co.uk>
+##     return error rather than trapping to keyboard
+
+function s = struct(...)
+va_start() ; 
+while nargin-- ,
+  tmp = va_arg() ;
+  if ! isstr(tmp) ,
+    error('struct: called with non-string key') ; 
+  else
+    if ! nargin-- ,
+      error('struct: called with odd number of arguments') ; 
+    else
+      value = va_arg() ;
+      eval(['s.',tmp,'=value;']) ;
+    end
+  end
+end
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/time/datenum.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,75 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} datenum(Y, M, D [, h , m [, s]])
+## @deftypefnx {Function File} {} datenum('date' [, P])
+## Returns the specified local time as a number of days since Jan 1, 0000.
+## By this reckoning, Jan 1, 1970 is day number 719529.  The fractional
+## portion, corresponds to the portion of the specified day.
+##
+## Note: 32-bit architectures only handle times between Dec 14, 1901 
+## and Jan 19, 2038, with special handling for 0000-01-01.  datenum
+## returns -1 in case of a range error.
+##
+## @seealso{date,clock,now,datestr,datevec,calendar,weekday}
+## @end deftypefn
+
+## 2001-08-30 Paul Kienzle <pkienzle@users.sf.net>
+## * make it independent of time zone
+
+function n = datenum(Y,M,D,h,m,s)
+  if nargin == 0 || (nargin > 2  && isstr(Y)) || nargin > 6
+    usage("n=datenum('date' [, P]) or n=datenum(Y, M, D [, h, m [, s]])");
+  endif
+  if isstr(Y)
+    if nargin < 2, M=[]; endif
+    [Y,M,D,h,m,s] = datevec(Y,M);
+  else
+    if nargin < 6, s = zeros(size(Y)); endif
+    if nargin < 5, m = s; endif
+    if nargin < 4, h = s; endif
+  endif
+
+  n = zeros(size(Y));
+  lt = localtime(0);
+  t0 = mktime(lt);
+  h = h+lt.hour-24;
+  for i=1:prod(size(Y))
+    tm.usec = 1e6*rem(s(i),1);
+    tm.sec = floor(s(i));
+    tm.min = m(i);
+    tm.hour = h(i);
+    tm.mday = D(i);
+    tm.mon = M(i)-1;
+    tm.year = Y(i)-1900;
+    tm.zone = "GMT";
+    tm.wday = 0;
+    tm.yday = 0;
+    tm.isdst = 0;
+    if (Y(i) == 0 && M(i) == 1 && d(i) == 1)
+      n(i) = (h(i)*3600 + m(i)*60 + s(i))/86400;
+    else
+      t = mktime(tm);
+      if (t==-1 && Y(i) != 1969)
+	n(i) = -1;
+      else
+      	n(i) = (t-t0) / 86400 + 719529;
+      endif
+    endif
+  endfor
+endfunction
+      
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/time/datestr.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,116 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} datestr(date,code,P)
+## Format the given date/time according to the format @code{code}.  The date
+## 730736.65149 (2000-09-07 15:38:09.0934) would be formated as follows:
+## @multitable @columnfractions 0.1 0.45 0.45
+## @item @strong{Code} @tab @strong{Format} @tab @strong{Example}
+## @item  0 @tab dd-mmm-yyyy HH:MM:SS @tab 07-Sep-2000 15:38:09
+## @item  1 @tab dd-mmm-yyyy          @tab 07-Sep-2000 
+## @item  2 @tab mm/dd/yy             @tab 09/07/00 
+## @item  3 @tab mmm                  @tab Sep 
+## @item  4 @tab m                    @tab S 
+## @item  5 @tab mm                   @tab 9
+## @item  6 @tab mm/dd                @tab 09/07 
+## @item  7 @tab dd                   @tab 7 
+## @item  8 @tab ddd                  @tab Thu 
+## @item  9 @tab d                    @tab T 
+## @item 10 @tab yyyy                 @tab 2000 
+## @item 11 @tab yy                   @tab 00
+## @item 12 @tab mmmyy                @tab Sep00 
+## @item 13 @tab HH:MM:SS             @tab 15:38:09 
+## @item 14 @tab HH:MM:SS PM          @tab 03:38:09 PM
+## @item 15 @tab HH:MM                @tab 15:38 
+## @item 16 @tab HH:MM PM             @tab 03:38 PM 
+## @item 17 @tab QQ-YY                @tab Q3-00
+## @item 18 @tab QQ                   @tab Q3
+## @end multitable
+##
+## If no code is given or code is -1, then use 0, 1 or 13 as the
+## default, depending on whether the date portion or the time portion 
+## of the date is empty.
+##
+## If a vector of dates is given, a vector of date strings is returned.
+##
+## The parameter @code{P} is needed by @code{datevec} to convert date strings
+## with 2 digit years into dates with 4 digit years.  See @code{datevec}
+## for more information.
+##
+## @seealso{date,clock,now,datestr,datenum,calendar,weekday} 
+## @end deftypefn
+
+## TODO: with shared "code", can vectorize construction
+function retval = datestr(date,code,P)
+  if (nargin == 0 || nargin > 3 )
+    usage("datestr(date [, code]) or datestr('date' [, code [, P]])");
+  endif
+  if (nargin < 3) P = []; endif
+  if (nargin < 2) code = []; endif
+  V = datevec(date, P);
+
+  if (isempty(code))
+    if (all(V(1,:)==0) && all(all(V(2:3,:) == 1)))
+      code(i) = 13;
+    elseif (all(V(4:6,:)==0))
+      code(i) = 1; 
+    else
+      code(i) = 0;
+    endif
+  endif
+
+  global __month_names = ["Jan";"Feb";"Mar";"Apr";"May";"Jun";...
+			  "Jul";"Aug";"Sep";"Oct";"Nov";"Dec"];
+  global __time_names = ["AM";"PM"];
+  for i=1:rows(V)
+    [Y, M, D, h, m, s] = deal(V(i,:));
+    Y2 = rem(Y,100);
+    switch (code)
+      case 0, str = sprintf("%02d-%s-%04d %02d:%02d:%02d",...
+			    D,__month_names(M,:),Y,h,m,floor(s));
+      case 1, str = sprintf("%02d-%s-%04d",D,__month_names(M,:),Y);
+      case 2, str = sprintf("%02d-%02d-%02d",D,M,Y2);
+      case 3, str = sprintf("%s",__month_names(M,:));
+      case 4, str = sprintf("%s",__month_names(M,1));
+      case 5, str = sprintf("%d",M);
+      case 6, str = sprintf("%02d/%02d",M,D);
+      case 7, str = sprintf("%d",D);
+      case 8, 
+	[d,str] = weekday(datenum(Y,M,D));
+      case 9, 
+	[d,str] = weekday(datenum(Y,M,D));
+	str = str(1);
+      case 10, str = sprintf("%04d", Y);
+      case 11, str = sprintf("%02d", Y2);
+      case 12, str = sprintf("%s%02d", __month_names(M,:),Y2);
+      case 13, str = sprintf("%02d:%02d:%02d", h, m, floor(s));
+      case 14, str = sprintf("%02d:%02d:%02d %s", rem(h,12), m, floor(s), \
+			     __time_names(floor(h/12)+1,:));
+      case 15, str = sprintf("%02d:%02d", h, m);
+      case 16, str = sprintf("%02d:%02d %s", rem(h,12), m, \
+			     __time_names(floor(h/12)+1,:));
+      case 17, str = sprintf("Q%d-%02d", floor((M+2)/3),Y2);
+      case 18, str = sprintf("Q%d", floor((M+2)/3));
+    endswitch
+    if i == 1
+      retval = str;
+    else 
+      retval = [ retval ; str ] ;
+    endif
+  endfor
+endfunction
+  
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/time/datevec.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,90 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {V} datevec(date)
+## @deftypefnx {Function File} {[Y,M,D,h,m,s] =} datevec(date)
+## Breaks the number of days since Jan 1, 0000 into a year-month-day
+## hour-minute-second format. By this reckoning, Jan 1, 1970 is day
+## number 719529.  The fractional portion of @code{date} corresponds to the
+## portion of the given day. If a single return value is requested,
+## then the components of the date are columns of the matrix @code{V}.
+##
+## Note: 32-bit architectures only handle times between Dec 14, 1901 
+## and Jan 19, 2038, with special handling for 0000-01-01.  datenum
+## returns -1 in case of a range error.
+##
+## The parameter @code{P} is needed to convert date strings with 2 digit
+## years into dates with 4 digit years.  2 digit years are assumed to be
+## between @code{P} and @code{P+99}. If @code{P} is not given then the 
+## current year - 50 is used, so that dates are centered on the present.
+## For birthdates, you would want @code{P} to be current year - 99.  For
+## appointments, you would want @code{P} to be current year.
+##
+## Dates must be represented as mm/dd/yy or dd-mmm-yyyy.  Times must
+## be hh:mm:ss or hh:mm:ss PM, with seconds optional.  These correspond 
+## to datestr format codes 0, 1, 2, 3, 13, 14, 15, 16.
+##
+## @seealso{date,clock,now,datestr,datenum,calendar,weekday} 
+## @end deftypefn
+
+function [Y,M,D,h,m,s] = datevec(date,P)
+
+  if nargin == 0 || nargin > 2
+    usage("V=datevec(n) or [Y,M,D,h,m,s]=datevec(n)");
+  endif
+  if nargin < 2, P = []; endif
+
+  if isstr(date)
+    if isempty(P)
+      tm = localtime(time);
+      P = tm.year+1900-50;
+    endif
+
+    global __month_names = ["Jan";"Feb";"Mar";"Apr";"May";"Jun";...
+			    "Jul";"Aug";"Sep";"Oct";"Nov";"Dec"];
+    global __time_names = ["AM";"PM"];
+
+    Y = h = m = s = zeros(rows(date),1);
+    M = D = ones(size(Y));
+    error("datevec: doesn't handle strings yet");
+  else
+    Y = h = m = s = zeros(size(date));
+    M = D = ones(size(Y));
+    for i = 1:prod(size(date))
+      if date(i) < 1
+	t = 86400*date(i);
+	h(i) = floor(t/3600);
+	t = t - 3600*h(i);
+	m(i) = floor(t/60);
+	t = t - 60*m(i);
+	s(i) = t;
+      else
+      	tm = gmtime((date(i) - 719529)*86400);
+      	Y(i) = tm.year+1900;
+      	M(i) = tm.mon+1;
+      	D(i) = tm.mday;
+      	h(i) = tm.hour;
+      	m(i) = tm.min;
+      	s(i) = tm.sec+tm.usec*1e-6;
+      endif
+    endfor
+  endif
+
+  if nargout <= 1
+    Y = [ Y(:), M(:), D(:), h(:), m(:), s(:) ];
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/time/now.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,30 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} now
+## Returns the current local time as a number of days since Jan 1, 0000.
+## By this reckoning, Jan 1, 1970 is day number 719529.  The fractional
+## portion, @code{rem(now,1)} corresponds to the portion of the current
+## day.
+##
+## @seealso{date,clock,datenum,datestr,datevec,calendar,weekday}
+## @end deftypefn
+
+function t = now
+  ## seconds since 1970-1-1 divided by 86400 sec/day plus day num for 1970-1-1
+  t = mktime(localtime(time))/86400 + 719529;
+endfunction
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/time/weekday.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,57 @@
+## Copyright (C) 2000 Paul Kienzle
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {V =} datevec(date)
+## @deftypefnx {Function File} {[Y,M,D,h,m,s] =} datevec(date)
+## Breaks the number of days since Jan 1, 0000 into a year-month-day
+## hour-minute-second format. By this reckoning, Jan 1, 1970 is day
+## number 719529.  The fractional portion of @code{date} corresponds to the
+## portion of the given day. If a single return value is requested,
+## then the components of the date are columns of the matrix @code{V}.
+##
+## Note: 32-bit architectures only handle times between Dec 14, 1901 
+## and Jan 19, 2038, with special handling for 0000-01-01.  datenum
+## returns -1 in case of a range error.
+##
+## The parameter @code{P} is needed to convert date strings with 2 digit
+## years into dates with 4 digit years.  2 digit years are assumed to be
+## between @code{P} and @code{P+99}. If @code{P} is not given then the 
+## current year - 50 is used, so that dates are centered on the present.
+## For birthdates, you would want @code{P} to be current year - 99.  For
+## appointments, you would want @code{P} to be current year.
+##
+## Dates must be represented as mm/dd/yy or dd-mmm-yyyy.  Times must
+## be hh:mm:ss or hh:mm:ss PM, with seconds optional.  These correspond 
+## to datestr format codes 0, 1, 2, 3, 13, 14, 15, 16.
+##
+## @seealso{date,clock,now,datestr,datenum,calendar,weekday} 
+## @end deftypefn
+
+function [d,s] = weekday(date,P)
+  if (nargin < 1 || nargin > 2)
+    usage("d = weekday(date [, P])");
+  endif
+  if isstr(date)
+    if nargin < 2, P = []; endif
+    date = datenum(date, P);
+  endif
+  d = rem(floor(date)+5,7)+1;
+  if nargout == 2,
+    global __day_names = ["Sun";"Mon";"Tue";"Wed";"Thu";"Fri";"Sat"];
+    s = __day_names(d,:);
+  endif
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,28 @@
+
+include ../Makeconf
+
+SUBMAKES = $(wildcard */Makefile)
+MAKE_SUBDIRS = $(dir $(SUBMAKES))
+INSTALL_SUBDIRS = $(filter-out Makefile, $(wildcard *))
+
+.PHONY: all install clean $(MAKE_SUBDIRS) $(INSTALL_SUBDIRS)
+
+all: $(MAKE_SUBDIRS)
+
+$(MAKE_SUBDIRS):
+	@if test ! -f $@/NOINSTALL || test x$(MAKECMDGOALS) = xclean ; then \
+	    cd $@ && $(MAKE) $(MAKECMDGOALS) ; \
+	fi
+
+install: $(INSTALL_SUBDIRS)
+
+$(INSTALL_SUBDIRS):
+	@if test -f $@/NOINSTALL ; then \
+	    echo skipping $@ ; \
+	else \
+	    echo installing $@ to $(MPATH)/$@ ; \
+	    ../$(INSTALLOCT) $@ $(MPATH)/$@ $(OPATH) $(XPATH) ; \
+	fi
+
+clean: $(MAKE_SUBDIRS)
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/AUTHORS	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,1 @@
+Rafael Laboissiere <rafael@laboissiere.net>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/ChangeLog	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,25 @@
+2001-07-27  Rafael Laboissiere  <rafael@icp.inpg.fr>
+
+	* configure.in: Bumped version number to 0.1.1.
+
+	* README: Copyright notice.
+
+	* NEWS: Copyright notice and information about release 0.1.1.
+
+2001-07-26  Rafael Laboissiere  <rafael@icp.inpg.fr>
+
+	* gpc_write.cc (gpc_write): Correctly call get_gpc_pt, avoid
+	segmentation faults.
+
+	* gpc_create.cc (gpc_create): Removed spurious call to warning ().
+
+2001-07-25  Rafael Laboissiere  <rafael@icp.inpg.fr>
+
+	* gpc_plot.m: Fixed logic for assigning values to default input
+	parameters.  Thanks to Etienne Grossmann
+	<etienne@anonimo.isr.ist.utl.pt>.
+
+2001-07-23  Rafael Laboissiere  <rafael@icp.inpg.fr>
+
+	* Initial release 0.1.
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/Makefile.am	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,48 @@
+octdir = $(prefix)/$(OCTDIR)/gpc
+
+linked_oct_files = \
+  gpc_clip.oct \
+  gpc_write.oct \
+  gpc_read.oct \
+  gpc_get.oct \
+  gpc_tristrip.oct \
+  gpc_is_polygon.oct
+
+oct_SCRIPTS = \
+  $(linked_oct_files) \
+  gpc_create.oct
+
+m_scriptdir = $(prefix)/$(MDIR)/gpc
+
+m_script_DATA = gpc_plot.m
+
+CCFILES = \
+  $(oct_SCRIPTS:.oct=.cc) \
+  octave-gpc.cc
+
+OBJFILES = $(CCFILES:.cc=.o)
+
+EXTRA_DIST = \
+  bootstrap.sh \
+  gpc_plot.m \
+  $(CCFILES) \
+  octave-gpc.h
+
+%.o: %.cc octave-gpc.h
+	$(MKOCTFILE) -v -s -c $<
+
+gpc_create.oct: $(OBJFILES)
+	$(MKOCTFILE) -v -s -lgpcl -o $@ $^
+
+%.oct: gpc_create.oct
+	ln -f $< $@
+
+install-data-hook:
+	for i in $(linked_oct_files) ; \
+	  do ln -f $(octdir)/gpc_create.oct $(octdir)/$$i ; \
+	done
+
+clean:
+	rm -f *.oct *.o *core
+
+.PHONY: clean
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/NEWS	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,30 @@
+Octave-GPC NEWS -- history of user-visible changes.  
+$Id$
+
+Copyright (C) 2001  Rafael Laboissiere
+See the end for copying conditions.
+
+
+* octave-gpc 0.1.1 is a bug-fix release with few user-visible changes
+  Thanks to Etienne Grossmann <etienne@anonimo.isr.ist.utl.pt> for the bug
+  hunting. 
+
+----------------------------------------------------------------------
+Copyright information:
+
+Copyright (C) 2001  Rafael Laboissiere <rafael@laboissiere.net>
+
+   Permission is granted to anyone to make or distribute verbatim copies
+   of this document as received, in any medium, provided that the
+   copyright notice and this permission notice are preserved,
+   thus giving the recipient permission to redistribute in turn.
+
+   Permission is granted to distribute modified versions
+   of this document, or of portions of it,
+   under the above conditions, provided also that they
+   carry prominent notices stating who last changed them.
+^L
+Local variables:
+mode: outline
+paragraph-separate: "[  ^L]*$"
+end:
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/README	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,176 @@
+Octave-GPC README
+$Id$
+
+Copyright (C) 2001  Rafael Laboissiere
+See the end for copying conditions.
+
+
+=======================================================
+Octave bindings for the General Polygon Clipper Library
+=======================================================
+
+
+Introduction
+------------
+
+The General Polygon Clipper is a flexible and highly robust polygon set
+operations library for use with C applications written by Alan Murta (see
+http://www.cs.man.ac.uk/~amurta/software/index.html#gpc for details).  The
+octave-gpc package implements Octave bindings for GPC.  Almost all the
+functionalities of the C API are replicated in the Octave API.
+
+
+Requirements
+------------
+
+The code for the Octave DLD functions depends on features specific to the
+2.1.x series of Octave (development branch).  Although the 2.1 branch is
+designated "unstable", the author does not have found major problems in
+using octave-gpc with Octave 2.1.32.  Although, incompatible changes
+may happen across minor versions of the development branch.  If octave-gpc
+does not work with later versions of Octave, please notify the author.
+
+Octave-gpc depends on a shared library version of GPC, version 2.31 or
+later, called libgpcl.  The package distributed in the GPC web site has a
+very rudimentary Makefile, which does not buidl a shared library.  The
+Debian GNU/Linux package for GPC (called gpcl due to clash name with the
+GNU Pascal Compiler) uses a Libtool/Automake configuration setup that
+allows the building and installation of the shared library.  You can obtain
+the Debian package at http://packages.debian.org/libgpcl-dev.  You will
+need both the .orig.tar.gz and the .diff.gz files.
+
+
+Configuration, Build, & Installation
+------------------------------------
+
+Octave-gpc uses autoconf and automake for configuration.  The file INSTALL
+contains general installation intructions.  Configure the package with
+./configure.  The --help option to configure gives a list of options
+available for changing the default behavior.  In particular, options
+--with-octave and --with-mkoctfile should be used to indicate the location
+of version 2.1 for the programs octave and mkoctfile.  The other
+configuration parameters (destination of .m and .oct files, as well as the
+libexec directory) are guessed using the mkoctfile program.
+
+Building and installation should be as simple as typing "make" and "make
+install". 
+
+
+Using the Octave bindings
+-------------------------
+
+The functions of the octave-gpc package manipulate a special type of Octave
+object, called gpc_polygon.  This object stores internally a C gpc_polygon
+structure, as defined by the GPC library.  Since its members cannot be
+directly accessible from Octave, octave-gpc allows an intermediary
+representation.  A gpc_polygon is fully defined by three matrices:
+
+  1) A `vertices' matrix containing the x and y coordinates of the points
+     corresponding to the vertices of the polygon.  This must always be a
+     two-column matrix (x is the first column, y the second, one point per
+     row). The polygon is always assumed to be closed, so there is no need
+     to replicate the first point at the last row.
+
+  2) An `indices' matrix defining the contours that compound the
+     polygon. This is a two-column matrix of integer values, one line for
+     each contour.  The first and second column indicate, respectively, the
+     initial amd final row indices in the "vertices" matrix.
+
+     For example, if vertices = [1, 12; 13, 16], the polygon is composed of
+     two contours, whose vertices are  vertices(1:12,:) and
+     vertices(13:16,:).
+
+  3) A `hole' boolean vector indicating if each contour is a hole or not.
+
+     In the example above, if hole = [0; 1], the polygon defined by the
+     points vertices(13:16,:) is a hole.
+
+These three matrices can be given as arguments to the function gpc_create.
+This function returns a Octave object of type gpc_polygon:
+
+  octave> p = gpc_create (vertices, indices, hole);
+
+The `indices' and `hole' arguments are optional.  `hole' defaults to
+zeroes(size(indices,1),2), while indices defaults to [1,size(vertices,1)].
+
+Polygons in octave-gpc can also be represented by an Octave struct
+containing the fields `vertices', `indices', and `hole'.  gpc_create also
+accept a single struct argument:
+
+    octave> m.vertices = vertices,
+    octave> m.indices = indices;
+    octave> m.hole = hole;
+    octave> p = gpc_create (m);
+
+It is possible to obtain the associated struct of a gpc_polygon object by
+using the gpc_get function:
+
+    octave> m = gpc_get (p);
+
+Another way of creating gpc_polygon objects is by reading a polygon
+definition from a file:
+
+    octave> p = gpc_read ("filename");
+
+The file should be in the format described in the GPC library
+documentation.  gpc_polygon objects can be saved in that format using
+gpc_write:
+
+    octave> gpc_write (p, "filename");
+
+To assert if a given variable is a gpc_polygon object, use the
+gpc_is_polygon funciton:
+
+    octave> if gpc_is_polygon (p), disp "You are in business", endif;
+
+The clipping operations in octave-gpc are realized by the gpc_clip
+function:
+
+    octave> gpc_clip (p, q, operation);
+
+where `p' and `q' are gpc_polygon objects and `operation' is one of the
+strings "DIFF", "INT", "XOR", or "UNION".  If the third argument is
+omitted, `operation' defaults to "INT".  See the GPC documentation for the
+meaning of these operations.
+
+General polygons can be represented by tristrips, a collection of triangles
+suitable for fill plottings.  To transform a gcp_polygon into its tristrip
+representation, use:
+
+    octave> q = gcp_tristrip (p);
+
+In octave-gpc, there is a convenience script for plotting polygons called
+gpc_plot.  Its simplest invocation is as follows:
+
+    octave> gpc_plot (p);
+
+This call will plot the gpc_polygon `p' in the current figure and let it in
+the `hold on' state.  With a second argument, it is possible to specify a
+line format for the plot.  For instance:
+
+   octave> gpc_plot (p, "b.");
+
+will plot the polygon with the blue, dotted lines.  You can use a third
+argument with value 1 if the polygon is actually a tristrip.  In this case,
+if the `fill' function is available, a fill plot will be done.  (`fill' is
+available in the matcompat package; see http://octave.sf.net).
+
+----------------------------------------------------------------------
+Copyright information:
+
+Copyright (C) 2001  Rafael Laboissiere <rafael@laboissiere.net>
+
+   Permission is granted to anyone to make or distribute verbatim copies
+   of this document as received, in any medium, provided that the
+   copyright notice and this permission notice are preserved,
+   thus giving the recipient permission to redistribute in turn.
+
+   Permission is granted to distribute modified versions
+   of this document, or of portions of it,
+   under the above conditions, provided also that they
+   carry prominent notices stating who last changed them.
+
+
+Local variables: 
+mode: indented-text
+End:
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/bootstrap.sh	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,7 @@
+#! /bin/sh
+
+aclocal \
+  && automake --add-missing \
+  && autoconf
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/configure.in	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,100 @@
+dnl Process this file with autoconf to produce a configure script.
+AC_INIT(octave-gpc.h)
+
+AM_INIT_AUTOMAKE(octave-gpc, 0.1.1)
+
+dnl Checks for programs.
+AC_PROG_CC
+AC_PROG_CPP
+
+AC_PATH_PROG(PERL, perl)
+
+AC_ARG_WITH(octdir,
+  [
+  --with-octdir           Specify the path for installation of .oct
+                          files.  If not given, try to determine it by 
+                          running octave --version.],
+  [OCTDIR=$withval])
+
+AC_ARG_WITH(mdir,
+  [
+  --with-mdir             Specify the path for installation of .m files.
+                          If not given, try to determine it by running
+                          octave --version.],
+  [MDIR=$withval])
+
+AC_ARG_WITH(libexec,
+  [
+  --with-libexec          Name of the lib subdir in octave hierarchy
+                          (default = libexec)],
+  [LIBEXEC=$withval], [LIBEXEC=libexec])
+AC_SUBST(LIBEXEC)
+
+AC_ARG_WITH(octave,
+  [
+  --with-octave           Specify the octave path (version 2.1.* or 
+                          later)],
+  [OCTAVE=$withval])
+
+[if [ "$OCTDIR" = "" \] ; then]
+
+AC_PATH_PROG(OCTAVE, octave)
+
+octave_version_msg=`$OCTAVE --version`
+
+[OCTAVE_VERSION=`echo "$octave_version_msg" | \
+  $PERL -ne '/version ([0-9.]+)/; print $1;'`]
+
+AC_MSG_CHECKING(for version 2.1 of octave)
+[if echo "$OCTAVE_VERSION" | \
+     perl -ne '/([0-9]+)\.([0-9]+)/; exit 1 if ($1>=2 and $2>=1); exit 0' ; then]
+  AC_MSG_RESULT(no)
+  AC_MSG_ERROR(version of octave must be 2.1 or later)
+fi
+AC_MSG_RESULT(yes)
+
+[OCTAVE_ARCH=`echo "$octave_version_msg" | \
+  $PERL -ne '/\(([^)]+)\)/; print $1; last;'`]
+
+OCTDIR=$LIBEXEC/octave/$OCTAVE_VERSION/oct/$OCTAVE_ARCH
+
+MDIR=share/octave/$OCTAVE_VERSION/site/m/
+
+fi # if OCTDIR
+AC_SUBST(OCTDIR)
+
+AC_SUBST(MDIR)
+
+AC_ARG_WITH(mkoctfile,
+  [
+  --with-mkoctfile        Specify the mkoctfile path (version 2.1.* 
+                          or later).],
+  [MKOCTFILE=$withval])
+
+AC_PATH_PROG(MKOCTFILE, mkoctfile)
+
+AC_MSG_CHECKING(for version 2.1 of mkoctfile)
+[if perl -ne \
+   'if(/INCFLAGS/){/octave-([0-9]+)\.([0-9]+)/; \
+    exit 1 if ($1>=2 and $2>=1); exit 0}' \
+   < $MKOCTFILE ; then]
+  AC_MSG_RESULT(no)
+  AC_MSG_ERROR(version of mkoctfile must be 2.1 or later)
+fi
+AC_MSG_RESULT(yes)
+
+dnl Checks for libraries.
+AC_CHECK_LIB(gpcl, gpc_polygon_clip)
+
+[if [ "$HAVE_GPCLLIBRARY" != "" \] ; then]
+  AC_MSG_ERROR(the gpc library must be available in the system)
+fi
+
+dnl Checks for header files.
+
+dnl Checks for typedefs, structures, and compiler characteristics.
+dnl AC_C_CONST
+
+dnl Checks for library functions.
+
+AC_OUTPUT(Makefile)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/debian/changelog	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,21 @@
+octave-gpc (0.1.1-1) unstable; urgency=low
+
+  * New upstream release.
+
+ -- Rafael Laboissiere <rafael@icp.inpg.fr>  Thu, 26 Jul 2001 16:34:01 +0200
+
+octave-gpc (0.1-2) unstable; urgency=low
+
+  * debian/copyright: Added url location of upstream source.
+
+ -- Rafael Laboissiere <rafael@icp.inpg.fr>  Mon, 23 Jul 2001 13:25:49 +0200
+
+octave-gpc (0.1-1) unstable; urgency=low
+
+  * Initial Release.
+
+ -- Rafael Laboissiere <rafael@icp.inpg.fr>  Fri,  4 Aug 2000 15:13:57 +0200
+
+Local variables:
+mode: debian-changelog
+End:
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/debian/control	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,15 @@
+Source: octave-gpc
+Section: contrib/math
+Priority: optional
+Maintainer: Rafael Laboissiere <rafael@icp.inpg.fr>
+Standards-Version: 3.5.2
+Build-Depends: debhelper, libgpcl-dev, octave2.1-headers
+
+Package: octave-gpc
+Architecture: any
+Depends: octave2.1, ${shlibs:Depends}
+Description: Octave bindings for the General Polygon Clipper Library
+ GPC is a flexible and highly robust polygon set operations library for use
+ with C applications.  This package contains bindings for use of the library
+ functions with Octave.
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/debian/copyright	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,31 @@
+This package was debianized by Rafael Laboissiere <rafael@debian.org> on
+Fri,  4 Aug 2000 15:13:57 +0200.
+
+It was downloaded from:
+
+    http://prdownloads.sourceforge.net/octave/octave-gpc-0.1.tar.gz
+    
+Upstream Author: Rafael Laboissiere <rafael@laboissiere.net>
+
+Copyright:
+
+    Copyright (C) 2001 Rafael Laboissiere
+
+    This program is free software; you can redistribute it and/or
+    modify it under the terms of the GNU General Public License as
+    published by the Free Software Foundation; either version 2 of the
+    License, or (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+    02111-1307, USA.
+
+On Debian GNU/Linux systems, the complete text of the GNU General
+Public License can be found in `/usr/share/common-licenses/GPL'.
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/debian/cvsdir.sh	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,38 @@
+#! /bin/bash
+
+# File: cvsdir.sh
+# Description: Save and restore CVS dirs under current dir.  This is
+#   useful for genrating a Debian package without the CVS
+#   administrative directories, but getting them restored later.
+# Author: Rafael Laboissière <rafael@icp.inpg.fr>
+# Created on: Mon Feb 12 18:06:37 CET 2001
+# Last modified on: Mon Feb 12 18:07:48 CET 2001
+# $Id$
+
+
+cvsdirs=`find . -type d -and -name CVS`
+cvstar=../cvs.tar
+
+case "$1" in
+  save) 
+    if [ -n "$cvsdirs" ] ; then 
+      tar cf $cvstar $cvsdirs
+      rm -rf $cvsdirs
+    else
+      echo "W: No CVS dirs under ." 1>&2
+    fi
+  ;;
+  restore)
+    if [ -f $cvstar ] ; then
+      tar xf $cvstar
+    else
+      echo "E: File $cvstar not found" 1>&2
+    fi
+  ;;
+  *)
+    cat 1>&2 <<EOF
+Usage $0 <save|restore>
+EOF
+  ;;
+esac
+		    
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/debian/docs	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,1 @@
+README
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/debian/gpc_test.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,16 @@
+### Read subject and clip polygons
+s = gpc_read ("/usr/share/doc/libgpcl-dev/examples/subj1.gpf");
+c = gpc_read ("/usr/share/doc/libgpcl-dev/examples/clip1.gpf");
+
+### Compute clipping poligon (intersection)
+r = gpc_clip (s,c);
+
+### Plot the polygons
+gset nokey
+gset size square
+gset terminal x11
+hold off
+gpc_plot (s, "r");
+gpc_plot (c, "g");
+gpc_plot (r, "b");
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/debian/rules	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,70 @@
+#!/usr/bin/make -f
+# Sample debian/rules that uses debhelper.
+# GNU copyright 1997 to 1999 by Joey Hess.
+
+# Uncomment this to turn on verbose mode.
+#export DH_VERBOSE=1
+
+# This is the debhelper compatability version to use.
+export DH_COMPAT=1
+
+build: build-stamp
+build-stamp:
+	dh_testdir
+
+	./configure --with-octave=/usr/bin/octave2.1 \
+                    --with-mkoctfile=/usr/bin/mkoctfile \
+                    --with-libexec=lib \
+                    --prefix=/usr
+
+	# Add here commands to compile the package.
+	$(MAKE)
+
+	touch build-stamp
+
+clean:
+	dh_testdir
+	dh_testroot
+	rm -f build-stamp
+
+	# Add here commands to clean up after the build process.
+	-$(MAKE) clean
+	-$(MAKE) distclean
+
+	dh_clean
+
+install: build
+	dh_testdir
+	dh_testroot
+	dh_clean -k
+	dh_installdirs
+
+	# Add here commands to install the package into debian/tmp.
+	strip -R .note -R .comment gpc_create.oct
+	$(MAKE) install prefix=`pwd`/debian/tmp/usr
+
+
+# Build architecture-independent files here.
+binary-indep: build install
+# We have nothing to do by default.
+
+# Build architecture-dependent files here.
+binary-arch: build install
+	dh_testdir
+	dh_testroot
+	dh_installdocs
+	dh_installexamples debian/gpc_test.m
+	dh_installchangelogs ChangeLog
+	dh_link
+	dh_strip
+	dh_compress
+	dh_fixperms
+#	dh_makeshlibs
+	dh_installdeb
+	dh_shlibdeps
+	dh_gencontrol
+	dh_md5sums
+	dh_builddeb
+
+binary: binary-indep binary-arch
+.PHONY: build clean binary-indep binary-arch binary install
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/gpc_clip.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,120 @@
+/*
+
+Copyright (C) 2001 Rafael Laboissiere
+
+This file is part of octave-gpc.
+
+octave-gpc is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+octave-gpc is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with octave-gpc; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+#include "octave-gpc.h"
+
+// This is the user function for polygon operations
+DEFUN_DLD (gpc_clip, args, ,
+"  SYNOPSIS:\n"
+"    result = gpc_clip (subject, clip, [operation]])\n"
+"\n"
+"  DESCRIPTION:\n"
+"    Make an clipping operation between the SUBJECT and CLIP\n"
+"    arguments, which must be gpc_polygon objects.  The OPERATION\n"
+"    argument must be one of \"DIFF\", \"INT\", \"XOR\", or\n"
+"    \"UNION\" (the default value is \"INT\").\n" 
+"\n"
+"    RESULT is the resulting gpc_polygon object.\n"
+"\n"
+"  SEE ALSO:\n"
+"    The General Polygon Clipper Library documentation.\n"
+"    gpc_create, gpc_get, gpc_read, gpc_write,\n"
+"    gpc_is_polygon, gpc_plot.\n" )
+{
+  octave_value retval;
+  gpc_op operation = GPC_INT;
+  gpc_polygon *subject, *clip, result;
+
+  // Sanity check of the arguments
+  int nargin = args.length ();
+  
+  if (nargin < 2 || nargin > 3)
+    print_usage ("gpc_clip");
+  else
+    {
+      if ( nargin == 3 )
+	{
+	  string op = args (2).string_value ();
+	  if ( error_state )
+	    {
+	      error ("gpc_clip: operation argument should be a "
+		     "string");
+	      return retval;
+	    }
+	  else
+	    {
+	      if ( op == "DIFF" )
+		operation = GPC_DIFF;
+	      else
+		if ( op == "INT" )
+		  operation = GPC_INT;
+		else
+		  if ( op == "XOR" )
+		    operation = GPC_XOR;
+		  else
+		    if ( op == "UNION" )
+		      operation = GPC_UNION;
+		    else
+		      {
+			error ("gpc_clip: operation argument must be "
+			       "one of \"DIFF\", \"INT\", \"XOR\", or "
+			       "\"UNION\"");
+			return retval;
+		      }
+	    }
+	}
+
+      if ( args(0).type_id () == octave_gpc_polygon::static_type_id () )
+	  subject = get_gpc_pt (args(0));
+      else
+	{
+	  error ("gpc_clip: subject argument must be of type "
+		 "gpc_polygon");
+	  return retval;
+	}
+      
+      if ( args (1).type_id () == octave_gpc_polygon::static_type_id () )
+	  clip = get_gpc_pt (args(1));
+      else
+	{
+	  error ("gpc_clip: clip argument must be of type "
+		 "gpc_polygon");
+	  return retval;
+	}
+      
+      gpc_polygon_clip (operation, subject, clip, &result);
+      Octave_map m;
+      gpc_to_map (&result, &m);
+      retval = octave_value (new octave_gpc_polygon (m));
+      
+      // The result polygon must be freed by the C library function as
+      // it was created by gpc_polygon_clip.
+      gpc_free_polygon (&result);
+    }  
+  return retval;
+}
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; End: ***
+*/
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/gpc_create.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,105 @@
+/*
+
+Copyright (C) 2001 Rafael Laboissiere
+
+This file is part of octave-gpc.
+
+octave-gpc is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+octave-gpc is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with octave-gpc; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+#include "octave-gpc.h"
+
+// This is the user function for creating the gpc_polygon object.
+DEFUN_DLD (gpc_create, args, ,
+"  SYNOPSIS:\n"
+"    polygon = gpc_create (vertices[, indices[, hole]])\n"
+"    polygon = gpc_create (polygon_struct)\n"
+"\n"
+"  DESCRIPTION:\n"
+"    Create a gpc_polygon object for futher use with gpc_clip.  When\n"
+"    called with regular matrices as arguments, gpc_create accepts a\n"
+"    [n,2] matrix as VERTICES, containing the x and y coordinates of\n"
+"    the polygon vertices, a [m,2] integer matrix as INDICES with the\n"
+"    initial (first column) and final (second column) indices of each\n"
+"    contour composing the polygon, and a [m,1] boolean vector HOLE,\n"
+"    which specifies which contours are holes.  The HOLE and INDICES\n"
+"    are optional parameters and they default to:\n"
+"\n"
+"      HOLE = zeroes(size(indices,1),2)\n"
+"      INDICES = [1,size(vertices,1)]\n"
+"\n" 
+"    gpc_create can also be called with a single argument that is a\n"
+"    structure.  In this case it must be a structure containing the\n"
+"     members vertices, indices and hole, as above.\n"
+"\n"
+"    The value return is an object of type gpc_polygon.\n"
+"\n"
+"  SEE ALSO:\n"
+"    The General Polygon Clipper Library documentation.\n"
+"    gpc_clip, gpc_get, gpc_read, gpc_write, \n"
+"    gpc_is_polygon, gpc_plot.\n" )
+{
+  octave_value retval;
+
+  static bool type_loaded = false;
+
+  if (! type_loaded)
+    {
+      octave_gpc_polygon::register_type ();
+      type_loaded = true;
+    }
+
+  int nargin = args.length ();
+
+  if (nargin < 1 || nargin > 3)
+
+    print_usage ("gpc_create");
+
+  else
+    {
+      Octave_map* m;
+
+      if (args (0).is_map ())
+	 m = new Octave_map (args (0).map_value ());
+      else
+	{
+	  m = new Octave_map ();
+
+	  (*m) ["vertices"] = args (0);
+	  if (nargin > 1)
+	    {
+	      (*m) ["indices"] = args (1);
+	      if (nargin > 2)
+		(*m) ["hole"] = args (2);	  
+	    }
+	}
+
+      if ( ! assert_gpc_polygon (m) ) 
+	warning ("gpc_create: inconsistent arguments, but "
+		 "gpc_polygon object created anyway");
+
+      retval = octave_value (new octave_gpc_polygon (*m));
+
+      delete m;
+    }
+  return retval;
+}
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; End: ***
+*/
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/gpc_get.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,69 @@
+/*
+
+Copyright (C) 2001 Rafael Laboissiere
+
+This file is part of octave-gpc.
+
+octave-gpc is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+octave-gpc is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with octave-gpc; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+#include "octave-gpc.h"
+
+// This are the user functions for reading (writing) polygons from (to)
+// files. 
+DEFUN_DLD (gpc_get, args, ,
+"  SYNOPSIS:\n"
+"    polygon_struct = gpc_get (polygon)\n"
+"\n"
+"  DESCRIPTION:\n"
+"    Obtain the associated structure of a gpc_polygon object.  See\n"
+"    the documentation of gpc_create for the details.\n"
+"\n"
+"  SEE ALSO:\n"
+"    The General Polygon Clipper Library documentation.\n"
+"    gpc_create, gpc_clip, gpc_read, gpc_write, \n"
+"    gpc_is_polygon, gpc_plot.\n" )
+{
+  octave_value retval;
+
+  // Sanity check of the arguments
+  int nargin = args.length ();
+  
+  if ( nargin != 1 )
+    print_usage ("gpc_get");
+  else
+    {
+      if ( args(0).type_id () != octave_gpc_polygon::static_type_id () )
+	{
+	  error ("gpc_get: argument must be of type gpc_polygon");
+	  return retval;
+	}
+      else 
+	{
+	  Octave_map m;
+	  gpc_to_map (get_gpc_pt (args(0)), &m);
+	  retval = octave_value (m);
+	}  
+    }
+
+  return retval;
+}
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; End: ***
+*/
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/gpc_is_polygon.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,57 @@
+/*
+
+Copyright (C) 2001 Rafael Laboissiere
+
+This file is part of octave-gpc.
+
+octave-gpc is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+octave-gpc is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with octave-gpc; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+#include "octave-gpc.h"
+
+// This is the user function for testing if an object is a gpc_polygon
+DEFUN_DLD (gpc_is_polygon, args, ,
+"  SYNOPSIS:\n"
+"    result = gpc_is_polygon (x)\n"
+"\n"
+"  DESCRIPTION:\n"
+"    Returns true if X is a object of type gpc_polygon.  Returns false\n"
+"    otherwise.\n"
+"\n"
+"  SEE ALSO:\n"
+"    The General Polygon Clipper Library documentation.\n"
+"    gpc_create, gpc_clip, gpc_read, gpc_write, \n"
+"    gpc_get, gpc_plot.\n" )
+{
+  octave_value retval = false;
+
+  // Sanity check of the arguments
+  int nargin = args.length ();
+  
+  if (nargin != 1)
+    print_usage ("gpc_is_polygon");
+  else
+    retval = octave_value
+      (args(0).type_id () == octave_gpc_polygon::static_type_id ());
+
+  return retval;
+}
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; End: ***
+*/
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/gpc_plot.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,101 @@
+## Copyright (C) 2000 Rafael Laboissiere
+##
+## This program is free software.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
+## usage: gpc_plot (polygon [, format [, type]])
+##
+## The first argument must be a gpc_polygon object.  Its contours will
+## be plotted with intervening hold on.  The plot will be left in a
+## holded on state after call to gpc_plot.
+##
+## If a second argument is provided, it is interpreted as the plotting
+## style.  See the documentation for the plot command for q description
+## of possible styles.
+##
+## The third optional parameter, if set to 1, indicates that POLYGON is
+## of type tristrip, instead of a regular gpc_polygon.  See the
+## documentation for gpc_tristrip for more details.
+##
+## See also: gpc_create, plot, gpc_tristrip
+
+## Author: Rafael Laboissiere <rafael@laboissiere.net>
+
+function gpc_plot (p, f, t)
+
+  if nargin < 1 | nargin > 3
+    usage ("gpc_plot (polygon [, format [, type]])");
+
+  else
+    if ! gpc_is_polygon (p)
+      error ("gpc_plot: first argument must be a gpc_polygon object");
+
+    else
+      if nargin < 3
+	t = 0;
+        if nargin < 2
+	  f = "";
+        endif
+      endif	
+
+      ## Test for existence of fill.m function (in matcompat package)
+      ## for plotting tristrips
+      if exist ("fill") == 2
+	plot_fcn = "fill";
+      else
+	plot_fcn = "plot";
+      end
+
+      s = gpc_get (p);
+      vtx = s.vertices;
+      idx = s.indices;
+
+      for i = 1 : size (idx, 1)
+
+	if t == 0
+
+          ## Normal polygon plot
+	  j = [ idx (i, 1) : idx (i, 2), idx (i, 1) ];
+	  if strcmp (f, "")
+	    plot (vtx (j, 1), vtx (j, 2))
+	  else
+	    plot (vtx (j, 1), vtx (j, 2), f)
+	  endif
+	  hold on
+
+	else
+
+	  ## Tristrip plotting
+          for j = idx (i,1) : idx (i,2) - 2
+	    k = j + [0, 1, 2, 0];
+	    if strcmp (f, "")
+	      feval (plot_fcn, vtx (k, 1), vtx (k, 2));
+	    else
+	      feval (plot_fcn, vtx (k, 1), vtx (k, 2), f);
+	    endif
+	    hold on
+	  endfor	
+	  
+	endif
+
+      endfor
+
+    endif
+
+  endif
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/gpc_read.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,96 @@
+/*
+
+Copyright (C) 2001 Rafael Laboissiere
+
+This file is part of octave-gpc.
+
+octave-gpc is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+octave-gpc is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with octave-gpc; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+#include "octave-gpc.h"
+
+// This are the user functions for reading (writing) polygons from (to)
+// files. 
+DEFUN_DLD (gpc_read, args, ,
+"  SYNOPSIS:\n"
+"    polygon = gpc_read (file [, read_hole_flags])\n"
+"\n"
+"  DESCRIPTION:\n"
+"    Reads a gpc_polygon from FILE, which is in the format described in\n"
+"    the GPC documentation.  The reading of hole flags is optional and is\n"
+"    controlled by setting the optional argument READ_HOLE_FLAGS (0 for\n"
+"    false and 1 for true)."
+"\n"
+"    The returned value POLYGON is a gpc_polygon object.\n"
+"\n"
+"  SEE ALSO:\n"
+"    The General Polygon Clipper Library documentation.\n"
+"    gpc_create, gpc_clip, gpc_get, gpc_write, \n"
+"    gpc_is_polygon, gpc_plot.\n" )
+{
+  octave_value retval;
+  gpc_polygon p;
+  int read_hole_flags = 0;
+
+  // Sanity check of the arguments
+  int nargin = args.length ();
+  
+  if ( nargin < 1 || nargin > 2 )
+    print_usage ("gpc_read");
+  else
+    {
+      if ( nargin == 2 )
+	{
+	  octave_value ov = args (1);
+	  if ( ! ov.is_real_scalar () )
+	    {
+	      error ("gpc_read: read_hole_flags must be a real "
+		     "scalar");
+	      return retval;
+	    }
+	  read_hole_flags = (int) ov.double_value ();
+	}
+      if ( ! args (0).is_string () )
+	{
+	  error ("gpc_read: file argument must be string");
+	  return retval;
+	}
+	
+      FILE *fp = fopen (args (0).string_value ().c_str (), "r");
+      if ( fp == NULL )
+	{
+	  error ("gpc_read: cannot open file");
+	  return retval;
+	}
+
+      gpc_read_polygon (fp, read_hole_flags, &p);
+      fclose (fp);
+
+      Octave_map m;
+      gpc_to_map (&p, &m);
+      retval = octave_value (new octave_gpc_polygon (m));
+
+      gpc_free_polygon (&p);
+      
+    }  
+  return retval;
+}
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; End: ***
+*/
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/gpc_tristrip.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,84 @@
+/*
+
+Copyright (C) 2001 Rafael Laboissiere
+
+This file is part of octave-gpc.
+
+octave-gpc is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+octave-gpc is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with octave-gpc; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+#include "octave-gpc.h"
+
+// This are the user functions for reading (writing) polygons from (to)
+// files. 
+DEFUN_DLD (gpc_tristrip, args, ,
+"  SYNOPSIS:\n"
+"    tristrip = gpc_tristrip (polygon)\n"
+"\n"
+"  DESCRIPTION:\n"
+"    Obtain a TRISTRIP representation of POLYGON, a gpc_polygon object.\n"
+"    Tristrips are suitable for fill plottings and are coped with by\n"
+"    gpc_plot.\n"
+"\n"
+"  SEE ALSO:\n"
+"    The General Polygon Clipper Library documentation.\n"
+"    gpc_create, gpc_clip, gpc_get, gpc_read, gpc_write, \n"
+"    gpc_is_polygon, gpc_plot.\n" )
+{
+  octave_value retval;
+
+  // Sanity check of the arguments
+  int nargin = args.length ();
+  
+  if ( nargin != 1 )
+    print_usage ("gpc_tristrip");
+  else
+    {
+      if ( args(0).type_id () != octave_gpc_polygon::static_type_id () )
+	{
+	  error ("gpc_tristrip: argument must be of type gpc_polygon");
+	  return retval;
+	}
+      else 
+	{
+	  gpc_tristrip t;
+          gpc_polygon p;
+
+          gpc_polygon_to_tristrip (get_gpc_pt (args (0)), &t);
+
+	  p.contour = t.strip;
+	  int n = (p.num_contours = t.num_strips);
+          p.hole = new int [n];
+          for (int i = 0; i < n; i++)
+	    p.hole[i] = 0;
+
+	  Octave_map m;
+	  gpc_to_map (&p, &m);
+	  retval = octave_value (new octave_gpc_polygon (m));
+
+          gpc_free_tristrip (&t);
+          delete [] p.hole;
+	}  
+    }
+
+  return retval;
+}
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; End: ***
+*/
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/gpc_write.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,98 @@
+/*
+
+Copyright (C) 2001 Rafael Laboissiere
+
+This file is part of octave-gpc.
+
+octave-gpc is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+octave-gpc is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with octave-gpc; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+#include "octave-gpc.h"
+
+// This are the user functions for reading (writing) polygons from (to)
+// files. 
+DEFUN_DLD (gpc_write, args, ,
+"  SYNOPSIS:\n"
+"    gpc_write (polygon, file [, write_hole_flags])\n"
+"\n"
+"  DESCRIPTION:\n"
+"    Write a gpc_polygon to FILE in the format described in the GPC \n"
+"    documentation.  The writing of hole flags is optional and is\n"
+"    controlled by setting the optional argument WRITE_HOLE_FLAGS (0 for\n"
+"    false and 1 for true).\n"
+"\n"
+"  SEE ALSO:\n"
+"    The General Polygon Clipper Library documentation.\n"
+"    gpc_create, gpc_clip, gpc_get, gpc_read, \n"
+"    gpc_is_polygon, gpc_plot.\n" )
+{
+  octave_value retval;
+  gpc_polygon *p;
+  int write_hole_flags = 0;
+
+  // Sanity check of the arguments
+  int nargin = args.length ();
+  
+  if ( nargin < 2 || nargin > 3 )
+    print_usage ("gpc_write");
+  else
+    {
+      if ( nargin == 3 )
+	{
+	  octave_value ov = args (2);
+	  if ( ! ov.is_real_scalar () )
+	    {
+	      error ("gpc_write: write_hole_flags must be a real "
+		     "scalar");
+	      return retval;
+	    }
+	  write_hole_flags = (int) ov.double_value ();
+	}
+      if ( args(0).type_id () != octave_gpc_polygon::static_type_id () )
+	{
+	  error ("gpc_write: 1st argument must be of type "
+		 "gpc_polygon");
+	  return retval;
+	}
+      p = get_gpc_pt (args (0));
+
+      if ( ! args (1).is_string () )
+	{
+	  error ("gpc_write: file argument must be string");
+	  return retval;
+	}
+	
+      const char* file = args (1).string_value ().c_str ();
+      FILE *fp = fopen (file, "w");
+      if ( fp == NULL )
+	{
+	  error ("gpc_write: cannot open file %s", file);
+	  return retval;
+	}
+
+      gpc_write_polygon (fp, write_hole_flags, p);
+
+      fclose (fp);
+
+    }  
+  return retval;
+}
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; End: ***
+*/
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/octave-gpc.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,223 @@
+/*
+
+Copyright (C) 2001 Rafael Laboissiere
+
+This file is part of octave-gpc.
+
+octave-gpc is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+octave-gpc is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with octave-gpc; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+#include "octave-gpc.h"
+
+// Registration of the octave_gpc_polygon object type.
+DEFINE_OCTAVE_ALLOCATOR (octave_gpc_polygon);
+
+DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_gpc_polygon, "gpc_polygon");
+
+// Member function
+
+void 
+octave_gpc_polygon::print (ostream& os, bool pr_as_read_syntax = false) const
+{
+  os << "Variable is of type " <<  t_name << ".\n"
+     << "Its members (accessible with the function gpc_get) are:\n";
+  Octave_map m;
+  gpc_to_map (polygon, &m);
+  (octave_struct (m)).print (os);
+}
+
+
+// Utility function to check if an Octave object is a matrix with 2
+// columns.  This is the basic type for x.vertices and x.indices,
+// where x is of type gpc_polygon.
+
+static
+bool
+assert_nx2_matrix (octave_value ov)
+{
+  if ( ! ov.is_matrix_type () )
+    return false;
+  if ( ov.columns () != 2 )
+    return false;
+  return true;
+}
+
+// gpc_polygon_free will free any C gpc_polygon structure initialized
+// by the octave_gpc library (in C++).  For
+void
+octave_gpc_free_polygon (gpc_polygon* p)
+{
+  delete [] p->hole;
+  for (int i = 0; i < p->num_contours; i++)
+    delete [] p->contour[i].vertex;
+  delete [] p->contour;
+}
+
+gpc_polygon*
+get_gpc_pt (octave_value v)
+{
+  // Peek the representation and extract the data (i.e., the pointer
+  // to the gpc_polygon stored in the octave variable).  This seems to
+  // be the only way to do that with Octave 2.1
+  const octave_value& rep = v.get_rep ();
+  return ((const octave_gpc_polygon&) rep).polygon_value ();
+}
+
+void
+map_to_gpc (Octave_map& m, gpc_polygon* p)
+{
+
+  Matrix vtx = m ["vertices"].matrix_value ();
+  Matrix idx = m ["indices"].matrix_value ();
+  ColumnVector hol = m ["hole"].column_vector_value ();
+  int n = idx.rows ();
+
+  p->num_contours = n;
+  p->hole = new int [n];
+  p->contour = new gpc_vertex_list [n];
+
+  for (int i = 0; i < n; i++)
+    {
+      p->hole[i] = (int) hol (i);
+
+      int j0 = (int) idx (i, 0) - 1;
+      int m = (int) idx (i, 1) - j0;
+
+      p->contour[i].num_vertices = m;
+      p->contour[i].vertex = new gpc_vertex [m];
+
+      for (int j = 0; j < m; j++)
+	{
+	  p->contour[i].vertex[j].x = vtx (j0 + j, 0);
+	  p->contour[i].vertex[j].y = vtx (j0 + j, 1);
+	}
+    }
+}
+
+void 
+gpc_to_map (gpc_polygon* p, Octave_map* map)
+{
+  int n = p->num_contours;
+  ColumnVector hol (n);
+  Matrix idx (n, 2);
+  int m = 0;
+  for (int i = 0; i < n; i++) 
+    {
+      hol (i) = p->hole[i];
+      idx (i, 0) = m + 1;
+      m += p->contour[i].num_vertices;
+      idx (i, 1) = m;
+    }
+  Matrix vtx (m, 2);
+  int j = 0;
+  for (int i = 0; i < n; i++)
+    {
+      int m = p->contour[i].num_vertices;
+      gpc_vertex* v = p->contour[i].vertex;
+      for (int k = 0; k < m; k++)
+	{
+	  vtx (j, 0) = v[k].x;
+	  vtx (j++, 1) = v[k].y;
+	}
+    }
+
+  (*map) ["vertices"] = vtx;
+  (*map) ["indices"] = idx;
+  (*map) ["hole"] = hol;
+}  
+  
+bool 
+assert_gpc_polygon (Octave_map* m)
+{
+  if ( ! m->contains ("vertices") )
+    {
+      warning ("No vertices !");
+      return false;
+    }
+  octave_value v = (*m) ["vertices"];
+  if ( ! assert_nx2_matrix (v) )
+    {
+      warning ("assert_gpc_polygon: vertices member should be a "
+	       "[n,2] matrix");
+      	return false;
+    }
+  octave_value i;
+  if ( ! m->contains ("indices") )
+    {
+      Matrix im (1, 2);
+      im (0, 0) = (double) 1;
+      im (0, 1) = (double) v.rows ();
+      i = (*m) ["indices"] = im;
+    }
+  else
+    {
+      i = (*m) ["indices"];
+      if ( ! assert_nx2_matrix (i) )
+	{
+	  warning ("assert_gpc_polygon: indices member should be a "
+		   "[n,2] matrix");
+	  return false;
+	}
+      Matrix im = i.matrix_value ();
+      if ( im.column_max ().max () > v.rows ()
+	   || im.column_min ().min () < 1 )
+	{
+	  warning ("assert_gpc_polygon: indices out of range");
+	  return false;
+	}
+    }
+
+  if ( ! m->contains ("hole") )
+    {
+      ColumnVector h (i.rows ());
+      h.fill ((double) 0);
+      (*m) ["hole"] = h;
+    }
+  else
+    {
+      octave_value h = (*m) ["hole"];
+    
+      if ( (! h.is_matrix_type () || h.columns () != 1)
+	   && ! h.is_real_scalar () )
+	{
+	  warning ("assert_gpc_polygon: hole member should be a "
+		   "column vector");
+	  return false;
+	}
+      int n = h.rows ();
+      if ( n != i.rows () )
+	{
+	  warning ("assert_gpc_polygon: hole member length should "
+		   "be equal to the number of lines of indices member");
+	  return false;
+	}
+      for (int i = 0; i < n; i++)
+	if ( h.matrix_value () (i, 0) != 0
+	     && h.matrix_value () (i, 0) != 1 )
+	  {
+	    warning ("assert_gpc_polygon: hole member elements should "
+		     "be either 0 or 1");
+	    return false;
+	  }
+    }
+  return true;
+}
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; End: ***
+*/
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/gpc/octave-gpc.h	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,84 @@
+/*
+
+Copyright (C) 2001 Rafael Laboissiere
+
+This file is part of octave-gpc.
+
+octave-gpc is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+octave-gpc is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with octave-gpc; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+#include <octave/oct.h>
+#include <octave/oct-lvalue.h>
+#include <octave/ov.h>
+#include <octave/ov-struct.h>
+
+extern "C" {
+#include <gpcl/gpc.h>
+}
+
+void octave_gpc_free_polygon (gpc_polygon*);
+
+gpc_polygon* get_gpc_pt (octave_value);
+
+void map_to_gpc (Octave_map&, gpc_polygon*);
+
+void gpc_to_map (gpc_polygon*, Octave_map*);
+
+bool assert_gpc_polygon (Octave_map*);
+
+class
+octave_gpc_polygon : public octave_base_value
+{
+public:
+
+  octave_gpc_polygon (Octave_map m) 
+    : octave_base_value (), polygon (new gpc_polygon)
+  { map_to_gpc (m, polygon); }
+
+  octave_gpc_polygon (const octave_gpc_polygon& p)
+    : octave_base_value (), polygon (new gpc_polygon) 
+  {
+    Octave_map m;
+    gpc_to_map (p.polygon_value (), &m);
+    map_to_gpc (m, polygon);
+  } 
+
+  ~octave_gpc_polygon (void) { octave_gpc_free_polygon (polygon); }
+  
+  octave_value* clone (void) { return new octave_gpc_polygon (*this); }
+  
+  bool is_defined (void) const { return true; }
+
+  void print (ostream&, bool) const;
+
+  gpc_polygon* polygon_value (void) const { return polygon; }
+
+private:
+
+  gpc_polygon* polygon;
+
+  // The code below is needed for properly defining a new Octave object
+  // type.
+  DECLARE_OCTAVE_ALLOCATOR
+
+  DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA
+};
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; End: ***
+*/
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/splines/LICENSE.gcvsplf	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,22 @@
+MEMO:                     GCVSPL software package
+ 
+(C) COPYRIGHT 1985, 1986: H.J. Woltring
+                          Philips Medical Systems Division, Eindhoven
+                          University of Nijmegen (The Netherlands)
+ 
+DATE:                     1986-05-12
+ 
+NB: This software is copyrighted, and may be copied for excercise,
+study and use without authorization from the copyright owner(s), in
+compliance with paragraph 16b of the Dutch Copyright Act of 1912
+("Auteurswet 1912"). Within the constraints of this legislation, all
+forms of academic and research-oriented excercise, study, and use are
+allowed, including any necessary modifications. Copying and use as
+object for commercial exploitation are not allowed without permission
+of the copyright owners, including those upon whose work the package
+is based.
+
+[see also:
+http://isb.ri.ccf.org/biomch-l/archives/biomch-l-1994-06/00093.html
+http://www.utc.edu/Human-Movement/3-d/herman.htm
+Kai Habel]
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/splines/Makefile	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,12 @@
+include ../../Makeconf
+
+PROGS = gcvspl.oct
+
+all: $(PROGS)
+
+gcvspl.oct: gcvspl.cc gcvsplf.f
+	$(MKOCTFILE) -v gcvspl.cc gcvsplf.f
+
+clean: 
+	-$(RM) *.o $(PROGS) octave-core core *~
+   
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/splines/csaps.m	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,85 @@
+## Author: Joerg Specht
+##
+## This program is granted to the public domain.
+##
+## THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+## ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+## ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+## FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+## OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+## HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+## LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+## OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+## SUCH DAMAGE.
+
+function [r,p]=csaps(x,y,p,xi,w)
+  ## -*- texinfo -*-
+  ## @deftypefn{Function File}{[@var{yi}, @var{p}] =} csaps(@var{x}, @var{y}, @var{p}, @var{xi}, @var{w}=[])
+  ## @deftypefnx{Function File}{[@var{pp}, @var{p}] =} csaps(@var{x}, @var{y}, @var{p}=-1, [], @var{w}=[])
+  ##
+  ## Cubic spline approximation (smoothing)@*
+  ## approximate [x,y] weighted w at xi
+  ##
+  ## @table @asis
+  ## @item @var{p}<0
+  ##       automatic smoothing
+  ## @item @var{p}=0
+  ##       maximum smoothing: straight line
+  ## @item @var{p}=1
+  ##       no smoothing: interpolation
+  ## @end table
+  ##
+  ## @seealso{csapi, ppval, gcvspl}
+  ## @end deftypefn
+
+  if(nargin < 5)
+    w = [];
+    if(nargin < 4)
+      xi = [];
+      if(nargin < 3)
+	p = -1;
+      endif
+    endif
+  endif
+
+  if(columns(x) > 1)
+    x = x.';
+    y = y.';
+    w = w.';
+  endif
+
+  [x,i] = sort(x);
+  y = y(i);
+
+  if(p < 0)
+    md = 2;
+    p = 1;
+  else
+    md = 1;
+    ## csaps uses p=[0..1]; gcvspl uses p=[Inf..0]
+    p = 1/p - 1;
+  endif
+  if(length(xi) > 0)
+    if(columns(xi) > 1)
+      transposed = 1;
+      xi = xi.';
+    else
+      transposed = 0;
+    endif
+    [yi,wk] = gcvspl(x,y,xi,w,[],2,md,p);
+    if(transposed)
+      r = yi.';
+    else
+      r = yi;
+    endif
+  else
+    [D,wk] = gcvspl(x,y,x(1:length(x)-1),w,[],2,md,p,[3,2,1,0]);
+    ## gcvspl() produces derivates D, mkpp() needs coefficients P
+    pp = mkpp(x,[D(:,1)/6,D(:,2)/2,D(:,3),D(:,4)]);
+    r = pp;
+  endif
+  p = 1/(wk(4)+1);
+
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/splines/gcvspl.cc	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,360 @@
+/*
+** Author: Joerg Specht
+**
+** This program is granted to the public domain.
+**
+** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+** ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+** SUCH DAMAGE.
+*/
+
+// use: mkoctfile gcvspl.cc gcvsplf.f
+#define NDEBUG
+
+#include <octave/config.h>
+#include <octave/defun-dld.h>
+#include <octave/error.h>
+#include <octave/help.h>
+#include <octave/oct-obj.h>
+#include <octave/pager.h>
+#include <octave/symtab.h>
+#include <octave/variables.h>
+
+extern "C" {
+  /* by f2c -A ...: */
+  extern int gcvspl_(double *x, double *y, int *ny, 
+		     double *wx, double *wy, int *m, int *n,
+		     int *k, int *md, double *val, double *c,
+		     int *nc, double *wk, int *ier);
+  extern double splder_(int *ider, int *m, int *n, double *t, 
+			double *x, double *c, int *l, double *q);
+}
+
+#ifndef NDEBUG
+#ifndef DEBUGLEVEL
+#define DEBUGLEVEL	255
+#endif
+static int do_debug(const char *fmt, ...) {
+  va_list args;
+  fprintf(stderr, "debug: ");
+  va_start(args, fmt);
+  vfprintf(stderr, fmt, args);
+  va_end(args);
+  fprintf(stderr, "\n");
+  fflush(NULL);
+  return 1;
+}
+#define DEBUG(level, fmtetc)	((level) & DEBUGLEVEL) && do_debug fmtetc
+#else
+#define DEBUG(level, fmtetc)
+#endif
+
+#define ASSERT(what)					\
+	if(!(what)) {					\
+		(*current_liboctave_error_handler)(	\
+			"gcvspl: assertion failed: "#what);	\
+		return retval;				\
+	}
+
+DEFUN_DLD(gcvspl, args, nargout,
+"[yf,wk]=gcvspl(x(n,1),y(n,k), xf(nf,1)=x, wx(n,1)=[],wy(1,k)=[], m=2,md=2,val=1, ider=[0])\n\
+\n\
+uses  GCVSPL.FOR, 1986-05-12\n\
+from  http://www.netlib.org/gcv/index.html\n\
+for   B-spline data smoothing using generalized cross-validation\n\
+      and mean squared prediction or explicit user smoothing\n\
+by    H.J. Woltring,  University of Nijmegen,\n\
+      Philips Medical Systems, Eindhoven (The Netherlands)\n\
+\n\
+Purpose:\n\
+      Natural B-spline data smoothing subroutine, using the Generali-\n\
+      zed Cross-Validation and Mean-Squared Prediction Error Criteria\n\
+      of Craven & Wahba (1979). Alternatively, the amount of smoothing\n\
+      can be given explicitly, or it can be based on the effective\n\
+      number of degrees of freedom in the smoothing process as defined\n\
+      by Wahba (1980). The model assumes uncorrelated, additive noise\n\
+      and essentially smooth, underlying functions. The noise may be\n\
+      non-stationary, and the independent co-ordinates may be spaced\n\
+      non-equidistantly. Multiple datasets, with common independent\n\
+      variables and weight factors are accomodated.\n\
+      A full description of the package is provided in:\n\
+      H.J. Woltring (1986), A FORTRAN package for generalized,\n\
+      cross-validatory spline smoothing and differentiation.\n\
+      Advances in Engineering Software 8(2):104-113\n\
+\n\
+Meaning of parameters:\n\
+      X(N,1)  Independent variables: strictly increasing knot\n\
+              sequence, with X(I-1).lt.X(I), I=2,...,N.\n\
+      Y(N,K)  Input data to be smoothed (or interpolated).\n\
+      XF(NF,1)Points where the function should be approximated.\n\
+      WX(N,1) Weight factor array; WX(I) corresponds with\n\
+              the relative inverse variance of point Y(I,*).\n\
+              If no relative weighting information is\n\
+              available, the WX(I) should be set to ONE.\n\
+              All WX(I).gt.ZERO, I=1,...,N.\n\
+      WY(1,K) Weight factor array; WY(J) corresponds with\n\
+              the relative inverse variance of point Y(*,J).\n\
+              If no relative weighting information is\n\
+              available, the WY(J) should be set to ONE.\n\
+              All WY(J).gt.ZERO, J=1,...,K.\n\
+              NB: The effective weight for point Y(I,J) is\n\
+              equal to WX(I)*WY(J).\n\
+      M       Half order of the required B-splines (spline\n\
+              degree 2*M-1), with M.gt.0. The values M =\n\
+              1,2,3,4 correspond to linear, cubic, quintic,\n\
+              and heptic splines, respectively. N.ge.2*M.\n\
+      MD      Optimization mode switch:\n\
+              |MD| = 1: Prior given value for p in VAL\n\
+                        (VAL.ge.ZERO). This is the fastest\n\
+                        use of GCVSPL, since no iteration\n\
+                        is performed in p.\n\
+              |MD| = 2: Generalized cross validation.\n\
+              |MD| = 3: True predicted mean-squared error,\n\
+                        with prior given variance in VAL.\n\
+              |MD| = 4: Prior given number of degrees of\n\
+                        freedom in VAL (ZERO.le.VAL.le.N-M).\n\
+              After return from MD.ne.1, the same number of\n\
+              degrees of freedom can be obtained, for identical\n\
+              weight factors and knot positions, by selecting\n\
+              |MD|=1, and by copying the value of p from WK(4)\n\
+              into VAL. In this way, no iterative optimization\n\
+              is required when processing other data in Y.\n\
+      VAL     Mode value, as described above under MD.\n\
+      IDER    Derivative order required, with 0.le.IDER\n\
+              and IDER.le.2*M. If IDER.eq.0, the function\n\
+              value is returned; otherwise, the IDER-th\n\
+              derivative of the spline is returned.\n\
+\n\
+Return values:\n\
+      YF(NF,1)Approximated values at XF.\n\
+      WK(IWK) On normal exit, the first 6 values of WK are\n\
+              assigned as follows:\n\
+              WK(1) = Generalized Cross Validation value\n\
+              WK(2) = Mean Squared Residual.\n\
+              WK(3) = Estimate of the number of degrees of\n\
+                      freedom of the residual sum of squares\n\
+                      per dataset, with 0.lt.WK(3).lt.N-M.\n\
+              WK(4) = Smoothing parameter p, multiplicative\n\
+                      with the splines' derivative constraint.\n\
+              WK(5) = Estimate of the true mean squared error\n\
+                      (different formula for |MD| = 3).\n\
+              WK(6) = Gauss-Markov error variance.\n\
+\n\
+              If WK(4) -->  0 , WK(3) -->  0 , and an inter-\n\
+              polating spline is fitted to the data (p --> 0).\n\
+              A very small value > 0 is used for p, in order\n\
+              to avoid division by zero in the GCV function.\n\
+\n\
+              If WK(4) --> inf, WK(3) --> N-M, and a least-\n\
+              squares polynomial of order M (degree M-1) is\n\
+              fitted to the data (p --> inf). For numerical\n\
+              reasons, a very high value is used for p.\n\
+\n\
+              Upon return, the contents of WK can be used for\n\
+              covariance propagation in terms of the matrices\n\
+              B and WE: see the source listings. The variance\n\
+              estimate for dataset J follows as WK(6)/WY(J).\n\
+\n\
+Remarks:\n\
+      (1) GCVSPL calculates a natural spline of order 2*M (degree\n\
+      2*M-1) which smoothes or interpolates a given set of data\n\
+      points, using statistical considerations to determine the\n\
+      amount of smoothing required (Craven & Wahba, 1979). If the\n\
+      error variance is a priori known, it should be supplied to\n\
+      the routine in VAL, for |MD|=3. The degree of smoothing is\n\
+      then determined to minimize an unbiased estimate of the true\n\
+      mean squared error. On the other hand, if the error variance\n\
+      is not known, one may select |MD|=2. The routine then deter-\n\
+      mines the degree of smoothing to minimize the generalized\n\
+      cross validation function. This is asymptotically the same\n\
+      as minimizing the true predicted mean squared error (Craven &\n\
+      Wahba, 1979). If the estimates from |MD|=2 or 3 do not appear\n\
+      suitable to the user (as apparent from the smoothness of the\n\
+      M-th derivative or from the effective number of degrees of\n\
+      freedom returned in WK(3) ), the user may select an other\n\
+      value for the noise variance if |MD|=3, or a reasonably large\n\
+      number of degrees of freedom if |MD|=4. If |MD|=1, the proce-\n\
+      dure is non-iterative, and returns a spline for the given\n\
+      value of the smoothing parameter p as entered in VAL.\n\
+\n\
+      (2) The number of arithmetic operations and the amount of\n\
+      storage required are both proportional to N, so very large\n\
+      datasets may be accomodated. The data points do not have\n\
+      to be equidistant in the independant variable X or uniformly\n\
+      weighted in the dependant variable Y. However, the data\n\
+      points in X must be strictly increasing. Multiple dataset\n\
+      processing (K.gt.1) is numerically more efficient dan\n\
+      separate processing of the individual datasets (K.eq.1).\n\
+\n\
+      (3) If |MD|=3 (a priori known noise variance), any value of\n\
+      N.ge.2*M is acceptable. However, it is advisable for N-2*M\n\
+      be rather large (at least 20) if |MD|=2 (GCV).\n\
+\n\
+      (4) For |MD| > 1, GCVSPL tries to iteratively minimize the\n\
+      selected criterion function. This minimum is unique for |MD|\n\
+      = 4, but not necessarily for |MD| = 2 or 3. Consequently, \n\
+      local optima rather that the global optimum might be found,\n\
+      and some actual findings suggest that local optima might\n\
+      yield more meaningful results than the global optimum if N\n\
+      is small. Therefore, the user has some control over the\n\
+      search procedure. If MD > 1, the iterative search starts\n\
+      from a value which yields a number of degrees of freedom\n\
+      which is approximately equal to N/2, until the first (local)\n\
+      minimum is found via a golden section search procedure\n\
+      (Utreras, 1980). If MD < -1, the value for p contained in\n\
+      WK(4) is used instead. Thus, if MD = 2 or 3 yield too noisy\n\
+      an estimate, the user might try |MD| = 1 or 4, for suitably\n\
+      selected values for p or for the number of degrees of\n\
+      freedom, and then run GCVSPL with MD = -2 or -3. The con-\n\
+      tents of N, M, K, X, WX, WY, and WK are assumed unchanged\n\
+      if MD < 0.\n\
+\n\
+      (5) GCVSPL calculates the spline coefficient array C(N,K);\n\
+      this array can be used to calculate the spline function\n\
+      value and any of its derivatives up to the degree 2*M-1\n\
+      at any argument T within the knot range, using subrou-\n\
+      tines SPLDER and SEARCH, and the knot array X(N). Since\n\
+      the splines are constrained at their Mth derivative, only\n\
+      the lower spline derivatives will tend to be reliable\n\
+      estimates of the underlying, true signal derivatives.\n\
+\n\
+      (6) GCVSPL combines elements of subroutine CRVO5 by Utre-\n\
+      ras (1980), subroutine SMOOTH by Lyche et al. (1983), and\n\
+      subroutine CUBGCV by Hutchinson (1985). The trace of the\n\
+      influence matrix is assessed in a similar way as described\n\
+      by Hutchinson & de Hoog (1985). The major difference is\n\
+      that the present approach utilizes non-symmetrical B-spline\n\
+      design matrices as described by Lyche et al. (1983); there-\n\
+      fore, the original algorithm by Erisman & Tinney (1975) has\n\
+      been used, rather than the symmetrical version adopted by\n\
+      Hutchinson & de Hoog.\n\
+\n\
+References:\n\
+      P. Craven & G. Wahba (1979), Smoothing noisy data with\n\
+      spline functions. Numerische Mathematik 31, 377-403.\n\
+\n\
+      A.M. Erisman & W.F. Tinney (1975), On computing certain\n\
+      elements of the inverse of a sparse matrix. Communications\n\
+      of the ACM 18(3), 177-179.\n\
+\n\
+      M.F. Hutchinson & F.R. de Hoog (1985), Smoothing noisy data\n\
+      with spline functions. Numerische Mathematik 47(1), 99-106.\n\
+\n\
+      M.F. Hutchinson (1985), Subroutine CUBGCV. CSIRO Division of\n\
+      Mathematics and Statistics, P.O. Box 1965, Canberra, ACT 2601,\n\
+      Australia.\n\
+\n\
+      T. Lyche, L.L. Schumaker, & K. Sepehrnoori (1983), Fortran\n\
+      subroutines for computing smoothing and interpolating natural\n\
+      splines. Advances in Engineering Software 5(1), 2-5.\n\
+\n\
+      F. Utreras (1980), Un paquete de programas para ajustar curvas\n\
+      mediante funciones spline. Informe Tecnico MA-80-B-209, Depar-\n\
+      tamento de Matematicas, Faculdad de Ciencias Fisicas y Matema-\n\
+      ticas, Universidad de Chile, Santiago.\n\
+\n\
+      Wahba, G. (1980). Numerical and statistical methods for mildly,\n\
+      moderately and severely ill-posed problems with noisy data.\n\
+      Technical report nr. 595 (February 1980). Department of Statis-\n\
+      tics, University of Madison (WI), U.S.A.\
+")
+{
+  octave_value_list retval;
+  DEBUG(1, ("A"));
+  int nargs = args.length();
+  ASSERT(nargs >= 2 && nargs <= 9);
+  Matrix x=args(0).matrix_value();
+  Matrix y=args(1).matrix_value();
+  Matrix x_target = nargs > 2 ? args(2).matrix_value() : x;
+  // int ny=y.rows(); --> ny=n
+  ASSERT(!error_state);
+  int n=x.rows();
+  int k=y.columns();
+  Matrix wx = (nargs > 3 && !args(3).is_zero_by_zero())
+    ? args(3).matrix_value() : Matrix(n,1,1.0);
+  Matrix wy = (nargs > 4 && !args(4).is_zero_by_zero())
+    ? args(4).matrix_value() : Matrix(1,k,1.0);
+  int m = nargs > 5 ? (int)rint(args(5).double_value()) : 2;
+  int md = nargs > 6 ? (int)rint(args(6).double_value()) : 2;
+  double val = nargs > 7 ? args(7).double_value() : 1.0;
+  Matrix mider = nargs > 8 ? args(8).matrix_value() : Matrix(1,1,0.0);
+
+  // int nc=n;
+  double c[n*k];	// Matrix c(n,k);
+  double wk[6*(n*m+1)+n];// work array, return status
+  int ier;
+
+  DEBUG(1, ("B"));
+  ASSERT(!error_state);
+  ASSERT(x.columns() == 1);
+  ASSERT(y.rows() == n);
+  ASSERT(wx.rows() == n && wx.columns() == 1);
+  ASSERT(wy.rows() == 1 && wy.columns() == k);
+  ASSERT(m > 0);
+  ASSERT(n >= 2*m);
+  ASSERT(k >= 1);
+  ASSERT(md >= 1 && md <= 4);
+  ASSERT(val >= 0);
+  ASSERT(mider.rows() == 1);
+  int nider = mider.columns();
+  int ider[nider];
+  for(int i=0; i<nider; i++) {
+    ider[i] = (int)rint(mider.xelem(0,i));
+    ASSERT(0 <= ider[i] && ider[i] <= 2*m);
+  }
+
+  DEBUG(2,
+	("gcvspl_(x,y,ny=%d,wx,wy,m=%d,n=%d,k=%d,md=%d,val=%g,c,nc=%d,wk,ier)",
+	 n, m, n, k, md, val, n));
+  double *x_fortran = x.fortran_vec();
+  gcvspl_(x_fortran, y.fortran_vec(), &n,
+	  wx.fortran_vec(), wy.fortran_vec(), &m, &n, &k,
+	  &md, &val, c, &n, wk, &ier);
+
+  if(ier != 0) {
+    (*current_liboctave_error_handler)
+      (ier==1 ? "M<=0 || N<2*M"
+       : ier==2 ? "knots not sorted or negative weight"
+       : ier==3 ? "wrong mode parameter or value"
+       : "unknown error");
+    return retval;
+  }
+
+  DEBUG(1, ("D"));
+  int l=0;	// index in x, just simplifies search
+  double q[2*m];// work array
+  int nxt=x_target.rows();
+  ASSERT(x_target.columns() == 1);
+  Matrix y_target(nxt,k*nider);
+  DEBUG(1, ("E"));
+  double *xf=x_target.fortran_vec();
+  double *yf=y_target.fortran_vec();
+  for(int i=0; i<nxt; i++) {		// next point
+    double xt=xf[i];
+    for(int j=0; j<k; j++)		// next curve
+      for(int o=0; o<nider; o++)	// next derivate
+	yf[nxt*(nider*j+o)+i] = splder_(&ider[o], &m, &n, &xt, x_fortran, c+n*j, &l, q);
+  }
+
+  DEBUG(1, ("F"));
+  DEBUG(2, ("nargout=%d", nargout));
+  retval(0) = y_target;
+  if(nargout > 1) {
+    DEBUG(1, ("G"));
+    RowVector wkv(6);
+    double *wkvf=wkv.fortran_vec();
+    for(int i=0; i<6; i++)
+      wkvf[i] = wk[i];
+    retval(1) = wkv;
+  }
+  DEBUG(1, ("H"));
+  return retval;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/nonfree/splines/gcvsplf.f	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,1443 @@
+C from: http://www.netlib.org/gcv/index.html
+C "for     B-spline data smoothing using generalized cross-validation
+C          and mean squared prediction or explicit user smoothing"
+C "by      H.J. Woltring,  University of Nijmegen,
+C          Philips Medical Systems, Eindhoven (The Netherlands)"
+C
+C***********************************************************************
+C
+C GCVSPL.FOR, 1986-05-12
+C
+C***********************************************************************
+C
+C SUBROUTINE GCVSPL (REAL*8)
+C
+C Purpose:
+C *******
+C
+C       Natural B-spline data smoothing subroutine, using the Generali-
+C       zed Cross-Validation and Mean-Squared Prediction Error Criteria
+C       of Craven & Wahba (1979). Alternatively, the amount of smoothing
+C       can be given explicitly, or it can be based on the effective
+C       number of degrees of freedom in the smoothing process as defined
+C       by Wahba (1980). The model assumes uncorrelated, additive noise
+C       and essentially smooth, underlying functions. The noise may be
+C       non-stationary, and the independent co-ordinates may be spaced
+C       non-equidistantly. Multiple datasets, with common independent
+C       variables and weight factors are accomodated.
+C
+C
+C Calling convention:
+C ******************
+C
+C       CALL GCVSPL ( X, Y, NY, WX, WY, M, N, K, MD, VAL, C, NC, WK, IER )
+C
+C Meaning of parameters:
+C *********************
+C
+C       X(N)    ( I )   Independent variables: strictly increasing knot
+C                       sequence, with X(I-1).lt.X(I), I=2,...,N.
+C       Y(NY,K) ( I )   Input data to be smoothed (or interpolated).
+C       NY      ( I )   First dimension of array Y(NY,K), with NY.ge.N.
+C       WX(N)   ( I )   Weight factor array; WX(I) corresponds with
+C                       the relative inverse variance of point Y(I,*).
+C                       If no relative weighting information is
+C                       available, the WX(I) should be set to ONE.
+C                       All WX(I).gt.ZERO, I=1,...,N.
+C       WY(K)   ( I )   Weight factor array; WY(J) corresponds with
+C                       the relative inverse variance of point Y(*,J).
+C                       If no relative weighting information is
+C                       available, the WY(J) should be set to ONE.
+C                       All WY(J).gt.ZERO, J=1,...,K.
+C                       NB: The effective weight for point Y(I,J) is
+C                       equal to WX(I)*WY(J).
+C       M       ( I )   Half order of the required B-splines (spline
+C                       degree 2*M-1), with M.gt.0. The values M =
+C                       1,2,3,4 correspond to linear, cubic, quintic,
+C                       and heptic splines, respectively.
+C       N       ( I )   Number of observations per dataset, with N.ge.2*M.
+C       K       ( I )   Number of datasets, with K.ge.1.
+C       MD      ( I )   Optimization mode switch:
+C                       |MD| = 1: Prior given value for p in VAL
+C                                 (VAL.ge.ZERO). This is the fastest
+C                                 use of GCVSPL, since no iteration
+C                                 is performed in p.
+C                       |MD| = 2: Generalized cross validation.
+C                       |MD| = 3: True predicted mean-squared error,
+C                                 with prior given variance in VAL.
+C                       |MD| = 4: Prior given number of degrees of
+C                                 freedom in VAL (ZERO.le.VAL.le.N-M).
+C                        MD  < 0: It is assumed that the contents of
+C                                 X, W, M, N, and WK have not been
+C                                 modified since the previous invoca-
+C                                 tion of GCVSPL. If MD < -1, WK(4)
+C                                 is used as an initial estimate for
+C                                 the smoothing parameter p.
+C                       Other values for |MD|, and inappropriate values
+C                       for VAL will result in an error condition, or
+C                       cause a default value for VAL to be selected.
+C                       After return from MD.ne.1, the same number of
+C                       degrees of freedom can be obtained, for identical
+C                       weight factors and knot positions, by selecting
+C                       |MD|=1, and by copying the value of p from WK(4)
+C                       into VAL. In this way, no iterative optimization
+C                       is required when processing other data in Y.
+C       VAL     ( I )   Mode value, as described above under MD.
+C       C(NC,K) ( O )   Spline coefficients, to be used in conjunction
+C                       with function SPLDER. NB: the dimensions of C
+C                       in GCVSPL and in SPLDER are different
+C                       only a single column of C(N,K) is needed, and the
+C                       proper column C(1,J), with J=1...K should be used
+C                       when calling SPLDER.
+C       NC       ( I )  First dimension of array C(NC,K), NC.ge.N.
+C       WK(IWK) (I/W/O) Work vector, with length IWK.ge.6*(N*M+1)+N.
+C                       On normal exit, the first 6 values of WK are
+C                       assigned as follows:
+C
+C                       WK(1) = Generalized Cross Validation value
+C                       WK(2) = Mean Squared Residual.
+C                       WK(3) = Estimate of the number of degrees of
+C                               freedom of the residual sum of squares
+C                               per dataset, with 0.lt.WK(3).lt.N-M.
+C                       WK(4) = Smoothing parameter p, multiplicative
+C                               with the splines' derivative constraint.
+C                       WK(5) = Estimate of the true mean squared error
+C                               (different formula for |MD| = 3).
+C                       WK(6) = Gauss-Markov error variance.
+C
+C                       If WK(4) -->  0 , WK(3) -->  0 , and an inter-
+C                       polating spline is fitted to the data (p --> 0).
+C                       A very small value > 0 is used for p, in order
+C                       to avoid division by zero in the GCV function.
+C
+C                       If WK(4) --> inf, WK(3) --> N-M, and a least-
+C                       squares polynomial of order M (degree M-1) is
+C                       fitted to the data (p --> inf). For numerical
+C                       reasons, a very high value is used for p.
+C
+C                       Upon return, the contents of WK can be used for
+C                       covariance propagation in terms of the matrices
+C                       B and WE: see the source listings. The variance
+C                       estimate for dataset J follows as WK(6)/WY(J).
+C
+C       IER     ( O )   Error parameter:
+C
+C                       IER = 0:        Normal exit
+C                       IER = 1:        M.le.0 .or. N.lt.2*M
+C                       IER = 2:        Knot sequence is not strictly
+C                                       increasing, or some weight
+C                                       factor is not positive.
+C                       IER = 3:        Wrong mode  parameter or value.
+C
+C Remarks:
+C *******
+C
+C       (1) GCVSPL calculates a natural spline of order 2*M (degree
+C       2*M-1) which smoothes or interpolates a given set of data
+C       points, using statistical considerations to determine the
+C       amount of smoothing required (Craven & Wahba, 1979). If the
+C       error variance is a priori known, it should be supplied to
+C       the routine in VAL, for |MD|=3. The degree of smoothing is
+C       then determined to minimize an unbiased estimate of the true
+C       mean squared error. On the other hand, if the error variance
+C       is not known, one may select |MD|=2. The routine then deter-
+C       mines the degree of smoothing to minimize the generalized
+C       cross validation function. This is asymptotically the same
+C       as minimizing the true predicted mean squared error (Craven &
+C       Wahba, 1979). If the estimates from |MD|=2 or 3 do not appear
+C       suitable to the user (as apparent from the smoothness of the
+C       M-th derivative or from the effective number of degrees of
+C       freedom returned in WK(3) ), the user may select an other
+C       value for the noise variance if |MD|=3, or a reasonably large
+C       number of degrees of freedom if |MD|=4. If |MD|=1, the proce-
+C       dure is non-iterative, and returns a spline for the given
+C       value of the smoothing parameter p as entered in VAL.
+C
+C       (2) The number of arithmetic operations and the amount of
+C       storage required are both proportional to N, so very large
+C       datasets may be accomodated. The data points do not have
+C       to be equidistant in the independant variable X or uniformly
+C       weighted in the dependant variable Y. However, the data
+C       points in X must be strictly increasing. Multiple dataset
+C       processing (K.gt.1) is numerically more efficient dan
+C       separate processing of the individual datasets (K.eq.1).
+C
+C       (3) If |MD|=3 (a priori known noise variance), any value of
+C       N.ge.2*M is acceptable. However, it is advisable for N-2*M
+C       be rather large (at least 20) if |MD|=2 (GCV).
+C
+C       (4) For |MD| > 1, GCVSPL tries to iteratively minimize the
+C       selected criterion function. This minimum is unique for |MD|
+C       = 4, but not necessarily for |MD| = 2 or 3. Consequently, 
+C       local optima rather that the global optimum might be found,
+C       and some actual findings suggest that local optima might
+C       yield more meaningful results than the global optimum if N
+C       is small. Therefore, the user has some control over the
+C       search procedure. If MD > 1, the iterative search starts
+C       from a value which yields a number of degrees of freedom
+C       which is approximately equal to N/2, until the first (local)
+C       minimum is found via a golden section search procedure
+C       (Utreras, 1980). If MD < -1, the value for p contained in
+C       WK(4) is used instead. Thus, if MD = 2 or 3 yield too noisy
+C       an estimate, the user might try |MD| = 1 or 4, for suitably
+C       selected values for p or for the number of degrees of
+C       freedom, and then run GCVSPL with MD = -2 or -3. The con-
+C       tents of N, M, K, X, WX, WY, and WK are assumed unchanged
+C       if MD < 0.
+C
+C       (5) GCVSPL calculates the spline coefficient array C(N,K);
+C       this array can be used to calculate the spline function
+C       value and any of its derivatives up to the degree 2*M-1
+C       at any argument T within the knot range, using subrou-
+C       tines SPLDER and SEARCH, and the knot array X(N). Since
+C       the splines are constrained at their Mth derivative, only
+C       the lower spline derivatives will tend to be reliable
+C       estimates of the underlying, true signal derivatives.
+C
+C       (6) GCVSPL combines elements of subroutine CRVO5 by Utre-
+C       ras (1980), subroutine SMOOTH by Lyche et al. (1983), and
+C       subroutine CUBGCV by Hutchinson (1985). The trace of the
+C       influence matrix is assessed in a similar way as described
+C       by Hutchinson & de Hoog (1985). The major difference is
+C       that the present approach utilizes non-symmetrical B-spline
+C       design matrices as described by Lyche et al. (1983); there-
+C       fore, the original algorithm by Erisman & Tinney (1975) has
+C       been used, rather than the symmetrical version adopted by
+C       Hutchinson & de Hoog.
+C
+C References:
+C **********
+C
+C       P. Craven & G. Wahba (1979), Smoothing noisy data with
+C       spline functions. Numerische Mathematik 31, 377-403.
+C
+C       A.M. Erisman & W.F. Tinney (1975), On computing certain
+C       elements of the inverse of a sparse matrix. Communications
+C       of the ACM 18(3), 177-179.
+C
+C       M.F. Hutchinson & F.R. de Hoog (1985), Smoothing noisy data
+C       with spline functions. Numerische Mathematik 47(1), 99-106.
+C
+C       M.F. Hutchinson (1985), Subroutine CUBGCV. CSIRO Division of
+C       Mathematics and Statistics, P.O. Box 1965, Canberra, ACT 2601,
+C       Australia.
+C
+C       T. Lyche, L.L. Schumaker, & K. Sepehrnoori (1983), Fortran
+C       subroutines for computing smoothing and interpolating natural
+C       splines. Advances in Engineering Software 5(1), 2-5.
+C
+C       F. Utreras (1980), Un paquete de programas para ajustar curvas
+C       mediante funciones spline. Informe Tecnico MA-80-B-209, Depar-
+C       tamento de Matematicas, Faculdad de Ciencias Fisicas y Matema-
+C       ticas, Universidad de Chile, Santiago.
+C
+C       Wahba, G. (1980). Numerical and statistical methods for mildly,
+C       moderately and severely ill-posed problems with noisy data.
+C       Technical report nr. 595 (February 1980). Department of Statis-
+C       tics, University of Madison (WI), U.S.A.
+C
+C Subprograms required:
+C ********************
+C
+C       BASIS, PREP, SPLC, BANDET, BANSOL, TRINV
+C
+C***********************************************************************
+C
+      SUBROUTINE GCVSPL ( X, Y, NY, WX, WY, M, N, K, MD, VAL, C, NC,
+     1                   WK, IER )
+C
+      IMPLICIT REAL*8 (A-H,O-Z)
+      PARAMETER ( RATIO=2D0, TAU=1.618033983D0, IBWE=7,
+     1           ZERO=0D0, HALF=5D-1 , ONE=1D0, TOL=1D-6,
+     2           EPS=1D-15, EPSINV=ONE/EPS )
+      DIMENSION X(N), Y(NY,K), WX(N), WY(K), C(NC,K), WK(N+6*(N*M+1))
+      SAVE M2, NM1, EL
+      DATA M2, NM1, EL / 2*0, 0D0 /
+C
+C***  Parameter check and work array initialization
+C
+      IER = 0
+C***  Check on mode parameter
+      IF ((IABS(MD).GT.4) .OR.(  MD.EQ. 0  ) .OR.
+     1  ((IABS(MD).EQ.1).AND.( VAL.LT.ZERO)).OR.
+     2  ((IABS(MD).EQ.3).AND.( VAL.LT.ZERO)).OR.
+     3  ((IABS(MD).EQ.4).AND.((VAL.LT.ZERO) .OR.(VAL.GT.N-M)))) THEN
+         IER = 3      
+         RETURN
+      ENDIF
+C***  Check on M and N
+      IF (MD.GT.0) THEN
+         M2  = 2 * M
+         NM1 = N - 1
+      ELSE
+         IF ((M2.NE.2*M).OR.(NM1.NE.N-1)) THEN
+            IER = 3      
+            RETURN
+         ENDIF
+      ENDIF
+      IF ((M.LE.0).OR.(N.LT.M2)) THEN
+         IER = 1      
+         RETURN
+      ENDIF
+C***  Check on knot sequence and weights
+      IF (WX(1).LE.ZERO) IER = 2
+      DO 10 I=2,N
+         IF ((WX(I).LE.ZERO).OR.(X(I-1).GE.X(I))) IER = 2
+         IF (IER.NE.0) RETURN
+   10 CONTINUE
+      DO 15 J=1,K
+         IF (WY(J).LE.ZERO) IER = 2
+         IF (IER.NE.0) RETURN
+   15 CONTINUE
+C
+C***  Work array parameters (address information for covariance 
+C***  propagation by means of the matrices STAT, B, and WE). NB:
+C***  BWE cannot be used since it is modified by function TRINV.
+C
+      NM2P1 = N*(M2+1)
+      NM2M1 = N*(M2-1)
+C     ISTAT = 1            
+C     IBWE  = ISTAT + 6      
+      IB    = IBWE  + NM2P1      
+      IWE   = IB    + NM2M1      
+C     IWK   = IWE   + NM2P1      
+C
+C***  Compute the design matrices B and WE, the ratio
+C***  of their L1-norms, and check for iterative mode.
+C
+      IF (MD.GT.0) THEN
+         CALL BASIS ( M, N, X, WK(IB), R1, WK(IBWE) )
+         CALL PREP  ( M, N, X, WX, WK(IWE), EL )
+         EL = EL / R1      
+      ENDIF
+      IF (IABS(MD).NE.1) GO TO 20
+C***     Prior given value for p
+         R1 = VAL
+         GO TO 100
+C
+C***  Iterate to minimize the GCV function (|MD|=2),
+C***  the MSE function (|MD|=3), or to obtain the prior
+C***  given number of degrees of freedom (|MD|=4).
+C
+   20 IF (MD.LT.-1) THEN
+         R1 = WK(4)      
+      ELSE
+         R1 = ONE / EL      
+      ENDIF      
+      R2 = R1 * RATIO
+      GF2 = SPLC(M,N,K,Y,NY,WX,WY,MD,VAL,R2,EPS,C,NC,
+     1          WK,WK(IB),WK(IWE),EL,WK(IBWE))
+   40 GF1 = SPLC(M,N,K,Y,NY,WX,WY,MD,VAL,R1,EPS,C,NC,
+     1          WK,WK(IB),WK(IWE),EL,WK(IBWE))
+      IF (GF1.GT.GF2) GO TO 50
+         IF (WK(4).LE.ZERO) GO TO 100            
+         R2  = R1
+         GF2 = GF1
+         R1  = R1 / RATIO
+         GO TO 40
+   50 R3 = R2 * RATIO
+   60 GF3 = SPLC(M,N,K,Y,NY,WX,WY,MD,VAL,R3,EPS,C,NC,
+     1          WK,WK(IB),WK(IWE),EL,WK(IBWE))
+      IF (GF3.GT.GF2) GO TO 70
+         IF (WK(4).GE.EPSINV) GO TO 100      
+         R2  = R3      
+         GF2 = GF3
+         R3  = R3 * RATIO
+         GO TO 60
+   70 R2  = R3
+      GF2 = GF3
+      ALPHA = (R2-R1) / TAU
+      R4 = R1 + ALPHA
+      R3 = R2 - ALPHA
+      GF3 = SPLC(M,N,K,Y,NY,WX,WY,MD,VAL,R3,EPS,C,NC,
+     1          WK,WK(IB),WK(IWE),EL,WK(IBWE))
+      GF4 = SPLC(M,N,K,Y,NY,WX,WY,MD,VAL,R4,EPS,C,NC,
+     1          WK,WK(IB),WK(IWE),EL,WK(IBWE))
+   80 IF (GF3.LE.GF4) THEN
+         R2  = R4
+         GF2 = GF4
+         ERR = (R2-R1) / (R1+R2)
+         IF ((ERR*ERR+ONE.EQ.ONE).OR.(ERR.LE.TOL)) GO TO 90
+         R4  = R3
+         GF4 = GF3
+         ALPHA = ALPHA / TAU
+         R3  = R2 - ALPHA
+         GF3 = SPLC(M,N,K,Y,NY,WX,WY,MD,VAL,R3,EPS,C,NC,
+     1             WK,WK(IB),WK(IWE),EL,WK(IBWE))
+      ELSE
+         R1  = R3
+         GF1 = GF3
+         ERR = (R2-R1) / (R1+R2)
+         IF ((ERR*ERR+ONE.EQ.ONE).OR.(ERR.LE.TOL)) GO TO 90
+         R3  = R4
+         GF3 = GF4
+         ALPHA = ALPHA / TAU
+         R4 = R1 + ALPHA
+         GF4 = SPLC(M,N,K,Y,NY,WX,WY,MD,VAL,R4,EPS,C,NC,
+     1             WK,WK(IB),WK(IWE),EL,WK(IBWE))
+      ENDIF
+      GO TO 80
+   90 R1 = HALF * (R1+R2)
+C
+C***  Calculate final spline coefficients
+C
+  100 GF1 = SPLC(M,N,K,Y,NY,WX,WY,MD,VAL,R1,EPS,C,NC,
+     1          WK,WK(IB),WK(IWE),EL,WK(IBWE))
+C
+C***  Ready
+C
+      RETURN
+      END
+C BASIS.FOR, 1985-06-03
+C
+C***********************************************************************
+C
+C SUBROUTINE BASIS (REAL*8)
+C
+C Purpose:
+C *******
+C
+C       Subroutine to assess a B-spline tableau, stored in vectorized
+C       form.
+C
+C Calling convention:
+C ******************
+C
+C       CALL BASIS ( M, N, X, B, BL, Q )
+C
+C Meaning of parameters:
+C *********************
+C
+C       M               ( I )   Half order of the spline (degree 2*M-1),
+C                               M > 0.
+C       N               ( I )   Number of knots, N >= 2*M.
+C       X(N)            ( I )   Knot sequence, X(I-1) < X(I), I=2,N.
+C       B(1-M:M-1,N)    ( O )   Output tableau. Element B(J,I) of array
+C                               B corresponds with element b(i,i+j) of
+C                               the tableau matrix B.
+C       BL              ( O )   L1-norm of B.
+C       Q(1-M:M)        ( W )   Internal work array.
+C
+C Remark:
+C ******
+C
+C       This subroutine is an adaptation of subroutine BASIS from the
+C       paper by Lyche et al. (1983). No checking is performed on the
+C       validity of M and N. If the knot sequence is not strictly in-
+C       creasing, division by zero may occur.
+C
+C Reference:
+C *********
+C
+C       T. Lyche, L.L. Schumaker, & K. Sepehrnoori, Fortran subroutines
+C       for computing smoothing and interpolating natural splines.
+C       Advances in Engineering Software 5(1983)1, pp. 2-5.
+C
+C***********************************************************************
+C
+      SUBROUTINE BASIS ( M, N, X, B, BL, Q )
+C
+      IMPLICIT REAL*8 (A-H,O-Z)
+      PARAMETER ( ZERO=0D0, ONE=1D0 )
+      DIMENSION X(N), B(1-M:M-1,N), Q(1-M:M)
+C
+      IF (M.EQ.1) THEN
+C***         Linear spline
+         DO 3 I=1,N
+            B(0,I) = ONE
+    3    CONTINUE
+         BL = ONE
+         RETURN
+      ENDIF
+C
+C***  General splines
+C
+      MM1 = M - 1
+      MP1 = M + 1
+      M2  = 2 * M
+      DO 15 L=1,N
+C***     1st row
+         DO 5 J=-MM1,M
+            Q(J) = ZERO
+    5    CONTINUE
+         Q(MM1) = ONE
+         IF ((L.NE.1).AND.(L.NE.N))
+     1      Q(MM1) = ONE / ( X(L+1) - X(L-1) )
+C***     Successive rows
+         ARG = X(L)
+         DO 13 I=3,M2
+            IR = MP1 - I
+            V  = Q(IR)
+            IF (L.LT.I) THEN
+C***               Left-hand B-splines
+               DO 6 J=L+1,I
+                  U     = V
+                  V     = Q(IR+1)
+                  Q(IR) = U + (X(J)-ARG)*V
+                  IR    = IR + 1
+    6          CONTINUE
+            ENDIF
+            J1 = MAX0(L-I+1,1)
+            J2 = MIN0(L-1,N-I)
+            IF (J1.LE.J2) THEN
+C***               Ordinary B-splines
+               IF (I.LT.M2) THEN
+                  DO 8 J=J1,J2
+                     Y     = X(I+J)
+                     U     = V
+                     V     = Q(IR+1)
+                     Q(IR) = U + (V-U)*(Y-ARG)/(Y-X(J))
+                     IR = IR + 1
+    8             CONTINUE
+               ELSE
+                  DO 10 J=J1,J2
+                     U     = V
+                     V     = Q(IR+1)
+                     Q(IR) = (ARG-X(J))*U + (X(I+J)-ARG)*V
+                     IR    = IR + 1
+   10             CONTINUE
+               ENDIF
+            ENDIF
+            NMIP1 = N - I + 1
+            IF (NMIP1.LT.L) THEN
+C***           Right-hand B-splines
+               DO 12 J=NMIP1,L-1
+                  U     = V
+                  V     = Q(IR+1)
+                  Q(IR) = (ARG-X(J))*U + V
+                  IR    = IR + 1
+   12          CONTINUE
+            ENDIF
+   13    CONTINUE
+         DO 14 J=-MM1,MM1
+            B(J,L) = Q(J)
+   14    CONTINUE
+   15 CONTINUE
+C
+C***  Zero unused parts of B
+C
+      DO 17 I=1,MM1
+         DO 16 K=I,MM1
+            B(-K,    I) = ZERO
+            B( K,N+1-I) = ZERO
+   16    CONTINUE
+   17 CONTINUE
+C
+C***  Assess L1-norm of B
+C
+      BL = 0D0
+      DO 19 I=1,N
+         DO 18 K=-MM1,MM1
+            BL = BL + ABS(B(K,I))
+   18    CONTINUE
+   19 CONTINUE
+      BL = BL / N
+C
+C***  Ready
+C
+      RETURN
+      END
+C PREP.FOR, 1985-07-04
+C
+C***********************************************************************
+C
+C SUBROUTINE PREP (REAL*8)
+C
+C Purpose:
+C *******
+C
+C       To compute the matrix WE of weighted divided difference coeffi-
+C       cients needed to set up a linear system of equations for sol-
+C       ving B-spline smoothing problems, and its L1-norm EL. The matrix
+C       WE is stored in vectorized form.
+C
+C Calling convention:
+C ******************
+C
+C       CALL PREP ( M, N, X, W, WE, EL )
+C
+C Meaning of parameters:
+C *********************
+C
+C       M               ( I )   Half order of the B-spline (degree
+C                               2*M-1), with M > 0.
+C       N               ( I )   Number of knots, with N >= 2*M.
+C       X(N)            ( I )   Strictly increasing knot array, with
+C                               X(I-1) < X(I), I=2,N.
+C       W(N)            ( I )   Weight matrix (diagonal), with
+C                               W(I).gt.0.0, I=1,N.
+C       WE(-M:M,N)      ( O )   Array containing the weighted divided
+C                               difference terms in vectorized format.
+C                               Element WE(J,I) of array E corresponds
+C                               with element e(i,i+j) of the matrix
+C                               W**-1 * E.
+C       EL              ( O )   L1-norm of WE.
+C
+C Remark:
+C ******
+C
+C       This subroutine is an adaptation of subroutine PREP from the paper
+C       by Lyche et al. (1983). No checking is performed on the validity
+C       of M and N. Division by zero may occur if the knot sequence is
+C       not strictly increasing.
+C
+C Reference:
+C *********
+C
+C       T. Lyche, L.L. Schumaker, & K. Sepehrnoori, Fortran subroutines
+C       for computing smoothing and interpolating natural splines.
+C       Advances in Engineering Software 5(1983)1, pp. 2-5.
+C
+C***********************************************************************
+C
+      SUBROUTINE PREP ( M, N, X, W, WE, EL )
+C
+      IMPLICIT REAL*8 (A-H,O-Z)
+      PARAMETER ( ZERO=0D0, ONE=1D0 )
+      DIMENSION X(N), W(N), WE((2*M+1)*N)      
+C
+C***  Calculate the factor F1
+C
+      M2   = 2 * M
+      MP1  = M + 1
+      M2M1 = M2 - 1
+      M2P1 = M2 + 1
+      NM   = N - M
+      F1   = -ONE
+      IF (M.NE.1) THEN
+         DO 5 I=2,M
+            F1 = -F1 * I
+    5    CONTINUE
+         DO 6 I=MP1,M2M1
+            F1 = F1 * I
+    6    CONTINUE
+      END IF
+C
+C***  Columnwise evaluation of the unweighted design matrix E
+C
+      I1 = 1
+      I2 = M
+      JM = MP1
+      DO 17 J=1,N
+         INC = M2P1
+         IF (J.GT.NM) THEN
+            F1 = -F1
+            F  =  F1
+         ELSE
+            IF (J.LT.MP1) THEN
+                INC = 1
+                F   = F1
+            ELSE
+                F   = F1 * (X(J+M)-X(J-M))
+            END IF
+         END IF
+         IF ( J.GT.MP1) I1 = I1 + 1
+         IF (I2.LT.  N) I2 = I2 + 1
+         JJ = JM
+C***     Loop for divided difference coefficients
+         FF = F
+         Y = X(I1)
+         I1P1 = I1 + 1
+         DO 11 I=I1P1,I2
+            FF = FF / (Y-X(I))
+   11    CONTINUE
+         WE(JJ) = FF
+         JJ = JJ + M2
+         I2M1 = I2 - 1
+         IF (I1P1.LE.I2M1) THEN
+            DO 14 L=I1P1,I2M1
+               FF = F
+               Y  = X(L)
+               DO 12 I=I1,L-1
+                  FF = FF / (Y-X(I))
+   12          CONTINUE
+               DO 13 I=L+1,I2
+                  FF = FF / (Y-X(I))
+   13          CONTINUE
+               WE(JJ) = FF
+               JJ = JJ + M2
+   14       CONTINUE
+         END IF
+         FF = F
+         Y = X(I2)
+         DO 16 I=I1,I2M1
+            FF = FF / (Y-X(I))
+   16    CONTINUE
+         WE(JJ) = FF
+         JJ = JJ + M2
+         JM = JM + INC
+   17 CONTINUE
+C
+C***  Zero the upper left and lower right corners of E
+C
+      KL = 1
+      N2M = M2P1*N + 1
+      DO 19 I=1,M
+         KU = KL + M - I
+         DO 18 K=KL,KU
+            WE(    K) = ZERO
+            WE(N2M-K) = ZERO
+   18    CONTINUE
+         KL = KL + M2P1
+   19 CONTINUE
+C
+C***  Weighted matrix WE = W**-1 * E and its L1-norm
+C
+   20 JJ = 0
+      EL = 0D0
+      DO 22 I=1,N
+         WI = W(I)
+         DO 21 J=1,M2P1
+            JJ     = JJ + 1
+            WE(JJ) = WE(JJ) / WI
+            EL     = EL + ABS(WE(JJ))
+   21    CONTINUE
+   22 CONTINUE
+      EL = EL / N
+C
+C***  Ready
+C
+      RETURN
+      END
+C SPLC.FOR, 1985-12-12
+C
+C Author: H.J. Woltring
+C
+C Organizations: University of Nijmegen, and
+C                Philips Medical Systems, Eindhoven
+C                (The Netherlands)
+C
+C***********************************************************************
+C
+C FUNCTION SPLC (REAL*8)
+C
+C Purpose:
+C *******
+C
+C       To assess the coefficients of a B-spline and various statistical
+C       parameters, for a given value of the regularization parameter p.
+C
+C Calling convention:
+C ******************
+C
+C       FV = SPLC ( M, N, K, Y, NY, WX, WY, MODE, VAL, P, EPS, C, NC,
+C       1           STAT, B, WE, EL, BWE)
+C
+C Meaning of parameters:
+C *********************
+C
+C       SPLC            ( O )   GCV function value if |MODE|.eq.2,
+C                               MSE value if |MODE|.eq.3, and absolute
+C                               difference with the prior given number of
+C                               degrees of freedom if |MODE|.eq.4.
+C       M               ( I )   Half order of the B-spline (degree 2*M-1),
+C                               with M > 0.
+C       N               ( I )   Number of observations, with N >= 2*M.
+C       K               ( I )   Number of datasets, with K >= 1.
+C       Y(NY,K)         ( I )   Observed measurements.
+C       NY              ( I )   First dimension of Y(NY,K), with NY.ge.N.
+C       WX(N)           ( I )   Weight factors, corresponding to the
+C                               relative inverse variance of each measure-
+C                               ment, with WX(I) > 0.0.
+C       WY(K)           ( I )   Weight factors, corresponding to the
+C                               relative inverse variance of each dataset,
+C                               with WY(J) > 0.0.
+C       MODE            ( I )   Mode switch, as described in GCVSPL.
+C       VAL             ( I )   Prior variance if |MODE|.eq.3, and
+C                               prior number of degrees of freedom if
+C                               |MODE|.eq.4. For other values of MODE,
+C                               VAL is not used.
+C       P               ( I )   Smoothing parameter, with P >= 0.0. If
+C                               P.eq.0.0, an interpolating spline is
+C                               calculated.
+C       EPS             ( I )   Relative rounding tolerance*10.0. EPS is
+C                               the smallest positive number such that
+C                               EPS/10.0 + 1.0 .ne. 1.0.
+C       C(NC,K)         ( O )   Calculated spline coefficient arrays. NB:
+C                               the dimensions of in GCVSPL and in SPLDER
+C                               are different
+C                               column of C(N,K) is needed, and the proper
+C                               column C(1,J), with J=1...K, should be used
+C                               when calling SPLDER.
+C       NC              ( I )   First dimension of C(NC,K), with NC.ge.N.
+C       STAT(6)         ( O )   Statistics array. See the description in
+C                               subroutine GCVSPL.
+C       B (1-M:M-1,N)   ( I )   B-spline tableau as evaluated by subroutine
+C                               BASIS.
+C       WE( -M:M  ,N)   ( I )   Weighted B-spline tableau (W**-1 * E) as
+C                               evaluated by subroutine PREP.
+C       EL              ( I )   L1-norm of the matrix WE as evaluated by
+C                               subroutine PREP.
+C       BWE(-M:M,N)     ( O )   Central 2*M+1 bands of the inverted
+C                               matrix ( B  +  p * W**-1 * E )**-1
+C
+C Remarks:
+C *******
+C
+C       This subroutine combines elements of subroutine SPLC0 from the
+C       paper by Lyche et al. (1983), and of subroutine SPFIT1 by
+C       Hutchinson (1985).
+C
+C References:
+C **********
+C
+C       M.F. Hutchinson (1985), Subroutine CUBGCV. CSIRO division of
+C       Mathematics and Statistics, P.O. Box 1965, Canberra, ACT 2601,
+C       Australia.
+C
+C       T. Lyche, L.L. Schumaker, & K. Sepehrnoori, Fortran subroutines
+C       for computing smoothing and interpolating natural splines.
+C       Advances in Engineering Software 5(1983)1, pp. 2-5.
+C
+C***********************************************************************
+C
+      FUNCTION SPLC( M, N, K, Y, NY, WX, WY, MODE, VAL, P, EPS, C, NC,
+     1              STAT, B, WE, EL, BWE)
+C
+      IMPLICIT REAL*8 (A-H,O-Z)
+      PARAMETER ( ZERO=0D0, ONE=1D0, TWO=2D0 )
+      DIMENSION Y(NY,K), WX(N), WY(K), C(NC,K), STAT(6),
+     1         B(1-M:M-1,N), WE(-M:M,N), BWE(-M:M,N)
+C
+C***  Check on p-value
+C
+      DP = P
+      STAT(4) = P
+      PEL = P * EL
+C***  Pseudo-interpolation if p is too small
+      IF (PEL.LT.EPS) THEN
+         DP = EPS / EL
+         STAT(4) = ZERO
+      ENDIF
+C***  Pseudo least-squares polynomial if p is too large
+      IF (PEL*EPS.GT.ONE) THEN
+         DP = ONE / (EL*EPS)
+         STAT(4) = DP
+      ENDIF
+C
+C***  Calculate  BWE  =  B  +  p * W**-1 * E
+C
+      DO 40 I=1,N
+         KM = -MIN0(M,I-1)
+         KP =  MIN0(M,N-I)
+         DO 30 L=KM,KP
+            IF (IABS(L).EQ.M) THEN
+               BWE(L,I) =          DP * WE(L,I)
+            ELSE
+               BWE(L,I) = B(L,I) + DP * WE(L,I)
+            ENDIF
+   30    CONTINUE
+   40 CONTINUE
+C
+C***  Solve BWE * C = Y, and assess TRACE [ B * BWE**-1 ]
+C
+      CALL BANDET ( BWE, M, N )
+      CALL BANSOL ( BWE, Y, NY, C, NC, M, N, K )
+      STAT(3) = TRINV ( WE, BWE, M, N ) * DP      
+      TRN = STAT(3) / N
+C
+C***  Compute mean-squared weighted residual
+C
+      ESN = ZERO
+      DO 70 J=1,K
+         DO 60 I=1,N
+            DT = -Y(I,J)
+            KM = -MIN0(M-1,I-1)
+            KP =  MIN0(M-1,N-I)
+            DO 50 L=KM,KP
+               DT = DT + B(L,I)*C(I+L,J)
+   50       CONTINUE
+            ESN = ESN + DT*DT*WX(I)*WY(J)
+   60    CONTINUE
+   70 CONTINUE
+      ESN = ESN / (N*K)
+C
+C***  Calculate statistics and function value
+C
+      STAT(6) = ESN / TRN             
+      STAT(1) = STAT(6) / TRN         
+      STAT(2) = ESN                   
+C     STAT(3) = trace [p*B * BWE**-1] 
+C     STAT(4) = P                     
+      IF (IABS(MODE).NE.3) THEN
+C***     Unknown variance: GCV
+         STAT(5) = STAT(6) - ESN
+         IF (IABS(MODE).EQ.1) SPLC = ZERO
+         IF (IABS(MODE).EQ.2) SPLC = STAT(1)
+         IF (IABS(MODE).EQ.4) SPLC = DABS( STAT(3) - VAL )
+      ELSE
+C***     Known variance: estimated mean squared error
+         STAT(5) = ESN - VAL*(TWO*TRN - ONE)
+         SPLC = STAT(5)
+      ENDIF
+C
+      RETURN
+      END
+C BANDET.FOR, 1985-06-03
+C
+C***********************************************************************
+C
+C SUBROUTINE BANDET (REAL*8)
+C
+C Purpose:
+C *******
+C
+C       This subroutine computes the LU decomposition of an N*N matrix
+C       E. It is assumed that E has M bands above and M bands below the
+C       diagonal. The decomposition is returned in E. It is assumed that
+C       E can be decomposed without pivoting. The matrix E is stored in
+C       vectorized form in the array E(-M:M,N), where element E(J,I) of
+C       the array E corresponds with element e(i,i+j) of the matrix E.
+C
+C Calling convention:
+C ******************
+C
+C       CALL BANDET ( E, M, N )
+C
+C Meaning of parameters:
+C *********************
+C
+C       E(-M:M,N)       (I/O)   Matrix to be decomposed.
+C       M, N            ( I )   Matrix dimensioning parameters,
+C                               M >= 0, N >= 2*M.
+C
+C Remark:
+C ******
+C
+C       No checking on the validity of the input data is performed.
+C       If (M.le.0), no action is taken.
+C
+C***********************************************************************
+C
+      SUBROUTINE BANDET ( E, M, N )
+C
+      IMPLICIT REAL*8 (A-H,O-Z)
+      DIMENSION E(-M:M,N)
+C
+      IF (M.LE.0) RETURN
+      DO 40 I=1,N
+         DI = E(0,I)
+         MI = MIN0(M,I-1)
+         IF (MI.GE.1) THEN
+            DO 10 K=1,MI
+               DI = DI - E(-K,I)*E(K,I-K)
+   10       CONTINUE
+            E(0,I) = DI
+         ENDIF
+         LM = MIN0(M,N-I)
+         IF (LM.GE.1) THEN
+            DO 30 L=1,LM
+               DL = E(-L,I+L)
+               KM = MIN0(M-L,I-1)
+               IF (KM.GE.1) THEN
+                  DU = E(L,I)
+                  DO 20 K=1,KM
+                     DU = DU - E(  -K,  I)*E(L+K,I-K)
+                     DL = DL - E(-L-K,L+I)*E(  K,I-K)
+   20             CONTINUE
+                  E(L,I) = DU
+               ENDIF
+               E(-L,I+L) = DL / DI
+   30       CONTINUE
+         ENDIF
+   40 CONTINUE
+C
+C***  Ready
+C
+      RETURN
+      END
+C BANSOL.FOR, 1985-12-12
+C
+C***********************************************************************
+C
+C SUBROUTINE BANSOL (REAL*8)
+C
+C Purpose:
+C *******
+C
+C       This subroutine solves systems of linear equations given an LU
+C       decomposition of the design matrix. Such a decomposition is pro-
+C       vided by subroutine BANDET, in vectorized form. It is assumed
+C       that the design matrix is not singular. 
+C
+C Calling convention:
+C ******************
+C
+C       CALL BANSOL ( E, Y, NY, C, NC, M, N, K )
+C
+C Meaning of parameters:
+C *********************
+C
+C       E(-M:M,N)       ( I )   Input design matrix, in LU-decomposed,
+C                               vectorized form. Element E(J,I) of the
+C                               array E corresponds with element
+C                               e(i,i+j) of the N*N design matrix E.
+C       Y(NY,K)         ( I )   Right hand side vectors.
+C       C(NC,K)         ( O )   Solution vectors.
+C       NY, NC, M, N, K ( I )   Dimensioning parameters, with M >= 0,
+C                               N > 2*M, and K >= 1.
+C
+C Remark:
+C ******
+C
+C       This subroutine is an adaptation of subroutine BANSOL from the
+C       paper by Lyche et al. (1983). No checking is performed on the
+C       validity of the input parameters and data. Division by zero may
+C       occur if the system is singular.
+C
+C Reference:
+C *********
+C
+C       T. Lyche, L.L. Schumaker, & K. Sepehrnoori, Fortran subroutines
+C       for computing smoothing and interpolating natural splines.
+C       Advances in Engineering Software 5(1983)1, pp. 2-5.
+C
+C***********************************************************************
+C
+      SUBROUTINE BANSOL ( E, Y, NY, C, NC, M, N, K )
+C
+      IMPLICIT REAL*8 (A-H,O-Z)
+      DIMENSION E(-M:M,N), Y(NY,K), C(NC,K)
+C
+C***  Check on special cases: M=0, M=1, M>1
+C
+      NM1 = N - 1
+      IF (M-1) 10,40,80
+C
+C***  M = 0: Diagonal system
+C
+   10 DO 30 I=1,N
+         DO 20 J=1,K
+            C(I,J) = Y(I,J) / E(0,I)
+   20    CONTINUE
+   30 CONTINUE
+      RETURN
+C
+C***  M = 1: Tridiagonal system
+C
+   40 DO 70 J=1,K
+         C(1,J) = Y(1,J)
+         DO 50 I=2,N            
+            C(I,J) =  Y(I,J) - E(-1,I)*C(I-1,J)
+   50      CONTINUE
+         C(N,J) = C(N,J) / E(0,N)
+         DO 60 I=NM1,1,-1      
+            C(I,J) = (C(I,J) - E( 1,I)*C(I+1,J)) / E(0,I)
+   60    CONTINUE
+   70 CONTINUE
+      RETURN
+C
+C***  M > 1: General system
+C
+   80 DO 130 J=1,K
+         C(1,J) = Y(1,J)
+         DO 100 I=2,N            
+            MI = MIN0(M,I-1)
+            D  = Y(I,J)
+            DO 90 L=1,MI
+               D = D - E(-L,I)*C(I-L,J)
+   90       CONTINUE
+            C(I,J) = D
+  100    CONTINUE
+         C(N,J) = C(N,J) / E(0,N)
+         DO 120 I=NM1,1,-1      
+            MI = MIN0(M,N-I)
+            D  = C(I,J)
+            DO 110 L=1,MI
+               D = D - E( L,I)*C(I+L,J)
+  110       CONTINUE
+            C(I,J) = D / E(0,I)
+  120    CONTINUE
+  130 CONTINUE
+      RETURN
+C
+      END
+C TRINV.FOR, 1985-06-03
+C
+C***********************************************************************
+C
+C FUNCTION TRINV (REAL*8)
+C
+C Purpose:
+C *******
+C
+C       To calculate TRACE [ B * E**-1 ], where B and E are N * N
+C       matrices with bandwidth 2*M+1, and where E is a regular matrix
+C       in LU-decomposed form. B and E are stored in vectorized form,
+C       compatible with subroutines BANDET and BANSOL.
+C
+C Calling convention:
+C ******************
+C
+C       TRACE = TRINV ( B, E, M, N )
+C
+C Meaning of parameters:
+C *********************
+C
+C       B(-M:M,N)       ( I ) Input array for matrix B. Element B(J,I)
+C                             corresponds with element b(i,i+j) of the
+C                             matrix B.
+C       E(-M:M,N)       (I/O) Input array for matrix E. Element E(J,I)
+C                             corresponds with element e(i,i+j) of the
+C                             matrix E. This matrix is stored in LU-
+C                             decomposed form, with L unit lower tri-
+C                             angular, and U upper triangular. The unit
+C                             diagonal of L is not stored. Upon return,
+C                             the array E holds the central 2*M+1 bands
+C                             of the inverse E**-1, in similar ordering.
+C       M, N            ( I ) Array and matrix dimensioning parameters
+C                             (M.gt.0, N.ge.2*M+1).
+C       TRINV           ( O ) Output function value TRACE [ B * E**-1 ]
+C
+C Reference:
+C *********
+C
+C       A.M. Erisman & W.F. Tinney, On computing certain elements of the
+C       inverse of a sparse matrix. Communications of the ACM 18(1975),
+C       nr. 3, pp. 177-179.
+C
+C***********************************************************************
+C
+      REAL*8 FUNCTION TRINV ( B, E, M, N )
+C
+      IMPLICIT REAL*8 (A-H,O-Z)
+      PARAMETER ( ZERO=0D0, ONE=1D0 )
+      DIMENSION B(-M:M,N), E(-M:M,N)
+C
+C***  Assess central 2*M+1 bands of E**-1 and store in array E
+C
+      E(0,N) = ONE / E(0,N)      
+      DO 40 I=N-1,1,-1
+         MI = MIN0(M,N-I)
+         DD  = ONE / E(0,I)      
+C***     Save Ith column of L and Ith row of U, and normalize U row
+         DO 10 K=1,MI
+            E( K,N) = E( K,  I) * DD      
+            E(-K,1) = E(-K,K+I)      
+   10    CONTINUE
+         DD = DD + DD
+C***     Invert around Ith pivot
+         DO 30 J=MI,1,-1
+            DU = ZERO
+            DL = ZERO
+            DO 20 K=1,MI
+               DU = DU - E( K,N)*E(J-K,I+K)
+               DL = DL - E(-K,1)*E(K-J,I+J)
+   20       CONTINUE
+            E( J,  I) = DU
+            E(-J,J+I) = DL
+            DD = DD - (E(J,N)*DL + E(-J,1)*DU)
+   30    CONTINUE
+         E(0,I) = 5D-1 * DD
+   40 CONTINUE
+C
+C***  Assess TRACE [ B * E**-1 ] and clear working storage
+C
+      DD = ZERO
+      DO 60 I=1,N
+         MN = -MIN0(M,I-1)
+         MP =  MIN0(M,N-I)
+         DO 50 K=MN,MP
+            DD = DD + B(K,I)*E(-K,K+I)
+   50    CONTINUE
+   60 CONTINUE
+      TRINV = DD
+      DO 70 K=1,M
+         E( K,N) = ZERO
+         E(-K,1) = ZERO
+   70 CONTINUE
+C
+C***  Ready
+C
+      RETURN
+      END
+C SPLDER.FOR, 1985-06-11
+C
+C***********************************************************************
+C
+C FUNCTION SPLDER (REAL*8)
+C
+C Purpose:
+C *******
+C
+C       To produce the value of the function (IDER.eq.0) or of the
+C       IDERth derivative (IDER.gt.0) of a 2M-th order B-spline at
+C       the point T. The spline is described in terms of the half
+C       order M, the knot sequence X(N), N.ge.2*M, and the spline
+C       coefficients C(N).
+C
+C Calling convention:
+C ******************
+C
+C       SVIDER = SPLDER ( IDER, M, N, T, X, C, L, Q )
+C
+C Meaning of parameters:
+C *********************
+C
+C       SPLDER  ( O )   Function or derivative value.
+C       IDER    ( I )   Derivative order required, with 0.le.IDER
+C                       and IDER.le.2*M. If IDER.eq.0, the function
+C                       value is returned; otherwise, the IDER-th
+C                       derivative of the spline is returned.
+C       M       ( I )   Half order of the spline, with M.gt.0.
+C       N       ( I )   Number of knots and spline coefficients,
+C                       with N.ge.2*M.
+C       T       ( I )   Argument at which the spline or its deri-
+C                       vative is to be evaluated, with X(1).le.T
+C                       and T.le.X(N).
+C       X(N)    ( I )   Strictly increasing knot sequence array,
+C                       X(I-1).lt.X(I), I=2,...,N.
+C       C(N)    ( I )   Spline coefficients, as evaluated by
+C                       subroutine GVCSPL.
+C       L       (I/O)   L contains an integer such that:
+C                       X(L).le.T and T.lt.X(L+1) if T is within
+C                       the range X(1).le.T and T.lt.X(N). If
+C                       T.lt.X(1), L is set to 0, and if T.ge.X(N),
+C                       L is set to N. The search for L is facili-
+C                       tated if L has approximately the right
+C                       value on entry.
+C       Q(2*M)  ( W )   Internal work array.
+C
+C Remark:
+C ******
+C
+C       This subroutine is an adaptation of subroutine SPLDER of
+C       the paper by Lyche et al. (1983). No checking is performed
+C       on the validity of the input parameters.
+C
+C Reference:
+C *********
+C
+C       T. Lyche, L.L. Schumaker, & K. Sepehrnoori, Fortran subroutines
+C       for computing smoothing and interpolating natural splines.
+C       Advances in Engineering Software 5(1983)1, pp. 2-5.
+C
+C***********************************************************************
+C
+      REAL*8 FUNCTION SPLDER ( IDER, M, N, T, X, C, L, Q )
+C
+      IMPLICIT REAL*8 (A-H,O-Z)
+      PARAMETER ( ZERO=0D0, ONE=1D0 )
+      DIMENSION X(N), C(N), Q(2*M)
+C
+C***  Derivatives of IDER.ge.2*M are alway zero
+C
+      M2 =  2 * M
+      K  = M2 - IDER
+      IF (K.LT.1) THEN
+         SPLDER = ZERO
+         RETURN
+      ENDIF
+C
+C***  Search for the interval value L
+C
+      CALL SEARCH ( N, X, T, L )
+C
+C***  Initialize parameters and the 1st row of the B-spline
+C***  coefficients tableau
+C
+      TT   = T
+      MP1  =  M + 1
+      NPM  =  N + M
+      M2M1 = M2 - 1
+      K1   =  K - 1
+      NK   =  N - K
+      LK   =  L - K
+      LK1  = LK + 1
+      LM   =  L - M
+      JL   =  L + 1
+      JU   =  L + M2
+      II   =  N - M2
+      ML   = -L
+      DO 2 J=JL,JU
+         IF ((J.GE.MP1).AND.(J.LE.NPM)) THEN
+            Q(J+ML) = C(J-M)
+         ELSE
+            Q(J+ML) = ZERO
+         ENDIF
+    2 CONTINUE
+C
+C***  The following loop computes differences of the B-spline
+C***  coefficients. If the value of the spline is required,
+C***  differencing is not necessary.
+C
+      IF (IDER.GT.0) THEN
+         JL = JL - M2
+         ML = ML + M2
+         DO 6 I=1,IDER
+            JL = JL + 1
+            II = II + 1
+            J1 = MAX0(1,JL)
+            J2 = MIN0(L,II)
+            MI = M2 - I
+            J  = J2 + 1
+            IF (J1.LE.J2) THEN
+               DO 3 JIN=J1,J2
+                  J  =  J - 1
+                  JM = ML + J
+                  Q(JM) = (Q(JM) - Q(JM-1)) / (X(J+MI) - X(J))
+    3          CONTINUE
+            ENDIF
+            IF (JL.GE.1) GO TO 6
+               I1 =  I + 1
+               J  = ML + 1
+               IF (I1.LE.ML) THEN
+                  DO 5 JIN=I1,ML
+                     J    =  J - 1
+                     Q(J) = -Q(J-1)
+    5             CONTINUE
+               ENDIF
+    6    CONTINUE
+         DO 7 J=1,K
+            Q(J) = Q(J+IDER)
+    7    CONTINUE
+      ENDIF
+C
+C***  Compute lower half of the evaluation tableau
+C
+      IF (K1.GE.1) THEN      
+         DO 14 I=1,K1
+            NKI  =  NK + I
+            IR   =   K
+            JJ   =   L
+            KI   =   K - I
+            NKI1 = NKI + 1
+C***        Right-hand B-splines
+            IF (L.GE.NKI1) THEN
+               DO 9 J=NKI1,L
+                  Q(IR) = Q(IR-1) + (TT-X(JJ))*Q(IR)
+                  JJ    = JJ - 1
+                  IR    = IR - 1
+    9          CONTINUE
+            ENDIF
+C***        Middle B-splines
+            LK1I = LK1 + I
+            J1 = MAX0(1,LK1I)
+            J2 = MIN0(L, NKI)
+            IF (J1.LE.J2) THEN
+               DO 11 J=J1,J2
+                  XJKI  = X(JJ+KI)
+                  Z     = Q(IR)
+                  Q(IR) = Z + (XJKI-TT)*(Q(IR-1)-Z)/(XJKI-X(JJ))
+                  IR    = IR - 1
+                  JJ    = JJ - 1
+   11          CONTINUE
+            ENDIF
+C***        Left-hand B-splines
+            IF (LK1I.LE.0) THEN
+               JJ    = KI
+               LK1I1 =  1 - LK1I
+               DO 13 J=1,LK1I1
+                  Q(IR) = Q(IR) + (X(JJ)-TT)*Q(IR-1)
+                  JJ    = JJ - 1
+                  IR    = IR - 1
+   13          CONTINUE
+            ENDIF
+   14    CONTINUE
+      ENDIF
+C
+C***  Compute the return value
+C
+      Z = Q(K)
+C***  Multiply with factorial if IDER.gt.0
+      IF (IDER.GT.0) THEN
+         DO 16 J=K,M2M1
+            Z = Z * J
+   16    CONTINUE
+      ENDIF
+      SPLDER = Z
+C
+C***  Ready
+C
+      RETURN
+      END
+C SEARCH.FOR, 1985-06-03
+C
+C***********************************************************************
+C
+C SUBROUTINE SEARCH (REAL*8)
+C
+C Purpose:
+C *******
+C
+C       Given a strictly increasing knot sequence X(1) < ... < X(N),
+C       where N >= 1, and a real number T, this subroutine finds the
+C       value L such that X(L) <= T < X(L+1).  If T < X(1), L = 0;
+C       if X(N) <= T, L = N.
+C
+C Calling convention:
+C ******************
+C
+C       CALL SEARCH ( N, X, T, L )
+C
+C Meaning of parameters:
+C *********************
+C
+C       N       ( I )   Knot array dimensioning parameter.
+C       X(N)    ( I )   Stricly increasing knot array.
+C       T       ( I )   Input argument whose knot interval is to
+C                       be found.
+C       L       (I/O)   Knot interval parameter. The search procedure
+C                       is facilitated if L has approximately the
+C                       right value on entry.
+C
+C Remark:
+C ******
+C
+C       This subroutine is an adaptation of subroutine SEARCH from
+C       the paper by Lyche et al. (1983). No checking is performed
+C       on the input parameters and data; the algorithm may fail if
+C       the input sequence is not strictly increasing.
+C
+C Reference:
+C *********
+C
+C       T. Lyche, L.L. Schumaker, & K. Sepehrnoori, Fortran subroutines
+C       for computing smoothing and interpolating natural splines.
+C       Advances in Engineering Software 5(1983)1, pp. 2-5.
+C
+C***********************************************************************
+C
+      SUBROUTINE SEARCH ( N, X, T, L )
+C
+      IMPLICIT REAL*8 (A-H,O-Z)
+      DIMENSION X(N)
+C
+      IF (T.LT.X(1)) THEN
+C***     Out of range to the left
+         L = 0
+         RETURN
+      ENDIF
+      IF (T.GE.X(N)) THEN
+C***     Out of range to the right
+         L = N
+         RETURN
+      ENDIF
+C***  Validate input value of L
+      L = MAX0(L,1)
+      IF (L.GE.N) L = N-1
+C
+C***  Often L will be in an interval adjoining the interval found
+C***  in a previous call to search
+C
+      IF (T.GE.X(L)) GO TO 5
+      L = L - 1
+      IF (T.GE.X(L)) RETURN
+C
+C***  Perform bisection
+C
+      IL = 1
+    3 IU = L
+    4 L = (IL+IU) / 2
+      IF (IU-IL.LE.1) RETURN
+      IF (T.LT.X(L)) GO TO 3
+      IL = L
+      GO TO 4
+    5 IF (T.LT.X(L+1)) RETURN
+      L = L + 1
+      IF (T.LT.X(L+1)) RETURN
+      IL = L + 1
+      IU = N
+      GO TO 4
+C
+      END
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/octinst.sh.in	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,52 @@
+#! /bin/sh
+
+# octinst.sh source mpath opath xpath 
+
+# Copies all m-files and oct-files from the source directory to the
+# mpath and opath respectively.  Preserves links.  Files in
+# source/data are copied to mpath.  Files in the source/bin are copied
+# to xpath.
+
+if test $# -ne 4 ; then
+    echo 'Not enough arguments'
+    exit 1
+fi
+
+# interpret input parameters
+source=$1; shift
+mpath=$1; shift
+opath=$1; shift
+xpath=$1; shift
+INSTALL="@INSTALL@"
+INSTALL_DATA="@INSTALL_DATA@"
+INSTALL_PROGRAM="@INSTALL_PROGRAM@"
+
+# grab the m-files
+files=`echo $source/*.m`
+if test "$files" != "$source/*.m" ; then
+    $INSTALL -d $mpath
+    $INSTALL_DATA $files $mpath
+fi
+
+# grab the oct-files
+files=`echo $source/*.oct`
+if test "$files" != "$source/*.oct" ; then
+    $INSTALL -d $opath
+## Grrr... install doesn't preserve links.  Hope this works.
+    cp -fdp $files $opath
+fi
+
+# grab the data files
+files=`echo $source/data/*`
+if test "$files" != "$source/data/*" ; then
+    $INSTALL -d $mpath
+    $INSTALL_DATA $files $mpath
+fi
+
+# grab the executable files
+files=`echo $source/bin/*`
+if test "$files" != "$source/bin/*" ; then
+    $INSTALL -d $xpath
+    $INSTALL_PROGRAM $files $xpath
+fi
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/release.sh	Wed Oct 10 19:54:49 2001 +0000
@@ -0,0 +1,39 @@
+# !/bin/sh
+
+## Run this command to build a new release tarball. This assumes that 
+## the CVSROOT environment variable has been set appropriately, and 
+## that autogen is available on your path.
+##
+## Next follow these instructions to perform the upload: 
+##	1. FTP to upload.sourceforge.net 
+## 	2. Login as "anonymous" 
+##	3. Use your e-mail address as the password for this login 
+##	4. Set your client to binary mode ("bin" on command-line clients) 
+##	5. Change your current directory to /incoming ("cd /incoming") 
+##	6. Upload the desired files for the release ("put filename") 
+##
+## Finally, log in to your source forge account and go to 
+## https://sourceforge.net/project/admin/qrs.php?package_id=2841&group_id=2888
+
+# base name of the project
+PROJECT=octave-forge
+
+# use Ryyyy-mm-dd as the tag for revision yyyy.mm.dd
+TAG=R`date +%Y-%m-%d`
+ROOT=$PROJECT-`date +%Y.%m.%d`
+
+# tag the CVS tree with the revision number
+cvs rtag $TAG
+
+# extract the tree into a tagged directory
+cvs export -r $TAG $ROOT
+
+# generate configure script
+( cd $ROOT ; ./autogen.h )
+
+# build the tar ball
+tar czf $ROOT.tar.gz $ROOT
+
+# remove the tagged directory
+rm -rf $ROOT
+