view liboctave/SparseCmplxLU.cc @ 14846:460a3c6d8bf1

maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists. Example: func() => func () * dynamic.txi, func.txi, oop.txi, var.txi, embedded.cc, fortdemo.cc, funcdemo.cc, paramdemo.cc, stringdemo.cc, unwinddemo.cc, Array.cc, Array.h, CColVector.cc, CDiagMatrix.h, CMatrix.cc, CNDArray.cc, CRowVector.cc, CSparse.cc, CmplxGEPBAL.cc, EIG.cc, MSparse.cc, MatrixType.cc, Sparse-op-defs.h, Sparse-perm-op-defs.h, Sparse.cc, Sparse.h, SparseCmplxCHOL.cc, SparseCmplxCHOL.h, SparseCmplxLU.cc, SparseCmplxQR.cc, SparseCmplxQR.h, SparseQR.cc, SparseQR.h, SparsedbleCHOL.cc, SparsedbleCHOL.h, SparsedbleLU.cc, SparsedbleLU.h, base-lu.cc, cmd-hist.cc, dColVector.cc, dDiagMatrix.h, dMatrix.cc, dNDArray.cc, dRowVector.cc, dSparse.cc, dbleCHOL.cc, dbleGEPBAL.cc, dim-vector.cc, eigs-base.cc, f2c-main.c, fCColVector.cc, fCDiagMatrix.h, fCMatrix.cc, fCNDArray.cc, fCRowVector.cc, fCmplxGEPBAL.cc, fColVector.cc, fDiagMatrix.h, fEIG.cc, fMatrix.cc, fNDArray.cc, fRowVector.cc, file-ops.cc, file-stat.cc, floatCHOL.cc, floatGEPBAL.cc, idx-vector.h, lo-specfun.cc, lo-sysdep.cc, mx-inlines.cc, oct-binmap.h, oct-convn.cc, oct-md5.cc, oct-mem.h, oct-rand.cc, oct-syscalls.cc, randgamma.c, randmtzig.c, sparse-base-chol.cc, sparse-base-chol.h, sparse-base-lu.cc, sparse-dmsolve.cc, tempname.c, curl.m, divergence.m, randi.m, dlmwrite.m, edit.m, getappdata.m, what.m, getarchdir.m, install.m, installed_packages.m, repackage.m, unload_packages.m, colorbar.m, figure.m, isosurface.m, legend.m, loglog.m, plot.m, plot3.m, plotyy.m, polar.m, __errplot__.m, __ghostscript__.m, __marching_cube__.m, __plt__.m, __scatter__.m, semilogx.m, semilogy.m, trimesh.m, trisurf.m, demo.m, test.m, datetick.m, __delaunayn__.cc, __dsearchn__.cc, __fltk_uigetfile__.cc, __glpk__.cc, __init_fltk__.cc, __lin_interpn__.cc, __magick_read__.cc, __pchip_deriv__.cc, balance.cc, bsxfun.cc, ccolamd.cc, cellfun.cc, chol.cc, daspk.cc, dasrt.cc, dassl.cc, dmperm.cc, eig.cc, eigs.cc, fftw.cc, filter.cc, find.cc, kron.cc, lookup.cc, lsode.cc, matrix_type.cc, md5sum.cc, mgorth.cc, qr.cc, quad.cc, rand.cc, regexp.cc, symbfact.cc, tril.cc, urlwrite.cc, op-bm-bm.cc, op-cdm-cdm.cc, op-cell.cc, op-chm.cc, op-cm-cm.cc, op-cm-scm.cc, op-cm-sm.cc, op-cs-scm.cc, op-cs-sm.cc, op-dm-dm.cc, op-dm-scm.cc, op-dm-sm.cc, op-fcdm-fcdm.cc, op-fcm-fcm.cc, op-fdm-fdm.cc, op-fm-fm.cc, op-int.h, op-m-m.cc, op-m-scm.cc, op-m-sm.cc, op-pm-pm.cc, op-pm-scm.cc, op-pm-sm.cc, op-range.cc, op-s-scm.cc, op-s-sm.cc, op-sbm-sbm.cc, op-scm-cm.cc, op-scm-cs.cc, op-scm-m.cc, op-scm-s.cc, op-scm-scm.cc, op-scm-sm.cc, op-sm-cm.cc, op-sm-cs.cc, op-sm-m.cc, op-sm-s.cc, op-sm-scm.cc, op-sm-sm.cc, op-str-str.cc, op-struct.cc, bitfcns.cc, data.cc, debug.cc, dynamic-ld.cc, error.cc, gl-render.cc, graphics.cc, graphics.in.h, load-path.cc, ls-hdf5.cc, ls-mat5.cc, ls-mat5.h, ls-oct-ascii.cc, ls-oct-ascii.h, mex.cc, mk-errno-list, oct-map.cc, oct-obj.h, oct-parse.yy, octave-config.in.cc, ov-base-int.cc, ov-base-mat.cc, ov-base.cc, ov-bool-mat.cc, ov-bool-sparse.cc, ov-bool.cc, ov-cell.cc, ov-class.cc, ov-class.h, ov-cx-mat.cc, ov-cx-sparse.cc, ov-fcn-handle.cc, ov-flt-cx-mat.cc, ov-flt-re-mat.cc, ov-intx.h, ov-range.h, ov-re-mat.cc, ov-re-sparse.cc, ov-str-mat.cc, ov-struct.cc, ov-usr-fcn.h, ov.h, pr-output.cc, pt-id.cc, pt-id.h, pt-mat.cc, pt-select.cc, sparse.cc, symtab.cc, symtab.h, syscalls.cc, toplev.cc, txt-eng-ft.cc, variables.cc, zfstream.cc, zfstream.h, Dork.m, getStash.m, myStash.m, Gork.m, Pork.m, myStash.m, getStash.m, myStash.m, getStash.m, myStash.m, fntests.m: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
author Rik <octave@nomad.inbox5.com>
date Sun, 08 Jul 2012 11:28:50 -0700
parents 72c96de7a403
children 3d8ace26c5b4
line wrap: on
line source

