mirror of
https://github.com/opencv/opencv.git
synced 2024-12-16 10:29:11 +08:00
2ee9d21dae
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>
290 lines
9.6 KiB
C
290 lines
9.6 KiB
C
#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);
|
|
}
|