vendor: OpenCV 5.0.0 snapshot at 40738fb16ceddb5fb3fea747585f7ce6abb0605b

This commit is contained in:
Gitea Mirror Bot
2026-08-22 00:10:33 +08:00
commit f7f077da11
6933 changed files with 2335208 additions and 0 deletions
+289
View File
@@ -0,0 +1,289 @@
#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);
}
+72
View File
@@ -0,0 +1,72 @@
#include "f2c.h"
#include <float.h>
#include <stdio.h>
/* *********************************************************************** */
double dlamc3_(double *a, double *b)
{
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DLAMC3 is intended to force A and B to be stored prior to doing */
/* the addition of A and B , for use in situations where optimizers */
/* might hold one of these in a register. */
/* Arguments */
/* ========= */
/* A (input) DOUBLE PRECISION */
/* B (input) DOUBLE PRECISION */
/* The values A and B. */
/* ===================================================================== */
/* .. Executable Statements .. */
double ret_val = *a + *b;
return ret_val;
/* End of DLAMC3 */
} /* dlamc3_ */
/* simpler version of dlamch for the case of IEEE754-compliant FPU module by Piotr Luszczek S.
taken from http://www.mail-archive.com/numpy-discussion@lists.sourceforge.net/msg02448.html */
#ifndef DBL_DIGITS
#define DBL_DIGITS 53
#endif
static const unsigned char lapack_dlamch_tab0[] =
{
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 2, 0, 0, 0, 0, 0, 0, 3, 4, 5, 6, 7, 0, 8, 9, 0, 10, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 2, 0, 0, 0, 0, 0, 0, 3, 4, 5, 6, 7, 0, 8, 9,
0, 10, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
};
const double lapack_dlamch_tab1[] =
{
0, FLT_RADIX, DBL_EPSILON, DBL_MAX_EXP, DBL_MIN_EXP, DBL_DIGITS, DBL_MAX,
DBL_EPSILON*FLT_RADIX, 1, DBL_MIN*(1 + DBL_EPSILON), DBL_MIN
};
double dlamch_(char* cmach)
{
return lapack_dlamch_tab1[lapack_dlamch_tab0[(unsigned char)cmach[0]]];
}
+96
View File
@@ -0,0 +1,96 @@
#include "f2c.h"
static const int CLAPACK_NOT_IMPLEMENTED = -1024;
int sgesdd_(char *jobz, int *m, int *n, float *a, int *lda,
float *s, float *u, int *ldu, float *vt, int *ldvt, float *work,
int *lwork, int *iwork, int *info)
{
*info = CLAPACK_NOT_IMPLEMENTED;
return 0;
}
int dgels_(char *trans, int *m, int *n, int *nrhs, double *a,
int *lda, double *b, int *ldb, double *work, int *lwork, int *info)
{
*info = CLAPACK_NOT_IMPLEMENTED;
return 0;
}
int dgesv_(int *n, int *nrhs, double *a, int *lda, int *ipiv,
double *b, int *ldb, int *info)
{
*info = CLAPACK_NOT_IMPLEMENTED;
return 0;
}
int dgetrf_(int *m, int *n, double *a, int *lda, int *ipiv,
int *info)
{
*info = CLAPACK_NOT_IMPLEMENTED;
return 0;
}
int dposv_(char *uplo, int *n, int *nrhs, double *a, int *
lda, double *b, int *ldb, int *info)
{
*info = CLAPACK_NOT_IMPLEMENTED;
return 0;
}
int dpotrf_(char *uplo, int *n, double *a, int *lda, int *
info)
{
*info = CLAPACK_NOT_IMPLEMENTED;
return 0;
}
int sgels_(char *trans, int *m, int *n, int *nrhs, float *a,
int *lda, float *b, int *ldb, float *work, int *lwork, int *info)
{
*info = CLAPACK_NOT_IMPLEMENTED;
return 0;
}
int sgeev_(char *jobvl, char *jobvr, int *n, float *a, int *
lda, float *wr, float *wi, float *vl, int *ldvl, float *vr, int *
ldvr, float *work, int *lwork, int *info)
{
*info = CLAPACK_NOT_IMPLEMENTED;
return 0;
}
int sgeqrf_(int *m, int *n, float *a, int *lda, float *tau,
float *work, int *lwork, int *info)
{
*info = CLAPACK_NOT_IMPLEMENTED;
return 0;
}
int sgesv_(int *n, int *nrhs, float *a, int *lda, int *ipiv,
float *b, int *ldb, int *info)
{
*info = CLAPACK_NOT_IMPLEMENTED;
return 0;
}
int sgetrf_(int *m, int *n, float *a, int *lda, int *ipiv,
int *info)
{
*info = CLAPACK_NOT_IMPLEMENTED;
return 0;
}
int sposv_(char *uplo, int *n, int *nrhs, float *a, int *
lda, float *b, int *ldb, int *info)
{
*info = CLAPACK_NOT_IMPLEMENTED;
return 0;
}
int spotrf_(char *uplo, int *n, float *a, int *lda, int *
info)
{
*info = CLAPACK_NOT_IMPLEMENTED;
return 0;
}
+25
View File
@@ -0,0 +1,25 @@
#include "f2c.h"
static const unsigned char lapack_toupper_tab[] =
{
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23,
24, 25, 26, 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, 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, 123, 124, 125, 126, 127, 128, 129, 130, 131,
132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149,
150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167,
168, 169, 170, 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185,
186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 202, 203,
204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, 221,
222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239,
240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255
};
#define lapack_toupper(c) ((char)lapack_toupper_tab[(unsigned char)(c)])
int lsame_(char *ca, char *cb)
{
return lapack_toupper(ca[0]) == lapack_toupper(cb[0]);
}
+27
View File
@@ -0,0 +1,27 @@
#include "f2c.h"
double pow_di(double *ap, int *bp)
{
double p = 1;
double x = *ap;
int n = *bp;
if(n != 0)
{
if(n < 0)
{
n = -n;
x = 1/x;
}
unsigned u = (unsigned)n;
for(;;)
{
if((u & 1) != 0)
p *= x;
if((u >>= 1) == 0)
break;
x *= x;
}
}
return p;
}
+25
View File
@@ -0,0 +1,25 @@
#include "f2c.h"
int pow_ii(int *ap, int *bp)
{
int p;
int x = *ap;
int n = *bp;
if (n <= 0) {
if (n == 0 || x == 1)
return 1;
return x != -1 ? 0 : (n & 1) ? -1 : 1;
}
unsigned u = (unsigned)n;
for(p = 1; ; )
{
if(u & 01)
p *= x;
if(u >>= 1)
x *= x;
else
break;
}
return p;
}
+22
View File
@@ -0,0 +1,22 @@
/* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the
* target of a concatenation to appear on its right-hand side (contrary
* to the Fortran 77 Standard, but in accordance with Fortran 90).
*/
#include "f2c.h"
int s_cat(char *lp, char **rpp, int* rnp, int *np)
{
int i, L = 0;
int n = *np;
for(i = 0; i < n; i++) {
int ni = rnp[i];
if(ni > 0) {
memcpy(lp + L, rpp[i], ni);
L += ni;
}
}
lp[L] = '\0';
return 0;
}
+40
View File
@@ -0,0 +1,40 @@
#include "f2c.h"
/* compare two strings */
int s_cmp(char *a0, char *b0)
{
int la = (int)strlen(a0);
int lb = (int)strlen(b0);
unsigned char *a, *aend, *b, *bend;
a = (unsigned char *)a0;
b = (unsigned char *)b0;
aend = a + la;
bend = b + lb;
if(la <= lb)
{
while(a < aend)
if(*a != *b)
return( *a - *b );
else
{ ++a; ++b; }
while(b < bend)
if(*b != ' ')
return( ' ' - *b );
else ++b;
}
else
{
while(b < bend)
if(*a == *b)
{ ++a; ++b; }
else
return( *a - *b );
while(a < aend)
if(*a != ' ')
return(*a - ' ');
else ++a;
}
return(0);
}
+71
View File
@@ -0,0 +1,71 @@
#include "f2c.h"
#include <float.h>
#include <stdio.h>
/* *********************************************************************** */
double slamc3_(float *a, float *b)
{
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SLAMC3 is intended to force A and B to be stored prior to doing */
/* the addition of A and B , for use in situations where optimizers */
/* might hold one of these in a register. */
/* Arguments */
/* ========= */
/* A (input) REAL */
/* B (input) REAL */
/* The values A and B. */
/* ===================================================================== */
/* .. Executable Statements .. */
float ret_val = *a + *b;
return ret_val;
/* End of SLAMC3 */
} /* slamc3_ */
/* simpler version of slamch for the case of IEEE754-compliant FPU module by Piotr Luszczek S.
taken from http://www.mail-archive.com/numpy-discussion@lists.sourceforge.net/msg02448.html */
#ifndef FLT_DIGITS
#define FLT_DIGITS 24
#endif
static const unsigned char lapack_slamch_tab0[] =
{
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 2, 0, 0, 0, 0, 0, 0, 3, 4, 5, 6, 7, 0, 8, 9, 0, 10, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 2, 0, 0, 0, 0, 0, 0, 3, 4, 5, 6, 7, 0, 8, 9,
0, 10, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
};
const double lapack_slamch_tab1[] =
{
0, FLT_RADIX, FLT_EPSILON, FLT_MAX_EXP, FLT_MIN_EXP, FLT_DIGITS, FLT_MAX,
FLT_EPSILON*FLT_RADIX, 1, FLT_MIN*(1 + FLT_EPSILON), FLT_MIN
};
double slamch_(char* cmach)
{
return lapack_slamch_tab1[lapack_slamch_tab0[(unsigned char)cmach[0]]];
}
+19
View File
@@ -0,0 +1,19 @@
/* xerbla.f -- translated by f2c (version 20061008).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
*/
#include "f2c.h"
/* Subroutine */ int xerbla_(char *srname, int *info)
{
printf("** On entry to %s, parameter number %2i had an illegal value\n", srname, *info);
return 0;
} /* xerbla_ */