Ejemplo n.º 1
0
void DenseMatrix<T>::_matvec_blas(T alpha, T beta,
                                  DenseVector<T>& dest,
                                  const DenseVector<T>& arg,
                                  bool trans) const
{
  // Ensure that dest and arg sizes are compatible
  if (!trans)
    {
      // dest  ~ A     * arg
      // (mx1)   (mxn) * (nx1)
      if ((dest.size() != this->m()) || (arg.size() != this->n()))
        {
          libMesh::out << "Improper input argument sizes!" << std::endl;
          libmesh_error();
        }
    }

  else // trans == true
    {
      // Ensure that dest and arg are proper size
      // dest  ~ A^T   * arg
      // (nx1)   (nxm) * (mx1)
      if ((dest.size() != this->n()) || (arg.size() != this->m()))
        {
          libMesh::out << "Improper input argument sizes!" << std::endl;
          libmesh_error();
        }
    }

  // Calling sequence for dgemv:
  //
  // dgemv(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)

  //   TRANS  - CHARACTER*1, 't' for transpose, 'n' for non-transpose multiply
  // We store everything in row-major order, so pass the transpose flag for
  // non-transposed matvecs and the 'n' flag for transposed matvecs
  char TRANS[] = "t";
  if (trans)
    TRANS[0] = 'n';

  //   M      - INTEGER.
  //            On entry, M specifies the number of rows of the matrix A.
  // In C/C++, pass the number of *cols* of A
  int M = this->n();

  //   N      - INTEGER.
  //            On entry, N specifies the number of columns of the matrix A.
  // In C/C++, pass the number of *rows* of A
  int N = this->m();

  //   ALPHA  - DOUBLE PRECISION.
  // The scalar constant passed to this function

  //   A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
  //            Before entry, the leading m by n part of the array A must
  //            contain the matrix of coefficients.
  // The matrix, *this.  Note that _matvec_blas is called from
  // a const function, vector_mult(), and so we have made this function const
  // as well.  Since BLAS knows nothing about const, we have to cast it away
  // now.
  DenseMatrix<T>& a_ref = const_cast< DenseMatrix<T>& > ( *this );
  std::vector<T>& a = a_ref.get_values();

  //   LDA    - INTEGER.
  //            On entry, LDA specifies the first dimension of A as declared
  //            in the calling (sub) program. LDA must be at least
  //            max( 1, m ).
  int LDA = M;

  //   X      - DOUBLE PRECISION array of DIMENSION at least
  //            ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
  //            and at least
  //            ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
  //            Before entry, the incremented array X must contain the
  //            vector x.
  // Here, we must cast away the const-ness of "arg" since BLAS knows
  // nothing about const
  DenseVector<T>& x_ref = const_cast< DenseVector<T>& > ( arg );
  std::vector<T>& x = x_ref.get_values();

  //   INCX   - INTEGER.
  //            On entry, INCX specifies the increment for the elements of
  //            X. INCX must not be zero.
  int INCX = 1;

  //   BETA   - DOUBLE PRECISION.
  //            On entry, BETA specifies the scalar beta. When BETA is
  //            supplied as zero then Y need not be set on input.
  // The second scalar constant passed to this function

  //   Y      - DOUBLE PRECISION array of DIMENSION at least
  //            ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
  //            and at least
  //            ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
  //            Before entry with BETA non-zero, the incremented array Y
  //            must contain the vector y. On exit, Y is overwritten by the
  //            updated vector y.
  // The input vector "dest"
  std::vector<T>& y = dest.get_values();

  //   INCY   - INTEGER.
  //            On entry, INCY specifies the increment for the elements of
  //            Y. INCY must not be zero.
  int INCY = 1;

  // Finally, ready to call the BLAS function
  BLASgemv_(TRANS, &M, &N, &alpha, &(a[0]), &LDA, &(x[0]), &INCX, &beta, &(y[0]), &INCY);
}
Ejemplo n.º 2
0
void DenseMatrix<T>::_evd_lapack (DenseVector<T> & lambda_real,
                                  DenseVector<T> & lambda_imag)
{
  // The calling sequence for dgeev is:
  // DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, VL, LDVL, VR,
  //         LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, IWORK, INFO )


  //  BALANC  (input) CHARACTER*1
  //          Indicates how the input matrix should be diagonally scaled
  //          and/or permuted to improve the conditioning of its
  //          eigenvalues.
  //          = 'N': Do not diagonally scale or permute;
  char BALANC = 'N';

  //  JOBVL   (input) CHARACTER*1
  //          = 'N': left eigenvectors of A are not computed;
  //          = 'V': left eigenvectors of A are computed.
  char JOBVL = 'N';

  //  JOBVR   (input) CHARACTER*1
  //          = 'N': right eigenvectors of A are not computed;
  //          = 'V': right eigenvectors of A are computed.
  char JOBVR = 'N';

  //  SENSE   (input) CHARACTER*1
  //          Determines which reciprocal condition numbers are computed.
  //          = 'N': None are computed;
  //          = 'E': Computed for eigenvalues only;
  //          = 'V': Computed for right eigenvectors only;
  //          = 'B': Computed for eigenvalues and right eigenvectors.
  char SENSE = 'N';

  //    N       (input) int *
  //            The number of rows/cols of the matrix A.  N >= 0.
  libmesh_assert( this->m() == this->n() );
  int N = this->m();

  //  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
  //          On entry, the N-by-N matrix A.
  //          On exit, A has been overwritten.
  // Here, we pass &(_val[0]).

  //    LDA     (input) int *
  //            The leading dimension of the array A.  LDA >= max(1,N).
  int LDA = N;

  //  WR      (output) DOUBLE PRECISION array, dimension (N)
  //  WI      (output) DOUBLE PRECISION array, dimension (N)
  //          WR and WI contain the real and imaginary parts,
  //          respectively, of the computed eigenvalues.  Complex
  //          conjugate pairs of eigenvalues appear consecutively
  //          with the eigenvalue having the positive imaginary part
  //          first.
  lambda_real.resize(N);
  lambda_imag.resize(N);

  //  VL      (output) DOUBLE PRECISION array, dimension (LDVL,N)
  //          If JOBVL = 'V', the left eigenvectors u(j) are stored one
  //          after another in the columns of VL, in the same order
  //          as their eigenvalues.
  //          If JOBVL = 'N', VL is not referenced.
  //          If the j-th eigenvalue is real, then u(j) = VL(:,j),
  //          the j-th column of VL.
  //          If the j-th and (j+1)-st eigenvalues form a complex
  //          conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
  //          u(j+1) = VL(:,j) - i*VL(:,j+1).
  // Just set to NULL here.

  //  LDVL    (input) INTEGER
  //          The leading dimension of the array VL.  LDVL >= 1; if
  //          JOBVL = 'V', LDVL >= N.
  int LDVL = 1;

  //  VR      (output) DOUBLE PRECISION array, dimension (LDVR,N)
  //          If JOBVR = 'V', the right eigenvectors v(j) are stored one
  //          after another in the columns of VR, in the same order
  //          as their eigenvalues.
  //          If JOBVR = 'N', VR is not referenced.
  //          If the j-th eigenvalue is real, then v(j) = VR(:,j),
  //          the j-th column of VR.
  //          If the j-th and (j+1)-st eigenvalues form a complex
  //          conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
  //          v(j+1) = VR(:,j) - i*VR(:,j+1).
  // Just set to NULL here.

  //  LDVR    (input) INTEGER
  //          The leading dimension of the array VR.  LDVR >= 1; if
  //          JOBVR = 'V', LDVR >= N.
  int LDVR = 1;

  // Outputs (unused)
  int ILO = 0;
  int IHI = 0;
  std::vector<T> SCALE(N);
  T ABNRM;
  std::vector<T> RCONDE(N);
  std::vector<T> RCONDV(N);

  //  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
  //          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
  //
  //  LWORK   (input) INTEGER
  //          The dimension of the array WORK.
  int LWORK = 3*N;
  std::vector<T> WORK( LWORK );

  //  IWORK   (workspace) INTEGER array, dimension (2*N-2)
  //          If SENSE = 'N' or 'E', not referenced.
  // Just set to NULL


  //  INFO    (output) INTEGER
  //          = 0:  successful exit
  //          < 0:  if INFO = -i, the i-th argument had an illegal value.
  //          > 0:  if INFO = i, the QR algorithm failed to compute all the
  //                eigenvalues, and no eigenvectors or condition numbers
  //                have been computed; elements 1:ILO-1 and i+1:N of WR
  //                and WI contain eigenvalues which have converged.
  int INFO = 0;

  // Get references to raw data
  std::vector<T> & lambda_real_val = lambda_real.get_values();
  std::vector<T> & lambda_imag_val = lambda_imag.get_values();

  // Ready to call the actual factorization routine through SLEPc's interface
  LAPACKgeevx_( &BALANC, &JOBVL, &JOBVR, &SENSE, &N, &(_val[0]), &LDA, &lambda_real_val[0],
                &lambda_imag_val[0], libmesh_nullptr, &LDVL, libmesh_nullptr, &LDVR, &ILO, &IHI, &SCALE[0], &ABNRM,
                &RCONDE[0], &RCONDV[0], &WORK[0], &LWORK, libmesh_nullptr, &INFO );

  // Check return value for errors
  if (INFO != 0)
    libmesh_error_msg("INFO=" << INFO << ", Error during Lapack eigenvalue calculation!");
}
Ejemplo n.º 3
0
void DenseMatrix<T>::_lu_back_substitute_lapack (const DenseVector<T>& b,
                                                 DenseVector<T>& x)
{
  // The calling sequence for getrs is:
  // dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)

  //    trans   (input) char*
  //            'n' for no tranpose, 't' for transpose
  char TRANS[] = "t";

  //    N       (input) int*
  //            The order of the matrix A.  N >= 0.
  int N = this->m();


  //    NRHS    (input) int*
  //            The number of right hand sides, i.e., the number of columns
  //            of the matrix B.  NRHS >= 0.
  int NRHS = 1;

  //    A       (input) DOUBLE PRECISION array, dimension (LDA,N)
  //            The factors L and U from the factorization A = P*L*U
  //            as computed by dgetrf.
  // Here, we pass &(_val[0])

  //    LDA     (input) int*
  //            The leading dimension of the array A.  LDA >= max(1,N).
  int LDA = N;

  //    ipiv    (input) int array, dimension (N)
  //            The pivot indices from DGETRF; for 1<=i<=N, row i of the
  //            matrix was interchanged with row IPIV(i).
  // Here, we pass &(_pivots[0]) which was computed in _lu_decompose_lapack

  //    B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
  //            On entry, the right hand side matrix B.
  //            On exit, the solution matrix X.
  // Here, we pass a copy of the rhs vector's data array in x, so that the
  // passed right-hand side b is unmodified.  I don't see a way around this
  // copy if we want to maintain an unmodified rhs in LibMesh.
  x = b;
  std::vector<T>& x_vec = x.get_values();

  // We can avoid the copy if we don't care about overwriting the RHS: just
  // pass b to the Lapack routine and then swap with x before exiting
  // std::vector<T>& x_vec = b.get_values();

  //    LDB     (input) int*
  //            The leading dimension of the array B.  LDB >= max(1,N).
  int LDB = N;

  //    INFO    (output) int*
  //            = 0:  successful exit
  //            < 0:  if INFO = -i, the i-th argument had an illegal value
  int INFO = 0;

  // Finally, ready to call the Lapack getrs function
  LAPACKgetrs_(TRANS, &N, &NRHS, &(_val[0]), &LDA, &(_pivots[0]), &(x_vec[0]), &LDB, &INFO);

  // Check return value for errors
  if (INFO != 0)
    {
      libMesh::out << "INFO="
                   << INFO
                   << ", Error during Lapack LU solve!" << std::endl;
      libmesh_error();
    }

  // Don't do this if you already made a copy of b above
  // Swap b and x.  The solution will then be in x, and whatever was originally
  // in x, maybe garbage, maybe nothing, will be in b.
  // FIXME: Rewrite the LU and Cholesky solves to just take one input, and overwrite
  // the input.  This *should* make user code simpler, as they don't have to create
  // an extra vector just to pass it in to the solve function!
  // b.swap(x);
}
Ejemplo n.º 4
0
void DenseMatrix<T>::_svd_solve_lapack(const DenseVector<T> & rhs,
                                       DenseVector<T> & x,
                                       Real rcond) const
{
  // Since BLAS is expecting column-major storage, we first need to
  // make a transposed copy of *this, then pass it to the gelss
  // routine instead of the original.  This extra copy is kind of a
  // bummer, it might be better if we could use the full SVD to
  // compute the least-squares solution instead...  Note that it isn't
  // completely terrible either, since A_trans gets overwritten by
  // Lapack, and we usually would end up making a copy of A outside
  // the function call anyway.
  DenseMatrix<T> A_trans;
  this->get_transpose(A_trans);

  // M is INTEGER
  // The number of rows of the input matrix. M >= 0.
  // This is actually the number of *columns* of A_trans.
  int M = A_trans.n();

  // N is INTEGER
  // The number of columns of the matrix A. N >= 0.
  // This is actually the number of *rows* of A_trans.
  int N = A_trans.m();

  // We'll use the min and max of (M,N) several times below.
  int max_MN = std::max(M,N);
  int min_MN = std::min(M,N);

  // NRHS is INTEGER
  // The number of right hand sides, i.e., the number of columns
  // of the matrices B and X. NRHS >= 0.
  // This could later be generalized to solve for multiple right-hand
  // sides...
  int NRHS = 1;

  // A is DOUBLE PRECISION array, dimension (LDA,N)
  // On entry, the M-by-N matrix A.
  // On exit, the first min(m,n) rows of A are overwritten with
  // its right singular vectors, stored rowwise.
  //
  // The data vector that will be passed to Lapack.
  std::vector<T> & A_trans_vals = A_trans.get_values();

  // LDA is INTEGER
  // The leading dimension of the array A.  LDA >= max(1,M).
  int LDA = M;

  // B is DOUBLE PRECISION array, dimension (LDB,NRHS)
  // On entry, the M-by-NRHS right hand side matrix B.
  // On exit, B is overwritten by the N-by-NRHS solution
  // matrix X.  If m >= n and RANK = n, the residual
  // sum-of-squares for the solution in the i-th column is given
  // by the sum of squares of elements n+1:m in that column.
  //
  // Since we don't want the user's rhs vector to be overwritten by
  // the solution, we copy the rhs values into the solution vector "x"
  // now.  x needs to be long enough to hold both the (Nx1) solution
  // vector or the (Mx1) rhs, so size it to the max of those.
  x.resize(max_MN);
  for (unsigned i=0; i<rhs.size(); ++i)
    x(i) = rhs(i);

  // Make the syntax below simpler by grabbing a reference to this array.
  std::vector<T> & B = x.get_values();

  // LDB is INTEGER
  // The leading dimension of the array B. LDB >= max(1,max(M,N)).
  int LDB = x.size();

  // S is DOUBLE PRECISION array, dimension (min(M,N))
  // The singular values of A in decreasing order.
  // The condition number of A in the 2-norm = S(1)/S(min(m,n)).
  std::vector<T> S(min_MN);

  // RCOND is DOUBLE PRECISION
  // RCOND is used to determine the effective rank of A.
  // Singular values S(i) <= RCOND*S(1) are treated as zero.
  // If RCOND < 0, machine precision is used instead.
  Real RCOND = rcond;

  // RANK is INTEGER
  // The effective rank of A, i.e., the number of singular values
  // which are greater than RCOND*S(1).
  int RANK = 0;

  // LWORK is INTEGER
  // The dimension of the array WORK. LWORK >= 1, and also:
  // LWORK >= 3*min(M,N) + max( 2*min(M,N), max(M,N), NRHS )
  // For good performance, LWORK should generally be larger.
  //
  // If LWORK = -1, then a workspace query is assumed; the routine
  // only calculates the optimal size of the WORK array, returns
  // this value as the first entry of the WORK array, and no error
  // message related to LWORK is issued by XERBLA.
  //
  // The factor of 1.5 is arbitrary and is used to satisfy the "should
  // generally be larger" clause.
  int LWORK = 1.5 * (3*min_MN + std::max(2*min_MN, std::max(max_MN, NRHS)));

  // WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
  // On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
  std::vector<T> WORK(LWORK);

  // INFO is INTEGER
  // = 0:  successful exit
  // < 0:  if INFO = -i, the i-th argument had an illegal value.
  // > 0:  the algorithm for computing the SVD failed to converge;
  //       if INFO = i, i off-diagonal elements of an intermediate
  //       bidiagonal form did not converge to zero.
  int INFO = 0;

  // LAPACKgelss_(const PetscBLASInt *, // M
  //              const PetscBLASInt *, // N
  //              const PetscBLASInt *, // NRHS
  //              PetscScalar *,        // A
  //              const PetscBLASInt *, // LDA
  //              PetscScalar *,        // B
  //              const PetscBLASInt *, // LDB
  //              PetscReal *,          // S(out) = singular values of A in increasing order
  //              const PetscReal *,    // RCOND = tolerance for singular values
  //              PetscBLASInt *,       // RANK(out) = number of "non-zero" singular values
  //              PetscScalar *,        // WORK
  //              const PetscBLASInt *, // LWORK
  //              PetscBLASInt *);      // INFO
  LAPACKgelss_(&M, &N, &NRHS, &A_trans_vals[0], &LDA, &B[0], &LDB, &S[0], &RCOND, &RANK, &WORK[0], &LWORK, &INFO);

  // Check for errors in the Lapack call
  if (INFO < 0)
    libmesh_error_msg("Error, argument " << -INFO << " to LAPACKgelss_ had an illegal value.");
  if (INFO > 0)
    libmesh_error_msg("The algorithm for computing the SVD failed to converge!");

  // Debugging: print singular values and information about condition number:
  // libMesh::err << "RCOND=" << RCOND << std::endl;
  // libMesh::err << "Singular values: " << std::endl;
  // for (unsigned i=0; i<S.size(); ++i)
  //   libMesh::err << S[i] << std::endl;
  // libMesh::err << "The condition number of A is approximately: " << S[0]/S.back() << std::endl;

  // Lapack has already written the solution into B, but it will be
  // the wrong size for non-square problems, so we need to resize it
  // correctly.  The size of the solution vector should be the number
  // of columns of the original A matrix.  Unfortunately, resizing a
  // DenseVector currently also zeros it out (unlike a std::vector) so
  // we'll resize the underlying storage directly (the size is not
  // stored independently elsewhere).
  x.get_values().resize(this->n());
}