/*

Copyright (C) 2004-2012 David Bateman
Copyright (C) 1998-2004 Andy Adler

This file is part of Octave.

Octave is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 3 of the License, or (at your
option) any later version.

Octave is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with Octave; see the file COPYING.  If not, see
<http://www.gnu.org/licenses/>.

*/

#ifdef HAVE_CONFIG_H
#include <config.h>
#endif

#include <vector>

#include "lo-error.h"
#include "oct-locbuf.h"

#include "SparseCmplxLU.h"
#include "oct-spparms.h"

// Instantiate the base LU class for the types we need.

#include "sparse-base-lu.h"
#include "sparse-base-lu.cc"

template class sparse_base_lu <SparseComplexMatrix, Complex, SparseMatrix, double>;

#include "oct-sparse.h"

SparseComplexLU::SparseComplexLU (const SparseComplexMatrix& a,
                                  const Matrix& piv_thres, bool scale)
{
#ifdef HAVE_UMFPACK
  octave_idx_type nr = a.rows ();
  octave_idx_type nc = a.cols ();

  // Setup the control parameters
  Matrix Control (UMFPACK_CONTROL, 1);
  double *control = Control.fortran_vec ();
  UMFPACK_ZNAME (defaults) (control);

  double tmp = octave_sparse_params::get_key ("spumoni");
  if (!xisnan (tmp))
    Control (UMFPACK_PRL) = tmp;
  if (piv_thres.nelem () == 2)
    {
      tmp = (piv_thres (0) > 1. ? 1. : piv_thres (0));
      if (!xisnan (tmp))
        Control (UMFPACK_PIVOT_TOLERANCE) = tmp;
      tmp = (piv_thres (1) > 1. ? 1. : piv_thres (1));
      if (!xisnan (tmp))
        Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp;
    }
  else
    {
      tmp = octave_sparse_params::get_key ("piv_tol");
      if (!xisnan (tmp))
        Control (UMFPACK_PIVOT_TOLERANCE) = tmp;

      tmp = octave_sparse_params::get_key ("sym_tol");
      if (!xisnan (tmp))
          Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp;
    }

  // Set whether we are allowed to modify Q or not
  tmp = octave_sparse_params::get_key ("autoamd");
  if (!xisnan (tmp))
    Control (UMFPACK_FIXQ) = tmp;

  // Turn-off UMFPACK scaling for LU
  if (scale)
    Control (UMFPACK_SCALE) = UMFPACK_SCALE_SUM;
  else
    Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE;

  UMFPACK_ZNAME (report_control) (control);

  const octave_idx_type *Ap = a.cidx ();
  const octave_idx_type *Ai = a.ridx ();
  const Complex *Ax = a.data ();

  UMFPACK_ZNAME (report_matrix) (nr, nc, Ap, Ai,
                                 reinterpret_cast<const double *> (Ax),
                                 0, 1, control);

  void *Symbolic;
  Matrix Info (1, UMFPACK_INFO);
  double *info = Info.fortran_vec ();
  int status = UMFPACK_ZNAME (qsymbolic) (nr, nc, Ap, Ai,
                                          reinterpret_cast<const double *> (Ax),
                                          0, 0,
                                          &Symbolic, control, info);

  if (status < 0)
    {
      (*current_liboctave_error_handler)
            ("SparseComplexLU::SparseComplexLU symbolic factorization failed");

      UMFPACK_ZNAME (report_status) (control, status);
      UMFPACK_ZNAME (report_info) (control, info);

      UMFPACK_ZNAME (free_symbolic) (&Symbolic) ;
    }
  else
    {
      UMFPACK_ZNAME (report_symbolic) (Symbolic, control);

      void *Numeric;
      status = UMFPACK_ZNAME (numeric) (Ap, Ai,
                                        reinterpret_cast<const double *> (Ax),
                                        0, Symbolic, &Numeric, control,
                                        info);
      UMFPACK_ZNAME (free_symbolic) (&Symbolic) ;

      cond = Info (UMFPACK_RCOND);

      if (status < 0)
        {
          (*current_liboctave_error_handler)
            ("SparseComplexLU::SparseComplexLU numeric factorization failed");

          UMFPACK_ZNAME (report_status) (control, status);
          UMFPACK_ZNAME (report_info) (control, info);

          UMFPACK_ZNAME (free_numeric) (&Numeric);
        }
      else
        {
          UMFPACK_ZNAME (report_numeric) (Numeric, control);

          octave_idx_type lnz, unz, ignore1, ignore2, ignore3;
          status = UMFPACK_ZNAME (get_lunz) (&lnz, &unz, &ignore1,
                                        &ignore2, &ignore3, Numeric) ;

          if (status < 0)
            {
              (*current_liboctave_error_handler)
                ("SparseComplexLU::SparseComplexLU extracting LU factors failed");

              UMFPACK_ZNAME (report_status) (control, status);
              UMFPACK_ZNAME (report_info) (control, info);

              UMFPACK_ZNAME (free_numeric) (&Numeric);
            }
          else
            {
              octave_idx_type n_inner = (nr < nc ? nr : nc);

              if (lnz < 1)
                Lfact = SparseComplexMatrix (n_inner, nr,
                                             static_cast<octave_idx_type> (1));
              else
                Lfact = SparseComplexMatrix (n_inner, nr, lnz);

              octave_idx_type *Ltp = Lfact.cidx ();
              octave_idx_type *Ltj = Lfact.ridx ();
              Complex *Ltx = Lfact.data ();

              if (unz < 1)
                Ufact = SparseComplexMatrix (n_inner, nc,
                                             static_cast<octave_idx_type> (1));
              else
                Ufact = SparseComplexMatrix (n_inner, nc, unz);

              octave_idx_type *Up = Ufact.cidx ();
              octave_idx_type *Uj = Ufact.ridx ();
              Complex *Ux = Ufact.data ();

              Rfact = SparseMatrix (nr, nr, nr);
              for (octave_idx_type i = 0; i < nr; i++)
                {
                  Rfact.xridx (i) = i;
                  Rfact.xcidx (i) = i;
                }
              Rfact.xcidx (nr) = nr;
              double *Rx = Rfact.data ();

              P.resize (dim_vector (nr, 1));
              octave_idx_type *p = P.fortran_vec ();

              Q.resize (dim_vector (nc, 1));
              octave_idx_type *q = Q.fortran_vec ();

              octave_idx_type do_recip;
              status = UMFPACK_ZNAME (get_numeric) (Ltp, Ltj,
                                                    reinterpret_cast<double *> (Ltx),
                                                    0, Up, Uj,
                                                    reinterpret_cast <double *> (Ux),
                                                    0, p, q, 0, 0,
                                                    &do_recip, Rx, Numeric);

              UMFPACK_ZNAME (free_numeric) (&Numeric) ;

              if (status < 0)
                {
                  (*current_liboctave_error_handler)
                    ("SparseComplexLU::SparseComplexLU extracting LU factors failed");

                  UMFPACK_ZNAME (report_status) (control, status);
                }
              else
                {
                  Lfact = Lfact.transpose ();

                  if (do_recip)
                    for (octave_idx_type i = 0; i < nr; i++)
                      Rx[i] = 1.0 / Rx[i];

                  UMFPACK_ZNAME (report_matrix) (nr, n_inner,
                                            Lfact.cidx (), Lfact.ridx (),
                                            reinterpret_cast<double *> (Lfact.data ()),
                                            0, 1, control);

                  UMFPACK_ZNAME (report_matrix) (n_inner, nc,
                                            Ufact.cidx (), Ufact.ridx (),
                                            reinterpret_cast<double *> (Ufact.data ()),
                                            0, 1, control);
                  UMFPACK_ZNAME (report_perm) (nr, p, control);
                  UMFPACK_ZNAME (report_perm) (nc, q, control);
                }

              UMFPACK_ZNAME (report_info) (control, info);
            }
        }
    }
#else
  (*current_liboctave_error_handler) ("UMFPACK not installed");
#endif
}

