comparison liboctave/dbleHESS.cc @ 1253:bb67a902760b

[project @ 1995-04-11 16:35:23 by jwe]
author jwe
date Tue, 11 Apr 1995 16:35:23 +0000
parents 97eac19837dc
children f93b7fa5e113
comparison
equal deleted inserted replaced
1252:ccb22498f289 1253:bb67a902760b
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 (dgebal) (const char*, const int&, double*, 35 int F77_FCN (dgebal, DGEBAL) (const char*, const int&, double*,
36 const int&, int&, int&, double*, 36 const int&, int&, int&, double*,
37 int&, long, long); 37 int&, long, long);
38 38
39 int F77_FCN (dgehrd) (const int&, const int&, const int&, 39 int F77_FCN (dgehrd, DGEHRD) (const int&, const int&, const int&,
40 double*, const int&, double*, double*, 40 double*, const int&, double*, double*,
41 const int&, int&, long, long); 41 const int&, int&, long, long);
42 42
43 int F77_FCN (dorghr) (const int&, const int&, const int&, 43 int F77_FCN (dorghr, DORGHR) (const int&, const int&, const int&,
44 double*, const int&, double*, double*, 44 double*, const int&, double*, double*,
45 const int&, int&, long, long); 45 const int&, int&, long, long);
46 46
47 int F77_FCN (dgebak) (const char*, const char*, const int&, const int&, 47 int F77_FCN (dgebak, DGEBAK) (const char*, const char*, const int&,
48 const int&, double*, const int&, double*, const int&, 48 const int&, const int&, double*,
49 int&, long, long); 49 const int&, double*, const int&, int&,
50 long, long);
50 } 51 }
51 52
52 int 53 int
53 HESS::init (const Matrix& a) 54 HESS::init (const Matrix& a)
54 { 55 {
74 double *tau = new double [n+1]; 75 double *tau = new double [n+1];
75 double *scale = new double [n]; 76 double *scale = new double [n];
76 double *z = new double [n*n]; 77 double *z = new double [n*n];
77 double *work = new double [lwork]; 78 double *work = new double [lwork];
78 79
79 F77_FCN (dgebal) (jobbal, n, h, n, ilo, ihi, scale, info, 1L, 1L); 80 F77_FCN (dgebal, DGEBAL) (jobbal, n, h, n, ilo, ihi, scale, info,
81 1L, 1L);
80 82
81 F77_FCN (dgehrd) (n, ilo, ihi, h, n, tau, work, lwork, info, 1L, 1L); 83 F77_FCN (dgehrd, DGEHRD) (n, ilo, ihi, h, n, tau, work, lwork, info,
84 1L, 1L);
82 85
83 copy (z, h, n*n); 86 copy (z, h, n*n);
84 87
85 F77_FCN (dorghr) (n, ilo, ihi, z, n, tau, work, lwork, info, 1L, 1L); 88 F77_FCN (dorghr, DORGHR) (n, ilo, ihi, z, n, tau, work, lwork, info,
89 1L, 1L);
86 90
87 F77_FCN (dgebak) (jobbal, side, n, ilo, ihi, scale, n, z, n, info, 1L, 1L); 91 F77_FCN (dgebak, DGEBAK) (jobbal, side, n, ilo, ihi, scale, n, z, n,
92 info, 1L, 1L);
88 93
89 // We need to clear out all of the area below the sub-diagonal which was used 94 // We need to clear out all of the area below the sub-diagonal which was used
90 // to store the unitary matrix. 95 // to store the unitary matrix.
91 96
92 hess_mat = Matrix (h, n, n); 97 hess_mat = Matrix (h, n, n);