From 765d9c44f94634406eeff50e20e8cdfcf1b7699c Mon Sep 17 00:00:00 2001 From: siddhu8990 Date: Thu, 2 Feb 2017 16:02:41 +0530 Subject: Support for function 'schur' added q --- src/c/linearAlgebra/schur/dschura.c | 111 ++++++++++++++++++++++++++++++++++++ 1 file changed, 111 insertions(+) create mode 100644 src/c/linearAlgebra/schur/dschura.c (limited to 'src/c/linearAlgebra/schur/dschura.c') diff --git a/src/c/linearAlgebra/schur/dschura.c b/src/c/linearAlgebra/schur/dschura.c new file mode 100644 index 00000000..c31ddca2 --- /dev/null +++ b/src/c/linearAlgebra/schur/dschura.c @@ -0,0 +1,111 @@ +/* Copyright (C) 2017 - IIT Bombay - FOSSEE + + 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 + Author: Siddhesh Wani + Organization: FOSSEE, IIT Bombay + Email: toolbox@scilab.in + */ + +/*Fucntion to find schur decomposition of given square matrix */ +#include "schur.h" +#include "lapack.h" +#include "stdlib.h" +#include "string.h" + + +/*flag --> 0: nothing + --> 1: continuous + --> 2: discrete +*/ + +lapack_logical selctg1( double* in1, double* in2); + +double dschura(double* in1, int size, int flag, int nout, double* out1, \ + double* out2) +{ + char JOBVS = 'N'; + char SORT = 'N'; + int SDIM = 0; + int LVDS = size; + int LWORK = 3*size, INFO; + double *WR, *WI, *VS, *WORK; + int *BWORK; + double ret = 0; + double *buf; /*input is copied to buf, since lapack function direclty + modifies the input variable*/ + + /*Used incase of flag > 0*/ + LAPACK_D_SELECT2 selctg = &selctg1; + + if(nout >= 2) JOBVS = 'V'; + if(flag > 0) SORT = 'S'; + + buf = (double*) malloc((double) size*size*sizeof(double)); + WR = (double*) malloc((double) size*sizeof(double)); + WI = (double*) malloc((double) size*sizeof(double)); + VS = (double*) malloc((double) LVDS*size*sizeof(double)); + WORK = (double*) malloc((double) LWORK*sizeof(double)); + BWORK = (int*) malloc((double) size*sizeof(double)); + + + memcpy(buf,in1,size*size*sizeof(double)); + + dgees_(&JOBVS,&SORT,selctg,&size,buf,&size,&SDIM,WR,WI,VS,&LVDS, \ + WORK,&LWORK,BWORK,&INFO); + + /*if (INFO != 0) + { + out1 = NULL; + return 0; + } */ + + if(nout == 1) + { + /*Copy result in in1 to out1*/ + memcpy(out1,buf,size*size*sizeof(double)); + } + else if(nout == 2) + { + if(flag == 0) + { + /*copy in1 to out2 and VS to out1*/ + memcpy(out2,buf,size*size*sizeof(double)); + memcpy(out1,VS,size*size*sizeof(double)); + } + else + { + /*copy VS to out1 and SDIM to out2*/ + memcpy(out1,VS,size*size*sizeof(double)); + ret = SDIM; + } + } + else + { + /*copy VS to out1, SDIM to out2, in1 to out3*/ + memcpy(out1,VS,size*size*sizeof(double)); + memcpy(out2,buf,size*size*sizeof(double)); + ret = SDIM; + } + + free(buf); + free(WI); + free(WR); + free(VS); + free(WORK); + free(BWORK); + + return ret; +} + +lapack_logical selctg1(double* in1, double* in2) +{ + + if(sqrt(*in1**in1+*in2**in2) < 1) + return 1; + else + return 0; +} \ No newline at end of file -- cgit From e7dba33a909e158dffc6ddb3361df10d427db631 Mon Sep 17 00:00:00 2001 From: siddhu8990 Date: Tue, 7 Feb 2017 16:16:31 +0530 Subject: Support for 'lqr' and 'lqe' added --- src/c/linearAlgebra/schur/dschura.c | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) (limited to 'src/c/linearAlgebra/schur/dschura.c') diff --git a/src/c/linearAlgebra/schur/dschura.c b/src/c/linearAlgebra/schur/dschura.c index c31ddca2..79c41976 100644 --- a/src/c/linearAlgebra/schur/dschura.c +++ b/src/c/linearAlgebra/schur/dschura.c @@ -15,14 +15,15 @@ #include "lapack.h" #include "stdlib.h" #include "string.h" - +#include /*flag --> 0: nothing --> 1: continuous --> 2: discrete */ -lapack_logical selctg1( double* in1, double* in2); +lapack_logical selctg11( double* in1, double* in2); +lapack_logical selctg12( double* in1, double* in2); double dschura(double* in1, int size, int flag, int nout, double* out1, \ double* out2) @@ -38,9 +39,15 @@ double dschura(double* in1, int size, int flag, int nout, double* out1, \ double *buf; /*input is copied to buf, since lapack function direclty modifies the input variable*/ - /*Used incase of flag > 0*/ - LAPACK_D_SELECT2 selctg = &selctg1; + /*Used incase of flag > 0*/ + LAPACK_D_SELECT2 selctg; + + if(flag == 1 || flag == 0) + selctg = &selctg11; + else if(flag == 2) + selctg = &selctg12; + if(nout >= 2) JOBVS = 'V'; if(flag > 0) SORT = 'S'; @@ -101,7 +108,15 @@ double dschura(double* in1, int size, int flag, int nout, double* out1, \ return ret; } -lapack_logical selctg1(double* in1, double* in2) +lapack_logical selctg11(double* in1, double* in2) +{ + if(*in1 <= 0) + return 1; + else + return 0; +} + +lapack_logical selctg12(double* in1, double* in2) { if(sqrt(*in1**in1+*in2**in2) < 1) -- cgit From aceeb1fe05a8ff6c126ea9ba166a19249488dbd1 Mon Sep 17 00:00:00 2001 From: siddhu8990 Date: Thu, 13 Apr 2017 10:42:02 +0530 Subject: Functions added - balance,rcond,obscont --- src/c/linearAlgebra/schur/dschura.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/c/linearAlgebra/schur/dschura.c') diff --git a/src/c/linearAlgebra/schur/dschura.c b/src/c/linearAlgebra/schur/dschura.c index 79c41976..802caa81 100644 --- a/src/c/linearAlgebra/schur/dschura.c +++ b/src/c/linearAlgebra/schur/dschura.c @@ -10,7 +10,7 @@ Email: toolbox@scilab.in */ -/*Fucntion to find schur decomposition of given square matrix */ +/*Funtion to find schur decomposition of given square matrix */ #include "schur.h" #include "lapack.h" #include "stdlib.h" -- cgit