SparseComplexLU::SparseComplexLU (const SparseComplexMatrix& a,
                                  const ColumnVector& Qinit,
                                  const Matrix& piv_thres, bool scale,
                                  bool FixedQ, double droptol,
                                  bool milu, bool udiag)
{
#ifdef HAVE_UMFPACK
  if (milu)
    (*current_liboctave_error_handler)
      ("Modified incomplete LU not implemented");
  else
    {
      octave_idx_type nr = a.rows ();
      octave_idx_type nc = a.cols ();

      // Setup the control parameters
      Matrix Control (UMFPACK_CONTROL, 1);
      double *control = Control.fortran_vec ();
      UMFPACK_ZNAME (defaults) (control);

      double tmp = octave_sparse_params::get_key ("spumoni");
      if (!xisnan (tmp))
        Control (UMFPACK_PRL) = tmp;
      if (piv_thres.nelem () == 2)
        {
          tmp = (piv_thres (0) > 1. ? 1. : piv_thres (0));
          if (!xisnan (tmp))
            Control (UMFPACK_PIVOT_TOLERANCE) = tmp;
          tmp = (piv_thres (1) > 1. ? 1. : piv_thres (1));
          if (!xisnan (tmp))
            Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp;
        }
      else
        {
          tmp = octave_sparse_params::get_key ("piv_tol");
          if (!xisnan (tmp))
            Control (UMFPACK_PIVOT_TOLERANCE) = tmp;

          tmp = octave_sparse_params::get_key ("sym_tol");
          if (!xisnan (tmp))
            Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp;
        }

      if (droptol >= 0.)
        Control (UMFPACK_DROPTOL) = droptol;

      // Set whether we are allowed to modify Q or not
      if (FixedQ)
        Control (UMFPACK_FIXQ) = 1.0;
      else
        {
          tmp = octave_sparse_params::get_key ("autoamd");
          if (!xisnan (tmp))
            Control (UMFPACK_FIXQ) = tmp;
        }

      // Turn-off UMFPACK scaling for LU
      if (scale)
        Control (UMFPACK_SCALE) = UMFPACK_SCALE_SUM;
      else
        Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE;

      UMFPACK_ZNAME (report_control) (control);

      const octave_idx_type *Ap = a.cidx ();
      const octave_idx_type *Ai = a.ridx ();
      const Complex *Ax = a.data ();

      UMFPACK_ZNAME (report_matrix) (nr, nc, Ap, Ai,
                                reinterpret_cast<const double *> (Ax), 0,
                                1, control);

      void *Symbolic;
      Matrix Info (1, UMFPACK_INFO);
      double *info = Info.fortran_vec ();
      int status;

      // Null loop so that qinit is imediately deallocated when not
      // needed
      do {
        OCTAVE_LOCAL_BUFFER (octave_idx_type, qinit, nc);

        for (octave_idx_type i = 0; i < nc; i++)
          qinit [i] = static_cast<octave_idx_type> (Qinit (i));

        status = UMFPACK_ZNAME (qsymbolic) (nr, nc, Ap, Ai,
                                       reinterpret_cast<const double *> (Ax),
                                       0, qinit, &Symbolic, control,
                                       info);
      } while (0);

      if (status < 0)
        {
          (*current_liboctave_error_handler)
            ("SparseComplexLU::SparseComplexLU symbolic factorization failed");

          UMFPACK_ZNAME (report_status) (control, status);
          UMFPACK_ZNAME (report_info) (control, info);

          UMFPACK_ZNAME (free_symbolic) (&Symbolic) ;
        }
      else
        {
          UMFPACK_ZNAME (report_symbolic) (Symbolic, control);

          void *Numeric;
          status = UMFPACK_ZNAME (numeric) (Ap, Ai,
                                       reinterpret_cast<const double *> (Ax), 0,
                                       Symbolic, &Numeric, control, info) ;
          UMFPACK_ZNAME (free_symbolic) (&Symbolic) ;

          cond = Info (UMFPACK_RCOND);

          if (status < 0)
            {
              (*current_liboctave_error_handler)
                ("SparseComplexLU::SparseComplexLU numeric factorization failed");

              UMFPACK_ZNAME (report_status) (control, status);
              UMFPACK_ZNAME (report_info) (control, info);

              UMFPACK_ZNAME (free_numeric) (&Numeric);
            }
          else
            {
              UMFPACK_ZNAME (report_numeric) (Numeric, control);

              octave_idx_type lnz, unz, ignore1, ignore2, ignore3;
              status = UMFPACK_ZNAME (get_lunz) (&lnz, &unz,
                                            &ignore1, &ignore2, &ignore3, Numeric);

              if (status < 0)
                {
                  (*current_liboctave_error_handler)
                    ("SparseComplexLU::SparseComplexLU extracting LU factors failed");

                  UMFPACK_ZNAME (report_status) (control, status);
                  UMFPACK_ZNAME (report_info) (control, info);

                  UMFPACK_ZNAME (free_numeric) (&Numeric);
                }
              else
                {
                  octave_idx_type n_inner = (nr < nc ? nr : nc);

                  if (lnz < 1)
                    Lfact = SparseComplexMatrix (n_inner, nr,
                       static_cast<octave_idx_type> (1));
                  else
                    Lfact = SparseComplexMatrix (n_inner, nr, lnz);

                  octave_idx_type *Ltp = Lfact.cidx ();
                  octave_idx_type *Ltj = Lfact.ridx ();
                  Complex *Ltx = Lfact.data ();

                  if (unz < 1)
                    Ufact = SparseComplexMatrix (n_inner, nc,
                       static_cast<octave_idx_type> (1));
                  else
                    Ufact = SparseComplexMatrix  (n_inner, nc, unz);

                  octave_idx_type *Up = Ufact.cidx ();
                  octave_idx_type *Uj = Ufact.ridx ();
                  Complex *Ux = Ufact.data ();

                  Rfact = SparseMatrix (nr, nr, nr);
                  for (octave_idx_type i = 0; i < nr; i++)
                    {
                      Rfact.xridx (i) = i;
                      Rfact.xcidx (i) = i;
                    }
                  Rfact.xcidx (nr) = nr;
                  double *Rx = Rfact.data ();

                  P.resize (dim_vector (nr, 1));
                  octave_idx_type *p = P.fortran_vec ();

                  Q.resize (dim_vector (nc, 1));
                  octave_idx_type *q = Q.fortran_vec ();

                  octave_idx_type do_recip;
                  status =
                    UMFPACK_ZNAME (get_numeric) (Ltp, Ltj,
                                            reinterpret_cast<double *> (Ltx),
                                            0, Up, Uj,
                                            reinterpret_cast<double *> (Ux),
                                            0, p, q, 0, 0,
                                            &do_recip, Rx, Numeric) ;

                  UMFPACK_ZNAME (free_numeric) (&Numeric) ;

                  if (status < 0)
                    {
                      (*current_liboctave_error_handler)
                        ("SparseComplexLU::SparseComplexLU extracting LU factors failed");

                      UMFPACK_ZNAME (report_status) (control, status);
                    }
                  else
                    {
                      Lfact = Lfact.transpose ();

                      if (do_recip)
                        for (octave_idx_type i = 0; i < nr; i++)
                          Rx[i] = 1.0 / Rx[i];

                      UMFPACK_ZNAME (report_matrix) (nr, n_inner,
                                                Lfact.cidx (),
                                                Lfact.ridx (),
                                                reinterpret_cast<double *> (Lfact.data ()),
                                                0, 1, control);

                      UMFPACK_ZNAME (report_matrix) (n_inner, nc,
                                                Ufact.cidx (),
                                                Ufact.ridx (),
                                                reinterpret_cast<double *> (Ufact.data ()),
                                                0, 1, control);
                      UMFPACK_ZNAME (report_perm) (nr, p, control);
                      UMFPACK_ZNAME (report_perm) (nc, q, control);
                    }

                  UMFPACK_ZNAME (report_info) (control, info);
                }
            }
        }

      if (udiag)
        (*current_liboctave_error_handler)
          ("Option udiag of incomplete LU not implemented");
    }
#else
  (*current_liboctave_error_handler) ("UMFPACK not installed");
#endif
}