RTOp Package Browser (Single Doxygen Collection) Version of the Day
Loading...
Searching...
No Matches
RTOpPack_LapackWrappers.hpp
Go to the documentation of this file.
1// @HEADER
2// ***********************************************************************
3//
4// RTOp: Interfaces and Support Software for Vector Reduction Transformation
5// Operations
6// Copyright (2006) Sandia Corporation
7//
8// Under terms of Contract DE-AC04-94AL85000, there is a non-exclusive
9// license for use of this work by or on behalf of the U.S. Government.
10//
11// Redistribution and use in source and binary forms, with or without
12// modification, are permitted provided that the following conditions are
13// met:
14//
15// 1. Redistributions of source code must retain the above copyright
16// notice, this list of conditions and the following disclaimer.
17//
18// 2. Redistributions in binary form must reproduce the above copyright
19// notice, this list of conditions and the following disclaimer in the
20// documentation and/or other materials provided with the distribution.
21//
22// 3. Neither the name of the Corporation nor the names of the
23// contributors may be used to endorse or promote products derived from
24// this software without specific prior written permission.
25//
26// THIS SOFTWARE IS PROVIDED BY SANDIA CORPORATION "AS IS" AND ANY
27// EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
28// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
29// PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL SANDIA CORPORATION OR THE
30// CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
31// EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
32// PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
33// PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
34// LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
35// NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
36// SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37//
38// Questions? Contact Roscoe A. Bartlett (rabartl@sandia.gov)
39//
40// ***********************************************************************
41// @HEADER
42
43#ifndef RTOPPACK_LAPACK_WRAPPERS_HPP
44#define RTOPPACK_LAPACK_WRAPPERS_HPP
45
46
47#include "RTOpPack_Types.hpp"
48#include "Teuchos_LAPACK.hpp"
49#include "Teuchos_as.hpp"
50
51
52namespace RTOpPack {
53
54
59const int NUM_ETRANS_ARGS = 3;
60
62extern const Teuchos::Tuple<char,NUM_ETRANS_ARGS> transpMap;
63
64
75template<class Scalar>
76void getrf(
77 const SubMultiVectorView<Scalar> &A,
78 const ArrayView<int> &ipiv,
79 const Ptr<int> &rank
80 );
81
82
84template<class Scalar>
85void getrs(
86 const ConstSubMultiVectorView<Scalar> &A,
87 const ArrayView<const int> &ipiv,
88 const ETransp transp,
89 const Ptr<const SubMultiVectorView<Scalar> > &BX
90 );
91
92
93} // namespace RTOpPack
94
95
96//
97// Implementations
98//
99
100
101template<class Scalar>
103 const SubMultiVectorView<Scalar> &A,
104 const ArrayView<int> &ipiv,
105 const Ptr<int> &rank
106 )
107{
108 using Teuchos::as;
109 const int maxRank = TEUCHOS_MIN( A.subDim(), A.numSubCols() );
110#ifdef TEUCHOS_DEBUG
111 TEUCHOS_TEST_FOR_EXCEPT( A.subDim() == 0 );
112 TEUCHOS_TEST_FOR_EXCEPT( A.numSubCols() == 0 );
113 TEUCHOS_TEST_FOR_EXCEPT( is_null(A.values()) );
114 TEUCHOS_ASSERT_EQUALITY( as<int>(ipiv.size()), maxRank );
115#endif
116
117 Teuchos::LAPACK<int, Scalar> lapack;
118 int info = -1;
119 lapack.GETRF( A.subDim(), A.numSubCols(), A.values().get(), A.leadingDim(),
120 &ipiv[0], &info );
121 *rank = maxRank;
122 TEUCHOS_TEST_FOR_EXCEPTION(
123 info < 0, std::invalid_argument
124 ,"getrf(...): Error, Invalid argument "
125 << -info << " sent to LAPACK function xGETRF(...)" );
126 if (info > 0)
127 *rank = info - 1;
128}
129
130
131template<class Scalar>
133 const ConstSubMultiVectorView<Scalar> &A,
134 const ArrayView<const int> &ipiv,
135 const ETransp transp,
136 const Ptr<const SubMultiVectorView<Scalar> > &BX
137 )
138{
139 using Teuchos::as;
140#ifdef TEUCHOS_DEBUG
141 TEUCHOS_ASSERT( !is_null(BX) );
142 TEUCHOS_ASSERT_EQUALITY( A.subDim(), BX->subDim() );
143 TEUCHOS_ASSERT_EQUALITY( A.subDim(), A.numSubCols() );
144 TEUCHOS_TEST_FOR_EXCEPT( A.subDim() == 0 );
145 TEUCHOS_TEST_FOR_EXCEPT( A.numSubCols() == 0 );
146 TEUCHOS_TEST_FOR_EXCEPT( is_null(A.values()) );
147 TEUCHOS_ASSERT_EQUALITY( A.subDim(), ipiv.size() );
148#endif
149 Teuchos::LAPACK<int, Scalar> lapack;
150 int info = -1;
151 lapack.GETRS(
152 transpMap[transp],
153 A.subDim(), BX->numSubCols(), A.values().get(), A.leadingDim(),
154 &ipiv[0], BX->values().get(), BX->leadingDim(), &info
155 );
156 TEUCHOS_TEST_FOR_EXCEPTION(
157 info < 0, std::invalid_argument
158 ,"getrs(...): Error, Invalid argument "
159 << -info << " sent to LAPACK function xGETRS(...)" );
160 // If we get here B is the solution to the linear system.
161}
162
163
164#endif // RTOPPACK_LAPACK_WRAPPERS_HPP
const Teuchos::Tuple< char, NUM_ETRANS_ARGS > transpMap
void getrs(const ConstSubMultiVectorView< Scalar > &A, const ArrayView< const int > &ipiv, const ETransp transp, const Ptr< const SubMultiVectorView< Scalar > > &BX)
void getrf(const SubMultiVectorView< Scalar > &A, const ArrayView< int > &ipiv, const Ptr< int > &rank)
Peform an in-place factorization of a square or rectangular matrix.