aboutsummaryrefslogtreecommitdiffstats
path: root/contrib/libs/cblas/src
diff options
context:
space:
mode:
authorrobot-piglet <robot-piglet@yandex-team.com>2023-07-30 16:42:12 +0300
committerrobot-piglet <robot-piglet@yandex-team.com>2023-07-30 16:42:12 +0300
commitc3f888e801f16a6a34204639b386a77340acf4e9 (patch)
tree46d965a71238a5e6a9c4a0244d0ac64e09bb4540 /contrib/libs/cblas/src
parent6a4a0ea7b10e768714b024f72f84e88a4448b503 (diff)
downloadydb-c3f888e801f16a6a34204639b386a77340acf4e9.tar.gz
Intermediate changes
Diffstat (limited to 'contrib/libs/cblas/src')
-rw-r--r--contrib/libs/cblas/src/cblas_caxpy.c22
-rw-r--r--contrib/libs/cblas/src/cblas_ccopy.c22
-rw-r--r--contrib/libs/cblas/src/cblas_cdotc_sub.c23
-rw-r--r--contrib/libs/cblas/src/cblas_cdotu_sub.c23
-rw-r--r--contrib/libs/cblas/src/cblas_cgbmv.c165
-rw-r--r--contrib/libs/cblas/src/cblas_cgemm.c109
-rw-r--r--contrib/libs/cblas/src/cblas_cgemv.c162
-rw-r--r--contrib/libs/cblas/src/cblas_cgerc.c84
-rw-r--r--contrib/libs/cblas/src/cblas_cgeru.c45
-rw-r--r--contrib/libs/cblas/src/cblas_chbmv.c159
-rw-r--r--contrib/libs/cblas/src/cblas_chemm.c106
-rw-r--r--contrib/libs/cblas/src/cblas_chemv.c160
-rw-r--r--contrib/libs/cblas/src/cblas_cher.c116
-rw-r--r--contrib/libs/cblas/src/cblas_cher2.c152
-rw-r--r--contrib/libs/cblas/src/cblas_cher2k.c111
-rw-r--r--contrib/libs/cblas/src/cblas_cherk.c105
-rw-r--r--contrib/libs/cblas/src/cblas_chpmv.c160
-rw-r--r--contrib/libs/cblas/src/cblas_chpr.c115
-rw-r--r--contrib/libs/cblas/src/cblas_chpr2.c149
-rw-r--r--contrib/libs/cblas/src/cblas_cscal.c21
-rw-r--r--contrib/libs/cblas/src/cblas_csscal.c21
-rw-r--r--contrib/libs/cblas/src/cblas_cswap.c22
-rw-r--r--contrib/libs/cblas/src/cblas_csymm.c106
-rw-r--r--contrib/libs/cblas/src/cblas_csyr2k.c108
-rw-r--r--contrib/libs/cblas/src/cblas_csyrk.c108
-rw-r--r--contrib/libs/cblas/src/cblas_ctbmv.c158
-rw-r--r--contrib/libs/cblas/src/cblas_ctbsv.c162
-rw-r--r--contrib/libs/cblas/src/cblas_ctpmv.c152
-rw-r--r--contrib/libs/cblas/src/cblas_ctpsv.c157
-rw-r--r--contrib/libs/cblas/src/cblas_ctrmm.c144
-rw-r--r--contrib/libs/cblas/src/cblas_ctrmv.c155
-rw-r--r--contrib/libs/cblas/src/cblas_ctrsm.c155
-rw-r--r--contrib/libs/cblas/src/cblas_ctrsv.c156
-rw-r--r--contrib/libs/cblas/src/cblas_dasum.c23
-rw-r--r--contrib/libs/cblas/src/cblas_daxpy.c22
-rw-r--r--contrib/libs/cblas/src/cblas_dcopy.c22
-rw-r--r--contrib/libs/cblas/src/cblas_ddot.c25
-rw-r--r--contrib/libs/cblas/src/cblas_dgbmv.c81
-rw-r--r--contrib/libs/cblas/src/cblas_dgemm.c109
-rw-r--r--contrib/libs/cblas/src/cblas_dgemv.c78
-rw-r--r--contrib/libs/cblas/src/cblas_dger.c47
-rw-r--r--contrib/libs/cblas/src/cblas_dnrm2.c23
-rw-r--r--contrib/libs/cblas/src/cblas_drot.c23
-rw-r--r--contrib/libs/cblas/src/cblas_drotg.c14
-rw-r--r--contrib/libs/cblas/src/cblas_drotm.c14
-rw-r--r--contrib/libs/cblas/src/cblas_drotmg.c15
-rw-r--r--contrib/libs/cblas/src/cblas_dsbmv.c77
-rw-r--r--contrib/libs/cblas/src/cblas_dscal.c21
-rw-r--r--contrib/libs/cblas/src/cblas_dsdot.c25
-rw-r--r--contrib/libs/cblas/src/cblas_dspmv.c76
-rw-r--r--contrib/libs/cblas/src/cblas_dspr.c70
-rw-r--r--contrib/libs/cblas/src/cblas_dspr2.c70
-rw-r--r--contrib/libs/cblas/src/cblas_dswap.c22
-rw-r--r--contrib/libs/cblas/src/cblas_dsymm.c106
-rw-r--r--contrib/libs/cblas/src/cblas_dsymv.c76
-rw-r--r--contrib/libs/cblas/src/cblas_dsyr.c71
-rw-r--r--contrib/libs/cblas/src/cblas_dsyr2.c76
-rw-r--r--contrib/libs/cblas/src/cblas_dsyr2k.c109
-rw-r--r--contrib/libs/cblas/src/cblas_dsyrk.c108
-rw-r--r--contrib/libs/cblas/src/cblas_dtbmv.c122
-rw-r--r--contrib/libs/cblas/src/cblas_dtbsv.c122
-rw-r--r--contrib/libs/cblas/src/cblas_dtpmv.c117
-rw-r--r--contrib/libs/cblas/src/cblas_dtpsv.c118
-rw-r--r--contrib/libs/cblas/src/cblas_dtrmm.c148
-rw-r--r--contrib/libs/cblas/src/cblas_dtrmv.c122
-rw-r--r--contrib/libs/cblas/src/cblas_dtrsm.c153
-rw-r--r--contrib/libs/cblas/src/cblas_dtrsv.c121
-rw-r--r--contrib/libs/cblas/src/cblas_dzasum.c23
-rw-r--r--contrib/libs/cblas/src/cblas_dznrm2.c23
-rw-r--r--contrib/libs/cblas/src/cblas_globals.c2
-rw-r--r--contrib/libs/cblas/src/cblas_icamax.c23
-rw-r--r--contrib/libs/cblas/src/cblas_idamax.c23
-rw-r--r--contrib/libs/cblas/src/cblas_isamax.c23
-rw-r--r--contrib/libs/cblas/src/cblas_izamax.c23
-rw-r--r--contrib/libs/cblas/src/cblas_sasum.c23
-rw-r--r--contrib/libs/cblas/src/cblas_saxpy.c23
-rw-r--r--contrib/libs/cblas/src/cblas_scasum.c23
-rw-r--r--contrib/libs/cblas/src/cblas_scnrm2.c23
-rw-r--r--contrib/libs/cblas/src/cblas_scopy.c22
-rw-r--r--contrib/libs/cblas/src/cblas_sdot.c25
-rw-r--r--contrib/libs/cblas/src/cblas_sdsdot.c25
-rw-r--r--contrib/libs/cblas/src/cblas_sgbmv.c83
-rw-r--r--contrib/libs/cblas/src/cblas_sgemm.c110
-rw-r--r--contrib/libs/cblas/src/cblas_sgemv.c78
-rw-r--r--contrib/libs/cblas/src/cblas_sger.c46
-rw-r--r--contrib/libs/cblas/src/cblas_snrm2.c23
-rw-r--r--contrib/libs/cblas/src/cblas_srot.c22
-rw-r--r--contrib/libs/cblas/src/cblas_srotg.c14
-rw-r--r--contrib/libs/cblas/src/cblas_srotm.c22
-rw-r--r--contrib/libs/cblas/src/cblas_srotmg.c15
-rw-r--r--contrib/libs/cblas/src/cblas_ssbmv.c76
-rw-r--r--contrib/libs/cblas/src/cblas_sscal.c21
-rw-r--r--contrib/libs/cblas/src/cblas_sspmv.c73
-rw-r--r--contrib/libs/cblas/src/cblas_sspr.c72
-rw-r--r--contrib/libs/cblas/src/cblas_sspr2.c71
-rw-r--r--contrib/libs/cblas/src/cblas_sswap.c22
-rw-r--r--contrib/libs/cblas/src/cblas_ssymm.c108
-rw-r--r--contrib/libs/cblas/src/cblas_ssymv.c76
-rw-r--r--contrib/libs/cblas/src/cblas_ssyr.c70
-rw-r--r--contrib/libs/cblas/src/cblas_ssyr2.c76
-rw-r--r--contrib/libs/cblas/src/cblas_ssyr2k.c111
-rw-r--r--contrib/libs/cblas/src/cblas_ssyrk.c110
-rw-r--r--contrib/libs/cblas/src/cblas_stbmv.c122
-rw-r--r--contrib/libs/cblas/src/cblas_stbsv.c122
-rw-r--r--contrib/libs/cblas/src/cblas_stpmv.c118
-rw-r--r--contrib/libs/cblas/src/cblas_stpsv.c118
-rw-r--r--contrib/libs/cblas/src/cblas_strmm.c148
-rw-r--r--contrib/libs/cblas/src/cblas_strmv.c122
-rw-r--r--contrib/libs/cblas/src/cblas_strsm.c143
-rw-r--r--contrib/libs/cblas/src/cblas_strsv.c121
-rw-r--r--contrib/libs/cblas/src/cblas_xerbla.c68
-rw-r--r--contrib/libs/cblas/src/cblas_zaxpy.c22
-rw-r--r--contrib/libs/cblas/src/cblas_zcopy.c22
-rw-r--r--contrib/libs/cblas/src/cblas_zdotc_sub.c24
-rw-r--r--contrib/libs/cblas/src/cblas_zdotu_sub.c24
-rw-r--r--contrib/libs/cblas/src/cblas_zdscal.c21
-rw-r--r--contrib/libs/cblas/src/cblas_zgbmv.c166
-rw-r--r--contrib/libs/cblas/src/cblas_zgemm.c109
-rw-r--r--contrib/libs/cblas/src/cblas_zgemv.c164
-rw-r--r--contrib/libs/cblas/src/cblas_zgerc.c84
-rw-r--r--contrib/libs/cblas/src/cblas_zgeru.c44
-rw-r--r--contrib/libs/cblas/src/cblas_zhbmv.c159
-rw-r--r--contrib/libs/cblas/src/cblas_zhemm.c106
-rw-r--r--contrib/libs/cblas/src/cblas_zhemv.c160
-rw-r--r--contrib/libs/cblas/src/cblas_zher.c110
-rw-r--r--contrib/libs/cblas/src/cblas_zher2.c153
-rw-r--r--contrib/libs/cblas/src/cblas_zher2k.c110
-rw-r--r--contrib/libs/cblas/src/cblas_zherk.c105
-rw-r--r--contrib/libs/cblas/src/cblas_zhpmv.c160
-rw-r--r--contrib/libs/cblas/src/cblas_zhpr.c115
-rw-r--r--contrib/libs/cblas/src/cblas_zhpr2.c150
-rw-r--r--contrib/libs/cblas/src/cblas_zscal.c21
-rw-r--r--contrib/libs/cblas/src/cblas_zswap.c22
-rw-r--r--contrib/libs/cblas/src/cblas_zsymm.c106
-rw-r--r--contrib/libs/cblas/src/cblas_zsyr2k.c108
-rw-r--r--contrib/libs/cblas/src/cblas_zsyrk.c107
-rw-r--r--contrib/libs/cblas/src/cblas_ztbmv.c158
-rw-r--r--contrib/libs/cblas/src/cblas_ztbsv.c162
-rw-r--r--contrib/libs/cblas/src/cblas_ztpmv.c152
-rw-r--r--contrib/libs/cblas/src/cblas_ztpsv.c157
-rw-r--r--contrib/libs/cblas/src/cblas_ztrmm.c149
-rw-r--r--contrib/libs/cblas/src/cblas_ztrmv.c156
-rw-r--r--contrib/libs/cblas/src/cblas_ztrsm.c155
-rw-r--r--contrib/libs/cblas/src/cblas_ztrsv.c156
-rw-r--r--contrib/libs/cblas/src/cdotcsub.c41
-rw-r--r--contrib/libs/cblas/src/cdotusub.c41
-rw-r--r--contrib/libs/cblas/src/dasumsub.c34
-rw-r--r--contrib/libs/cblas/src/ddotsub.c36
-rw-r--r--contrib/libs/cblas/src/dnrm2sub.c34
-rw-r--r--contrib/libs/cblas/src/dsdotsub.c35
-rw-r--r--contrib/libs/cblas/src/dzasumsub.c34
-rw-r--r--contrib/libs/cblas/src/dznrm2sub.c34
-rw-r--r--contrib/libs/cblas/src/icamaxsub.c34
-rw-r--r--contrib/libs/cblas/src/idamaxsub.c34
-rw-r--r--contrib/libs/cblas/src/isamaxsub.c34
-rw-r--r--contrib/libs/cblas/src/izamaxsub.c34
-rw-r--r--contrib/libs/cblas/src/sasumsub.c33
-rw-r--r--contrib/libs/cblas/src/scasumsub.c34
-rw-r--r--contrib/libs/cblas/src/scnrm2sub.c34
-rw-r--r--contrib/libs/cblas/src/sdotsub.c35
-rw-r--r--contrib/libs/cblas/src/sdsdotsub.c36
-rw-r--r--contrib/libs/cblas/src/snrm2sub.c33
-rw-r--r--contrib/libs/cblas/src/xerbla.c47
-rw-r--r--contrib/libs/cblas/src/zdotcsub.c41
-rw-r--r--contrib/libs/cblas/src/zdotusub.c41
165 files changed, 13100 insertions, 0 deletions
diff --git a/contrib/libs/cblas/src/cblas_caxpy.c b/contrib/libs/cblas/src/cblas_caxpy.c
new file mode 100644
index 0000000000..7579aa707a
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_caxpy.c
@@ -0,0 +1,22 @@
+/*
+ * cblas_caxpy.c
+ *
+ * The program is a C interface to caxpy.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_caxpy( const int N, const void *alpha, const void *X,
+ const int incX, void *Y, const int incY)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_caxpy( &F77_N, alpha, X, &F77_incX, Y, &F77_incY);
+}
diff --git a/contrib/libs/cblas/src/cblas_ccopy.c b/contrib/libs/cblas/src/cblas_ccopy.c
new file mode 100644
index 0000000000..b7bc428473
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ccopy.c
@@ -0,0 +1,22 @@
+/*
+ * cblas_ccopy.c
+ *
+ * The program is a C interface to ccopy.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ccopy( const int N, const void *X,
+ const int incX, void *Y, const int incY)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_ccopy( &F77_N, X, &F77_incX, Y, &F77_incY);
+}
diff --git a/contrib/libs/cblas/src/cblas_cdotc_sub.c b/contrib/libs/cblas/src/cblas_cdotc_sub.c
new file mode 100644
index 0000000000..d6086814e2
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_cdotc_sub.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_cdotc_sub.c
+ *
+ * The program is a C interface to cdotc.
+ * It calls the fortran wrapper before calling cdotc.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_cdotc_sub( const int N, const void *X, const int incX,
+ const void *Y, const int incY,void *dotc)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_cdotc_sub( &F77_N, X, &F77_incX, Y, &F77_incY, dotc);
+}
diff --git a/contrib/libs/cblas/src/cblas_cdotu_sub.c b/contrib/libs/cblas/src/cblas_cdotu_sub.c
new file mode 100644
index 0000000000..d06e4e5fa9
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_cdotu_sub.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_cdotu_sub.f
+ *
+ * The program is a C interface to cdotu.
+ * It calls the forteran wrapper before calling cdotu.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_cdotu_sub( const int N, const void *X,
+ const int incX, const void *Y, const int incY,void *dotu)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_cdotu_sub( &F77_N, X, &F77_incX, Y, &F77_incY, dotu);
+}
diff --git a/contrib/libs/cblas/src/cblas_cgbmv.c b/contrib/libs/cblas/src/cblas_cgbmv.c
new file mode 100644
index 0000000000..e61a31a4ab
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_cgbmv.c
@@ -0,0 +1,165 @@
+/*
+ * cblas_cgbmv.c
+ * The program is a C interface of cgbmv
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_cgbmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const int KL, const int KU,
+ const void *alpha, const void *A, const int lda,
+ const void *X, const int incX, const void *beta,
+ void *Y, const int incY)
+{
+ char TA;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA;
+#else
+ #define F77_TA &TA
+#endif
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+ F77_INT F77_KL=KL,F77_KU=KU;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_KL KL
+ #define F77_KU KU
+ #define F77_incX incx
+ #define F77_incY incY
+#endif
+ int n=0, i=0, incx=incX;
+ const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
+ float ALPHA[2],BETA[2];
+ int tincY, tincx;
+ float *x=(float *)X, *y=(float *)Y, *st=0, *tx=0;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(2, "cblas_cgbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ F77_cgbmv(F77_TA, &F77_M, &F77_N, &F77_KL, &F77_KU, alpha,
+ A, &F77_lda, X, &F77_incX, beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ ALPHA[0]= *alp;
+ ALPHA[1]= -alp[1];
+ BETA[0]= *bet;
+ BETA[1]= -bet[1];
+ TA = 'N';
+ if (M > 0)
+ {
+ n = M << 1;
+ x = malloc(n*sizeof(float));
+ tx = x;
+
+ if( incX > 0 ) {
+ i = incX << 1 ;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ #else
+ incx = 1;
+ #endif
+
+ if( incY > 0 )
+ tincY = incY;
+ else
+ tincY = -incY;
+
+ y++;
+
+ if (N > 0)
+ {
+ i = tincY << 1;
+ n = i * N ;
+ st = y + n;
+ do {
+ *y = -(*y);
+ y += i;
+ } while(y != st);
+ y -= n;
+ }
+ }
+ else x = (float *) X;
+
+
+ }
+ else
+ {
+ cblas_xerbla(2, "cblas_cgbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ if (TransA == CblasConjTrans)
+ F77_cgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, ALPHA,
+ A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY);
+ else
+ F77_cgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, alpha,
+ A ,&F77_lda, x,&F77_incX, beta, Y, &F77_incY);
+ if (TransA == CblasConjTrans)
+ {
+ if (x != X) free(x);
+ if (N > 0)
+ {
+ do
+ {
+ *y = -(*y);
+ y += i;
+ }
+ while (y != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_cgbmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+}
diff --git a/contrib/libs/cblas/src/cblas_cgemm.c b/contrib/libs/cblas/src/cblas_cgemm.c
new file mode 100644
index 0000000000..dee4696eed
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_cgemm.c
@@ -0,0 +1,109 @@
+/*
+ *
+ * cblas_cgemm.c
+ * This program is a C interface to cgemm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_cgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
+ const enum 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;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_TB;
+#else
+ #define F77_TA &TA
+ #define F77_TB &TB
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if(TransA == CblasTrans) TA='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(2, "cblas_cgemm", "Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if(TransB == CblasTrans) TB='T';
+ else if ( TransB == CblasConjTrans ) TB='C';
+ else if ( TransB == CblasNoTrans ) TB='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ F77_TB = C2F_CHAR(&TB);
+ #endif
+
+ F77_cgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, alpha, A,
+ &F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if(TransA == CblasTrans) TB='T';
+ else if ( TransA == CblasConjTrans ) TB='C';
+ else if ( TransA == CblasNoTrans ) TB='N';
+ else
+ {
+ cblas_xerbla(2, "cblas_cgemm", "Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if(TransB == CblasTrans) TA='T';
+ else if ( TransB == CblasConjTrans ) TA='C';
+ else if ( TransB == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(2, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ F77_TB = C2F_CHAR(&TB);
+ #endif
+
+ F77_cgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, alpha, B,
+ &F77_ldb, A, &F77_lda, beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_cgemm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_cgemv.c b/contrib/libs/cblas/src/cblas_cgemv.c
new file mode 100644
index 0000000000..5e4509a4f1
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_cgemv.c
@@ -0,0 +1,162 @@
+/*
+ * cblas_cgemv.c
+ * The program is a C interface of cgemv
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_cgemv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *X, const int incX, const void *beta,
+ void *Y, const int incY)
+{
+ char TA;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA;
+#else
+ #define F77_TA &TA
+#endif
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incx
+ #define F77_incY incY
+#endif
+
+ int n=0, i=0, incx=incX;
+ const float *xx= (const float *)X;
+ float ALPHA[2],BETA[2];
+ int tincY, tincx;
+ float *x=(float *)X, *y=(float *)Y, *st=0, *tx=0;
+ const float *stx = x;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+
+ if (order == CblasColMajor)
+ {
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(2, "cblas_cgemv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ F77_cgemv(F77_TA, &F77_M, &F77_N, alpha, A, &F77_lda, X, &F77_incX,
+ beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ ALPHA[0]= *( (const float *) alpha );
+ ALPHA[1]= -( *( (const float *) alpha+1) );
+ BETA[0]= *( (const float *) beta );
+ BETA[1]= -( *( (const float *) beta+1 ) );
+ TA = 'N';
+ if (M > 0)
+ {
+ n = M << 1;
+ x = malloc(n*sizeof(float));
+ tx = x;
+ if( incX > 0 ) {
+ i = incX << 1 ;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+
+ F77_incX = 1;
+
+ if(incY > 0)
+ tincY = incY;
+ else
+ tincY = -incY;
+
+ y++;
+
+ if (N > 0)
+ {
+ i = tincY << 1;
+ n = i * N ;
+ st = y + n;
+ do {
+ *y = -(*y);
+ y += i;
+ } while(y != st);
+ y -= n;
+ }
+ stx = x;
+ }
+ else stx = (const float *)X;
+ }
+ else
+ {
+ cblas_xerbla(2, "cblas_cgemv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ if (TransA == CblasConjTrans)
+ F77_cgemv(F77_TA, &F77_N, &F77_M, ALPHA, A, &F77_lda, stx,
+ &F77_incX, BETA, Y, &F77_incY);
+ else
+ F77_cgemv(F77_TA, &F77_N, &F77_M, alpha, A, &F77_lda, x,
+ &F77_incX, beta, Y, &F77_incY);
+
+ if (TransA == CblasConjTrans)
+ {
+ if (x != (const float *)X) free(x);
+ if (N > 0)
+ {
+ do
+ {
+ *y = -(*y);
+ y += i;
+ }
+ while (y != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_cgemv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_cgerc.c b/contrib/libs/cblas/src/cblas_cgerc.c
new file mode 100644
index 0000000000..29ccde63a8
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_cgerc.c
@@ -0,0 +1,84 @@
+/*
+ * cblas_cgerc.c
+ * The program is a C interface to cgerc.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_cgerc(const enum CBLAS_ORDER order, const int M, const int N,
+ const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *A, const int lda)
+{
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incy
+ #define F77_lda lda
+#endif
+
+ int n, i, tincy, incy=incY;
+ float *y=(float *)Y, *yy=(float *)Y, *ty, *st;
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ F77_cgerc( &F77_M, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, A,
+ &F77_lda);
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (N > 0)
+ {
+ n = N << 1;
+ y = malloc(n*sizeof(float));
+
+ ty = y;
+ if( incY > 0 ) {
+ i = incY << 1;
+ tincy = 2;
+ st= y+n;
+ } else {
+ i = incY *(-2);
+ tincy = -2;
+ st = y-2;
+ y +=(n-2);
+ }
+ do
+ {
+ *y = *yy;
+ y[1] = -yy[1];
+ y += tincy ;
+ yy += i;
+ }
+ while (y != st);
+ y = ty;
+
+ #ifdef F77_INT
+ F77_incY = 1;
+ #else
+ incy = 1;
+ #endif
+ }
+ else y = (float *) Y;
+
+ F77_cgeru( &F77_N, &F77_M, alpha, y, &F77_incY, X, &F77_incX, A,
+ &F77_lda);
+ if(Y!=y)
+ free(y);
+
+ } else cblas_xerbla(1, "cblas_cgerc", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_cgeru.c b/contrib/libs/cblas/src/cblas_cgeru.c
new file mode 100644
index 0000000000..549eae3cf4
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_cgeru.c
@@ -0,0 +1,45 @@
+/*
+ * cblas_cgeru.c
+ * The program is a C interface to cgeru.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_cgeru(const enum CBLAS_ORDER order, const int M, const int N,
+ const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *A, const int lda)
+{
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+ #define F77_lda lda
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+
+ if (order == CblasColMajor)
+ {
+ F77_cgeru( &F77_M, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, A,
+ &F77_lda);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ F77_cgeru( &F77_N, &F77_M, alpha, Y, &F77_incY, X, &F77_incX, A,
+ &F77_lda);
+ }
+ else cblas_xerbla(1, "cblas_cgeru","Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_chbmv.c b/contrib/libs/cblas/src/cblas_chbmv.c
new file mode 100644
index 0000000000..3f33e69c21
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_chbmv.c
@@ -0,0 +1,159 @@
+/*
+ * cblas_chbmv.c
+ * The program is a C interface to chbmv
+ *
+ * Keita Teranishi 5/18/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+#include <stdio.h>
+#include <stdlib.h>
+void cblas_chbmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_UPLO Uplo,const int N,const int K,
+ const void *alpha, const void *A, const int lda,
+ const void *X, const int incX, const void *beta,
+ void *Y, const int incY)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_incX incx
+ #define F77_incY incY
+#endif
+ int n, i=0, incx=incX;
+ const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
+ float ALPHA[2],BETA[2];
+ int tincY, tincx;
+ float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_chbmv","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_chbmv(F77_UL, &F77_N, &F77_K, alpha, A, &F77_lda, X,
+ &F77_incX, beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ ALPHA[0]= *alp;
+ ALPHA[1]= -alp[1];
+ BETA[0]= *bet;
+ BETA[1]= -bet[1];
+
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(float));
+
+ tx = x;
+ if( incX > 0 ) {
+ i = incX << 1 ;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ #else
+ incx = 1;
+ #endif
+
+ if(incY > 0)
+ tincY = incY;
+ else
+ tincY = -incY;
+ y++;
+
+ i = tincY << 1;
+ n = i * N ;
+ st = y + n;
+ do {
+ *y = -(*y);
+ y += i;
+ } while(y != st);
+ y -= n;
+ } else
+ x = (float *) X;
+
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_chbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_chbmv(F77_UL, &F77_N, &F77_K, ALPHA,
+ A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY);
+ }
+ else
+ {
+ cblas_xerbla(1, "cblas_chbmv","Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if ( order == CblasRowMajor )
+ {
+ RowMajorStrg = 1;
+ if(X!=x)
+ free(x);
+ if (N > 0)
+ {
+ do
+ {
+ *y = -(*y);
+ y += i;
+ }
+ while (y != st);
+ }
+ }
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_chemm.c b/contrib/libs/cblas/src/cblas_chemm.c
new file mode 100644
index 0000000000..89b80f5dc3
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_chemm.c
@@ -0,0 +1,106 @@
+/*
+ *
+ * cblas_chemm.c
+ * This program is a C interface to chemm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_chemm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const void *beta,
+ void *C, const int ldc)
+{
+ char SD, UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_SD, F77_UL;
+#else
+ #define F77_SD &SD
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if( Side == CblasRight) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_chemm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_chemm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_chemm(F77_SD, F77_UL, &F77_M, &F77_N, alpha, A, &F77_lda,
+ B, &F77_ldb, beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Side == CblasRight) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_chemm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_chemm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_chemm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A,
+ &F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_chemm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_chemv.c b/contrib/libs/cblas/src/cblas_chemv.c
new file mode 100644
index 0000000000..f36a00d78e
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_chemv.c
@@ -0,0 +1,160 @@
+/*
+ * cblas_chemv.c
+ * The program is a C interface to chemv
+ *
+ * Keita Teranishi 5/18/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_chemv(const enum CBLAS_ORDER order,
+ const enum CBLAS_UPLO Uplo, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *X, const int incX, const void *beta,
+ void *Y, const int incY)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incx
+ #define F77_incY incY
+#endif
+ int n=0, i=0, incx=incX;
+ const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
+ float ALPHA[2],BETA[2];
+ int tincY, tincx;
+ float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_chemv","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_chemv(F77_UL, &F77_N, alpha, A, &F77_lda, X, &F77_incX,
+ beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ ALPHA[0]= *alp;
+ ALPHA[1]= -alp[1];
+ BETA[0]= *bet;
+ BETA[1]= -bet[1];
+
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(float));
+
+ tx = x;
+ if( incX > 0 ) {
+ i = incX << 1 ;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ #else
+ incx = 1;
+ #endif
+
+ if(incY > 0)
+ tincY = incY;
+ else
+ tincY = -incY;
+ y++;
+
+ i = tincY << 1;
+ n = i * N ;
+ st = y + n;
+ do {
+ *y = -(*y);
+ y += i;
+ } while(y != st);
+ y -= n;
+ } else
+ x = (float *) X;
+
+
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_chemv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_chemv(F77_UL, &F77_N, ALPHA, A, &F77_lda, x, &F77_incX,
+ BETA, Y, &F77_incY);
+ }
+ else
+ {
+ cblas_xerbla(1, "cblas_chemv","Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if ( order == CblasRowMajor )
+ {
+ RowMajorStrg = 1;
+ if ( X != x )
+ free(x);
+ if (N > 0)
+ {
+ do
+ {
+ *y = -(*y);
+ y += i;
+ }
+ while (y != st);
+ }
+ }
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_cher.c b/contrib/libs/cblas/src/cblas_cher.c
new file mode 100644
index 0000000000..3332868ad7
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_cher.c
@@ -0,0 +1,116 @@
+/*
+ * cblas_cher.c
+ * The program is a C interface to cher.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_cher(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const void *X, const int incX
+ ,void *A, const int lda)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incx
+#endif
+ int n, i, tincx, incx=incX;
+ float *x=(float *)X, *xx=(float *)X, *tx, *st;
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_cher","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_cher(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_cher","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(float));
+ tx = x;
+ if( incX > 0 ) {
+ i = incX << 1 ;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ #else
+ incx = 1;
+ #endif
+ }
+ else x = (float *) X;
+ F77_cher(F77_UL, &F77_N, &alpha, x, &F77_incX, A, &F77_lda);
+ } else
+ {
+ cblas_xerbla(1, "cblas_cher","Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if(X!=x)
+ free(x);
+
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_cher2.c b/contrib/libs/cblas/src/cblas_cher2.c
new file mode 100644
index 0000000000..1bcdd3a6dd
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_cher2.c
@@ -0,0 +1,152 @@
+/*
+ * cblas_cher2.c
+ * The program is a C interface to cher2.
+ *
+ * Keita Teranishi 3/23/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_cher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *A, const int lda)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incx
+ #define F77_incY incy
+#endif
+ int n, i, j, tincx, tincy, incx=incX, incy=incY;
+ float *x=(float *)X, *xx=(float *)X, *y=(float *)Y,
+ *yy=(float *)Y, *tx, *ty, *stx, *sty;
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_cher2","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_cher2(F77_UL, &F77_N, alpha, X, &F77_incX,
+ Y, &F77_incY, A, &F77_lda);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_cher2","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(float));
+ y = malloc(n*sizeof(float));
+ tx = x;
+ ty = y;
+ if( incX > 0 ) {
+ i = incX << 1 ;
+ tincx = 2;
+ stx= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ stx = x-2;
+ x +=(n-2);
+ }
+
+ if( incY > 0 ) {
+ j = incY << 1;
+ tincy = 2;
+ sty= y+n;
+ } else {
+ j = incY *(-2);
+ tincy = -2;
+ sty = y-2;
+ y +=(n-2);
+ }
+
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != stx);
+
+ do
+ {
+ *y = *yy;
+ y[1] = -yy[1];
+ y += tincy ;
+ yy += j;
+ }
+ while (y != sty);
+
+ x=tx;
+ y=ty;
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ F77_incY = 1;
+ #else
+ incx = 1;
+ incy = 1;
+ #endif
+ } else
+ {
+ x = (float *) X;
+ y = (float *) Y;
+ }
+ F77_cher2(F77_UL, &F77_N, alpha, y, &F77_incY, x,
+ &F77_incX, A, &F77_lda);
+ } else
+ {
+ cblas_xerbla(1, "cblas_cher2","Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if(X!=x)
+ free(x);
+ if(Y!=y)
+ free(y);
+
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_cher2k.c b/contrib/libs/cblas/src/cblas_cher2k.c
new file mode 100644
index 0000000000..b4082ef235
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_cher2k.c
@@ -0,0 +1,111 @@
+/*
+ *
+ * cblas_cher2k.c
+ * This program is a C interface to cher2k.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_cher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const float beta,
+ void *C, const int ldc)
+{
+ char UL, TR;
+#ifdef F77_CHAR
+ F77_CHAR F77_TR, F77_UL;
+#else
+ #define F77_TR &TR
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ float ALPHA[2];
+ const float *alp=(float *)alpha;
+
+ CBLAS_CallFromC = 1;
+ RowMajorStrg = 0;
+
+ if( Order == CblasColMajor )
+ {
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_cher2k", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Trans == CblasTrans) TR ='T';
+ else if ( Trans == CblasConjTrans ) TR='C';
+ else if ( Trans == CblasNoTrans ) TR='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_cher2k", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_cher2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(2, "cblas_cher2k", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Trans == CblasTrans) TR ='N';
+ else if ( Trans == CblasConjTrans ) TR='N';
+ else if ( Trans == CblasNoTrans ) TR='C';
+ else
+ {
+ cblas_xerbla(3, "cblas_cher2k", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ ALPHA[0]= *alp;
+ ALPHA[1]= -alp[1];
+ F77_cher2k(F77_UL,F77_TR, &F77_N, &F77_K, ALPHA, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_cher2k", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_cherk.c b/contrib/libs/cblas/src/cblas_cherk.c
new file mode 100644
index 0000000000..fd0e09b43b
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_cherk.c
@@ -0,0 +1,105 @@
+/*
+ *
+ * cblas_cherk.c
+ * This program is a C interface to cherk.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_cherk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const float alpha, const void *A, const int lda,
+ const float beta, void *C, const int ldc)
+{
+ char UL, TR;
+#ifdef F77_CHAR
+ F77_CHAR F77_TR, F77_UL;
+#else
+ #define F77_TR &TR
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_cherk", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Trans == CblasTrans) TR ='T';
+ else if ( Trans == CblasConjTrans ) TR='C';
+ else if ( Trans == CblasNoTrans ) TR='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_cherk", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_cherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
+ &beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_cherk", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Trans == CblasTrans) TR ='N';
+ else if ( Trans == CblasConjTrans ) TR='N';
+ else if ( Trans == CblasNoTrans ) TR='C';
+ else
+ {
+ cblas_xerbla(3, "cblas_cherk", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_cherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
+ &beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_cherk", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_chpmv.c b/contrib/libs/cblas/src/cblas_chpmv.c
new file mode 100644
index 0000000000..c805756ebd
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_chpmv.c
@@ -0,0 +1,160 @@
+/*
+ * cblas_chpmv.c
+ * The program is a C interface of chpmv
+ *
+ * Keita Teranishi 5/18/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_chpmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_UPLO Uplo,const int N,
+ const void *alpha, const void *AP,
+ const void *X, const int incX, const void *beta,
+ void *Y, const int incY)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incx
+ #define F77_incY incY
+#endif
+ int n, i=0, incx=incX;
+ const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
+ float ALPHA[2],BETA[2];
+ int tincY, tincx;
+ float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_chpmv","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_chpmv(F77_UL, &F77_N, alpha, AP, X,
+ &F77_incX, beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ ALPHA[0]= *alp;
+ ALPHA[1]= -alp[1];
+ BETA[0]= *bet;
+ BETA[1]= -bet[1];
+
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(float));
+
+ tx = x;
+ if( incX > 0 ) {
+ i = incX << 1;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ #else
+ incx = 1;
+ #endif
+
+ if(incY > 0)
+ tincY = incY;
+ else
+ tincY = -incY;
+ y++;
+
+ i = tincY << 1;
+ n = i * N ;
+ st = y + n;
+ do {
+ *y = -(*y);
+ y += i;
+ } while(y != st);
+ y -= n;
+ } else
+ x = (float *) X;
+
+
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_chpmv","Illegal Uplo setting, %d\n", Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_chpmv(F77_UL, &F77_N, ALPHA,
+ AP, x, &F77_incX, BETA, Y, &F77_incY);
+ }
+ else
+ {
+ cblas_xerbla(1, "cblas_chpmv","Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if ( order == CblasRowMajor )
+ {
+ RowMajorStrg = 1;
+ if(X!=x)
+ free(x);
+ if (N > 0)
+ {
+ do
+ {
+ *y = -(*y);
+ y += i;
+ }
+ while (y != st);
+ }
+ }
+
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_chpr.c b/contrib/libs/cblas/src/cblas_chpr.c
new file mode 100644
index 0000000000..9b39f38bdf
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_chpr.c
@@ -0,0 +1,115 @@
+/*
+ * cblas_chpr.c
+ * The program is a C interface to chpr.
+ *
+ * Keita Teranishi 3/23/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_chpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const void *X,
+ const int incX, void *A)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incx
+#endif
+ int n, i, tincx, incx=incX;
+ float *x=(float *)X, *xx=(float *)X, *tx, *st;
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_chpr","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_chpr(F77_UL, &F77_N, &alpha, X, &F77_incX, A);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_chpr","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(float));
+ tx = x;
+ if( incX > 0 ) {
+ i = incX << 1;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+ #ifdef F77_INT
+ F77_incX = 1;
+ #else
+ incx = 1;
+ #endif
+ }
+ else x = (float *) X;
+
+ F77_chpr(F77_UL, &F77_N, &alpha, x, &F77_incX, A);
+
+ } else
+ {
+ cblas_xerbla(1, "cblas_chpr","Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if(X!=x)
+ free(x);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_chpr2.c b/contrib/libs/cblas/src/cblas_chpr2.c
new file mode 100644
index 0000000000..e43077db6a
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_chpr2.c
@@ -0,0 +1,149 @@
+/*
+ * cblas_chpr2.c
+ * The program is a C interface to chpr2.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_chpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N,const void *alpha, const void *X,
+ const int incX,const void *Y, const int incY, void *Ap)
+
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incx
+ #define F77_incY incy
+#endif
+ int n, i, j, tincx, tincy, incx=incX, incy=incY;
+ float *x=(float *)X, *xx=(float *)X, *y=(float *)Y,
+ *yy=(float *)Y, *tx, *ty, *stx, *sty;
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_chpr2","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_chpr2(F77_UL, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, Ap);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_chpr2","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(float));
+ y = malloc(n*sizeof(float));
+ tx = x;
+ ty = y;
+ if( incX > 0 ) {
+ i = incX << 1 ;
+ tincx = 2;
+ stx= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ stx = x-2;
+ x +=(n-2);
+ }
+
+ if( incY > 0 ) {
+ j = incY << 1;
+ tincy = 2;
+ sty= y+n;
+ } else {
+ j = incY *(-2);
+ tincy = -2;
+ sty = y-2;
+ y +=(n-2);
+ }
+
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != stx);
+ do
+ {
+ *y = *yy;
+ y[1] = -yy[1];
+ y += tincy ;
+ yy += j;
+ }
+ while (y != sty);
+
+ x=tx;
+ y=ty;
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ F77_incY = 1;
+ #else
+ incx = 1;
+ incy = 1;
+ #endif
+
+ } else
+ {
+ x = (float *) X;
+ y = (void *) Y;
+ }
+ F77_chpr2(F77_UL, &F77_N, alpha, y, &F77_incY, x, &F77_incX, Ap);
+ } else
+ {
+ cblas_xerbla(1, "cblas_chpr2","Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if(X!=x)
+ free(x);
+ if(Y!=y)
+ free(y);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_cscal.c b/contrib/libs/cblas/src/cblas_cscal.c
new file mode 100644
index 0000000000..a23e6ee577
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_cscal.c
@@ -0,0 +1,21 @@
+/*
+ * cblas_cscal.c
+ *
+ * The program is a C interface to cscal.f.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_cscal( const int N, const void *alpha, void *X,
+ const int incX)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_cscal( &F77_N, alpha, X, &F77_incX);
+}
diff --git a/contrib/libs/cblas/src/cblas_csscal.c b/contrib/libs/cblas/src/cblas_csscal.c
new file mode 100644
index 0000000000..39983fe071
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_csscal.c
@@ -0,0 +1,21 @@
+/*
+ * cblas_csscal.c
+ *
+ * The program is a C interface to csscal.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_csscal( const int N, const float alpha, void *X,
+ const int incX)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_csscal( &F77_N, &alpha, X, &F77_incX);
+}
diff --git a/contrib/libs/cblas/src/cblas_cswap.c b/contrib/libs/cblas/src/cblas_cswap.c
new file mode 100644
index 0000000000..1272820727
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_cswap.c
@@ -0,0 +1,22 @@
+/*
+ * cblas_cswap.c
+ *
+ * The program is a C interface to cswap.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_cswap( const int N, void *X, const int incX, void *Y,
+ const int incY)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_cswap( &F77_N, X, &F77_incX, Y, &F77_incY);
+}
diff --git a/contrib/libs/cblas/src/cblas_csymm.c b/contrib/libs/cblas/src/cblas_csymm.c
new file mode 100644
index 0000000000..4db34e346d
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_csymm.c
@@ -0,0 +1,106 @@
+/*
+ *
+ * cblas_csymm.c
+ * This program is a C interface to csymm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_csymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const void *beta,
+ void *C, const int ldc)
+{
+ char SD, UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_SD, F77_UL;
+#else
+ #define F77_SD &SD
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if( Side == CblasRight) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_csymm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_csymm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_csymm(F77_SD, F77_UL, &F77_M, &F77_N, alpha, A, &F77_lda,
+ B, &F77_ldb, beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Side == CblasRight) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_csymm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_csymm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_csymm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A, &F77_lda,
+ B, &F77_ldb, beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_csymm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_csyr2k.c b/contrib/libs/cblas/src/cblas_csyr2k.c
new file mode 100644
index 0000000000..5ca3f34cda
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_csyr2k.c
@@ -0,0 +1,108 @@
+/*
+ *
+ * cblas_csyr2k.c
+ * This program is a C interface to csyr2k.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_csyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, 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 UL, TR;
+#ifdef F77_CHAR
+ F77_CHAR F77_TR, F77_UL;
+#else
+ #define F77_TR &TR
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_csyr2k", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Trans == CblasTrans) TR ='T';
+ else if ( Trans == CblasConjTrans ) TR='C';
+ else if ( Trans == CblasNoTrans ) TR='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_csyr2k", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_csyr2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
+ B, &F77_ldb, beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_csyr2k", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Trans == CblasTrans) TR ='N';
+ else if ( Trans == CblasConjTrans ) TR='N';
+ else if ( Trans == CblasNoTrans ) TR='T';
+ else
+ {
+ cblas_xerbla(3, "cblas_csyr2k", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_csyr2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_csyr2k", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_csyrk.c b/contrib/libs/cblas/src/cblas_csyrk.c
new file mode 100644
index 0000000000..3f0bb07eac
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_csyrk.c
@@ -0,0 +1,108 @@
+/*
+ *
+ * cblas_csyrk.c
+ * This program is a C interface to csyrk.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_csyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const void *alpha, const void *A, const int lda,
+ const void *beta, void *C, const int ldc)
+{
+ char UL, TR;
+#ifdef F77_CHAR
+ F77_CHAR F77_TR, F77_UL;
+#else
+ #define F77_TR &TR
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_csyrk", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Trans == CblasTrans) TR ='T';
+ else if ( Trans == CblasConjTrans ) TR='C';
+ else if ( Trans == CblasNoTrans ) TR='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_csyrk", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_csyrk(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
+ beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_csyrk", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Trans == CblasTrans) TR ='N';
+ else if ( Trans == CblasConjTrans ) TR='N';
+ else if ( Trans == CblasNoTrans ) TR='T';
+ else
+ {
+ cblas_xerbla(3, "cblas_csyrk", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_csyrk(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
+ beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_csyrk", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
+
diff --git a/contrib/libs/cblas/src/cblas_ctbmv.c b/contrib/libs/cblas/src/cblas_ctbmv.c
new file mode 100644
index 0000000000..7845cc8284
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ctbmv.c
@@ -0,0 +1,158 @@
+/*
+ * cblas_ctbmv.c
+ * The program is a C interface to ctbmv.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ctbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const void *A, const int lda,
+ void *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ int n, i=0, tincX;
+ float *st=0, *x=(float *)X;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_ctbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctbmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ctbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ TA = 'N';
+ if ( N > 0)
+ {
+ if(incX > 0)
+ tincX = incX;
+ else
+ tincX = -incX;
+ i = tincX << 1;
+ n = i * N;
+ x++;
+ st = x + n;
+ do
+ {
+ *x = -(*x);
+ x+= i;
+ }
+ while (x != st);
+ x -= n;
+ }
+ }
+ else
+ {
+ cblas_xerbla(3, "cblas_ctbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ctbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+
+ if (TransA == CblasConjTrans)
+ {
+ if (N > 0)
+ {
+ do
+ {
+ *x = -(*x);
+ x += i;
+ }
+ while (x != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_ctbmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ctbsv.c b/contrib/libs/cblas/src/cblas_ctbsv.c
new file mode 100644
index 0000000000..ab4646b546
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ctbsv.c
@@ -0,0 +1,162 @@
+/*
+ * cblas_ctbsv.c
+ * The program is a C interface to ctbsv.
+ *
+ * Keita Teranishi 3/23/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ctbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const void *A, const int lda,
+ void *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ int n, i=0, tincX;
+ float *st=0,*x=(float *)X;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctbsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_ctbsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctbsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ctbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctbsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ TA = 'N';
+ if ( N > 0)
+ {
+ if ( incX > 0 )
+ tincX = incX;
+ else
+ tincX = -incX;
+
+ n = N*2*(tincX);
+
+ x++;
+
+ st=x+n;
+
+ i = tincX << 1;
+ do
+ {
+ *x = -(*x);
+ x+=i;
+ }
+ while (x != st);
+ x -= n;
+ }
+ }
+ else
+ {
+ cblas_xerbla(3, "cblas_ctbsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctbsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ctbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+
+ if (TransA == CblasConjTrans)
+ {
+ if (N > 0)
+ {
+ do
+ {
+ *x = -(*x);
+ x+= i;
+ }
+ while (x != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_ctbsv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ctpmv.c b/contrib/libs/cblas/src/cblas_ctpmv.c
new file mode 100644
index 0000000000..7a4d63af22
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ctpmv.c
@@ -0,0 +1,152 @@
+/*
+ * cblas_ctpmv.c
+ * The program is a C interface to ctpmv.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ctpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *Ap, void *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ int n, i=0, tincX;
+ float *st=0,*x=(float *)X;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctpmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_ctpmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctpmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ctpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctpmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ TA = 'N';
+ if ( N > 0)
+ {
+ if(incX > 0)
+ tincX = incX;
+ else
+ tincX = -incX;
+ i = tincX << 1;
+ n = i * N;
+ x++;
+ st = x + n;
+ do
+ {
+ *x = -(*x);
+ x += i;
+ }
+ while (x != st);
+ x -= n;
+ }
+ }
+ else
+ {
+ cblas_xerbla(3, "cblas_ctpmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctpmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ctpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
+ if (TransA == CblasConjTrans)
+ {
+ if (N > 0)
+ {
+ do
+ {
+ *x = -(*x);
+ x += i;
+ }
+ while (x != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_ctpmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ctpsv.c b/contrib/libs/cblas/src/cblas_ctpsv.c
new file mode 100644
index 0000000000..d39687cbf9
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ctpsv.c
@@ -0,0 +1,157 @@
+/*
+ * cblas_ctpsv.c
+ * The program is a C interface to ctpsv.
+ *
+ * Keita Teranishi 3/23/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ctpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *Ap, void *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ int n, i=0, tincX;
+ float *st=0, *x=(float*)X;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctpsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_ctpsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctpsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ctpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctpsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ TA = 'N';
+ if ( N > 0)
+ {
+ if ( incX > 0 )
+ tincX = incX;
+ else
+ tincX = -incX;
+
+ n = N*2*(tincX);
+
+ x++;
+
+ st=x+n;
+
+ i = tincX << 1;
+ do
+ {
+ *x = -(*x);
+ x+=i;
+ }
+ while (x != st);
+ x -= n;
+ }
+ }
+ else
+ {
+ cblas_xerbla(3, "cblas_ctpsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctpsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ctpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
+
+ if (TransA == CblasConjTrans)
+ {
+ if (N > 0)
+ {
+ do
+ {
+ *x = -(*x);
+ x += i;
+ }
+ while (x != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_ctpsv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ctrmm.c b/contrib/libs/cblas/src/cblas_ctrmm.c
new file mode 100644
index 0000000000..d70bfd308a
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ctrmm.c
@@ -0,0 +1,144 @@
+/*
+ *
+ * cblas_ctrmm.c
+ * This program is a C interface to ctrmm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ctrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ void *B, const int ldb)
+{
+ char UL, TA, SD, DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_SD &SD
+ #define F77_DI &DI
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if( Side == CblasRight ) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctrmm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Uplo == CblasUpper ) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_ctrmm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( TransA == CblasTrans ) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctrmm", "Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else cblas_xerbla(5, "cblas_ctrmm",
+ "Illegal Diag setting, %d\n", Diag);
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ctrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, alpha, A, &F77_lda, B, &F77_ldb);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Side == CblasRight ) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctrmm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper ) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_ctrmm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( TransA == CblasTrans ) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctrmm", "Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_ctrmm", "Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ctrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A, &F77_lda, B, &F77_ldb);
+ }
+ else cblas_xerbla(1, "cblas_ctrmm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ctrmv.c b/contrib/libs/cblas/src/cblas_ctrmv.c
new file mode 100644
index 0000000000..3d284388ce
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ctrmv.c
@@ -0,0 +1,155 @@
+/*
+ * cblas_ctrmv.c
+ * The program is a C interface to ctrmv.
+ *
+ * Keita Teranishi 3/23/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ctrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *A, const int lda,
+ void *X, const int incX)
+
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ int n, i=0, tincX;
+ float *st=0,*x=(float *)X;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctrmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_ctrmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctrmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ctrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctrmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ TA = 'N';
+ if ( N > 0)
+ {
+ if(incX > 0)
+ tincX = incX;
+ else
+ tincX = -incX;
+ i = tincX << 1;
+ n = i * N;
+ st = x + n;
+ do
+ {
+ x[1] = -x[1];
+ x+= i;
+ }
+ while (x != st);
+ x -= n;
+ }
+ }
+ else
+ {
+ cblas_xerbla(3, "cblas_ctrmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctrmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ctrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ if (TransA == CblasConjTrans)
+ {
+ if (N > 0)
+ {
+ do
+ {
+ x[1] = -x[1];
+ x += i;
+ }
+ while (x != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_ctrmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ctrsm.c b/contrib/libs/cblas/src/cblas_ctrsm.c
new file mode 100644
index 0000000000..00c592d56a
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ctrsm.c
@@ -0,0 +1,155 @@
+/*
+ *
+ * cblas_ctrsm.c
+ * This program is a C interface to ctrsm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ctrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ void *B, const int ldb)
+{
+ char UL, TA, SD, DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_SD &SD
+ #define F77_DI &DI
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+
+ if( Side == CblasRight) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctrsm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_ctrsm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( TransA == CblasTrans) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctrsm", "Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_ctrsm", "Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ctrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, alpha, A,
+ &F77_lda, B, &F77_ldb);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+
+ if( Side == CblasRight) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctrsm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_ctrsm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( TransA == CblasTrans) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctrsm", "Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_ctrsm", "Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+
+ F77_ctrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A,
+ &F77_lda, B, &F77_ldb);
+ }
+ else cblas_xerbla(1, "cblas_ctrsm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ctrsv.c b/contrib/libs/cblas/src/cblas_ctrsv.c
new file mode 100644
index 0000000000..39ff644cbd
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ctrsv.c
@@ -0,0 +1,156 @@
+/*
+ * cblas_ctrsv.c
+ * The program is a C interface to ctrsv.
+ *
+ * Keita Teranishi 3/23/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ctrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *A, const int lda, void *X,
+ const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ int n, i=0, tincX;
+ float *st=0,*x=(float *)X;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctrsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_ctrsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctrsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ctrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ctrsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ TA = 'N';
+ if ( N > 0)
+ {
+ if ( incX > 0 )
+ tincX = incX;
+ else
+ tincX = -incX;
+
+ n = N*2*(tincX);
+ x++;
+ st=x+n;
+ i = tincX << 1;
+ do
+ {
+ *x = -(*x);
+ x+=i;
+ }
+ while (x != st);
+ x -= n;
+ }
+ }
+ else
+ {
+ cblas_xerbla(3, "cblas_ctrsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ctrsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ctrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ if (TransA == CblasConjTrans)
+ {
+ if (N > 0)
+ {
+ do
+ {
+ *x = -(*x);
+ x += i;
+ }
+ while (x != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_ctrsv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dasum.c b/contrib/libs/cblas/src/cblas_dasum.c
new file mode 100644
index 0000000000..1a3667f2d7
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dasum.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_dasum.c
+ *
+ * The program is a C interface to dasum.
+ * It calls the fortran wrapper before calling dasum.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+double cblas_dasum( const int N, const double *X, const int incX)
+{
+ double asum;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_dasum_sub( &F77_N, X, &F77_incX, &asum);
+ return asum;
+}
diff --git a/contrib/libs/cblas/src/cblas_daxpy.c b/contrib/libs/cblas/src/cblas_daxpy.c
new file mode 100644
index 0000000000..3678137fb7
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_daxpy.c
@@ -0,0 +1,22 @@
+/*
+ * cblas_daxpy.c
+ *
+ * The program is a C interface to daxpy.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_daxpy( const int N, const double alpha, const double *X,
+ const int incX, double *Y, const int incY)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_daxpy( &F77_N, &alpha, X, &F77_incX, Y, &F77_incY);
+}
diff --git a/contrib/libs/cblas/src/cblas_dcopy.c b/contrib/libs/cblas/src/cblas_dcopy.c
new file mode 100644
index 0000000000..422a55e517
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dcopy.c
@@ -0,0 +1,22 @@
+/*
+ * cblas_dcopy.c
+ *
+ * The program is a C interface to dcopy.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dcopy( const int N, const double *X,
+ const int incX, double *Y, const int incY)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_dcopy( &F77_N, X, &F77_incX, Y, &F77_incY);
+}
diff --git a/contrib/libs/cblas/src/cblas_ddot.c b/contrib/libs/cblas/src/cblas_ddot.c
new file mode 100644
index 0000000000..d773434031
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ddot.c
@@ -0,0 +1,25 @@
+/*
+ * cblas_ddot.c
+ *
+ * The program is a C interface to ddot.
+ * It calls the fortran wrapper before calling ddot.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+double cblas_ddot( const int N, const double *X,
+ const int incX, const double *Y, const int incY)
+{
+ double dot;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_ddot_sub( &F77_N, X, &F77_incX, Y, &F77_incY, &dot);
+ return dot;
+}
diff --git a/contrib/libs/cblas/src/cblas_dgbmv.c b/contrib/libs/cblas/src/cblas_dgbmv.c
new file mode 100644
index 0000000000..33c481db11
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dgbmv.c
@@ -0,0 +1,81 @@
+/*
+ *
+ * cblas_dgbmv.c
+ * This program is a C interface to dgbmv.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dgbmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const int KL, const int KU,
+ const double alpha, const double *A, const int lda,
+ const double *X, const int incX, const double beta,
+ double *Y, const int incY)
+{
+ char TA;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA;
+#else
+ #define F77_TA &TA
+#endif
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+ F77_INT F77_KL=KL,F77_KU=KU;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_KL KL
+ #define F77_KU KU
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(2, "cblas_dgbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ F77_dgbmv(F77_TA, &F77_M, &F77_N, &F77_KL, &F77_KU, &alpha,
+ A, &F77_lda, X, &F77_incX, &beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(2, "cblas_dgbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ F77_dgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, &alpha,
+ A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY);
+ }
+ else cblas_xerbla(1, "cblas_dgbmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+}
diff --git a/contrib/libs/cblas/src/cblas_dgemm.c b/contrib/libs/cblas/src/cblas_dgemm.c
new file mode 100644
index 0000000000..d02ac16b32
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dgemm.c
@@ -0,0 +1,109 @@
+/*
+ *
+ * cblas_dgemm.c
+ * This program is a C interface to dgemm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
+ const enum 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;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_TB;
+#else
+ #define F77_TA &TA
+ #define F77_TB &TB
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if(TransA == CblasTrans) TA='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if(TransB == CblasTrans) TB='T';
+ else if ( TransB == CblasConjTrans ) TB='C';
+ else if ( TransB == CblasNoTrans ) TB='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ F77_TB = C2F_CHAR(&TB);
+ #endif
+
+ F77_dgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, &alpha, A,
+ &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if(TransA == CblasTrans) TB='T';
+ else if ( TransA == CblasConjTrans ) TB='C';
+ else if ( TransA == CblasNoTrans ) TB='N';
+ else
+ {
+ cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if(TransB == CblasTrans) TA='T';
+ else if ( TransB == CblasConjTrans ) TA='C';
+ else if ( TransB == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(2, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ F77_TB = C2F_CHAR(&TB);
+ #endif
+
+ F77_dgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, &alpha, B,
+ &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_dgemm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dgemv.c b/contrib/libs/cblas/src/cblas_dgemv.c
new file mode 100644
index 0000000000..9062f3eed4
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dgemv.c
@@ -0,0 +1,78 @@
+/*
+ *
+ * cblas_dgemv.c
+ * This program is a C interface to dgemv.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dgemv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const double alpha, const double *A, const int lda,
+ const double *X, const int incX, const double beta,
+ double *Y, const int incY)
+{
+ char TA;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA;
+#else
+ #define F77_TA &TA
+#endif
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(2, "cblas_dgemv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ F77_dgemv(F77_TA, &F77_M, &F77_N, &alpha, A, &F77_lda, X, &F77_incX,
+ &beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(2, "cblas_dgemv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ F77_dgemv(F77_TA, &F77_N, &F77_M, &alpha, A, &F77_lda, X,
+ &F77_incX, &beta, Y, &F77_incY);
+ }
+ else cblas_xerbla(1, "cblas_dgemv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dger.c b/contrib/libs/cblas/src/cblas_dger.c
new file mode 100644
index 0000000000..b2b805b4f7
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dger.c
@@ -0,0 +1,47 @@
+/*
+ *
+ * cblas_dger.c
+ * This program is a C interface to dger.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dger(const enum CBLAS_ORDER order, const int M, const int N,
+ const double alpha, const double *X, const int incX,
+ const double *Y, const int incY, double *A, const int lda)
+{
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+ #define F77_lda lda
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ F77_dger( &F77_M, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
+ &F77_lda);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ F77_dger( &F77_N, &F77_M ,&alpha, Y, &F77_incY, X, &F77_incX, A,
+ &F77_lda);
+
+ }
+ else cblas_xerbla(1, "cblas_dger", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dnrm2.c b/contrib/libs/cblas/src/cblas_dnrm2.c
new file mode 100644
index 0000000000..fe46ad4849
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dnrm2.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_dnrm2.c
+ *
+ * The program is a C interface to dnrm2.
+ * It calls the fortranwrapper before calling dnrm2.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+double cblas_dnrm2( const int N, const double *X, const int incX)
+{
+ double nrm2;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_dnrm2_sub( &F77_N, X, &F77_incX, &nrm2);
+ return nrm2;
+}
diff --git a/contrib/libs/cblas/src/cblas_drot.c b/contrib/libs/cblas/src/cblas_drot.c
new file mode 100644
index 0000000000..51dc4ad5ef
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_drot.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_drot.c
+ *
+ * The program is a C interface to drot.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_drot(const int N, double *X, const int incX,
+ double *Y, const int incY, const double c, const double s)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_drot(&F77_N, X, &F77_incX, Y, &F77_incY, &c, &s);
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_drotg.c b/contrib/libs/cblas/src/cblas_drotg.c
new file mode 100644
index 0000000000..0cbbd8bc0b
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_drotg.c
@@ -0,0 +1,14 @@
+/*
+ * cblas_drotg.c
+ *
+ * The program is a C interface to drotg.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_drotg( double *a, double *b, double *c, double *s)
+{
+ F77_drotg(a,b,c,s);
+}
diff --git a/contrib/libs/cblas/src/cblas_drotm.c b/contrib/libs/cblas/src/cblas_drotm.c
new file mode 100644
index 0000000000..ebe20ad627
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_drotm.c
@@ -0,0 +1,14 @@
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_drotm( const int N, double *X, const int incX, double *Y,
+ const int incY, const double *P)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_drotm( &F77_N, X, &F77_incX, Y, &F77_incY, P);
+}
diff --git a/contrib/libs/cblas/src/cblas_drotmg.c b/contrib/libs/cblas/src/cblas_drotmg.c
new file mode 100644
index 0000000000..13a2208e5f
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_drotmg.c
@@ -0,0 +1,15 @@
+/*
+ * cblas_drotmg.c
+ *
+ * The program is a C interface to drotmg.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_drotmg( double *d1, double *d2, double *b1,
+ const double b2, double *p)
+{
+ F77_drotmg(d1,d2,b1,&b2,p);
+}
diff --git a/contrib/libs/cblas/src/cblas_dsbmv.c b/contrib/libs/cblas/src/cblas_dsbmv.c
new file mode 100644
index 0000000000..95b61820fc
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dsbmv.c
@@ -0,0 +1,77 @@
+/*
+ *
+ * cblas_dsbmv.c
+ * This program is a C interface to dsbmv.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dsbmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_UPLO Uplo, const int N, const int K,
+ const double alpha, const double *A, const int lda,
+ const double *X, const int incX, const double beta,
+ double *Y, const int incY)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dsbmv","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_dsbmv(F77_UL, &F77_N, &F77_K, &alpha, A, &F77_lda, X,
+ &F77_incX, &beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_dsbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_dsbmv(F77_UL, &F77_N, &F77_K, &alpha,
+ A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY);
+ }
+ else cblas_xerbla(1, "cblas_dsbmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dscal.c b/contrib/libs/cblas/src/cblas_dscal.c
new file mode 100644
index 0000000000..bd04de77d6
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dscal.c
@@ -0,0 +1,21 @@
+/*
+ * cblas_dscal.c
+ *
+ * The program is a C interface to dscal.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dscal( const int N, const double alpha, double *X,
+ const int incX)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_dscal( &F77_N, &alpha, X, &F77_incX);
+}
diff --git a/contrib/libs/cblas/src/cblas_dsdot.c b/contrib/libs/cblas/src/cblas_dsdot.c
new file mode 100644
index 0000000000..52cd877a20
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dsdot.c
@@ -0,0 +1,25 @@
+/*
+ * cblas_dsdot.c
+ *
+ * The program is a C interface to dsdot.
+ * It calls fthe fortran wrapper before calling dsdot.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+double cblas_dsdot( const int N, const float *X,
+ const int incX, const float *Y, const int incY)
+{
+ double dot;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_dsdot_sub( &F77_N, X, &F77_incX, Y, &F77_incY, &dot);
+ return dot;
+}
diff --git a/contrib/libs/cblas/src/cblas_dspmv.c b/contrib/libs/cblas/src/cblas_dspmv.c
new file mode 100644
index 0000000000..dd1544f9cf
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dspmv.c
@@ -0,0 +1,76 @@
+/*
+ *
+ * cblas_dspmv.c
+ * This program is a C interface to dspmv.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dspmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_UPLO Uplo, const int N,
+ const double alpha, const double *AP,
+ const double *X, const int incX, const double beta,
+ double *Y, const int incY)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dspmv","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_dspmv(F77_UL, &F77_N, &alpha, AP, X,
+ &F77_incX, &beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_dspmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_dspmv(F77_UL, &F77_N, &alpha,
+ AP, X,&F77_incX, &beta, Y, &F77_incY);
+ }
+ else cblas_xerbla(1, "cblas_dspmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dspr.c b/contrib/libs/cblas/src/cblas_dspr.c
new file mode 100644
index 0000000000..c6300391cb
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dspr.c
@@ -0,0 +1,70 @@
+/*
+ *
+ * cblas_dspr.c
+ * This program is a C interface to dspr.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const double *X,
+ const int incX, double *Ap)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_dspr","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_dspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasLower) UL = 'U';
+ else if (Uplo == CblasUpper) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dspr","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_dspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap);
+ } else cblas_xerbla(1, "cblas_dspr", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dspr2.c b/contrib/libs/cblas/src/cblas_dspr2.c
new file mode 100644
index 0000000000..4f1e7805a0
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dspr2.c
@@ -0,0 +1,70 @@
+/*
+ * cblas_dspr2.c
+ * The program is a C interface to dspr2.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const double *X,
+ const int incX, const double *Y, const int incY, double *A)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_dspr2","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_dspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasLower) UL = 'U';
+ else if (Uplo == CblasUpper) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dspr2","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_dspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A);
+ } else cblas_xerbla(1, "cblas_dspr2", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dswap.c b/contrib/libs/cblas/src/cblas_dswap.c
new file mode 100644
index 0000000000..9ae5bb93c0
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dswap.c
@@ -0,0 +1,22 @@
+/*
+ * cblas_dswap.c
+ *
+ * The program is a C interface to dswap.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dswap( const int N, double *X, const int incX, double *Y,
+ const int incY)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_dswap( &F77_N, X, &F77_incX, Y, &F77_incY);
+}
diff --git a/contrib/libs/cblas/src/cblas_dsymm.c b/contrib/libs/cblas/src/cblas_dsymm.c
new file mode 100644
index 0000000000..8b50e9a40b
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dsymm.c
@@ -0,0 +1,106 @@
+/*
+ *
+ * cblas_dsymm.c
+ * This program is a C interface to dsymm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dsymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const int M, const int N,
+ const double alpha, const double *A, const int lda,
+ const double *B, const int ldb, const double beta,
+ double *C, const int ldc)
+{
+ char SD, UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_SD, F77_UL;
+#else
+ #define F77_SD &SD
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if( Side == CblasRight) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dsymm","Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_dsymm","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_dsymm(F77_SD, F77_UL, &F77_M, &F77_N, &alpha, A, &F77_lda,
+ B, &F77_ldb, &beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Side == CblasRight) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_dsymm","Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_dsymm","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_dsymm(F77_SD, F77_UL, &F77_N, &F77_M, &alpha, A, &F77_lda, B,
+ &F77_ldb, &beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_dsymm","Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dsymv.c b/contrib/libs/cblas/src/cblas_dsymv.c
new file mode 100644
index 0000000000..020adc91d3
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dsymv.c
@@ -0,0 +1,76 @@
+/*
+ *
+ * cblas_dsymv.c
+ * This program is a C interface to dsymv.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dsymv(const enum CBLAS_ORDER order,
+ const enum CBLAS_UPLO Uplo, const int N,
+ const double alpha, const double *A, const int lda,
+ const double *X, const int incX, const double beta,
+ double *Y, const int incY)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dsymv","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_dsymv(F77_UL, &F77_N, &alpha, A, &F77_lda, X,
+ &F77_incX, &beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_dsymv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_dsymv(F77_UL, &F77_N, &alpha,
+ A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY);
+ }
+ else cblas_xerbla(1, "cblas_dsymv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dsyr.c b/contrib/libs/cblas/src/cblas_dsyr.c
new file mode 100644
index 0000000000..0d20083481
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dsyr.c
@@ -0,0 +1,71 @@
+/*
+ *
+ * cblas_dsyr.c
+ * This program is a C interface to dsyr.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dsyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const double *X,
+ const int incX, double *A, const int lda)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_lda=lda;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_lda lda
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_dsyr","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_dsyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasLower) UL = 'U';
+ else if (Uplo == CblasUpper) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dsyr","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_dsyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
+ } else cblas_xerbla(1, "cblas_dsyr", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dsyr2.c b/contrib/libs/cblas/src/cblas_dsyr2.c
new file mode 100644
index 0000000000..fe4a2920ed
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dsyr2.c
@@ -0,0 +1,76 @@
+/*
+ *
+ * cblas_dsyr2.c
+ * This program is a C interface to dsyr2.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dsyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const double *X,
+ const int incX, const double *Y, const int incY, double *A,
+ const int lda)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY, F77__lda=lda;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+ #define F77_lda lda
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_dsyr2","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_dsyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
+ &F77_lda);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasLower) UL = 'U';
+ else if (Uplo == CblasUpper) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dsyr2","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_dsyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
+ &F77_lda);
+ } else cblas_xerbla(1, "cblas_dsyr2", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dsyr2k.c b/contrib/libs/cblas/src/cblas_dsyr2k.c
new file mode 100644
index 0000000000..e50dc11cc9
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dsyr2k.c
@@ -0,0 +1,109 @@
+/*
+ *
+ * cblas_dsyr2k.c
+ * This program is a C interface to dsyr2k.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, 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 UL, TR;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL;
+#else
+ #define F77_TR &TR
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dsyr2k","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Trans == CblasTrans) TR ='T';
+ else if ( Trans == CblasConjTrans ) TR='C';
+ else if ( Trans == CblasNoTrans ) TR='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_dsyr2k","Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_dsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
+ B, &F77_ldb, &beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_dsyr2k","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Trans == CblasTrans) TR ='N';
+ else if ( Trans == CblasConjTrans ) TR='N';
+ else if ( Trans == CblasNoTrans ) TR='T';
+ else
+ {
+ cblas_xerbla(3, "cblas_dsyr2k","Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_dsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, B,
+ &F77_ldb, &beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_dsyr2k","Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dsyrk.c b/contrib/libs/cblas/src/cblas_dsyrk.c
new file mode 100644
index 0000000000..469f930df3
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dsyrk.c
@@ -0,0 +1,108 @@
+/*
+ *
+ * cblas_dsyrk.c
+ * This program is a C interface to dsyrk.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dsyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const double alpha, const double *A, const int lda,
+ const double beta, double *C, const int ldc)
+{
+ char UL, TR;
+#ifdef F77_CHAR
+ F77_CHAR F77_TR, F77_UL;
+#else
+ #define F77_TR &TR
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dsyrk","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Trans == CblasTrans) TR ='T';
+ else if ( Trans == CblasConjTrans ) TR='C';
+ else if ( Trans == CblasNoTrans ) TR='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_dsyrk","Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_dsyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
+ &beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_dsyrk","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Trans == CblasTrans) TR ='N';
+ else if ( Trans == CblasConjTrans ) TR='N';
+ else if ( Trans == CblasNoTrans ) TR='T';
+ else
+ {
+ cblas_xerbla(3, "cblas_dsyrk","Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_dsyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
+ &beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_dsyrk","Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
+
diff --git a/contrib/libs/cblas/src/cblas_dtbmv.c b/contrib/libs/cblas/src/cblas_dtbmv.c
new file mode 100644
index 0000000000..491f11d475
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dtbmv.c
@@ -0,0 +1,122 @@
+/*
+ * cblas_dtbmv.c
+ * The program is a C interface to dtbmv.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dtbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const double *A, const int lda,
+ double *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtbmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_dtbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_dtbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+
+ }
+ else cblas_xerbla(1, "cblas_dtbmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+}
diff --git a/contrib/libs/cblas/src/cblas_dtbsv.c b/contrib/libs/cblas/src/cblas_dtbsv.c
new file mode 100644
index 0000000000..664822fea4
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dtbsv.c
@@ -0,0 +1,122 @@
+/*
+ * cblas_dtbsv.c
+ * The program is a C interface to dtbsv.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dtbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const double *A, const int lda,
+ double *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtbsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtbsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtbsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_dtbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtbsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtbsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtbsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_dtbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else cblas_xerbla(1, "cblas_dtbsv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dtpmv.c b/contrib/libs/cblas/src/cblas_dtpmv.c
new file mode 100644
index 0000000000..5b96a2b495
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dtpmv.c
@@ -0,0 +1,117 @@
+/*
+ * cblas_dtpmv.c
+ * The program is a C interface to dtpmv.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dtpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const double *Ap, double *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtpmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtpmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtpmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_dtpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtpmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtpmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtpmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_dtpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
+ }
+ else cblas_xerbla(1, "cblas_dtpmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dtpsv.c b/contrib/libs/cblas/src/cblas_dtpsv.c
new file mode 100644
index 0000000000..5555c2174e
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dtpsv.c
@@ -0,0 +1,118 @@
+/*
+ * cblas_dtpsv.c
+ * The program is a C interface to dtpsv.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dtpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const double *Ap, double *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtpsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtpsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtpsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_dtpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtpsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtpsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtpsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_dtpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
+
+ }
+ else cblas_xerbla(1, "cblas_dtpsv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dtrmm.c b/contrib/libs/cblas/src/cblas_dtrmm.c
new file mode 100644
index 0000000000..32a5d2bc91
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dtrmm.c
@@ -0,0 +1,148 @@
+/*
+ *
+ * cblas_dtrmm.c
+ * This program is a C interface to dtrmm.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dtrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const double alpha, const double *A, const int lda,
+ double *B, const int ldb)
+{
+ char UL, TA, SD, DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_SD &SD
+ #define F77_DI &DI
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if( Side == CblasRight) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtrmm","Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtrmm","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( TransA == CblasTrans) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtrmm","Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_dtrmm","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_dtrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Side == CblasRight) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtrmm","Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtrmm","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( TransA == CblasTrans) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtrmm","Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_dtrmm","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_dtrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb);
+ }
+ else cblas_xerbla(1, "cblas_dtrmm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dtrmv.c b/contrib/libs/cblas/src/cblas_dtrmv.c
new file mode 100644
index 0000000000..cce150709b
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dtrmv.c
@@ -0,0 +1,122 @@
+/*
+ *
+ * cblas_dtrmv.c
+ * This program is a C interface to sgemv.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dtrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const double *A, const int lda,
+ double *X, const int incX)
+
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtrmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtrmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtrmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_dtrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtrmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtrmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtrmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_dtrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ } else cblas_xerbla(1, "cblas_dtrmv", "Illegal order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dtrsm.c b/contrib/libs/cblas/src/cblas_dtrsm.c
new file mode 100644
index 0000000000..4f47cb193c
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dtrsm.c
@@ -0,0 +1,153 @@
+/*
+ *
+ * cblas_dtrsm.c
+ * This program is a C interface to dtrsm.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dtrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const double alpha, const double *A, const int lda,
+ double *B, const int ldb)
+
+{
+ char UL, TA, SD, DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_SD &SD
+ #define F77_DI &DI
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if ( Side == CblasRight) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtrsm","Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if ( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtrsm","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if ( TransA == CblasTrans ) TA='T';
+ else if ( TransA == CblasConjTrans) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtrsm","Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if ( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_dtrsm","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_dtrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha,
+ A, &F77_lda, B, &F77_ldb);
+ }
+ else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if ( Side == CblasRight) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtrsm","Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if ( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtrsm","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if ( TransA == CblasTrans ) TA='T';
+ else if ( TransA == CblasConjTrans) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtrsm","Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if ( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_dtrsm","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_dtrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A,
+ &F77_lda, B, &F77_ldb);
+ }
+ else cblas_xerbla(1, "cblas_dtrsm","Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dtrsv.c b/contrib/libs/cblas/src/cblas_dtrsv.c
new file mode 100644
index 0000000000..7299d17d52
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dtrsv.c
@@ -0,0 +1,121 @@
+/*
+ * cblas_dtrsv.c
+ * The program is a C interface to dtrsv.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_dtrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const double *A, const int lda, double *X,
+ const int incX)
+
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtrsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtrsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtrsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_dtrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_dtrsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(3, "cblas_dtrsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_dtrsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_dtrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else cblas_xerbla(1, "cblas_dtrsv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_dzasum.c b/contrib/libs/cblas/src/cblas_dzasum.c
new file mode 100644
index 0000000000..b32f573e5f
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dzasum.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_dzasum.c
+ *
+ * The program is a C interface to dzasum.
+ * It calls the fortran wrapper before calling dzasum.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+double cblas_dzasum( const int N, const void *X, const int incX)
+{
+ double asum;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_dzasum_sub( &F77_N, X, &F77_incX, &asum);
+ return asum;
+}
diff --git a/contrib/libs/cblas/src/cblas_dznrm2.c b/contrib/libs/cblas/src/cblas_dznrm2.c
new file mode 100644
index 0000000000..dfa2bfc837
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_dznrm2.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_dznrm2.c
+ *
+ * The program is a C interface to dznrm2.
+ * It calls the fortran wrapper before calling dznrm2.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+double cblas_dznrm2( const int N, const void *X, const int incX)
+{
+ double nrm2;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_dznrm2_sub( &F77_N, X, &F77_incX, &nrm2);
+ return nrm2;
+}
diff --git a/contrib/libs/cblas/src/cblas_globals.c b/contrib/libs/cblas/src/cblas_globals.c
new file mode 100644
index 0000000000..ebcd74db3f
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_globals.c
@@ -0,0 +1,2 @@
+int CBLAS_CallFromC=0;
+int RowMajorStrg=0;
diff --git a/contrib/libs/cblas/src/cblas_icamax.c b/contrib/libs/cblas/src/cblas_icamax.c
new file mode 100644
index 0000000000..f0cdbdb3e7
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_icamax.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_icamax.c
+ *
+ * The program is a C interface to icamax.
+ * It calls the fortran wrapper before calling icamax.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+CBLAS_INDEX cblas_icamax( const int N, const void *X, const int incX)
+{
+ int iamax;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_icamax_sub( &F77_N, X, &F77_incX, &iamax);
+ return iamax ? iamax-1 : 0;
+}
diff --git a/contrib/libs/cblas/src/cblas_idamax.c b/contrib/libs/cblas/src/cblas_idamax.c
new file mode 100644
index 0000000000..abb70b53cc
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_idamax.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_idamax.c
+ *
+ * The program is a C interface to idamax.
+ * It calls the fortran wrapper before calling idamax.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+CBLAS_INDEX cblas_idamax( const int N, const double *X, const int incX)
+{
+ int iamax;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_idamax_sub( &F77_N, X, &F77_incX, &iamax);
+ return iamax ? iamax-1 : 0;
+}
diff --git a/contrib/libs/cblas/src/cblas_isamax.c b/contrib/libs/cblas/src/cblas_isamax.c
new file mode 100644
index 0000000000..bfd74e8f9c
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_isamax.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_isamax.c
+ *
+ * The program is a C interface to isamax.
+ * It calls the fortran wrapper before calling isamax.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+CBLAS_INDEX cblas_isamax( const int N, const float *X, const int incX)
+{
+ int iamax;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_isamax_sub( &F77_N, X, &F77_incX, &iamax);
+ return iamax ? iamax-1 : 0;
+}
diff --git a/contrib/libs/cblas/src/cblas_izamax.c b/contrib/libs/cblas/src/cblas_izamax.c
new file mode 100644
index 0000000000..21fdc396fd
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_izamax.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_izamax.c
+ *
+ * The program is a C interface to izamax.
+ * It calls the fortran wrapper before calling izamax.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+CBLAS_INDEX cblas_izamax( const int N, const void *X, const int incX)
+{
+ int iamax;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_izamax_sub( &F77_N, X, &F77_incX, &iamax);
+ return (iamax ? iamax-1 : 0);
+}
diff --git a/contrib/libs/cblas/src/cblas_sasum.c b/contrib/libs/cblas/src/cblas_sasum.c
new file mode 100644
index 0000000000..7d4c32cf9e
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_sasum.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_sasum.c
+ *
+ * The program is a C interface to sasum.
+ * It calls the fortran wrapper before calling sasum.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+float cblas_sasum( const int N, const float *X, const int incX)
+{
+ float asum;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_sasum_sub( &F77_N, X, &F77_incX, &asum);
+ return asum;
+}
diff --git a/contrib/libs/cblas/src/cblas_saxpy.c b/contrib/libs/cblas/src/cblas_saxpy.c
new file mode 100644
index 0000000000..2eee8e06e4
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_saxpy.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_saxpy.c
+ *
+ * The program is a C interface to saxpy.
+ * It calls the fortran wrapper before calling saxpy.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_saxpy( const int N, const float alpha, const float *X,
+ const int incX, float *Y, const int incY)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_saxpy( &F77_N, &alpha, X, &F77_incX, Y, &F77_incY);
+}
diff --git a/contrib/libs/cblas/src/cblas_scasum.c b/contrib/libs/cblas/src/cblas_scasum.c
new file mode 100644
index 0000000000..e1fa53090a
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_scasum.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_scasum.c
+ *
+ * The program is a C interface to scasum.
+ * It calls the fortran wrapper before calling scasum.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+float cblas_scasum( const int N, const void *X, const int incX)
+{
+ float asum;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_scasum_sub( &F77_N, X, &F77_incX, &asum);
+ return asum;
+}
diff --git a/contrib/libs/cblas/src/cblas_scnrm2.c b/contrib/libs/cblas/src/cblas_scnrm2.c
new file mode 100644
index 0000000000..fa48454ed5
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_scnrm2.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_scnrm2.c
+ *
+ * The program is a C interface to scnrm2.
+ * It calls the fortran wrapper before calling scnrm2.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+float cblas_scnrm2( const int N, const void *X, const int incX)
+{
+ float nrm2;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_scnrm2_sub( &F77_N, X, &F77_incX, &nrm2);
+ return nrm2;
+}
diff --git a/contrib/libs/cblas/src/cblas_scopy.c b/contrib/libs/cblas/src/cblas_scopy.c
new file mode 100644
index 0000000000..7796959f33
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_scopy.c
@@ -0,0 +1,22 @@
+/*
+ * cblas_scopy.c
+ *
+ * The program is a C interface to scopy.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_scopy( const int N, const float *X,
+ const int incX, float *Y, const int incY)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_scopy( &F77_N, X, &F77_incX, Y, &F77_incY);
+}
diff --git a/contrib/libs/cblas/src/cblas_sdot.c b/contrib/libs/cblas/src/cblas_sdot.c
new file mode 100644
index 0000000000..baf859272b
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_sdot.c
@@ -0,0 +1,25 @@
+/*
+ * cblas_sdot.c
+ *
+ * The program is a C interface to sdot.
+ * It calls the fortran wrapper before calling sdot.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+float cblas_sdot( const int N, const float *X,
+ const int incX, const float *Y, const int incY)
+{
+ float dot;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_sdot_sub( &F77_N, X, &F77_incX, Y, &F77_incY, &dot);
+ return dot;
+}
diff --git a/contrib/libs/cblas/src/cblas_sdsdot.c b/contrib/libs/cblas/src/cblas_sdsdot.c
new file mode 100644
index 0000000000..b824849b99
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_sdsdot.c
@@ -0,0 +1,25 @@
+/*
+ * cblas_sdsdot.c
+ *
+ * The program is a C interface to sdsdot.
+ * It calls the fortran wrapper before calling sdsdot.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+float cblas_sdsdot( const int N, const float alpha, const float *X,
+ const int incX, const float *Y, const int incY)
+{
+ float dot;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_sdsdot_sub( &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, &dot);
+ return dot;
+}
diff --git a/contrib/libs/cblas/src/cblas_sgbmv.c b/contrib/libs/cblas/src/cblas_sgbmv.c
new file mode 100644
index 0000000000..0af607f20b
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_sgbmv.c
@@ -0,0 +1,83 @@
+/*
+ *
+ * cblas_sgbmv.c
+ * This program is a C interface to sgbmv.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_sgbmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const int KL, const int KU,
+ const float alpha, const float *A, const int lda,
+ const float *X, const int incX, const float beta,
+ float *Y, const int incY)
+{
+ char TA;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA;
+#else
+ #define F77_TA &TA
+#endif
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+ F77_INT F77_KL=KL,F77_KU=KU;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_KL KL
+ #define F77_KU KU
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(2, "cblas_sgbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ F77_sgbmv(F77_TA, &F77_M, &F77_N, &F77_KL, &F77_KU, &alpha,
+ A, &F77_lda, X, &F77_incX, &beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(2, "cblas_sgbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ F77_sgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, &alpha,
+ A ,&F77_lda, X, &F77_incX, &beta, Y, &F77_incY);
+ }
+ else cblas_xerbla(1, "cblas_sgbmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_sgemm.c b/contrib/libs/cblas/src/cblas_sgemm.c
new file mode 100644
index 0000000000..73a06e5e16
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_sgemm.c
@@ -0,0 +1,110 @@
+/*
+ *
+ * cblas_sgemm.c
+ * This program is a C interface to sgemm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_sgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
+ const enum 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;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_TB;
+#else
+ #define F77_TA &TA
+ #define F77_TB &TB
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+ if( Order == CblasColMajor )
+ {
+ if(TransA == CblasTrans) TA='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(2, "cblas_sgemm",
+ "Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if(TransB == CblasTrans) TB='T';
+ else if ( TransB == CblasConjTrans ) TB='C';
+ else if ( TransB == CblasNoTrans ) TB='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_sgemm",
+ "Illegal TransB setting, %d\n", TransB);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ F77_TB = C2F_CHAR(&TB);
+ #endif
+
+ F77_sgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if(TransA == CblasTrans) TB='T';
+ else if ( TransA == CblasConjTrans ) TB='C';
+ else if ( TransA == CblasNoTrans ) TB='N';
+ else
+ {
+ cblas_xerbla(2, "cblas_sgemm",
+ "Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if(TransB == CblasTrans) TA='T';
+ else if ( TransB == CblasConjTrans ) TA='C';
+ else if ( TransB == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(2, "cblas_sgemm",
+ "Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ F77_TB = C2F_CHAR(&TB);
+ #endif
+
+ F77_sgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc);
+ } else
+ cblas_xerbla(1, "cblas_sgemm",
+ "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+}
diff --git a/contrib/libs/cblas/src/cblas_sgemv.c b/contrib/libs/cblas/src/cblas_sgemv.c
new file mode 100644
index 0000000000..45b7196484
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_sgemv.c
@@ -0,0 +1,78 @@
+/*
+ *
+ * cblas_sgemv.c
+ * This program is a C interface to sgemv.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_sgemv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const float alpha, const float *A, const int lda,
+ const float *X, const int incX, const float beta,
+ float *Y, const int incY)
+{
+ char TA;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA;
+#else
+ #define F77_TA &TA
+#endif
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(2, "cblas_sgemv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ F77_sgemv(F77_TA, &F77_M, &F77_N, &alpha, A, &F77_lda, X, &F77_incX,
+ &beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(2, "cblas_sgemv", "Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ F77_sgemv(F77_TA, &F77_N, &F77_M, &alpha, A, &F77_lda, X,
+ &F77_incX, &beta, Y, &F77_incY);
+ }
+ else cblas_xerbla(1, "cblas_sgemv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_sger.c b/contrib/libs/cblas/src/cblas_sger.c
new file mode 100644
index 0000000000..368940c74d
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_sger.c
@@ -0,0 +1,46 @@
+/*
+ *
+ * cblas_sger.c
+ * This program is a C interface to sger.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_sger(const enum CBLAS_ORDER order, const int M, const int N,
+ const float alpha, const float *X, const int incX,
+ const float *Y, const int incY, float *A, const int lda)
+{
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+ #define F77_lda lda
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ F77_sger( &F77_M, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
+ &F77_lda);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ F77_sger( &F77_N, &F77_M, &alpha, Y, &F77_incY, X, &F77_incX, A,
+ &F77_lda);
+ }
+ else cblas_xerbla(1, "cblas_sger", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_snrm2.c b/contrib/libs/cblas/src/cblas_snrm2.c
new file mode 100644
index 0000000000..18161b4fa7
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_snrm2.c
@@ -0,0 +1,23 @@
+/*
+ * cblas_snrm2.c
+ *
+ * The program is a C interface to snrm2.
+ * It calls the fortran wrapper before calling snrm2.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+float cblas_snrm2( const int N, const float *X, const int incX)
+{
+ float nrm2;
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_snrm2_sub( &F77_N, X, &F77_incX, &nrm2);
+ return nrm2;
+}
diff --git a/contrib/libs/cblas/src/cblas_srot.c b/contrib/libs/cblas/src/cblas_srot.c
new file mode 100644
index 0000000000..cbd1c8c90a
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_srot.c
@@ -0,0 +1,22 @@
+/*
+ * cblas_srot.c
+ *
+ * The program is a C interface to srot.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_srot( const int N, float *X, const int incX, float *Y,
+ const int incY, const float c, const float s)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_srot(&F77_N, X, &F77_incX, Y, &F77_incY, &c, &s);
+}
diff --git a/contrib/libs/cblas/src/cblas_srotg.c b/contrib/libs/cblas/src/cblas_srotg.c
new file mode 100644
index 0000000000..f6460048d0
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_srotg.c
@@ -0,0 +1,14 @@
+/*
+ * cblas_srotg.c
+ *
+ * The program is a C interface to srotg.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_srotg( float *a, float *b, float *c, float *s)
+{
+ F77_srotg(a,b,c,s);
+}
diff --git a/contrib/libs/cblas/src/cblas_srotm.c b/contrib/libs/cblas/src/cblas_srotm.c
new file mode 100644
index 0000000000..4967464544
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_srotm.c
@@ -0,0 +1,22 @@
+/*
+ * cblas_srotm.c
+ *
+ * The program is a C interface to srotm.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_srotm( const int N, float *X, const int incX, float *Y,
+ const int incY, const float *P)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_srotm( &F77_N, X, &F77_incX, Y, &F77_incY, P);
+}
diff --git a/contrib/libs/cblas/src/cblas_srotmg.c b/contrib/libs/cblas/src/cblas_srotmg.c
new file mode 100644
index 0000000000..04f978b405
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_srotmg.c
@@ -0,0 +1,15 @@
+/*
+ * cblas_srotmg.c
+ *
+ * The program is a C interface to srotmg.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_srotmg( float *d1, float *d2, float *b1,
+ const float b2, float *p)
+{
+ F77_srotmg(d1,d2,b1,&b2,p);
+}
diff --git a/contrib/libs/cblas/src/cblas_ssbmv.c b/contrib/libs/cblas/src/cblas_ssbmv.c
new file mode 100644
index 0000000000..7a18630b61
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ssbmv.c
@@ -0,0 +1,76 @@
+/*
+ *
+ * cblas_ssbmv.c
+ * This program is a C interface to ssbmv.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ssbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const int K, const float alpha, const float *A,
+ const int lda, const float *X, const int incX,
+ const float beta, float *Y, const int incY)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ssbmv","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_ssbmv(F77_UL, &F77_N, &F77_K, &alpha, A, &F77_lda, X,
+ &F77_incX, &beta, Y, &F77_incY);
+ }else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ssbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_ssbmv(F77_UL, &F77_N, &F77_K, &alpha, A, &F77_lda, X,
+ &F77_incX, &beta, Y, &F77_incY);
+ }
+ else cblas_xerbla(1, "cblas_ssbmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_sscal.c b/contrib/libs/cblas/src/cblas_sscal.c
new file mode 100644
index 0000000000..1f09abe7a4
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_sscal.c
@@ -0,0 +1,21 @@
+/*
+ * cblas_sscal.c
+ *
+ * The program is a C interface to sscal.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_sscal( const int N, const float alpha, float *X,
+ const int incX)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_sscal( &F77_N, &alpha, X, &F77_incX);
+}
diff --git a/contrib/libs/cblas/src/cblas_sspmv.c b/contrib/libs/cblas/src/cblas_sspmv.c
new file mode 100644
index 0000000000..aa4a287eb7
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_sspmv.c
@@ -0,0 +1,73 @@
+/*
+ *
+ * cblas_sspmv.c
+ * This program is a C interface to sspmv.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_sspmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_UPLO Uplo, const int N,
+ const float alpha, const float *AP,
+ const float *X, const int incX, const float beta,
+ float *Y, const int incY)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_sspmv","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_sspmv(F77_UL, &F77_N, &alpha, AP, X,
+ &F77_incX, &beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_sspmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_sspmv(F77_UL, &F77_N, &alpha,
+ AP, X,&F77_incX, &beta, Y, &F77_incY);
+ }
+ else cblas_xerbla(1, "cblas_sspmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+}
diff --git a/contrib/libs/cblas/src/cblas_sspr.c b/contrib/libs/cblas/src/cblas_sspr.c
new file mode 100644
index 0000000000..c8517ac1cd
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_sspr.c
@@ -0,0 +1,72 @@
+/*
+ *
+ * cblas_sspr.c
+ * This program is a C interface to sspr.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_sspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const float *X,
+ const int incX, float *Ap)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_sspr","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_sspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasLower) UL = 'U';
+ else if (Uplo == CblasUpper) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_sspr","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_sspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap);
+ } else cblas_xerbla(1, "cblas_sspr", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_sspr2.c b/contrib/libs/cblas/src/cblas_sspr2.c
new file mode 100644
index 0000000000..4f5afcd85d
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_sspr2.c
@@ -0,0 +1,71 @@
+/*
+ *
+ * cblas_sspr2.c
+ * This program is a C interface to sspr2.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_sspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const float *X,
+ const int incX, const float *Y, const int incY, float *A)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_sspr2","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_sspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasLower) UL = 'U';
+ else if (Uplo == CblasUpper) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_sspr2","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_sspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A);
+ } else cblas_xerbla(1, "cblas_sspr2", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+}
diff --git a/contrib/libs/cblas/src/cblas_sswap.c b/contrib/libs/cblas/src/cblas_sswap.c
new file mode 100644
index 0000000000..b74d8469c3
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_sswap.c
@@ -0,0 +1,22 @@
+/*
+ * cblas_sswap.c
+ *
+ * The program is a C interface to sswap.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_sswap( const int N, float *X, const int incX, float *Y,
+ const int incY)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_sswap( &F77_N, X, &F77_incX, Y, &F77_incY);
+}
diff --git a/contrib/libs/cblas/src/cblas_ssymm.c b/contrib/libs/cblas/src/cblas_ssymm.c
new file mode 100644
index 0000000000..a3b160105d
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ssymm.c
@@ -0,0 +1,108 @@
+/*
+ *
+ * cblas_ssymm.c
+ * This program is a C interface to ssymm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ssymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const int M, const int N,
+ const float alpha, const float *A, const int lda,
+ const float *B, const int ldb, const float beta,
+ float *C, const int ldc)
+{
+ char SD, UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_SD, F77_UL;
+#else
+ #define F77_SD &SD
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if( Side == CblasRight) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ssymm",
+ "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_ssymm",
+ "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_ssymm(F77_SD, F77_UL, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Side == CblasRight) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_ssymm",
+ "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_ssymm",
+ "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_ssymm(F77_SD, F77_UL, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
+ } else cblas_xerbla(1, "cblas_ssymm",
+ "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ssymv.c b/contrib/libs/cblas/src/cblas_ssymv.c
new file mode 100644
index 0000000000..89f5cc0cc6
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ssymv.c
@@ -0,0 +1,76 @@
+/*
+ *
+ * cblas_ssymv.c
+ * This program is a C interface to ssymv.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ssymv(const enum CBLAS_ORDER order,
+ const enum CBLAS_UPLO Uplo, const int N,
+ const float alpha, const float *A, const int lda,
+ const float *X, const int incX, const float beta,
+ float *Y, const int incY)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ssymv","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_ssymv(F77_UL, &F77_N, &alpha, A, &F77_lda, X,
+ &F77_incX, &beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ssymv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_ssymv(F77_UL, &F77_N, &alpha,
+ A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY);
+ }
+ else cblas_xerbla(1, "cblas_ssymv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ssyr.c b/contrib/libs/cblas/src/cblas_ssyr.c
new file mode 100644
index 0000000000..4e58dba417
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ssyr.c
@@ -0,0 +1,70 @@
+/*
+ *
+ * cblas_ssyr.c
+ * This program is a C interface to ssyr.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ssyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const float *X,
+ const int incX, float *A, const int lda)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_lda=lda;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_lda lda
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ssyr","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_ssyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasLower) UL = 'U';
+ else if (Uplo == CblasUpper) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ssyr","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_ssyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
+ } else cblas_xerbla(1, "cblas_ssyr", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ssyr2.c b/contrib/libs/cblas/src/cblas_ssyr2.c
new file mode 100644
index 0000000000..1d990cd413
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ssyr2.c
@@ -0,0 +1,76 @@
+/*
+ *
+ * cblas_ssyr2.c
+ * This program is a C interface to ssyr2.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ssyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const float *X,
+ const int incX, const float *Y, const int incY, float *A,
+ const int lda)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY, F77__lda=lda;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+ #define F77_lda lda
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ssyr2","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_ssyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
+ &F77_lda);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasLower) UL = 'U';
+ else if (Uplo == CblasUpper) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ssyr2","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_ssyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
+ &F77_lda);
+ } else cblas_xerbla(1, "cblas_ssyr2", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ssyr2k.c b/contrib/libs/cblas/src/cblas_ssyr2k.c
new file mode 100644
index 0000000000..871dd21a12
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ssyr2k.c
@@ -0,0 +1,111 @@
+/*
+ *
+ * cblas_ssyr2k.c
+ * This program is a C interface to ssyr2k.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ssyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, 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 UL, TR;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL;
+#else
+ #define F77_TR &TR
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ssyr2k",
+ "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Trans == CblasTrans) TR ='T';
+ else if ( Trans == CblasConjTrans ) TR='C';
+ else if ( Trans == CblasNoTrans ) TR='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_ssyr2k",
+ "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_ssyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_ssyr2k",
+ "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Trans == CblasTrans) TR ='N';
+ else if ( Trans == CblasConjTrans ) TR='N';
+ else if ( Trans == CblasNoTrans ) TR='T';
+ else
+ {
+ cblas_xerbla(3, "cblas_ssyr2k",
+ "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_ssyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
+ } else cblas_xerbla(1, "cblas_ssyr2k",
+ "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ssyrk.c b/contrib/libs/cblas/src/cblas_ssyrk.c
new file mode 100644
index 0000000000..4992c9b266
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ssyrk.c
@@ -0,0 +1,110 @@
+/*
+ *
+ * cblas_ssyrk.c
+ * This program is a C interface to ssyrk.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ssyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const float alpha, const float *A, const int lda,
+ const float beta, float *C, const int ldc)
+{
+ char UL, TR;
+#ifdef F77_CHAR
+ F77_CHAR F77_TR, F77_UL;
+#else
+ #define F77_TR &TR
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ssyrk",
+ "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Trans == CblasTrans) TR ='T';
+ else if ( Trans == CblasConjTrans ) TR='C';
+ else if ( Trans == CblasNoTrans ) TR='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_ssyrk",
+ "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_ssyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, &beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_ssyrk",
+ "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Trans == CblasTrans) TR ='N';
+ else if ( Trans == CblasConjTrans ) TR='N';
+ else if ( Trans == CblasNoTrans ) TR='T';
+ else
+ {
+ cblas_xerbla(3, "cblas_ssyrk",
+ "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_ssyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, &beta, C, &F77_ldc);
+ } else cblas_xerbla(1, "cblas_ssyrk",
+ "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
+
diff --git a/contrib/libs/cblas/src/cblas_stbmv.c b/contrib/libs/cblas/src/cblas_stbmv.c
new file mode 100644
index 0000000000..9e84bc0198
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_stbmv.c
@@ -0,0 +1,122 @@
+/*
+ * cblas_stbmv.c
+ * This program is a C interface to stbmv.
+ * Written by Keita Teranishi
+ * 3/3/1998
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+
+void cblas_stbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const float *A, const int lda,
+ float *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_stbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_stbmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_stbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(3, "cblas_stbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_stbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else cblas_xerbla(1, "cblas_stbmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_stbsv.c b/contrib/libs/cblas/src/cblas_stbsv.c
new file mode 100644
index 0000000000..fc19089708
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_stbsv.c
@@ -0,0 +1,122 @@
+/*
+ * cblas_stbsv.c
+ * The program is a C interface to stbsv.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_stbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const float *A, const int lda,
+ float *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_stbsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_stbsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_stbsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_stbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_stbsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(3, "cblas_stbsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_stbsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_stbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else cblas_xerbla(1, "cblas_stbsv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_stpmv.c b/contrib/libs/cblas/src/cblas_stpmv.c
new file mode 100644
index 0000000000..8f7fd6acd9
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_stpmv.c
@@ -0,0 +1,118 @@
+/*
+ *
+ * cblas_stpmv.c
+ * This program is a C interface to stpmv.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_stpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const float *Ap, float *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_stpmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_stpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_stpmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_stpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
+ }
+ else cblas_xerbla(1, "cblas_stpmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_stpsv.c b/contrib/libs/cblas/src/cblas_stpsv.c
new file mode 100644
index 0000000000..acc5f1d5ca
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_stpsv.c
@@ -0,0 +1,118 @@
+/*
+ * cblas_stpsv.c
+ * The program is a C interface to stpsv.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_stpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const float *Ap, float *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_stpsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_stpsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_stpsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_stpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_stpsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(3, "cblas_stpsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_stpsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_stpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
+
+ }
+ else cblas_xerbla(1, "cblas_stpsv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_strmm.c b/contrib/libs/cblas/src/cblas_strmm.c
new file mode 100644
index 0000000000..9f8ce198dc
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_strmm.c
@@ -0,0 +1,148 @@
+/*
+ *
+ * cblas_strmm.c
+ * This program is a C interface to strmm.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_strmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const float alpha, const float *A, const int lda,
+ float *B, const int ldb)
+{
+ char UL, TA, SD, DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_SD &SD
+ #define F77_DI &DI
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if( Side == CblasRight) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_strmm","Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_strmm","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( TransA == CblasTrans) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_strmm","Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_strmm", "Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_strmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Side == CblasRight) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_strmm","Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_strmm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( TransA == CblasTrans) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_strmm", "Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_strmm","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+#ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+#endif
+ F77_strmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A,
+ &F77_lda, B, &F77_ldb);
+ }
+ else cblas_xerbla(1, "cblas_strmm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_strmv.c b/contrib/libs/cblas/src/cblas_strmv.c
new file mode 100644
index 0000000000..5a85b1dafb
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_strmv.c
@@ -0,0 +1,122 @@
+/*
+ *
+ * cblas_strmv.c
+ * This program is a C interface to strmv.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_strmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const float *A, const int lda,
+ float *X, const int incX)
+
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_strmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_strmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_strmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_strmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_strmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(3, "cblas_strmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_strmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_strmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else cblas_xerbla(1, "cblas_strmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_strsm.c b/contrib/libs/cblas/src/cblas_strsm.c
new file mode 100644
index 0000000000..5dc3e0bc0d
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_strsm.c
@@ -0,0 +1,143 @@
+/*
+ *
+ * cblas_strsm.c
+ * This program is a C interface to strsm.
+ * Written by Keita Teranishi
+ * 4/6/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_strsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const float alpha, const float *A, const int lda,
+ float *B, const int ldb)
+
+{
+ char UL, TA, SD, DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_SD &SD
+ #define F77_DI &DI
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if( Side == CblasRight) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_strsm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_strsm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( TransA == CblasTrans) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_strsm", "Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_strsm", "Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_strsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Side == CblasRight) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_strsm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_strsm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( TransA == CblasTrans) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_strsm", "Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_strsm", "Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_strsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb);
+ }
+ else cblas_xerbla(1, "cblas_strsm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_strsv.c b/contrib/libs/cblas/src/cblas_strsv.c
new file mode 100644
index 0000000000..a0509aebd6
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_strsv.c
@@ -0,0 +1,121 @@
+/*
+ * cblas_strsv.c
+ * The program is a C interface to strsv.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_strsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const float *A, const int lda, float *X,
+ const int incX)
+
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_strsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_strsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_strsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_strsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_strsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans) TA = 'N';
+ else
+ {
+ cblas_xerbla(3, "cblas_strsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_strsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_strsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else cblas_xerbla(1, "cblas_strsv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_xerbla.c b/contrib/libs/cblas/src/cblas_xerbla.c
new file mode 100644
index 0000000000..3a2bfe6e3b
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_xerbla.c
@@ -0,0 +1,68 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <stdarg.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+
+void cblas_xerbla(int info, const char *rout, const char *form, ...)
+{
+ extern int RowMajorStrg;
+ char empty[1] = "";
+ va_list argptr;
+
+ va_start(argptr, form);
+
+ if (RowMajorStrg)
+ {
+ 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)
+ F77_xerbla(empty, &info); /* Force link of our F77 error handler */
+ exit(-1);
+}
diff --git a/contrib/libs/cblas/src/cblas_zaxpy.c b/contrib/libs/cblas/src/cblas_zaxpy.c
new file mode 100644
index 0000000000..f63c4c39bc
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zaxpy.c
@@ -0,0 +1,22 @@
+/*
+ * cblas_zaxpy.c
+ *
+ * The program is a C interface to zaxpy.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zaxpy( const int N, const void *alpha, const void *X,
+ const int incX, void *Y, const int incY)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_zaxpy( &F77_N, alpha, X, &F77_incX, Y, &F77_incY);
+}
diff --git a/contrib/libs/cblas/src/cblas_zcopy.c b/contrib/libs/cblas/src/cblas_zcopy.c
new file mode 100644
index 0000000000..a16be28e7e
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zcopy.c
@@ -0,0 +1,22 @@
+/*
+ * cblas_zcopy.c
+ *
+ * The program is a C interface to zcopy.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zcopy( const int N, const void *X,
+ const int incX, void *Y, const int incY)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_zcopy( &F77_N, X, &F77_incX, Y, &F77_incY);
+}
diff --git a/contrib/libs/cblas/src/cblas_zdotc_sub.c b/contrib/libs/cblas/src/cblas_zdotc_sub.c
new file mode 100644
index 0000000000..29dec6c576
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zdotc_sub.c
@@ -0,0 +1,24 @@
+/*
+ * cblas_zdotc_sub.c
+ *
+ * The program is a C interface to zdotc.
+ * It calls the fortran wrapper before calling zdotc.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zdotc_sub( const int N, const void *X, const int incX,
+ const void *Y, const int incY, void *dotc)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_zdotc_sub( &F77_N, X, &F77_incX, Y, &F77_incY, dotc);
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zdotu_sub.c b/contrib/libs/cblas/src/cblas_zdotu_sub.c
new file mode 100644
index 0000000000..48a14bf3d4
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zdotu_sub.c
@@ -0,0 +1,24 @@
+/*
+ * cblas_zdotu_sub.c
+ *
+ * The program is a C interface to zdotu.
+ * It calls the fortran wrapper before calling zdotu.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zdotu_sub( const int N, const void *X, const int incX,
+ const void *Y, const int incY, void *dotu)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_zdotu_sub( &F77_N, X, &F77_incX, Y, &F77_incY, dotu);
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zdscal.c b/contrib/libs/cblas/src/cblas_zdscal.c
new file mode 100644
index 0000000000..788365befa
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zdscal.c
@@ -0,0 +1,21 @@
+/*
+ * cblas_zdscal.c
+ *
+ * The program is a C interface to zdscal.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zdscal( const int N, const double alpha, void *X,
+ const int incX)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_zdscal( &F77_N, &alpha, X, &F77_incX);
+}
diff --git a/contrib/libs/cblas/src/cblas_zgbmv.c b/contrib/libs/cblas/src/cblas_zgbmv.c
new file mode 100644
index 0000000000..fb3cabb400
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zgbmv.c
@@ -0,0 +1,166 @@
+/*
+ * cblas_zgbmv.c
+ * The program is a C interface of zgbmv
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zgbmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const int KL, const int KU,
+ const void *alpha, const void *A, const int lda,
+ const void *X, const int incX, const void *beta,
+ void *Y, const int incY)
+{
+ char TA;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA;
+#else
+ #define F77_TA &TA
+#endif
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+ F77_INT F77_KL=KL,F77_KU=KU;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_KL KL
+ #define F77_KU KU
+ #define F77_incX incx
+ #define F77_incY incY
+#endif
+ int n, i=0, incx=incX;
+ const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
+ double ALPHA[2],BETA[2];
+ int tincY, tincx;
+ double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(2, "cblas_zgbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ F77_zgbmv(F77_TA, &F77_M, &F77_N, &F77_KL, &F77_KU, alpha,
+ A, &F77_lda, X, &F77_incX, beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ ALPHA[0]= *alp;
+ ALPHA[1]= -alp[1];
+ BETA[0]= *bet;
+ BETA[1]= -bet[1];
+ TA = 'N';
+ if (M > 0)
+ {
+ n = M << 1;
+ x = malloc(n*sizeof(double));
+ tx = x;
+
+ if( incX > 0 ) {
+ i = incX << 1 ;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ #else
+ incx = 1;
+ #endif
+
+ if( incY > 0 )
+ tincY = incY;
+ else
+ tincY = -incY;
+
+ y++;
+
+ if (N > 0)
+ {
+ i = tincY << 1;
+ n = i * N ;
+ st = y + n;
+ do {
+ *y = -(*y);
+ y += i;
+ } while(y != st);
+ y -= n;
+ }
+ }
+ else x = (double *) X;
+
+
+ }
+ else
+ {
+ cblas_xerbla(2, "cblas_zgbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ if (TransA == CblasConjTrans)
+ F77_zgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, ALPHA,
+ A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY);
+ else
+ F77_zgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, alpha,
+ A ,&F77_lda, x,&F77_incX, beta, Y, &F77_incY);
+ if (TransA == CblasConjTrans)
+ {
+ if (x != X) free(x);
+ if (N > 0)
+ {
+ do
+ {
+ *y = -(*y);
+ y += i;
+ }
+ while (y != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_zgbmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zgemm.c b/contrib/libs/cblas/src/cblas_zgemm.c
new file mode 100644
index 0000000000..f344d83876
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zgemm.c
@@ -0,0 +1,109 @@
+/*
+ *
+ * cblas_zgemm.c
+ * This program is a C interface to zgemm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
+ const enum 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;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_TB;
+#else
+ #define F77_TA &TA
+ #define F77_TB &TB
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if(TransA == CblasTrans) TA='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(2, "cblas_zgemm","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if(TransB == CblasTrans) TB='T';
+ else if ( TransB == CblasConjTrans ) TB='C';
+ else if ( TransB == CblasNoTrans ) TB='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_zgemm","Illegal TransB setting, %d\n", TransB);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ F77_TB = C2F_CHAR(&TB);
+ #endif
+
+ F77_zgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, alpha, A,
+ &F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if(TransA == CblasTrans) TB='T';
+ else if ( TransA == CblasConjTrans ) TB='C';
+ else if ( TransA == CblasNoTrans ) TB='N';
+ else
+ {
+ cblas_xerbla(2, "cblas_zgemm","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if(TransB == CblasTrans) TA='T';
+ else if ( TransB == CblasConjTrans ) TA='C';
+ else if ( TransB == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(2, "cblas_zgemm","Illegal TransB setting, %d\n", TransB);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ F77_TB = C2F_CHAR(&TB);
+ #endif
+
+ F77_zgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, alpha, B,
+ &F77_ldb, A, &F77_lda, beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_zgemm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zgemv.c b/contrib/libs/cblas/src/cblas_zgemv.c
new file mode 100644
index 0000000000..355d7ef30f
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zgemv.c
@@ -0,0 +1,164 @@
+/*
+ * cblas_zgemv.c
+ * The program is a C interface of zgemv
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zgemv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *X, const int incX, const void *beta,
+ void *Y, const int incY)
+{
+ char TA;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA;
+#else
+ #define F77_TA &TA
+#endif
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incx
+ #define F77_incY incY
+#endif
+
+ int n, i=0, incx=incX;
+ const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
+ double ALPHA[2],BETA[2];
+ int tincY, tincx;
+ double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+
+ if (order == CblasColMajor)
+ {
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(2, "cblas_zgemv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ F77_zgemv(F77_TA, &F77_M, &F77_N, alpha, A, &F77_lda, X, &F77_incX,
+ beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ ALPHA[0]= *alp;
+ ALPHA[1]= -alp[1];
+ BETA[0]= *bet;
+ BETA[1]= -bet[1];
+ TA = 'N';
+ if (M > 0)
+ {
+ n = M << 1;
+ x = malloc(n*sizeof(double));
+ tx = x;
+ if( incX > 0 ) {
+ i = incX << 1 ;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ #else
+ incx = 1;
+ #endif
+
+ if(incY > 0)
+ tincY = incY;
+ else
+ tincY = -incY;
+
+ y++;
+
+ if (N > 0)
+ {
+ i = tincY << 1;
+ n = i * N ;
+ st = y + n;
+ do {
+ *y = -(*y);
+ y += i;
+ } while(y != st);
+ y -= n;
+ }
+ }
+ else x = (double *) X;
+ }
+ else
+ {
+ cblas_xerbla(2, "cblas_zgemv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_TA = C2F_CHAR(&TA);
+ #endif
+ if (TransA == CblasConjTrans)
+ F77_zgemv(F77_TA, &F77_N, &F77_M, ALPHA, A, &F77_lda, x,
+ &F77_incX, BETA, Y, &F77_incY);
+ else
+ F77_zgemv(F77_TA, &F77_N, &F77_M, alpha, A, &F77_lda, x,
+ &F77_incX, beta, Y, &F77_incY);
+
+ if (TransA == CblasConjTrans)
+ {
+ if (x != (double *)X) free(x);
+ if (N > 0)
+ {
+ do
+ {
+ *y = -(*y);
+ y += i;
+ }
+ while (y != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_zgemv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zgerc.c b/contrib/libs/cblas/src/cblas_zgerc.c
new file mode 100644
index 0000000000..2acde748e4
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zgerc.c
@@ -0,0 +1,84 @@
+/*
+ * cblas_zgerc.c
+ * The program is a C interface to zgerc.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zgerc(const enum CBLAS_ORDER order, const int M, const int N,
+ const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *A, const int lda)
+{
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incy
+ #define F77_lda lda
+#endif
+
+ int n, i, tincy, incy=incY;
+ double *y=(double *)Y, *yy=(double *)Y, *ty, *st;
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ F77_zgerc( &F77_M, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, A,
+ &F77_lda);
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (N > 0)
+ {
+ n = N << 1;
+ y = malloc(n*sizeof(double));
+
+ ty = y;
+ if( incY > 0 ) {
+ i = incY << 1;
+ tincy = 2;
+ st= y+n;
+ } else {
+ i = incY *(-2);
+ tincy = -2;
+ st = y-2;
+ y +=(n-2);
+ }
+ do
+ {
+ *y = *yy;
+ y[1] = -yy[1];
+ y += tincy ;
+ yy += i;
+ }
+ while (y != st);
+ y = ty;
+
+ #ifdef F77_INT
+ F77_incY = 1;
+ #else
+ incy = 1;
+ #endif
+ }
+ else y = (double *) Y;
+
+ F77_zgeru( &F77_N, &F77_M, alpha, y, &F77_incY, X, &F77_incX, A,
+ &F77_lda);
+ if(Y!=y)
+ free(y);
+
+ } else cblas_xerbla(1, "cblas_zgerc", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zgeru.c b/contrib/libs/cblas/src/cblas_zgeru.c
new file mode 100644
index 0000000000..464ca1539e
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zgeru.c
@@ -0,0 +1,44 @@
+/*
+ * cblas_zgeru.c
+ * The program is a C interface to zgeru.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zgeru(const enum CBLAS_ORDER order, const int M, const int N,
+ const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *A, const int lda)
+{
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+ #define F77_lda lda
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if (order == CblasColMajor)
+ {
+ F77_zgeru( &F77_M, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, A,
+ &F77_lda);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ F77_zgeru( &F77_N, &F77_M, alpha, Y, &F77_incY, X, &F77_incX, A,
+ &F77_lda);
+ }
+ else cblas_xerbla(1, "cblas_zgeru", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zhbmv.c b/contrib/libs/cblas/src/cblas_zhbmv.c
new file mode 100644
index 0000000000..de4b96a9b0
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zhbmv.c
@@ -0,0 +1,159 @@
+/*
+ * cblas_zhbmv.c
+ * The program is a C interface to zhbmv
+ *
+ * Keita Teranishi 5/18/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+#include <stdio.h>
+#include <stdlib.h>
+void cblas_zhbmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_UPLO Uplo,const int N,const int K,
+ const void *alpha, const void *A, const int lda,
+ const void *X, const int incX, const void *beta,
+ void *Y, const int incY)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_incX incx
+ #define F77_incY incY
+#endif
+ int n, i=0, incx=incX;
+ const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
+ double ALPHA[2],BETA[2];
+ int tincY, tincx;
+ double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zhbmv","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_zhbmv(F77_UL, &F77_N, &F77_K, alpha, A, &F77_lda, X,
+ &F77_incX, beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ ALPHA[0]= *alp;
+ ALPHA[1]= -alp[1];
+ BETA[0]= *bet;
+ BETA[1]= -bet[1];
+
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(double));
+
+ tx = x;
+ if( incX > 0 ) {
+ i = incX << 1 ;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ #else
+ incx = 1;
+ #endif
+
+ if(incY > 0)
+ tincY = incY;
+ else
+ tincY = -incY;
+ y++;
+
+ i = tincY << 1;
+ n = i * N ;
+ st = y + n;
+ do {
+ *y = -(*y);
+ y += i;
+ } while(y != st);
+ y -= n;
+ } else
+ x = (double *) X;
+
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zhbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_zhbmv(F77_UL, &F77_N, &F77_K, ALPHA,
+ A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY);
+ }
+ else
+ {
+ cblas_xerbla(1, "cblas_zhbmv","Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if ( order == CblasRowMajor )
+ {
+ RowMajorStrg = 1;
+ if(X!=x)
+ free(x);
+ if (N > 0)
+ {
+ do
+ {
+ *y = -(*y);
+ y += i;
+ }
+ while (y != st);
+ }
+ }
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zhemm.c b/contrib/libs/cblas/src/cblas_zhemm.c
new file mode 100644
index 0000000000..2eb0951d2b
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zhemm.c
@@ -0,0 +1,106 @@
+/*
+ *
+ * cblas_zhemm.c
+ * This program is a C interface to zhemm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zhemm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const void *beta,
+ void *C, const int ldc)
+{
+ char SD, UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_SD, F77_UL;
+#else
+ #define F77_SD &SD
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if( Side == CblasRight) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_zhemm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_zhemm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_zhemm(F77_SD, F77_UL, &F77_M, &F77_N, alpha, A, &F77_lda,
+ B, &F77_ldb, beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Side == CblasRight) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_zhemm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_zhemm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_zhemm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A,
+ &F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_zhemm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zhemv.c b/contrib/libs/cblas/src/cblas_zhemv.c
new file mode 100644
index 0000000000..29cee1f20b
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zhemv.c
@@ -0,0 +1,160 @@
+/*
+ * cblas_zhemv.c
+ * The program is a C interface to zhemv
+ *
+ * Keita Teranishi 5/18/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zhemv(const enum CBLAS_ORDER order,
+ const enum CBLAS_UPLO Uplo, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *X, const int incX, const void *beta,
+ void *Y, const int incY)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incx
+ #define F77_incY incY
+#endif
+ int n, i=0, incx=incX;
+ const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
+ double ALPHA[2],BETA[2];
+ int tincY, tincx;
+ double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_zhemv","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_zhemv(F77_UL, &F77_N, alpha, A, &F77_lda, X, &F77_incX,
+ beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ ALPHA[0]= *alp;
+ ALPHA[1]= -alp[1];
+ BETA[0]= *bet;
+ BETA[1]= -bet[1];
+
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(double));
+
+ tx = x;
+ if( incX > 0 ) {
+ i = incX << 1 ;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ #else
+ incx = 1;
+ #endif
+
+ if(incY > 0)
+ tincY = incY;
+ else
+ tincY = -incY;
+ y++;
+
+ i = tincY << 1;
+ n = i * N ;
+ st = y + n;
+ do {
+ *y = -(*y);
+ y += i;
+ } while(y != st);
+ y -= n;
+ } else
+ x = (double *) X;
+
+
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zhemv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_zhemv(F77_UL, &F77_N, ALPHA, A, &F77_lda, x, &F77_incX,
+ BETA, Y, &F77_incY);
+ }
+ else
+ {
+ cblas_xerbla(1, "cblas_zhemv","Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if ( order == CblasRowMajor )
+ {
+ RowMajorStrg = 1;
+ if ( X != x )
+ free(x);
+ if (N > 0)
+ {
+ do
+ {
+ *y = -(*y);
+ y += i;
+ }
+ while (y != st);
+ }
+ }
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zher.c b/contrib/libs/cblas/src/cblas_zher.c
new file mode 100644
index 0000000000..f688992bf4
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zher.c
@@ -0,0 +1,110 @@
+/*
+ * cblas_zher.c
+ * The program is a C interface to zher.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zher(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const void *X, const int incX
+ ,void *A, const int lda)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incx
+#endif
+ int n, i, tincx, incx=incX;
+ double *x=(double *)X, *xx=(double *)X, *tx, *st;
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zher","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_zher(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zher","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(double));
+ tx = x;
+ if( incX > 0 ) {
+ i = incX << 1 ;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ #else
+ incx = 1;
+ #endif
+ }
+ else x = (double *) X;
+ F77_zher(F77_UL, &F77_N, &alpha, x, &F77_incX, A, &F77_lda);
+ } else cblas_xerbla(1, "cblas_zher", "Illegal Order setting, %d\n", order);
+ if(X!=x)
+ free(x);
+
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zher2.c b/contrib/libs/cblas/src/cblas_zher2.c
new file mode 100644
index 0000000000..fa0547453b
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zher2.c
@@ -0,0 +1,153 @@
+/*
+ * cblas_zher2.c
+ * The program is a C interface to zher2.
+ *
+ * Keita Teranishi 3/23/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *A, const int lda)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incx
+ #define F77_incY incy
+#endif
+ int n, i, j, tincx, tincy, incx=incX, incy=incY;
+ double *x=(double *)X, *xx=(double *)X, *y=(double *)Y,
+ *yy=(double *)Y, *tx, *ty, *stx, *sty;
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zher2", "Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_zher2(F77_UL, &F77_N, alpha, X, &F77_incX,
+ Y, &F77_incY, A, &F77_lda);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zher2", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(double));
+ y = malloc(n*sizeof(double));
+ tx = x;
+ ty = y;
+ if( incX > 0 ) {
+ i = incX << 1 ;
+ tincx = 2;
+ stx= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ stx = x-2;
+ x +=(n-2);
+ }
+
+ if( incY > 0 ) {
+ j = incY << 1;
+ tincy = 2;
+ sty= y+n;
+ } else {
+ j = incY *(-2);
+ tincy = -2;
+ sty = y-2;
+ y +=(n-2);
+ }
+
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != stx);
+
+ do
+ {
+ *y = *yy;
+ y[1] = -yy[1];
+ y += tincy ;
+ yy += j;
+ }
+ while (y != sty);
+
+ x=tx;
+ y=ty;
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ F77_incY = 1;
+ #else
+ incx = 1;
+ incy = 1;
+ #endif
+ } else
+ {
+ x = (double *) X;
+ y = (double *) Y;
+ }
+ F77_zher2(F77_UL, &F77_N, alpha, y, &F77_incY, x,
+ &F77_incX, A, &F77_lda);
+ }
+ else
+ {
+ cblas_xerbla(1, "cblas_zher2", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if(X!=x)
+ free(x);
+ if(Y!=y)
+ free(y);
+
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zher2k.c b/contrib/libs/cblas/src/cblas_zher2k.c
new file mode 100644
index 0000000000..abd0a4ddcb
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zher2k.c
@@ -0,0 +1,110 @@
+/*
+ *
+ * cblas_zher2k.c
+ * This program is a C interface to zher2k.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const double beta,
+ void *C, const int ldc)
+{
+ char UL, TR;
+#ifdef F77_CHAR
+ F77_CHAR F77_TR, F77_UL;
+#else
+ #define F77_TR &TR
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ double ALPHA[2];
+ const double *alp=(double *)alpha;
+
+ CBLAS_CallFromC = 1;
+ RowMajorStrg = 0;
+
+ if( Order == CblasColMajor )
+ {
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_zher2k", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Trans == CblasTrans) TR ='T';
+ else if ( Trans == CblasConjTrans ) TR='C';
+ else if ( Trans == CblasNoTrans ) TR='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_zher2k", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_zher2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zher2k", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Trans == CblasTrans) TR ='N';
+ else if ( Trans == CblasConjTrans ) TR='N';
+ else if ( Trans == CblasNoTrans ) TR='C';
+ else
+ {
+ cblas_xerbla(3, "cblas_zher2k", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ ALPHA[0]= *alp;
+ ALPHA[1]= -alp[1];
+ F77_zher2k(F77_UL,F77_TR, &F77_N, &F77_K, ALPHA, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
+ } else cblas_xerbla(1, "cblas_zher2k", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zherk.c b/contrib/libs/cblas/src/cblas_zherk.c
new file mode 100644
index 0000000000..a867788f34
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zherk.c
@@ -0,0 +1,105 @@
+/*
+ *
+ * cblas_zherk.c
+ * This program is a C interface to zherk.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zherk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const double alpha, const void *A, const int lda,
+ const double beta, void *C, const int ldc)
+{
+ char UL, TR;
+#ifdef F77_CHAR
+ F77_CHAR F77_TR, F77_UL;
+#else
+ #define F77_TR &TR
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_zherk", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Trans == CblasTrans) TR ='T';
+ else if ( Trans == CblasConjTrans ) TR='C';
+ else if ( Trans == CblasNoTrans ) TR='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_zherk", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_zherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
+ &beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_zherk", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Trans == CblasTrans) TR ='N';
+ else if ( Trans == CblasConjTrans ) TR='N';
+ else if ( Trans == CblasNoTrans ) TR='C';
+ else
+ {
+ cblas_xerbla(3, "cblas_zherk", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_zherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
+ &beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_zherk", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zhpmv.c b/contrib/libs/cblas/src/cblas_zhpmv.c
new file mode 100644
index 0000000000..289eb78066
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zhpmv.c
@@ -0,0 +1,160 @@
+/*
+ * cblas_zhpmv.c
+ * The program is a C interface of zhpmv
+ *
+ * Keita Teranishi 5/18/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zhpmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_UPLO Uplo,const int N,
+ const void *alpha, const void *AP,
+ const void *X, const int incX, const void *beta,
+ void *Y, const int incY)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incx
+ #define F77_incY incY
+#endif
+ int n, i=0, incx=incX;
+ const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
+ double ALPHA[2],BETA[2];
+ int tincY, tincx;
+ double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zhpmv","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ F77_zhpmv(F77_UL, &F77_N, alpha, AP, X,
+ &F77_incX, beta, Y, &F77_incY);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ ALPHA[0]= *alp;
+ ALPHA[1]= -alp[1];
+ BETA[0]= *bet;
+ BETA[1]= -bet[1];
+
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(double));
+
+ tx = x;
+ if( incX > 0 ) {
+ i = incX << 1;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+
+
+ #ifdef F77_INT
+ F77_incX = 1;
+ #else
+ incx = 1;
+ #endif
+
+ if(incY > 0)
+ tincY = incY;
+ else
+ tincY = -incY;
+ y++;
+
+ i = tincY << 1;
+ n = i * N ;
+ st = y + n;
+ do {
+ *y = -(*y);
+ y += i;
+ } while(y != st);
+ y -= n;
+ } else
+ x = (double *) X;
+
+
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zhpmv","Illegal Uplo setting, %d\n", Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_zhpmv(F77_UL, &F77_N, ALPHA,
+ AP, x, &F77_incX, BETA, Y, &F77_incY);
+ }
+ else
+ {
+ cblas_xerbla(1, "cblas_zhpmv","Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if ( order == CblasRowMajor )
+ {
+ RowMajorStrg = 1;
+ if(X!=x)
+ free(x);
+ if (N > 0)
+ {
+ do
+ {
+ *y = -(*y);
+ y += i;
+ }
+ while (y != st);
+ }
+ }
+
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zhpr.c b/contrib/libs/cblas/src/cblas_zhpr.c
new file mode 100644
index 0000000000..5517c22d56
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zhpr.c
@@ -0,0 +1,115 @@
+/*
+ * cblas_zhpr.c
+ * The program is a C interface to zhpr.
+ *
+ * Keita Teranishi 3/23/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zhpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const void *X,
+ const int incX, void *A)
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incx
+#endif
+ int n, i, tincx, incx=incX;
+ double *x=(double *)X, *xx=(double *)X, *tx, *st;
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zhpr","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_zhpr(F77_UL, &F77_N, &alpha, X, &F77_incX, A);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zhpr","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(double));
+ tx = x;
+ if( incX > 0 ) {
+ i = incX << 1;
+ tincx = 2;
+ st= x+n;
+ } else {
+ i = incX *(-2);
+ tincx = -2;
+ st = x-2;
+ x +=(n-2);
+ }
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += tincx ;
+ xx += i;
+ }
+ while (x != st);
+ x=tx;
+ #ifdef F77_INT
+ F77_incX = 1;
+ #else
+ incx = 1;
+ #endif
+ }
+ else x = (double *) X;
+
+ F77_zhpr(F77_UL, &F77_N, &alpha, x, &F77_incX, A);
+
+ } else
+ {
+ cblas_xerbla(1, "cblas_zhpr","Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if(X!=x)
+ free(x);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zhpr2.c b/contrib/libs/cblas/src/cblas_zhpr2.c
new file mode 100644
index 0000000000..69b9f14a90
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zhpr2.c
@@ -0,0 +1,150 @@
+/*
+ * cblas_zhpr2.c
+ * The program is a C interface to zhpr2.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zhpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N,const void *alpha, const void *X,
+ const int incX,const void *Y, const int incY, void *Ap)
+
+{
+ char UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_UL;
+#else
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incx
+ #define F77_incY incy
+#endif
+ int n, i, j, incx=incX, incy=incY;
+ double *x=(double *)X, *xx=(double *)X, *y=(double *)Y,
+ *yy=(double *)Y, *stx, *sty;
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasLower) UL = 'L';
+ else if (Uplo == CblasUpper) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zhpr2","Illegal Uplo setting, %d\n",Uplo );
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+
+ F77_zhpr2(F77_UL, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, Ap);
+
+ } else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_zhpr2","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ #endif
+ if (N > 0)
+ {
+ n = N << 1;
+ x = malloc(n*sizeof(double));
+ y = malloc(n*sizeof(double));
+ stx = x + n;
+ sty = y + n;
+ if( incX > 0 )
+ i = incX << 1;
+ else
+ i = incX *(-2);
+
+ if( incY > 0 )
+ j = incY << 1;
+ else
+ j = incY *(-2);
+ do
+ {
+ *x = *xx;
+ x[1] = -xx[1];
+ x += 2;
+ xx += i;
+ } while (x != stx);
+ do
+ {
+ *y = *yy;
+ y[1] = -yy[1];
+ y += 2;
+ yy += j;
+ }
+ while (y != sty);
+ x -= n;
+ y -= n;
+
+ #ifdef F77_INT
+ if(incX > 0 )
+ F77_incX = 1;
+ else
+ F77_incX = -1;
+
+ if(incY > 0 )
+ F77_incY = 1;
+ else
+ F77_incY = -1;
+
+ #else
+ if(incX > 0 )
+ incx = 1;
+ else
+ incx = -1;
+
+ if(incY > 0 )
+ incy = 1;
+ else
+ incy = -1;
+ #endif
+
+ } else
+ {
+ x = (double *) X;
+ y = (void *) Y;
+ }
+ F77_zhpr2(F77_UL, &F77_N, alpha, y, &F77_incY, x, &F77_incX, Ap);
+ }
+ else
+ {
+ cblas_xerbla(1, "cblas_zhpr2","Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if(X!=x)
+ free(x);
+ if(Y!=y)
+ free(y);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zscal.c b/contrib/libs/cblas/src/cblas_zscal.c
new file mode 100644
index 0000000000..37b319f38f
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zscal.c
@@ -0,0 +1,21 @@
+/*
+ * cblas_zscal.c
+ *
+ * The program is a C interface to zscal.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zscal( const int N, const void *alpha, void *X,
+ const int incX)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ F77_zscal( &F77_N, alpha, X, &F77_incX);
+}
diff --git a/contrib/libs/cblas/src/cblas_zswap.c b/contrib/libs/cblas/src/cblas_zswap.c
new file mode 100644
index 0000000000..dfde2cbd01
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zswap.c
@@ -0,0 +1,22 @@
+/*
+ * cblas_zswap.c
+ *
+ * The program is a C interface to zswap.
+ *
+ * Written by Keita Teranishi. 2/11/1998
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zswap( const int N, void *X, const int incX, void *Y,
+ const int incY)
+{
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
+#else
+ #define F77_N N
+ #define F77_incX incX
+ #define F77_incY incY
+#endif
+ F77_zswap( &F77_N, X, &F77_incX, Y, &F77_incY);
+}
diff --git a/contrib/libs/cblas/src/cblas_zsymm.c b/contrib/libs/cblas/src/cblas_zsymm.c
new file mode 100644
index 0000000000..91aa67d3b0
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zsymm.c
@@ -0,0 +1,106 @@
+/*
+ *
+ * cblas_zsymm.c
+ * This program is a C interface to zsymm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zsymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const void *beta,
+ void *C, const int ldc)
+{
+ char SD, UL;
+#ifdef F77_CHAR
+ F77_CHAR F77_SD, F77_UL;
+#else
+ #define F77_SD &SD
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if( Side == CblasRight) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_zsymm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_zsymm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_zsymm(F77_SD, F77_UL, &F77_M, &F77_N, alpha, A, &F77_lda,
+ B, &F77_ldb, beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Side == CblasRight) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_zsymm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_zsymm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_SD = C2F_CHAR(&SD);
+ #endif
+
+ F77_zsymm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A, &F77_lda,
+ B, &F77_ldb, beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_zsymm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zsyr2k.c b/contrib/libs/cblas/src/cblas_zsyr2k.c
new file mode 100644
index 0000000000..def7239ba1
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zsyr2k.c
@@ -0,0 +1,108 @@
+/*
+ *
+ * cblas_zsyr2k.c
+ * This program is a C interface to zsyr2k.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, 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 UL, TR;
+#ifdef F77_CHAR
+ F77_CHAR F77_TR, F77_UL;
+#else
+ #define F77_TR &TR
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldb ldb
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_zsyr2k", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Trans == CblasTrans) TR ='T';
+ else if ( Trans == CblasConjTrans ) TR='C';
+ else if ( Trans == CblasNoTrans ) TR='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_zsyr2k", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_zsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
+ B, &F77_ldb, beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_zsyr2k", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Trans == CblasTrans) TR ='N';
+ else if ( Trans == CblasConjTrans ) TR='N';
+ else if ( Trans == CblasNoTrans ) TR='T';
+ else
+ {
+ cblas_xerbla(3, "cblas_zsyr2k", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_zsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_zsyr2k", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_zsyrk.c b/contrib/libs/cblas/src/cblas_zsyrk.c
new file mode 100644
index 0000000000..7968f90417
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_zsyrk.c
@@ -0,0 +1,107 @@
+/*
+ *
+ * cblas_zsyrk.c
+ * This program is a C interface to zsyrk.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_zsyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const void *alpha, const void *A, const int lda,
+ const void *beta, void *C, const int ldc)
+{
+ char UL, TR;
+#ifdef F77_CHAR
+ F77_CHAR F77_TR, F77_UL;
+#else
+ #define F77_TR &TR
+ #define F77_UL &UL
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_K=K, F77_lda=lda;
+ F77_INT F77_ldc=ldc;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_ldc ldc
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_zsyrk", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Trans == CblasTrans) TR ='T';
+ else if ( Trans == CblasConjTrans ) TR='C';
+ else if ( Trans == CblasNoTrans ) TR='N';
+ else
+ {
+ cblas_xerbla(3, "cblas_zsyrk", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_zsyrk(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
+ beta, C, &F77_ldc);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_zsyrk", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Trans == CblasTrans) TR ='N';
+ else if ( Trans == CblasConjTrans ) TR='N';
+ else if ( Trans == CblasNoTrans ) TR='T';
+ else
+ {
+ cblas_xerbla(3, "cblas_zsyrk", "Illegal Trans setting, %d\n", Trans);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TR = C2F_CHAR(&TR);
+ #endif
+
+ F77_zsyrk(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
+ beta, C, &F77_ldc);
+ }
+ else cblas_xerbla(1, "cblas_zsyrk", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ztbmv.c b/contrib/libs/cblas/src/cblas_ztbmv.c
new file mode 100644
index 0000000000..b3dde43813
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ztbmv.c
@@ -0,0 +1,158 @@
+/*
+ * cblas_ztbmv.c
+ * The program is a C interface to ztbmv.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ztbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const void *A, const int lda,
+ void *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ int n, i=0, tincX;
+ double *st=0, *x=(double *)X;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_ztbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztbmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ztbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ TA = 'N';
+ if ( N > 0)
+ {
+ if(incX > 0)
+ tincX = incX;
+ else
+ tincX = -incX;
+ i = tincX << 1;
+ n = i * N;
+ x++;
+ st = x + n;
+ do
+ {
+ *x = -(*x);
+ x+= i;
+ }
+ while (x != st);
+ x -= n;
+ }
+ }
+ else
+ {
+ cblas_xerbla(3, "cblas_ztbmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztbmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ztbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+
+ if (TransA == CblasConjTrans)
+ {
+ if (N > 0)
+ {
+ do
+ {
+ *x = -(*x);
+ x += i;
+ }
+ while (x != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_ztbmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ztbsv.c b/contrib/libs/cblas/src/cblas_ztbsv.c
new file mode 100644
index 0000000000..e3532b35ae
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ztbsv.c
@@ -0,0 +1,162 @@
+/*
+ * cblas_ztbsv.c
+ * The program is a C interface to ztbsv.
+ *
+ * Keita Teranishi 3/23/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ztbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const void *A, const int lda,
+ void *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_K K
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ int n, i=0, tincX;
+ double *st=0,*x=(double *)X;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztbsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_ztbsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztbsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ztbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztbsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ TA = 'N';
+ if ( N > 0)
+ {
+ if ( incX > 0 )
+ tincX = incX;
+ else
+ tincX = -incX;
+
+ n = N*2*(tincX);
+
+ x++;
+
+ st=x+n;
+
+ i = tincX << 1;
+ do
+ {
+ *x = -(*x);
+ x+=i;
+ }
+ while (x != st);
+ x -= n;
+ }
+ }
+ else
+ {
+ cblas_xerbla(3, "cblas_ztbsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztbsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ztbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
+ &F77_incX);
+
+ if (TransA == CblasConjTrans)
+ {
+ if (N > 0)
+ {
+ do
+ {
+ *x = -(*x);
+ x+= i;
+ }
+ while (x != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_ztbsv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ztpmv.c b/contrib/libs/cblas/src/cblas_ztpmv.c
new file mode 100644
index 0000000000..f29b7bb32a
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ztpmv.c
@@ -0,0 +1,152 @@
+/*
+ * cblas_ztpmv.c
+ * The program is a C interface to ztpmv.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ztpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *Ap, void *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ int n, i=0, tincX;
+ double *st=0,*x=(double *)X;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztpmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_ztpmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztpmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ztpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztpmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ TA = 'N';
+ if ( N > 0)
+ {
+ if(incX > 0)
+ tincX = incX;
+ else
+ tincX = -incX;
+ i = tincX << 1;
+ n = i * N;
+ x++;
+ st = x + n;
+ do
+ {
+ *x = -(*x);
+ x += i;
+ }
+ while (x != st);
+ x -= n;
+ }
+ }
+ else
+ {
+ cblas_xerbla(3, "cblas_ztpmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztpmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ztpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
+ if (TransA == CblasConjTrans)
+ {
+ if (N > 0)
+ {
+ do
+ {
+ *x = -(*x);
+ x += i;
+ }
+ while (x != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_ztpmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ztpsv.c b/contrib/libs/cblas/src/cblas_ztpsv.c
new file mode 100644
index 0000000000..4c72808b0e
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ztpsv.c
@@ -0,0 +1,157 @@
+/*
+ * cblas_ztpsv.c
+ * The program is a C interface to ztpsv.
+ *
+ * Keita Teranishi 3/23/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ztpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *Ap, void *X, const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_incX incX
+#endif
+ int n, i=0, tincX;
+ double *st=0, *x=(double*)X;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztpsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_ztpsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztpsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ztpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztpsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ TA = 'N';
+ if ( N > 0)
+ {
+ if ( incX > 0 )
+ tincX = incX;
+ else
+ tincX = -incX;
+
+ n = N*2*(tincX);
+
+ x++;
+
+ st=x+n;
+
+ i = tincX << 1;
+ do
+ {
+ *x = -(*x);
+ x+=i;
+ }
+ while (x != st);
+ x -= n;
+ }
+ }
+ else
+ {
+ cblas_xerbla(3, "cblas_ztpsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztpsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ztpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
+
+ if (TransA == CblasConjTrans)
+ {
+ if (N > 0)
+ {
+ do
+ {
+ *x = -(*x);
+ x += i;
+ }
+ while (x != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_ztpsv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ztrmm.c b/contrib/libs/cblas/src/cblas_ztrmm.c
new file mode 100644
index 0000000000..caeaefa1ed
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ztrmm.c
@@ -0,0 +1,149 @@
+/*
+ *
+ * cblas_ztrmm.c
+ * This program is a C interface to ztrmm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ztrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ void *B, const int ldb)
+{
+ char UL, TA, SD, DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_SD &SD
+ #define F77_DI &DI
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+ if( Side == CblasRight ) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztrmm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if( Uplo == CblasUpper ) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_ztrmm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( TransA == CblasTrans ) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztrmm", "Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_ztrmm", "Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ztrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, alpha, A, &F77_lda, B, &F77_ldb);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if( Side == CblasRight ) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztrmm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper ) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_ztrmm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( TransA == CblasTrans ) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztrmm", "Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_ztrmm", "Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ztrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A, &F77_lda, B, &F77_ldb);
+ }
+ else cblas_xerbla(1, "cblas_ztrmm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ztrmv.c b/contrib/libs/cblas/src/cblas_ztrmv.c
new file mode 100644
index 0000000000..c9345afaa3
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ztrmv.c
@@ -0,0 +1,156 @@
+/*
+ * cblas_ztrmv.c
+ * The program is a C interface to ztrmv.
+ *
+ * Keita Teranishi 5/20/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ztrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *A, const int lda,
+ void *X, const int incX)
+
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ int n, i=0, tincX;
+ double *st=0,*x=(double *)X;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztrmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_ztrmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztrmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ztrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztrmv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ TA = 'N';
+ if ( N > 0)
+ {
+ if(incX > 0)
+ tincX = incX;
+ else
+ tincX = -incX;
+ i = tincX << 1;
+ n = i * N;
+ x++;
+ st = x + n;
+ do
+ {
+ *x = -(*x);
+ x += i;
+ }
+ while (x != st);
+ x -= n;
+ }
+ }
+ else
+ {
+ cblas_xerbla(3, "cblas_ztrmv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztrmv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ztrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ if (TransA == CblasConjTrans)
+ {
+ if (N > 0)
+ {
+ do
+ {
+ *x = -(*x);
+ x += i;
+ }
+ while (x != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_ztrmv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ztrsm.c b/contrib/libs/cblas/src/cblas_ztrsm.c
new file mode 100644
index 0000000000..08375d8153
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ztrsm.c
@@ -0,0 +1,155 @@
+/*
+ *
+ * cblas_ztrsm.c
+ * This program is a C interface to ztrsm.
+ * Written by Keita Teranishi
+ * 4/8/1998
+ *
+ */
+
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ztrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ void *B, const int ldb)
+{
+ char UL, TA, SD, DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_SD &SD
+ #define F77_DI &DI
+#endif
+
+#ifdef F77_INT
+ F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
+#else
+ #define F77_M M
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_ldb ldb
+#endif
+
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+ CBLAS_CallFromC = 1;
+
+ if( Order == CblasColMajor )
+ {
+
+ if( Side == CblasRight) SD='R';
+ else if ( Side == CblasLeft ) SD='L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztrsm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='U';
+ else if ( Uplo == CblasLower ) UL='L';
+ else
+ {
+ cblas_xerbla(3, "cblas_ztrsm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( TransA == CblasTrans) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztrsm", "Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_ztrsm", "Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+ F77_ztrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, alpha, A,
+ &F77_lda, B, &F77_ldb);
+ } else if (Order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+
+ if( Side == CblasRight) SD='L';
+ else if ( Side == CblasLeft ) SD='R';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztrsm", "Illegal Side setting, %d\n", Side);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Uplo == CblasUpper) UL='L';
+ else if ( Uplo == CblasLower ) UL='U';
+ else
+ {
+ cblas_xerbla(3, "cblas_ztrsm", "Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( TransA == CblasTrans) TA ='T';
+ else if ( TransA == CblasConjTrans ) TA='C';
+ else if ( TransA == CblasNoTrans ) TA='N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztrsm", "Illegal Trans setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if( Diag == CblasUnit ) DI='U';
+ else if ( Diag == CblasNonUnit ) DI='N';
+ else
+ {
+ cblas_xerbla(5, "cblas_ztrsm", "Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_SD = C2F_CHAR(&SD);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+
+
+ F77_ztrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A,
+ &F77_lda, B, &F77_ldb);
+ }
+ else cblas_xerbla(1, "cblas_ztrsm", "Illegal Order setting, %d\n", Order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cblas_ztrsv.c b/contrib/libs/cblas/src/cblas_ztrsv.c
new file mode 100644
index 0000000000..621399ba04
--- /dev/null
+++ b/contrib/libs/cblas/src/cblas_ztrsv.c
@@ -0,0 +1,156 @@
+/*
+ * cblas_ztrsv.c
+ * The program is a C interface to ztrsv.
+ *
+ * Keita Teranishi 3/23/98
+ *
+ */
+#include "cblas.h"
+#include "cblas_f77.h"
+void cblas_ztrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *A, const int lda, void *X,
+ const int incX)
+{
+ char TA;
+ char UL;
+ char DI;
+#ifdef F77_CHAR
+ F77_CHAR F77_TA, F77_UL, F77_DI;
+#else
+ #define F77_TA &TA
+ #define F77_UL &UL
+ #define F77_DI &DI
+#endif
+#ifdef F77_INT
+ F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
+#else
+ #define F77_N N
+ #define F77_lda lda
+ #define F77_incX incX
+#endif
+ int n, i=0, tincX;
+ double *st=0,*x=(double *)X;
+ extern int CBLAS_CallFromC;
+ extern int RowMajorStrg;
+ RowMajorStrg = 0;
+
+ CBLAS_CallFromC = 1;
+ if (order == CblasColMajor)
+ {
+ if (Uplo == CblasUpper) UL = 'U';
+ else if (Uplo == CblasLower) UL = 'L';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztrsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (TransA == CblasNoTrans) TA = 'N';
+ else if (TransA == CblasTrans) TA = 'T';
+ else if (TransA == CblasConjTrans) TA = 'C';
+ else
+ {
+ cblas_xerbla(3, "cblas_ztrsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztrsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ztrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ }
+ else if (order == CblasRowMajor)
+ {
+ RowMajorStrg = 1;
+ if (Uplo == CblasUpper) UL = 'L';
+ else if (Uplo == CblasLower) UL = 'U';
+ else
+ {
+ cblas_xerbla(2, "cblas_ztrsv","Illegal Uplo setting, %d\n", Uplo);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (TransA == CblasNoTrans) TA = 'T';
+ else if (TransA == CblasTrans) TA = 'N';
+ else if (TransA == CblasConjTrans)
+ {
+ TA = 'N';
+ if ( N > 0)
+ {
+ if ( incX > 0 )
+ tincX = incX;
+ else
+ tincX = -incX;
+
+ n = N*2*(tincX);
+ x++;
+ st=x+n;
+ i = tincX << 1;
+ do
+ {
+ *x = -(*x);
+ x+=i;
+ }
+ while (x != st);
+ x -= n;
+ }
+ }
+ else
+ {
+ cblas_xerbla(3, "cblas_ztrsv","Illegal TransA setting, %d\n", TransA);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+
+ if (Diag == CblasUnit) DI = 'U';
+ else if (Diag == CblasNonUnit) DI = 'N';
+ else
+ {
+ cblas_xerbla(4, "cblas_ztrsv","Illegal Diag setting, %d\n", Diag);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+ }
+ #ifdef F77_CHAR
+ F77_UL = C2F_CHAR(&UL);
+ F77_TA = C2F_CHAR(&TA);
+ F77_DI = C2F_CHAR(&DI);
+ #endif
+ F77_ztrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
+ &F77_incX);
+ if (TransA == CblasConjTrans)
+ {
+ if (N > 0)
+ {
+ do
+ {
+ *x = -(*x);
+ x += i;
+ }
+ while (x != st);
+ }
+ }
+ }
+ else cblas_xerbla(1, "cblas_ztrsv", "Illegal Order setting, %d\n", order);
+ CBLAS_CallFromC = 0;
+ RowMajorStrg = 0;
+ return;
+}
diff --git a/contrib/libs/cblas/src/cdotcsub.c b/contrib/libs/cblas/src/cdotcsub.c
new file mode 100644
index 0000000000..c8adb9d92b
--- /dev/null
+++ b/contrib/libs/cblas/src/cdotcsub.c
@@ -0,0 +1,41 @@
+/* cdotcsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* cdotcsub.f */
+
+/* The program is a fortran wrapper for cdotc. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int cdotcsub_(integer *n, complex *x, integer *incx, complex
+ *y, integer *incy, complex *dotc)
+{
+ /* System generated locals */
+ complex q__1;
+
+ /* Local variables */
+ extern /* Complex */ VOID cdotc_(complex *, integer *, complex *, integer
+ *, complex *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --y;
+ --x;
+
+ /* Function Body */
+ cdotc_(&q__1, n, &x[1], incx, &y[1], incy);
+ dotc->r = q__1.r, dotc->i = q__1.i;
+ return 0;
+} /* cdotcsub_ */
+
diff --git a/contrib/libs/cblas/src/cdotusub.c b/contrib/libs/cblas/src/cdotusub.c
new file mode 100644
index 0000000000..b6c4c70c5c
--- /dev/null
+++ b/contrib/libs/cblas/src/cdotusub.c
@@ -0,0 +1,41 @@
+/* cdotusub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* cdotusub.f */
+
+/* The program is a fortran wrapper for cdotu. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int cdotusub_(integer *n, complex *x, integer *incx, complex
+ *y, integer *incy, complex *dotu)
+{
+ /* System generated locals */
+ complex q__1;
+
+ /* Local variables */
+ extern /* Complex */ VOID cdotu_(complex *, integer *, complex *, integer
+ *, complex *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --y;
+ --x;
+
+ /* Function Body */
+ cdotu_(&q__1, n, &x[1], incx, &y[1], incy);
+ dotu->r = q__1.r, dotu->i = q__1.i;
+ return 0;
+} /* cdotusub_ */
+
diff --git a/contrib/libs/cblas/src/dasumsub.c b/contrib/libs/cblas/src/dasumsub.c
new file mode 100644
index 0000000000..147ad557ab
--- /dev/null
+++ b/contrib/libs/cblas/src/dasumsub.c
@@ -0,0 +1,34 @@
+/* dasumsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* dasumsun.f */
+
+/* The program is a fortran wrapper for dasum.. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int dasumsub_(integer *n, doublereal *x, integer *incx,
+ doublereal *asum)
+{
+ extern doublereal dasum_(integer *, doublereal *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ *asum = dasum_(n, &x[1], incx);
+ return 0;
+} /* dasumsub_ */
+
diff --git a/contrib/libs/cblas/src/ddotsub.c b/contrib/libs/cblas/src/ddotsub.c
new file mode 100644
index 0000000000..ba36a6918a
--- /dev/null
+++ b/contrib/libs/cblas/src/ddotsub.c
@@ -0,0 +1,36 @@
+/* ddotsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* ddotsub.f */
+
+/* The program is a fortran wrapper for ddot. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int ddotsub_(integer *n, doublereal *x, integer *incx,
+ doublereal *y, integer *incy, doublereal *dot)
+{
+ extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
+ integer *);
+
+
+
+ /* Parameter adjustments */
+ --y;
+ --x;
+
+ /* Function Body */
+ *dot = ddot_(n, &x[1], incx, &y[1], incy);
+ return 0;
+} /* ddotsub_ */
+
diff --git a/contrib/libs/cblas/src/dnrm2sub.c b/contrib/libs/cblas/src/dnrm2sub.c
new file mode 100644
index 0000000000..f5df4489e0
--- /dev/null
+++ b/contrib/libs/cblas/src/dnrm2sub.c
@@ -0,0 +1,34 @@
+/* dnrm2sub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* dnrm2sub.f */
+
+/* The program is a fortran wrapper for dnrm2. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int dnrm2sub_(integer *n, doublereal *x, integer *incx,
+ doublereal *nrm2)
+{
+ extern doublereal dnrm2_(integer *, doublereal *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ *nrm2 = dnrm2_(n, &x[1], incx);
+ return 0;
+} /* dnrm2sub_ */
+
diff --git a/contrib/libs/cblas/src/dsdotsub.c b/contrib/libs/cblas/src/dsdotsub.c
new file mode 100644
index 0000000000..9739a2334e
--- /dev/null
+++ b/contrib/libs/cblas/src/dsdotsub.c
@@ -0,0 +1,35 @@
+/* dsdotsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* dsdotsub.f */
+
+/* The program is a fortran wrapper for dsdot. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int dsdotsub_(integer *n, real *x, integer *incx, real *y,
+ integer *incy, doublereal *dot)
+{
+ extern doublereal dsdot_(integer *, real *, integer *, real *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --y;
+ --x;
+
+ /* Function Body */
+ *dot = dsdot_(n, &x[1], incx, &y[1], incy);
+ return 0;
+} /* dsdotsub_ */
+
diff --git a/contrib/libs/cblas/src/dzasumsub.c b/contrib/libs/cblas/src/dzasumsub.c
new file mode 100644
index 0000000000..84f505180f
--- /dev/null
+++ b/contrib/libs/cblas/src/dzasumsub.c
@@ -0,0 +1,34 @@
+/* dzasumsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* dzasumsub.f */
+
+/* The program is a fortran wrapper for dzasum. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int dzasumsub_(integer *n, doublecomplex *x, integer *incx,
+ doublereal *asum)
+{
+ extern doublereal dzasum_(integer *, doublecomplex *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ *asum = dzasum_(n, &x[1], incx);
+ return 0;
+} /* dzasumsub_ */
+
diff --git a/contrib/libs/cblas/src/dznrm2sub.c b/contrib/libs/cblas/src/dznrm2sub.c
new file mode 100644
index 0000000000..476c6d04bc
--- /dev/null
+++ b/contrib/libs/cblas/src/dznrm2sub.c
@@ -0,0 +1,34 @@
+/* dznrm2sub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* dznrm2sub.f */
+
+/* The program is a fortran wrapper for dznrm2. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int dznrm2sub_(integer *n, doublecomplex *x, integer *incx,
+ doublereal *nrm2)
+{
+ extern doublereal dznrm2_(integer *, doublecomplex *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ *nrm2 = dznrm2_(n, &x[1], incx);
+ return 0;
+} /* dznrm2sub_ */
+
diff --git a/contrib/libs/cblas/src/icamaxsub.c b/contrib/libs/cblas/src/icamaxsub.c
new file mode 100644
index 0000000000..206a90f69b
--- /dev/null
+++ b/contrib/libs/cblas/src/icamaxsub.c
@@ -0,0 +1,34 @@
+/* icamaxsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* icamaxsub.f */
+
+/* The program is a fortran wrapper for icamax. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int icamaxsub_(integer *n, complex *x, integer *incx,
+ integer *iamax)
+{
+ extern integer icamax_(integer *, complex *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ *iamax = icamax_(n, &x[1], incx);
+ return 0;
+} /* icamaxsub_ */
+
diff --git a/contrib/libs/cblas/src/idamaxsub.c b/contrib/libs/cblas/src/idamaxsub.c
new file mode 100644
index 0000000000..f8bfc69215
--- /dev/null
+++ b/contrib/libs/cblas/src/idamaxsub.c
@@ -0,0 +1,34 @@
+/* idamaxsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* icamaxsub.f */
+
+/* The program is a fortran wrapper for idamax. */
+/* Witten by Keita Teranishi. 2/22/1998 */
+
+/* Subroutine */ int idamaxsub_(integer *n, doublereal *x, integer *incx,
+ integer *iamax)
+{
+ extern integer idamax_(integer *, doublereal *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ *iamax = idamax_(n, &x[1], incx);
+ return 0;
+} /* idamaxsub_ */
+
diff --git a/contrib/libs/cblas/src/isamaxsub.c b/contrib/libs/cblas/src/isamaxsub.c
new file mode 100644
index 0000000000..f5ae1dd6b9
--- /dev/null
+++ b/contrib/libs/cblas/src/isamaxsub.c
@@ -0,0 +1,34 @@
+/* isamaxsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* isamaxsub.f */
+
+/* The program is a fortran wrapper for isamax. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int isamaxsub_(integer *n, real *x, integer *incx, integer *
+ iamax)
+{
+ extern integer isamax_(integer *, real *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ *iamax = isamax_(n, &x[1], incx);
+ return 0;
+} /* isamaxsub_ */
+
diff --git a/contrib/libs/cblas/src/izamaxsub.c b/contrib/libs/cblas/src/izamaxsub.c
new file mode 100644
index 0000000000..229a5cdd6a
--- /dev/null
+++ b/contrib/libs/cblas/src/izamaxsub.c
@@ -0,0 +1,34 @@
+/* izamaxsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* izamaxsub.f */
+
+/* The program is a fortran wrapper for izamax. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int izamaxsub_(integer *n, doublecomplex *x, integer *incx,
+ integer *iamax)
+{
+ extern integer izamax_(integer *, doublecomplex *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ *iamax = izamax_(n, &x[1], incx);
+ return 0;
+} /* izamaxsub_ */
+
diff --git a/contrib/libs/cblas/src/sasumsub.c b/contrib/libs/cblas/src/sasumsub.c
new file mode 100644
index 0000000000..709285cbcd
--- /dev/null
+++ b/contrib/libs/cblas/src/sasumsub.c
@@ -0,0 +1,33 @@
+/* sasumsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* sasumsub.f */
+
+/* The program is a fortran wrapper for sasum. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int sasumsub_(integer *n, real *x, integer *incx, real *asum)
+{
+ extern doublereal sasum_(integer *, real *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ *asum = sasum_(n, &x[1], incx);
+ return 0;
+} /* sasumsub_ */
+
diff --git a/contrib/libs/cblas/src/scasumsub.c b/contrib/libs/cblas/src/scasumsub.c
new file mode 100644
index 0000000000..b36fd18d74
--- /dev/null
+++ b/contrib/libs/cblas/src/scasumsub.c
@@ -0,0 +1,34 @@
+/* scasumsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* scasumsub.f */
+
+/* The program is a fortran wrapper for scasum. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int scasumsub_(integer *n, complex *x, integer *incx, real *
+ asum)
+{
+ extern doublereal scasum_(integer *, complex *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ *asum = scasum_(n, &x[1], incx);
+ return 0;
+} /* scasumsub_ */
+
diff --git a/contrib/libs/cblas/src/scnrm2sub.c b/contrib/libs/cblas/src/scnrm2sub.c
new file mode 100644
index 0000000000..2b287aa84d
--- /dev/null
+++ b/contrib/libs/cblas/src/scnrm2sub.c
@@ -0,0 +1,34 @@
+/* scnrm2sub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* scnrm2sub.f */
+
+/* The program is a fortran wrapper for scnrm2. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int scnrm2sub_(integer *n, complex *x, integer *incx, real *
+ nrm2)
+{
+ extern doublereal scnrm2_(integer *, complex *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ *nrm2 = scnrm2_(n, &x[1], incx);
+ return 0;
+} /* scnrm2sub_ */
+
diff --git a/contrib/libs/cblas/src/sdotsub.c b/contrib/libs/cblas/src/sdotsub.c
new file mode 100644
index 0000000000..2074574874
--- /dev/null
+++ b/contrib/libs/cblas/src/sdotsub.c
@@ -0,0 +1,35 @@
+/* sdotsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* sdotsub.f */
+
+/* The program is a fortran wrapper for sdot. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int sdotsub_(integer *n, real *x, integer *incx, real *y,
+ integer *incy, real *dot)
+{
+ extern doublereal sdot_(integer *, real *, integer *, real *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --y;
+ --x;
+
+ /* Function Body */
+ *dot = sdot_(n, &x[1], incx, &y[1], incy);
+ return 0;
+} /* sdotsub_ */
+
diff --git a/contrib/libs/cblas/src/sdsdotsub.c b/contrib/libs/cblas/src/sdsdotsub.c
new file mode 100644
index 0000000000..a25424fb7d
--- /dev/null
+++ b/contrib/libs/cblas/src/sdsdotsub.c
@@ -0,0 +1,36 @@
+/* sdsdotsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* sdsdotsub.f */
+
+/* The program is a fortran wrapper for sdsdot. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int sdsdotsub_(integer *n, real *x, integer *incx, real *y,
+ integer *incy, real *dot)
+{
+ extern doublereal sdsdot_(integer *, real *, integer *, real *, integer *)
+ ;
+
+
+
+ /* Parameter adjustments */
+ --y;
+ --x;
+
+ /* Function Body */
+ *dot = sdsdot_(n, &x[1], incx, &y[1], incy);
+ return 0;
+} /* sdsdotsub_ */
+
diff --git a/contrib/libs/cblas/src/snrm2sub.c b/contrib/libs/cblas/src/snrm2sub.c
new file mode 100644
index 0000000000..e0b3e43682
--- /dev/null
+++ b/contrib/libs/cblas/src/snrm2sub.c
@@ -0,0 +1,33 @@
+/* snrm2sub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* snrm2sub.f */
+
+/* The program is a fortran wrapper for snrm2. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int snrm2sub_(integer *n, real *x, integer *incx, real *nrm2)
+{
+ extern doublereal snrm2_(integer *, real *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ *nrm2 = snrm2_(n, &x[1], incx);
+ return 0;
+} /* snrm2sub_ */
+
diff --git a/contrib/libs/cblas/src/xerbla.c b/contrib/libs/cblas/src/xerbla.c
new file mode 100644
index 0000000000..5a7bcd8bcc
--- /dev/null
+++ b/contrib/libs/cblas/src/xerbla.c
@@ -0,0 +1,47 @@
+#include <stdio.h>
+#include <ctype.h>
+#include "cblas.h"
+#include "cblas_f77.h"
+
+#define XerblaStrLen 6
+#define XerblaStrLen1 7
+
+#ifdef F77_CHAR
+void F77_xerbla(F77_CHAR F77_srname, void *vinfo)
+#else
+void F77_xerbla(char *srname, void *vinfo)
+#endif
+
+{
+#ifdef F77_CHAR
+ char *srname;
+#endif
+
+ char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0'};
+
+#ifdef F77_INT
+ F77_INT *info=vinfo;
+ F77_INT i;
+#else
+ int *info=vinfo;
+ int i;
+#endif
+
+ extern int CBLAS_CallFromC;
+
+#ifdef F77_CHAR
+ srname = F2C_STR(F77_srname, XerblaStrLen);
+#endif
+
+ if (CBLAS_CallFromC)
+ {
+ for(i=0; i != XerblaStrLen; i++) rout[i+6] = tolower(srname[i]);
+ rout[XerblaStrLen+6] = '\0';
+ cblas_xerbla(*info+1,rout,"");
+ }
+ else
+ {
+ fprintf(stderr, "Parameter %d to routine %s was incorrect\n",
+ *info, srname);
+ }
+}
diff --git a/contrib/libs/cblas/src/zdotcsub.c b/contrib/libs/cblas/src/zdotcsub.c
new file mode 100644
index 0000000000..d6c6e3fecb
--- /dev/null
+++ b/contrib/libs/cblas/src/zdotcsub.c
@@ -0,0 +1,41 @@
+/* zdotcsub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* zdotcsub.f */
+
+/* The program is a fortran wrapper for zdotc. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int zdotcsub_(integer *n, doublecomplex *x, integer *incx,
+ doublecomplex *y, integer *incy, doublecomplex *dotc)
+{
+ /* System generated locals */
+ doublecomplex z__1;
+
+ /* Local variables */
+ extern /* Double Complex */ VOID zdotc_(doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --y;
+ --x;
+
+ /* Function Body */
+ zdotc_(&z__1, n, &x[1], incx, &y[1], incy);
+ dotc->r = z__1.r, dotc->i = z__1.i;
+ return 0;
+} /* zdotcsub_ */
+
diff --git a/contrib/libs/cblas/src/zdotusub.c b/contrib/libs/cblas/src/zdotusub.c
new file mode 100644
index 0000000000..bf42f6b073
--- /dev/null
+++ b/contrib/libs/cblas/src/zdotusub.c
@@ -0,0 +1,41 @@
+/* zdotusub.f -- translated by f2c (version 20200916).
+ 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"
+
+/* zdotusub.f */
+
+/* The program is a fortran wrapper for zdotu. */
+/* Witten by Keita Teranishi. 2/11/1998 */
+
+/* Subroutine */ int zdotusub_(integer *n, doublecomplex *x, integer *incx,
+ doublecomplex *y, integer *incy, doublecomplex *dotu)
+{
+ /* System generated locals */
+ doublecomplex z__1;
+
+ /* Local variables */
+ extern /* Double Complex */ VOID zdotu_(doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *);
+
+
+
+ /* Parameter adjustments */
+ --y;
+ --x;
+
+ /* Function Body */
+ zdotu_(&z__1, n, &x[1], incx, &y[1], incy);
+ dotu->r = z__1.r, dotu->i = z__1.i;
+ return 0;
+} /* zdotusub_ */
+