summaryrefslogtreecommitdiff
path: root/src/matrixOperations
diff options
context:
space:
mode:
Diffstat (limited to 'src/matrixOperations')
-rw-r--r--src/matrixOperations/division/cldivma.c67
-rw-r--r--src/matrixOperations/division/crdivma.c65
-rw-r--r--src/matrixOperations/division/dldivma.c115
-rw-r--r--src/matrixOperations/division/drdivma.c132
-rw-r--r--src/matrixOperations/division/sldivma.c63
-rw-r--r--src/matrixOperations/division/srdivma.c65
-rw-r--r--src/matrixOperations/division/zldivma.c123
-rw-r--r--src/matrixOperations/division/zrdivma.c155
8 files changed, 785 insertions, 0 deletions
diff --git a/src/matrixOperations/division/cldivma.c b/src/matrixOperations/division/cldivma.c
new file mode 100644
index 00000000..b912a7de
--- /dev/null
+++ b/src/matrixOperations/division/cldivma.c
@@ -0,0 +1,67 @@
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2008-2008 - INRIA - Allan SIMON
+ *
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution. The terms
+ * are also available at
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+
+
+/**** WARNING NOT WORK AT ALL FOR THE MOMENT ***/
+/**** Because of problem of conversion float-> double ****/
+#include "matrixDivision.h"
+#include "lapack.h"
+#include <string.h>
+#include <stdio.h>
+
+
+void cldivma ( floatComplex* in1, int lines1, int columns1 ,
+ floatComplex* in2, int lines2, int columns2 ,
+ floatComplex* out ){
+
+ int i = 0 ;
+ /* these 3 variable are created to permit to use the value in the fortran functions
+ because they need doubleComplex matrix as arguments and we can't cast directly the pointers
+ without having problems , i know that's ugly */
+ doubleComplex *dblin1 = NULL;
+ doubleComplex *dblin2 = NULL;
+ doubleComplex *dblout = NULL;
+
+
+
+ /* Array allocations*/
+ dblin1 = (doubleComplex*)malloc(sizeof(doubleComplex) * (unsigned int)columns1 * (unsigned int)lines1);
+ dblin2 = (doubleComplex*)malloc(sizeof(doubleComplex) * (unsigned int)columns2 * (unsigned int)lines2);
+ dblout = (doubleComplex*)malloc(sizeof(doubleComplex) * (unsigned int)lines1 * (unsigned int)lines2);
+
+
+
+ /*copy and cast all the floatComplex value into doubleComplex value */
+ for ( i = 0 ; i < lines1 * columns1 ; i ++ )
+ {
+ dblin1[i] = DoubleComplex ( (double) creals( in1[i]) , (double) cimags ( in1[i])) ;
+ }
+
+ for ( i = 0 ; i < lines2 * columns2 ; i ++ )
+ {
+ dblin2[i] = DoubleComplex ( (double) creals( in2[i]) , (double) cimags ( in2[i])) ;
+ }
+
+ zldivma( dblin1 , lines1 , columns1 , dblin2 , lines2 , columns2 , dblout );
+
+
+ for ( i = 0 ; i < min(lines2,columns2) * lines1 ; i++ )
+ {
+ out[i] = FloatComplex ((float) zreals ( dblout[i]) , (float) zimags ( dblout[i])) ;
+
+ }
+
+ free ( dblin1);
+ free ( dblin2);
+ free ( dblout);
+
+}
diff --git a/src/matrixOperations/division/crdivma.c b/src/matrixOperations/division/crdivma.c
new file mode 100644
index 00000000..ba1850df
--- /dev/null
+++ b/src/matrixOperations/division/crdivma.c
@@ -0,0 +1,65 @@
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2008-2008 - INRIA - Allan SIMON
+ *
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution. The terms
+ * are also available at
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+
+
+
+#include "matrixDivision.h"
+#include "lapack.h"
+#include <string.h>
+#include <stdio.h>
+
+void crdivma ( floatComplex* in1, int lines1, int columns1 ,
+ floatComplex* in2, int lines2, int columns2 ,
+ floatComplex* out ){
+
+ int i = 0 ;
+ /* these 3 variable are created to permit to use the value in the fortran functions
+ because they need doubleComplex matrix as arguments and we can't cast directly the pointers
+ without having problems , i know that's ugly */
+ doubleComplex *dblin1 = NULL;
+ doubleComplex *dblin2 = NULL;
+ doubleComplex *dblout = NULL;
+
+
+
+ /* Array allocations*/
+ dblin1 = (doubleComplex*)malloc(sizeof(doubleComplex) * (unsigned int)columns1 * (unsigned int)lines1);
+ dblin2 = (doubleComplex*)malloc(sizeof(doubleComplex) * (unsigned int)columns2 * (unsigned int)lines2);
+ dblout = (doubleComplex*)malloc(sizeof(doubleComplex) * (unsigned int)lines1 * (unsigned int)lines2);
+
+
+
+ /*copy and cast all the floatComplex value into doubleComplex value */
+ for ( i = 0 ; i < lines1 * columns1 ; i ++ )
+ {
+ dblin1[i] = DoubleComplex ( (double) creals( in1[i]) , (double) cimags ( in1[i])) ;
+ }
+
+ for ( i = 0 ; i < lines2 * columns2 ; i ++ )
+ {
+ dblin2[i] = DoubleComplex ( (double) creals( in2[i]) , (double) cimags ( in2[i])) ;
+ }
+
+ zrdivma( dblin1 , lines1 , columns1 , dblin2 , lines2 , columns2 , dblout );
+
+
+ for ( i = 0 ; i < min(lines2,columns2) * lines1 ; i++ )
+ {
+ out[i] = FloatComplex ((float) zreals ( dblout[i]) , (float) zimags ( dblout[i])) ;
+
+ }
+
+ free ( dblin1);
+ free ( dblin2);
+ free ( dblout);
+
+}
diff --git a/src/matrixOperations/division/dldivma.c b/src/matrixOperations/division/dldivma.c
new file mode 100644
index 00000000..18c124c1
--- /dev/null
+++ b/src/matrixOperations/division/dldivma.c
@@ -0,0 +1,115 @@
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2008-2008 - INRIA - Allan SIMON
+ *
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution. The terms
+ * are also available at
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+
+
+
+
+#include "matrixDivision.h"
+#include "lapack.h"
+#include <stdio.h>
+#include <string.h>
+
+void dldivma (double* in1, int lines1, int columns1 ,
+ double* in2, int lines2, int columns2 ,
+ double* out ){
+
+
+ char cNorm = 0;
+ int iExit = 0;
+
+ /*temporary variables*/
+ int iWork = 0;
+ int iInfo = 0;
+ int iMax = 0;
+ double dblRcond = 0;
+
+ double dblEps = 0;
+ double dblAnorm = 0;
+
+ double *pAf = NULL;
+ double *pXb = NULL;
+ double *pDwork = NULL;
+
+ int *pRank = NULL;
+ int *pIpiv = NULL;
+ int *pJpvt = NULL;
+ int *pIwork = NULL;
+
+ iWork = max(4 * columns1, max(min(lines1, columns1) + 3 * lines1 + 1, 2 * min(lines1, columns1) + columns2));
+
+
+
+
+ /* Array allocations*/
+ pAf = (double*)malloc(sizeof(double) * (unsigned int) lines1 * (unsigned int) columns1);
+ pXb = (double*)malloc(sizeof(double) * (unsigned int) max(lines1,columns1) * (unsigned int) columns1);
+
+ pRank = (int*)malloc(sizeof(int));
+ pIpiv = (int*)malloc(sizeof(int) *(unsigned int) columns1);
+ pJpvt = (int*)malloc(sizeof(int) *(unsigned int) columns1);
+ pIwork = (int*)malloc(sizeof(int) *(unsigned int) columns1);
+
+
+
+ cNorm = '1';
+ pDwork = (double*)malloc(sizeof(double) *(unsigned int)iWork);
+ dblEps = getRelativeMachinePrecision() ;
+
+ dblAnorm = dlange_(&cNorm, &lines1, &columns1, in1, &lines1, pDwork);
+
+ if(lines1 == columns1)
+ {
+ cNorm = 'F';
+ dlacpy_(&cNorm, &columns1, &columns1, in1, &columns1, pAf, &columns1);
+ dgetrf_(&columns1, &columns1, pAf, &columns1, pIpiv, &iInfo);
+ if(iInfo == 0)
+ {
+ cNorm = '1';
+ C2F(dgecon)(&cNorm, &columns1, pAf, &columns1, &dblAnorm, &dblRcond, pDwork, pIwork, &iInfo);
+ if(dblRcond > sqrt(dblEps))
+ {
+ cNorm = 'N';
+ C2F(dgetrs)(&cNorm, &columns1, &columns2, pAf, &columns1, pIpiv, in2, &columns1, &iInfo);
+ cNorm = 'F';
+ C2F(dlacpy)(&cNorm, &columns1, &columns2, in2, &columns1, out, &columns1);
+ iExit = 1;
+ }
+ }
+
+ }
+
+ if(iExit == 0)
+ {
+ dblRcond = sqrt(dblEps);
+ cNorm = 'F';
+ iMax = max(lines1, columns1);
+ C2F(dlacpy)(&cNorm, &lines1, &columns2, in2, &lines2, pXb, &iMax);
+ memset(pJpvt, 0x00,(unsigned int) sizeof(int) * (unsigned int) columns1);
+ C2F(dgelsy)( &lines1, &columns1, &columns2, in1, &lines1, pXb, &iMax,
+ pJpvt, &dblRcond, &pRank[0], pDwork, &iWork, &iInfo);
+
+ if(iInfo == 0)
+ {
+
+ cNorm = 'F';
+ C2F(dlacpy)(&cNorm, &columns1, &columns2, pXb, &iMax, out, &columns1);
+ }
+ }
+
+ free(pAf);
+ free(pXb);
+ free(pRank);
+ free(pIpiv);
+ free(pJpvt);
+ free(pIwork);
+ free(pDwork);
+}
diff --git a/src/matrixOperations/division/drdivma.c b/src/matrixOperations/division/drdivma.c
new file mode 100644
index 00000000..456cde6c
--- /dev/null
+++ b/src/matrixOperations/division/drdivma.c
@@ -0,0 +1,132 @@
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2008-2008 - INRIA - Allan SIMON
+ *
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution. The terms
+ * are also available at
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+
+#include "matrixDivision.h"
+#include "lapack.h"
+#include <string.h>
+#include <stdio.h>
+
+
+
+void drdivma ( double * in1, int lines1, int columns1,
+ double * in2, int lines2, int columns2,
+ double * out){
+
+ char cNorm = 0;
+ int iExit = 0;
+
+ /*temporary variables*/
+ int iWork = 0;
+ int iInfo = 0;
+ int iMax = 0;
+ double dblRcond = 0;
+
+ double dblEps = 0;
+ double dblAnorm = 0;
+
+ double *pAf = NULL;
+ double *pAt = NULL;
+ double *pBt = NULL;
+ double *pDwork = NULL;
+
+ int *pRank = NULL;
+ int *pIpiv = NULL;
+ int *pJpvt = NULL;
+ int *pIwork = NULL;
+
+ iWork = max(4 * columns2, max(min(lines2, columns2) + 3 * lines2 + 1, 2 * min(lines2, columns2) + lines1));
+
+
+ /* Array allocations*/
+ pAf = (double*)malloc(sizeof(double) * (unsigned int)columns2 * (unsigned int)lines2);
+ pAt = (double*)malloc(sizeof(double) * (unsigned int)columns2 *(unsigned int) lines2);
+ pBt = (double*)malloc(sizeof(double) * (unsigned int)max(lines2,columns2) * (unsigned int)lines1);
+
+ pRank = (int*)malloc(sizeof(int));
+ pIpiv = (int*)malloc(sizeof(int) * (unsigned int)columns2);
+ pJpvt = (int*)malloc(sizeof(int) * (unsigned int)lines2);
+ pIwork = (int*)malloc(sizeof(int) * (unsigned int)columns2);
+
+
+ cNorm = '1';
+ pDwork = (double*)malloc(sizeof(double) * (unsigned int)iWork);
+ dblEps = getRelativeMachinePrecision() ;
+ dblAnorm = dlange_(&cNorm, &lines2, &columns1, in2, &lines2, pDwork);
+
+ /*tranpose A and B*/
+
+ dtransposea(in2, lines2, columns2, pAt);
+ dtransposea(in1, lines1, columns2, pBt);
+
+ if(lines2 == columns2)
+ {
+ cNorm = 'F';
+ dlacpy_(&cNorm, &columns2, &columns2, pAt, &columns2, pAf, &columns2);
+ dgetrf_(&columns2, &columns2, pAf, &columns2, pIpiv, &iInfo);
+ if(iInfo == 0)
+ {
+ cNorm = '1';
+ dgecon_(&cNorm, &columns2, pAf, &columns2, &dblAnorm, &dblRcond, pDwork, pIwork, &iInfo);
+ if(dblRcond > sqrt(dblEps))
+ {
+ cNorm = 'N';
+ dgetrs_(&cNorm, &columns2, &lines1, pAf, &columns2, pIpiv, pBt, &columns2, &iInfo);
+ dtransposea(pBt, columns2, lines1, out);
+ iExit = 1;
+ }
+ }
+
+ }
+
+ if(iExit == 0)
+ {
+ dblRcond = sqrt(dblEps);
+ cNorm = 'F';
+ iMax = max(lines2, columns2);
+ memset(pJpvt, 0x00, (unsigned int)sizeof(int) * (unsigned int)lines2);
+ dgelsy_(&columns2, &lines2, &lines1, pAt, &columns2, pBt, &iMax,
+ pJpvt, &dblRcond, &pRank[0], pDwork, &iWork, &iInfo);
+
+ if(iInfo == 0)
+ {
+
+
+ /* TransposeRealMatrix(pBt, lines1, lines2, out, Max(lines1,columns1), lines2);*/
+
+ /*Mega caca de la mort qui tue des ours a mains nues
+ mais je ne sais pas comment le rendre "beau" :(*/
+ {
+ int i,j,ij,ji;
+ for(j = 0 ; j < lines2 ; j++)
+ {
+ for(i = 0 ; i < lines1 ; i++)
+ {
+ ij = i + j * lines1;
+ ji = j + i * max(lines2, columns2);
+ out[ij] = pBt[ji];
+ }
+ }
+ }
+ }
+ }
+
+ free(pAf);
+ free(pAt);
+ free(pBt);
+ free(pRank);
+ free(pIpiv);
+ free(pJpvt);
+ free(pIwork);
+ free(pDwork);
+
+}
+
diff --git a/src/matrixOperations/division/sldivma.c b/src/matrixOperations/division/sldivma.c
new file mode 100644
index 00000000..03c7eeab
--- /dev/null
+++ b/src/matrixOperations/division/sldivma.c
@@ -0,0 +1,63 @@
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2008-2008 - INRIA - Allan SIMON
+ *
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution. The terms
+ * are also available at
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+
+
+#include "matrixDivision.h"
+#include "lapack.h"
+#include <string.h>
+#include <stdio.h>
+void sldivma ( float* in1, int lines1, int columns1 ,
+ float* in2, int lines2, int columns2 ,
+ float* out ){
+
+ int i = 0 ;
+ /* these 3 variable are created to permit to use the value in the fortran functions
+ because they need double matrix as arguments and we can't cast directly the pointers
+ without having problems , i know that's ugly */
+ double *dblin1 = NULL;
+ double *dblin2 = NULL;
+ double *dblout = NULL;
+
+
+
+ /* Array allocations*/
+ dblin1 = (double*)malloc(sizeof(double) * (unsigned int)columns1 * (unsigned int)lines1);
+ dblin2 = (double*)malloc(sizeof(double) * (unsigned int)columns2 * (unsigned int)lines2);
+ dblout = (double*)malloc(sizeof(double) * (unsigned int)lines1 * (unsigned int)lines2);
+
+
+
+ /*copy and cast all the float value into double value */
+ for ( i = 0 ; i < lines1 * columns1 ; i ++ )
+ {
+ dblin1[i] = (double) in1[i] ;
+ }
+
+ for ( i = 0 ; i < lines2 * columns2 ; i ++ )
+ {
+ dblin2[i] = (double) in2[i] ;
+ }
+
+ dldivma( dblin1 , lines1 , columns1 , dblin2 , lines2 , columns2 , dblout );
+
+
+ for ( i = 0 ; i < min(lines2,columns2) * lines1 ; i++ )
+ {
+ out[i] = (float) dblout[i] ;
+
+ }
+
+ free ( dblin1);
+ free ( dblin2);
+ free ( dblout);
+
+}
diff --git a/src/matrixOperations/division/srdivma.c b/src/matrixOperations/division/srdivma.c
new file mode 100644
index 00000000..a4ecad61
--- /dev/null
+++ b/src/matrixOperations/division/srdivma.c
@@ -0,0 +1,65 @@
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2008-2008 - INRIA - Allan SIMON
+ *
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution. The terms
+ * are also available at
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+
+
+/**** WARNING NOT WORK AT ALL FOR THE MOMENT ***/
+/**** Because of problem of conversion float-> double ****/
+#include "matrixDivision.h"
+#include "lapack.h"
+#include <string.h>
+#include <stdio.h>
+void srdivma ( float* in1, int lines1, int columns1 ,
+ float* in2, int lines2, int columns2 ,
+ float* out ){
+
+ int i = 0 ;
+ /* these 3 variable are created to permit to use the value in the fortran functions
+ because they need double matrix as arguments and we can't cast directly the pointers
+ without having problems , i know that's ugly */
+ double *dblin1 = NULL;
+ double *dblin2 = NULL;
+ double *dblout = NULL;
+
+
+
+ /* Array allocations*/
+ dblin1 = (double*)malloc(sizeof(double) * (unsigned int)columns1 * (unsigned int)lines1);
+ dblin2 = (double*)malloc(sizeof(double) * (unsigned int)columns2 * (unsigned int)lines2);
+ dblout = (double*)malloc(sizeof(double) * (unsigned int)lines1 * (unsigned int)lines2);
+
+
+
+ /*copy and cast all the float value into double value */
+ for ( i = 0 ; i < lines1 * columns1 ; i ++ )
+ {
+ dblin1[i] = (double) in1[i] ;
+ }
+
+ for ( i = 0 ; i < lines2 * columns2 ; i ++ )
+ {
+ dblin2[i] = (double) in2[i] ;
+ }
+
+ drdivma( dblin1 , lines1 , columns1 , dblin2 , lines2 , columns2 , dblout );
+
+
+ for ( i = 0 ; i < min(lines2,columns2) * lines1 ; i++ )
+ {
+ out[i] = (float) dblout[i] ;
+
+ }
+
+ free ( dblin1);
+ free ( dblin2);
+ free ( dblout);
+
+}
diff --git a/src/matrixOperations/division/zldivma.c b/src/matrixOperations/division/zldivma.c
new file mode 100644
index 00000000..c09a859e
--- /dev/null
+++ b/src/matrixOperations/division/zldivma.c
@@ -0,0 +1,123 @@
+
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2008-2008 - INRIA - Allan SIMON
+ *
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution. The terms
+ * are also available at
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+
+
+#include "matrixDivision.h"
+#include "string.h"
+
+void zldivma( doubleComplex* in1, int lines1, int columns1 ,
+ doubleComplex* in2, int lines2, int columns2 ,
+ doubleComplex* out )
+{
+
+
+ char cNorm = 0;
+ int iExit = 0;
+
+ /*temporary variables*/
+ int iWork = 0;
+ int iInfo = 0;
+ int iMax = 0;
+ int iRank = 0;
+
+ double dblRcond = 0;
+
+ double dblEps = 0;
+ double dblAnorm = 0;
+
+ doubleComplex *pAf = NULL;
+ doubleComplex *pXb = NULL;
+ doubleComplex *pDwork = NULL;
+
+
+ double *pRwork = NULL;
+
+
+ int *pIpiv = NULL;
+ int *pJpvt = NULL;
+
+ iWork = max(2*columns2, min(lines2, columns2) + max(2 * min(lines2, columns2), max(lines2 + 1, min(lines2, columns2) + lines1)));
+
+
+
+ /* Array allocations*/
+
+
+ pAf = (doubleComplex*)malloc(sizeof(doubleComplex) *(unsigned int) lines1 *(unsigned int)columns1);
+ pXb = (doubleComplex*)malloc(sizeof(doubleComplex) *(unsigned int) max(lines1,columns1) *(unsigned int) columns2);
+
+
+ pIpiv = (int*)malloc(sizeof(int) * (unsigned int)columns1);
+ pJpvt = (int*)malloc(sizeof(int) * (unsigned int)columns1);
+ pRwork = (double*)malloc(sizeof(double) * (unsigned int)columns1*2);
+
+
+ cNorm = '1';
+ pDwork = (doubleComplex*)malloc(sizeof(doubleComplex) * (unsigned int)iWork);
+ dblEps = getRelativeMachinePrecision() ;
+ dblAnorm = C2F(zlange)(&cNorm, &lines1, &columns1, in1, &lines1, pDwork);
+
+ if(lines1 == columns1)
+ {
+ cNorm = 'F';
+ C2F(zlacpy)(&cNorm, &columns1, &columns1, in1, &columns1, pAf, &columns1);
+ C2F(zlacpy)(&cNorm, &columns1, &columns2, in2, &columns1, pXb, &columns1);
+ C2F(zgetrf)(&columns1, &columns1, pAf, &columns1, pIpiv, &iInfo);
+ if(iInfo == 0)
+ {
+ cNorm = '1';
+ C2F(zgecon)(&cNorm, &columns1, pAf, &columns1, &dblAnorm, &dblRcond, pDwork, pRwork, &iInfo);
+ if(dblRcond > sqrt(dblEps))
+ {
+ cNorm = 'N';
+ C2F(zgetrs)(&cNorm, &columns1, &columns2, pAf, &columns1, pIpiv, pXb, &columns1, &iInfo);
+ cNorm = 'F';
+ C2F(zlacpy)(&cNorm, &columns1, &columns2, pXb, &columns1, out, &columns1);
+
+ iExit = 1;
+ }
+
+ }
+ }
+
+ if(iExit == 0)
+ {
+ dblRcond = sqrt(dblEps);
+ cNorm = 'F';
+ iMax = max(lines1, columns1);
+ C2F(zlacpy)(&cNorm, &lines1, &columns2, in2, &lines1, pXb, &iMax);
+ memset(pJpvt, 0x00,(unsigned int) sizeof(int) * (unsigned int)columns1);
+ C2F(zgelsy)( &lines1, &columns1, &columns2, in1, &lines1, pXb, &iMax,
+ pJpvt, &dblRcond, &iRank, pDwork, &iWork, pRwork, &iInfo);
+
+ if(iInfo == 0)
+ {
+
+ cNorm = 'F';
+ C2F(zlacpy)(&cNorm, &columns1, &columns2, pXb, &iMax, out, &columns1);
+
+ }
+ }
+
+
+
+
+
+ free(pAf);
+ free(pXb);
+ free(pIpiv);
+ free(pJpvt);
+ free(pRwork);
+ free(pDwork);
+
+}
diff --git a/src/matrixOperations/division/zrdivma.c b/src/matrixOperations/division/zrdivma.c
new file mode 100644
index 00000000..6d48988b
--- /dev/null
+++ b/src/matrixOperations/division/zrdivma.c
@@ -0,0 +1,155 @@
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2008-2008 - INRIA - Allan SIMON
+ *
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution. The terms
+ * are also available at
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+
+#include "matrixDivision.h"
+
+#include <stdio.h>
+#include <string.h>
+
+void zrdivma( doubleComplex* in1, int lines1, int columns1 ,
+ doubleComplex* in2, int lines2, int columns2 ,
+ doubleComplex* out )
+{
+
+ char cNorm = 0;
+ int iExit = 0;
+
+ /*temporary variables*/
+ int iWork = 0;
+ int iInfo = 0;
+ int iMax = 0;
+ double dblRcond = 0;
+
+ double dblEps = 0;
+ double dblAnorm = 0;
+
+
+ doubleComplex *poAf = NULL;
+ doubleComplex *poAt = NULL;
+ doubleComplex *poBt = NULL;
+ doubleComplex *poDwork = NULL;
+
+ int *pRank = NULL;
+ int *pIpiv = NULL;
+ int *pJpvt = NULL;
+ double *pRwork = NULL;
+
+ iWork = max(2*columns2, min(lines2, columns2) + max(2 * min(lines2, columns2), max(lines2 + 1, min(lines2, columns2) + lines1)));
+
+
+
+ /* Array allocations*/
+
+
+ poAf = (doubleComplex*)malloc(sizeof(doubleComplex) *(unsigned int) lines2 *(unsigned int) columns2);
+ poAt = (doubleComplex*)malloc(sizeof(doubleComplex) * (unsigned int)lines2 *(unsigned int) columns2);
+ poBt = (doubleComplex*)malloc(sizeof(doubleComplex) *(unsigned int) max(lines2, columns2) *(unsigned int) lines1);
+
+ pRank = (int*)malloc(sizeof(int));
+ pIpiv = (int*)malloc(sizeof(int) *(unsigned int) columns2);
+ pJpvt = (int*)malloc(sizeof(int) *(unsigned int) lines2);
+ pRwork = (double*)malloc(sizeof(double) * 2 *(unsigned int) lines2);
+
+
+
+ cNorm = '1';
+ poDwork = (doubleComplex*)malloc(sizeof(doubleComplex) *(unsigned int) iWork);
+ dblEps = getRelativeMachinePrecision() ;
+ dblAnorm = C2F(zlange)(&cNorm, &lines2, &columns2, in2, &lines2, poDwork);
+
+ /* hermitian tranpose A (transpose + conjugate )*/
+
+ ztransposea(in2, lines2, columns2, poAt);
+ zconja ( poAt , lines2*columns2 , poAt );
+ {
+ int i,j,ij,ji;
+ for(j = 0 ; j < lines1 ; j++)
+ {
+ for(i = 0 ; i < columns2 ; i++)
+ {
+ ij = i + j * max(lines2, columns2);
+ ji = j + i * lines1;
+
+ poBt[ij] = DoubleComplex (zreals ( in1[ji] ) , - zimags ( in1[ji] ) );
+ }
+ }
+ }
+
+ if(lines2 == columns2)
+ {
+ cNorm = 'F';
+ C2F(zlacpy)(&cNorm, &columns2, &columns2, poAt, &columns1, poAf, &columns2);
+ C2F(zgetrf)(&columns2, &columns2, poAf, &columns2, pIpiv, &iInfo);
+ if(iInfo == 0)
+ {
+ cNorm = '1';
+ C2F(zgecon)(&cNorm, &columns2, poAf, &columns2, &dblAnorm,
+ &dblRcond, poDwork, pRwork, &iInfo);
+ if(dblRcond > sqrt(dblEps))
+ {
+ cNorm = 'N';
+ C2F(zgetrs)(&cNorm, &columns2, &lines1, poAf, &columns2, pIpiv, poBt, &columns2, &iInfo);
+ ztransposea(poBt, columns2, lines2, out);
+
+ iExit = 1;
+ }
+ }
+
+ }
+
+ if(iExit == 0)
+ {
+ dblRcond = sqrt(dblEps);
+ cNorm = 'F';
+ iMax = max(lines2, columns2);
+
+ memset(pJpvt, 0x00,(unsigned int) sizeof(int) *(unsigned int) lines2);
+ C2F(zgelsy)(&columns2, &lines2, &lines1, poAt, &columns2, poBt, &iMax,
+ pJpvt, &dblRcond, &pRank[0], poDwork, &iWork, pRwork, &iInfo);
+
+ if(iInfo == 0)
+ {
+
+ /*// TransposeRealMatrix(pBt, lines1, lines2, _pdblRealOut, Max(lines1,columns1), lines2);
+
+ //Mega caca de la mort qui tue des ours a mains nues
+ //mais je ne sais pas comment le rendre "beau" :(*/
+ {
+ int i,j,ij,ji;
+ for(j = 0 ; j < lines2 ; j++)
+ {
+ for(i = 0 ; i < lines1 ; i++)
+ {
+ ij = i + j * lines1;
+ ji = j + i * max(lines2, columns2);
+ out[ij] = DoubleComplex ( zreals( poBt[ji]) , -zimags ( poBt[ji]));
+ printf ( "\n\t\t\t<debug>%e + %e\n " , zreals( poBt[ji]) , -zimags ( poBt[ji]));
+ }
+ }
+ }
+ }
+ }
+
+
+
+ free(poAf);
+ free(poAt);
+ free(poBt);
+ free(pRank);
+ free(pIpiv);
+ free(pJpvt);
+ free(pRwork);
+ free(poDwork);
+
+}
+
+
generated by cgit (git 2.34.1) at 2025-03-22 11:38:20 +0000