Mercurial > octave-nkf

comparison liboctave/array/dSparse.cc @ 15271:648dabbb4c6b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
build: Refactor liboctave into multiple subdirectories. Move libcruft into liboctave. * array/Array-C.cc, array/Array-b.cc, array/Array-ch.cc, array/Array-d.cc, array/Array-f.cc, array/Array-fC.cc, array/Array-i.cc, array/Array-idx-vec.cc, array/Array-s.cc, array/Array-str.cc, array/Array-util.cc, array/Array-util.h, array/Array-voidp.cc, array/Array.cc, array/Array.h, array/Array2.h, array/Array3.h, array/ArrayN.h, array/CColVector.cc, array/CColVector.h, array/CDiagMatrix.cc, array/CDiagMatrix.h, array/CMatrix.cc, array/CMatrix.h, array/CNDArray.cc, array/CNDArray.h, array/CRowVector.cc, array/CRowVector.h, array/CSparse.cc, array/CSparse.h, array/DiagArray2.cc, array/DiagArray2.h, array/MArray-C.cc, array/MArray-d.cc, array/MArray-decl.h, array/MArray-defs.h, array/MArray-f.cc, array/MArray-fC.cc, array/MArray-i.cc, array/MArray-s.cc, array/MArray.cc, array/MArray.h, array/MArray2.h, array/MArrayN.h, array/MDiagArray2.cc, array/MDiagArray2.h, array/MSparse-C.cc, array/MSparse-d.cc, array/MSparse-defs.h, array/MSparse.cc, array/MSparse.h, array/Matrix.h, array/MatrixType.cc, array/MatrixType.h, array/PermMatrix.cc, array/PermMatrix.h, array/Range.cc, array/Range.h, array/Sparse-C.cc, array/Sparse-b.cc, array/Sparse-d.cc, array/Sparse.cc, array/Sparse.h, array/boolMatrix.cc, array/boolMatrix.h, array/boolNDArray.cc, array/boolNDArray.h, array/boolSparse.cc, array/boolSparse.h, array/chMatrix.cc, array/chMatrix.h, array/chNDArray.cc, array/chNDArray.h, array/dColVector.cc, array/dColVector.h, array/dDiagMatrix.cc, array/dDiagMatrix.h, array/dMatrix.cc, array/dMatrix.h, array/dNDArray.cc, array/dNDArray.h, array/dRowVector.cc, array/dRowVector.h, array/dSparse.cc, array/dSparse.h, array/dim-vector.cc, array/dim-vector.h, array/fCColVector.cc, array/fCColVector.h, array/fCDiagMatrix.cc, array/fCDiagMatrix.h, array/fCMatrix.cc, array/fCMatrix.h, array/fCNDArray.cc, array/fCNDArray.h, array/fCRowVector.cc, array/fCRowVector.h, array/fColVector.cc, array/fColVector.h, array/fDiagMatrix.cc, array/fDiagMatrix.h, array/fMatrix.cc, array/fMatrix.h, array/fNDArray.cc, array/fNDArray.h, array/fRowVector.cc, array/fRowVector.h, array/idx-vector.cc, array/idx-vector.h, array/int16NDArray.cc, array/int16NDArray.h, array/int32NDArray.cc, array/int32NDArray.h, array/int64NDArray.cc, array/int64NDArray.h, array/int8NDArray.cc, array/int8NDArray.h, array/intNDArray.cc, array/intNDArray.h, array/module.mk, array/uint16NDArray.cc, array/uint16NDArray.h, array/uint32NDArray.cc, array/uint32NDArray.h, array/uint64NDArray.cc, array/uint64NDArray.h, array/uint8NDArray.cc, array/uint8NDArray.h: Moved from liboctave dir to array subdirectory. * cruft/Makefile.am, cruft/amos/README, cruft/amos/cacai.f, cruft/amos/cacon.f, cruft/amos/cairy.f, cruft/amos/casyi.f, cruft/amos/cbesh.f, cruft/amos/cbesi.f, cruft/amos/cbesj.f, cruft/amos/cbesk.f, cruft/amos/cbesy.f, cruft/amos/cbinu.f, cruft/amos/cbiry.f, cruft/amos/cbknu.f, cruft/amos/cbuni.f, cruft/amos/cbunk.f, cruft/amos/ckscl.f, cruft/amos/cmlri.f, cruft/amos/crati.f, cruft/amos/cs1s2.f, cruft/amos/cseri.f, cruft/amos/cshch.f, cruft/amos/cuchk.f, cruft/amos/cunhj.f, cruft/amos/cuni1.f, cruft/amos/cuni2.f, cruft/amos/cunik.f, cruft/amos/cunk1.f, cruft/amos/cunk2.f, cruft/amos/cuoik.f, cruft/amos/cwrsk.f, cruft/amos/dgamln.f, cruft/amos/gamln.f, cruft/amos/module.mk, cruft/amos/xzabs.f, cruft/amos/xzexp.f, cruft/amos/xzlog.f, cruft/amos/xzsqrt.f, cruft/amos/zacai.f, cruft/amos/zacon.f, cruft/amos/zairy.f, cruft/amos/zasyi.f, cruft/amos/zbesh.f, cruft/amos/zbesi.f, cruft/amos/zbesj.f, cruft/amos/zbesk.f, cruft/amos/zbesy.f, cruft/amos/zbinu.f, cruft/amos/zbiry.f, cruft/amos/zbknu.f, cruft/amos/zbuni.f, cruft/amos/zbunk.f, cruft/amos/zdiv.f, cruft/amos/zkscl.f, cruft/amos/zmlri.f, cruft/amos/zmlt.f, cruft/amos/zrati.f, cruft/amos/zs1s2.f, cruft/amos/zseri.f, cruft/amos/zshch.f, cruft/amos/zuchk.f, cruft/amos/zunhj.f, cruft/amos/zuni1.f, cruft/amos/zuni2.f, cruft/amos/zunik.f, cruft/amos/zunk1.f, cruft/amos/zunk2.f, cruft/amos/zuoik.f, cruft/amos/zwrsk.f, cruft/blas-xtra/cconv2.f, cruft/blas-xtra/cdotc3.f, cruft/blas-xtra/cmatm3.f, cruft/blas-xtra/csconv2.f, cruft/blas-xtra/dconv2.f, cruft/blas-xtra/ddot3.f, cruft/blas-xtra/dmatm3.f, cruft/blas-xtra/module.mk, cruft/blas-xtra/sconv2.f, cruft/blas-xtra/sdot3.f, cruft/blas-xtra/smatm3.f, cruft/blas-xtra/xcdotc.f, cruft/blas-xtra/xcdotu.f, cruft/blas-xtra/xddot.f, cruft/blas-xtra/xdnrm2.f, cruft/blas-xtra/xdznrm2.f, cruft/blas-xtra/xerbla.f, cruft/blas-xtra/xscnrm2.f, cruft/blas-xtra/xsdot.f, cruft/blas-xtra/xsnrm2.f, cruft/blas-xtra/xzdotc.f, cruft/blas-xtra/xzdotu.f, cruft/blas-xtra/zconv2.f, cruft/blas-xtra/zdconv2.f, cruft/blas-xtra/zdotc3.f, cruft/blas-xtra/zmatm3.f, cruft/daspk/datv.f, cruft/daspk/dcnst0.f, cruft/daspk/dcnstr.f, cruft/daspk/ddasic.f, cruft/daspk/ddasid.f, cruft/daspk/ddasik.f, cruft/daspk/ddaspk.f, cruft/daspk/ddstp.f, cruft/daspk/ddwnrm.f, cruft/daspk/dfnrmd.f, cruft/daspk/dfnrmk.f, cruft/daspk/dhels.f, cruft/daspk/dheqr.f, cruft/daspk/dinvwt.f, cruft/daspk/dlinsd.f, cruft/daspk/dlinsk.f, cruft/daspk/dmatd.f, cruft/daspk/dnedd.f, cruft/daspk/dnedk.f, cruft/daspk/dnsd.f, cruft/daspk/dnsid.f, cruft/daspk/dnsik.f, cruft/daspk/dnsk.f, cruft/daspk/dorth.f, cruft/daspk/dslvd.f, cruft/daspk/dslvk.f, cruft/daspk/dspigm.f, cruft/daspk/dyypnw.f, cruft/daspk/module.mk, cruft/dasrt/ddasrt.f, cruft/dasrt/drchek.f, cruft/dasrt/droots.f, cruft/dasrt/module.mk, cruft/dassl/ddaini.f, cruft/dassl/ddajac.f, cruft/dassl/ddanrm.f, cruft/dassl/ddaslv.f, cruft/dassl/ddassl.f, cruft/dassl/ddastp.f, cruft/dassl/ddatrp.f, cruft/dassl/ddawts.f, cruft/dassl/module.mk, cruft/fftpack/cfftb.f, cruft/fftpack/cfftb1.f, cruft/fftpack/cfftf.f, cruft/fftpack/cfftf1.f, cruft/fftpack/cffti.f, cruft/fftpack/cffti1.f, cruft/fftpack/fftpack.doc, cruft/fftpack/module.mk, cruft/fftpack/passb.f, cruft/fftpack/passb2.f, cruft/fftpack/passb3.f, cruft/fftpack/passb4.f, cruft/fftpack/passb5.f, cruft/fftpack/passf.f, cruft/fftpack/passf2.f, cruft/fftpack/passf3.f, cruft/fftpack/passf4.f, cruft/fftpack/passf5.f, cruft/fftpack/zfftb.f, cruft/fftpack/zfftb1.f, cruft/fftpack/zfftf.f, cruft/fftpack/zfftf1.f, cruft/fftpack/zffti.f, cruft/fftpack/zffti1.f, cruft/fftpack/zpassb.f, cruft/fftpack/zpassb2.f, cruft/fftpack/zpassb3.f, cruft/fftpack/zpassb4.f, cruft/fftpack/zpassb5.f, cruft/fftpack/zpassf.f, cruft/fftpack/zpassf2.f, cruft/fftpack/zpassf3.f, cruft/fftpack/zpassf4.f, cruft/fftpack/zpassf5.f, cruft/lapack-xtra/crsf2csf.f, cruft/lapack-xtra/module.mk, cruft/lapack-xtra/xclange.f, cruft/lapack-xtra/xdlamch.f, cruft/lapack-xtra/xdlange.f, cruft/lapack-xtra/xilaenv.f, cruft/lapack-xtra/xslamch.f, cruft/lapack-xtra/xslange.f, cruft/lapack-xtra/xzlange.f, cruft/lapack-xtra/zrsf2csf.f, cruft/link-deps.mk, cruft/misc/blaswrap.c, cruft/misc/cquit.c, cruft/misc/d1mach-tst.for, cruft/misc/d1mach.f, cruft/misc/f77-extern.cc, cruft/misc/f77-fcn.c, cruft/misc/f77-fcn.h, cruft/misc/i1mach.f, cruft/misc/lo-error.c, cruft/misc/lo-error.h, cruft/misc/module.mk, cruft/misc/quit.cc, cruft/misc/quit.h, cruft/misc/r1mach.f, cruft/mkf77def.in, cruft/odepack/cfode.f, cruft/odepack/dlsode.f, cruft/odepack/ewset.f, cruft/odepack/intdy.f, cruft/odepack/module.mk, cruft/odepack/prepj.f, cruft/odepack/scfode.f, cruft/odepack/sewset.f, cruft/odepack/sintdy.f, cruft/odepack/slsode.f, cruft/odepack/solsy.f, cruft/odepack/sprepj.f, cruft/odepack/ssolsy.f, cruft/odepack/sstode.f, cruft/odepack/stode.f, cruft/odepack/svnorm.f, cruft/odepack/vnorm.f, cruft/ordered-qz/README, cruft/ordered-qz/dsubsp.f, cruft/ordered-qz/exchqz.f, cruft/ordered-qz/module.mk, cruft/ordered-qz/sexchqz.f, cruft/ordered-qz/ssubsp.f, cruft/quadpack/dqagi.f, cruft/quadpack/dqagie.f, cruft/quadpack/dqagp.f, cruft/quadpack/dqagpe.f, cruft/quadpack/dqelg.f, cruft/quadpack/dqk15i.f, cruft/quadpack/dqk21.f, cruft/quadpack/dqpsrt.f, cruft/quadpack/module.mk, cruft/quadpack/qagi.f, cruft/quadpack/qagie.f, cruft/quadpack/qagp.f, cruft/quadpack/qagpe.f, cruft/quadpack/qelg.f, cruft/quadpack/qk15i.f, cruft/quadpack/qk21.f, cruft/quadpack/qpsrt.f, cruft/quadpack/xerror.f, cruft/ranlib/Basegen.doc, cruft/ranlib/HOWTOGET, cruft/ranlib/README, cruft/ranlib/advnst.f, cruft/ranlib/genbet.f, cruft/ranlib/genchi.f, cruft/ranlib/genexp.f, cruft/ranlib/genf.f, cruft/ranlib/gengam.f, cruft/ranlib/genmn.f, cruft/ranlib/genmul.f, cruft/ranlib/gennch.f, cruft/ranlib/gennf.f, cruft/ranlib/gennor.f, cruft/ranlib/genprm.f, cruft/ranlib/genunf.f, cruft/ranlib/getcgn.f, cruft/ranlib/getsd.f, cruft/ranlib/ignbin.f, cruft/ranlib/ignlgi.f, cruft/ranlib/ignnbn.f, cruft/ranlib/ignpoi.f, cruft/ranlib/ignuin.f, cruft/ranlib/initgn.f, cruft/ranlib/inrgcm.f, cruft/ranlib/lennob.f, cruft/ranlib/mltmod.f, cruft/ranlib/module.mk, cruft/ranlib/phrtsd.f, cruft/ranlib/qrgnin.f, cruft/ranlib/randlib.chs, cruft/ranlib/randlib.fdoc, cruft/ranlib/ranf.f, cruft/ranlib/setall.f, cruft/ranlib/setant.f, cruft/ranlib/setgmn.f, cruft/ranlib/setsd.f, cruft/ranlib/sexpo.f, cruft/ranlib/sgamma.f, cruft/ranlib/snorm.f, cruft/ranlib/tstbot.for, cruft/ranlib/tstgmn.for, cruft/ranlib/tstmid.for, cruft/ranlib/wrap.f, cruft/slatec-err/fdump.f, cruft/slatec-err/ixsav.f, cruft/slatec-err/j4save.f, cruft/slatec-err/module.mk, cruft/slatec-err/xerclr.f, cruft/slatec-err/xercnt.f, cruft/slatec-err/xerhlt.f, cruft/slatec-err/xermsg.f, cruft/slatec-err/xerprn.f, cruft/slatec-err/xerrwd.f, cruft/slatec-err/xersve.f, cruft/slatec-err/xgetf.f, cruft/slatec-err/xgetua.f, cruft/slatec-err/xsetf.f, cruft/slatec-err/xsetua.f, cruft/slatec-fn/acosh.f, cruft/slatec-fn/albeta.f, cruft/slatec-fn/algams.f, cruft/slatec-fn/alngam.f, cruft/slatec-fn/alnrel.f, cruft/slatec-fn/asinh.f, cruft/slatec-fn/atanh.f, cruft/slatec-fn/betai.f, cruft/slatec-fn/csevl.f, cruft/slatec-fn/d9gmit.f, cruft/slatec-fn/d9lgic.f, cruft/slatec-fn/d9lgit.f, cruft/slatec-fn/d9lgmc.f, cruft/slatec-fn/dacosh.f, cruft/slatec-fn/dasinh.f, cruft/slatec-fn/datanh.f, cruft/slatec-fn/dbetai.f, cruft/slatec-fn/dcsevl.f, cruft/slatec-fn/derf.f, cruft/slatec-fn/derfc.in.f, cruft/slatec-fn/dgami.f, cruft/slatec-fn/dgamit.f, cruft/slatec-fn/dgamlm.f, cruft/slatec-fn/dgamma.f, cruft/slatec-fn/dgamr.f, cruft/slatec-fn/dlbeta.f, cruft/slatec-fn/dlgams.f, cruft/slatec-fn/dlngam.f, cruft/slatec-fn/dlnrel.f, cruft/slatec-fn/dpchim.f, cruft/slatec-fn/dpchst.f, cruft/slatec-fn/erf.f, cruft/slatec-fn/erfc.in.f, cruft/slatec-fn/gami.f, cruft/slatec-fn/gamit.f, cruft/slatec-fn/gamlim.f, cruft/slatec-fn/gamma.f, cruft/slatec-fn/gamr.f, cruft/slatec-fn/initds.f, cruft/slatec-fn/inits.f, cruft/slatec-fn/module.mk, cruft/slatec-fn/pchim.f, cruft/slatec-fn/pchst.f, cruft/slatec-fn/r9gmit.f, cruft/slatec-fn/r9lgic.f, cruft/slatec-fn/r9lgit.f, cruft/slatec-fn/r9lgmc.f, cruft/slatec-fn/xacosh.f, cruft/slatec-fn/xasinh.f, cruft/slatec-fn/xatanh.f, cruft/slatec-fn/xbetai.f, cruft/slatec-fn/xdacosh.f, cruft/slatec-fn/xdasinh.f, cruft/slatec-fn/xdatanh.f, cruft/slatec-fn/xdbetai.f, cruft/slatec-fn/xderf.f, cruft/slatec-fn/xderfc.f, cruft/slatec-fn/xdgami.f, cruft/slatec-fn/xdgamit.f, cruft/slatec-fn/xdgamma.f, cruft/slatec-fn/xerf.f, cruft/slatec-fn/xerfc.f, cruft/slatec-fn/xgamma.f, cruft/slatec-fn/xgmainc.f, cruft/slatec-fn/xsgmainc.f: Moved from top-level libcruft to cruft directory below liboctave. * numeric/CmplxAEPBAL.cc, numeric/CmplxAEPBAL.h, numeric/CmplxCHOL.cc, numeric/CmplxCHOL.h, numeric/CmplxGEPBAL.cc, numeric/CmplxGEPBAL.h, numeric/CmplxHESS.cc, numeric/CmplxHESS.h, numeric/CmplxLU.cc, numeric/CmplxLU.h, numeric/CmplxQR.cc, numeric/CmplxQR.h, numeric/CmplxQRP.cc, numeric/CmplxQRP.h, numeric/CmplxSCHUR.cc, numeric/CmplxSCHUR.h, numeric/CmplxSVD.cc, numeric/CmplxSVD.h, numeric/CollocWt.cc, numeric/CollocWt.h, numeric/DAE.h, numeric/DAEFunc.h, numeric/DAERT.h, numeric/DAERTFunc.h, numeric/DASPK-opts.in, numeric/DASPK.cc, numeric/DASPK.h, numeric/DASRT-opts.in, numeric/DASRT.cc, numeric/DASRT.h, numeric/DASSL-opts.in, numeric/DASSL.cc, numeric/DASSL.h, numeric/DET.h, numeric/EIG.cc, numeric/EIG.h, numeric/LSODE-opts.in, numeric/LSODE.cc, numeric/LSODE.h, numeric/ODE.h, numeric/ODEFunc.h, numeric/ODES.cc, numeric/ODES.h, numeric/ODESFunc.h, numeric/Quad-opts.in, numeric/Quad.cc, numeric/Quad.h, numeric/SparseCmplxCHOL.cc, numeric/SparseCmplxCHOL.h, numeric/SparseCmplxLU.cc, numeric/SparseCmplxLU.h, numeric/SparseCmplxQR.cc, numeric/SparseCmplxQR.h, numeric/SparseQR.cc, numeric/SparseQR.h, numeric/SparsedbleCHOL.cc, numeric/SparsedbleCHOL.h, numeric/SparsedbleLU.cc, numeric/SparsedbleLU.h, numeric/base-aepbal.h, numeric/base-dae.h, numeric/base-de.h, numeric/base-lu.cc, numeric/base-lu.h, numeric/base-min.h, numeric/base-qr.cc, numeric/base-qr.h, numeric/bsxfun-decl.h, numeric/bsxfun-defs.cc, numeric/bsxfun.h, numeric/dbleAEPBAL.cc, numeric/dbleAEPBAL.h, numeric/dbleCHOL.cc, numeric/dbleCHOL.h, numeric/dbleGEPBAL.cc, numeric/dbleGEPBAL.h, numeric/dbleHESS.cc, numeric/dbleHESS.h, numeric/dbleLU.cc, numeric/dbleLU.h, numeric/dbleQR.cc, numeric/dbleQR.h, numeric/dbleQRP.cc, numeric/dbleQRP.h, numeric/dbleSCHUR.cc, numeric/dbleSCHUR.h, numeric/dbleSVD.cc, numeric/dbleSVD.h, numeric/eigs-base.cc, numeric/fCmplxAEPBAL.cc, numeric/fCmplxAEPBAL.h, numeric/fCmplxCHOL.cc, numeric/fCmplxCHOL.h, numeric/fCmplxGEPBAL.cc, numeric/fCmplxGEPBAL.h, numeric/fCmplxHESS.cc, numeric/fCmplxHESS.h, numeric/fCmplxLU.cc, numeric/fCmplxLU.h, numeric/fCmplxQR.cc, numeric/fCmplxQR.h, numeric/fCmplxQRP.cc, numeric/fCmplxQRP.h, numeric/fCmplxSCHUR.cc, numeric/fCmplxSCHUR.h, numeric/fCmplxSVD.cc, numeric/fCmplxSVD.h, numeric/fEIG.cc, numeric/fEIG.h, numeric/floatAEPBAL.cc, numeric/floatAEPBAL.h, numeric/floatCHOL.cc, numeric/floatCHOL.h, numeric/floatGEPBAL.cc, numeric/floatGEPBAL.h, numeric/floatHESS.cc, numeric/floatHESS.h, numeric/floatLU.cc, numeric/floatLU.h, numeric/floatQR.cc, numeric/floatQR.h, numeric/floatQRP.cc, numeric/floatQRP.h, numeric/floatSCHUR.cc, numeric/floatSCHUR.h, numeric/floatSVD.cc, numeric/floatSVD.h, numeric/lo-mappers.cc, numeric/lo-mappers.h, numeric/lo-specfun.cc, numeric/lo-specfun.h, numeric/module.mk, numeric/oct-convn.cc, numeric/oct-convn.h, numeric/oct-fftw.cc, numeric/oct-fftw.h, numeric/oct-norm.cc, numeric/oct-norm.h, numeric/oct-rand.cc, numeric/oct-rand.h, numeric/oct-spparms.cc, numeric/oct-spparms.h, numeric/randgamma.c, numeric/randgamma.h, numeric/randmtzig.c, numeric/randmtzig.h, numeric/randpoisson.c, numeric/randpoisson.h, numeric/sparse-base-chol.cc, numeric/sparse-base-chol.h, numeric/sparse-base-lu.cc, numeric/sparse-base-lu.h, numeric/sparse-dmsolve.cc: Moved from liboctave dir to numeric subdirectory. * operators/Sparse-diag-op-defs.h, operators/Sparse-op-defs.h, operators/Sparse-perm-op-defs.h, operators/config-ops.sh, operators/mk-ops.awk, operators/module.mk, operators/mx-base.h, operators/mx-defs.h, operators/mx-ext.h, operators/mx-inlines.cc, operators/mx-op-decl.h, operators/mx-op-defs.h, operators/mx-ops, operators/sparse-mk-ops.awk, operators/sparse-mx-ops, operators/vx-ops: Moved from liboctave dir to operators subdirectory. * system/dir-ops.cc, system/dir-ops.h, system/file-ops.cc, system/file-ops.h, system/file-stat.cc, system/file-stat.h, system/lo-sysdep.cc, system/lo-sysdep.h, system/mach-info.cc, system/mach-info.h, system/module.mk, system/oct-env.cc, system/oct-env.h, system/oct-group.cc, system/oct-group.h, system/oct-openmp.h, system/oct-passwd.cc, system/oct-passwd.h, system/oct-syscalls.cc, system/oct-syscalls.h, system/oct-time.cc, system/oct-time.h, system/oct-uname.cc, system/oct-uname.h, system/pathlen.h, system/sysdir.h, system/syswait.h, system/tempnam.c, system/tempname.c: Moved from liboctave dir to system subdirectory. * util/base-list.h, util/byte-swap.h, util/caseless-str.h, util/cmd-edit.cc, util/cmd-edit.h, util/cmd-hist.cc, util/cmd-hist.h, util/data-conv.cc, util/data-conv.h, util/f2c-main.c, util/functor.h, util/glob-match.cc, util/glob-match.h, util/kpse.cc, util/lo-array-gripes.cc, util/lo-array-gripes.h, util/lo-cieee.c, util/lo-cutils.c, util/lo-cutils.h, util/lo-ieee.cc, util/lo-ieee.h, util/lo-macros.h, util/lo-math.h, util/lo-traits.h, util/lo-utils.cc, util/lo-utils.h, util/module.mk, util/oct-alloc.cc, util/oct-alloc.h, util/oct-base64.cc, util/oct-base64.h, util/oct-binmap.h, util/oct-cmplx.h, util/oct-glob.cc, util/oct-glob.h, util/oct-inttypes.cc, util/oct-inttypes.h, util/oct-locbuf.cc, util/oct-locbuf.h, util/oct-md5.cc, util/oct-md5.h, util/oct-mem.h, util/oct-mutex.cc, util/oct-mutex.h, util/oct-refcount.h, util/oct-rl-edit.c, util/oct-rl-edit.h, util/oct-rl-hist.c, util/oct-rl-hist.h, util/oct-shlib.cc, util/oct-shlib.h, util/oct-sort.cc, util/oct-sort.h, util/oct-sparse.h, util/pathsearch.cc, util/pathsearch.h, util/regexp.cc, util/regexp.h, util/singleton-cleanup.cc, util/singleton-cleanup.h, util/sparse-sort.cc, util/sparse-sort.h, util/sparse-util.cc, util/sparse-util.h, util/statdefs.h, util/str-vec.cc, util/str-vec.h, util/sun-utils.h: Moved from liboctave dir to util subdirectory. * Makefile.am: Eliminate reference to top-level liboctave directory. * autogen.sh: cd to new liboctave/operators directory to run config-ops.sh. * build-aux/common.mk: Eliminate LIBCRUFT references. * configure.ac: Eliminate libcruft top-level references. Switch test programs to find files in liboctave/cruft subdirectory. * OctaveFAQ.texi, install.txi, mkoctfile.1: Eliminate references to libcruft in docs. * libgui/src/Makefile.am, libinterp/Makefile.am, src/Makefile.am: Update include file locations. Stop linking against libcruft. * libinterp/corefcn/module.mk: Update location of OPT_INC files which are now in numeric/ subdirectory. * libinterp/dldfcn/config-module.awk: Stop linking against libcruft. * libinterp/interpfcn/toplev.cc: Remove reference to LIBCRUFT. * libinterp/link-deps.mk, liboctave/link-deps.mk: Add GNULIB_LINK_DEPS to link dependencies. * libinterp/oct-conf.in.h: Remove reference to OCTAVE_CONF_LIBCRUFT. * liboctave/Makefile.am: Overhaul to use convenience libraries in subdirectories. * scripts/miscellaneous/mkoctfile.m: Eliminate reference to LIBCRUFT. * src/mkoctfile.in.cc, src/mkoctfile.in.sh: Stop linking againt libcruft. Eliminate references to LIBCRUFT.
author Rik <rik@octave.org>
date Fri, 31 Aug 2012 20:00:20 -0700
parents liboctave/dSparse.cc@4bbd3bbb8912
children 6aafe87a3144
comparison
equal deleted inserted replaced
15270:6615a46d90ec 15271:648dabbb4c6b
1 /*
2
3 Copyright (C) 2004-2012 David Bateman
4 Copyright (C) 1998-2004 Andy Adler
5 Copyright (C) 2010 VZLU Prague
6
7 This file is part of Octave.
8
9 Octave is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 3 of the License, or (at your
12 option) any later version.
13
14 Octave is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with Octave; see the file COPYING. If not, see
21 <http://www.gnu.org/licenses/>.
22
23 */
24
25 #ifdef HAVE_CONFIG_H
26 #include <config.h>
27 #endif
28
29 #include <cfloat>
30
31 #include <iostream>
32 #include <vector>
33 #include <functional>
34
35 #include "quit.h"
36 #include "lo-ieee.h"
37 #include "lo-mappers.h"
38 #include "f77-fcn.h"
39 #include "dRowVector.h"
40 #include "oct-locbuf.h"
41
42 #include "dDiagMatrix.h"
43 #include "CSparse.h"
44 #include "boolSparse.h"
45 #include "dSparse.h"
46 #include "functor.h"
47 #include "oct-spparms.h"
48 #include "SparsedbleLU.h"
49 #include "MatrixType.h"
50 #include "oct-sparse.h"
51 #include "sparse-util.h"
52 #include "SparsedbleCHOL.h"
53 #include "SparseQR.h"
54
55 #include "Sparse-diag-op-defs.h"
56
57 #include "Sparse-perm-op-defs.h"
58
59 // Define whether to use a basic QR solver or one that uses a Dulmange
60 // Mendelsohn factorization to seperate the problem into under-determined,
61 // well-determined and over-determined parts and solves them seperately
62 #ifndef USE_QRSOLVE
63 #include "sparse-dmsolve.cc"
64 #endif
65
66 // Fortran functions we call.
67 extern "C"
68 {
69 F77_RET_T
70 F77_FUNC (dgbtrf, DGBTRF) (const octave_idx_type&, const octave_idx_type&,
71 const octave_idx_type&, const octave_idx_type&,
72 double*, const octave_idx_type&,
73 octave_idx_type*, octave_idx_type&);
74
75 F77_RET_T
76 F77_FUNC (dgbtrs, DGBTRS) (F77_CONST_CHAR_ARG_DECL,
77 const octave_idx_type&, const octave_idx_type&,
78 const octave_idx_type&, const octave_idx_type&,
79 const double*, const octave_idx_type&,
80 const octave_idx_type*, double*,
81 const octave_idx_type&, octave_idx_type&
82 F77_CHAR_ARG_LEN_DECL);
83
84 F77_RET_T
85 F77_FUNC (dgbcon, DGBCON) (F77_CONST_CHAR_ARG_DECL,
86 const octave_idx_type&, const octave_idx_type&,
87 const octave_idx_type&, double*,
88 const octave_idx_type&, const octave_idx_type*,
89 const double&, double&, double*,
90 octave_idx_type*, octave_idx_type&
91 F77_CHAR_ARG_LEN_DECL);
92
93 F77_RET_T
94 F77_FUNC (dpbtrf, DPBTRF) (F77_CONST_CHAR_ARG_DECL,
95 const octave_idx_type&, const octave_idx_type&,
96 double*, const octave_idx_type&, octave_idx_type&
97 F77_CHAR_ARG_LEN_DECL);
98
99 F77_RET_T
100 F77_FUNC (dpbtrs, DPBTRS) (F77_CONST_CHAR_ARG_DECL,
101 const octave_idx_type&, const octave_idx_type&,
102 const octave_idx_type&, double*,
103 const octave_idx_type&, double*,
104 const octave_idx_type&, octave_idx_type&
105 F77_CHAR_ARG_LEN_DECL);
106
107 F77_RET_T
108 F77_FUNC (dpbcon, DPBCON) (F77_CONST_CHAR_ARG_DECL,
109 const octave_idx_type&, const octave_idx_type&,
110 double*, const octave_idx_type&,
111 const double&, double&, double*,
112 octave_idx_type*, octave_idx_type&
113 F77_CHAR_ARG_LEN_DECL);
114 F77_RET_T
115 F77_FUNC (dptsv, DPTSV) (const octave_idx_type&, const octave_idx_type&,
116 double*, double*, double*, const octave_idx_type&,
117 octave_idx_type&);
118
119 F77_RET_T
120 F77_FUNC (dgtsv, DGTSV) (const octave_idx_type&, const octave_idx_type&,
121 double*, double*, double*, double*,
122 const octave_idx_type&, octave_idx_type&);
123
124 F77_RET_T
125 F77_FUNC (dgttrf, DGTTRF) (const octave_idx_type&, double*, double*,
126 double*, double*, octave_idx_type*,
127 octave_idx_type&);
128
129 F77_RET_T
130 F77_FUNC (dgttrs, DGTTRS) (F77_CONST_CHAR_ARG_DECL,
131 const octave_idx_type&, const octave_idx_type&,
132 const double*, const double*, const double*,
133 const double*, const octave_idx_type*,
134 double *, const octave_idx_type&, octave_idx_type&
135 F77_CHAR_ARG_LEN_DECL);
136
137 F77_RET_T
138 F77_FUNC (zptsv, ZPTSV) (const octave_idx_type&, const octave_idx_type&,
139 double*, Complex*, Complex*, const octave_idx_type&,
140 octave_idx_type&);
141
142 F77_RET_T
143 F77_FUNC (zgtsv, ZGTSV) (const octave_idx_type&, const octave_idx_type&,
144 Complex*, Complex*, Complex*, Complex*,
145 const octave_idx_type&, octave_idx_type&);
146
147 }
148
149 SparseMatrix::SparseMatrix (const SparseBoolMatrix &a)
150 : MSparse<double> (a.rows (), a.cols (), a.nnz ())
151 {
152 octave_idx_type nc = cols ();
153 octave_idx_type nz = a.nnz ();
154
155 for (octave_idx_type i = 0; i < nc + 1; i++)
156 cidx (i) = a.cidx (i);
157
158 for (octave_idx_type i = 0; i < nz; i++)
159 {
160 data (i) = a.data (i);
161 ridx (i) = a.ridx (i);
162 }
163 }
164
165 SparseMatrix::SparseMatrix (const DiagMatrix& a)
166 : MSparse<double> (a.rows (), a.cols (), a.length ())
167 {
168 octave_idx_type j = 0, l = a.length ();
169 for (octave_idx_type i = 0; i < l; i++)
170 {
171 cidx (i) = j;
172 if (a(i, i) != 0.0)
173 {
174 data (j) = a(i, i);
175 ridx (j) = i;
176 j++;
177 }
178 }
179 for (octave_idx_type i = l; i <= a.cols (); i++)
180 cidx (i) = j;
181 }
182
183 bool
184 SparseMatrix::operator == (const SparseMatrix& a) const
185 {
186 octave_idx_type nr = rows ();
187 octave_idx_type nc = cols ();
188 octave_idx_type nz = nnz ();
189 octave_idx_type nr_a = a.rows ();
190 octave_idx_type nc_a = a.cols ();
191 octave_idx_type nz_a = a.nnz ();
192
193 if (nr != nr_a || nc != nc_a || nz != nz_a)
194 return false;
195
196 for (octave_idx_type i = 0; i < nc + 1; i++)
197 if (cidx (i) != a.cidx (i))
198 return false;
199
200 for (octave_idx_type i = 0; i < nz; i++)
201 if (data (i) != a.data (i) || ridx (i) != a.ridx (i))
202 return false;
203
204 return true;
205 }
206
207 bool
208 SparseMatrix::operator != (const SparseMatrix& a) const
209 {
210 return !(*this == a);
211 }
212
213 bool
214 SparseMatrix::is_symmetric (void) const
215 {
216 octave_idx_type nr = rows ();
217 octave_idx_type nc = cols ();
218
219 if (nr == nc && nr > 0)
220 {
221 for (octave_idx_type j = 0; j < nc; j++)
222 {
223 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
224 {
225 octave_idx_type ri = ridx (i);
226
227 if (ri != j)
228 {
229 bool found = false;
230
231 for (octave_idx_type k = cidx (ri); k < cidx (ri+1); k++)
232 {
233 if (ridx (k) == j)
234 {
235 if (data (i) == data (k))
236 found = true;
237 break;
238 }
239 }
240
241 if (! found)
242 return false;
243 }
244 }
245 }
246
247 return true;
248 }
249
250 return false;
251 }
252
253 SparseMatrix&
254 SparseMatrix::insert (const SparseMatrix& a, octave_idx_type r, octave_idx_type c)
255 {
256 MSparse<double>::insert (a, r, c);
257 return *this;
258 }
259
260 SparseMatrix&
261 SparseMatrix::insert (const SparseMatrix& a, const Array<octave_idx_type>& indx)
262 {
263 MSparse<double>::insert (a, indx);
264 return *this;
265 }
266
267 SparseMatrix
268 SparseMatrix::max (int dim) const
269 {
270 Array<octave_idx_type> dummy_idx;
271 return max (dummy_idx, dim);
272 }
273
274 SparseMatrix
275 SparseMatrix::max (Array<octave_idx_type>& idx_arg, int dim) const
276 {
277 SparseMatrix result;
278 dim_vector dv = dims ();
279
280 if (dv.numel () == 0 || dim >= dv.length ())
281 return result;
282
283 if (dim < 0)
284 dim = dv.first_non_singleton ();
285
286 octave_idx_type nr = dv(0);
287 octave_idx_type nc = dv(1);
288
289 if (dim == 0)
290 {
291 idx_arg.clear (1, nc);
292 octave_idx_type nel = 0;
293 for (octave_idx_type j = 0; j < nc; j++)
294 {
295 double tmp_max = octave_NaN;
296 octave_idx_type idx_j = 0;
297 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
298 {
299 if (ridx (i) != idx_j)
300 break;
301 else
302 idx_j++;
303 }
304
305 if (idx_j != nr)
306 tmp_max = 0.;
307
308 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
309 {
310 double tmp = data (i);
311
312 if (xisnan (tmp))
313 continue;
314 else if (xisnan (tmp_max) || tmp > tmp_max)
315 {
316 idx_j = ridx (i);
317 tmp_max = tmp;
318 }
319
320 }
321
322 idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_j;
323 if (tmp_max != 0.)
324 nel++;
325 }
326
327 result = SparseMatrix (1, nc, nel);
328
329 octave_idx_type ii = 0;
330 result.xcidx (0) = 0;
331 for (octave_idx_type j = 0; j < nc; j++)
332 {
333 double tmp = elem (idx_arg(j), j);
334 if (tmp != 0.)
335 {
336 result.xdata (ii) = tmp;
337 result.xridx (ii++) = 0;
338 }
339 result.xcidx (j+1) = ii;
340
341 }
342 }
343 else
344 {
345 idx_arg.resize (dim_vector (nr, 1), 0);
346
347 for (octave_idx_type i = cidx (0); i < cidx (1); i++)
348 idx_arg.elem (ridx (i)) = -1;
349
350 for (octave_idx_type j = 0; j < nc; j++)
351 for (octave_idx_type i = 0; i < nr; i++)
352 {
353 if (idx_arg.elem (i) != -1)
354 continue;
355 bool found = false;
356 for (octave_idx_type k = cidx (j); k < cidx (j+1); k++)
357 if (ridx (k) == i)
358 {
359 found = true;
360 break;
361 }
362
363 if (!found)
364 idx_arg.elem (i) = j;
365
366 }
367
368 for (octave_idx_type j = 0; j < nc; j++)
369 {
370 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
371 {
372 octave_idx_type ir = ridx (i);
373 octave_idx_type ix = idx_arg.elem (ir);
374 double tmp = data (i);
375
376 if (xisnan (tmp))
377 continue;
378 else if (ix == -1 || tmp > elem (ir, ix))
379 idx_arg.elem (ir) = j;
380 }
381 }
382
383 octave_idx_type nel = 0;
384 for (octave_idx_type j = 0; j < nr; j++)
385 if (idx_arg.elem (j) == -1 || elem (j, idx_arg.elem (j)) != 0.)
386 nel++;
387
388 result = SparseMatrix (nr, 1, nel);
389
390 octave_idx_type ii = 0;
391 result.xcidx (0) = 0;
392 result.xcidx (1) = nel;
393 for (octave_idx_type j = 0; j < nr; j++)
394 {
395 if (idx_arg(j) == -1)
396 {
397 idx_arg(j) = 0;
398 result.xdata (ii) = octave_NaN;
399 result.xridx (ii++) = j;
400 }
401 else
402 {
403 double tmp = elem (j, idx_arg(j));
404 if (tmp != 0.)
405 {
406 result.xdata (ii) = tmp;
407 result.xridx (ii++) = j;
408 }
409 }
410 }
411 }
412
413 return result;
414 }
415
416 SparseMatrix
417 SparseMatrix::min (int dim) const
418 {
419 Array<octave_idx_type> dummy_idx;
420 return min (dummy_idx, dim);
421 }
422
423 SparseMatrix
424 SparseMatrix::min (Array<octave_idx_type>& idx_arg, int dim) const
425 {
426 SparseMatrix result;
427 dim_vector dv = dims ();
428
429 if (dv.numel () == 0 || dim >= dv.length ())
430 return result;
431
432 if (dim < 0)
433 dim = dv.first_non_singleton ();
434
435 octave_idx_type nr = dv(0);
436 octave_idx_type nc = dv(1);
437
438 if (dim == 0)
439 {
440 idx_arg.clear (1, nc);
441 octave_idx_type nel = 0;
442 for (octave_idx_type j = 0; j < nc; j++)
443 {
444 double tmp_min = octave_NaN;
445 octave_idx_type idx_j = 0;
446 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
447 {
448 if (ridx (i) != idx_j)
449 break;
450 else
451 idx_j++;
452 }
453
454 if (idx_j != nr)
455 tmp_min = 0.;
456
457 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
458 {
459 double tmp = data (i);
460
461 if (xisnan (tmp))
462 continue;
463 else if (xisnan (tmp_min) || tmp < tmp_min)
464 {
465 idx_j = ridx (i);
466 tmp_min = tmp;
467 }
468
469 }
470
471 idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_j;
472 if (tmp_min != 0.)
473 nel++;
474 }
475
476 result = SparseMatrix (1, nc, nel);
477
478 octave_idx_type ii = 0;
479 result.xcidx (0) = 0;
480 for (octave_idx_type j = 0; j < nc; j++)
481 {
482 double tmp = elem (idx_arg(j), j);
483 if (tmp != 0.)
484 {
485 result.xdata (ii) = tmp;
486 result.xridx (ii++) = 0;
487 }
488 result.xcidx (j+1) = ii;
489
490 }
491 }
492 else
493 {
494 idx_arg.resize (dim_vector (nr, 1), 0);
495
496 for (octave_idx_type i = cidx (0); i < cidx (1); i++)
497 idx_arg.elem (ridx (i)) = -1;
498
499 for (octave_idx_type j = 0; j < nc; j++)
500 for (octave_idx_type i = 0; i < nr; i++)
501 {
502 if (idx_arg.elem (i) != -1)
503 continue;
504 bool found = false;
505 for (octave_idx_type k = cidx (j); k < cidx (j+1); k++)
506 if (ridx (k) == i)
507 {
508 found = true;
509 break;
510 }
511
512 if (!found)
513 idx_arg.elem (i) = j;
514
515 }
516
517 for (octave_idx_type j = 0; j < nc; j++)
518 {
519 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
520 {
521 octave_idx_type ir = ridx (i);
522 octave_idx_type ix = idx_arg.elem (ir);
523 double tmp = data (i);
524
525 if (xisnan (tmp))
526 continue;
527 else if (ix == -1 || tmp < elem (ir, ix))
528 idx_arg.elem (ir) = j;
529 }
530 }
531
532 octave_idx_type nel = 0;
533 for (octave_idx_type j = 0; j < nr; j++)
534 if (idx_arg.elem (j) == -1 || elem (j, idx_arg.elem (j)) != 0.)
535 nel++;
536
537 result = SparseMatrix (nr, 1, nel);
538
539 octave_idx_type ii = 0;
540 result.xcidx (0) = 0;
541 result.xcidx (1) = nel;
542 for (octave_idx_type j = 0; j < nr; j++)
543 {
544 if (idx_arg(j) == -1)
545 {
546 idx_arg(j) = 0;
547 result.xdata (ii) = octave_NaN;
548 result.xridx (ii++) = j;
549 }
550 else
551 {
552 double tmp = elem (j, idx_arg(j));
553 if (tmp != 0.)
554 {
555 result.xdata (ii) = tmp;
556 result.xridx (ii++) = j;
557 }
558 }
559 }
560 }
561
562 return result;
563 }
564
565 RowVector
566 SparseMatrix::row (octave_idx_type i) const
567 {
568 octave_idx_type nc = columns ();
569 RowVector retval (nc, 0);
570
571 for (octave_idx_type j = 0; j < nc; j++)
572 for (octave_idx_type k = cidx (j); k < cidx (j+1); k++)
573 {
574 if (ridx (k) == i)
575 {
576 retval(j) = data (k);
577 break;
578 }
579 }
580
581 return retval;
582 }
583
584 ColumnVector
585 SparseMatrix::column (octave_idx_type i) const
586 {
587 octave_idx_type nr = rows ();
588 ColumnVector retval (nr, 0);
589
590 for (octave_idx_type k = cidx (i); k < cidx (i+1); k++)
591 retval(ridx (k)) = data (k);
592
593 return retval;
594 }
595
596 SparseMatrix
597 SparseMatrix::concat (const SparseMatrix& rb, const Array<octave_idx_type>& ra_idx)
598 {
599 // Don't use numel to avoid all possiblity of an overflow
600 if (rb.rows () > 0 && rb.cols () > 0)
601 insert (rb, ra_idx(0), ra_idx(1));
602 return *this;
603 }
604
605 SparseComplexMatrix
606 SparseMatrix::concat (const SparseComplexMatrix& rb, const Array<octave_idx_type>& ra_idx)
607 {
608 SparseComplexMatrix retval (*this);
609 if (rb.rows () > 0 && rb.cols () > 0)
610 retval.insert (rb, ra_idx(0), ra_idx(1));
611 return retval;
612 }
613
614 SparseMatrix
615 real (const SparseComplexMatrix& a)
616 {
617 octave_idx_type nr = a.rows ();
618 octave_idx_type nc = a.cols ();
619 octave_idx_type nz = a.nnz ();
620 SparseMatrix r (nr, nc, nz);
621
622 for (octave_idx_type i = 0; i < nc +1; i++)
623 r.cidx (i) = a.cidx (i);
624
625 for (octave_idx_type i = 0; i < nz; i++)
626 {
627 r.data (i) = std::real (a.data (i));
628 r.ridx (i) = a.ridx (i);
629 }
630
631 return r;
632 }
633
634 SparseMatrix
635 imag (const SparseComplexMatrix& a)
636 {
637 octave_idx_type nr = a.rows ();
638 octave_idx_type nc = a.cols ();
639 octave_idx_type nz = a.nnz ();
640 SparseMatrix r (nr, nc, nz);
641
642 for (octave_idx_type i = 0; i < nc +1; i++)
643 r.cidx (i) = a.cidx (i);
644
645 for (octave_idx_type i = 0; i < nz; i++)
646 {
647 r.data (i) = std::imag (a.data (i));
648 r.ridx (i) = a.ridx (i);
649 }
650
651 return r;
652 }
653
654 SparseMatrix
655 atan2 (const double& x, const SparseMatrix& y)
656 {
657 octave_idx_type nr = y.rows ();
658 octave_idx_type nc = y.cols ();
659
660 if (x == 0.)
661 return SparseMatrix (nr, nc);
662 else
663 {
664 // Its going to be basically full, so this is probably the
665 // best way to handle it.
666 Matrix tmp (nr, nc, atan2 (x, 0.));
667
668 for (octave_idx_type j = 0; j < nc; j++)
669 for (octave_idx_type i = y.cidx (j); i < y.cidx (j+1); i++)
670 tmp.elem (y.ridx (i), j) = atan2 (x, y.data (i));
671
672 return SparseMatrix (tmp);
673 }
674 }
675
676 SparseMatrix
677 atan2 (const SparseMatrix& x, const double& y)
678 {
679 octave_idx_type nr = x.rows ();
680 octave_idx_type nc = x.cols ();
681 octave_idx_type nz = x.nnz ();
682
683 SparseMatrix retval (nr, nc, nz);
684
685 octave_idx_type ii = 0;
686 retval.xcidx (0) = 0;
687 for (octave_idx_type i = 0; i < nc; i++)
688 {
689 for (octave_idx_type j = x.cidx (i); j < x.cidx (i+1); j++)
690 {
691 double tmp = atan2 (x.data (j), y);
692 if (tmp != 0.)
693 {
694 retval.xdata (ii) = tmp;
695 retval.xridx (ii++) = x.ridx (j);
696 }
697 }
698 retval.xcidx (i+1) = ii;
699 }
700
701 if (ii != nz)
702 {
703 SparseMatrix retval2 (nr, nc, ii);
704 for (octave_idx_type i = 0; i < nc+1; i++)
705 retval2.xcidx (i) = retval.cidx (i);
706 for (octave_idx_type i = 0; i < ii; i++)
707 {
708 retval2.xdata (i) = retval.data (i);
709 retval2.xridx (i) = retval.ridx (i);
710 }
711 return retval2;
712 }
713 else
714 return retval;
715 }
716
717 SparseMatrix
718 atan2 (const SparseMatrix& x, const SparseMatrix& y)
719 {
720 SparseMatrix r;
721
722 if ((x.rows () == y.rows ()) && (x.cols () == y.cols ()))
723 {
724 octave_idx_type x_nr = x.rows ();
725 octave_idx_type x_nc = x.cols ();
726
727 octave_idx_type y_nr = y.rows ();
728 octave_idx_type y_nc = y.cols ();
729
730 if (x_nr != y_nr || x_nc != y_nc)
731 gripe_nonconformant ("atan2", x_nr, x_nc, y_nr, y_nc);
732 else
733 {
734 r = SparseMatrix (x_nr, x_nc, (x.nnz () + y.nnz ()));
735
736 octave_idx_type jx = 0;
737 r.cidx (0) = 0;
738 for (octave_idx_type i = 0 ; i < x_nc ; i++)
739 {
740 octave_idx_type ja = x.cidx (i);
741 octave_idx_type ja_max = x.cidx (i+1);
742 bool ja_lt_max= ja < ja_max;
743
744 octave_idx_type jb = y.cidx (i);
745 octave_idx_type jb_max = y.cidx (i+1);
746 bool jb_lt_max = jb < jb_max;
747
748 while (ja_lt_max || jb_lt_max )
749 {
750 octave_quit ();
751 if ((! jb_lt_max) ||
752 (ja_lt_max && (x.ridx (ja) < y.ridx (jb))))
753 {
754 r.ridx (jx) = x.ridx (ja);
755 r.data (jx) = atan2 (x.data (ja), 0.);
756 jx++;
757 ja++;
758 ja_lt_max= ja < ja_max;
759 }
760 else if (( !ja_lt_max ) ||
761 (jb_lt_max && (y.ridx (jb) < x.ridx (ja)) ) )
762 {
763 jb++;
764 jb_lt_max= jb < jb_max;
765 }
766 else
767 {
768 double tmp = atan2 (x.data (ja), y.data (jb));
769 if (tmp != 0.)
770 {
771 r.data (jx) = tmp;
772 r.ridx (jx) = x.ridx (ja);
773 jx++;
774 }
775 ja++;
776 ja_lt_max= ja < ja_max;
777 jb++;
778 jb_lt_max= jb < jb_max;
779 }
780 }
781 r.cidx (i+1) = jx;
782 }
783
784 r.maybe_compress ();
785 }
786 }
787 else
788 (*current_liboctave_error_handler) ("matrix size mismatch");
789
790 return r;
791 }
792
793 SparseMatrix
794 SparseMatrix::inverse (void) const
795 {
796 octave_idx_type info;
797 double rcond;
798 MatrixType mattype (*this);
799 return inverse (mattype, info, rcond, 0, 0);
800 }
801
802 SparseMatrix
803 SparseMatrix::inverse (MatrixType& mattype) const
804 {
805 octave_idx_type info;
806 double rcond;
807 return inverse (mattype, info, rcond, 0, 0);
808 }
809
810 SparseMatrix
811 SparseMatrix::inverse (MatrixType& mattype, octave_idx_type& info) const
812 {
813 double rcond;
814 return inverse (mattype, info, rcond, 0, 0);
815 }
816
817 SparseMatrix
818 SparseMatrix::dinverse (MatrixType &mattyp, octave_idx_type& info,
819 double& rcond, const bool,
820 const bool calccond) const
821 {
822 SparseMatrix retval;
823
824 octave_idx_type nr = rows ();
825 octave_idx_type nc = cols ();
826 info = 0;
827
828 if (nr == 0 || nc == 0 || nr != nc)
829 (*current_liboctave_error_handler) ("inverse requires square matrix");
830 else
831 {
832 // Print spparms("spumoni") info if requested
833 int typ = mattyp.type ();
834 mattyp.info ();
835
836 if (typ == MatrixType::Diagonal ||
837 typ == MatrixType::Permuted_Diagonal)
838 {
839 if (typ == MatrixType::Permuted_Diagonal)
840 retval = transpose ();
841 else
842 retval = *this;
843
844 // Force make_unique to be called
845 double *v = retval.data ();
846
847 if (calccond)
848 {
849 double dmax = 0., dmin = octave_Inf;
850 for (octave_idx_type i = 0; i < nr; i++)
851 {
852 double tmp = fabs (v[i]);
853 if (tmp > dmax)
854 dmax = tmp;
855 if (tmp < dmin)
856 dmin = tmp;
857 }
858 rcond = dmin / dmax;
859 }
860
861 for (octave_idx_type i = 0; i < nr; i++)
862 v[i] = 1.0 / v[i];
863 }
864 else
865 (*current_liboctave_error_handler) ("incorrect matrix type");
866 }
867
868 return retval;
869 }
870
871 SparseMatrix
872 SparseMatrix::tinverse (MatrixType &mattyp, octave_idx_type& info,
873 double& rcond, const bool,
874 const bool calccond) const
875 {
876 SparseMatrix retval;
877
878 octave_idx_type nr = rows ();
879 octave_idx_type nc = cols ();
880 info = 0;
881
882 if (nr == 0 || nc == 0 || nr != nc)
883 (*current_liboctave_error_handler) ("inverse requires square matrix");
884 else
885 {
886 // Print spparms("spumoni") info if requested
887 int typ = mattyp.type ();
888 mattyp.info ();
889
890 if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper ||
891 typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower)
892 {
893 double anorm = 0.;
894 double ainvnorm = 0.;
895
896 if (calccond)
897 {
898 // Calculate the 1-norm of matrix for rcond calculation
899 for (octave_idx_type j = 0; j < nr; j++)
900 {
901 double atmp = 0.;
902 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
903 atmp += fabs (data (i));
904 if (atmp > anorm)
905 anorm = atmp;
906 }
907 }
908
909 if (typ == MatrixType::Upper || typ == MatrixType::Lower)
910 {
911 octave_idx_type nz = nnz ();
912 octave_idx_type cx = 0;
913 octave_idx_type nz2 = nz;
914 retval = SparseMatrix (nr, nc, nz2);
915
916 for (octave_idx_type i = 0; i < nr; i++)
917 {
918 octave_quit ();
919 // place the 1 in the identity position
920 octave_idx_type cx_colstart = cx;
921
922 if (cx == nz2)
923 {
924 nz2 *= 2;
925 retval.change_capacity (nz2);
926 }
927
928 retval.xcidx (i) = cx;
929 retval.xridx (cx) = i;
930 retval.xdata (cx) = 1.0;
931 cx++;
932
933 // iterate accross columns of input matrix
934 for (octave_idx_type j = i+1; j < nr; j++)
935 {
936 double v = 0.;
937 // iterate to calculate sum
938 octave_idx_type colXp = retval.xcidx (i);
939 octave_idx_type colUp = cidx (j);
940 octave_idx_type rpX, rpU;
941
942 if (cidx (j) == cidx (j+1))
943 {
944 (*current_liboctave_error_handler)
945 ("division by zero");
946 goto inverse_singular;
947 }
948
949 do
950 {
951 octave_quit ();
952 rpX = retval.xridx (colXp);
953 rpU = ridx (colUp);
954
955 if (rpX < rpU)
956 colXp++;
957 else if (rpX > rpU)
958 colUp++;
959 else
960 {
961 v -= retval.xdata (colXp) * data (colUp);
962 colXp++;
963 colUp++;
964 }
965 } while ((rpX<j) && (rpU<j) &&
966 (colXp<cx) && (colUp<nz));
967
968 // get A(m,m)
969 if (typ == MatrixType::Upper)
970 colUp = cidx (j+1) - 1;
971 else
972 colUp = cidx (j);
973 double pivot = data (colUp);
974 if (pivot == 0. || ridx (colUp) != j)
975 {
976 (*current_liboctave_error_handler)
977 ("division by zero");
978 goto inverse_singular;
979 }
980
981 if (v != 0.)
982 {
983 if (cx == nz2)
984 {
985 nz2 *= 2;
986 retval.change_capacity (nz2);
987 }
988
989 retval.xridx (cx) = j;
990 retval.xdata (cx) = v / pivot;
991 cx++;
992 }
993 }
994
995 // get A(m,m)
996 octave_idx_type colUp;
997 if (typ == MatrixType::Upper)
998 colUp = cidx (i+1) - 1;
999 else
1000 colUp = cidx (i);
1001 double pivot = data (colUp);
1002 if (pivot == 0. || ridx (colUp) != i)
1003 {
1004 (*current_liboctave_error_handler) ("division by zero");
1005 goto inverse_singular;
1006 }
1007
1008 if (pivot != 1.0)
1009 for (octave_idx_type j = cx_colstart; j < cx; j++)
1010 retval.xdata (j) /= pivot;
1011 }
1012 retval.xcidx (nr) = cx;
1013 retval.maybe_compress ();
1014 }
1015 else
1016 {
1017 octave_idx_type nz = nnz ();
1018 octave_idx_type cx = 0;
1019 octave_idx_type nz2 = nz;
1020 retval = SparseMatrix (nr, nc, nz2);
1021
1022 OCTAVE_LOCAL_BUFFER (double, work, nr);
1023 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nr);
1024
1025 octave_idx_type *perm = mattyp.triangular_perm ();
1026 if (typ == MatrixType::Permuted_Upper)
1027 {
1028 for (octave_idx_type i = 0; i < nr; i++)
1029 rperm[perm[i]] = i;
1030 }
1031 else
1032 {
1033 for (octave_idx_type i = 0; i < nr; i++)
1034 rperm[i] = perm[i];
1035 for (octave_idx_type i = 0; i < nr; i++)
1036 perm[rperm[i]] = i;
1037 }
1038
1039 for (octave_idx_type i = 0; i < nr; i++)
1040 {
1041 octave_quit ();
1042 octave_idx_type iidx = rperm[i];
1043
1044 for (octave_idx_type j = 0; j < nr; j++)
1045 work[j] = 0.;
1046
1047 // place the 1 in the identity position
1048 work[iidx] = 1.0;
1049
1050 // iterate accross columns of input matrix
1051 for (octave_idx_type j = iidx+1; j < nr; j++)
1052 {
1053 double v = 0.;
1054 octave_idx_type jidx = perm[j];
1055 // iterate to calculate sum
1056 for (octave_idx_type k = cidx (jidx);
1057 k < cidx (jidx+1); k++)
1058 {
1059 octave_quit ();
1060 v -= work[ridx (k)] * data (k);
1061 }
1062
1063 // get A(m,m)
1064 double pivot;
1065 if (typ == MatrixType::Permuted_Upper)
1066 pivot = data (cidx (jidx+1) - 1);
1067 else
1068 pivot = data (cidx (jidx));
1069 if (pivot == 0.)
1070 {
1071 (*current_liboctave_error_handler)
1072 ("division by zero");
1073 goto inverse_singular;
1074 }
1075
1076 work[j] = v / pivot;
1077 }
1078
1079 // get A(m,m)
1080 octave_idx_type colUp;
1081 if (typ == MatrixType::Permuted_Upper)
1082 colUp = cidx (perm[iidx]+1) - 1;
1083 else
1084 colUp = cidx (perm[iidx]);
1085
1086 double pivot = data (colUp);
1087 if (pivot == 0.)
1088 {
1089 (*current_liboctave_error_handler)
1090 ("division by zero");
1091 goto inverse_singular;
1092 }
1093
1094 octave_idx_type new_cx = cx;
1095 for (octave_idx_type j = iidx; j < nr; j++)
1096 if (work[j] != 0.0)
1097 {
1098 new_cx++;
1099 if (pivot != 1.0)
1100 work[j] /= pivot;
1101 }
1102
1103 if (cx < new_cx)
1104 {
1105 nz2 = (2*nz2 < new_cx ? new_cx : 2*nz2);
1106 retval.change_capacity (nz2);
1107 }
1108
1109 retval.xcidx (i) = cx;
1110 for (octave_idx_type j = iidx; j < nr; j++)
1111 if (work[j] != 0.)
1112 {
1113 retval.xridx (cx) = j;
1114 retval.xdata (cx++) = work[j];
1115 }
1116 }
1117
1118 retval.xcidx (nr) = cx;
1119 retval.maybe_compress ();
1120 }
1121
1122 if (calccond)
1123 {
1124 // Calculate the 1-norm of inverse matrix for rcond calculation
1125 for (octave_idx_type j = 0; j < nr; j++)
1126 {
1127 double atmp = 0.;
1128 for (octave_idx_type i = retval.cidx (j);
1129 i < retval.cidx (j+1); i++)
1130 atmp += fabs (retval.data (i));
1131 if (atmp > ainvnorm)
1132 ainvnorm = atmp;
1133 }
1134
1135 rcond = 1. / ainvnorm / anorm;
1136 }
1137 }
1138 else
1139 (*current_liboctave_error_handler) ("incorrect matrix type");
1140 }
1141
1142 return retval;
1143
1144 inverse_singular:
1145 return SparseMatrix ();
1146 }
1147
1148 SparseMatrix
1149 SparseMatrix::inverse (MatrixType &mattype, octave_idx_type& info,
1150 double& rcond, int, int calc_cond) const
1151 {
1152 int typ = mattype.type (false);
1153 SparseMatrix ret;
1154
1155 if (typ == MatrixType::Unknown)
1156 typ = mattype.type (*this);
1157
1158 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal)
1159 ret = dinverse (mattype, info, rcond, true, calc_cond);
1160 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper)
1161 ret = tinverse (mattype, info, rcond, true, calc_cond).transpose ();
1162 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower)
1163 {
1164 MatrixType newtype = mattype.transpose ();
1165 ret = transpose ().tinverse (newtype, info, rcond, true, calc_cond);
1166 }
1167 else
1168 {
1169 if (mattype.is_hermitian ())
1170 {
1171 MatrixType tmp_typ (MatrixType::Upper);
1172 SparseCHOL fact (*this, info, false);
1173 rcond = fact.rcond ();
1174 if (info == 0)
1175 {
1176 double rcond2;
1177 SparseMatrix Q = fact.Q ();
1178 SparseMatrix InvL = fact.L ().transpose ().tinverse (tmp_typ,
1179 info, rcond2, true, false);
1180 ret = Q * InvL.transpose () * InvL * Q.transpose ();
1181 }
1182 else
1183 {
1184 // Matrix is either singular or not positive definite
1185 mattype.mark_as_unsymmetric ();
1186 typ = MatrixType::Full;
1187 }
1188 }
1189
1190 if (!mattype.is_hermitian ())
1191 {
1192 octave_idx_type n = rows ();
1193 ColumnVector Qinit(n);
1194 for (octave_idx_type i = 0; i < n; i++)
1195 Qinit(i) = i;
1196
1197 MatrixType tmp_typ (MatrixType::Upper);
1198 SparseLU fact (*this, Qinit, Matrix (), false, false);
1199 rcond = fact.rcond ();
1200 double rcond2;
1201 SparseMatrix InvL = fact.L ().transpose ().tinverse (tmp_typ,
1202 info, rcond2, true, false);
1203 SparseMatrix InvU = fact.U ().tinverse (tmp_typ, info, rcond2,
1204 true, false).transpose ();
1205 ret = fact.Pc ().transpose () * InvU * InvL * fact.Pr ();
1206 }
1207 }
1208
1209 return ret;
1210 }
1211
1212 DET
1213 SparseMatrix::determinant (void) const
1214 {
1215 octave_idx_type info;
1216 double rcond;
1217 return determinant (info, rcond, 0);
1218 }
1219
1220 DET
1221 SparseMatrix::determinant (octave_idx_type& info) const
1222 {
1223 double rcond;
1224 return determinant (info, rcond, 0);
1225 }
1226
1227 DET
1228 SparseMatrix::determinant (octave_idx_type& err, double& rcond, int) const
1229 {
1230 DET retval;
1231
1232 #ifdef HAVE_UMFPACK
1233 octave_idx_type nr = rows ();
1234 octave_idx_type nc = cols ();
1235
1236 if (nr == 0 || nc == 0 || nr != nc)
1237 {
1238 retval = DET (1.0);
1239 }
1240 else
1241 {
1242 err = 0;
1243
1244 // Setup the control parameters
1245 Matrix Control (UMFPACK_CONTROL, 1);
1246 double *control = Control.fortran_vec ();
1247 UMFPACK_DNAME (defaults) (control);
1248
1249 double tmp = octave_sparse_params::get_key ("spumoni");
1250 if (!xisnan (tmp))
1251 Control (UMFPACK_PRL) = tmp;
1252
1253 tmp = octave_sparse_params::get_key ("piv_tol");
1254 if (!xisnan (tmp))
1255 {
1256 Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp;
1257 Control (UMFPACK_PIVOT_TOLERANCE) = tmp;
1258 }
1259
1260 // Set whether we are allowed to modify Q or not
1261 tmp = octave_sparse_params::get_key ("autoamd");
1262 if (!xisnan (tmp))
1263 Control (UMFPACK_FIXQ) = tmp;
1264
1265 // Turn-off UMFPACK scaling for LU
1266 Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE;
1267
1268 UMFPACK_DNAME (report_control) (control);
1269
1270 const octave_idx_type *Ap = cidx ();
1271 const octave_idx_type *Ai = ridx ();
1272 const double *Ax = data ();
1273
1274 UMFPACK_DNAME (report_matrix) (nr, nc, Ap, Ai, Ax, 1, control);
1275
1276 void *Symbolic;
1277 Matrix Info (1, UMFPACK_INFO);
1278 double *info = Info.fortran_vec ();
1279 int status = UMFPACK_DNAME (qsymbolic) (nr, nc, Ap, Ai,
1280 Ax, 0, &Symbolic, control, info);
1281
1282 if (status < 0)
1283 {
1284 (*current_liboctave_error_handler)
1285 ("SparseMatrix::determinant symbolic factorization failed");
1286
1287 UMFPACK_DNAME (report_status) (control, status);
1288 UMFPACK_DNAME (report_info) (control, info);
1289
1290 UMFPACK_DNAME (free_symbolic) (&Symbolic) ;
1291 }
1292 else
1293 {
1294 UMFPACK_DNAME (report_symbolic) (Symbolic, control);
1295
1296 void *Numeric;
1297 status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic,
1298 &Numeric, control, info) ;
1299 UMFPACK_DNAME (free_symbolic) (&Symbolic) ;
1300
1301 rcond = Info (UMFPACK_RCOND);
1302
1303 if (status < 0)
1304 {
1305 (*current_liboctave_error_handler)
1306 ("SparseMatrix::determinant numeric factorization failed");
1307
1308 UMFPACK_DNAME (report_status) (control, status);
1309 UMFPACK_DNAME (report_info) (control, info);
1310
1311 UMFPACK_DNAME (free_numeric) (&Numeric);
1312 }
1313 else
1314 {
1315 UMFPACK_DNAME (report_numeric) (Numeric, control);
1316
1317 double c10, e10;
1318
1319 status = UMFPACK_DNAME (get_determinant) (&c10, &e10, Numeric, info);
1320
1321 if (status < 0)
1322 {
1323 (*current_liboctave_error_handler)
1324 ("SparseMatrix::determinant error calculating determinant");
1325
1326 UMFPACK_DNAME (report_status) (control, status);
1327 UMFPACK_DNAME (report_info) (control, info);
1328 }
1329 else
1330 retval = DET (c10, e10, 10);
1331
1332 UMFPACK_DNAME (free_numeric) (&Numeric);
1333 }
1334 }
1335 }
1336 #else
1337 (*current_liboctave_error_handler) ("UMFPACK not installed");
1338 #endif
1339
1340 return retval;
1341 }
1342
1343 Matrix
1344 SparseMatrix::dsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err,
1345 double& rcond, solve_singularity_handler,
1346 bool calc_cond) const
1347 {
1348 Matrix retval;
1349
1350 octave_idx_type nr = rows ();
1351 octave_idx_type nc = cols ();
1352 octave_idx_type nm = (nc < nr ? nc : nr);
1353 err = 0;
1354
1355 if (nr != b.rows ())
1356 (*current_liboctave_error_handler)
1357 ("matrix dimension mismatch solution of linear equations");
1358 else if (nr == 0 || nc == 0 || b.cols () == 0)
1359 retval = Matrix (nc, b.cols (), 0.0);
1360 else
1361 {
1362 // Print spparms("spumoni") info if requested
1363 int typ = mattype.type ();
1364 mattype.info ();
1365
1366 if (typ == MatrixType::Diagonal ||
1367 typ == MatrixType::Permuted_Diagonal)
1368 {
1369 retval.resize (nc, b.cols (), 0.);
1370 if (typ == MatrixType::Diagonal)
1371 for (octave_idx_type j = 0; j < b.cols (); j++)
1372 for (octave_idx_type i = 0; i < nm; i++)
1373 retval(i,j) = b(i,j) / data (i);
1374 else
1375 for (octave_idx_type j = 0; j < b.cols (); j++)
1376 for (octave_idx_type k = 0; k < nc; k++)
1377 for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
1378 retval(k,j) = b(ridx (i),j) / data (i);
1379
1380 if (calc_cond)
1381 {
1382 double dmax = 0., dmin = octave_Inf;
1383 for (octave_idx_type i = 0; i < nm; i++)
1384 {
1385 double tmp = fabs (data (i));
1386 if (tmp > dmax)
1387 dmax = tmp;
1388 if (tmp < dmin)
1389 dmin = tmp;
1390 }
1391 rcond = dmin / dmax;
1392 }
1393 else
1394 rcond = 1.;
1395 }
1396 else
1397 (*current_liboctave_error_handler) ("incorrect matrix type");
1398 }
1399
1400 return retval;
1401 }
1402
1403 SparseMatrix
1404 SparseMatrix::dsolve (MatrixType &mattype, const SparseMatrix& b,
1405 octave_idx_type& err, double& rcond,
1406 solve_singularity_handler, bool calc_cond) const
1407 {
1408 SparseMatrix retval;
1409
1410 octave_idx_type nr = rows ();
1411 octave_idx_type nc = cols ();
1412 octave_idx_type nm = (nc < nr ? nc : nr);
1413 err = 0;
1414
1415 if (nr != b.rows ())
1416 (*current_liboctave_error_handler)
1417 ("matrix dimension mismatch solution of linear equations");
1418 else if (nr == 0 || nc == 0 || b.cols () == 0)
1419 retval = SparseMatrix (nc, b.cols ());
1420 else
1421 {
1422 // Print spparms("spumoni") info if requested
1423 int typ = mattype.type ();
1424 mattype.info ();
1425
1426 if (typ == MatrixType::Diagonal ||
1427 typ == MatrixType::Permuted_Diagonal)
1428 {
1429 octave_idx_type b_nc = b.cols ();
1430 octave_idx_type b_nz = b.nnz ();
1431 retval = SparseMatrix (nc, b_nc, b_nz);
1432
1433 retval.xcidx (0) = 0;
1434 octave_idx_type ii = 0;
1435 if (typ == MatrixType::Diagonal)
1436 for (octave_idx_type j = 0; j < b_nc; j++)
1437 {
1438 for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
1439 {
1440 if (b.ridx (i) >= nm)
1441 break;
1442 retval.xridx (ii) = b.ridx (i);
1443 retval.xdata (ii++) = b.data (i) / data (b.ridx (i));
1444 }
1445 retval.xcidx (j+1) = ii;
1446 }
1447 else
1448 for (octave_idx_type j = 0; j < b_nc; j++)
1449 {
1450 for (octave_idx_type l = 0; l < nc; l++)
1451 for (octave_idx_type i = cidx (l); i < cidx (l+1); i++)
1452 {
1453 bool found = false;
1454 octave_idx_type k;
1455 for (k = b.cidx (j); k < b.cidx (j+1); k++)
1456 if (ridx (i) == b.ridx (k))
1457 {
1458 found = true;
1459 break;
1460 }
1461 if (found)
1462 {
1463 retval.xridx (ii) = l;
1464 retval.xdata (ii++) = b.data (k) / data (i);
1465 }
1466 }
1467 retval.xcidx (j+1) = ii;
1468 }
1469
1470 if (calc_cond)
1471 {
1472 double dmax = 0., dmin = octave_Inf;
1473 for (octave_idx_type i = 0; i < nm; i++)
1474 {
1475 double tmp = fabs (data (i));
1476 if (tmp > dmax)
1477 dmax = tmp;
1478 if (tmp < dmin)
1479 dmin = tmp;
1480 }
1481 rcond = dmin / dmax;
1482 }
1483 else
1484 rcond = 1.;
1485 }
1486 else
1487 (*current_liboctave_error_handler) ("incorrect matrix type");
1488 }
1489
1490 return retval;
1491 }
1492
1493 ComplexMatrix
1494 SparseMatrix::dsolve (MatrixType &mattype, const ComplexMatrix& b,
1495 octave_idx_type& err, double& rcond,
1496 solve_singularity_handler, bool calc_cond) const
1497 {
1498 ComplexMatrix retval;
1499
1500 octave_idx_type nr = rows ();
1501 octave_idx_type nc = cols ();
1502 octave_idx_type nm = (nc < nr ? nc : nr);
1503 err = 0;
1504
1505 if (nr != b.rows ())
1506 (*current_liboctave_error_handler)
1507 ("matrix dimension mismatch solution of linear equations");
1508 else if (nr == 0 || nc == 0 || b.cols () == 0)
1509 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
1510 else
1511 {
1512 // Print spparms("spumoni") info if requested
1513 int typ = mattype.type ();
1514 mattype.info ();
1515
1516 if (typ == MatrixType::Diagonal ||
1517 typ == MatrixType::Permuted_Diagonal)
1518 {
1519 retval.resize (nc, b.cols (), 0);
1520 if (typ == MatrixType::Diagonal)
1521 for (octave_idx_type j = 0; j < b.cols (); j++)
1522 for (octave_idx_type i = 0; i < nm; i++)
1523 retval(i,j) = b(i,j) / data (i);
1524 else
1525 for (octave_idx_type j = 0; j < b.cols (); j++)
1526 for (octave_idx_type k = 0; k < nc; k++)
1527 for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
1528 retval(k,j) = b(ridx (i),j) / data (i);
1529
1530 if (calc_cond)
1531 {
1532 double dmax = 0., dmin = octave_Inf;
1533 for (octave_idx_type i = 0; i < nm; i++)
1534 {
1535 double tmp = fabs (data (i));
1536 if (tmp > dmax)
1537 dmax = tmp;
1538 if (tmp < dmin)
1539 dmin = tmp;
1540 }
1541 rcond = dmin / dmax;
1542 }
1543 else
1544 rcond = 1.;
1545 }
1546 else
1547 (*current_liboctave_error_handler) ("incorrect matrix type");
1548 }
1549
1550 return retval;
1551 }
1552
1553 SparseComplexMatrix
1554 SparseMatrix::dsolve (MatrixType &mattype, const SparseComplexMatrix& b,
1555 octave_idx_type& err, double& rcond,
1556 solve_singularity_handler, bool calc_cond) const
1557 {
1558 SparseComplexMatrix retval;
1559
1560 octave_idx_type nr = rows ();
1561 octave_idx_type nc = cols ();
1562 octave_idx_type nm = (nc < nr ? nc : nr);
1563 err = 0;
1564
1565 if (nr != b.rows ())
1566 (*current_liboctave_error_handler)
1567 ("matrix dimension mismatch solution of linear equations");
1568 else if (nr == 0 || nc == 0 || b.cols () == 0)
1569 retval = SparseComplexMatrix (nc, b.cols ());
1570 else
1571 {
1572 // Print spparms("spumoni") info if requested
1573 int typ = mattype.type ();
1574 mattype.info ();
1575
1576 if (typ == MatrixType::Diagonal ||
1577 typ == MatrixType::Permuted_Diagonal)
1578 {
1579 octave_idx_type b_nc = b.cols ();
1580 octave_idx_type b_nz = b.nnz ();
1581 retval = SparseComplexMatrix (nc, b_nc, b_nz);
1582
1583 retval.xcidx (0) = 0;
1584 octave_idx_type ii = 0;
1585 if (typ == MatrixType::Diagonal)
1586 for (octave_idx_type j = 0; j < b.cols (); j++)
1587 {
1588 for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
1589 {
1590 if (b.ridx (i) >= nm)
1591 break;
1592 retval.xridx (ii) = b.ridx (i);
1593 retval.xdata (ii++) = b.data (i) / data (b.ridx (i));
1594 }
1595 retval.xcidx (j+1) = ii;
1596 }
1597 else
1598 for (octave_idx_type j = 0; j < b.cols (); j++)
1599 {
1600 for (octave_idx_type l = 0; l < nc; l++)
1601 for (octave_idx_type i = cidx (l); i < cidx (l+1); i++)
1602 {
1603 bool found = false;
1604 octave_idx_type k;
1605 for (k = b.cidx (j); k < b.cidx (j+1); k++)
1606 if (ridx (i) == b.ridx (k))
1607 {
1608 found = true;
1609 break;
1610 }
1611 if (found)
1612 {
1613 retval.xridx (ii) = l;
1614 retval.xdata (ii++) = b.data (k) / data (i);
1615 }
1616 }
1617 retval.xcidx (j+1) = ii;
1618 }
1619
1620 if (calc_cond)
1621 {
1622 double dmax = 0., dmin = octave_Inf;
1623 for (octave_idx_type i = 0; i < nm; i++)
1624 {
1625 double tmp = fabs (data (i));
1626 if (tmp > dmax)
1627 dmax = tmp;
1628 if (tmp < dmin)
1629 dmin = tmp;
1630 }
1631 rcond = dmin / dmax;
1632 }
1633 else
1634 rcond = 1.;
1635 }
1636 else
1637 (*current_liboctave_error_handler) ("incorrect matrix type");
1638 }
1639
1640 return retval;
1641 }
1642
1643 Matrix
1644 SparseMatrix::utsolve (MatrixType &mattype, const Matrix& b,
1645 octave_idx_type& err, double& rcond,
1646 solve_singularity_handler sing_handler,
1647 bool calc_cond) const
1648 {
1649 Matrix retval;
1650
1651 octave_idx_type nr = rows ();
1652 octave_idx_type nc = cols ();
1653 octave_idx_type nm = (nc > nr ? nc : nr);
1654 err = 0;
1655
1656 if (nr != b.rows ())
1657 (*current_liboctave_error_handler)
1658 ("matrix dimension mismatch solution of linear equations");
1659 else if (nr == 0 || nc == 0 || b.cols () == 0)
1660 retval = Matrix (nc, b.cols (), 0.0);
1661 else
1662 {
1663 // Print spparms("spumoni") info if requested
1664 int typ = mattype.type ();
1665 mattype.info ();
1666
1667 if (typ == MatrixType::Permuted_Upper ||
1668 typ == MatrixType::Upper)
1669 {
1670 double anorm = 0.;
1671 double ainvnorm = 0.;
1672 octave_idx_type b_nc = b.cols ();
1673 rcond = 1.;
1674
1675 if (calc_cond)
1676 {
1677 // Calculate the 1-norm of matrix for rcond calculation
1678 for (octave_idx_type j = 0; j < nc; j++)
1679 {
1680 double atmp = 0.;
1681 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
1682 atmp += fabs (data (i));
1683 if (atmp > anorm)
1684 anorm = atmp;
1685 }
1686 }
1687
1688 if (typ == MatrixType::Permuted_Upper)
1689 {
1690 retval.resize (nc, b_nc);
1691 octave_idx_type *perm = mattype.triangular_perm ();
1692 OCTAVE_LOCAL_BUFFER (double, work, nm);
1693
1694 for (octave_idx_type j = 0; j < b_nc; j++)
1695 {
1696 for (octave_idx_type i = 0; i < nr; i++)
1697 work[i] = b(i,j);
1698 for (octave_idx_type i = nr; i < nc; i++)
1699 work[i] = 0.;
1700
1701 for (octave_idx_type k = nc-1; k >= 0; k--)
1702 {
1703 octave_idx_type kidx = perm[k];
1704
1705 if (work[k] != 0.)
1706 {
1707 if (ridx (cidx (kidx+1)-1) != k ||
1708 data (cidx (kidx+1)-1) == 0.)
1709 {
1710 err = -2;
1711 goto triangular_error;
1712 }
1713
1714 double tmp = work[k] / data (cidx (kidx+1)-1);
1715 work[k] = tmp;
1716 for (octave_idx_type i = cidx (kidx);
1717 i < cidx (kidx+1)-1; i++)
1718 {
1719 octave_idx_type iidx = ridx (i);
1720 work[iidx] = work[iidx] - tmp * data (i);
1721 }
1722 }
1723 }
1724
1725 for (octave_idx_type i = 0; i < nc; i++)
1726 retval.xelem (perm[i], j) = work[i];
1727 }
1728
1729 if (calc_cond)
1730 {
1731 // Calculation of 1-norm of inv(*this)
1732 for (octave_idx_type i = 0; i < nm; i++)
1733 work[i] = 0.;
1734
1735 for (octave_idx_type j = 0; j < nr; j++)
1736 {
1737 work[j] = 1.;
1738
1739 for (octave_idx_type k = j; k >= 0; k--)
1740 {
1741 octave_idx_type iidx = perm[k];
1742
1743 if (work[k] != 0.)
1744 {
1745 double tmp = work[k] / data (cidx (iidx+1)-1);
1746 work[k] = tmp;
1747 for (octave_idx_type i = cidx (iidx);
1748 i < cidx (iidx+1)-1; i++)
1749 {
1750 octave_idx_type idx2 = ridx (i);
1751 work[idx2] = work[idx2] - tmp * data (i);
1752 }
1753 }
1754 }
1755 double atmp = 0;
1756 for (octave_idx_type i = 0; i < j+1; i++)
1757 {
1758 atmp += fabs (work[i]);
1759 work[i] = 0.;
1760 }
1761 if (atmp > ainvnorm)
1762 ainvnorm = atmp;
1763 }
1764 rcond = 1. / ainvnorm / anorm;
1765 }
1766 }
1767 else
1768 {
1769 OCTAVE_LOCAL_BUFFER (double, work, nm);
1770 retval.resize (nc, b_nc);
1771
1772 for (octave_idx_type j = 0; j < b_nc; j++)
1773 {
1774 for (octave_idx_type i = 0; i < nr; i++)
1775 work[i] = b(i,j);
1776 for (octave_idx_type i = nr; i < nc; i++)
1777 work[i] = 0.;
1778
1779 for (octave_idx_type k = nc-1; k >= 0; k--)
1780 {
1781 if (work[k] != 0.)
1782 {
1783 if (ridx (cidx (k+1)-1) != k ||
1784 data (cidx (k+1)-1) == 0.)
1785 {
1786 err = -2;
1787 goto triangular_error;
1788 }
1789
1790 double tmp = work[k] / data (cidx (k+1)-1);
1791 work[k] = tmp;
1792 for (octave_idx_type i = cidx (k); i < cidx (k+1)-1; i++)
1793 {
1794 octave_idx_type iidx = ridx (i);
1795 work[iidx] = work[iidx] - tmp * data (i);
1796 }
1797 }
1798 }
1799
1800 for (octave_idx_type i = 0; i < nc; i++)
1801 retval.xelem (i, j) = work[i];
1802 }
1803
1804 if (calc_cond)
1805 {
1806 // Calculation of 1-norm of inv(*this)
1807 for (octave_idx_type i = 0; i < nm; i++)
1808 work[i] = 0.;
1809
1810 for (octave_idx_type j = 0; j < nr; j++)
1811 {
1812 work[j] = 1.;
1813
1814 for (octave_idx_type k = j; k >= 0; k--)
1815 {
1816 if (work[k] != 0.)
1817 {
1818 double tmp = work[k] / data (cidx (k+1)-1);
1819 work[k] = tmp;
1820 for (octave_idx_type i = cidx (k); i < cidx (k+1)-1; i++)
1821 {
1822 octave_idx_type iidx = ridx (i);
1823 work[iidx] = work[iidx] - tmp * data (i);
1824 }
1825 }
1826 }
1827 double atmp = 0;
1828 for (octave_idx_type i = 0; i < j+1; i++)
1829 {
1830 atmp += fabs (work[i]);
1831 work[i] = 0.;
1832 }
1833 if (atmp > ainvnorm)
1834 ainvnorm = atmp;
1835 }
1836 rcond = 1. / ainvnorm / anorm;
1837 }
1838 }
1839
1840 triangular_error:
1841 if (err != 0)
1842 {
1843 if (sing_handler)
1844 {
1845 sing_handler (rcond);
1846 mattype.mark_as_rectangular ();
1847 }
1848 else
1849 (*current_liboctave_error_handler)
1850 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g",
1851 rcond);
1852 }
1853
1854 volatile double rcond_plus_one = rcond + 1.0;
1855
1856 if (rcond_plus_one == 1.0 || xisnan (rcond))
1857 {
1858 err = -2;
1859
1860 if (sing_handler)
1861 {
1862 sing_handler (rcond);
1863 mattype.mark_as_rectangular ();
1864 }
1865 else
1866 (*current_liboctave_error_handler)
1867 ("matrix singular to machine precision, rcond = %g",
1868 rcond);
1869 }
1870 }
1871 else
1872 (*current_liboctave_error_handler) ("incorrect matrix type");
1873 }
1874
1875 return retval;
1876 }
1877
1878 SparseMatrix
1879 SparseMatrix::utsolve (MatrixType &mattype, const SparseMatrix& b,
1880 octave_idx_type& err, double& rcond,
1881 solve_singularity_handler sing_handler,
1882 bool calc_cond) const
1883 {
1884 SparseMatrix retval;
1885
1886 octave_idx_type nr = rows ();
1887 octave_idx_type nc = cols ();
1888 octave_idx_type nm = (nc > nr ? nc : nr);
1889 err = 0;
1890
1891 if (nr != b.rows ())
1892 (*current_liboctave_error_handler)
1893 ("matrix dimension mismatch solution of linear equations");
1894 else if (nr == 0 || nc == 0 || b.cols () == 0)
1895 retval = SparseMatrix (nc, b.cols ());
1896 else
1897 {
1898 // Print spparms("spumoni") info if requested
1899 int typ = mattype.type ();
1900 mattype.info ();
1901
1902 if (typ == MatrixType::Permuted_Upper ||
1903 typ == MatrixType::Upper)
1904 {
1905 double anorm = 0.;
1906 double ainvnorm = 0.;
1907 rcond = 1.;
1908
1909 if (calc_cond)
1910 {
1911 // Calculate the 1-norm of matrix for rcond calculation
1912 for (octave_idx_type j = 0; j < nc; j++)
1913 {
1914 double atmp = 0.;
1915 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
1916 atmp += fabs (data (i));
1917 if (atmp > anorm)
1918 anorm = atmp;
1919 }
1920 }
1921
1922 octave_idx_type b_nc = b.cols ();
1923 octave_idx_type b_nz = b.nnz ();
1924 retval = SparseMatrix (nc, b_nc, b_nz);
1925 retval.xcidx (0) = 0;
1926 octave_idx_type ii = 0;
1927 octave_idx_type x_nz = b_nz;
1928
1929 if (typ == MatrixType::Permuted_Upper)
1930 {
1931 octave_idx_type *perm = mattype.triangular_perm ();
1932 OCTAVE_LOCAL_BUFFER (double, work, nm);
1933
1934 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc);
1935 for (octave_idx_type i = 0; i < nc; i++)
1936 rperm[perm[i]] = i;
1937
1938 for (octave_idx_type j = 0; j < b_nc; j++)
1939 {
1940 for (octave_idx_type i = 0; i < nm; i++)
1941 work[i] = 0.;
1942 for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
1943 work[b.ridx (i)] = b.data (i);
1944
1945 for (octave_idx_type k = nc-1; k >= 0; k--)
1946 {
1947 octave_idx_type kidx = perm[k];
1948
1949 if (work[k] != 0.)
1950 {
1951 if (ridx (cidx (kidx+1)-1) != k ||
1952 data (cidx (kidx+1)-1) == 0.)
1953 {
1954 err = -2;
1955 goto triangular_error;
1956 }
1957
1958 double tmp = work[k] / data (cidx (kidx+1)-1);
1959 work[k] = tmp;
1960 for (octave_idx_type i = cidx (kidx);
1961 i < cidx (kidx+1)-1; i++)
1962 {
1963 octave_idx_type iidx = ridx (i);
1964 work[iidx] = work[iidx] - tmp * data (i);
1965 }
1966 }
1967 }
1968
1969 // Count non-zeros in work vector and adjust space in
1970 // retval if needed
1971 octave_idx_type new_nnz = 0;
1972 for (octave_idx_type i = 0; i < nc; i++)
1973 if (work[i] != 0.)
1974 new_nnz++;
1975
1976 if (ii + new_nnz > x_nz)
1977 {
1978 // Resize the sparse matrix
1979 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
1980 retval.change_capacity (sz);
1981 x_nz = sz;
1982 }
1983
1984 for (octave_idx_type i = 0; i < nc; i++)
1985 if (work[rperm[i]] != 0.)
1986 {
1987 retval.xridx (ii) = i;
1988 retval.xdata (ii++) = work[rperm[i]];
1989 }
1990 retval.xcidx (j+1) = ii;
1991 }
1992
1993 retval.maybe_compress ();
1994
1995 if (calc_cond)
1996 {
1997 // Calculation of 1-norm of inv(*this)
1998 for (octave_idx_type i = 0; i < nm; i++)
1999 work[i] = 0.;
2000
2001 for (octave_idx_type j = 0; j < nr; j++)
2002 {
2003 work[j] = 1.;
2004
2005 for (octave_idx_type k = j; k >= 0; k--)
2006 {
2007 octave_idx_type iidx = perm[k];
2008
2009 if (work[k] != 0.)
2010 {
2011 double tmp = work[k] / data (cidx (iidx+1)-1);
2012 work[k] = tmp;
2013 for (octave_idx_type i = cidx (iidx);
2014 i < cidx (iidx+1)-1; i++)
2015 {
2016 octave_idx_type idx2 = ridx (i);
2017 work[idx2] = work[idx2] - tmp * data (i);
2018 }
2019 }
2020 }
2021 double atmp = 0;
2022 for (octave_idx_type i = 0; i < j+1; i++)
2023 {
2024 atmp += fabs (work[i]);
2025 work[i] = 0.;
2026 }
2027 if (atmp > ainvnorm)
2028 ainvnorm = atmp;
2029 }
2030 rcond = 1. / ainvnorm / anorm;
2031 }
2032 }
2033 else
2034 {
2035 OCTAVE_LOCAL_BUFFER (double, work, nm);
2036
2037 for (octave_idx_type j = 0; j < b_nc; j++)
2038 {
2039 for (octave_idx_type i = 0; i < nm; i++)
2040 work[i] = 0.;
2041 for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
2042 work[b.ridx (i)] = b.data (i);
2043
2044 for (octave_idx_type k = nc-1; k >= 0; k--)
2045 {
2046 if (work[k] != 0.)
2047 {
2048 if (ridx (cidx (k+1)-1) != k ||
2049 data (cidx (k+1)-1) == 0.)
2050 {
2051 err = -2;
2052 goto triangular_error;
2053 }
2054
2055 double tmp = work[k] / data (cidx (k+1)-1);
2056 work[k] = tmp;
2057 for (octave_idx_type i = cidx (k); i < cidx (k+1)-1; i++)
2058 {
2059 octave_idx_type iidx = ridx (i);
2060 work[iidx] = work[iidx] - tmp * data (i);
2061 }
2062 }
2063 }
2064
2065 // Count non-zeros in work vector and adjust space in
2066 // retval if needed
2067 octave_idx_type new_nnz = 0;
2068 for (octave_idx_type i = 0; i < nc; i++)
2069 if (work[i] != 0.)
2070 new_nnz++;
2071
2072 if (ii + new_nnz > x_nz)
2073 {
2074 // Resize the sparse matrix
2075 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
2076 retval.change_capacity (sz);
2077 x_nz = sz;
2078 }
2079
2080 for (octave_idx_type i = 0; i < nc; i++)
2081 if (work[i] != 0.)
2082 {
2083 retval.xridx (ii) = i;
2084 retval.xdata (ii++) = work[i];
2085 }
2086 retval.xcidx (j+1) = ii;
2087 }
2088
2089 retval.maybe_compress ();
2090
2091 if (calc_cond)
2092 {
2093 // Calculation of 1-norm of inv(*this)
2094 for (octave_idx_type i = 0; i < nm; i++)
2095 work[i] = 0.;
2096
2097 for (octave_idx_type j = 0; j < nr; j++)
2098 {
2099 work[j] = 1.;
2100
2101 for (octave_idx_type k = j; k >= 0; k--)
2102 {
2103 if (work[k] != 0.)
2104 {
2105 double tmp = work[k] / data (cidx (k+1)-1);
2106 work[k] = tmp;
2107 for (octave_idx_type i = cidx (k);
2108 i < cidx (k+1)-1; i++)
2109 {
2110 octave_idx_type iidx = ridx (i);
2111 work[iidx] = work[iidx] - tmp * data (i);
2112 }
2113 }
2114 }
2115 double atmp = 0;
2116 for (octave_idx_type i = 0; i < j+1; i++)
2117 {
2118 atmp += fabs (work[i]);
2119 work[i] = 0.;
2120 }
2121 if (atmp > ainvnorm)
2122 ainvnorm = atmp;
2123 }
2124 rcond = 1. / ainvnorm / anorm;
2125 }
2126 }
2127
2128 triangular_error:
2129 if (err != 0)
2130 {
2131 if (sing_handler)
2132 {
2133 sing_handler (rcond);
2134 mattype.mark_as_rectangular ();
2135 }
2136 else
2137 (*current_liboctave_error_handler)
2138 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g",
2139 rcond);
2140 }
2141
2142 volatile double rcond_plus_one = rcond + 1.0;
2143
2144 if (rcond_plus_one == 1.0 || xisnan (rcond))
2145 {
2146 err = -2;
2147
2148 if (sing_handler)
2149 {
2150 sing_handler (rcond);
2151 mattype.mark_as_rectangular ();
2152 }
2153 else
2154 (*current_liboctave_error_handler)
2155 ("matrix singular to machine precision, rcond = %g",
2156 rcond);
2157 }
2158 }
2159 else
2160 (*current_liboctave_error_handler) ("incorrect matrix type");
2161 }
2162 return retval;
2163 }
2164
2165 ComplexMatrix
2166 SparseMatrix::utsolve (MatrixType &mattype, const ComplexMatrix& b,
2167 octave_idx_type& err, double& rcond,
2168 solve_singularity_handler sing_handler,
2169 bool calc_cond) const
2170 {
2171 ComplexMatrix retval;
2172
2173 octave_idx_type nr = rows ();
2174 octave_idx_type nc = cols ();
2175 octave_idx_type nm = (nc > nr ? nc : nr);
2176 err = 0;
2177
2178 if (nr != b.rows ())
2179 (*current_liboctave_error_handler)
2180 ("matrix dimension mismatch solution of linear equations");
2181 else if (nr == 0 || nc == 0 || b.cols () == 0)
2182 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
2183 else
2184 {
2185 // Print spparms("spumoni") info if requested
2186 int typ = mattype.type ();
2187 mattype.info ();
2188
2189 if (typ == MatrixType::Permuted_Upper ||
2190 typ == MatrixType::Upper)
2191 {
2192 double anorm = 0.;
2193 double ainvnorm = 0.;
2194 octave_idx_type b_nc = b.cols ();
2195 rcond = 1.;
2196
2197 if (calc_cond)
2198 {
2199 // Calculate the 1-norm of matrix for rcond calculation
2200 for (octave_idx_type j = 0; j < nc; j++)
2201 {
2202 double atmp = 0.;
2203 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
2204 atmp += fabs (data (i));
2205 if (atmp > anorm)
2206 anorm = atmp;
2207 }
2208 }
2209
2210 if (typ == MatrixType::Permuted_Upper)
2211 {
2212 retval.resize (nc, b_nc);
2213 octave_idx_type *perm = mattype.triangular_perm ();
2214 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
2215
2216 for (octave_idx_type j = 0; j < b_nc; j++)
2217 {
2218 for (octave_idx_type i = 0; i < nr; i++)
2219 cwork[i] = b(i,j);
2220 for (octave_idx_type i = nr; i < nc; i++)
2221 cwork[i] = 0.;
2222
2223 for (octave_idx_type k = nc-1; k >= 0; k--)
2224 {
2225 octave_idx_type kidx = perm[k];
2226
2227 if (cwork[k] != 0.)
2228 {
2229 if (ridx (cidx (kidx+1)-1) != k ||
2230 data (cidx (kidx+1)-1) == 0.)
2231 {
2232 err = -2;
2233 goto triangular_error;
2234 }
2235
2236 Complex tmp = cwork[k] / data (cidx (kidx+1)-1);
2237 cwork[k] = tmp;
2238 for (octave_idx_type i = cidx (kidx);
2239 i < cidx (kidx+1)-1; i++)
2240 {
2241 octave_idx_type iidx = ridx (i);
2242 cwork[iidx] = cwork[iidx] - tmp * data (i);
2243 }
2244 }
2245 }
2246
2247 for (octave_idx_type i = 0; i < nc; i++)
2248 retval.xelem (perm[i], j) = cwork[i];
2249 }
2250
2251 if (calc_cond)
2252 {
2253 // Calculation of 1-norm of inv(*this)
2254 OCTAVE_LOCAL_BUFFER (double, work, nm);
2255 for (octave_idx_type i = 0; i < nm; i++)
2256 work[i] = 0.;
2257
2258 for (octave_idx_type j = 0; j < nr; j++)
2259 {
2260 work[j] = 1.;
2261
2262 for (octave_idx_type k = j; k >= 0; k--)
2263 {
2264 octave_idx_type iidx = perm[k];
2265
2266 if (work[k] != 0.)
2267 {
2268 double tmp = work[k] / data (cidx (iidx+1)-1);
2269 work[k] = tmp;
2270 for (octave_idx_type i = cidx (iidx);
2271 i < cidx (iidx+1)-1; i++)
2272 {
2273 octave_idx_type idx2 = ridx (i);
2274 work[idx2] = work[idx2] - tmp * data (i);
2275 }
2276 }
2277 }
2278 double atmp = 0;
2279 for (octave_idx_type i = 0; i < j+1; i++)
2280 {
2281 atmp += fabs (work[i]);
2282 work[i] = 0.;
2283 }
2284 if (atmp > ainvnorm)
2285 ainvnorm = atmp;
2286 }
2287 rcond = 1. / ainvnorm / anorm;
2288 }
2289 }
2290 else
2291 {
2292 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
2293 retval.resize (nc, b_nc);
2294
2295 for (octave_idx_type j = 0; j < b_nc; j++)
2296 {
2297 for (octave_idx_type i = 0; i < nr; i++)
2298 cwork[i] = b(i,j);
2299 for (octave_idx_type i = nr; i < nc; i++)
2300 cwork[i] = 0.;
2301
2302 for (octave_idx_type k = nc-1; k >= 0; k--)
2303 {
2304 if (cwork[k] != 0.)
2305 {
2306 if (ridx (cidx (k+1)-1) != k ||
2307 data (cidx (k+1)-1) == 0.)
2308 {
2309 err = -2;
2310 goto triangular_error;
2311 }
2312
2313 Complex tmp = cwork[k] / data (cidx (k+1)-1);
2314 cwork[k] = tmp;
2315 for (octave_idx_type i = cidx (k); i < cidx (k+1)-1; i++)
2316 {
2317 octave_idx_type iidx = ridx (i);
2318 cwork[iidx] = cwork[iidx] - tmp * data (i);
2319 }
2320 }
2321 }
2322
2323 for (octave_idx_type i = 0; i < nc; i++)
2324 retval.xelem (i, j) = cwork[i];
2325 }
2326
2327 if (calc_cond)
2328 {
2329 // Calculation of 1-norm of inv(*this)
2330 OCTAVE_LOCAL_BUFFER (double, work, nm);
2331 for (octave_idx_type i = 0; i < nm; i++)
2332 work[i] = 0.;
2333
2334 for (octave_idx_type j = 0; j < nr; j++)
2335 {
2336 work[j] = 1.;
2337
2338 for (octave_idx_type k = j; k >= 0; k--)
2339 {
2340 if (work[k] != 0.)
2341 {
2342 double tmp = work[k] / data (cidx (k+1)-1);
2343 work[k] = tmp;
2344 for (octave_idx_type i = cidx (k);
2345 i < cidx (k+1)-1; i++)
2346 {
2347 octave_idx_type iidx = ridx (i);
2348 work[iidx] = work[iidx] - tmp * data (i);
2349 }
2350 }
2351 }
2352 double atmp = 0;
2353 for (octave_idx_type i = 0; i < j+1; i++)
2354 {
2355 atmp += fabs (work[i]);
2356 work[i] = 0.;
2357 }
2358 if (atmp > ainvnorm)
2359 ainvnorm = atmp;
2360 }
2361 rcond = 1. / ainvnorm / anorm;
2362 }
2363 }
2364
2365 triangular_error:
2366 if (err != 0)
2367 {
2368 if (sing_handler)
2369 {
2370 sing_handler (rcond);
2371 mattype.mark_as_rectangular ();
2372 }
2373 else
2374 (*current_liboctave_error_handler)
2375 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g",
2376 rcond);
2377 }
2378
2379 volatile double rcond_plus_one = rcond + 1.0;
2380
2381 if (rcond_plus_one == 1.0 || xisnan (rcond))
2382 {
2383 err = -2;
2384
2385 if (sing_handler)
2386 {
2387 sing_handler (rcond);
2388 mattype.mark_as_rectangular ();
2389 }
2390 else
2391 (*current_liboctave_error_handler)
2392 ("matrix singular to machine precision, rcond = %g",
2393 rcond);
2394 }
2395 }
2396 else
2397 (*current_liboctave_error_handler) ("incorrect matrix type");
2398 }
2399
2400 return retval;
2401 }
2402
2403 SparseComplexMatrix
2404 SparseMatrix::utsolve (MatrixType &mattype, const SparseComplexMatrix& b,
2405 octave_idx_type& err, double& rcond,
2406 solve_singularity_handler sing_handler,
2407 bool calc_cond) const
2408 {
2409 SparseComplexMatrix retval;
2410
2411 octave_idx_type nr = rows ();
2412 octave_idx_type nc = cols ();
2413 octave_idx_type nm = (nc > nr ? nc : nr);
2414 err = 0;
2415
2416 if (nr != b.rows ())
2417 (*current_liboctave_error_handler)
2418 ("matrix dimension mismatch solution of linear equations");
2419 else if (nr == 0 || nc == 0 || b.cols () == 0)
2420 retval = SparseComplexMatrix (nc, b.cols ());
2421 else
2422 {
2423 // Print spparms("spumoni") info if requested
2424 int typ = mattype.type ();
2425 mattype.info ();
2426
2427 if (typ == MatrixType::Permuted_Upper ||
2428 typ == MatrixType::Upper)
2429 {
2430 double anorm = 0.;
2431 double ainvnorm = 0.;
2432 rcond = 1.;
2433
2434 if (calc_cond)
2435 {
2436 // Calculate the 1-norm of matrix for rcond calculation
2437 for (octave_idx_type j = 0; j < nc; j++)
2438 {
2439 double atmp = 0.;
2440 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
2441 atmp += fabs (data (i));
2442 if (atmp > anorm)
2443 anorm = atmp;
2444 }
2445 }
2446
2447 octave_idx_type b_nc = b.cols ();
2448 octave_idx_type b_nz = b.nnz ();
2449 retval = SparseComplexMatrix (nc, b_nc, b_nz);
2450 retval.xcidx (0) = 0;
2451 octave_idx_type ii = 0;
2452 octave_idx_type x_nz = b_nz;
2453
2454 if (typ == MatrixType::Permuted_Upper)
2455 {
2456 octave_idx_type *perm = mattype.triangular_perm ();
2457 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
2458
2459 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc);
2460 for (octave_idx_type i = 0; i < nc; i++)
2461 rperm[perm[i]] = i;
2462
2463 for (octave_idx_type j = 0; j < b_nc; j++)
2464 {
2465 for (octave_idx_type i = 0; i < nm; i++)
2466 cwork[i] = 0.;
2467 for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
2468 cwork[b.ridx (i)] = b.data (i);
2469
2470 for (octave_idx_type k = nc-1; k >= 0; k--)
2471 {
2472 octave_idx_type kidx = perm[k];
2473
2474 if (cwork[k] != 0.)
2475 {
2476 if (ridx (cidx (kidx+1)-1) != k ||
2477 data (cidx (kidx+1)-1) == 0.)
2478 {
2479 err = -2;
2480 goto triangular_error;
2481 }
2482
2483 Complex tmp = cwork[k] / data (cidx (kidx+1)-1);
2484 cwork[k] = tmp;
2485 for (octave_idx_type i = cidx (kidx);
2486 i < cidx (kidx+1)-1; i++)
2487 {
2488 octave_idx_type iidx = ridx (i);
2489 cwork[iidx] = cwork[iidx] - tmp * data (i);
2490 }
2491 }
2492 }
2493
2494 // Count non-zeros in work vector and adjust space in
2495 // retval if needed
2496 octave_idx_type new_nnz = 0;
2497 for (octave_idx_type i = 0; i < nc; i++)
2498 if (cwork[i] != 0.)
2499 new_nnz++;
2500
2501 if (ii + new_nnz > x_nz)
2502 {
2503 // Resize the sparse matrix
2504 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
2505 retval.change_capacity (sz);
2506 x_nz = sz;
2507 }
2508
2509 for (octave_idx_type i = 0; i < nc; i++)
2510 if (cwork[rperm[i]] != 0.)
2511 {
2512 retval.xridx (ii) = i;
2513 retval.xdata (ii++) = cwork[rperm[i]];
2514 }
2515 retval.xcidx (j+1) = ii;
2516 }
2517
2518 retval.maybe_compress ();
2519
2520 if (calc_cond)
2521 {
2522 // Calculation of 1-norm of inv(*this)
2523 OCTAVE_LOCAL_BUFFER (double, work, nm);
2524 for (octave_idx_type i = 0; i < nm; i++)
2525 work[i] = 0.;
2526
2527 for (octave_idx_type j = 0; j < nr; j++)
2528 {
2529 work[j] = 1.;
2530
2531 for (octave_idx_type k = j; k >= 0; k--)
2532 {
2533 octave_idx_type iidx = perm[k];
2534
2535 if (work[k] != 0.)
2536 {
2537 double tmp = work[k] / data (cidx (iidx+1)-1);
2538 work[k] = tmp;
2539 for (octave_idx_type i = cidx (iidx);
2540 i < cidx (iidx+1)-1; i++)
2541 {
2542 octave_idx_type idx2 = ridx (i);
2543 work[idx2] = work[idx2] - tmp * data (i);
2544 }
2545 }
2546 }
2547 double atmp = 0;
2548 for (octave_idx_type i = 0; i < j+1; i++)
2549 {
2550 atmp += fabs (work[i]);
2551 work[i] = 0.;
2552 }
2553 if (atmp > ainvnorm)
2554 ainvnorm = atmp;
2555 }
2556 rcond = 1. / ainvnorm / anorm;
2557 }
2558 }
2559 else
2560 {
2561 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
2562
2563 for (octave_idx_type j = 0; j < b_nc; j++)
2564 {
2565 for (octave_idx_type i = 0; i < nm; i++)
2566 cwork[i] = 0.;
2567 for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
2568 cwork[b.ridx (i)] = b.data (i);
2569
2570 for (octave_idx_type k = nc-1; k >= 0; k--)
2571 {
2572 if (cwork[k] != 0.)
2573 {
2574 if (ridx (cidx (k+1)-1) != k ||
2575 data (cidx (k+1)-1) == 0.)
2576 {
2577 err = -2;
2578 goto triangular_error;
2579 }
2580
2581 Complex tmp = cwork[k] / data (cidx (k+1)-1);
2582 cwork[k] = tmp;
2583 for (octave_idx_type i = cidx (k); i < cidx (k+1)-1; i++)
2584 {
2585 octave_idx_type iidx = ridx (i);
2586 cwork[iidx] = cwork[iidx] - tmp * data (i);
2587 }
2588 }
2589 }
2590
2591 // Count non-zeros in work vector and adjust space in
2592 // retval if needed
2593 octave_idx_type new_nnz = 0;
2594 for (octave_idx_type i = 0; i < nc; i++)
2595 if (cwork[i] != 0.)
2596 new_nnz++;
2597
2598 if (ii + new_nnz > x_nz)
2599 {
2600 // Resize the sparse matrix
2601 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
2602 retval.change_capacity (sz);
2603 x_nz = sz;
2604 }
2605
2606 for (octave_idx_type i = 0; i < nc; i++)
2607 if (cwork[i] != 0.)
2608 {
2609 retval.xridx (ii) = i;
2610 retval.xdata (ii++) = cwork[i];
2611 }
2612 retval.xcidx (j+1) = ii;
2613 }
2614
2615 retval.maybe_compress ();
2616
2617 if (calc_cond)
2618 {
2619 // Calculation of 1-norm of inv(*this)
2620 OCTAVE_LOCAL_BUFFER (double, work, nm);
2621 for (octave_idx_type i = 0; i < nm; i++)
2622 work[i] = 0.;
2623
2624 for (octave_idx_type j = 0; j < nr; j++)
2625 {
2626 work[j] = 1.;
2627
2628 for (octave_idx_type k = j; k >= 0; k--)
2629 {
2630 if (work[k] != 0.)
2631 {
2632 double tmp = work[k] / data (cidx (k+1)-1);
2633 work[k] = tmp;
2634 for (octave_idx_type i = cidx (k);
2635 i < cidx (k+1)-1; i++)
2636 {
2637 octave_idx_type iidx = ridx (i);
2638 work[iidx] = work[iidx] - tmp * data (i);
2639 }
2640 }
2641 }
2642 double atmp = 0;
2643 for (octave_idx_type i = 0; i < j+1; i++)
2644 {
2645 atmp += fabs (work[i]);
2646 work[i] = 0.;
2647 }
2648 if (atmp > ainvnorm)
2649 ainvnorm = atmp;
2650 }
2651 rcond = 1. / ainvnorm / anorm;
2652 }
2653 }
2654
2655 triangular_error:
2656 if (err != 0)
2657 {
2658 if (sing_handler)
2659 {
2660 sing_handler (rcond);
2661 mattype.mark_as_rectangular ();
2662 }
2663 else
2664 (*current_liboctave_error_handler)
2665 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g",
2666 rcond);
2667 }
2668
2669 volatile double rcond_plus_one = rcond + 1.0;
2670
2671 if (rcond_plus_one == 1.0 || xisnan (rcond))
2672 {
2673 err = -2;
2674
2675 if (sing_handler)
2676 {
2677 sing_handler (rcond);
2678 mattype.mark_as_rectangular ();
2679 }
2680 else
2681 (*current_liboctave_error_handler)
2682 ("matrix singular to machine precision, rcond = %g",
2683 rcond);
2684 }
2685 }
2686 else
2687 (*current_liboctave_error_handler) ("incorrect matrix type");
2688 }
2689
2690 return retval;
2691 }
2692
2693 Matrix
2694 SparseMatrix::ltsolve (MatrixType &mattype, const Matrix& b,
2695 octave_idx_type& err, double& rcond,
2696 solve_singularity_handler sing_handler,
2697 bool calc_cond) const
2698 {
2699 Matrix retval;
2700
2701 octave_idx_type nr = rows ();
2702 octave_idx_type nc = cols ();
2703 octave_idx_type nm = (nc > nr ? nc : nr);
2704 err = 0;
2705
2706 if (nr != b.rows ())
2707 (*current_liboctave_error_handler)
2708 ("matrix dimension mismatch solution of linear equations");
2709 else if (nr == 0 || nc == 0 || b.cols () == 0)
2710 retval = Matrix (nc, b.cols (), 0.0);
2711 else
2712 {
2713 // Print spparms("spumoni") info if requested
2714 int typ = mattype.type ();
2715 mattype.info ();
2716
2717 if (typ == MatrixType::Permuted_Lower ||
2718 typ == MatrixType::Lower)
2719 {
2720 double anorm = 0.;
2721 double ainvnorm = 0.;
2722 octave_idx_type b_nc = b.cols ();
2723 rcond = 1.;
2724
2725 if (calc_cond)
2726 {
2727 // Calculate the 1-norm of matrix for rcond calculation
2728 for (octave_idx_type j = 0; j < nc; j++)
2729 {
2730 double atmp = 0.;
2731 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
2732 atmp += fabs (data (i));
2733 if (atmp > anorm)
2734 anorm = atmp;
2735 }
2736 }
2737
2738 if (typ == MatrixType::Permuted_Lower)
2739 {
2740 retval.resize (nc, b_nc);
2741 OCTAVE_LOCAL_BUFFER (double, work, nm);
2742 octave_idx_type *perm = mattype.triangular_perm ();
2743
2744 for (octave_idx_type j = 0; j < b_nc; j++)
2745 {
2746 if (nc > nr)
2747 for (octave_idx_type i = 0; i < nm; i++)
2748 work[i] = 0.;
2749 for (octave_idx_type i = 0; i < nr; i++)
2750 work[perm[i]] = b(i,j);
2751
2752 for (octave_idx_type k = 0; k < nc; k++)
2753 {
2754 if (work[k] != 0.)
2755 {
2756 octave_idx_type minr = nr;
2757 octave_idx_type mini = 0;
2758
2759 for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
2760 if (perm[ridx (i)] < minr)
2761 {
2762 minr = perm[ridx (i)];
2763 mini = i;
2764 }
2765
2766 if (minr != k || data (mini) == 0)
2767 {
2768 err = -2;
2769 goto triangular_error;
2770 }
2771
2772 double tmp = work[k] / data (mini);
2773 work[k] = tmp;
2774 for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
2775 {
2776 if (i == mini)
2777 continue;
2778
2779 octave_idx_type iidx = perm[ridx (i)];
2780 work[iidx] = work[iidx] - tmp * data (i);
2781 }
2782 }
2783 }
2784
2785 for (octave_idx_type i = 0; i < nc; i++)
2786 retval(i, j) = work[i];
2787 }
2788
2789 if (calc_cond)
2790 {
2791 // Calculation of 1-norm of inv(*this)
2792 for (octave_idx_type i = 0; i < nm; i++)
2793 work[i] = 0.;
2794
2795 for (octave_idx_type j = 0; j < nr; j++)
2796 {
2797 work[j] = 1.;
2798
2799 for (octave_idx_type k = 0; k < nc; k++)
2800 {
2801 if (work[k] != 0.)
2802 {
2803 octave_idx_type minr = nr;
2804 octave_idx_type mini = 0;
2805
2806 for (octave_idx_type i = cidx (k);
2807 i < cidx (k+1); i++)
2808 if (perm[ridx (i)] < minr)
2809 {
2810 minr = perm[ridx (i)];
2811 mini = i;
2812 }
2813
2814 double tmp = work[k] / data (mini);
2815 work[k] = tmp;
2816 for (octave_idx_type i = cidx (k);
2817 i < cidx (k+1); i++)
2818 {
2819 if (i == mini)
2820 continue;
2821
2822 octave_idx_type iidx = perm[ridx (i)];
2823 work[iidx] = work[iidx] - tmp * data (i);
2824 }
2825 }
2826 }
2827
2828 double atmp = 0;
2829 for (octave_idx_type i = j; i < nc; i++)
2830 {
2831 atmp += fabs (work[i]);
2832 work[i] = 0.;
2833 }
2834 if (atmp > ainvnorm)
2835 ainvnorm = atmp;
2836 }
2837 rcond = 1. / ainvnorm / anorm;
2838 }
2839 }
2840 else
2841 {
2842 OCTAVE_LOCAL_BUFFER (double, work, nm);
2843 retval.resize (nc, b_nc, 0.);
2844
2845 for (octave_idx_type j = 0; j < b_nc; j++)
2846 {
2847 for (octave_idx_type i = 0; i < nr; i++)
2848 work[i] = b(i,j);
2849 for (octave_idx_type i = nr; i < nc; i++)
2850 work[i] = 0.;
2851 for (octave_idx_type k = 0; k < nc; k++)
2852 {
2853 if (work[k] != 0.)
2854 {
2855 if (ridx (cidx (k)) != k ||
2856 data (cidx (k)) == 0.)
2857 {
2858 err = -2;
2859 goto triangular_error;
2860 }
2861
2862 double tmp = work[k] / data (cidx (k));
2863 work[k] = tmp;
2864 for (octave_idx_type i = cidx (k)+1;
2865 i < cidx (k+1); i++)
2866 {
2867 octave_idx_type iidx = ridx (i);
2868 work[iidx] = work[iidx] - tmp * data (i);
2869 }
2870 }
2871 }
2872
2873 for (octave_idx_type i = 0; i < nc; i++)
2874 retval.xelem (i, j) = work[i];
2875 }
2876
2877 if (calc_cond)
2878 {
2879 // Calculation of 1-norm of inv(*this)
2880 for (octave_idx_type i = 0; i < nm; i++)
2881 work[i] = 0.;
2882
2883 for (octave_idx_type j = 0; j < nr; j++)
2884 {
2885 work[j] = 1.;
2886
2887 for (octave_idx_type k = j; k < nc; k++)
2888 {
2889
2890 if (work[k] != 0.)
2891 {
2892 double tmp = work[k] / data (cidx (k));
2893 work[k] = tmp;
2894 for (octave_idx_type i = cidx (k)+1;
2895 i < cidx (k+1); i++)
2896 {
2897 octave_idx_type iidx = ridx (i);
2898 work[iidx] = work[iidx] - tmp * data (i);
2899 }
2900 }
2901 }
2902 double atmp = 0;
2903 for (octave_idx_type i = j; i < nc; i++)
2904 {
2905 atmp += fabs (work[i]);
2906 work[i] = 0.;
2907 }
2908 if (atmp > ainvnorm)
2909 ainvnorm = atmp;
2910 }
2911 rcond = 1. / ainvnorm / anorm;
2912 }
2913 }
2914
2915 triangular_error:
2916 if (err != 0)
2917 {
2918 if (sing_handler)
2919 {
2920 sing_handler (rcond);
2921 mattype.mark_as_rectangular ();
2922 }
2923 else
2924 (*current_liboctave_error_handler)
2925 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g",
2926 rcond);
2927 }
2928
2929 volatile double rcond_plus_one = rcond + 1.0;
2930
2931 if (rcond_plus_one == 1.0 || xisnan (rcond))
2932 {
2933 err = -2;
2934
2935 if (sing_handler)
2936 {
2937 sing_handler (rcond);
2938 mattype.mark_as_rectangular ();
2939 }
2940 else
2941 (*current_liboctave_error_handler)
2942 ("matrix singular to machine precision, rcond = %g",
2943 rcond);
2944 }
2945 }
2946 else
2947 (*current_liboctave_error_handler) ("incorrect matrix type");
2948 }
2949
2950 return retval;
2951 }
2952
2953 SparseMatrix
2954 SparseMatrix::ltsolve (MatrixType &mattype, const SparseMatrix& b,
2955 octave_idx_type& err, double& rcond,
2956 solve_singularity_handler sing_handler,
2957 bool calc_cond) const
2958 {
2959 SparseMatrix retval;
2960
2961 octave_idx_type nr = rows ();
2962 octave_idx_type nc = cols ();
2963 octave_idx_type nm = (nc > nr ? nc : nr);
2964 err = 0;
2965
2966 if (nr != b.rows ())
2967 (*current_liboctave_error_handler)
2968 ("matrix dimension mismatch solution of linear equations");
2969 else if (nr == 0 || nc == 0 || b.cols () == 0)
2970 retval = SparseMatrix (nc, b.cols ());
2971 else
2972 {
2973 // Print spparms("spumoni") info if requested
2974 int typ = mattype.type ();
2975 mattype.info ();
2976
2977 if (typ == MatrixType::Permuted_Lower ||
2978 typ == MatrixType::Lower)
2979 {
2980 double anorm = 0.;
2981 double ainvnorm = 0.;
2982 rcond = 1.;
2983
2984 if (calc_cond)
2985 {
2986 // Calculate the 1-norm of matrix for rcond calculation
2987 for (octave_idx_type j = 0; j < nc; j++)
2988 {
2989 double atmp = 0.;
2990 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
2991 atmp += fabs (data (i));
2992 if (atmp > anorm)
2993 anorm = atmp;
2994 }
2995 }
2996
2997 octave_idx_type b_nc = b.cols ();
2998 octave_idx_type b_nz = b.nnz ();
2999 retval = SparseMatrix (nc, b_nc, b_nz);
3000 retval.xcidx (0) = 0;
3001 octave_idx_type ii = 0;
3002 octave_idx_type x_nz = b_nz;
3003
3004 if (typ == MatrixType::Permuted_Lower)
3005 {
3006 OCTAVE_LOCAL_BUFFER (double, work, nm);
3007 octave_idx_type *perm = mattype.triangular_perm ();
3008
3009 for (octave_idx_type j = 0; j < b_nc; j++)
3010 {
3011 for (octave_idx_type i = 0; i < nm; i++)
3012 work[i] = 0.;
3013 for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
3014 work[perm[b.ridx (i)]] = b.data (i);
3015
3016 for (octave_idx_type k = 0; k < nc; k++)
3017 {
3018 if (work[k] != 0.)
3019 {
3020 octave_idx_type minr = nr;
3021 octave_idx_type mini = 0;
3022
3023 for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
3024 if (perm[ridx (i)] < minr)
3025 {
3026 minr = perm[ridx (i)];
3027 mini = i;
3028 }
3029
3030 if (minr != k || data (mini) == 0)
3031 {
3032 err = -2;
3033 goto triangular_error;
3034 }
3035
3036 double tmp = work[k] / data (mini);
3037 work[k] = tmp;
3038 for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
3039 {
3040 if (i == mini)
3041 continue;
3042
3043 octave_idx_type iidx = perm[ridx (i)];
3044 work[iidx] = work[iidx] - tmp * data (i);
3045 }
3046 }
3047 }
3048
3049 // Count non-zeros in work vector and adjust space in
3050 // retval if needed
3051 octave_idx_type new_nnz = 0;
3052 for (octave_idx_type i = 0; i < nc; i++)
3053 if (work[i] != 0.)
3054 new_nnz++;
3055
3056 if (ii + new_nnz > x_nz)
3057 {
3058 // Resize the sparse matrix
3059 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
3060 retval.change_capacity (sz);
3061 x_nz = sz;
3062 }
3063
3064 for (octave_idx_type i = 0; i < nc; i++)
3065 if (work[i] != 0.)
3066 {
3067 retval.xridx (ii) = i;
3068 retval.xdata (ii++) = work[i];
3069 }
3070 retval.xcidx (j+1) = ii;
3071 }
3072
3073 retval.maybe_compress ();
3074
3075 if (calc_cond)
3076 {
3077 // Calculation of 1-norm of inv(*this)
3078 for (octave_idx_type i = 0; i < nm; i++)
3079 work[i] = 0.;
3080
3081 for (octave_idx_type j = 0; j < nr; j++)
3082 {
3083 work[j] = 1.;
3084
3085 for (octave_idx_type k = 0; k < nc; k++)
3086 {
3087 if (work[k] != 0.)
3088 {
3089 octave_idx_type minr = nr;
3090 octave_idx_type mini = 0;
3091
3092 for (octave_idx_type i = cidx (k);
3093 i < cidx (k+1); i++)
3094 if (perm[ridx (i)] < minr)
3095 {
3096 minr = perm[ridx (i)];
3097 mini = i;
3098 }
3099
3100 double tmp = work[k] / data (mini);
3101 work[k] = tmp;
3102 for (octave_idx_type i = cidx (k);
3103 i < cidx (k+1); i++)
3104 {
3105 if (i == mini)
3106 continue;
3107
3108 octave_idx_type iidx = perm[ridx (i)];
3109 work[iidx] = work[iidx] - tmp * data (i);
3110 }
3111 }
3112 }
3113
3114 double atmp = 0;
3115 for (octave_idx_type i = j; i < nr; i++)
3116 {
3117 atmp += fabs (work[i]);
3118 work[i] = 0.;
3119 }
3120 if (atmp > ainvnorm)
3121 ainvnorm = atmp;
3122 }
3123 rcond = 1. / ainvnorm / anorm;
3124 }
3125 }
3126 else
3127 {
3128 OCTAVE_LOCAL_BUFFER (double, work, nm);
3129
3130 for (octave_idx_type j = 0; j < b_nc; j++)
3131 {
3132 for (octave_idx_type i = 0; i < nm; i++)
3133 work[i] = 0.;
3134 for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
3135 work[b.ridx (i)] = b.data (i);
3136
3137 for (octave_idx_type k = 0; k < nc; k++)
3138 {
3139 if (work[k] != 0.)
3140 {
3141 if (ridx (cidx (k)) != k ||
3142 data (cidx (k)) == 0.)
3143 {
3144 err = -2;
3145 goto triangular_error;
3146 }
3147
3148 double tmp = work[k] / data (cidx (k));
3149 work[k] = tmp;
3150 for (octave_idx_type i = cidx (k)+1; i < cidx (k+1); i++)
3151 {
3152 octave_idx_type iidx = ridx (i);
3153 work[iidx] = work[iidx] - tmp * data (i);
3154 }
3155 }
3156 }
3157
3158 // Count non-zeros in work vector and adjust space in
3159 // retval if needed
3160 octave_idx_type new_nnz = 0;
3161 for (octave_idx_type i = 0; i < nc; i++)
3162 if (work[i] != 0.)
3163 new_nnz++;
3164
3165 if (ii + new_nnz > x_nz)
3166 {
3167 // Resize the sparse matrix
3168 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
3169 retval.change_capacity (sz);
3170 x_nz = sz;
3171 }
3172
3173 for (octave_idx_type i = 0; i < nc; i++)
3174 if (work[i] != 0.)
3175 {
3176 retval.xridx (ii) = i;
3177 retval.xdata (ii++) = work[i];
3178 }
3179 retval.xcidx (j+1) = ii;
3180 }
3181
3182 retval.maybe_compress ();
3183
3184 if (calc_cond)
3185 {
3186 // Calculation of 1-norm of inv(*this)
3187 for (octave_idx_type i = 0; i < nm; i++)
3188 work[i] = 0.;
3189
3190 for (octave_idx_type j = 0; j < nr; j++)
3191 {
3192 work[j] = 1.;
3193
3194 for (octave_idx_type k = j; k < nc; k++)
3195 {
3196
3197 if (work[k] != 0.)
3198 {
3199 double tmp = work[k] / data (cidx (k));
3200 work[k] = tmp;
3201 for (octave_idx_type i = cidx (k)+1;
3202 i < cidx (k+1); i++)
3203 {
3204 octave_idx_type iidx = ridx (i);
3205 work[iidx] = work[iidx] - tmp * data (i);
3206 }
3207 }
3208 }
3209 double atmp = 0;
3210 for (octave_idx_type i = j; i < nc; i++)
3211 {
3212 atmp += fabs (work[i]);
3213 work[i] = 0.;
3214 }
3215 if (atmp > ainvnorm)
3216 ainvnorm = atmp;
3217 }
3218 rcond = 1. / ainvnorm / anorm;
3219 }
3220 }
3221
3222 triangular_error:
3223 if (err != 0)
3224 {
3225 if (sing_handler)
3226 {
3227 sing_handler (rcond);
3228 mattype.mark_as_rectangular ();
3229 }
3230 else
3231 (*current_liboctave_error_handler)
3232 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g",
3233 rcond);
3234 }
3235
3236 volatile double rcond_plus_one = rcond + 1.0;
3237
3238 if (rcond_plus_one == 1.0 || xisnan (rcond))
3239 {
3240 err = -2;
3241
3242 if (sing_handler)
3243 {
3244 sing_handler (rcond);
3245 mattype.mark_as_rectangular ();
3246 }
3247 else
3248 (*current_liboctave_error_handler)
3249 ("matrix singular to machine precision, rcond = %g",
3250 rcond);
3251 }
3252 }
3253 else
3254 (*current_liboctave_error_handler) ("incorrect matrix type");
3255 }
3256
3257 return retval;
3258 }
3259
3260 ComplexMatrix
3261 SparseMatrix::ltsolve (MatrixType &mattype, const ComplexMatrix& b,
3262 octave_idx_type& err, double& rcond,
3263 solve_singularity_handler sing_handler,
3264 bool calc_cond) const
3265 {
3266 ComplexMatrix retval;
3267
3268 octave_idx_type nr = rows ();
3269 octave_idx_type nc = cols ();
3270 octave_idx_type nm = (nc > nr ? nc : nr);
3271 err = 0;
3272
3273 if (nr != b.rows ())
3274 (*current_liboctave_error_handler)
3275 ("matrix dimension mismatch solution of linear equations");
3276 else if (nr == 0 || nc == 0 || b.cols () == 0)
3277 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
3278 else
3279 {
3280 // Print spparms("spumoni") info if requested
3281 int typ = mattype.type ();
3282 mattype.info ();
3283
3284 if (typ == MatrixType::Permuted_Lower ||
3285 typ == MatrixType::Lower)
3286 {
3287 double anorm = 0.;
3288 double ainvnorm = 0.;
3289 octave_idx_type b_nc = b.cols ();
3290 rcond = 1.;
3291
3292 if (calc_cond)
3293 {
3294 // Calculate the 1-norm of matrix for rcond calculation
3295 for (octave_idx_type j = 0; j < nc; j++)
3296 {
3297 double atmp = 0.;
3298 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
3299 atmp += fabs (data (i));
3300 if (atmp > anorm)
3301 anorm = atmp;
3302 }
3303 }
3304
3305 if (typ == MatrixType::Permuted_Lower)
3306 {
3307 retval.resize (nc, b_nc);
3308 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
3309 octave_idx_type *perm = mattype.triangular_perm ();
3310
3311 for (octave_idx_type j = 0; j < b_nc; j++)
3312 {
3313 for (octave_idx_type i = 0; i < nm; i++)
3314 cwork[i] = 0.;
3315 for (octave_idx_type i = 0; i < nr; i++)
3316 cwork[perm[i]] = b(i,j);
3317
3318 for (octave_idx_type k = 0; k < nc; k++)
3319 {
3320 if (cwork[k] != 0.)
3321 {
3322 octave_idx_type minr = nr;
3323 octave_idx_type mini = 0;
3324
3325 for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
3326 if (perm[ridx (i)] < minr)
3327 {
3328 minr = perm[ridx (i)];
3329 mini = i;
3330 }
3331
3332 if (minr != k || data (mini) == 0)
3333 {
3334 err = -2;
3335 goto triangular_error;
3336 }
3337
3338 Complex tmp = cwork[k] / data (mini);
3339 cwork[k] = tmp;
3340 for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
3341 {
3342 if (i == mini)
3343 continue;
3344
3345 octave_idx_type iidx = perm[ridx (i)];
3346 cwork[iidx] = cwork[iidx] - tmp * data (i);
3347 }
3348 }
3349 }
3350
3351 for (octave_idx_type i = 0; i < nc; i++)
3352 retval(i, j) = cwork[i];
3353 }
3354
3355 if (calc_cond)
3356 {
3357 // Calculation of 1-norm of inv(*this)
3358 OCTAVE_LOCAL_BUFFER (double, work, nm);
3359 for (octave_idx_type i = 0; i < nm; i++)
3360 work[i] = 0.;
3361
3362 for (octave_idx_type j = 0; j < nr; j++)
3363 {
3364 work[j] = 1.;
3365
3366 for (octave_idx_type k = 0; k < nc; k++)
3367 {
3368 if (work[k] != 0.)
3369 {
3370 octave_idx_type minr = nr;
3371 octave_idx_type mini = 0;
3372
3373 for (octave_idx_type i = cidx (k);
3374 i < cidx (k+1); i++)
3375 if (perm[ridx (i)] < minr)
3376 {
3377 minr = perm[ridx (i)];
3378 mini = i;
3379 }
3380
3381 double tmp = work[k] / data (mini);
3382 work[k] = tmp;
3383 for (octave_idx_type i = cidx (k);
3384 i < cidx (k+1); i++)
3385 {
3386 if (i == mini)
3387 continue;
3388
3389 octave_idx_type iidx = perm[ridx (i)];
3390 work[iidx] = work[iidx] - tmp * data (i);
3391 }
3392 }
3393 }
3394
3395 double atmp = 0;
3396 for (octave_idx_type i = j; i < nc; i++)
3397 {
3398 atmp += fabs (work[i]);
3399 work[i] = 0.;
3400 }
3401 if (atmp > ainvnorm)
3402 ainvnorm = atmp;
3403 }
3404 rcond = 1. / ainvnorm / anorm;
3405 }
3406 }
3407 else
3408 {
3409 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
3410 retval.resize (nc, b_nc, 0.);
3411
3412 for (octave_idx_type j = 0; j < b_nc; j++)
3413 {
3414 for (octave_idx_type i = 0; i < nr; i++)
3415 cwork[i] = b(i,j);
3416 for (octave_idx_type i = nr; i < nc; i++)
3417 cwork[i] = 0.;
3418
3419 for (octave_idx_type k = 0; k < nc; k++)
3420 {
3421 if (cwork[k] != 0.)
3422 {
3423 if (ridx (cidx (k)) != k ||
3424 data (cidx (k)) == 0.)
3425 {
3426 err = -2;
3427 goto triangular_error;
3428 }
3429
3430 Complex tmp = cwork[k] / data (cidx (k));
3431 cwork[k] = tmp;
3432 for (octave_idx_type i = cidx (k)+1; i < cidx (k+1); i++)
3433 {
3434 octave_idx_type iidx = ridx (i);
3435 cwork[iidx] = cwork[iidx] - tmp * data (i);
3436 }
3437 }
3438 }
3439
3440 for (octave_idx_type i = 0; i < nc; i++)
3441 retval.xelem (i, j) = cwork[i];
3442 }
3443
3444 if (calc_cond)
3445 {
3446 // Calculation of 1-norm of inv(*this)
3447 OCTAVE_LOCAL_BUFFER (double, work, nm);
3448 for (octave_idx_type i = 0; i < nm; i++)
3449 work[i] = 0.;
3450
3451 for (octave_idx_type j = 0; j < nr; j++)
3452 {
3453 work[j] = 1.;
3454
3455 for (octave_idx_type k = j; k < nc; k++)
3456 {
3457
3458 if (work[k] != 0.)
3459 {
3460 double tmp = work[k] / data (cidx (k));
3461 work[k] = tmp;
3462 for (octave_idx_type i = cidx (k)+1;
3463 i < cidx (k+1); i++)
3464 {
3465 octave_idx_type iidx = ridx (i);
3466 work[iidx] = work[iidx] - tmp * data (i);
3467 }
3468 }
3469 }
3470 double atmp = 0;
3471 for (octave_idx_type i = j; i < nc; i++)
3472 {
3473 atmp += fabs (work[i]);
3474 work[i] = 0.;
3475 }
3476 if (atmp > ainvnorm)
3477 ainvnorm = atmp;
3478 }
3479 rcond = 1. / ainvnorm / anorm;
3480 }
3481 }
3482
3483 triangular_error:
3484 if (err != 0)
3485 {
3486 if (sing_handler)
3487 {
3488 sing_handler (rcond);
3489 mattype.mark_as_rectangular ();
3490 }
3491 else
3492 (*current_liboctave_error_handler)
3493 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g",
3494 rcond);
3495 }
3496
3497 volatile double rcond_plus_one = rcond + 1.0;
3498
3499 if (rcond_plus_one == 1.0 || xisnan (rcond))
3500 {
3501 err = -2;
3502
3503 if (sing_handler)
3504 {
3505 sing_handler (rcond);
3506 mattype.mark_as_rectangular ();
3507 }
3508 else
3509 (*current_liboctave_error_handler)
3510 ("matrix singular to machine precision, rcond = %g",
3511 rcond);
3512 }
3513 }
3514 else
3515 (*current_liboctave_error_handler) ("incorrect matrix type");
3516 }
3517
3518 return retval;
3519 }
3520
3521 SparseComplexMatrix
3522 SparseMatrix::ltsolve (MatrixType &mattype, const SparseComplexMatrix& b,
3523 octave_idx_type& err, double& rcond,
3524 solve_singularity_handler sing_handler,
3525 bool calc_cond) const
3526 {
3527 SparseComplexMatrix retval;
3528
3529 octave_idx_type nr = rows ();
3530 octave_idx_type nc = cols ();
3531 octave_idx_type nm = (nc > nr ? nc : nr);
3532 err = 0;
3533
3534 if (nr != b.rows ())
3535 (*current_liboctave_error_handler)
3536 ("matrix dimension mismatch solution of linear equations");
3537 else if (nr == 0 || nc == 0 || b.cols () == 0)
3538 retval = SparseComplexMatrix (nc, b.cols ());
3539 else
3540 {
3541 // Print spparms("spumoni") info if requested
3542 int typ = mattype.type ();
3543 mattype.info ();
3544
3545 if (typ == MatrixType::Permuted_Lower ||
3546 typ == MatrixType::Lower)
3547 {
3548 double anorm = 0.;
3549 double ainvnorm = 0.;
3550 rcond = 1.;
3551
3552 if (calc_cond)
3553 {
3554 // Calculate the 1-norm of matrix for rcond calculation
3555 for (octave_idx_type j = 0; j < nc; j++)
3556 {
3557 double atmp = 0.;
3558 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
3559 atmp += fabs (data (i));
3560 if (atmp > anorm)
3561 anorm = atmp;
3562 }
3563 }
3564
3565 octave_idx_type b_nc = b.cols ();
3566 octave_idx_type b_nz = b.nnz ();
3567 retval = SparseComplexMatrix (nc, b_nc, b_nz);
3568 retval.xcidx (0) = 0;
3569 octave_idx_type ii = 0;
3570 octave_idx_type x_nz = b_nz;
3571
3572 if (typ == MatrixType::Permuted_Lower)
3573 {
3574 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
3575 octave_idx_type *perm = mattype.triangular_perm ();
3576
3577 for (octave_idx_type j = 0; j < b_nc; j++)
3578 {
3579 for (octave_idx_type i = 0; i < nm; i++)
3580 cwork[i] = 0.;
3581 for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
3582 cwork[perm[b.ridx (i)]] = b.data (i);
3583
3584 for (octave_idx_type k = 0; k < nc; k++)
3585 {
3586 if (cwork[k] != 0.)
3587 {
3588 octave_idx_type minr = nr;
3589 octave_idx_type mini = 0;
3590
3591 for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
3592 if (perm[ridx (i)] < minr)
3593 {
3594 minr = perm[ridx (i)];
3595 mini = i;
3596 }
3597
3598 if (minr != k || data (mini) == 0)
3599 {
3600 err = -2;
3601 goto triangular_error;
3602 }
3603
3604 Complex tmp = cwork[k] / data (mini);
3605 cwork[k] = tmp;
3606 for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
3607 {
3608 if (i == mini)
3609 continue;
3610
3611 octave_idx_type iidx = perm[ridx (i)];
3612 cwork[iidx] = cwork[iidx] - tmp * data (i);
3613 }
3614 }
3615 }
3616
3617 // Count non-zeros in work vector and adjust space in
3618 // retval if needed
3619 octave_idx_type new_nnz = 0;
3620 for (octave_idx_type i = 0; i < nc; i++)
3621 if (cwork[i] != 0.)
3622 new_nnz++;
3623
3624 if (ii + new_nnz > x_nz)
3625 {
3626 // Resize the sparse matrix
3627 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
3628 retval.change_capacity (sz);
3629 x_nz = sz;
3630 }
3631
3632 for (octave_idx_type i = 0; i < nc; i++)
3633 if (cwork[i] != 0.)
3634 {
3635 retval.xridx (ii) = i;
3636 retval.xdata (ii++) = cwork[i];
3637 }
3638 retval.xcidx (j+1) = ii;
3639 }
3640
3641 retval.maybe_compress ();
3642
3643 if (calc_cond)
3644 {
3645 // Calculation of 1-norm of inv(*this)
3646 OCTAVE_LOCAL_BUFFER (double, work, nm);
3647 for (octave_idx_type i = 0; i < nm; i++)
3648 work[i] = 0.;
3649
3650 for (octave_idx_type j = 0; j < nr; j++)
3651 {
3652 work[j] = 1.;
3653
3654 for (octave_idx_type k = 0; k < nc; k++)
3655 {
3656 if (work[k] != 0.)
3657 {
3658 octave_idx_type minr = nr;
3659 octave_idx_type mini = 0;
3660
3661 for (octave_idx_type i = cidx (k);
3662 i < cidx (k+1); i++)
3663 if (perm[ridx (i)] < minr)
3664 {
3665 minr = perm[ridx (i)];
3666 mini = i;
3667 }
3668
3669 double tmp = work[k] / data (mini);
3670 work[k] = tmp;
3671 for (octave_idx_type i = cidx (k);
3672 i < cidx (k+1); i++)
3673 {
3674 if (i == mini)
3675 continue;
3676
3677 octave_idx_type iidx = perm[ridx (i)];
3678 work[iidx] = work[iidx] - tmp * data (i);
3679 }
3680 }
3681 }
3682
3683 double atmp = 0;
3684 for (octave_idx_type i = j; i < nc; i++)
3685 {
3686 atmp += fabs (work[i]);
3687 work[i] = 0.;
3688 }
3689 if (atmp > ainvnorm)
3690 ainvnorm = atmp;
3691 }
3692 rcond = 1. / ainvnorm / anorm;
3693 }
3694 }
3695 else
3696 {
3697 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
3698
3699 for (octave_idx_type j = 0; j < b_nc; j++)
3700 {
3701 for (octave_idx_type i = 0; i < nm; i++)
3702 cwork[i] = 0.;
3703 for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
3704 cwork[b.ridx (i)] = b.data (i);
3705
3706 for (octave_idx_type k = 0; k < nc; k++)
3707 {
3708 if (cwork[k] != 0.)
3709 {
3710 if (ridx (cidx (k)) != k ||
3711 data (cidx (k)) == 0.)
3712 {
3713 err = -2;
3714 goto triangular_error;
3715 }
3716
3717 Complex tmp = cwork[k] / data (cidx (k));
3718 cwork[k] = tmp;
3719 for (octave_idx_type i = cidx (k)+1; i < cidx (k+1); i++)
3720 {
3721 octave_idx_type iidx = ridx (i);
3722 cwork[iidx] = cwork[iidx] - tmp * data (i);
3723 }
3724 }
3725 }
3726
3727 // Count non-zeros in work vector and adjust space in
3728 // retval if needed
3729 octave_idx_type new_nnz = 0;
3730 for (octave_idx_type i = 0; i < nc; i++)
3731 if (cwork[i] != 0.)
3732 new_nnz++;
3733
3734 if (ii + new_nnz > x_nz)
3735 {
3736 // Resize the sparse matrix
3737 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
3738 retval.change_capacity (sz);
3739 x_nz = sz;
3740 }
3741
3742 for (octave_idx_type i = 0; i < nc; i++)
3743 if (cwork[i] != 0.)
3744 {
3745 retval.xridx (ii) = i;
3746 retval.xdata (ii++) = cwork[i];
3747 }
3748 retval.xcidx (j+1) = ii;
3749 }
3750
3751 retval.maybe_compress ();
3752
3753 if (calc_cond)
3754 {
3755 // Calculation of 1-norm of inv(*this)
3756 OCTAVE_LOCAL_BUFFER (double, work, nm);
3757 for (octave_idx_type i = 0; i < nm; i++)
3758 work[i] = 0.;
3759
3760 for (octave_idx_type j = 0; j < nr; j++)
3761 {
3762 work[j] = 1.;
3763
3764 for (octave_idx_type k = j; k < nc; k++)
3765 {
3766
3767 if (work[k] != 0.)
3768 {
3769 double tmp = work[k] / data (cidx (k));
3770 work[k] = tmp;
3771 for (octave_idx_type i = cidx (k)+1;
3772 i < cidx (k+1); i++)
3773 {
3774 octave_idx_type iidx = ridx (i);
3775 work[iidx] = work[iidx] - tmp * data (i);
3776 }
3777 }
3778 }
3779 double atmp = 0;
3780 for (octave_idx_type i = j; i < nc; i++)
3781 {
3782 atmp += fabs (work[i]);
3783 work[i] = 0.;
3784 }
3785 if (atmp > ainvnorm)
3786 ainvnorm = atmp;
3787 }
3788 rcond = 1. / ainvnorm / anorm;
3789 }
3790 }
3791
3792 triangular_error:
3793 if (err != 0)
3794 {
3795 if (sing_handler)
3796 {
3797 sing_handler (rcond);
3798 mattype.mark_as_rectangular ();
3799 }
3800 else
3801 (*current_liboctave_error_handler)
3802 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g",
3803 rcond);
3804 }
3805
3806 volatile double rcond_plus_one = rcond + 1.0;
3807
3808 if (rcond_plus_one == 1.0 || xisnan (rcond))
3809 {
3810 err = -2;
3811
3812 if (sing_handler)
3813 {
3814 sing_handler (rcond);
3815 mattype.mark_as_rectangular ();
3816 }
3817 else
3818 (*current_liboctave_error_handler)
3819 ("matrix singular to machine precision, rcond = %g",
3820 rcond);
3821 }
3822 }
3823 else
3824 (*current_liboctave_error_handler) ("incorrect matrix type");
3825 }
3826
3827 return retval;
3828 }
3829
3830 Matrix
3831 SparseMatrix::trisolve (MatrixType &mattype, const Matrix& b,
3832 octave_idx_type& err, double& rcond,
3833 solve_singularity_handler sing_handler,
3834 bool calc_cond) const
3835 {
3836 Matrix retval;
3837
3838 octave_idx_type nr = rows ();
3839 octave_idx_type nc = cols ();
3840 err = 0;
3841
3842 if (nr != nc || nr != b.rows ())
3843 (*current_liboctave_error_handler)
3844 ("matrix dimension mismatch solution of linear equations");
3845 else if (nr == 0 || b.cols () == 0)
3846 retval = Matrix (nc, b.cols (), 0.0);
3847 else if (calc_cond)
3848 (*current_liboctave_error_handler)
3849 ("calculation of condition number not implemented");
3850 else
3851 {
3852 // Print spparms("spumoni") info if requested
3853 volatile int typ = mattype.type ();
3854 mattype.info ();
3855
3856 if (typ == MatrixType::Tridiagonal_Hermitian)
3857 {
3858 OCTAVE_LOCAL_BUFFER (double, D, nr);
3859 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1);
3860
3861 if (mattype.is_dense ())
3862 {
3863 octave_idx_type ii = 0;
3864
3865 for (octave_idx_type j = 0; j < nc-1; j++)
3866 {
3867 D[j] = data (ii++);
3868 DL[j] = data (ii);
3869 ii += 2;
3870 }
3871 D[nc-1] = data (ii);
3872 }
3873 else
3874 {
3875 D[0] = 0.;
3876 for (octave_idx_type i = 0; i < nr - 1; i++)
3877 {
3878 D[i+1] = 0.;
3879 DL[i] = 0.;
3880 }
3881
3882 for (octave_idx_type j = 0; j < nc; j++)
3883 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
3884 {
3885 if (ridx (i) == j)
3886 D[j] = data (i);
3887 else if (ridx (i) == j + 1)
3888 DL[j] = data (i);
3889 }
3890 }
3891
3892 octave_idx_type b_nc = b.cols ();
3893 retval = b;
3894 double *result = retval.fortran_vec ();
3895
3896 F77_XFCN (dptsv, DPTSV, (nr, b_nc, D, DL, result,
3897 b.rows (), err));
3898
3899 if (err != 0)
3900 {
3901 err = 0;
3902 mattype.mark_as_unsymmetric ();
3903 typ = MatrixType::Tridiagonal;
3904 }
3905 else
3906 rcond = 1.;
3907 }
3908
3909 if (typ == MatrixType::Tridiagonal)
3910 {
3911 OCTAVE_LOCAL_BUFFER (double, DU, nr - 1);
3912 OCTAVE_LOCAL_BUFFER (double, D, nr);
3913 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1);
3914
3915 if (mattype.is_dense ())
3916 {
3917 octave_idx_type ii = 0;
3918
3919 for (octave_idx_type j = 0; j < nc-1; j++)
3920 {
3921 D[j] = data (ii++);
3922 DL[j] = data (ii++);
3923 DU[j] = data (ii++);
3924 }
3925 D[nc-1] = data (ii);
3926 }
3927 else
3928 {
3929 D[0] = 0.;
3930 for (octave_idx_type i = 0; i < nr - 1; i++)
3931 {
3932 D[i+1] = 0.;
3933 DL[i] = 0.;
3934 DU[i] = 0.;
3935 }
3936
3937 for (octave_idx_type j = 0; j < nc; j++)
3938 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
3939 {
3940 if (ridx (i) == j)
3941 D[j] = data (i);
3942 else if (ridx (i) == j + 1)
3943 DL[j] = data (i);
3944 else if (ridx (i) == j - 1)
3945 DU[j-1] = data (i);
3946 }
3947 }
3948
3949 octave_idx_type b_nc = b.cols ();
3950 retval = b;
3951 double *result = retval.fortran_vec ();
3952
3953 F77_XFCN (dgtsv, DGTSV, (nr, b_nc, DL, D, DU, result,
3954 b.rows (), err));
3955
3956 if (err != 0)
3957 {
3958 rcond = 0.;
3959 err = -2;
3960
3961 if (sing_handler)
3962 {
3963 sing_handler (rcond);
3964 mattype.mark_as_rectangular ();
3965 }
3966 else
3967 (*current_liboctave_error_handler)
3968 ("matrix singular to machine precision");
3969
3970 }
3971 else
3972 rcond = 1.;
3973 }
3974 else if (typ != MatrixType::Tridiagonal_Hermitian)
3975 (*current_liboctave_error_handler) ("incorrect matrix type");
3976 }
3977
3978 return retval;
3979 }
3980
3981 SparseMatrix
3982 SparseMatrix::trisolve (MatrixType &mattype, const SparseMatrix& b,
3983 octave_idx_type& err, double& rcond,
3984 solve_singularity_handler sing_handler,
3985 bool calc_cond) const
3986 {
3987 SparseMatrix retval;
3988
3989 octave_idx_type nr = rows ();
3990 octave_idx_type nc = cols ();
3991 err = 0;
3992
3993 if (nr != nc || nr != b.rows ())
3994 (*current_liboctave_error_handler)
3995 ("matrix dimension mismatch solution of linear equations");
3996 else if (nr == 0 || b.cols () == 0)
3997 retval = SparseMatrix (nc, b.cols ());
3998 else if (calc_cond)
3999 (*current_liboctave_error_handler)
4000 ("calculation of condition number not implemented");
4001 else
4002 {
4003 // Print spparms("spumoni") info if requested
4004 int typ = mattype.type ();
4005 mattype.info ();
4006
4007 // Note can't treat symmetric case as there is no dpttrf function
4008 if (typ == MatrixType::Tridiagonal ||
4009 typ == MatrixType::Tridiagonal_Hermitian)
4010 {
4011 OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2);
4012 OCTAVE_LOCAL_BUFFER (double, DU, nr - 1);
4013 OCTAVE_LOCAL_BUFFER (double, D, nr);
4014 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1);
4015 Array<octave_idx_type> ipvt (dim_vector (nr, 1));
4016 octave_idx_type *pipvt = ipvt.fortran_vec ();
4017
4018 if (mattype.is_dense ())
4019 {
4020 octave_idx_type ii = 0;
4021
4022 for (octave_idx_type j = 0; j < nc-1; j++)
4023 {
4024 D[j] = data (ii++);
4025 DL[j] = data (ii++);
4026 DU[j] = data (ii++);
4027 }
4028 D[nc-1] = data (ii);
4029 }
4030 else
4031 {
4032 D[0] = 0.;
4033 for (octave_idx_type i = 0; i < nr - 1; i++)
4034 {
4035 D[i+1] = 0.;
4036 DL[i] = 0.;
4037 DU[i] = 0.;
4038 }
4039
4040 for (octave_idx_type j = 0; j < nc; j++)
4041 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4042 {
4043 if (ridx (i) == j)
4044 D[j] = data (i);
4045 else if (ridx (i) == j + 1)
4046 DL[j] = data (i);
4047 else if (ridx (i) == j - 1)
4048 DU[j-1] = data (i);
4049 }
4050 }
4051
4052 F77_XFCN (dgttrf, DGTTRF, (nr, DL, D, DU, DU2, pipvt, err));
4053
4054 if (err != 0)
4055 {
4056 rcond = 0.0;
4057 err = -2;
4058
4059 if (sing_handler)
4060 {
4061 sing_handler (rcond);
4062 mattype.mark_as_rectangular ();
4063 }
4064 else
4065 (*current_liboctave_error_handler)
4066 ("matrix singular to machine precision");
4067
4068 }
4069 else
4070 {
4071 rcond = 1.0;
4072 char job = 'N';
4073 volatile octave_idx_type x_nz = b.nnz ();
4074 octave_idx_type b_nc = b.cols ();
4075 retval = SparseMatrix (nr, b_nc, x_nz);
4076 retval.xcidx (0) = 0;
4077 volatile octave_idx_type ii = 0;
4078
4079 OCTAVE_LOCAL_BUFFER (double, work, nr);
4080
4081 for (volatile octave_idx_type j = 0; j < b_nc; j++)
4082 {
4083 for (octave_idx_type i = 0; i < nr; i++)
4084 work[i] = 0.;
4085 for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
4086 work[b.ridx (i)] = b.data (i);
4087
4088 F77_XFCN (dgttrs, DGTTRS,
4089 (F77_CONST_CHAR_ARG2 (&job, 1),
4090 nr, 1, DL, D, DU, DU2, pipvt,
4091 work, b.rows (), err
4092 F77_CHAR_ARG_LEN (1)));
4093
4094 // Count non-zeros in work vector and adjust
4095 // space in retval if needed
4096 octave_idx_type new_nnz = 0;
4097 for (octave_idx_type i = 0; i < nr; i++)
4098 if (work[i] != 0.)
4099 new_nnz++;
4100
4101 if (ii + new_nnz > x_nz)
4102 {
4103 // Resize the sparse matrix
4104 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
4105 retval.change_capacity (sz);
4106 x_nz = sz;
4107 }
4108
4109 for (octave_idx_type i = 0; i < nr; i++)
4110 if (work[i] != 0.)
4111 {
4112 retval.xridx (ii) = i;
4113 retval.xdata (ii++) = work[i];
4114 }
4115 retval.xcidx (j+1) = ii;
4116 }
4117
4118 retval.maybe_compress ();
4119 }
4120 }
4121 else if (typ != MatrixType::Tridiagonal_Hermitian)
4122 (*current_liboctave_error_handler) ("incorrect matrix type");
4123 }
4124
4125 return retval;
4126 }
4127
4128 ComplexMatrix
4129 SparseMatrix::trisolve (MatrixType &mattype, const ComplexMatrix& b,
4130 octave_idx_type& err, double& rcond,
4131 solve_singularity_handler sing_handler,
4132 bool calc_cond) const
4133 {
4134 ComplexMatrix retval;
4135
4136 octave_idx_type nr = rows ();
4137 octave_idx_type nc = cols ();
4138 err = 0;
4139
4140 if (nr != nc || nr != b.rows ())
4141 (*current_liboctave_error_handler)
4142 ("matrix dimension mismatch solution of linear equations");
4143 else if (nr == 0 || b.cols () == 0)
4144 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
4145 else if (calc_cond)
4146 (*current_liboctave_error_handler)
4147 ("calculation of condition number not implemented");
4148 else
4149 {
4150 // Print spparms("spumoni") info if requested
4151 volatile int typ = mattype.type ();
4152 mattype.info ();
4153
4154 if (typ == MatrixType::Tridiagonal_Hermitian)
4155 {
4156 OCTAVE_LOCAL_BUFFER (double, D, nr);
4157 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1);
4158
4159 if (mattype.is_dense ())
4160 {
4161 octave_idx_type ii = 0;
4162
4163 for (octave_idx_type j = 0; j < nc-1; j++)
4164 {
4165 D[j] = data (ii++);
4166 DL[j] = data (ii);
4167 ii += 2;
4168 }
4169 D[nc-1] = data (ii);
4170 }
4171 else
4172 {
4173 D[0] = 0.;
4174 for (octave_idx_type i = 0; i < nr - 1; i++)
4175 {
4176 D[i+1] = 0.;
4177 DL[i] = 0.;
4178 }
4179
4180 for (octave_idx_type j = 0; j < nc; j++)
4181 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4182 {
4183 if (ridx (i) == j)
4184 D[j] = data (i);
4185 else if (ridx (i) == j + 1)
4186 DL[j] = data (i);
4187 }
4188 }
4189
4190 octave_idx_type b_nr = b.rows ();
4191 octave_idx_type b_nc = b.cols ();
4192 rcond = 1.;
4193
4194 retval = b;
4195 Complex *result = retval.fortran_vec ();
4196
4197 F77_XFCN (zptsv, ZPTSV, (nr, b_nc, D, DL, result,
4198 b_nr, err));
4199
4200 if (err != 0)
4201 {
4202 err = 0;
4203 mattype.mark_as_unsymmetric ();
4204 typ = MatrixType::Tridiagonal;
4205 }
4206 }
4207
4208 if (typ == MatrixType::Tridiagonal)
4209 {
4210 OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1);
4211 OCTAVE_LOCAL_BUFFER (Complex, D, nr);
4212 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1);
4213
4214 if (mattype.is_dense ())
4215 {
4216 octave_idx_type ii = 0;
4217
4218 for (octave_idx_type j = 0; j < nc-1; j++)
4219 {
4220 D[j] = data (ii++);
4221 DL[j] = data (ii++);
4222 DU[j] = data (ii++);
4223 }
4224 D[nc-1] = data (ii);
4225 }
4226 else
4227 {
4228 D[0] = 0.;
4229 for (octave_idx_type i = 0; i < nr - 1; i++)
4230 {
4231 D[i+1] = 0.;
4232 DL[i] = 0.;
4233 DU[i] = 0.;
4234 }
4235
4236 for (octave_idx_type j = 0; j < nc; j++)
4237 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4238 {
4239 if (ridx (i) == j)
4240 D[j] = data (i);
4241 else if (ridx (i) == j + 1)
4242 DL[j] = data (i);
4243 else if (ridx (i) == j - 1)
4244 DU[j-1] = data (i);
4245 }
4246 }
4247
4248 octave_idx_type b_nr = b.rows ();
4249 octave_idx_type b_nc = b.cols ();
4250 rcond = 1.;
4251
4252 retval = b;
4253 Complex *result = retval.fortran_vec ();
4254
4255 F77_XFCN (zgtsv, ZGTSV, (nr, b_nc, DL, D, DU, result,
4256 b_nr, err));
4257
4258 if (err != 0)
4259 {
4260 rcond = 0.;
4261 err = -2;
4262
4263 if (sing_handler)
4264 {
4265 sing_handler (rcond);
4266 mattype.mark_as_rectangular ();
4267 }
4268 else
4269 (*current_liboctave_error_handler)
4270 ("matrix singular to machine precision");
4271 }
4272 }
4273 else if (typ != MatrixType::Tridiagonal_Hermitian)
4274 (*current_liboctave_error_handler) ("incorrect matrix type");
4275 }
4276
4277 return retval;
4278 }
4279
4280 SparseComplexMatrix
4281 SparseMatrix::trisolve (MatrixType &mattype, const SparseComplexMatrix& b,
4282 octave_idx_type& err, double& rcond,
4283 solve_singularity_handler sing_handler,
4284 bool calc_cond) const
4285 {
4286 SparseComplexMatrix retval;
4287
4288 octave_idx_type nr = rows ();
4289 octave_idx_type nc = cols ();
4290 err = 0;
4291
4292 if (nr != nc || nr != b.rows ())
4293 (*current_liboctave_error_handler)
4294 ("matrix dimension mismatch solution of linear equations");
4295 else if (nr == 0 || b.cols () == 0)
4296 retval = SparseComplexMatrix (nc, b.cols ());
4297 else if (calc_cond)
4298 (*current_liboctave_error_handler)
4299 ("calculation of condition number not implemented");
4300 else
4301 {
4302 // Print spparms("spumoni") info if requested
4303 int typ = mattype.type ();
4304 mattype.info ();
4305
4306 // Note can't treat symmetric case as there is no dpttrf function
4307 if (typ == MatrixType::Tridiagonal ||
4308 typ == MatrixType::Tridiagonal_Hermitian)
4309 {
4310 OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2);
4311 OCTAVE_LOCAL_BUFFER (double, DU, nr - 1);
4312 OCTAVE_LOCAL_BUFFER (double, D, nr);
4313 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1);
4314 Array<octave_idx_type> ipvt (dim_vector (nr, 1));
4315 octave_idx_type *pipvt = ipvt.fortran_vec ();
4316
4317 if (mattype.is_dense ())
4318 {
4319 octave_idx_type ii = 0;
4320
4321 for (octave_idx_type j = 0; j < nc-1; j++)
4322 {
4323 D[j] = data (ii++);
4324 DL[j] = data (ii++);
4325 DU[j] = data (ii++);
4326 }
4327 D[nc-1] = data (ii);
4328 }
4329 else
4330 {
4331 D[0] = 0.;
4332 for (octave_idx_type i = 0; i < nr - 1; i++)
4333 {
4334 D[i+1] = 0.;
4335 DL[i] = 0.;
4336 DU[i] = 0.;
4337 }
4338
4339 for (octave_idx_type j = 0; j < nc; j++)
4340 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4341 {
4342 if (ridx (i) == j)
4343 D[j] = data (i);
4344 else if (ridx (i) == j + 1)
4345 DL[j] = data (i);
4346 else if (ridx (i) == j - 1)
4347 DU[j-1] = data (i);
4348 }
4349 }
4350
4351 F77_XFCN (dgttrf, DGTTRF, (nr, DL, D, DU, DU2, pipvt, err));
4352
4353 if (err != 0)
4354 {
4355 rcond = 0.0;
4356 err = -2;
4357
4358 if (sing_handler)
4359 {
4360 sing_handler (rcond);
4361 mattype.mark_as_rectangular ();
4362 }
4363 else
4364 (*current_liboctave_error_handler)
4365 ("matrix singular to machine precision");
4366 }
4367 else
4368 {
4369 rcond = 1.;
4370 char job = 'N';
4371 octave_idx_type b_nr = b.rows ();
4372 octave_idx_type b_nc = b.cols ();
4373 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
4374 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr);
4375
4376 // Take a first guess that the number of non-zero terms
4377 // will be as many as in b
4378 volatile octave_idx_type x_nz = b.nnz ();
4379 volatile octave_idx_type ii = 0;
4380 retval = SparseComplexMatrix (b_nr, b_nc, x_nz);
4381
4382 retval.xcidx (0) = 0;
4383 for (volatile octave_idx_type j = 0; j < b_nc; j++)
4384 {
4385
4386 for (octave_idx_type i = 0; i < b_nr; i++)
4387 {
4388 Complex c = b (i,j);
4389 Bx[i] = std::real (c);
4390 Bz[i] = std::imag (c);
4391 }
4392
4393 F77_XFCN (dgttrs, DGTTRS,
4394 (F77_CONST_CHAR_ARG2 (&job, 1),
4395 nr, 1, DL, D, DU, DU2, pipvt,
4396 Bx, b_nr, err
4397 F77_CHAR_ARG_LEN (1)));
4398
4399 if (err != 0)
4400 {
4401 (*current_liboctave_error_handler)
4402 ("SparseMatrix::solve solve failed");
4403
4404 err = -1;
4405 break;
4406 }
4407
4408 F77_XFCN (dgttrs, DGTTRS,
4409 (F77_CONST_CHAR_ARG2 (&job, 1),
4410 nr, 1, DL, D, DU, DU2, pipvt,
4411 Bz, b_nr, err
4412 F77_CHAR_ARG_LEN (1)));
4413
4414 if (err != 0)
4415 {
4416 (*current_liboctave_error_handler)
4417 ("SparseMatrix::solve solve failed");
4418
4419 err = -1;
4420 break;
4421 }
4422
4423 // Count non-zeros in work vector and adjust
4424 // space in retval if needed
4425 octave_idx_type new_nnz = 0;
4426 for (octave_idx_type i = 0; i < nr; i++)
4427 if (Bx[i] != 0. || Bz[i] != 0.)
4428 new_nnz++;
4429
4430 if (ii + new_nnz > x_nz)
4431 {
4432 // Resize the sparse matrix
4433 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
4434 retval.change_capacity (sz);
4435 x_nz = sz;
4436 }
4437
4438 for (octave_idx_type i = 0; i < nr; i++)
4439 if (Bx[i] != 0. || Bz[i] != 0.)
4440 {
4441 retval.xridx (ii) = i;
4442 retval.xdata (ii++) =
4443 Complex (Bx[i], Bz[i]);
4444 }
4445
4446 retval.xcidx (j+1) = ii;
4447 }
4448
4449 retval.maybe_compress ();
4450 }
4451 }
4452 else if (typ != MatrixType::Tridiagonal_Hermitian)
4453 (*current_liboctave_error_handler) ("incorrect matrix type");
4454 }
4455
4456 return retval;
4457 }
4458
4459 Matrix
4460 SparseMatrix::bsolve (MatrixType &mattype, const Matrix& b,
4461 octave_idx_type& err, double& rcond,
4462 solve_singularity_handler sing_handler,
4463 bool calc_cond) const
4464 {
4465 Matrix retval;
4466
4467 octave_idx_type nr = rows ();
4468 octave_idx_type nc = cols ();
4469 err = 0;
4470
4471 if (nr != nc || nr != b.rows ())
4472 (*current_liboctave_error_handler)
4473 ("matrix dimension mismatch solution of linear equations");
4474 else if (nr == 0 || b.cols () == 0)
4475 retval = Matrix (nc, b.cols (), 0.0);
4476 else
4477 {
4478 // Print spparms("spumoni") info if requested
4479 volatile int typ = mattype.type ();
4480 mattype.info ();
4481
4482 if (typ == MatrixType::Banded_Hermitian)
4483 {
4484 octave_idx_type n_lower = mattype.nlower ();
4485 octave_idx_type ldm = n_lower + 1;
4486 Matrix m_band (ldm, nc);
4487 double *tmp_data = m_band.fortran_vec ();
4488
4489 if (! mattype.is_dense ())
4490 {
4491 octave_idx_type ii = 0;
4492
4493 for (octave_idx_type j = 0; j < ldm; j++)
4494 for (octave_idx_type i = 0; i < nc; i++)
4495 tmp_data[ii++] = 0.;
4496 }
4497
4498 for (octave_idx_type j = 0; j < nc; j++)
4499 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4500 {
4501 octave_idx_type ri = ridx (i);
4502 if (ri >= j)
4503 m_band(ri - j, j) = data (i);
4504 }
4505
4506 // Calculate the norm of the matrix, for later use.
4507 double anorm;
4508 if (calc_cond)
4509 anorm = m_band.abs ().sum ().row (0).max ();
4510
4511 char job = 'L';
4512 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1),
4513 nr, n_lower, tmp_data, ldm, err
4514 F77_CHAR_ARG_LEN (1)));
4515
4516 if (err != 0)
4517 {
4518 // Matrix is not positive definite!! Fall through to
4519 // unsymmetric banded solver.
4520 mattype.mark_as_unsymmetric ();
4521 typ = MatrixType::Banded;
4522 rcond = 0.0;
4523 err = 0;
4524 }
4525 else
4526 {
4527 if (calc_cond)
4528 {
4529 Array<double> z (dim_vector (3 * nr, 1));
4530 double *pz = z.fortran_vec ();
4531 Array<octave_idx_type> iz (dim_vector (nr, 1));
4532 octave_idx_type *piz = iz.fortran_vec ();
4533
4534 F77_XFCN (dpbcon, DPBCON,
4535 (F77_CONST_CHAR_ARG2 (&job, 1),
4536 nr, n_lower, tmp_data, ldm,
4537 anorm, rcond, pz, piz, err
4538 F77_CHAR_ARG_LEN (1)));
4539
4540 if (err != 0)
4541 err = -2;
4542
4543 volatile double rcond_plus_one = rcond + 1.0;
4544
4545 if (rcond_plus_one == 1.0 || xisnan (rcond))
4546 {
4547 err = -2;
4548
4549 if (sing_handler)
4550 {
4551 sing_handler (rcond);
4552 mattype.mark_as_rectangular ();
4553 }
4554 else
4555 (*current_liboctave_error_handler)
4556 ("matrix singular to machine precision, rcond = %g",
4557 rcond);
4558 }
4559 }
4560 else
4561 rcond = 1.;
4562
4563 if (err == 0)
4564 {
4565 retval = b;
4566 double *result = retval.fortran_vec ();
4567
4568 octave_idx_type b_nc = b.cols ();
4569
4570 F77_XFCN (dpbtrs, DPBTRS,
4571 (F77_CONST_CHAR_ARG2 (&job, 1),
4572 nr, n_lower, b_nc, tmp_data,
4573 ldm, result, b.rows (), err
4574 F77_CHAR_ARG_LEN (1)));
4575
4576 if (err != 0)
4577 {
4578 (*current_liboctave_error_handler)
4579 ("SparseMatrix::solve solve failed");
4580 err = -1;
4581 }
4582 }
4583 }
4584 }
4585
4586 if (typ == MatrixType::Banded)
4587 {
4588 // Create the storage for the banded form of the sparse matrix
4589 octave_idx_type n_upper = mattype.nupper ();
4590 octave_idx_type n_lower = mattype.nlower ();
4591 octave_idx_type ldm = n_upper + 2 * n_lower + 1;
4592
4593 Matrix m_band (ldm, nc);
4594 double *tmp_data = m_band.fortran_vec ();
4595
4596 if (! mattype.is_dense ())
4597 {
4598 octave_idx_type ii = 0;
4599
4600 for (octave_idx_type j = 0; j < ldm; j++)
4601 for (octave_idx_type i = 0; i < nc; i++)
4602 tmp_data[ii++] = 0.;
4603 }
4604
4605 for (octave_idx_type j = 0; j < nc; j++)
4606 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4607 m_band(ridx (i) - j + n_lower + n_upper, j) = data (i);
4608
4609 // Calculate the norm of the matrix, for later use.
4610 double anorm;
4611 if (calc_cond)
4612 {
4613 for (octave_idx_type j = 0; j < nr; j++)
4614 {
4615 double atmp = 0.;
4616 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4617 atmp += fabs (data (i));
4618 if (atmp > anorm)
4619 anorm = atmp;
4620 }
4621 }
4622
4623 Array<octave_idx_type> ipvt (dim_vector (nr, 1));
4624 octave_idx_type *pipvt = ipvt.fortran_vec ();
4625
4626 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data,
4627 ldm, pipvt, err));
4628
4629 // Throw-away extra info LAPACK gives so as to not
4630 // change output.
4631 if (err != 0)
4632 {
4633 err = -2;
4634 rcond = 0.0;
4635
4636 if (sing_handler)
4637 {
4638 sing_handler (rcond);
4639 mattype.mark_as_rectangular ();
4640 }
4641 else
4642 (*current_liboctave_error_handler)
4643 ("matrix singular to machine precision");
4644
4645 }
4646 else
4647 {
4648 if (calc_cond)
4649 {
4650 char job = '1';
4651 Array<double> z (dim_vector (3 * nr, 1));
4652 double *pz = z.fortran_vec ();
4653 Array<octave_idx_type> iz (dim_vector (nr, 1));
4654 octave_idx_type *piz = iz.fortran_vec ();
4655
4656 F77_XFCN (dgbcon, DGBCON,
4657 (F77_CONST_CHAR_ARG2 (&job, 1),
4658 nc, n_lower, n_upper, tmp_data, ldm, pipvt,
4659 anorm, rcond, pz, piz, err
4660 F77_CHAR_ARG_LEN (1)));
4661
4662 if (err != 0)
4663 err = -2;
4664
4665 volatile double rcond_plus_one = rcond + 1.0;
4666
4667 if (rcond_plus_one == 1.0 || xisnan (rcond))
4668 {
4669 err = -2;
4670
4671 if (sing_handler)
4672 {
4673 sing_handler (rcond);
4674 mattype.mark_as_rectangular ();
4675 }
4676 else
4677 (*current_liboctave_error_handler)
4678 ("matrix singular to machine precision, rcond = %g",
4679 rcond);
4680 }
4681 }
4682 else
4683 rcond = 1.;
4684
4685 if (err == 0)
4686 {
4687 retval = b;
4688 double *result = retval.fortran_vec ();
4689
4690 octave_idx_type b_nc = b.cols ();
4691
4692 char job = 'N';
4693 F77_XFCN (dgbtrs, DGBTRS,
4694 (F77_CONST_CHAR_ARG2 (&job, 1),
4695 nr, n_lower, n_upper, b_nc, tmp_data,
4696 ldm, pipvt, result, b.rows (), err
4697 F77_CHAR_ARG_LEN (1)));
4698 }
4699 }
4700 }
4701 else if (typ != MatrixType::Banded_Hermitian)
4702 (*current_liboctave_error_handler) ("incorrect matrix type");
4703 }
4704
4705 return retval;
4706 }
4707
4708 SparseMatrix
4709 SparseMatrix::bsolve (MatrixType &mattype, const SparseMatrix& b,
4710 octave_idx_type& err, double& rcond,
4711 solve_singularity_handler sing_handler,
4712 bool calc_cond) const
4713 {
4714 SparseMatrix retval;
4715
4716 octave_idx_type nr = rows ();
4717 octave_idx_type nc = cols ();
4718 err = 0;
4719
4720 if (nr != nc || nr != b.rows ())
4721 (*current_liboctave_error_handler)
4722 ("matrix dimension mismatch solution of linear equations");
4723 else if (nr == 0 || b.cols () == 0)
4724 retval = SparseMatrix (nc, b.cols ());
4725 else
4726 {
4727 // Print spparms("spumoni") info if requested
4728 volatile int typ = mattype.type ();
4729 mattype.info ();
4730
4731 if (typ == MatrixType::Banded_Hermitian)
4732 {
4733 octave_idx_type n_lower = mattype.nlower ();
4734 octave_idx_type ldm = n_lower + 1;
4735
4736 Matrix m_band (ldm, nc);
4737 double *tmp_data = m_band.fortran_vec ();
4738
4739 if (! mattype.is_dense ())
4740 {
4741 octave_idx_type ii = 0;
4742
4743 for (octave_idx_type j = 0; j < ldm; j++)
4744 for (octave_idx_type i = 0; i < nc; i++)
4745 tmp_data[ii++] = 0.;
4746 }
4747
4748 for (octave_idx_type j = 0; j < nc; j++)
4749 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4750 {
4751 octave_idx_type ri = ridx (i);
4752 if (ri >= j)
4753 m_band(ri - j, j) = data (i);
4754 }
4755
4756 // Calculate the norm of the matrix, for later use.
4757 double anorm;
4758 if (calc_cond)
4759 anorm = m_band.abs ().sum ().row (0).max ();
4760
4761 char job = 'L';
4762 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1),
4763 nr, n_lower, tmp_data, ldm, err
4764 F77_CHAR_ARG_LEN (1)));
4765
4766 if (err != 0)
4767 {
4768 mattype.mark_as_unsymmetric ();
4769 typ = MatrixType::Banded;
4770 rcond = 0.0;
4771 err = 0;
4772 }
4773 else
4774 {
4775 if (calc_cond)
4776 {
4777 Array<double> z (dim_vector (3 * nr, 1));
4778 double *pz = z.fortran_vec ();
4779 Array<octave_idx_type> iz (dim_vector (nr, 1));
4780 octave_idx_type *piz = iz.fortran_vec ();
4781
4782 F77_XFCN (dpbcon, DPBCON,
4783 (F77_CONST_CHAR_ARG2 (&job, 1),
4784 nr, n_lower, tmp_data, ldm,
4785 anorm, rcond, pz, piz, err
4786 F77_CHAR_ARG_LEN (1)));
4787
4788 if (err != 0)
4789 err = -2;
4790
4791 volatile double rcond_plus_one = rcond + 1.0;
4792
4793 if (rcond_plus_one == 1.0 || xisnan (rcond))
4794 {
4795 err = -2;
4796
4797 if (sing_handler)
4798 {
4799 sing_handler (rcond);
4800 mattype.mark_as_rectangular ();
4801 }
4802 else
4803 (*current_liboctave_error_handler)
4804 ("matrix singular to machine precision, rcond = %g",
4805 rcond);
4806 }
4807 }
4808 else
4809 rcond = 1.;
4810
4811 if (err == 0)
4812 {
4813 octave_idx_type b_nr = b.rows ();
4814 octave_idx_type b_nc = b.cols ();
4815 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
4816
4817 // Take a first guess that the number of non-zero terms
4818 // will be as many as in b
4819 volatile octave_idx_type x_nz = b.nnz ();
4820 volatile octave_idx_type ii = 0;
4821 retval = SparseMatrix (b_nr, b_nc, x_nz);
4822
4823 retval.xcidx (0) = 0;
4824 for (volatile octave_idx_type j = 0; j < b_nc; j++)
4825 {
4826 for (octave_idx_type i = 0; i < b_nr; i++)
4827 Bx[i] = b.elem (i, j);
4828
4829 F77_XFCN (dpbtrs, DPBTRS,
4830 (F77_CONST_CHAR_ARG2 (&job, 1),
4831 nr, n_lower, 1, tmp_data,
4832 ldm, Bx, b_nr, err
4833 F77_CHAR_ARG_LEN (1)));
4834
4835 if (err != 0)
4836 {
4837 (*current_liboctave_error_handler)
4838 ("SparseMatrix::solve solve failed");
4839 err = -1;
4840 break;
4841 }
4842
4843 for (octave_idx_type i = 0; i < b_nr; i++)
4844 {
4845 double tmp = Bx[i];
4846 if (tmp != 0.0)
4847 {
4848 if (ii == x_nz)
4849 {
4850 // Resize the sparse matrix
4851 octave_idx_type sz = x_nz *
4852 (b_nc - j) / b_nc;
4853 sz = (sz > 10 ? sz : 10) + x_nz;
4854 retval.change_capacity (sz);
4855 x_nz = sz;
4856 }
4857 retval.xdata (ii) = tmp;
4858 retval.xridx (ii++) = i;
4859 }
4860 }
4861 retval.xcidx (j+1) = ii;
4862 }
4863
4864 retval.maybe_compress ();
4865 }
4866 }
4867 }
4868
4869 if (typ == MatrixType::Banded)
4870 {
4871 // Create the storage for the banded form of the sparse matrix
4872 octave_idx_type n_upper = mattype.nupper ();
4873 octave_idx_type n_lower = mattype.nlower ();
4874 octave_idx_type ldm = n_upper + 2 * n_lower + 1;
4875
4876 Matrix m_band (ldm, nc);
4877 double *tmp_data = m_band.fortran_vec ();
4878
4879 if (! mattype.is_dense ())
4880 {
4881 octave_idx_type ii = 0;
4882
4883 for (octave_idx_type j = 0; j < ldm; j++)
4884 for (octave_idx_type i = 0; i < nc; i++)
4885 tmp_data[ii++] = 0.;
4886 }
4887
4888 for (octave_idx_type j = 0; j < nc; j++)
4889 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4890 m_band(ridx (i) - j + n_lower + n_upper, j) = data (i);
4891
4892 // Calculate the norm of the matrix, for later use.
4893 double anorm;
4894 if (calc_cond)
4895 {
4896 for (octave_idx_type j = 0; j < nr; j++)
4897 {
4898 double atmp = 0.;
4899 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4900 atmp += fabs (data (i));
4901 if (atmp > anorm)
4902 anorm = atmp;
4903 }
4904 }
4905
4906 Array<octave_idx_type> ipvt (dim_vector (nr, 1));
4907 octave_idx_type *pipvt = ipvt.fortran_vec ();
4908
4909 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data,
4910 ldm, pipvt, err));
4911
4912 if (err != 0)
4913 {
4914 err = -2;
4915 rcond = 0.0;
4916
4917 if (sing_handler)
4918 {
4919 sing_handler (rcond);
4920 mattype.mark_as_rectangular ();
4921 }
4922 else
4923 (*current_liboctave_error_handler)
4924 ("matrix singular to machine precision");
4925
4926 }
4927 else
4928 {
4929 if (calc_cond)
4930 {
4931 char job = '1';
4932 Array<double> z (dim_vector (3 * nr, 1));
4933 double *pz = z.fortran_vec ();
4934 Array<octave_idx_type> iz (dim_vector (nr, 1));
4935 octave_idx_type *piz = iz.fortran_vec ();
4936
4937 F77_XFCN (dgbcon, DGBCON,
4938 (F77_CONST_CHAR_ARG2 (&job, 1),
4939 nc, n_lower, n_upper, tmp_data, ldm, pipvt,
4940 anorm, rcond, pz, piz, err
4941 F77_CHAR_ARG_LEN (1)));
4942
4943 if (err != 0)
4944 err = -2;
4945
4946 volatile double rcond_plus_one = rcond + 1.0;
4947
4948 if (rcond_plus_one == 1.0 || xisnan (rcond))
4949 {
4950 err = -2;
4951
4952 if (sing_handler)
4953 {
4954 sing_handler (rcond);
4955 mattype.mark_as_rectangular ();
4956 }
4957 else
4958 (*current_liboctave_error_handler)
4959 ("matrix singular to machine precision, rcond = %g",
4960 rcond);
4961 }
4962 }
4963 else
4964 rcond = 1.;
4965
4966 if (err == 0)
4967 {
4968 char job = 'N';
4969 volatile octave_idx_type x_nz = b.nnz ();
4970 octave_idx_type b_nc = b.cols ();
4971 retval = SparseMatrix (nr, b_nc, x_nz);
4972 retval.xcidx (0) = 0;
4973 volatile octave_idx_type ii = 0;
4974
4975 OCTAVE_LOCAL_BUFFER (double, work, nr);
4976
4977 for (volatile octave_idx_type j = 0; j < b_nc; j++)
4978 {
4979 for (octave_idx_type i = 0; i < nr; i++)
4980 work[i] = 0.;
4981 for (octave_idx_type i = b.cidx (j);
4982 i < b.cidx (j+1); i++)
4983 work[b.ridx (i)] = b.data (i);
4984
4985 F77_XFCN (dgbtrs, DGBTRS,
4986 (F77_CONST_CHAR_ARG2 (&job, 1),
4987 nr, n_lower, n_upper, 1, tmp_data,
4988 ldm, pipvt, work, b.rows (), err
4989 F77_CHAR_ARG_LEN (1)));
4990
4991 // Count non-zeros in work vector and adjust
4992 // space in retval if needed
4993 octave_idx_type new_nnz = 0;
4994 for (octave_idx_type i = 0; i < nr; i++)
4995 if (work[i] != 0.)
4996 new_nnz++;
4997
4998 if (ii + new_nnz > x_nz)
4999 {
5000 // Resize the sparse matrix
5001 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
5002 retval.change_capacity (sz);
5003 x_nz = sz;
5004 }
5005
5006 for (octave_idx_type i = 0; i < nr; i++)
5007 if (work[i] != 0.)
5008 {
5009 retval.xridx (ii) = i;
5010 retval.xdata (ii++) = work[i];
5011 }
5012 retval.xcidx (j+1) = ii;
5013 }
5014
5015 retval.maybe_compress ();
5016 }
5017 }
5018 }
5019 else if (typ != MatrixType::Banded_Hermitian)
5020 (*current_liboctave_error_handler) ("incorrect matrix type");
5021 }
5022
5023 return retval;
5024 }
5025
5026 ComplexMatrix
5027 SparseMatrix::bsolve (MatrixType &mattype, const ComplexMatrix& b,
5028 octave_idx_type& err, double& rcond,
5029 solve_singularity_handler sing_handler,
5030 bool calc_cond) const
5031 {
5032 ComplexMatrix retval;
5033
5034 octave_idx_type nr = rows ();
5035 octave_idx_type nc = cols ();
5036 err = 0;
5037
5038 if (nr != nc || nr != b.rows ())
5039 (*current_liboctave_error_handler)
5040 ("matrix dimension mismatch solution of linear equations");
5041 else if (nr == 0 || b.cols () == 0)
5042 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
5043 else
5044 {
5045 // Print spparms("spumoni") info if requested
5046 volatile int typ = mattype.type ();
5047 mattype.info ();
5048
5049 if (typ == MatrixType::Banded_Hermitian)
5050 {
5051 octave_idx_type n_lower = mattype.nlower ();
5052 octave_idx_type ldm = n_lower + 1;
5053
5054 Matrix m_band (ldm, nc);
5055 double *tmp_data = m_band.fortran_vec ();
5056
5057 if (! mattype.is_dense ())
5058 {
5059 octave_idx_type ii = 0;
5060
5061 for (octave_idx_type j = 0; j < ldm; j++)
5062 for (octave_idx_type i = 0; i < nc; i++)
5063 tmp_data[ii++] = 0.;
5064 }
5065
5066 for (octave_idx_type j = 0; j < nc; j++)
5067 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
5068 {
5069 octave_idx_type ri = ridx (i);
5070 if (ri >= j)
5071 m_band(ri - j, j) = data (i);
5072 }
5073
5074 // Calculate the norm of the matrix, for later use.
5075 double anorm;
5076 if (calc_cond)
5077 anorm = m_band.abs ().sum ().row (0).max ();
5078
5079 char job = 'L';
5080 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1),
5081 nr, n_lower, tmp_data, ldm, err
5082 F77_CHAR_ARG_LEN (1)));
5083
5084 if (err != 0)
5085 {
5086 // Matrix is not positive definite!! Fall through to
5087 // unsymmetric banded solver.
5088 mattype.mark_as_unsymmetric ();
5089 typ = MatrixType::Banded;
5090 rcond = 0.0;
5091 err = 0;
5092 }
5093 else
5094 {
5095 if (calc_cond)
5096 {
5097 Array<double> z (dim_vector (3 * nr, 1));
5098 double *pz = z.fortran_vec ();
5099 Array<octave_idx_type> iz (dim_vector (nr, 1));
5100 octave_idx_type *piz = iz.fortran_vec ();
5101
5102 F77_XFCN (dpbcon, DPBCON,
5103 (F77_CONST_CHAR_ARG2 (&job, 1),
5104 nr, n_lower, tmp_data, ldm,
5105 anorm, rcond, pz, piz, err
5106 F77_CHAR_ARG_LEN (1)));
5107
5108 if (err != 0)
5109 err = -2;
5110
5111 volatile double rcond_plus_one = rcond + 1.0;
5112
5113 if (rcond_plus_one == 1.0 || xisnan (rcond))
5114 {
5115 err = -2;
5116
5117 if (sing_handler)
5118 {
5119 sing_handler (rcond);
5120 mattype.mark_as_rectangular ();
5121 }
5122 else
5123 (*current_liboctave_error_handler)
5124 ("matrix singular to machine precision, rcond = %g",
5125 rcond);
5126 }
5127 }
5128 else
5129 rcond = 1.;
5130
5131 if (err == 0)
5132 {
5133 octave_idx_type b_nr = b.rows ();
5134 octave_idx_type b_nc = b.cols ();
5135
5136 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
5137 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr);
5138
5139 retval.resize (b_nr, b_nc);
5140
5141 for (volatile octave_idx_type j = 0; j < b_nc; j++)
5142 {
5143 for (octave_idx_type i = 0; i < b_nr; i++)
5144 {
5145 Complex c = b (i,j);
5146 Bx[i] = std::real (c);
5147 Bz[i] = std::imag (c);
5148 }
5149
5150 F77_XFCN (dpbtrs, DPBTRS,
5151 (F77_CONST_CHAR_ARG2 (&job, 1),
5152 nr, n_lower, 1, tmp_data,
5153 ldm, Bx, b_nr, err
5154 F77_CHAR_ARG_LEN (1)));
5155
5156 if (err != 0)
5157 {
5158 (*current_liboctave_error_handler)
5159 ("SparseMatrix::solve solve failed");
5160 err = -1;
5161 break;
5162 }
5163
5164 F77_XFCN (dpbtrs, DPBTRS,
5165 (F77_CONST_CHAR_ARG2 (&job, 1),
5166 nr, n_lower, 1, tmp_data,
5167 ldm, Bz, b.rows (), err
5168 F77_CHAR_ARG_LEN (1)));
5169
5170 if (err != 0)
5171 {
5172 (*current_liboctave_error_handler)
5173 ("SparseMatrix::solve solve failed");
5174 err = -1;
5175 break;
5176 }
5177
5178 for (octave_idx_type i = 0; i < b_nr; i++)
5179 retval(i, j) = Complex (Bx[i], Bz[i]);
5180 }
5181 }
5182 }
5183 }
5184
5185 if (typ == MatrixType::Banded)
5186 {
5187 // Create the storage for the banded form of the sparse matrix
5188 octave_idx_type n_upper = mattype.nupper ();
5189 octave_idx_type n_lower = mattype.nlower ();
5190 octave_idx_type ldm = n_upper + 2 * n_lower + 1;
5191
5192 Matrix m_band (ldm, nc);
5193 double *tmp_data = m_band.fortran_vec ();
5194
5195 if (! mattype.is_dense ())
5196 {
5197 octave_idx_type ii = 0;
5198
5199 for (octave_idx_type j = 0; j < ldm; j++)
5200 for (octave_idx_type i = 0; i < nc; i++)
5201 tmp_data[ii++] = 0.;
5202 }
5203
5204 for (octave_idx_type j = 0; j < nc; j++)
5205 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
5206 m_band(ridx (i) - j + n_lower + n_upper, j) = data (i);
5207
5208 // Calculate the norm of the matrix, for later use.
5209 double anorm;
5210 if (calc_cond)
5211 {
5212 for (octave_idx_type j = 0; j < nr; j++)
5213 {
5214 double atmp = 0.;
5215 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
5216 atmp += fabs (data (i));
5217 if (atmp > anorm)
5218 anorm = atmp;
5219 }
5220 }
5221
5222 Array<octave_idx_type> ipvt (dim_vector (nr, 1));
5223 octave_idx_type *pipvt = ipvt.fortran_vec ();
5224
5225 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data,
5226 ldm, pipvt, err));
5227
5228 if (err != 0)
5229 {
5230 err = -2;
5231 rcond = 0.0;
5232
5233 if (sing_handler)
5234 {
5235 sing_handler (rcond);
5236 mattype.mark_as_rectangular ();
5237 }
5238 else
5239 (*current_liboctave_error_handler)
5240 ("matrix singular to machine precision");
5241
5242 }
5243 else
5244 {
5245 if (calc_cond)
5246 {
5247 char job = '1';
5248 Array<double> z (dim_vector (3 * nr, 1));
5249 double *pz = z.fortran_vec ();
5250 Array<octave_idx_type> iz (dim_vector (nr, 1));
5251 octave_idx_type *piz = iz.fortran_vec ();
5252
5253 F77_XFCN (dpbcon, DPBCON,
5254 (F77_CONST_CHAR_ARG2 (&job, 1),
5255 nr, n_lower, tmp_data, ldm,
5256 anorm, rcond, pz, piz, err
5257 F77_CHAR_ARG_LEN (1)));
5258
5259 if (err != 0)
5260 err = -2;
5261
5262 volatile double rcond_plus_one = rcond + 1.0;
5263
5264 if (rcond_plus_one == 1.0 || xisnan (rcond))
5265 {
5266 err = -2;
5267
5268 if (sing_handler)
5269 {
5270 sing_handler (rcond);
5271 mattype.mark_as_rectangular ();
5272 }
5273 else
5274 (*current_liboctave_error_handler)
5275 ("matrix singular to machine precision, rcond = %g",
5276 rcond);
5277 }
5278 }
5279 else
5280 rcond = 1.;
5281
5282 if (err == 0)
5283 {
5284 char job = 'N';
5285 octave_idx_type b_nc = b.cols ();
5286 retval.resize (nr,b_nc);
5287
5288 OCTAVE_LOCAL_BUFFER (double, Bz, nr);
5289 OCTAVE_LOCAL_BUFFER (double, Bx, nr);
5290
5291 for (volatile octave_idx_type j = 0; j < b_nc; j++)
5292 {
5293 for (octave_idx_type i = 0; i < nr; i++)
5294 {
5295 Complex c = b (i, j);
5296 Bx[i] = std::real (c);
5297 Bz[i] = std::imag (c);
5298 }
5299
5300 F77_XFCN (dgbtrs, DGBTRS,
5301 (F77_CONST_CHAR_ARG2 (&job, 1),
5302 nr, n_lower, n_upper, 1, tmp_data,
5303 ldm, pipvt, Bx, b.rows (), err
5304 F77_CHAR_ARG_LEN (1)));
5305
5306 F77_XFCN (dgbtrs, DGBTRS,
5307 (F77_CONST_CHAR_ARG2 (&job, 1),
5308 nr, n_lower, n_upper, 1, tmp_data,
5309 ldm, pipvt, Bz, b.rows (), err
5310 F77_CHAR_ARG_LEN (1)));
5311
5312 for (octave_idx_type i = 0; i < nr; i++)
5313 retval(i, j) = Complex (Bx[i], Bz[i]);
5314 }
5315 }
5316 }
5317 }
5318 else if (typ != MatrixType::Banded_Hermitian)
5319 (*current_liboctave_error_handler) ("incorrect matrix type");
5320 }
5321
5322 return retval;
5323 }
5324
5325 SparseComplexMatrix
5326 SparseMatrix::bsolve (MatrixType &mattype, const SparseComplexMatrix& b,
5327 octave_idx_type& err, double& rcond,
5328 solve_singularity_handler sing_handler,
5329 bool calc_cond) const
5330 {
5331 SparseComplexMatrix retval;
5332
5333 octave_idx_type nr = rows ();
5334 octave_idx_type nc = cols ();
5335 err = 0;
5336
5337 if (nr != nc || nr != b.rows ())
5338 (*current_liboctave_error_handler)
5339 ("matrix dimension mismatch solution of linear equations");
5340 else if (nr == 0 || b.cols () == 0)
5341 retval = SparseComplexMatrix (nc, b.cols ());
5342 else
5343 {
5344 // Print spparms("spumoni") info if requested
5345 volatile int typ = mattype.type ();
5346 mattype.info ();
5347
5348 if (typ == MatrixType::Banded_Hermitian)
5349 {
5350 octave_idx_type n_lower = mattype.nlower ();
5351 octave_idx_type ldm = n_lower + 1;
5352
5353 Matrix m_band (ldm, nc);
5354 double *tmp_data = m_band.fortran_vec ();
5355
5356 if (! mattype.is_dense ())
5357 {
5358 octave_idx_type ii = 0;
5359
5360 for (octave_idx_type j = 0; j < ldm; j++)
5361 for (octave_idx_type i = 0; i < nc; i++)
5362 tmp_data[ii++] = 0.;
5363 }
5364
5365 for (octave_idx_type j = 0; j < nc; j++)
5366 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
5367 {
5368 octave_idx_type ri = ridx (i);
5369 if (ri >= j)
5370 m_band(ri - j, j) = data (i);
5371 }
5372
5373 // Calculate the norm of the matrix, for later use.
5374 double anorm;
5375 if (calc_cond)
5376 anorm = m_band.abs ().sum ().row (0).max ();
5377
5378 char job = 'L';
5379 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1),
5380 nr, n_lower, tmp_data, ldm, err
5381 F77_CHAR_ARG_LEN (1)));
5382
5383 if (err != 0)
5384 {
5385 // Matrix is not positive definite!! Fall through to
5386 // unsymmetric banded solver.
5387 mattype.mark_as_unsymmetric ();
5388 typ = MatrixType::Banded;
5389
5390 rcond = 0.0;
5391 err = 0;
5392 }
5393 else
5394 {
5395 if (calc_cond)
5396 {
5397 Array<double> z (dim_vector (3 * nr, 1));
5398 double *pz = z.fortran_vec ();
5399 Array<octave_idx_type> iz (dim_vector (nr, 1));
5400 octave_idx_type *piz = iz.fortran_vec ();
5401
5402 F77_XFCN (dpbcon, DPBCON,
5403 (F77_CONST_CHAR_ARG2 (&job, 1),
5404 nr, n_lower, tmp_data, ldm,
5405 anorm, rcond, pz, piz, err
5406 F77_CHAR_ARG_LEN (1)));
5407
5408 if (err != 0)
5409 err = -2;
5410
5411 volatile double rcond_plus_one = rcond + 1.0;
5412
5413 if (rcond_plus_one == 1.0 || xisnan (rcond))
5414 {
5415 err = -2;
5416
5417 if (sing_handler)
5418 {
5419 sing_handler (rcond);
5420 mattype.mark_as_rectangular ();
5421 }
5422 else
5423 (*current_liboctave_error_handler)
5424 ("matrix singular to machine precision, rcond = %g",
5425 rcond);
5426 }
5427 }
5428 else
5429 rcond = 1.;
5430
5431 if (err == 0)
5432 {
5433 octave_idx_type b_nr = b.rows ();
5434 octave_idx_type b_nc = b.cols ();
5435 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
5436 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr);
5437
5438 // Take a first guess that the number of non-zero terms
5439 // will be as many as in b
5440 volatile octave_idx_type x_nz = b.nnz ();
5441 volatile octave_idx_type ii = 0;
5442 retval = SparseComplexMatrix (b_nr, b_nc, x_nz);
5443
5444 retval.xcidx (0) = 0;
5445 for (volatile octave_idx_type j = 0; j < b_nc; j++)
5446 {
5447
5448 for (octave_idx_type i = 0; i < b_nr; i++)
5449 {
5450 Complex c = b (i,j);
5451 Bx[i] = std::real (c);
5452 Bz[i] = std::imag (c);
5453 }
5454
5455 F77_XFCN (dpbtrs, DPBTRS,
5456 (F77_CONST_CHAR_ARG2 (&job, 1),
5457 nr, n_lower, 1, tmp_data,
5458 ldm, Bx, b_nr, err
5459 F77_CHAR_ARG_LEN (1)));
5460
5461 if (err != 0)
5462 {
5463 (*current_liboctave_error_handler)
5464 ("SparseMatrix::solve solve failed");
5465 err = -1;
5466 break;
5467 }
5468
5469 F77_XFCN (dpbtrs, DPBTRS,
5470 (F77_CONST_CHAR_ARG2 (&job, 1),
5471 nr, n_lower, 1, tmp_data,
5472 ldm, Bz, b_nr, err
5473 F77_CHAR_ARG_LEN (1)));
5474
5475 if (err != 0)
5476 {
5477 (*current_liboctave_error_handler)
5478 ("SparseMatrix::solve solve failed");
5479
5480 err = -1;
5481 break;
5482 }
5483
5484 // Count non-zeros in work vector and adjust
5485 // space in retval if needed
5486 octave_idx_type new_nnz = 0;
5487 for (octave_idx_type i = 0; i < nr; i++)
5488 if (Bx[i] != 0. || Bz[i] != 0.)
5489 new_nnz++;
5490
5491 if (ii + new_nnz > x_nz)
5492 {
5493 // Resize the sparse matrix
5494 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
5495 retval.change_capacity (sz);
5496 x_nz = sz;
5497 }
5498
5499 for (octave_idx_type i = 0; i < nr; i++)
5500 if (Bx[i] != 0. || Bz[i] != 0.)
5501 {
5502 retval.xridx (ii) = i;
5503 retval.xdata (ii++) =
5504 Complex (Bx[i], Bz[i]);
5505 }
5506
5507 retval.xcidx (j+1) = ii;
5508 }
5509
5510 retval.maybe_compress ();
5511 }
5512 }
5513 }
5514
5515 if (typ == MatrixType::Banded)
5516 {
5517 // Create the storage for the banded form of the sparse matrix
5518 octave_idx_type n_upper = mattype.nupper ();
5519 octave_idx_type n_lower = mattype.nlower ();
5520 octave_idx_type ldm = n_upper + 2 * n_lower + 1;
5521
5522 Matrix m_band (ldm, nc);
5523 double *tmp_data = m_band.fortran_vec ();
5524
5525 if (! mattype.is_dense ())
5526 {
5527 octave_idx_type ii = 0;
5528
5529 for (octave_idx_type j = 0; j < ldm; j++)
5530 for (octave_idx_type i = 0; i < nc; i++)
5531 tmp_data[ii++] = 0.;
5532 }
5533
5534 for (octave_idx_type j = 0; j < nc; j++)
5535 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
5536 m_band(ridx (i) - j + n_lower + n_upper, j) = data (i);
5537
5538 // Calculate the norm of the matrix, for later use.
5539 double anorm;
5540 if (calc_cond)
5541 {
5542 for (octave_idx_type j = 0; j < nr; j++)
5543 {
5544 double atmp = 0.;
5545 for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
5546 atmp += fabs (data (i));
5547 if (atmp > anorm)
5548 anorm = atmp;
5549 }
5550 }
5551
5552 Array<octave_idx_type> ipvt (dim_vector (nr, 1));
5553 octave_idx_type *pipvt = ipvt.fortran_vec ();
5554
5555 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data,
5556 ldm, pipvt, err));
5557
5558 if (err != 0)
5559 {
5560 err = -2;
5561 rcond = 0.0;
5562
5563 if (sing_handler)
5564 {
5565 sing_handler (rcond);
5566 mattype.mark_as_rectangular ();
5567 }
5568 else
5569 (*current_liboctave_error_handler)
5570 ("matrix singular to machine precision");
5571
5572 }
5573 else
5574 {
5575 if (calc_cond)
5576 {
5577 char job = '1';
5578 Array<double> z (dim_vector (3 * nr, 1));
5579 double *pz = z.fortran_vec ();
5580 Array<octave_idx_type> iz (dim_vector (nr, 1));
5581 octave_idx_type *piz = iz.fortran_vec ();
5582
5583 F77_XFCN (dgbcon, DGBCON,
5584 (F77_CONST_CHAR_ARG2 (&job, 1),
5585 nc, n_lower, n_upper, tmp_data, ldm, pipvt,
5586 anorm, rcond, pz, piz, err
5587 F77_CHAR_ARG_LEN (1)));
5588
5589 if (err != 0)
5590 err = -2;
5591
5592 volatile double rcond_plus_one = rcond + 1.0;
5593
5594 if (rcond_plus_one == 1.0 || xisnan (rcond))
5595 {
5596 err = -2;
5597
5598 if (sing_handler)
5599 {
5600 sing_handler (rcond);
5601 mattype.mark_as_rectangular ();
5602 }
5603 else
5604 (*current_liboctave_error_handler)
5605 ("matrix singular to machine precision, rcond = %g",
5606 rcond);
5607 }
5608 }
5609 else
5610 rcond = 1.;
5611
5612 if (err == 0)
5613 {
5614 char job = 'N';
5615 volatile octave_idx_type x_nz = b.nnz ();
5616 octave_idx_type b_nc = b.cols ();
5617 retval = SparseComplexMatrix (nr, b_nc, x_nz);
5618 retval.xcidx (0) = 0;
5619 volatile octave_idx_type ii = 0;
5620
5621 OCTAVE_LOCAL_BUFFER (double, Bx, nr);
5622 OCTAVE_LOCAL_BUFFER (double, Bz, nr);
5623
5624 for (volatile octave_idx_type j = 0; j < b_nc; j++)
5625 {
5626 for (octave_idx_type i = 0; i < nr; i++)
5627 {
5628 Bx[i] = 0.;
5629 Bz[i] = 0.;
5630 }
5631 for (octave_idx_type i = b.cidx (j);
5632 i < b.cidx (j+1); i++)
5633 {
5634 Complex c = b.data (i);
5635 Bx[b.ridx (i)] = std::real (c);
5636 Bz[b.ridx (i)] = std::imag (c);
5637 }
5638
5639 F77_XFCN (dgbtrs, DGBTRS,
5640 (F77_CONST_CHAR_ARG2 (&job, 1),
5641 nr, n_lower, n_upper, 1, tmp_data,
5642 ldm, pipvt, Bx, b.rows (), err
5643 F77_CHAR_ARG_LEN (1)));
5644
5645 F77_XFCN (dgbtrs, DGBTRS,
5646 (F77_CONST_CHAR_ARG2 (&job, 1),
5647 nr, n_lower, n_upper, 1, tmp_data,
5648 ldm, pipvt, Bz, b.rows (), err
5649 F77_CHAR_ARG_LEN (1)));
5650
5651 // Count non-zeros in work vector and adjust
5652 // space in retval if needed
5653 octave_idx_type new_nnz = 0;
5654 for (octave_idx_type i = 0; i < nr; i++)
5655 if (Bx[i] != 0. || Bz[i] != 0.)
5656 new_nnz++;
5657
5658 if (ii + new_nnz > x_nz)
5659 {
5660 // Resize the sparse matrix
5661 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
5662 retval.change_capacity (sz);
5663 x_nz = sz;
5664 }
5665
5666 for (octave_idx_type i = 0; i < nr; i++)
5667 if (Bx[i] != 0. || Bz[i] != 0.)
5668 {
5669 retval.xridx (ii) = i;
5670 retval.xdata (ii++) =
5671 Complex (Bx[i], Bz[i]);
5672 }
5673 retval.xcidx (j+1) = ii;
5674 }
5675
5676 retval.maybe_compress ();
5677 }
5678 }
5679 }
5680 else if (typ != MatrixType::Banded_Hermitian)
5681 (*current_liboctave_error_handler) ("incorrect matrix type");
5682 }
5683
5684 return retval;
5685 }
5686
5687 void *
5688 SparseMatrix::factorize (octave_idx_type& err, double &rcond, Matrix &Control,
5689 Matrix &Info, solve_singularity_handler sing_handler,
5690 bool calc_cond) const
5691 {
5692 // The return values
5693 void *Numeric = 0;
5694 err = 0;
5695
5696 #ifdef HAVE_UMFPACK
5697 // Setup the control parameters
5698 Control = Matrix (UMFPACK_CONTROL, 1);
5699 double *control = Control.fortran_vec ();
5700 UMFPACK_DNAME (defaults) (control);
5701
5702 double tmp = octave_sparse_params::get_key ("spumoni");
5703 if (!xisnan (tmp))
5704 Control (UMFPACK_PRL) = tmp;
5705 tmp = octave_sparse_params::get_key ("piv_tol");
5706 if (!xisnan (tmp))
5707 {
5708 Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp;
5709 Control (UMFPACK_PIVOT_TOLERANCE) = tmp;
5710 }
5711
5712 // Set whether we are allowed to modify Q or not
5713 tmp = octave_sparse_params::get_key ("autoamd");
5714 if (!xisnan (tmp))
5715 Control (UMFPACK_FIXQ) = tmp;
5716
5717 UMFPACK_DNAME (report_control) (control);
5718
5719 const octave_idx_type *Ap = cidx ();
5720 const octave_idx_type *Ai = ridx ();
5721 const double *Ax = data ();
5722 octave_idx_type nr = rows ();
5723 octave_idx_type nc = cols ();
5724
5725 UMFPACK_DNAME (report_matrix) (nr, nc, Ap, Ai, Ax, 1, control);
5726
5727 void *Symbolic;
5728 Info = Matrix (1, UMFPACK_INFO);
5729 double *info = Info.fortran_vec ();
5730 int status = UMFPACK_DNAME (qsymbolic) (nr, nc, Ap, Ai, Ax, 0,
5731 &Symbolic, control, info);
5732
5733 if (status < 0)
5734 {
5735 (*current_liboctave_error_handler)
5736 ("SparseMatrix::solve symbolic factorization failed");
5737 err = -1;
5738
5739 UMFPACK_DNAME (report_status) (control, status);
5740 UMFPACK_DNAME (report_info) (control, info);
5741
5742 UMFPACK_DNAME (free_symbolic) (&Symbolic) ;
5743 }
5744 else
5745 {
5746 UMFPACK_DNAME (report_symbolic) (Symbolic, control);
5747
5748 status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic,
5749 &Numeric, control, info) ;
5750 UMFPACK_DNAME (free_symbolic) (&Symbolic) ;
5751
5752 if (calc_cond)
5753 rcond = Info (UMFPACK_RCOND);
5754 else
5755 rcond = 1.;
5756 volatile double rcond_plus_one = rcond + 1.0;
5757
5758 if (status == UMFPACK_WARNING_singular_matrix ||
5759 rcond_plus_one == 1.0 || xisnan (rcond))
5760 {
5761 UMFPACK_DNAME (report_numeric) (Numeric, control);
5762
5763 err = -2;
5764
5765 if (sing_handler)
5766 sing_handler (rcond);
5767 else
5768 (*current_liboctave_error_handler)
5769 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g",
5770 rcond);
5771
5772 }
5773 else if (status < 0)
5774 {
5775 (*current_liboctave_error_handler)
5776 ("SparseMatrix::solve numeric factorization failed");
5777
5778 UMFPACK_DNAME (report_status) (control, status);
5779 UMFPACK_DNAME (report_info) (control, info);
5780
5781 err = -1;
5782 }
5783 else
5784 {
5785 UMFPACK_DNAME (report_numeric) (Numeric, control);
5786 }
5787 }
5788
5789 if (err != 0)
5790 UMFPACK_DNAME (free_numeric) (&Numeric);
5791
5792 #else
5793 (*current_liboctave_error_handler) ("UMFPACK not installed");
5794 #endif
5795
5796 return Numeric;
5797 }
5798
5799 Matrix
5800 SparseMatrix::fsolve (MatrixType &mattype, const Matrix& b,
5801 octave_idx_type& err, double& rcond,
5802 solve_singularity_handler sing_handler,
5803 bool calc_cond) const
5804 {
5805 Matrix retval;
5806
5807 octave_idx_type nr = rows ();
5808 octave_idx_type nc = cols ();
5809 err = 0;
5810
5811 if (nr != nc || nr != b.rows ())
5812 (*current_liboctave_error_handler)
5813 ("matrix dimension mismatch solution of linear equations");
5814 else if (nr == 0 || b.cols () == 0)
5815 retval = Matrix (nc, b.cols (), 0.0);
5816 else
5817 {
5818 // Print spparms("spumoni") info if requested
5819 volatile int typ = mattype.type ();
5820 mattype.info ();
5821
5822 if (typ == MatrixType::Hermitian)
5823 {
5824 #ifdef HAVE_CHOLMOD
5825 cholmod_common Common;
5826 cholmod_common *cm = &Common;
5827
5828 // Setup initial parameters
5829 CHOLMOD_NAME(start) (cm);
5830 cm->prefer_zomplex = false;
5831
5832 double spu = octave_sparse_params::get_key ("spumoni");
5833 if (spu == 0.)
5834 {
5835 cm->print = -1;
5836 cm->print_function = 0;
5837 }
5838 else
5839 {
5840 cm->print = static_cast<int> (spu) + 2;
5841 cm->print_function =&SparseCholPrint;
5842 }
5843
5844 cm->error_handler = &SparseCholError;
5845 cm->complex_divide = CHOLMOD_NAME(divcomplex);
5846 cm->hypotenuse = CHOLMOD_NAME(hypot);
5847
5848 cm->final_ll = true;
5849
5850 cholmod_sparse Astore;
5851 cholmod_sparse *A = &Astore;
5852 double dummy;
5853 A->nrow = nr;
5854 A->ncol = nc;
5855
5856 A->p = cidx ();
5857 A->i = ridx ();
5858 A->nzmax = nnz ();
5859 A->packed = true;
5860 A->sorted = true;
5861 A->nz = 0;
5862 #ifdef IDX_TYPE_LONG
5863 A->itype = CHOLMOD_LONG;
5864 #else
5865 A->itype = CHOLMOD_INT;
5866 #endif
5867 A->dtype = CHOLMOD_DOUBLE;
5868 A->stype = 1;
5869 A->xtype = CHOLMOD_REAL;
5870
5871 if (nr < 1)
5872 A->x = &dummy;
5873 else
5874 A->x = data ();
5875
5876 cholmod_dense Bstore;
5877 cholmod_dense *B = &Bstore;
5878 B->nrow = b.rows ();
5879 B->ncol = b.cols ();
5880 B->d = B->nrow;
5881 B->nzmax = B->nrow * B->ncol;
5882 B->dtype = CHOLMOD_DOUBLE;
5883 B->xtype = CHOLMOD_REAL;
5884 if (nc < 1 || b.cols () < 1)
5885 B->x = &dummy;
5886 else
5887 // We won't alter it, honest :-)
5888 B->x = const_cast<double *>(b.fortran_vec ());
5889
5890 cholmod_factor *L;
5891 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
5892 L = CHOLMOD_NAME(analyze) (A, cm);
5893 CHOLMOD_NAME(factorize) (A, L, cm);
5894 if (calc_cond)
5895 rcond = CHOLMOD_NAME(rcond)(L, cm);
5896 else
5897 rcond = 1.0;
5898
5899 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
5900
5901 if (rcond == 0.0)
5902 {
5903 // Either its indefinite or singular. Try UMFPACK
5904 mattype.mark_as_unsymmetric ();
5905 typ = MatrixType::Full;
5906 }
5907 else
5908 {
5909 volatile double rcond_plus_one = rcond + 1.0;
5910
5911 if (rcond_plus_one == 1.0 || xisnan (rcond))
5912 {
5913 err = -2;
5914
5915 if (sing_handler)
5916 {
5917 sing_handler (rcond);
5918 mattype.mark_as_rectangular ();
5919 }
5920 else
5921 (*current_liboctave_error_handler)
5922 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g",
5923 rcond);
5924
5925 return retval;
5926 }
5927
5928 cholmod_dense *X;
5929 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
5930 X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm);
5931 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
5932
5933 retval.resize (b.rows (), b.cols ());
5934 for (octave_idx_type j = 0; j < b.cols (); j++)
5935 {
5936 octave_idx_type jr = j * b.rows ();
5937 for (octave_idx_type i = 0; i < b.rows (); i++)
5938 retval.xelem (i,j) = static_cast<double *>(X->x)[jr + i];
5939 }
5940
5941 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
5942 CHOLMOD_NAME(free_dense) (&X, cm);
5943 CHOLMOD_NAME(free_factor) (&L, cm);
5944 CHOLMOD_NAME(finish) (cm);
5945 static char tmp[] = " ";
5946 CHOLMOD_NAME(print_common) (tmp, cm);
5947 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
5948 }
5949 #else
5950 (*current_liboctave_warning_handler)
5951 ("CHOLMOD not installed");
5952
5953 mattype.mark_as_unsymmetric ();
5954 typ = MatrixType::Full;
5955 #endif
5956 }
5957
5958 if (typ == MatrixType::Full)
5959 {
5960 #ifdef HAVE_UMFPACK
5961 Matrix Control, Info;
5962 void *Numeric =
5963 factorize (err, rcond, Control, Info, sing_handler, calc_cond);
5964
5965 if (err == 0)
5966 {
5967 const double *Bx = b.fortran_vec ();
5968 retval.resize (b.rows (), b.cols ());
5969 double *result = retval.fortran_vec ();
5970 octave_idx_type b_nr = b.rows ();
5971 octave_idx_type b_nc = b.cols ();
5972 int status = 0;
5973 double *control = Control.fortran_vec ();
5974 double *info = Info.fortran_vec ();
5975 const octave_idx_type *Ap = cidx ();
5976 const octave_idx_type *Ai = ridx ();
5977 const double *Ax = data ();
5978
5979 for (octave_idx_type j = 0, iidx = 0; j < b_nc; j++, iidx += b_nr)
5980 {
5981 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap,
5982 Ai, Ax, &result[iidx], &Bx[iidx],
5983 Numeric, control, info);
5984 if (status < 0)
5985 {
5986 (*current_liboctave_error_handler)
5987 ("SparseMatrix::solve solve failed");
5988
5989 UMFPACK_DNAME (report_status) (control, status);
5990
5991 err = -1;
5992
5993 break;
5994 }
5995 }
5996
5997 UMFPACK_DNAME (report_info) (control, info);
5998
5999 UMFPACK_DNAME (free_numeric) (&Numeric);
6000 }
6001 else
6002 mattype.mark_as_rectangular ();
6003
6004 #else
6005 (*current_liboctave_error_handler) ("UMFPACK not installed");
6006 #endif
6007 }
6008 else if (typ != MatrixType::Hermitian)
6009 (*current_liboctave_error_handler) ("incorrect matrix type");
6010 }
6011
6012 return retval;
6013 }
6014
6015 SparseMatrix
6016 SparseMatrix::fsolve (MatrixType &mattype, const SparseMatrix& b,
6017 octave_idx_type& err, double& rcond,
6018 solve_singularity_handler sing_handler,
6019 bool calc_cond) const
6020 {
6021 SparseMatrix retval;
6022
6023 octave_idx_type nr = rows ();
6024 octave_idx_type nc = cols ();
6025 err = 0;
6026
6027 if (nr != nc || nr != b.rows ())
6028 (*current_liboctave_error_handler)
6029 ("matrix dimension mismatch solution of linear equations");
6030 else if (nr == 0 || b.cols () == 0)
6031 retval = SparseMatrix (nc, b.cols ());
6032 else
6033 {
6034 // Print spparms("spumoni") info if requested
6035 volatile int typ = mattype.type ();
6036 mattype.info ();
6037
6038 if (typ == MatrixType::Hermitian)
6039 {
6040 #ifdef HAVE_CHOLMOD
6041 cholmod_common Common;
6042 cholmod_common *cm = &Common;
6043
6044 // Setup initial parameters
6045 CHOLMOD_NAME(start) (cm);
6046 cm->prefer_zomplex = false;
6047
6048 double spu = octave_sparse_params::get_key ("spumoni");
6049 if (spu == 0.)
6050 {
6051 cm->print = -1;
6052 cm->print_function = 0;
6053 }
6054 else
6055 {
6056 cm->print = static_cast<int> (spu) + 2;
6057 cm->print_function =&SparseCholPrint;
6058 }
6059
6060 cm->error_handler = &SparseCholError;
6061 cm->complex_divide = CHOLMOD_NAME(divcomplex);
6062 cm->hypotenuse = CHOLMOD_NAME(hypot);
6063
6064 cm->final_ll = true;
6065
6066 cholmod_sparse Astore;
6067 cholmod_sparse *A = &Astore;
6068 double dummy;
6069 A->nrow = nr;
6070 A->ncol = nc;
6071
6072 A->p = cidx ();
6073 A->i = ridx ();
6074 A->nzmax = nnz ();
6075 A->packed = true;
6076 A->sorted = true;
6077 A->nz = 0;
6078 #ifdef IDX_TYPE_LONG
6079 A->itype = CHOLMOD_LONG;
6080 #else
6081 A->itype = CHOLMOD_INT;
6082 #endif
6083 A->dtype = CHOLMOD_DOUBLE;
6084 A->stype = 1;
6085 A->xtype = CHOLMOD_REAL;
6086
6087 if (nr < 1)
6088 A->x = &dummy;
6089 else
6090 A->x = data ();
6091
6092 cholmod_sparse Bstore;
6093 cholmod_sparse *B = &Bstore;
6094 B->nrow = b.rows ();
6095 B->ncol = b.cols ();
6096 B->p = b.cidx ();
6097 B->i = b.ridx ();
6098 B->nzmax = b.nnz ();
6099 B->packed = true;
6100 B->sorted = true;
6101 B->nz = 0;
6102 #ifdef IDX_TYPE_LONG
6103 B->itype = CHOLMOD_LONG;
6104 #else
6105 B->itype = CHOLMOD_INT;
6106 #endif
6107 B->dtype = CHOLMOD_DOUBLE;
6108 B->stype = 0;
6109 B->xtype = CHOLMOD_REAL;
6110
6111 if (b.rows () < 1 || b.cols () < 1)
6112 B->x = &dummy;
6113 else
6114 B->x = b.data ();
6115
6116 cholmod_factor *L;
6117 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6118 L = CHOLMOD_NAME(analyze) (A, cm);
6119 CHOLMOD_NAME(factorize) (A, L, cm);
6120 if (calc_cond)
6121 rcond = CHOLMOD_NAME(rcond)(L, cm);
6122 else
6123 rcond = 1.;
6124 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6125
6126 if (rcond == 0.0)
6127 {
6128 // Either its indefinite or singular. Try UMFPACK
6129 mattype.mark_as_unsymmetric ();
6130 typ = MatrixType::Full;
6131 }
6132 else
6133 {
6134 volatile double rcond_plus_one = rcond + 1.0;
6135
6136 if (rcond_plus_one == 1.0 || xisnan (rcond))
6137 {
6138 err = -2;
6139
6140 if (sing_handler)
6141 {
6142 sing_handler (rcond);
6143 mattype.mark_as_rectangular ();
6144 }
6145 else
6146 (*current_liboctave_error_handler)
6147 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g",
6148 rcond);
6149
6150 return retval;
6151 }
6152
6153 cholmod_sparse *X;
6154 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6155 X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm);
6156 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6157
6158 retval = SparseMatrix (static_cast<octave_idx_type>(X->nrow),
6159 static_cast<octave_idx_type>(X->ncol),
6160 static_cast<octave_idx_type>(X->nzmax));
6161 for (octave_idx_type j = 0;
6162 j <= static_cast<octave_idx_type>(X->ncol); j++)
6163 retval.xcidx (j) = static_cast<octave_idx_type *>(X->p)[j];
6164 for (octave_idx_type j = 0;
6165 j < static_cast<octave_idx_type>(X->nzmax); j++)
6166 {
6167 retval.xridx (j) = static_cast<octave_idx_type *>(X->i)[j];
6168 retval.xdata (j) = static_cast<double *>(X->x)[j];
6169 }
6170
6171 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6172 CHOLMOD_NAME(free_sparse) (&X, cm);
6173 CHOLMOD_NAME(free_factor) (&L, cm);
6174 CHOLMOD_NAME(finish) (cm);
6175 static char tmp[] = " ";
6176 CHOLMOD_NAME(print_common) (tmp, cm);
6177 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6178 }
6179 #else
6180 (*current_liboctave_warning_handler)
6181 ("CHOLMOD not installed");
6182
6183 mattype.mark_as_unsymmetric ();
6184 typ = MatrixType::Full;
6185 #endif
6186 }
6187
6188 if (typ == MatrixType::Full)
6189 {
6190 #ifdef HAVE_UMFPACK
6191 Matrix Control, Info;
6192 void *Numeric = factorize (err, rcond, Control, Info,
6193 sing_handler, calc_cond);
6194
6195 if (err == 0)
6196 {
6197 octave_idx_type b_nr = b.rows ();
6198 octave_idx_type b_nc = b.cols ();
6199 int status = 0;
6200 double *control = Control.fortran_vec ();
6201 double *info = Info.fortran_vec ();
6202 const octave_idx_type *Ap = cidx ();
6203 const octave_idx_type *Ai = ridx ();
6204 const double *Ax = data ();
6205
6206 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
6207 OCTAVE_LOCAL_BUFFER (double, Xx, b_nr);
6208
6209 // Take a first guess that the number of non-zero terms
6210 // will be as many as in b
6211 octave_idx_type x_nz = b.nnz ();
6212 octave_idx_type ii = 0;
6213 retval = SparseMatrix (b_nr, b_nc, x_nz);
6214
6215 retval.xcidx (0) = 0;
6216 for (octave_idx_type j = 0; j < b_nc; j++)
6217 {
6218
6219 for (octave_idx_type i = 0; i < b_nr; i++)
6220 Bx[i] = b.elem (i, j);
6221
6222 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap,
6223 Ai, Ax, Xx, Bx, Numeric, control,
6224 info);
6225 if (status < 0)
6226 {
6227 (*current_liboctave_error_handler)
6228 ("SparseMatrix::solve solve failed");
6229
6230 UMFPACK_DNAME (report_status) (control, status);
6231
6232 err = -1;
6233
6234 break;
6235 }
6236
6237 for (octave_idx_type i = 0; i < b_nr; i++)
6238 {
6239 double tmp = Xx[i];
6240 if (tmp != 0.0)
6241 {
6242 if (ii == x_nz)
6243 {
6244 // Resize the sparse matrix
6245 octave_idx_type sz = x_nz * (b_nc - j) / b_nc;
6246 sz = (sz > 10 ? sz : 10) + x_nz;
6247 retval.change_capacity (sz);
6248 x_nz = sz;
6249 }
6250 retval.xdata (ii) = tmp;
6251 retval.xridx (ii++) = i;
6252 }
6253 }
6254 retval.xcidx (j+1) = ii;
6255 }
6256
6257 retval.maybe_compress ();
6258
6259 UMFPACK_DNAME (report_info) (control, info);
6260
6261 UMFPACK_DNAME (free_numeric) (&Numeric);
6262 }
6263 else
6264 mattype.mark_as_rectangular ();
6265
6266 #else
6267 (*current_liboctave_error_handler) ("UMFPACK not installed");
6268 #endif
6269 }
6270 else if (typ != MatrixType::Hermitian)
6271 (*current_liboctave_error_handler) ("incorrect matrix type");
6272 }
6273
6274 return retval;
6275 }
6276
6277 ComplexMatrix
6278 SparseMatrix::fsolve (MatrixType &mattype, const ComplexMatrix& b,
6279 octave_idx_type& err, double& rcond,
6280 solve_singularity_handler sing_handler,
6281 bool calc_cond) const
6282 {
6283 ComplexMatrix retval;
6284
6285 octave_idx_type nr = rows ();
6286 octave_idx_type nc = cols ();
6287 err = 0;
6288
6289 if (nr != nc || nr != b.rows ())
6290 (*current_liboctave_error_handler)
6291 ("matrix dimension mismatch solution of linear equations");
6292 else if (nr == 0 || b.cols () == 0)
6293 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
6294 else
6295 {
6296 // Print spparms("spumoni") info if requested
6297 volatile int typ = mattype.type ();
6298 mattype.info ();
6299
6300 if (typ == MatrixType::Hermitian)
6301 {
6302 #ifdef HAVE_CHOLMOD
6303 cholmod_common Common;
6304 cholmod_common *cm = &Common;
6305
6306 // Setup initial parameters
6307 CHOLMOD_NAME(start) (cm);
6308 cm->prefer_zomplex = false;
6309
6310 double spu = octave_sparse_params::get_key ("spumoni");
6311 if (spu == 0.)
6312 {
6313 cm->print = -1;
6314 cm->print_function = 0;
6315 }
6316 else
6317 {
6318 cm->print = static_cast<int> (spu) + 2;
6319 cm->print_function =&SparseCholPrint;
6320 }
6321
6322 cm->error_handler = &SparseCholError;
6323 cm->complex_divide = CHOLMOD_NAME(divcomplex);
6324 cm->hypotenuse = CHOLMOD_NAME(hypot);
6325
6326 cm->final_ll = true;
6327
6328 cholmod_sparse Astore;
6329 cholmod_sparse *A = &Astore;
6330 double dummy;
6331 A->nrow = nr;
6332 A->ncol = nc;
6333
6334 A->p = cidx ();
6335 A->i = ridx ();
6336 A->nzmax = nnz ();
6337 A->packed = true;
6338 A->sorted = true;
6339 A->nz = 0;
6340 #ifdef IDX_TYPE_LONG
6341 A->itype = CHOLMOD_LONG;
6342 #else
6343 A->itype = CHOLMOD_INT;
6344 #endif
6345 A->dtype = CHOLMOD_DOUBLE;
6346 A->stype = 1;
6347 A->xtype = CHOLMOD_REAL;
6348
6349 if (nr < 1)
6350 A->x = &dummy;
6351 else
6352 A->x = data ();
6353
6354 cholmod_dense Bstore;
6355 cholmod_dense *B = &Bstore;
6356 B->nrow = b.rows ();
6357 B->ncol = b.cols ();
6358 B->d = B->nrow;
6359 B->nzmax = B->nrow * B->ncol;
6360 B->dtype = CHOLMOD_DOUBLE;
6361 B->xtype = CHOLMOD_COMPLEX;
6362 if (nc < 1 || b.cols () < 1)
6363 B->x = &dummy;
6364 else
6365 // We won't alter it, honest :-)
6366 B->x = const_cast<Complex *>(b.fortran_vec ());
6367
6368 cholmod_factor *L;
6369 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6370 L = CHOLMOD_NAME(analyze) (A, cm);
6371 CHOLMOD_NAME(factorize) (A, L, cm);
6372 if (calc_cond)
6373 rcond = CHOLMOD_NAME(rcond)(L, cm);
6374 else
6375 rcond = 1.0;
6376 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6377
6378 if (rcond == 0.0)
6379 {
6380 // Either its indefinite or singular. Try UMFPACK
6381 mattype.mark_as_unsymmetric ();
6382 typ = MatrixType::Full;
6383 }
6384 else
6385 {
6386 volatile double rcond_plus_one = rcond + 1.0;
6387
6388 if (rcond_plus_one == 1.0 || xisnan (rcond))
6389 {
6390 err = -2;
6391
6392 if (sing_handler)
6393 {
6394 sing_handler (rcond);
6395 mattype.mark_as_rectangular ();
6396 }
6397 else
6398 (*current_liboctave_error_handler)
6399 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g",
6400 rcond);
6401
6402 return retval;
6403 }
6404
6405 cholmod_dense *X;
6406 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6407 X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm);
6408 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6409
6410 retval.resize (b.rows (), b.cols ());
6411 for (octave_idx_type j = 0; j < b.cols (); j++)
6412 {
6413 octave_idx_type jr = j * b.rows ();
6414 for (octave_idx_type i = 0; i < b.rows (); i++)
6415 retval.xelem (i,j) = static_cast<Complex *>(X->x)[jr + i];
6416 }
6417
6418 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6419 CHOLMOD_NAME(free_dense) (&X, cm);
6420 CHOLMOD_NAME(free_factor) (&L, cm);
6421 CHOLMOD_NAME(finish) (cm);
6422 static char tmp[] = " ";
6423 CHOLMOD_NAME(print_common) (tmp, cm);
6424 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6425 }
6426 #else
6427 (*current_liboctave_warning_handler)
6428 ("CHOLMOD not installed");
6429
6430 mattype.mark_as_unsymmetric ();
6431 typ = MatrixType::Full;
6432 #endif
6433 }
6434
6435 if (typ == MatrixType::Full)
6436 {
6437 #ifdef HAVE_UMFPACK
6438 Matrix Control, Info;
6439 void *Numeric = factorize (err, rcond, Control, Info,
6440 sing_handler, calc_cond);
6441
6442 if (err == 0)
6443 {
6444 octave_idx_type b_nr = b.rows ();
6445 octave_idx_type b_nc = b.cols ();
6446 int status = 0;
6447 double *control = Control.fortran_vec ();
6448 double *info = Info.fortran_vec ();
6449 const octave_idx_type *Ap = cidx ();
6450 const octave_idx_type *Ai = ridx ();
6451 const double *Ax = data ();
6452
6453 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
6454 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr);
6455
6456 retval.resize (b_nr, b_nc);
6457
6458 OCTAVE_LOCAL_BUFFER (double, Xx, b_nr);
6459 OCTAVE_LOCAL_BUFFER (double, Xz, b_nr);
6460
6461 for (octave_idx_type j = 0; j < b_nc; j++)
6462 {
6463 for (octave_idx_type i = 0; i < b_nr; i++)
6464 {
6465 Complex c = b (i,j);
6466 Bx[i] = std::real (c);
6467 Bz[i] = std::imag (c);
6468 }
6469
6470 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap,
6471 Ai, Ax, Xx, Bx, Numeric, control,
6472 info);
6473 int status2 = UMFPACK_DNAME (solve) (UMFPACK_A,
6474 Ap, Ai, Ax, Xz, Bz, Numeric,
6475 control, info) ;
6476
6477 if (status < 0 || status2 < 0)
6478 {
6479 (*current_liboctave_error_handler)
6480 ("SparseMatrix::solve solve failed");
6481
6482 UMFPACK_DNAME (report_status) (control, status);
6483
6484 err = -1;
6485
6486 break;
6487 }
6488
6489 for (octave_idx_type i = 0; i < b_nr; i++)
6490 retval(i, j) = Complex (Xx[i], Xz[i]);
6491 }
6492
6493 UMFPACK_DNAME (report_info) (control, info);
6494
6495 UMFPACK_DNAME (free_numeric) (&Numeric);
6496 }
6497 else
6498 mattype.mark_as_rectangular ();
6499
6500 #else
6501 (*current_liboctave_error_handler) ("UMFPACK not installed");
6502 #endif
6503 }
6504 else if (typ != MatrixType::Hermitian)
6505 (*current_liboctave_error_handler) ("incorrect matrix type");
6506 }
6507
6508 return retval;
6509 }
6510
6511 SparseComplexMatrix
6512 SparseMatrix::fsolve (MatrixType &mattype, const SparseComplexMatrix& b,
6513 octave_idx_type& err, double& rcond,
6514 solve_singularity_handler sing_handler,
6515 bool calc_cond) const
6516 {
6517 SparseComplexMatrix retval;
6518
6519 octave_idx_type nr = rows ();
6520 octave_idx_type nc = cols ();
6521 err = 0;
6522
6523 if (nr != nc || nr != b.rows ())
6524 (*current_liboctave_error_handler)
6525 ("matrix dimension mismatch solution of linear equations");
6526 else if (nr == 0 || b.cols () == 0)
6527 retval = SparseComplexMatrix (nc, b.cols ());
6528 else
6529 {
6530 // Print spparms("spumoni") info if requested
6531 volatile int typ = mattype.type ();
6532 mattype.info ();
6533
6534 if (typ == MatrixType::Hermitian)
6535 {
6536 #ifdef HAVE_CHOLMOD
6537 cholmod_common Common;
6538 cholmod_common *cm = &Common;
6539
6540 // Setup initial parameters
6541 CHOLMOD_NAME(start) (cm);
6542 cm->prefer_zomplex = false;
6543
6544 double spu = octave_sparse_params::get_key ("spumoni");
6545 if (spu == 0.)
6546 {
6547 cm->print = -1;
6548 cm->print_function = 0;
6549 }
6550 else
6551 {
6552 cm->print = static_cast<int> (spu) + 2;
6553 cm->print_function =&SparseCholPrint;
6554 }
6555
6556 cm->error_handler = &SparseCholError;
6557 cm->complex_divide = CHOLMOD_NAME(divcomplex);
6558 cm->hypotenuse = CHOLMOD_NAME(hypot);
6559
6560 cm->final_ll = true;
6561
6562 cholmod_sparse Astore;
6563 cholmod_sparse *A = &Astore;
6564 double dummy;
6565 A->nrow = nr;
6566 A->ncol = nc;
6567
6568 A->p = cidx ();
6569 A->i = ridx ();
6570 A->nzmax = nnz ();
6571 A->packed = true;
6572 A->sorted = true;
6573 A->nz = 0;
6574 #ifdef IDX_TYPE_LONG
6575 A->itype = CHOLMOD_LONG;
6576 #else
6577 A->itype = CHOLMOD_INT;
6578 #endif
6579 A->dtype = CHOLMOD_DOUBLE;
6580 A->stype = 1;
6581 A->xtype = CHOLMOD_REAL;
6582
6583 if (nr < 1)
6584 A->x = &dummy;
6585 else
6586 A->x = data ();
6587
6588 cholmod_sparse Bstore;
6589 cholmod_sparse *B = &Bstore;
6590 B->nrow = b.rows ();
6591 B->ncol = b.cols ();
6592 B->p = b.cidx ();
6593 B->i = b.ridx ();
6594 B->nzmax = b.nnz ();
6595 B->packed = true;
6596 B->sorted = true;
6597 B->nz = 0;
6598 #ifdef IDX_TYPE_LONG
6599 B->itype = CHOLMOD_LONG;
6600 #else
6601 B->itype = CHOLMOD_INT;
6602 #endif
6603 B->dtype = CHOLMOD_DOUBLE;
6604 B->stype = 0;
6605 B->xtype = CHOLMOD_COMPLEX;
6606
6607 if (b.rows () < 1 || b.cols () < 1)
6608 B->x = &dummy;
6609 else
6610 B->x = b.data ();
6611
6612 cholmod_factor *L;
6613 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6614 L = CHOLMOD_NAME(analyze) (A, cm);
6615 CHOLMOD_NAME(factorize) (A, L, cm);
6616 if (calc_cond)
6617 rcond = CHOLMOD_NAME(rcond)(L, cm);
6618 else
6619 rcond = 1.0;
6620 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6621
6622 if (rcond == 0.0)
6623 {
6624 // Either its indefinite or singular. Try UMFPACK
6625 mattype.mark_as_unsymmetric ();
6626 typ = MatrixType::Full;
6627 }
6628 else
6629 {
6630 volatile double rcond_plus_one = rcond + 1.0;
6631
6632 if (rcond_plus_one == 1.0 || xisnan (rcond))
6633 {
6634 err = -2;
6635
6636 if (sing_handler)
6637 {
6638 sing_handler (rcond);
6639 mattype.mark_as_rectangular ();
6640 }
6641 else
6642 (*current_liboctave_error_handler)
6643 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g",
6644 rcond);
6645
6646 return retval;
6647 }
6648
6649 cholmod_sparse *X;
6650 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6651 X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm);
6652 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6653
6654 retval = SparseComplexMatrix
6655 (static_cast<octave_idx_type>(X->nrow),
6656 static_cast<octave_idx_type>(X->ncol),
6657 static_cast<octave_idx_type>(X->nzmax));
6658 for (octave_idx_type j = 0;
6659 j <= static_cast<octave_idx_type>(X->ncol); j++)
6660 retval.xcidx (j) = static_cast<octave_idx_type *>(X->p)[j];
6661 for (octave_idx_type j = 0;
6662 j < static_cast<octave_idx_type>(X->nzmax); j++)
6663 {
6664 retval.xridx (j) = static_cast<octave_idx_type *>(X->i)[j];
6665 retval.xdata (j) = static_cast<Complex *>(X->x)[j];
6666 }
6667
6668 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6669 CHOLMOD_NAME(free_sparse) (&X, cm);
6670 CHOLMOD_NAME(free_factor) (&L, cm);
6671 CHOLMOD_NAME(finish) (cm);
6672 static char tmp[] = " ";
6673 CHOLMOD_NAME(print_common) (tmp, cm);
6674 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
6675 }
6676 #else
6677 (*current_liboctave_warning_handler)
6678 ("CHOLMOD not installed");
6679
6680 mattype.mark_as_unsymmetric ();
6681 typ = MatrixType::Full;
6682 #endif
6683 }
6684
6685 if (typ == MatrixType::Full)
6686 {
6687 #ifdef HAVE_UMFPACK
6688 Matrix Control, Info;
6689 void *Numeric = factorize (err, rcond, Control, Info,
6690 sing_handler, calc_cond);
6691
6692 if (err == 0)
6693 {
6694 octave_idx_type b_nr = b.rows ();
6695 octave_idx_type b_nc = b.cols ();
6696 int status = 0;
6697 double *control = Control.fortran_vec ();
6698 double *info = Info.fortran_vec ();
6699 const octave_idx_type *Ap = cidx ();
6700 const octave_idx_type *Ai = ridx ();
6701 const double *Ax = data ();
6702
6703 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
6704 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr);
6705
6706 // Take a first guess that the number of non-zero terms
6707 // will be as many as in b
6708 octave_idx_type x_nz = b.nnz ();
6709 octave_idx_type ii = 0;
6710 retval = SparseComplexMatrix (b_nr, b_nc, x_nz);
6711
6712 OCTAVE_LOCAL_BUFFER (double, Xx, b_nr);
6713 OCTAVE_LOCAL_BUFFER (double, Xz, b_nr);
6714
6715 retval.xcidx (0) = 0;
6716 for (octave_idx_type j = 0; j < b_nc; j++)
6717 {
6718 for (octave_idx_type i = 0; i < b_nr; i++)
6719 {
6720 Complex c = b (i,j);
6721 Bx[i] = std::real (c);
6722 Bz[i] = std::imag (c);
6723 }
6724
6725 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap,
6726 Ai, Ax, Xx, Bx, Numeric, control,
6727 info);
6728 int status2 = UMFPACK_DNAME (solve) (UMFPACK_A,
6729 Ap, Ai, Ax, Xz, Bz, Numeric,
6730 control, info) ;
6731
6732 if (status < 0 || status2 < 0)
6733 {
6734 (*current_liboctave_error_handler)
6735 ("SparseMatrix::solve solve failed");
6736
6737 UMFPACK_DNAME (report_status) (control, status);
6738
6739 err = -1;
6740
6741 break;
6742 }
6743
6744 for (octave_idx_type i = 0; i < b_nr; i++)
6745 {
6746 Complex tmp = Complex (Xx[i], Xz[i]);
6747 if (tmp != 0.0)
6748 {
6749 if (ii == x_nz)
6750 {
6751 // Resize the sparse matrix
6752 octave_idx_type sz = x_nz * (b_nc - j) / b_nc;
6753 sz = (sz > 10 ? sz : 10) + x_nz;
6754 retval.change_capacity (sz);
6755 x_nz = sz;
6756 }
6757 retval.xdata (ii) = tmp;
6758 retval.xridx (ii++) = i;
6759 }
6760 }
6761 retval.xcidx (j+1) = ii;
6762 }
6763
6764 retval.maybe_compress ();
6765
6766 UMFPACK_DNAME (report_info) (control, info);
6767
6768 UMFPACK_DNAME (free_numeric) (&Numeric);
6769 }
6770 else
6771 mattype.mark_as_rectangular ();
6772 #else
6773 (*current_liboctave_error_handler) ("UMFPACK not installed");
6774 #endif
6775 }
6776 else if (typ != MatrixType::Hermitian)
6777 (*current_liboctave_error_handler) ("incorrect matrix type");
6778 }
6779
6780 return retval;
6781 }
6782
6783 Matrix
6784 SparseMatrix::solve (MatrixType &mattype, const Matrix& b) const
6785 {
6786 octave_idx_type info;
6787 double rcond;
6788 return solve (mattype, b, info, rcond, 0);
6789 }
6790
6791 Matrix
6792 SparseMatrix::solve (MatrixType &mattype, const Matrix& b,
6793 octave_idx_type& info) const
6794 {
6795 double rcond;
6796 return solve (mattype, b, info, rcond, 0);
6797 }
6798
6799 Matrix
6800 SparseMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& info,
6801 double& rcond) const
6802 {
6803 return solve (mattype, b, info, rcond, 0);
6804 }
6805
6806 Matrix
6807 SparseMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& err,
6808 double& rcond, solve_singularity_handler sing_handler,
6809 bool singular_fallback) const
6810 {
6811 Matrix retval;
6812 int typ = mattype.type (false);
6813
6814 if (typ == MatrixType::Unknown)
6815 typ = mattype.type (*this);
6816
6817 // Only calculate the condition number for CHOLMOD/UMFPACK
6818 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal)
6819 retval = dsolve (mattype, b, err, rcond, sing_handler, false);
6820 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper)
6821 retval = utsolve (mattype, b, err, rcond, sing_handler, false);
6822 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower)
6823 retval = ltsolve (mattype, b, err, rcond, sing_handler, false);
6824 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian)
6825 retval = bsolve (mattype, b, err, rcond, sing_handler, false);
6826 else if (typ == MatrixType::Tridiagonal ||
6827 typ == MatrixType::Tridiagonal_Hermitian)
6828 retval = trisolve (mattype, b, err, rcond, sing_handler, false);
6829 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian)
6830 retval = fsolve (mattype, b, err, rcond, sing_handler, true);
6831 else if (typ != MatrixType::Rectangular)
6832 {
6833 (*current_liboctave_error_handler) ("unknown matrix type");
6834 return Matrix ();
6835 }
6836
6837 // Rectangular or one of the above solvers flags a singular matrix
6838 if (singular_fallback && mattype.type (false) == MatrixType::Rectangular)
6839 {
6840 rcond = 1.;
6841 #ifdef USE_QRSOLVE
6842 retval = qrsolve (*this, b, err);
6843 #else
6844 retval = dmsolve<Matrix, SparseMatrix, Matrix> (*this, b, err);
6845 #endif
6846 }
6847
6848 return retval;
6849 }
6850
6851 SparseMatrix
6852 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b) const
6853 {
6854 octave_idx_type info;
6855 double rcond;
6856 return solve (mattype, b, info, rcond, 0);
6857 }
6858
6859 SparseMatrix
6860 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b,
6861 octave_idx_type& info) const
6862 {
6863 double rcond;
6864 return solve (mattype, b, info, rcond, 0);
6865 }
6866
6867 SparseMatrix
6868 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b,
6869 octave_idx_type& info, double& rcond) const
6870 {
6871 return solve (mattype, b, info, rcond, 0);
6872 }
6873
6874 SparseMatrix
6875 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b,
6876 octave_idx_type& err, double& rcond,
6877 solve_singularity_handler sing_handler,
6878 bool singular_fallback) const
6879 {
6880 SparseMatrix retval;
6881 int typ = mattype.type (false);
6882
6883 if (typ == MatrixType::Unknown)
6884 typ = mattype.type (*this);
6885
6886 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal)
6887 retval = dsolve (mattype, b, err, rcond, sing_handler, false);
6888 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper)
6889 retval = utsolve (mattype, b, err, rcond, sing_handler, false);
6890 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower)
6891 retval = ltsolve (mattype, b, err, rcond, sing_handler, false);
6892 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian)
6893 retval = bsolve (mattype, b, err, rcond, sing_handler, false);
6894 else if (typ == MatrixType::Tridiagonal ||
6895 typ == MatrixType::Tridiagonal_Hermitian)
6896 retval = trisolve (mattype, b, err, rcond, sing_handler, false);
6897 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian)
6898 retval = fsolve (mattype, b, err, rcond, sing_handler, true);
6899 else if (typ != MatrixType::Rectangular)
6900 {
6901 (*current_liboctave_error_handler) ("unknown matrix type");
6902 return SparseMatrix ();
6903 }
6904
6905 if (singular_fallback && mattype.type (false) == MatrixType::Rectangular)
6906 {
6907 rcond = 1.;
6908 #ifdef USE_QRSOLVE
6909 retval = qrsolve (*this, b, err);
6910 #else
6911 retval = dmsolve<SparseMatrix, SparseMatrix,
6912 SparseMatrix> (*this, b, err);
6913 #endif
6914 }
6915
6916 return retval;
6917 }
6918
6919 ComplexMatrix
6920 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b) const
6921 {
6922 octave_idx_type info;
6923 double rcond;
6924 return solve (mattype, b, info, rcond, 0);
6925 }
6926
6927 ComplexMatrix
6928 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b,
6929 octave_idx_type& info) const
6930 {
6931 double rcond;
6932 return solve (mattype, b, info, rcond, 0);
6933 }
6934
6935 ComplexMatrix
6936 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b,
6937 octave_idx_type& info, double& rcond) const
6938 {
6939 return solve (mattype, b, info, rcond, 0);
6940 }
6941
6942 ComplexMatrix
6943 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b,
6944 octave_idx_type& err, double& rcond,
6945 solve_singularity_handler sing_handler,
6946 bool singular_fallback) const
6947 {
6948 ComplexMatrix retval;
6949 int typ = mattype.type (false);
6950
6951 if (typ == MatrixType::Unknown)
6952 typ = mattype.type (*this);
6953
6954 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal)
6955 retval = dsolve (mattype, b, err, rcond, sing_handler, false);
6956 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper)
6957 retval = utsolve (mattype, b, err, rcond, sing_handler, false);
6958 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower)
6959 retval = ltsolve (mattype, b, err, rcond, sing_handler, false);
6960 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian)
6961 retval = bsolve (mattype, b, err, rcond, sing_handler, false);
6962 else if (typ == MatrixType::Tridiagonal ||
6963 typ == MatrixType::Tridiagonal_Hermitian)
6964 retval = trisolve (mattype, b, err, rcond, sing_handler, false);
6965 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian)
6966 retval = fsolve (mattype, b, err, rcond, sing_handler, true);
6967 else if (typ != MatrixType::Rectangular)
6968 {
6969 (*current_liboctave_error_handler) ("unknown matrix type");
6970 return ComplexMatrix ();
6971 }
6972
6973 if (singular_fallback && mattype.type (false) == MatrixType::Rectangular)
6974 {
6975 rcond = 1.;
6976 #ifdef USE_QRSOLVE
6977 retval = qrsolve (*this, b, err);
6978 #else
6979 retval = dmsolve<ComplexMatrix, SparseMatrix,
6980 ComplexMatrix> (*this, b, err);
6981 #endif
6982 }
6983
6984 return retval;
6985 }
6986
6987 SparseComplexMatrix
6988 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b) const
6989 {
6990 octave_idx_type info;
6991 double rcond;
6992 return solve (mattype, b, info, rcond, 0);
6993 }
6994
6995 SparseComplexMatrix
6996 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b,
6997 octave_idx_type& info) const
6998 {
6999 double rcond;
7000 return solve (mattype, b, info, rcond, 0);
7001 }
7002
7003 SparseComplexMatrix
7004 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b,
7005 octave_idx_type& info, double& rcond) const
7006 {
7007 return solve (mattype, b, info, rcond, 0);
7008 }
7009
7010 SparseComplexMatrix
7011 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b,
7012 octave_idx_type& err, double& rcond,
7013 solve_singularity_handler sing_handler,
7014 bool singular_fallback) const
7015 {
7016 SparseComplexMatrix retval;
7017 int typ = mattype.type (false);
7018
7019 if (typ == MatrixType::Unknown)
7020 typ = mattype.type (*this);
7021
7022 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal)
7023 retval = dsolve (mattype, b, err, rcond, sing_handler, false);
7024 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper)
7025 retval = utsolve (mattype, b, err, rcond, sing_handler, false);
7026 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower)
7027 retval = ltsolve (mattype, b, err, rcond, sing_handler, false);
7028 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian)
7029 retval = bsolve (mattype, b, err, rcond, sing_handler, false);
7030 else if (typ == MatrixType::Tridiagonal ||
7031 typ == MatrixType::Tridiagonal_Hermitian)
7032 retval = trisolve (mattype, b, err, rcond, sing_handler, false);
7033 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian)
7034 retval = fsolve (mattype, b, err, rcond, sing_handler, true);
7035 else if (typ != MatrixType::Rectangular)
7036 {
7037 (*current_liboctave_error_handler) ("unknown matrix type");
7038 return SparseComplexMatrix ();
7039 }
7040
7041 if (singular_fallback && mattype.type (false) == MatrixType::Rectangular)
7042 {
7043 rcond = 1.;
7044 #ifdef USE_QRSOLVE
7045 retval = qrsolve (*this, b, err);
7046 #else
7047 retval = dmsolve<SparseComplexMatrix, SparseMatrix,
7048 SparseComplexMatrix> (*this, b, err);
7049 #endif
7050 }
7051
7052 return retval;
7053 }
7054
7055 ColumnVector
7056 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b) const
7057 {
7058 octave_idx_type info; double rcond;
7059 return solve (mattype, b, info, rcond);
7060 }
7061
7062 ColumnVector
7063 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info) const
7064 {
7065 double rcond;
7066 return solve (mattype, b, info, rcond);
7067 }
7068
7069 ColumnVector
7070 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond) const
7071 {
7072 return solve (mattype, b, info, rcond, 0);
7073 }
7074
7075 ColumnVector
7076 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond,
7077 solve_singularity_handler sing_handler) const
7078 {
7079 Matrix tmp (b);
7080 return solve (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0));
7081 }
7082
7083 ComplexColumnVector
7084 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b) const
7085 {
7086 octave_idx_type info;
7087 double rcond;
7088 return solve (mattype, b, info, rcond, 0);
7089 }
7090
7091 ComplexColumnVector
7092 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info) const
7093 {
7094 double rcond;
7095 return solve (mattype, b, info, rcond, 0);
7096 }
7097
7098 ComplexColumnVector
7099 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info,
7100 double& rcond) const
7101 {
7102 return solve (mattype, b, info, rcond, 0);
7103 }
7104
7105 ComplexColumnVector
7106 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info, double& rcond,
7107 solve_singularity_handler sing_handler) const
7108 {
7109 ComplexMatrix tmp (b);
7110 return solve (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0));
7111 }
7112
7113 Matrix
7114 SparseMatrix::solve (const Matrix& b) const
7115 {
7116 octave_idx_type info;
7117 double rcond;
7118 return solve (b, info, rcond, 0);
7119 }
7120
7121 Matrix
7122 SparseMatrix::solve (const Matrix& b, octave_idx_type& info) const
7123 {
7124 double rcond;
7125 return solve (b, info, rcond, 0);
7126 }
7127
7128 Matrix
7129 SparseMatrix::solve (const Matrix& b, octave_idx_type& info,
7130 double& rcond) const
7131 {
7132 return solve (b, info, rcond, 0);
7133 }
7134
7135 Matrix
7136 SparseMatrix::solve (const Matrix& b, octave_idx_type& err,
7137 double& rcond,
7138 solve_singularity_handler sing_handler) const
7139 {
7140 MatrixType mattype (*this);
7141 return solve (mattype, b, err, rcond, sing_handler);
7142 }
7143
7144 SparseMatrix
7145 SparseMatrix::solve (const SparseMatrix& b) const
7146 {
7147 octave_idx_type info;
7148 double rcond;
7149 return solve (b, info, rcond, 0);
7150 }
7151
7152 SparseMatrix
7153 SparseMatrix::solve (const SparseMatrix& b,
7154 octave_idx_type& info) const
7155 {
7156 double rcond;
7157 return solve (b, info, rcond, 0);
7158 }
7159
7160 SparseMatrix
7161 SparseMatrix::solve (const SparseMatrix& b,
7162 octave_idx_type& info, double& rcond) const
7163 {
7164 return solve (b, info, rcond, 0);
7165 }
7166
7167 SparseMatrix
7168 SparseMatrix::solve (const SparseMatrix& b,
7169 octave_idx_type& err, double& rcond,
7170 solve_singularity_handler sing_handler) const
7171 {
7172 MatrixType mattype (*this);
7173 return solve (mattype, b, err, rcond, sing_handler);
7174 }
7175
7176 ComplexMatrix
7177 SparseMatrix::solve (const ComplexMatrix& b,
7178 octave_idx_type& info) const
7179 {
7180 double rcond;
7181 return solve (b, info, rcond, 0);
7182 }
7183
7184 ComplexMatrix
7185 SparseMatrix::solve (const ComplexMatrix& b,
7186 octave_idx_type& info, double& rcond) const
7187 {
7188 return solve (b, info, rcond, 0);
7189 }
7190
7191 ComplexMatrix
7192 SparseMatrix::solve (const ComplexMatrix& b,
7193 octave_idx_type& err, double& rcond,
7194 solve_singularity_handler sing_handler) const
7195 {
7196 MatrixType mattype (*this);
7197 return solve (mattype, b, err, rcond, sing_handler);
7198 }
7199
7200 SparseComplexMatrix
7201 SparseMatrix::solve (const SparseComplexMatrix& b) const
7202 {
7203 octave_idx_type info;
7204 double rcond;
7205 return solve (b, info, rcond, 0);
7206 }
7207
7208 SparseComplexMatrix
7209 SparseMatrix::solve (const SparseComplexMatrix& b,
7210 octave_idx_type& info) const
7211 {
7212 double rcond;
7213 return solve (b, info, rcond, 0);
7214 }
7215
7216 SparseComplexMatrix
7217 SparseMatrix::solve (const SparseComplexMatrix& b,
7218 octave_idx_type& info, double& rcond) const
7219 {
7220 return solve (b, info, rcond, 0);
7221 }
7222
7223 SparseComplexMatrix
7224 SparseMatrix::solve (const SparseComplexMatrix& b,
7225 octave_idx_type& err, double& rcond,
7226 solve_singularity_handler sing_handler) const
7227 {
7228 MatrixType mattype (*this);
7229 return solve (mattype, b, err, rcond, sing_handler);
7230 }
7231
7232 ColumnVector
7233 SparseMatrix::solve (const ColumnVector& b) const
7234 {
7235 octave_idx_type info; double rcond;
7236 return solve (b, info, rcond);
7237 }
7238
7239 ColumnVector
7240 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info) const
7241 {
7242 double rcond;
7243 return solve (b, info, rcond);
7244 }
7245
7246 ColumnVector
7247 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info, double& rcond) const
7248 {
7249 return solve (b, info, rcond, 0);
7250 }
7251
7252 ColumnVector
7253 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info, double& rcond,
7254 solve_singularity_handler sing_handler) const
7255 {
7256 Matrix tmp (b);
7257 return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0));
7258 }
7259
7260 ComplexColumnVector
7261 SparseMatrix::solve (const ComplexColumnVector& b) const
7262 {
7263 octave_idx_type info;
7264 double rcond;
7265 return solve (b, info, rcond, 0);
7266 }
7267
7268 ComplexColumnVector
7269 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info) const
7270 {
7271 double rcond;
7272 return solve (b, info, rcond, 0);
7273 }
7274
7275 ComplexColumnVector
7276 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info,
7277 double& rcond) const
7278 {
7279 return solve (b, info, rcond, 0);
7280 }
7281
7282 ComplexColumnVector
7283 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, double& rcond,
7284 solve_singularity_handler sing_handler) const
7285 {
7286 ComplexMatrix tmp (b);
7287 return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0));
7288 }
7289
7290 // other operations.
7291
7292 bool
7293 SparseMatrix::any_element_is_negative (bool neg_zero) const
7294 {
7295 octave_idx_type nel = nnz ();
7296
7297 if (neg_zero)
7298 {
7299 for (octave_idx_type i = 0; i < nel; i++)
7300 if (lo_ieee_signbit (data (i)))
7301 return true;
7302 }
7303 else
7304 {
7305 for (octave_idx_type i = 0; i < nel; i++)
7306 if (data (i) < 0)
7307 return true;
7308 }
7309
7310 return false;
7311 }
7312
7313 bool
7314 SparseMatrix::any_element_is_nan (void) const
7315 {
7316 octave_idx_type nel = nnz ();
7317
7318 for (octave_idx_type i = 0; i < nel; i++)
7319 {
7320 double val = data (i);
7321 if (xisnan (val))
7322 return true;
7323 }
7324
7325 return false;
7326 }
7327
7328 bool
7329 SparseMatrix::any_element_is_inf_or_nan (void) const
7330 {
7331 octave_idx_type nel = nnz ();
7332
7333 for (octave_idx_type i = 0; i < nel; i++)
7334 {
7335 double val = data (i);
7336 if (xisinf (val) || xisnan (val))
7337 return true;
7338 }
7339
7340 return false;
7341 }
7342
7343 bool
7344 SparseMatrix::any_element_not_one_or_zero (void) const
7345 {
7346 octave_idx_type nel = nnz ();
7347
7348 for (octave_idx_type i = 0; i < nel; i++)
7349 {
7350 double val = data (i);
7351 if (val != 0.0 && val != 1.0)
7352 return true;
7353 }
7354
7355 return false;
7356 }
7357
7358 bool
7359 SparseMatrix::all_elements_are_zero (void) const
7360 {
7361 octave_idx_type nel = nnz ();
7362
7363 for (octave_idx_type i = 0; i < nel; i++)
7364 if (data (i) != 0)
7365 return false;
7366
7367 return true;
7368 }
7369
7370 bool
7371 SparseMatrix::all_elements_are_int_or_inf_or_nan (void) const
7372 {
7373 octave_idx_type nel = nnz ();
7374
7375 for (octave_idx_type i = 0; i < nel; i++)
7376 {
7377 double val = data (i);
7378 if (xisnan (val) || D_NINT (val) == val)
7379 continue;
7380 else
7381 return false;
7382 }
7383
7384 return true;
7385 }
7386
7387 // Return nonzero if any element of M is not an integer. Also extract
7388 // the largest and smallest values and return them in MAX_VAL and MIN_VAL.
7389
7390 bool
7391 SparseMatrix::all_integers (double& max_val, double& min_val) const
7392 {
7393 octave_idx_type nel = nnz ();
7394
7395 if (nel == 0)
7396 return false;
7397
7398 max_val = data (0);
7399 min_val = data (0);
7400
7401 for (octave_idx_type i = 0; i < nel; i++)
7402 {
7403 double val = data (i);
7404
7405 if (val > max_val)
7406 max_val = val;
7407
7408 if (val < min_val)
7409 min_val = val;
7410
7411 if (D_NINT (val) != val)
7412 return false;
7413 }
7414
7415 return true;
7416 }
7417
7418 bool
7419 SparseMatrix::too_large_for_float (void) const
7420 {
7421 return test_any (xtoo_large_for_float);
7422 }
7423
7424 SparseBoolMatrix
7425 SparseMatrix::operator ! (void) const
7426 {
7427 if (any_element_is_nan ())
7428 gripe_nan_to_logical_conversion ();
7429
7430 octave_idx_type nr = rows ();
7431 octave_idx_type nc = cols ();
7432 octave_idx_type nz1 = nnz ();
7433 octave_idx_type nz2 = nr*nc - nz1;
7434
7435 SparseBoolMatrix r (nr, nc, nz2);
7436
7437 octave_idx_type ii = 0;
7438 octave_idx_type jj = 0;
7439 r.cidx (0) = 0;
7440 for (octave_idx_type i = 0; i < nc; i++)
7441 {
7442 for (octave_idx_type j = 0; j < nr; j++)
7443 {
7444 if (jj < cidx (i+1) && ridx (jj) == j)
7445 jj++;
7446 else
7447 {
7448 r.data (ii) = true;
7449 r.ridx (ii++) = j;
7450 }
7451 }
7452 r.cidx (i+1) = ii;
7453 }
7454
7455 return r;
7456 }
7457
7458 // FIXME Do these really belong here? Maybe they should be
7459 // in a base class?
7460
7461 SparseBoolMatrix
7462 SparseMatrix::all (int dim) const
7463 {
7464 SPARSE_ALL_OP (dim);
7465 }
7466
7467 SparseBoolMatrix
7468 SparseMatrix::any (int dim) const
7469 {
7470 SPARSE_ANY_OP (dim);
7471 }
7472
7473 SparseMatrix
7474 SparseMatrix::cumprod (int dim) const
7475 {
7476 SPARSE_CUMPROD (SparseMatrix, double, cumprod);
7477 }
7478
7479 SparseMatrix
7480 SparseMatrix::cumsum (int dim) const
7481 {
7482 SPARSE_CUMSUM (SparseMatrix, double, cumsum);
7483 }
7484
7485 SparseMatrix
7486 SparseMatrix::prod (int dim) const
7487 {
7488 if ((rows () == 1 && dim == -1) || dim == 1)
7489 return transpose (). prod (0). transpose ();
7490 else
7491 {
7492 SPARSE_REDUCTION_OP (SparseMatrix, double, *=,
7493 (cidx (j+1) - cidx (j) < nr ? 0.0 : 1.0), 1.0);
7494 }
7495 }
7496
7497 SparseMatrix
7498 SparseMatrix::sum (int dim) const
7499 {
7500 SPARSE_REDUCTION_OP (SparseMatrix, double, +=, 0.0, 0.0);
7501 }
7502
7503 SparseMatrix
7504 SparseMatrix::sumsq (int dim) const
7505 {
7506 #define ROW_EXPR \
7507 double d = data (i); \
7508 tmp[ridx (i)] += d * d
7509
7510 #define COL_EXPR \
7511 double d = data (i); \
7512 tmp[j] += d * d
7513
7514 SPARSE_BASE_REDUCTION_OP (SparseMatrix, double, ROW_EXPR, COL_EXPR,
7515 0.0, 0.0);
7516
7517 #undef ROW_EXPR
7518 #undef COL_EXPR
7519 }
7520
7521 SparseMatrix
7522 SparseMatrix::abs (void) const
7523 {
7524 octave_idx_type nz = nnz ();
7525
7526 SparseMatrix retval (*this);
7527
7528 for (octave_idx_type i = 0; i < nz; i++)
7529 retval.data (i) = fabs (retval.data (i));
7530
7531 return retval;
7532 }
7533
7534 SparseMatrix
7535 SparseMatrix::diag (octave_idx_type k) const
7536 {
7537 return MSparse<double>::diag (k);
7538 }
7539
7540 Matrix
7541 SparseMatrix::matrix_value (void) const
7542 {
7543 return Sparse<double>::array_value ();
7544 }
7545
7546 std::ostream&
7547 operator << (std::ostream& os, const SparseMatrix& a)
7548 {
7549 octave_idx_type nc = a.cols ();
7550
7551 // add one to the printed indices to go from
7552 // zero-based to one-based arrays
7553 for (octave_idx_type j = 0; j < nc; j++)
7554 {
7555 octave_quit ();
7556 for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++)
7557 {
7558 os << a.ridx (i) + 1 << " " << j + 1 << " ";
7559 octave_write_double (os, a.data (i));
7560 os << "\n";
7561 }
7562 }
7563
7564 return os;
7565 }
7566
7567 std::istream&
7568 operator >> (std::istream& is, SparseMatrix& a)
7569 {
7570 typedef SparseMatrix::element_type elt_type;
7571
7572 return read_sparse_matrix<elt_type> (is, a, octave_read_value<double>);
7573 }
7574
7575 SparseMatrix
7576 SparseMatrix::squeeze (void) const
7577 {
7578 return MSparse<double>::squeeze ();
7579 }
7580
7581 SparseMatrix
7582 SparseMatrix::reshape (const dim_vector& new_dims) const
7583 {
7584 return MSparse<double>::reshape (new_dims);
7585 }
7586
7587 SparseMatrix
7588 SparseMatrix::permute (const Array<octave_idx_type>& vec, bool inv) const
7589 {
7590 return MSparse<double>::permute (vec, inv);
7591 }
7592
7593 SparseMatrix
7594 SparseMatrix::ipermute (const Array<octave_idx_type>& vec) const
7595 {
7596 return MSparse<double>::ipermute (vec);
7597 }
7598
7599 // matrix by matrix -> matrix operations
7600
7601 SparseMatrix
7602 operator * (const SparseMatrix& m, const SparseMatrix& a)
7603 {
7604 SPARSE_SPARSE_MUL (SparseMatrix, double, double);
7605 }
7606
7607 Matrix
7608 operator * (const Matrix& m, const SparseMatrix& a)
7609 {
7610 FULL_SPARSE_MUL (Matrix, double, 0.);
7611 }
7612
7613 Matrix
7614 mul_trans (const Matrix& m, const SparseMatrix& a)
7615 {
7616 FULL_SPARSE_MUL_TRANS (Matrix, double, 0., );
7617 }
7618
7619 Matrix
7620 operator * (const SparseMatrix& m, const Matrix& a)
7621 {
7622 SPARSE_FULL_MUL (Matrix, double, 0.);
7623 }
7624
7625 Matrix
7626 trans_mul (const SparseMatrix& m, const Matrix& a)
7627 {
7628 SPARSE_FULL_TRANS_MUL (Matrix, double, 0., );
7629 }
7630
7631 // diag * sparse and sparse * diag
7632
7633 SparseMatrix
7634 operator * (const DiagMatrix& d, const SparseMatrix& a)
7635 {
7636 return do_mul_dm_sm<SparseMatrix> (d, a);
7637 }
7638
7639 SparseMatrix
7640 operator * (const SparseMatrix& a, const DiagMatrix& d)
7641 {
7642 return do_mul_sm_dm<SparseMatrix> (a, d);
7643 }
7644
7645 SparseMatrix
7646 operator + (const DiagMatrix& d, const SparseMatrix& a)
7647 {
7648 return do_add_dm_sm<SparseMatrix> (d, a);
7649 }
7650
7651 SparseMatrix
7652 operator - (const DiagMatrix& d, const SparseMatrix& a)
7653 {
7654 return do_sub_dm_sm<SparseMatrix> (d, a);
7655 }
7656
7657 SparseMatrix
7658 operator + (const SparseMatrix& a, const DiagMatrix& d)
7659 {
7660 return do_add_sm_dm<SparseMatrix> (a, d);
7661 }
7662
7663 SparseMatrix
7664 operator - (const SparseMatrix& a, const DiagMatrix& d)
7665 {
7666 return do_sub_sm_dm<SparseMatrix> (a, d);
7667 }
7668
7669 // perm * sparse and sparse * perm
7670
7671 SparseMatrix
7672 operator * (const PermMatrix& p, const SparseMatrix& a)
7673 {
7674 return octinternal_do_mul_pm_sm (p, a);
7675 }
7676
7677 SparseMatrix
7678 operator * (const SparseMatrix& a, const PermMatrix& p)
7679 {
7680 return octinternal_do_mul_sm_pm (a, p);
7681 }
7682
7683 // FIXME -- it would be nice to share code among the min/max
7684 // functions below.
7685
7686 #define EMPTY_RETURN_CHECK(T) \
7687 if (nr == 0 || nc == 0) \
7688 return T (nr, nc);
7689
7690 SparseMatrix
7691 min (double d, const SparseMatrix& m)
7692 {
7693 SparseMatrix result;
7694
7695 octave_idx_type nr = m.rows ();
7696 octave_idx_type nc = m.columns ();
7697
7698 EMPTY_RETURN_CHECK (SparseMatrix);
7699
7700 // Count the number of non-zero elements
7701 if (d < 0.)
7702 {
7703 result = SparseMatrix (nr, nc, d);
7704 for (octave_idx_type j = 0; j < nc; j++)
7705 for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
7706 {
7707 double tmp = xmin (d, m.data (i));
7708 if (tmp != 0.)
7709 {
7710 octave_idx_type idx = m.ridx (i) + j * nr;
7711 result.xdata (idx) = tmp;
7712 result.xridx (idx) = m.ridx (i);
7713 }
7714 }
7715 }
7716 else
7717 {
7718 octave_idx_type nel = 0;
7719 for (octave_idx_type j = 0; j < nc; j++)
7720 for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
7721 if (xmin (d, m.data (i)) != 0.)
7722 nel++;
7723
7724 result = SparseMatrix (nr, nc, nel);
7725
7726 octave_idx_type ii = 0;
7727 result.xcidx (0) = 0;
7728 for (octave_idx_type j = 0; j < nc; j++)
7729 {
7730 for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
7731 {
7732 double tmp = xmin (d, m.data (i));
7733
7734 if (tmp != 0.)
7735 {
7736 result.xdata (ii) = tmp;
7737 result.xridx (ii++) = m.ridx (i);
7738 }
7739 }
7740 result.xcidx (j+1) = ii;
7741 }
7742 }
7743
7744 return result;
7745 }
7746
7747 SparseMatrix
7748 min (const SparseMatrix& m, double d)
7749 {
7750 return min (d, m);
7751 }
7752
7753 SparseMatrix
7754 min (const SparseMatrix& a, const SparseMatrix& b)
7755 {
7756 SparseMatrix r;
7757
7758 if ((a.rows () == b.rows ()) && (a.cols () == b.cols ()))
7759 {
7760 octave_idx_type a_nr = a.rows ();
7761 octave_idx_type a_nc = a.cols ();
7762
7763 octave_idx_type b_nr = b.rows ();
7764 octave_idx_type b_nc = b.cols ();
7765
7766 if (a_nr != b_nr || a_nc != b_nc)
7767 gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc);
7768 else
7769 {
7770 r = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ()));
7771
7772 octave_idx_type jx = 0;
7773 r.cidx (0) = 0;
7774 for (octave_idx_type i = 0 ; i < a_nc ; i++)
7775 {
7776 octave_idx_type ja = a.cidx (i);
7777 octave_idx_type ja_max = a.cidx (i+1);
7778 bool ja_lt_max= ja < ja_max;
7779
7780 octave_idx_type jb = b.cidx (i);
7781 octave_idx_type jb_max = b.cidx (i+1);
7782 bool jb_lt_max = jb < jb_max;
7783
7784 while (ja_lt_max || jb_lt_max )
7785 {
7786 octave_quit ();
7787 if ((! jb_lt_max) ||
7788 (ja_lt_max && (a.ridx (ja) < b.ridx (jb))))
7789 {
7790 double tmp = xmin (a.data (ja), 0.);
7791 if (tmp != 0.)
7792 {
7793 r.ridx (jx) = a.ridx (ja);
7794 r.data (jx) = tmp;
7795 jx++;
7796 }
7797 ja++;
7798 ja_lt_max= ja < ja_max;
7799 }
7800 else if (( !ja_lt_max ) ||
7801 (jb_lt_max && (b.ridx (jb) < a.ridx (ja)) ) )
7802 {
7803 double tmp = xmin (0., b.data (jb));
7804 if (tmp != 0.)
7805 {
7806 r.ridx (jx) = b.ridx (jb);
7807 r.data (jx) = tmp;
7808 jx++;
7809 }
7810 jb++;
7811 jb_lt_max= jb < jb_max;
7812 }
7813 else
7814 {
7815 double tmp = xmin (a.data (ja), b.data (jb));
7816 if (tmp != 0.)
7817 {
7818 r.data (jx) = tmp;
7819 r.ridx (jx) = a.ridx (ja);
7820 jx++;
7821 }
7822 ja++;
7823 ja_lt_max= ja < ja_max;
7824 jb++;
7825 jb_lt_max= jb < jb_max;
7826 }
7827 }
7828 r.cidx (i+1) = jx;
7829 }
7830
7831 r.maybe_compress ();
7832 }
7833 }
7834 else
7835 (*current_liboctave_error_handler) ("matrix size mismatch");
7836
7837 return r;
7838 }
7839
7840 SparseMatrix
7841 max (double d, const SparseMatrix& m)
7842 {
7843 SparseMatrix result;
7844
7845 octave_idx_type nr = m.rows ();
7846 octave_idx_type nc = m.columns ();
7847
7848 EMPTY_RETURN_CHECK (SparseMatrix);
7849
7850 // Count the number of non-zero elements
7851 if (d > 0.)
7852 {
7853 result = SparseMatrix (nr, nc, d);
7854 for (octave_idx_type j = 0; j < nc; j++)
7855 for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
7856 {
7857 double tmp = xmax (d, m.data (i));
7858
7859 if (tmp != 0.)
7860 {
7861 octave_idx_type idx = m.ridx (i) + j * nr;
7862 result.xdata (idx) = tmp;
7863 result.xridx (idx) = m.ridx (i);
7864 }
7865 }
7866 }
7867 else
7868 {
7869 octave_idx_type nel = 0;
7870 for (octave_idx_type j = 0; j < nc; j++)
7871 for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
7872 if (xmax (d, m.data (i)) != 0.)
7873 nel++;
7874
7875 result = SparseMatrix (nr, nc, nel);
7876
7877 octave_idx_type ii = 0;
7878 result.xcidx (0) = 0;
7879 for (octave_idx_type j = 0; j < nc; j++)
7880 {
7881 for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
7882 {
7883 double tmp = xmax (d, m.data (i));
7884 if (tmp != 0.)
7885 {
7886 result.xdata (ii) = tmp;
7887 result.xridx (ii++) = m.ridx (i);
7888 }
7889 }
7890 result.xcidx (j+1) = ii;
7891 }
7892 }
7893
7894 return result;
7895 }
7896
7897 SparseMatrix
7898 max (const SparseMatrix& m, double d)
7899 {
7900 return max (d, m);
7901 }
7902
7903 SparseMatrix
7904 max (const SparseMatrix& a, const SparseMatrix& b)
7905 {
7906 SparseMatrix r;
7907
7908 if ((a.rows () == b.rows ()) && (a.cols () == b.cols ()))
7909 {
7910 octave_idx_type a_nr = a.rows ();
7911 octave_idx_type a_nc = a.cols ();
7912
7913 octave_idx_type b_nr = b.rows ();
7914 octave_idx_type b_nc = b.cols ();
7915
7916 if (a_nr != b_nr || a_nc != b_nc)
7917 gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc);
7918 else
7919 {
7920 r = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ()));
7921
7922 octave_idx_type jx = 0;
7923 r.cidx (0) = 0;
7924 for (octave_idx_type i = 0 ; i < a_nc ; i++)
7925 {
7926 octave_idx_type ja = a.cidx (i);
7927 octave_idx_type ja_max = a.cidx (i+1);
7928 bool ja_lt_max= ja < ja_max;
7929
7930 octave_idx_type jb = b.cidx (i);
7931 octave_idx_type jb_max = b.cidx (i+1);
7932 bool jb_lt_max = jb < jb_max;
7933
7934 while (ja_lt_max || jb_lt_max )
7935 {
7936 octave_quit ();
7937 if ((! jb_lt_max) ||
7938 (ja_lt_max && (a.ridx (ja) < b.ridx (jb))))
7939 {
7940 double tmp = xmax (a.data (ja), 0.);
7941 if (tmp != 0.)
7942 {
7943 r.ridx (jx) = a.ridx (ja);
7944 r.data (jx) = tmp;
7945 jx++;
7946 }
7947 ja++;
7948 ja_lt_max= ja < ja_max;
7949 }
7950 else if (( !ja_lt_max ) ||
7951 (jb_lt_max && (b.ridx (jb) < a.ridx (ja)) ) )
7952 {
7953 double tmp = xmax (0., b.data (jb));
7954 if (tmp != 0.)
7955 {
7956 r.ridx (jx) = b.ridx (jb);
7957 r.data (jx) = tmp;
7958 jx++;
7959 }
7960 jb++;
7961 jb_lt_max= jb < jb_max;
7962 }
7963 else
7964 {
7965 double tmp = xmax (a.data (ja), b.data (jb));
7966 if (tmp != 0.)
7967 {
7968 r.data (jx) = tmp;
7969 r.ridx (jx) = a.ridx (ja);
7970 jx++;
7971 }
7972 ja++;
7973 ja_lt_max= ja < ja_max;
7974 jb++;
7975 jb_lt_max= jb < jb_max;
7976 }
7977 }
7978 r.cidx (i+1) = jx;
7979 }
7980
7981 r.maybe_compress ();
7982 }
7983 }
7984 else
7985 (*current_liboctave_error_handler) ("matrix size mismatch");
7986
7987 return r;
7988 }
7989
7990 SPARSE_SMS_CMP_OPS (SparseMatrix, 0.0, , double, 0.0, )
7991 SPARSE_SMS_BOOL_OPS (SparseMatrix, double, 0.0)
7992
7993 SPARSE_SSM_CMP_OPS (double, 0.0, , SparseMatrix, 0.0, )
7994 SPARSE_SSM_BOOL_OPS (double, SparseMatrix, 0.0)
7995
7996 SPARSE_SMSM_CMP_OPS (SparseMatrix, 0.0, , SparseMatrix, 0.0, )
7997 SPARSE_SMSM_BOOL_OPS (SparseMatrix, SparseMatrix, 0.0)