007fdd4f724f889c9a3b025aa994a92e009db171
[scilab.git] / scilab / modules / linear_algebra / sci_gateway / c / sci_qr.c
1
2 /*
3  * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
4  * Copyright (C) ????-2008 - INRIA
5  *
6  * This file must be used under the terms of the CeCILL.
7  * This source file is licensed as described in the file COPYING, which
8  * you should have received as part of this distribution.  The terms
9  * are also available at
10  * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
11  *
12  */
13
14 #include <string.h>
15 #include <stdio.h>
16 #include "stack-c.h"
17 #include "gw_linear_algebra.h"
18 #include "Scierror.h"
19 #include "localization.h"
20 /*--------------------------------------------------------------------------*/
21 extern int C2F(intdgeqpf3)(char *fname, unsigned long fname_len);
22 extern int C2F(intzgeqpf3)(char *fname, unsigned long fname_len);
23 extern int C2F(intdgeqpf4)(char *fname, unsigned long fname_len);
24 extern int C2F(intzgeqpf4)(char *fname, unsigned long fname_len);
25 extern int C2F(doldqr)(double *tol,char *fname, unsigned long fname_len);
26 extern int C2F(zoldqr)(double *tol,char *fname, unsigned long fname_len);
27
28 /*--------------------------------------------------------------------------*/
29 int C2F(intqr)(char *fname,unsigned long fname_len)
30 {
31         int *header1;int *header2;
32         int Cmplx;int ret; double *snd; double tol;
33
34         if (GetType(1)!=sci_matrix) 
35         {
36                 OverLoad(1);
37                 return 0;
38         }
39         header1 = (int *) GetData(1);
40         Cmplx=header1[3];
41
42         if (header1[0] == 10) Cmplx=10;
43
44         if (Lhs==4) 
45         {   /* obsolete : [Q,R,rk,E]=qr(A) or = qr(A,tol)   */
46                 if (Rhs==2) 
47                 {
48                         snd = (double *) GetData(2);
49                         tol = snd[2];
50                 }
51                 else 
52                 {
53                         tol = -1;Rhs=1;
54                 }
55
56                 switch (Cmplx) 
57                 {
58                         case REAL :
59                                 ret = C2F(doldqr)(&tol,"qr",2L);
60                         break;
61                         case COMPLEX :
62                                 ret = C2F(zoldqr)(&tol,"qr",2L);
63                         break;
64                         default :
65                                 Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
66                                 fname,1);
67                         return 0;
68                 }
69                 return 0;
70         }
71
72         switch (Rhs) 
73         {
74                 case 1:   /*   qr(A)   */
75                         switch (Cmplx) 
76                         {
77                                 case REAL :
78                                         ret = C2F(intdgeqpf3)("qr",2L);
79                                 break;
80                                 case COMPLEX :
81                                         ret = C2F(intzgeqpf3)("qr",2L);
82                                 break;
83                                 default :
84                                         Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
85                                         fname,1);
86                                 break;
87                         }
88                 break;
89
90                 case 2 :   /*   qr(A, something)   */
91                         header2 = (int *) GetData(2);
92                         switch (header2[0]) 
93                         {
94                                 case STRING  :
95                                 /* Economy size:  ...=qr(A,"e")  */
96                                         switch (Cmplx) 
97                                         {
98                                                 case REAL :
99                                                 ret = C2F(intdgeqpf4)("qr",2L);
100                                                 break;
101
102                                                 case COMPLEX :
103                                                 ret = C2F(intzgeqpf4)("qr",2L);
104                                                 break;
105
106                                                 default :
107                                                 Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
108                                                 fname,1);
109                                                 break;
110                                         }
111                                 break;
112
113                                 default:
114                                         Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
115                                         fname,2);
116                                 break;
117                         }
118           return 0;
119   default :
120           Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
121                                 fname,1);
122           break;
123         }
124         return 0;
125 }
126 /*--------------------------------------------------------------------------*/