* Bug #4405 fixed - qr() was underspecified in documentation.
[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                         if (GetType(2)==sci_matrix)
49                         {
50                                 snd = (double *) GetData(2);
51                                 tol = snd[2];
52                         }
53                         else
54                         {
55                                 Scierror(999,_("%s: Wrong type for input argument #%d: Real scalar expected.\n"),
56                                 fname,2);
57                                 return 0;
58                         }
59                 }
60                 else 
61                 {
62                         tol = -1;Rhs=1;
63                 }
64
65                 switch (Cmplx) 
66                 {
67                         case REAL :
68                                 ret = C2F(doldqr)(&tol,"qr",2L);
69                         break;
70                         case COMPLEX :
71                                 ret = C2F(zoldqr)(&tol,"qr",2L);
72                         break;
73                         default :
74                                 Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
75                                 fname,1);
76                         return 0;
77                 }
78                 return 0;
79         }
80
81         switch (Rhs) 
82         {
83                 case 1:   /*   qr(A)   */
84                         switch (Cmplx) 
85                         {
86                                 case REAL :
87                                         ret = C2F(intdgeqpf3)("qr",2L);
88                                 break;
89                                 case COMPLEX :
90                                         ret = C2F(intzgeqpf3)("qr",2L);
91                                 break;
92                                 default :
93                                         Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
94                                         fname,1);
95                                 break;
96                         }
97                 break;
98
99                 case 2 :   /*   qr(A, something)   */
100                         header2 = (int *) GetData(2);
101                         switch (header2[0]) 
102                         {
103                                 case STRING  :
104                                 /* Economy size:  ...=qr(A,"e")  */
105                                         switch (Cmplx) 
106                                         {
107                                                 case REAL :
108                                                 ret = C2F(intdgeqpf4)("qr",2L);
109                                                 break;
110
111                                                 case COMPLEX :
112                                                 ret = C2F(intzgeqpf4)("qr",2L);
113                                                 break;
114
115                                                 default :
116                                                 Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
117                                                 fname,1);
118                                                 break;
119                                         }
120                                 break;
121
122                                 default:
123                                         Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
124                                         fname,2);
125                                 break;
126                         }
127           return 0;
128   default :
129           Scierror(999,_("%s: Wrong type for input argument #%d: Real or Complex matrix expected.\n"),
130                                 fname,1);
131           break;
132         }
133         return 0;
134 }
135 /*--------------------------------------------------------------------------*/