lapack_int LAPACKE_slaswp( int matrix_order, lapack_int n, float* a,
lapack_int lda, lapack_int k1, lapack_int k2,
const lapack_int* ipiv, lapack_int incx )
{
if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_slaswp", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_sge_nancheck( matrix_order, lda, n, a, lda ) ) {
return -3;
}
#endif
return LAPACKE_slaswp_work( matrix_order, n, a, lda, k1, k2, ipiv, incx );
}
int CORE_sgessm(int M, int N, int K, int IB,
int *IPIV,
float *L, int LDL,
float *A, int LDA)
{
static float zone = 1.0;
static float mzone = -1.0;
static int ione = 1;
int i, sb;
int tmp, tmp2;
/* 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;
}
if (K < 0) {
coreblas_error(3, "Illegal value of K");
return -3;
}
if (IB < 0) {
coreblas_error(4, "Illegal value of IB");
return -4;
}
if ((LDL < max(1,M)) && (M > 0)) {
coreblas_error(7, "Illegal value of LDL");
return -7;
}
if ((LDA < max(1,M)) && (M > 0)) {
coreblas_error(9, "Illegal value of LDA");
return -9;
}
/* Quick return */
if ((M == 0) || (N == 0) || (K == 0) || (IB == 0))
return PLASMA_SUCCESS;
for(i = 0; i < K; i += IB) {
sb = min(IB, K-i);
/*
* Apply interchanges to columns I*IB+1:IB*( I+1 )+1.
*/
tmp = i+1;
tmp2 = i+sb;
LAPACKE_slaswp_work(LAPACK_COL_MAJOR, N, A, LDA, tmp, tmp2, IPIV, ione);
/*
* Compute block row of U.
*/
cblas_strsm(
CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasUnit,
sb, N, (zone),
&L[LDL*i+i], LDL,
&A[i], LDA );
if (i+sb < M) {
/*
* Update trailing submatrix.
*/
cblas_sgemm(
CblasColMajor, CblasNoTrans, CblasNoTrans,
M-(i+sb), N, sb,
(mzone), &L[LDL*i+(i+sb)], LDL,
&A[i], LDA,
(zone), &A[i+sb], LDA );
}
}
return PLASMA_SUCCESS;
}
