mirror of https://github.com/opencv/opencv.git
Open Source Computer Vision Library
https://opencv.org/
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
289 lines
9.6 KiB
289 lines
9.6 KiB
#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); |
|
}
|
|
|