Newer
Older
/**
*
* @copyright (c) 2009-2016 The University of Tennessee and The University
* of Tennessee Research Foundation.
* All rights reserved.
* @copyright (c) 2012-2016 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria,
* Univ. Bordeaux. All rights reserved.
*
**/
/**
*
* @file core_ztpqrt.c
*
* PLASMA core_blas kernel
* PLASMA is a software package provided by Univ. of Tennessee,
* Univ. of California Berkeley and Univ. of Colorado Denver
*
* @version 0.9.0
* @author Mathieu Faverge
* @date 2016-12-15
* @precisions normal z -> c d s
*
**/
#include "coreblas/lapacke.h"
#include "coreblas.h"
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
/**
******************************************************************************
*
* @ingroup CORE_MORSE_Complex64_t
*
* CORE_ztpqrt computes a blocked QR factorization of a complex
* "triangular-pentagonal" matrix C, which is composed of a
* triangular block A and pentagonal block B, using the compact
* WY representation for Q.
*
* C = | A | = Q * R
* | B |
*
*******************************************************************************
*
* @param[in] M
* The number of rows of the tile B. M >= 0.
*
* @param[in] N
* The number of rows of the tile A1.
* The number of columns of the tiles A1 and A2. N >= 0.
*
* @param[in] IB
* The inner-blocking size. IB >= 0.
*
* @param[in] N
* The number of columns of the matrix B, and the order of the matrix
* A. N >= 0.
*
* @param[in] L
* The number of rows of the upper trapezoidal part of B.
* MIN(M,N) >= L >= 0. See Further Details.
*
* @param[in,out] A
* On entry, the upper triangular N-by-N matrix A.
* On exit, the elements on and above the diagonal of the array
* contain the upper triangular matrix R.
*
* @param[in] LDA
* The leading dimension of the array A. LDA >= max(1,N).
*
* @param[in,out] B
* On entry, the pentagonal M-by-N matrix B. The first M-L rows
* are rectangular, and the last L rows are upper trapezoidal.
* On exit, B contains the pentagonal matrix V. See Further Details.
*
* @param[in] LDB
* The leading dimension of the array B. LDB >= max(1,M).
*
* @param[out] T
* The IB-by-N triangular factor T of the block reflector.
* T is upper triangular by block (economic storage);
* The rest of the array is not referenced.
*
* @param[in] LDT
* The leading dimension of the array T. LDT >= IB.
*
* @param[out] TAU
* The scalar factors of the elementary reflectors (see Further
* Details).
*
* @param[out] WORK
* WORK is COMPLEX*16 array, dimension ((IB+1)*N)
*
*******************************************************************************
*
* @return
* \retval MORSE_SUCCESS successful exit
* \retval <0 if -i, the i-th argument had an illegal value
*
******************************************************************************/
int CORE_ztpqrt( int M, int N, int L, int IB,
MORSE_Complex64_t *A, int LDA,
MORSE_Complex64_t *B, int LDB,
MORSE_Complex64_t *T, int LDT,
MORSE_Complex64_t *WORK )
{
#if !defined(NDEBUG)
/* Check input arguments */
if (M < 0) {
coreblas_error(1, "Illegal value of M");
return -1;
}
if (N < 0) {
coreblas_error(2, "Illegal value of N");
return -2;
}

Mathieu Faverge
committed
if( (L < 0) || ((L > chameleon_min(M, N)) && (chameleon_min(M,N) > 0))) {
coreblas_error(3, "Illegal value of L");
return -3;
}
if (IB < 0) {
coreblas_error(4, "Illegal value of IB");
return -4;
}

Mathieu Faverge
committed
if ((LDA < chameleon_max(1,N)) && (N > 0)) {
coreblas_error(6, "Illegal value of LDA");
return -6;
}

Mathieu Faverge
committed
if ((LDB < chameleon_max(1,M)) && (M > 0)) {
coreblas_error(6, "Illegal value of LDB");
return -8;
}

Mathieu Faverge
committed
if ((LDT < chameleon_max(1,IB)) && (IB > 0)) {
coreblas_error(6, "Illegal value of LDT");
return -10;
}
if ((L != 0) && (L != chameleon_min(M, N))) {
//LAPACKE_ztpmqrt_work( LAPACK_COL_MAJOR, M, N, K, L, IB, V, LDV, T, LDT, A, LDA, B, LDB, WORK );
coreblas_error( 6, "Illegal value of L (only 0 or min(M,N) handled for now)");
return -6;
}
#endif /*!defined(NDEBUG)*/
/* Quick return */
if ((M == 0) || (N == 0) || (IB == 0))
return MORSE_SUCCESS;
CORE_ztsqrt( M, N, IB, A, LDA, B, LDB, T, LDT, WORK, WORK+N );
}
CORE_zttqrt( M, N, IB, A, LDA, B, LDB, T, LDT, WORK, WORK+N );
}
/* else { */
/* //LAPACKE_ztpqrt_work( LAPACK_COL_MAJOR, M, N, L, IB, A, LDA, B, LDB, T, LDT, WORK ); */
/* coreblas_error( 3, "Illegal value of L (only 0 or M handled for now)"); */
/* return -3; */
/* } */