mirror/opencv
1
0
Fork 0
mirror of https://github.com/opencv/opencv.git synced 2024-12-17 02:48:01 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity
201a753e4a
opencv/3rdparty/clapack/runtime/cblas_wrap.c

290 lines
9.6 KiB
C
Raw Normal View History

Merge pull request #18571 from vpisarev:add_lapack Added clapack * bring a small subset of Lapack, automatically converted to C, into OpenCV * added missing lsame_ prototype * * small fix in make_clapack script * trying to fix remaining CI problems * fixed character arrays' initializers * get rid of F2C_STR_MAX * * added back single-precision versions for QR, LU and Cholesky decompositions. It adds very little extra overhead. * added stub version of sdesdd. * uncommented calls to all the single-precision Lapack functions from opencv/core/src/hal_internal.cpp. * fixed warning from Visual Studio + cleaned f2c runtime a bit * * regenerated Lapack w/o forward declarations of intrinsic functions (such as sqrt(), r_cnjg() etc.) * at once, trailing whitespaces are removed from the generated sources, just in case * since there is no declarations of intrinsic functions anymore, we could turn some of them into inline functions * trying to eliminate the crash on ARM * fixed API and semantics of s_copy * * CLapack has been tested successfully. It's now time to restore the standard LAPACK detection procedure * removed some more trailing whitespaces * * retained only the essential stuff in CLapack * added checks to lapack calls to gracefully return "not implemented" instead of returning invalid results with "ok" status * disabled warning when building lapack * cmake: update LAPACK detection Co-authored-by: Alexander Alekhin <alexander.a.alekhin@gmail.com>
2020-11-06 05:46:51 +08:00
#include "f2c.h"
#include <stdarg.h>
void cblas_cgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA,
const CBLAS_TRANSPOSE TransB, const int M, const int N,
const int K, const void *alpha, const void *A,
const int lda, const void *B, const int ldb,
const void *beta, void *C, const int ldc)
{
char TA, TB;
if( layout == CblasColMajor )
{
if(TransA == CblasTrans) TA='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(layout, 2, "cblas_cgemm", "Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TB='T';
else if ( TransB == CblasConjTrans ) TB='C';
else if ( TransB == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(layout, 3, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB);
return;
}
cgemm_(&TA, &TB, (int*)&M, (int*)&N, (int*)&K, (complex*)alpha, (complex*)A, (int*)&lda,
(complex*)B, (int*)&ldb, (complex*)beta, (complex*)C, (int*)&ldc);
}
else if (layout == CblasRowMajor)
{
if(TransA == CblasTrans) TB='T';
else if ( TransA == CblasConjTrans ) TB='C';
else if ( TransA == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(layout, 2, "cblas_cgemm", "Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TA='T';
else if ( TransB == CblasConjTrans ) TA='C';
else if ( TransB == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(layout, 2, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB);
return;
}
cgemm_(&TA, &TB, (int*)&N, (int*)&M, (int*)&K, (complex*)alpha, (complex*)B, (int*)&ldb,
(complex*)A, (int*)&lda, (complex*)beta, (complex*)C, (int*)&ldc);
}
else cblas_xerbla(layout, 1, "cblas_cgemm", "Illegal layout setting, %d\n", layout);
}
void cblas_dgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA,
const CBLAS_TRANSPOSE TransB, const int M, const int N,
const int K, const double alpha, const double *A,
const int lda, const double *B, const int ldb,
const double beta, double *C, const int ldc)
{
char TA, TB;
if( layout == CblasColMajor )
{
if(TransA == CblasTrans) TA='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(layout, 2, "cblas_dgemm", "Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TB='T';
else if ( TransB == CblasConjTrans ) TB='C';
else if ( TransB == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(layout, 3, "cblas_dgemm", "Illegal TransB setting, %d\n", TransB);
return;
}
dgemm_(&TA, &TB, (int*)&M, (int*)&N, (int*)&K, (double*)&alpha, (double*)A, (int*)&lda,
(double*)B, (int*)&ldb, (double*)&beta, (double*)C, (int*)&ldc);
}
else if (layout == CblasRowMajor)
{
if(TransA == CblasTrans) TB='T';
else if ( TransA == CblasConjTrans ) TB='C';
else if ( TransA == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(layout, 2, "cblas_dgemm", "Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TA='T';
else if ( TransB == CblasConjTrans ) TA='C';
else if ( TransB == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(layout, 2, "cblas_dgemm", "Illegal TransB setting, %d\n", TransB);
return;
}
dgemm_(&TA, &TB, (int*)&N, (int*)&M, (int*)&K, (double*)&alpha, (double*)B, (int*)&ldb,
(double*)A, (int*)&lda, (double*)&beta, (double*)C, (int*)&ldc);
}
else cblas_xerbla(layout, 1, "cblas_dgemm", "Illegal layout setting, %d\n", layout);
}
void cblas_sgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA,
const CBLAS_TRANSPOSE TransB, const int M, const int N,
const int K, const float alpha, const float *A,
const int lda, const float *B, const int ldb,
const float beta, float *C, const int ldc)
{
char TA, TB;
if( layout == CblasColMajor )
{
if(TransA == CblasTrans) TA='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(layout, 2, "cblas_sgemm", "Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TB='T';
else if ( TransB == CblasConjTrans ) TB='C';
else if ( TransB == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(layout, 3, "cblas_sgemm", "Illegal TransB setting, %d\n", TransB);
return;
}
sgemm_(&TA, &TB, (int*)&M, (int*)&N, (int*)&K, (float*)&alpha, (float*)A, (int*)&lda,
(float*)B, (int*)&ldb, (float*)&beta, (float*)C, (int*)&ldc);
}
else if (layout == CblasRowMajor)
{
if(TransA == CblasTrans) TB='T';
else if ( TransA == CblasConjTrans ) TB='C';
else if ( TransA == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(layout, 2, "cblas_sgemm", "Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TA='T';
else if ( TransB == CblasConjTrans ) TA='C';
else if ( TransB == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(layout, 2, "cblas_sgemm", "Illegal TransB setting, %d\n", TransB);
return;
}
sgemm_(&TA, &TB, (int*)&N, (int*)&M, (int*)&K, (float*)&alpha, (float*)B, (int*)&ldb,
(float*)A, (int*)&lda, (float*)&beta, (float*)C, (int*)&ldc);
}
else cblas_xerbla(layout, 1, "cblas_sgemm", "Illegal layout setting, %d\n", layout);
}
void cblas_zgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA,
const CBLAS_TRANSPOSE TransB, const int M, const int N,
const int K, const void *alpha, const void *A,
const int lda, const void *B, const int ldb,
const void *beta, void *C, const int ldc)
{
char TA, TB;
if( layout == CblasColMajor )
{
if(TransA == CblasTrans) TA='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(layout, 2, "cblas_zgemm", "Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TB='T';
else if ( TransB == CblasConjTrans ) TB='C';
else if ( TransB == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(layout, 3, "cblas_zgemm", "Illegal TransB setting, %d\n", TransB);
return;
}
zgemm_(&TA, &TB, (int*)&M, (int*)&N, (int*)&K, (doublecomplex*)alpha, (doublecomplex*)A, (int*)&lda,
(doublecomplex*)B, (int*)&ldb, (doublecomplex*)beta, (doublecomplex*)C, (int*)&ldc);
}
else if (layout == CblasRowMajor)
{
if(TransA == CblasTrans) TB='T';
else if ( TransA == CblasConjTrans ) TB='C';
else if ( TransA == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(layout, 2, "cblas_zgemm", "Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TA='T';
else if ( TransB == CblasConjTrans ) TA='C';
else if ( TransB == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(layout, 2, "cblas_zgemm", "Illegal TransB setting, %d\n", TransB);
return;
}
zgemm_(&TA, &TB, (int*)&N, (int*)&M, (int*)&K, (doublecomplex*)alpha, (doublecomplex*)B, (int*)&ldb,
(doublecomplex*)A, (int*)&lda, (doublecomplex*)beta, (doublecomplex*)C, (int*)&ldc);
}
else cblas_xerbla(layout, 1, "cblas_zgemm", "Illegal layout setting, %d\n", layout);
}
void cblas_xerbla(const CBLAS_LAYOUT layout, int info, const char *rout, const char *form, ...)
{
extern int RowMajorStrg;
char empty[1] = "";
va_list argptr;
va_start(argptr, form);
if (layout == CblasRowMajor)
{
if (strstr(rout,"gemm") != 0)
{
if (info == 5 ) info = 4;
else if (info == 4 ) info = 5;
else if (info == 11) info = 9;
else if (info == 9 ) info = 11;
}
else if (strstr(rout,"symm") != 0 || strstr(rout,"hemm") != 0)
{
if (info == 5 ) info = 4;
else if (info == 4 ) info = 5;
}
else if (strstr(rout,"trmm") != 0 || strstr(rout,"trsm") != 0)
{
if (info == 7 ) info = 6;
else if (info == 6 ) info = 7;
}
else if (strstr(rout,"gemv") != 0)
{
if (info == 4) info = 3;
else if (info == 3) info = 4;
}
else if (strstr(rout,"gbmv") != 0)
{
if (info == 4) info = 3;
else if (info == 3) info = 4;
else if (info == 6) info = 5;
else if (info == 5) info = 6;
}
else if (strstr(rout,"ger") != 0)
{
if (info == 3) info = 2;
else if (info == 2) info = 3;
else if (info == 8) info = 6;
else if (info == 6) info = 8;
}
else if ( (strstr(rout,"her2") != 0 || strstr(rout,"hpr2") != 0)
&& strstr(rout,"her2k") == 0 )
{
if (info == 8) info = 6;
else if (info == 6) info = 8;
}
}
if (info)
fprintf(stderr, "Parameter %d to routine %s was incorrect\n", info, rout);
vfprintf(stderr, form, argptr);
va_end(argptr);
if (info && !info)
xerbla_(empty, &info); /* Force link of our F77 error handler */
exit(-1);
}
Reference in New Issue Copy Permalink