1 //=================================================================================================
2 /*!
3 //  \file blaze/math/lapack/clapack/hetrs.h
4 //  \brief Header file for the CLAPACK hetrs wrapper functions
5 //
6 //  Copyright (C) 2012-2020 Klaus Iglberger - All Rights Reserved
7 //
8 //  This file is part of the Blaze library. You can redistribute it and/or modify it under
9 //  the terms of the New (Revised) BSD License. Redistribution and use in source and binary
10 //  forms, with or without modification, are permitted provided that the following conditions
11 //  are met:
12 //
13 //  1. Redistributions of source code must retain the above copyright notice, this list of
14 //     conditions and the following disclaimer.
15 //  2. Redistributions in binary form must reproduce the above copyright notice, this list
16 //     of conditions and the following disclaimer in the documentation and/or other materials
17 //     provided with the distribution.
18 //  3. Neither the names of the Blaze development group nor the names of its contributors
19 //     may be used to endorse or promote products derived from this software without specific
20 //     prior written permission.
21 //
22 //  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY
23 //  EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
24 //  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
25 //  SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26 //  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 //  TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
28 //  BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
29 //  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 //  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
31 //  DAMAGE.
32 */
33 //=================================================================================================
34 
35 #ifndef _BLAZE_MATH_LAPACK_CLAPACK_HETRS_H_
36 #define _BLAZE_MATH_LAPACK_CLAPACK_HETRS_H_
37 
38 
39 //*************************************************************************************************
40 // Includes
41 //*************************************************************************************************
42 
43 #include <blaze/math/blas/Types.h>
44 #include <blaze/util/Complex.h>
45 #include <blaze/util/StaticAssert.h>
46 #include <blaze/util/Types.h>
47 
48 
49 //=================================================================================================
50 //
51 //  LAPACK FORWARD DECLARATIONS
52 //
53 //=================================================================================================
54 
55 //*************************************************************************************************
56 /*! \cond BLAZE_INTERNAL */
57 #if !defined(INTEL_MKL_VERSION)
58 extern "C" {
59 
60 void chetrs_( char* uplo, blaze::blas_int_t* n, blaze::blas_int_t* nrhs, float* A,
61               blaze::blas_int_t* lda, blaze::blas_int_t* ipiv, float* B, blaze::blas_int_t* ldb,
62               blaze::blas_int_t* info, blaze::fortran_charlen_t nuplo );
63 void zhetrs_( char* uplo, blaze::blas_int_t* n, blaze::blas_int_t* nrhs, double* A,
64               blaze::blas_int_t* lda, blaze::blas_int_t* ipiv, double* B, blaze::blas_int_t* ldb,
65               blaze::blas_int_t* info, blaze::fortran_charlen_t nuplo );
66 
67 }
68 #endif
69 /*! \endcond */
70 //*************************************************************************************************
71 
72 
73 
74 
75 namespace blaze {
76 
77 //=================================================================================================
78 //
79 //  LAPACK LDLH-BASED SUBSTITUTION FUNCTIONS (HETRS)
80 //
81 //=================================================================================================
82 
83 //*************************************************************************************************
84 /*!\name LAPACK LDLH-based substitution functions (hetrs) */
85 //@{
86 void hetrs( char uplo, blas_int_t n, blas_int_t nrhs, const complex<float>* A,
87             blas_int_t lda, const blas_int_t* ipiv, complex<float>* B,
88             blas_int_t ldb, blas_int_t* info );
89 
90 void hetrs( char uplo, blas_int_t n, blas_int_t nrhs, const complex<double>* A,
91             blas_int_t lda, const blas_int_t* ipiv, complex<double>* B,
92             blas_int_t ldb, blas_int_t* info );
93 //@}
94 //*************************************************************************************************
95 
96 
97 //*************************************************************************************************
98 /*!\brief LAPACK kernel for the substitution step of solving a symmetric indefinite single
99 //        precision complex linear system of equations (\f$ A*X=B \f$).
100 // \ingroup lapack_substitution
101 //
102 // \param uplo \c 'L' to use the lower part of the matrix, \c 'U' to use the upper part.
103 // \param n The number of rows/columns of the column-major matrix \f$[0..\infty)\f$.
104 // \param nrhs The number of right-hand side vectors \f$[0..\infty)\f$.
105 // \param A Pointer to the first element of the single precision complex column-major square matrix.
106 // \param lda The total number of elements between two columns of matrix \a A \f$[0..\infty)\f$.
107 // \param ipiv Auxiliary array of size \a n for the pivot indices.
108 // \param B Pointer to the first element of the single precision complex column-major matrix.
109 // \param ldb The total number of elements between two columns of matrix \a B \f$[0..\infty)\f$.
110 // \param info Return code of the function call.
111 // \return void
112 //
113 // This function uses the LAPACK chetrs() function to perform the substitution step to compute
114 // the solution to the symmetric indefinite system of linear equations \f$ A*X=B \f$, where \a A
115 // is a \a n-by-\a n matrix that has already been factorized by the chetrf() function and \a X
116 // and \a B are column-major \a n-by-\a nrhs matrices.
117 //
118 // The \a info argument provides feedback on the success of the function call:
119 //
120 //   - = 0: The function finished successfully.
121 //   - < 0: If info = -i, the i-th argument had an illegal value.
122 //
123 // For more information on the chetrs() function, see the LAPACK online documentation browser:
124 //
125 //        http://www.netlib.org/lapack/explore-html/
126 //
127 // \note This function can only be used if a fitting LAPACK library, which supports this function,
128 // is available and linked to the executable. Otherwise a call to this function will result in a
129 // linker error.
130 */
hetrs(char uplo,blas_int_t n,blas_int_t nrhs,const complex<float> * A,blas_int_t lda,const blas_int_t * ipiv,complex<float> * B,blas_int_t ldb,blas_int_t * info)131 inline void hetrs( char uplo, blas_int_t n, blas_int_t nrhs, const complex<float>* A,
132                    blas_int_t lda, const blas_int_t* ipiv, complex<float>* B,
133                    blas_int_t ldb, blas_int_t* info )
134 {
135    BLAZE_STATIC_ASSERT( sizeof( complex<float> ) == 2UL*sizeof( float ) );
136 
137 #if defined(INTEL_MKL_VERSION)
138    BLAZE_STATIC_ASSERT( sizeof( MKL_INT ) == sizeof( blas_int_t ) );
139    BLAZE_STATIC_ASSERT( sizeof( MKL_Complex8 ) == sizeof( complex<float> ) );
140    using ET = MKL_Complex8;
141 #else
142    using ET = float;
143 #endif
144 
145    chetrs_( &uplo, &n, &nrhs, const_cast<ET*>( reinterpret_cast<const ET*>( A ) ),
146             &lda, const_cast<blas_int_t*>( ipiv ), reinterpret_cast<ET*>( B ), &ldb, info
147 #if !defined(INTEL_MKL_VERSION)
148           , blaze::fortran_charlen_t(1)
149 #endif
150           );
151 }
152 //*************************************************************************************************
153 
154 
155 //*************************************************************************************************
156 /*!\brief LAPACK kernel for the substitution step of solving a symmetric indefinite double
157 //        precision complex linear system of equations (\f$ A*X=B \f$).
158 // \ingroup lapack_substitution
159 //
160 // \param uplo \c 'L' to use the lower part of the matrix, \c 'U' to use the upper part.
161 // \param n The number of rows/columns of the column-major matrix \f$[0..\infty)\f$.
162 // \param nrhs The number of right-hand side vectors \f$[0..\infty)\f$.
163 // \param A Pointer to the first element of the double precision complex column-major square matrix.
164 // \param lda The total number of elements between two columns of matrix \a A \f$[0..\infty)\f$.
165 // \param ipiv Auxiliary array of size \a n for the pivot indices.
166 // \param B Pointer to the first element of the double precision complex column-major matrix.
167 // \param ldb The total number of elements between two columns of matrix \a B \f$[0..\infty)\f$.
168 // \param info Return code of the function call.
169 // \return void
170 //
171 // This function uses the LAPACK zhetrs() function to perform the substitution step to compute
172 // the solution to the symmetric indefinite system of linear equations \f$ A*X=B \f$, where \a A
173 // is a \a n-by-\a n matrix that has already been factorized by the zhetrf() function and \a X
174 // and \a B are column-major \a n-by-\a nrhs matrices.
175 //
176 // The \a info argument provides feedback on the success of the function call:
177 //
178 //   - = 0: The function finished successfully.
179 //   - < 0: If info = -i, the i-th argument had an illegal value.
180 //
181 // For more information on the zhetrs() function, see the LAPACK online documentation browser:
182 //
183 //        http://www.netlib.org/lapack/explore-html/
184 //
185 // \note This function can only be used if a fitting LAPACK library, which supports this function,
186 // is available and linked to the executable. Otherwise a call to this function will result in a
187 // linker error.
188 */
hetrs(char uplo,blas_int_t n,blas_int_t nrhs,const complex<double> * A,blas_int_t lda,const blas_int_t * ipiv,complex<double> * B,blas_int_t ldb,blas_int_t * info)189 inline void hetrs( char uplo, blas_int_t n, blas_int_t nrhs, const complex<double>* A,
190                    blas_int_t lda, const blas_int_t* ipiv, complex<double>* B,
191                    blas_int_t ldb, blas_int_t* info )
192 {
193    BLAZE_STATIC_ASSERT( sizeof( complex<double> ) == 2UL*sizeof( double ) );
194 
195 #if defined(INTEL_MKL_VERSION)
196    BLAZE_STATIC_ASSERT( sizeof( MKL_INT ) == sizeof( blas_int_t ) );
197    BLAZE_STATIC_ASSERT( sizeof( MKL_Complex16 ) == sizeof( complex<double> ) );
198    using ET = MKL_Complex16;
199 #else
200    using ET = double;
201 #endif
202 
203    zhetrs_( &uplo, &n, &nrhs, const_cast<ET*>( reinterpret_cast<const ET*>( A ) ),
204             &lda, const_cast<blas_int_t*>( ipiv ), reinterpret_cast<ET*>( B ), &ldb, info
205 #if !defined(INTEL_MKL_VERSION)
206           , blaze::fortran_charlen_t(1)
207 #endif
208           );
209 }
210 //*************************************************************************************************
211 
212 } // namespace blaze
213 
214 #endif
215