Mercurial > hg > octave-max

comparison liboctave/CmplxSCHUR.cc @ 1251:97eac19837dc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1995-04-11 15:58:32 by jwe]
author jwe
date Tue, 11 Apr 1995 15:58:32 +0000
parents b6360f2d4fa6
children bb67a902760b
comparison
equal deleted inserted replaced
1250:5cca5ae20299 1251:97eac19837dc
30 #include "lo-error.h" 30 #include "lo-error.h"
31 #include "f77-uscore.h" 31 #include "f77-uscore.h"
32 32
33 extern "C" 33 extern "C"
34 { 34 {
35 int F77_FCN (zgeesx) (const char*, const char*, int (*)(Complex*), 35 int F77_FCN (zgeesx) (const char*, const char*, int (*)(const Complex&),
36 const char*, const int*, Complex*, const int*, 36 const char*, const int&, Complex*, const int&,
37 int*, Complex*, Complex*, const int*, double*, 37 int&, Complex*, Complex*, const int&, double&,
38 double*, Complex*, const int*, double*, int*, 38 double&, Complex*, const int&, double*, int*,
39 int*, long, long); 39 int&, long, long);
40 } 40 }
41 41
42 static int 42 static int
43 complex_select_ana (Complex *a) 43 complex_select_ana (const Complex& a)
44 { 44 {
45 return a->real () < 0.0; 45 return a.real () < 0.0;
46 } 46 }
47 47
48 static int 48 static int
49 complex_select_dig (Complex *a) 49 complex_select_dig (const Complex& a)
50 { 50 {
51 return (abs (*a) < 1.0); 51 return (abs (a) < 1.0);
52 } 52 }
53 53
54 int 54 int
55 ComplexSCHUR::init (const ComplexMatrix& a, const char *ord) 55 ComplexSCHUR::init (const ComplexMatrix& a, const char *ord)
56 { 56 {
61 (*current_liboctave_error_handler) 61 (*current_liboctave_error_handler)
62 ("ComplexSCHUR requires square matrix"); 62 ("ComplexSCHUR requires square matrix");
63 return -1; 63 return -1;
64 } 64 }
65 65
66 char jobvs = 'V'; 66 char *jobvs = "V";
67 char sort; 67 char *sort;
68 if (*ord == 'A' || *ord == 'D' || *ord == 'a' || *ord == 'd') 68 if (*ord == 'A' || *ord == 'D' || *ord == 'a' || *ord == 'd')
69 sort = 'S'; 69 sort = "S";
70 else 70 else
71 sort = 'N'; 71 sort = "N";
72 72
73 char sense = 'N'; 73 char *sense = "N";
74 74
75 int n = a_nc; 75 int n = a_nc;
76 int lwork = 8 * n; 76 int lwork = 8 * n;
77 int info; 77 int info;
78 int sdim; 78 int sdim;
93 Complex *q = new Complex [n*n]; 93 Complex *q = new Complex [n*n];
94 Complex *w = new Complex [n]; 94 Complex *w = new Complex [n];
95 95
96 if (*ord == 'A' || *ord == 'a') 96 if (*ord == 'A' || *ord == 'a')
97 { 97 {
98 F77_FCN (zgeesx) (&jobvs, &sort, complex_select_ana, &sense, 98 F77_FCN (zgeesx) (jobvs, sort, complex_select_ana, sense,
99 &n, s, &n, &sdim, w, q, &n, &rconde, &rcondv, 99 n, s, n, sdim, w, q, n, rconde, rcondv,
100 work, &lwork, rwork, bwork, &info, 1L, 1L); 100 work, lwork, rwork, bwork, info, 1L, 1L);
101 } 101 }
102 else if (*ord == 'D' || *ord == 'd') 102 else if (*ord == 'D' || *ord == 'd')
103 { 103 {
104 F77_FCN (zgeesx) (&jobvs, &sort, complex_select_dig, &sense, 104 F77_FCN (zgeesx) (jobvs, sort, complex_select_dig, sense,
105 &n, s, &n, &sdim, w, q, &n, &rconde, &rcondv, 105 n, s, n, sdim, w, q, n, rconde, rcondv,
106 work, &lwork, rwork, bwork, &info, 1L, 1L); 106 work, lwork, rwork, bwork, info, 1L, 1L);
107 } 107 }
108 else 108 else
109 { 109 {
110 F77_FCN (zgeesx) (&jobvs, &sort, (void *) 0, &sense, &n, s, 110 F77_FCN (zgeesx) (jobvs, sort, (void *) 0, sense, n, s,
111 &n, &sdim, w, q, &n, &rconde, &rcondv, work, 111 n, sdim, w, q, n, rconde, rcondv, work,
112 &lwork, rwork, bwork, &info, 1L, 1L); 112 lwork, rwork, bwork, info, 1L, 1L);
113 } 113 }
114 114
115 schur_mat = ComplexMatrix (s, n, n); 115 schur_mat = ComplexMatrix (s, n, n);
116 unitary_mat = ComplexMatrix (q, n, n); 116 unitary_mat = ComplexMatrix (q, n, n);
117 117