Mercurial > octave

comparison liboctave/dbleSCHUR.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
31 #include "f77-uscore.h" 31 #include "f77-uscore.h"
32 32
33 extern "C" 33 extern "C"
34 { 34 {
35 int F77_FCN (dgeesx) (const char*, const char*, 35 int F77_FCN (dgeesx) (const char*, const char*,
36 int (*)(double*, double*), const char*, 36 int (*)(const double&, const double&),
37 const int*, double*, const int*, int*, double*, 37 const char*, const int&, double*, const int&,
38 double*, double*, const int*, double*, double*, 38 int&, double*, double*, double*, const int&,
39 double*, const int*, int*, const int*, int*, 39 double&, double&, double*, const int&, int*,
40 int*, long, long); 40 const int&, int*, int&, long, long);
41 } 41 }
42 42
43 static int 43 static int
44 select_ana (double *a, double *b) 44 select_ana (const double& a, const double& b)
45 { 45 {
46 return (*a < 0.0); 46 return (a < 0.0);
47 } 47 }
48 48
49 static int 49 static int
50 select_dig (double *a, double *b) 50 select_dig (const double& a, const double& b)
51 { 51 {
52 return (hypot (*a, *b) < 1.0); 52 return (hypot (a, b) < 1.0);
53 } 53 }
54 54
55 int 55 int
56 SCHUR::init (const Matrix& a, const char *ord) 56 SCHUR::init (const Matrix& a, const char *ord)
57 { 57 {
61 { 61 {
62 (*current_liboctave_error_handler) ("SCHUR requires square matrix"); 62 (*current_liboctave_error_handler) ("SCHUR 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 68
69 if (*ord == 'A' || *ord == 'D' || *ord == 'a' || *ord == 'd') 69 if (*ord == 'A' || *ord == 'D' || *ord == 'a' || *ord == 'd')
70 sort = 'S'; 70 sort = "S";
71 else 71 else
72 sort = 'N'; 72 sort = "N";
73 73
74 char sense = 'N'; 74 char *sense = "N";
75 75
76 int n = a_nc; 76 int n = a_nc;
77 int lwork = 8 * n; 77 int lwork = 8 * n;
78 int liwork = 1; 78 int liwork = 1;
79 int info; 79 int info;
98 bwork = new int [n]; 98 bwork = new int [n];
99 } 99 }
100 100
101 if (*ord == 'A' || *ord == 'a') 101 if (*ord == 'A' || *ord == 'a')
102 { 102 {
103 F77_FCN (dgeesx) (&jobvs, &sort, select_ana, &sense, &n, s, &n, 103 F77_FCN (dgeesx) (jobvs, sort, select_ana, sense, n, s, n,
104 &sdim, wr, wi, q, &n, &rconde, &rcondv, work, 104 sdim, wr, wi, q, n, rconde, rcondv, work,
105 &lwork, iwork, &liwork, bwork, &info, 1L, 1L); 105 lwork, iwork, liwork, bwork, info, 1L, 1L);
106 } 106 }
107 else if (*ord == 'D' || *ord == 'd') 107 else if (*ord == 'D' || *ord == 'd')
108 { 108 {
109 F77_FCN (dgeesx) (&jobvs, &sort, select_dig, &sense, &n, s, &n, 109 F77_FCN (dgeesx) (jobvs, sort, select_dig, sense, n, s, n,
110 &sdim, wr, wi, q, &n, &rconde, &rcondv, work, 110 sdim, wr, wi, q, n, rconde, rcondv, work,
111 &lwork, iwork, &liwork, bwork, &info, 1L, 1L); 111 lwork, iwork, liwork, bwork, info, 1L, 1L);
112 112
113 } 113 }
114 else 114 else
115 { 115 {
116 F77_FCN (dgeesx) (&jobvs, &sort, (void *) 0, &sense, &n, s, 116 F77_FCN (dgeesx) (jobvs, sort, (void *) 0, sense, n, s,
117 &n, &sdim, wr, wi, q, &n, &rconde, &rcondv, 117 n, sdim, wr, wi, q, n, rconde, rcondv,
118 work, &lwork, iwork, &liwork, bwork, &info, 118 work, lwork, iwork, liwork, bwork, info,
119 1L, 1L); 119 1L, 1L);
120 } 120 }
121 121
122 schur_mat = Matrix (s, n, n); 122 schur_mat = Matrix (s, n, n);
123 unitary_mat = Matrix (q, n, n); 123 unitary_mat = Matrix (q, n, n);