GNU Octave  4.4.1
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
gsvd.cc
Go to the documentation of this file.
1 /*
2 
3 Copyright (C) 2016-2018 Barbara Lócsi
4 Copyright (C) 2006 Pascal Dupuis <Pascal.Dupuis@uclouvain.be>
5 Copyright (C) 1996, 1997 John W. Eaton
6 
7 This file is part of Octave.
8 
9 Octave is free software: you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
13 
14 Octave is distributed in the hope that it will be useful, but
15 WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
18 
19 You should have received a copy of the GNU General Public License
20 along with Octave; see the file COPYING. If not, see
21 <https://www.gnu.org/licenses/>.
22 
23 */
24 
25 #ifdef HAVE_CONFIG_H
26 # include <config.h>
27 #endif
28 
29 #include <vector>
30 
31 #include "CMatrix.h"
32 #include "dDiagMatrix.h"
33 #include "dMatrix.h"
34 #include "fCMatrix.h"
35 #include "fDiagMatrix.h"
36 #include "fMatrix.h"
37 #include "gsvd.h"
38 #include "lo-error.h"
39 #include "lo-lapack-proto.h"
40 #include "oct-shlib.h"
41 
42 static std::map<std::string, void *> gsvd_fcn;
43 
44 static bool have_DGGSVD3 = false;
45 static bool gsvd_initialized = false;
46 
47 /* Hack to stringize macro results. */
48 #define xSTRINGIZE(x) #x
49 #define STRINGIZE(x) xSTRINGIZE(x)
50 
51 void initialize_gsvd (void)
52 {
53  if (gsvd_initialized)
54  return;
55 
56  octave::dynamic_library libs ("");
57  if (! libs)
58  {
59  // FIXME: Should we throw an error if we cannot check the libraries?
60  have_DGGSVD3 = false;
61  return;
62  }
63 
64  have_DGGSVD3 = (libs.search (STRINGIZE (F77_FUNC (dggsvd3, DGGSVD3)))
65  != nullptr);
66 
67  if (have_DGGSVD3)
68  {
69  gsvd_fcn["dg"] = libs.search (STRINGIZE (F77_FUNC (dggsvd3, DGGSVD3)));
70  gsvd_fcn["sg"] = libs.search (STRINGIZE (F77_FUNC (sggsvd3, SGGSVD3)));
71  gsvd_fcn["zg"] = libs.search (STRINGIZE (F77_FUNC (zggsvd3, ZGGSVD3)));
72  gsvd_fcn["cg"] = libs.search (STRINGIZE (F77_FUNC (cggsvd3, CGGSVD3)));
73  }
74  else
75  {
76  gsvd_fcn["dg"] = libs.search (STRINGIZE (F77_FUNC (dggsvd, DGGSVD)));
77  gsvd_fcn["sg"] = libs.search (STRINGIZE (F77_FUNC (sggsvd, SGGSVD)));
78  gsvd_fcn["zg"] = libs.search (STRINGIZE (F77_FUNC (zggsvd, ZGGSVD)));
79  gsvd_fcn["cg"] = libs.search (STRINGIZE (F77_FUNC (cggsvd, CGGSVD)));
80  }
81  gsvd_initialized = true;
82 }
83 
84 template<class T1>
86 {
87  typedef F77_RET_T (*type)
91  const F77_INT&, // M
92  const F77_INT&, // N
93  const F77_INT&, // P
94  F77_INT &, // K
95  F77_INT &, // L
96  T1*, // A(LDA,N)
97  const F77_INT&, // LDA
98  T1*, // B(LDB,N)
99  const F77_INT&, // LDB
100  T1*, // ALPHA(N)
101  T1*, // BETA(N)
102  T1*, // U(LDU,M)
103  const F77_INT&, // LDU
104  T1*, // V(LDV,P)
105  const F77_INT&, // LDV
106  T1*, // Q(LDQ,N)
107  const F77_INT&, // LDQ
108  T1*, // WORK
109  F77_INT*, // IWORK(N)
110  F77_INT& // INFO
114 };
115 
116 template<class T1>
118 {
119  typedef F77_RET_T (*type)
121  F77_CONST_CHAR_ARG_DECL, // JOBV
122  F77_CONST_CHAR_ARG_DECL, // JOBQ
123  const F77_INT&, // M
124  const F77_INT&, // N
125  const F77_INT&, // P
126  F77_INT &, // K
127  F77_INT &, // L
128  T1*, // A(LDA,N)
129  const F77_INT&, // LDA
130  T1*, // B(LDB,N)
131  const F77_INT&, // LDB
132  T1*, // ALPHA(N)
133  T1*, // BETA(N)
134  T1*, // U(LDU,M)
135  const F77_INT&, // LDU
136  T1*, // V(LDV,P)
137  const F77_INT&, // LDV
138  T1*, // Q(LDQ,N)
139  const F77_INT&, // LDQ
140  T1*, // WORK
141  const F77_INT&, // LWORK
142  F77_INT*, // IWORK(N)
143  F77_INT& // INFO
147 };
148 
149 template<class T1, class T2>
151 {
152  typedef F77_RET_T (*type)
154  F77_CONST_CHAR_ARG_DECL, // JOBV
155  F77_CONST_CHAR_ARG_DECL, // JOBQ
156  const F77_INT&, // M
157  const F77_INT&, // N
158  const F77_INT&, // P
159  F77_INT &, // K
160  F77_INT &, // L
161  T1*, // A(LDA,N)
162  const F77_INT&, // LDA
163  T1*, // B(LDB,N)
164  const F77_INT&, // LDB
165  T2*, // ALPHA(N)
166  T2*, // BETA(N)
167  T1*, // U(LDU,M)
168  const F77_INT&, // LDU
169  T1*, // V(LDV,P)
170  const F77_INT&, // LDV
171  T1*, // Q(LDQ,N)
172  const F77_INT&, // LDQ
173  T1*, // WORK
174  T2*, // RWORK
175  F77_INT*, // IWORK(N)
176  F77_INT& // INFO
180 };
181 
182 template<class T1, class T2>
184 {
185  typedef F77_RET_T (*type)
187  F77_CONST_CHAR_ARG_DECL, // JOBV
188  F77_CONST_CHAR_ARG_DECL, // JOBQ
189  const F77_INT&, // M
190  const F77_INT&, // N
191  const F77_INT&, // P
192  F77_INT &, // K
193  F77_INT &, // L
194  T1*, // A(LDA,N)
195  const F77_INT&, // LDA
196  T1*, // B(LDB,N)
197  const F77_INT&, // LDB
198  T2*, // ALPHA(N)
199  T2*, // BETA(N)
200  T1*, // U(LDU,M)
201  const F77_INT&, // LDU
202  T1*, // V(LDV,P)
203  const F77_INT&, // LDV
204  T1*, // Q(LDQ,N)
205  const F77_INT&, // LDQ
206  T1*, // WORK
207  const F77_INT&, // LWORK
208  T2*, // RWORK
209  F77_INT*, // IWORK(N)
210  F77_INT& // INFO
214 };
215 
216 // template specializations
225 
226 namespace octave
227 {
228  namespace math
229  {
230  template <>
231  void
232  gsvd<Matrix>::ggsvd (char& jobu, char& jobv, char& jobq, F77_INT m,
233  F77_INT n, F77_INT p, F77_INT& k, F77_INT& l,
234  double *tmp_dataA, F77_INT m1, double *tmp_dataB,
235  F77_INT p1, Matrix& alpha, Matrix& beta, double *u,
236  F77_INT nrow_u, double *v, F77_INT nrow_v, double *q,
237  F77_INT nrow_q, Matrix& work, F77_INT lwork,
238  F77_INT *iwork, F77_INT& info)
239  {
240  if (! gsvd_initialized)
241  initialize_gsvd ();
242 
243  if (have_DGGSVD3)
244  {
245  dggsvd3_type f_ptr = reinterpret_cast<dggsvd3_type> (gsvd_fcn["dg"]);
246  f_ptr (F77_CONST_CHAR_ARG2 (&jobu, 1),
247  F77_CONST_CHAR_ARG2 (&jobv, 1),
248  F77_CONST_CHAR_ARG2 (&jobq, 1),
249  m, n, p, k, l, tmp_dataA, m1, tmp_dataB, p1,
250  alpha.fortran_vec (), beta.fortran_vec (),
251  u, nrow_u, v, nrow_v, q, nrow_q,
252  work.fortran_vec (), lwork, iwork, info
253  F77_CHAR_ARG_LEN (1)
254  F77_CHAR_ARG_LEN (1)
255  F77_CHAR_ARG_LEN (1));
256  }
257  else
258  {
259  dggsvd_type f_ptr = reinterpret_cast<dggsvd_type> (gsvd_fcn["dg"]);
260  f_ptr (F77_CONST_CHAR_ARG2 (&jobu, 1),
261  F77_CONST_CHAR_ARG2 (&jobv, 1),
262  F77_CONST_CHAR_ARG2 (&jobq, 1),
263  m, n, p, k, l, tmp_dataA, m1, tmp_dataB, p1,
264  alpha.fortran_vec (), beta.fortran_vec (),
265  u, nrow_u, v, nrow_v, q, nrow_q,
266  work.fortran_vec (), iwork, info
267  F77_CHAR_ARG_LEN (1)
268  F77_CHAR_ARG_LEN (1)
269  F77_CHAR_ARG_LEN (1));
270  }
271  }
272 
273  template <>
274  void
275  gsvd<FloatMatrix>::ggsvd (char& jobu, char& jobv, char& jobq, F77_INT m,
276  F77_INT n, F77_INT p, F77_INT& k, F77_INT& l,
277  float *tmp_dataA, F77_INT m1, float *tmp_dataB,
278  F77_INT p1, FloatMatrix& alpha,
279  FloatMatrix& beta, float *u, F77_INT nrow_u,
280  float *v, F77_INT nrow_v, float *q,
281  F77_INT nrow_q, FloatMatrix& work,
282  F77_INT lwork, F77_INT *iwork, F77_INT& info)
283  {
284  if (! gsvd_initialized)
285  initialize_gsvd ();
286 
287  if (have_DGGSVD3)
288  {
289  sggsvd3_type f_ptr = reinterpret_cast<sggsvd3_type> (gsvd_fcn["sg"]);
290  f_ptr (F77_CONST_CHAR_ARG2 (&jobu, 1),
291  F77_CONST_CHAR_ARG2 (&jobv, 1),
292  F77_CONST_CHAR_ARG2 (&jobq, 1),
293  m, n, p, k, l, tmp_dataA, m1, tmp_dataB, p1,
294  alpha.fortran_vec (), beta.fortran_vec (),
295  u, nrow_u, v, nrow_v, q, nrow_q,
296  work.fortran_vec (), lwork, iwork, info
297  F77_CHAR_ARG_LEN (1)
298  F77_CHAR_ARG_LEN (1)
299  F77_CHAR_ARG_LEN (1));
300  }
301  else
302  {
303  sggsvd_type f_ptr = reinterpret_cast<sggsvd_type> (gsvd_fcn["sg"]);
304  f_ptr (F77_CONST_CHAR_ARG2 (&jobu, 1),
305  F77_CONST_CHAR_ARG2 (&jobv, 1),
306  F77_CONST_CHAR_ARG2 (&jobq, 1),
307  m, n, p, k, l, tmp_dataA, m1, tmp_dataB, p1,
308  alpha.fortran_vec (), beta.fortran_vec (),
309  u, nrow_u, v, nrow_v, q, nrow_q,
310  work.fortran_vec (), iwork, info
311  F77_CHAR_ARG_LEN (1)
312  F77_CHAR_ARG_LEN (1)
313  F77_CHAR_ARG_LEN (1));
314  }
315  }
316 
317  template <>
318  void
319  gsvd<ComplexMatrix>::ggsvd (char& jobu, char& jobv, char& jobq,
320  F77_INT m, F77_INT n, F77_INT p, F77_INT& k,
321  F77_INT& l, Complex *tmp_dataA, F77_INT m1,
322  Complex *tmp_dataB, F77_INT p1, Matrix& alpha,
323  Matrix& beta, Complex *u, F77_INT nrow_u,
324  Complex *v, F77_INT nrow_v, Complex *q,
325  F77_INT nrow_q, ComplexMatrix& work,
326  F77_INT lwork, F77_INT *iwork, F77_INT& info)
327  {
328  if (! gsvd_initialized)
329  initialize_gsvd ();
330 
331  Matrix rwork(2*n, 1);
332  if (have_DGGSVD3)
333  {
334  zggsvd3_type f_ptr = reinterpret_cast<zggsvd3_type> (gsvd_fcn["zg"]);
335  f_ptr (F77_CONST_CHAR_ARG2 (&jobu, 1),
336  F77_CONST_CHAR_ARG2 (&jobv, 1),
337  F77_CONST_CHAR_ARG2 (&jobq, 1),
338  m, n, p, k, l,
339  F77_DBLE_CMPLX_ARG (tmp_dataA), m1,
340  F77_DBLE_CMPLX_ARG (tmp_dataB), p1,
341  alpha.fortran_vec (), beta.fortran_vec (),
342  F77_DBLE_CMPLX_ARG (u), nrow_u,
343  F77_DBLE_CMPLX_ARG (v), nrow_v,
344  F77_DBLE_CMPLX_ARG (q), nrow_q,
346  lwork, rwork.fortran_vec (), iwork, info
347  F77_CHAR_ARG_LEN (1)
348  F77_CHAR_ARG_LEN (1)
349  F77_CHAR_ARG_LEN (1));
350  }
351  else
352  {
353  zggsvd_type f_ptr = reinterpret_cast<zggsvd_type> (gsvd_fcn["zg"]);
354  f_ptr (F77_CONST_CHAR_ARG2 (&jobu, 1),
355  F77_CONST_CHAR_ARG2 (&jobv, 1),
356  F77_CONST_CHAR_ARG2 (&jobq, 1),
357  m, n, p, k, l,
358  F77_DBLE_CMPLX_ARG (tmp_dataA), m1,
359  F77_DBLE_CMPLX_ARG (tmp_dataB), p1,
360  alpha.fortran_vec (), beta.fortran_vec (),
361  F77_DBLE_CMPLX_ARG (u), nrow_u,
362  F77_DBLE_CMPLX_ARG (v), nrow_v,
363  F77_DBLE_CMPLX_ARG (q), nrow_q,
365  rwork.fortran_vec (), iwork, info
366  F77_CHAR_ARG_LEN (1)
367  F77_CHAR_ARG_LEN (1)
368  F77_CHAR_ARG_LEN (1));
369  }
370  }
371 
372  template <>
373  void
374  gsvd<FloatComplexMatrix>::ggsvd (char& jobu, char& jobv, char& jobq,
375  F77_INT m, F77_INT n, F77_INT p,
376  F77_INT& k, F77_INT& l,
377  FloatComplex *tmp_dataA, F77_INT m1,
378  FloatComplex *tmp_dataB, F77_INT p1,
379  FloatMatrix& alpha, FloatMatrix& beta,
380  FloatComplex *u, F77_INT nrow_u,
381  FloatComplex *v, F77_INT nrow_v,
382  FloatComplex *q, F77_INT nrow_q,
383  FloatComplexMatrix& work, F77_INT lwork,
384  F77_INT *iwork, F77_INT& info)
385  {
386  if (! gsvd_initialized)
387  initialize_gsvd ();
388 
389  FloatMatrix rwork(2*n, 1);
390  if (have_DGGSVD3)
391  {
392  cggsvd3_type f_ptr = reinterpret_cast<cggsvd3_type> (gsvd_fcn["cg"]);
393  f_ptr (F77_CONST_CHAR_ARG2 (&jobu, 1),
394  F77_CONST_CHAR_ARG2 (&jobv, 1),
395  F77_CONST_CHAR_ARG2 (&jobq, 1),
396  m, n, p, k, l,
397  F77_CMPLX_ARG (tmp_dataA), m1,
398  F77_CMPLX_ARG (tmp_dataB), p1,
399  alpha.fortran_vec (), beta.fortran_vec (),
400  F77_CMPLX_ARG (u), nrow_u,
401  F77_CMPLX_ARG (v), nrow_v,
402  F77_CMPLX_ARG (q), nrow_q,
403  F77_CMPLX_ARG (work.fortran_vec ()), lwork,
404  rwork.fortran_vec (), iwork, info
405  F77_CHAR_ARG_LEN (1)
406  F77_CHAR_ARG_LEN (1)
407  F77_CHAR_ARG_LEN (1));
408  }
409  else
410  {
411  cggsvd_type f_ptr = reinterpret_cast<cggsvd_type> (gsvd_fcn["cg"]);
412  f_ptr (F77_CONST_CHAR_ARG2 (&jobu, 1),
413  F77_CONST_CHAR_ARG2 (&jobv, 1),
414  F77_CONST_CHAR_ARG2 (&jobq, 1),
415  m, n, p, k, l,
416  F77_CMPLX_ARG (tmp_dataA), m1,
417  F77_CMPLX_ARG (tmp_dataB), p1,
418  alpha.fortran_vec (), beta.fortran_vec (),
419  F77_CMPLX_ARG (u), nrow_u,
420  F77_CMPLX_ARG (v), nrow_v,
421  F77_CMPLX_ARG (q), nrow_q,
422  F77_CMPLX_ARG (work.fortran_vec ()),
423  rwork.fortran_vec (), iwork, info
424  F77_CHAR_ARG_LEN (1)
425  F77_CHAR_ARG_LEN (1)
426  F77_CHAR_ARG_LEN (1));
427  }
428  }
429 
430  template <typename T>
431  T
433  {
435  {
436  (*current_liboctave_error_handler)
437  ("gsvd: U not computed because type == gsvd::sigma_only");
438  return T ();
439  }
440  else
441  return left_smA;
442  }
443 
444  template <typename T>
445  T
447  {
449  {
450  (*current_liboctave_error_handler)
451  ("gsvd: V not computed because type == gsvd::sigma_only");
452  return T ();
453  }
454  else
455  return left_smB;
456  }
457 
458  template <typename T>
459  T
461  {
463  {
464  (*current_liboctave_error_handler)
465  ("gsvd: X not computed because type == gsvd::sigma_only");
466  return T ();
467  }
468  else
469  return right_sm;
470  }
471 
472  template <typename T>
473  T
474  gsvd<T>::R_matrix (void) const
475  {
476  if (type != gsvd::Type::std)
477  {
478  (*current_liboctave_error_handler)
479  ("gsvd: R not computed because type != gsvd::std");
480  return T ();
481  }
482  else
483  return R;
484  }
485 
486  template <typename T>
487  gsvd<T>::gsvd (const T& a, const T& b, gsvd::Type gsvd_type)
488  {
489  F77_INT info;
490 
491  F77_INT m = to_f77_int (a.rows ());
492  F77_INT n = to_f77_int (a.cols ());
493  F77_INT p = to_f77_int (b.rows ());
494 
495  T atmp = a;
496  P *tmp_dataA = atmp.fortran_vec ();
497 
498  T btmp = b;
499  P *tmp_dataB = btmp.fortran_vec ();
500 
501  char jobu = 'U';
502  char jobv = 'V';
503  char jobq = 'Q';
504 
505  F77_INT nrow_u = m;
506  F77_INT nrow_v = p;
507  F77_INT nrow_q = n;
508 
509  F77_INT k, l;
510 
511  switch (gsvd_type)
512  {
514 
515  // Note: for this case, both jobu and jobv should be 'N', but
516  // there seems to be a bug in dgesvd from Lapack V2.0. To
517  // demonstrate the bug, set both jobu and jobv to 'N' and find
518  // the singular values of [eye(3), eye(3)]. The result is
519  // [-sqrt(2), -sqrt(2), -sqrt(2)].
520  //
521  // For Lapack 3.0, this problem seems to be fixed.
522 
523  jobu = 'N';
524  jobv = 'N';
525  jobq = 'N';
526  nrow_u = nrow_v = nrow_q = 1;
527  break;
528 
529  default:
530  break;
531  }
532 
533  type = gsvd_type;
534 
535  if (! (jobu == 'N' || jobu == 'O'))
536  left_smA.resize (nrow_u, m);
537 
538  P *u = left_smA.fortran_vec ();
539 
540  if (! (jobv == 'N' || jobv == 'O'))
541  left_smB.resize (nrow_v, p);
542 
543  P *v = left_smB.fortran_vec ();
544 
545  if (! (jobq == 'N' || jobq == 'O'))
546  right_sm.resize (nrow_q, n);
547 
548  P *q = right_sm.fortran_vec ();
549 
550  real_matrix alpha (n, 1);
551  real_matrix beta (n, 1);
552 
553  std::vector<F77_INT> iwork (n);
554 
555  if (! gsvd_initialized)
556  initialize_gsvd ();
557 
558  F77_INT lwork;
559  if (have_DGGSVD3)
560  {
561  lwork = -1;
562  T work_tmp (1, 1);
563 
564  gsvd<T>::ggsvd (jobu, jobv, jobq, m, n, p, k, l,
565  tmp_dataA, m, tmp_dataB, p, alpha, beta, u,
566  nrow_u, v, nrow_v, q, nrow_q, work_tmp, lwork,
567  iwork.data (), info);
568 
569  lwork = static_cast<F77_INT> (std::abs (work_tmp(0, 0)));
570  }
571  else
572  {
573  lwork = 3*n;
574  lwork = (lwork > m ? lwork : m);
575  lwork = (lwork > p ? lwork : p) + n;
576  }
577  info = 0;
578 
579  T work (lwork, 1);
580 
581  gsvd<T>::ggsvd (jobu, jobv, jobq, m, n, p, k, l,
582  tmp_dataA, m, tmp_dataB, p, alpha, beta, u,
583  nrow_u, v, nrow_v, q, nrow_q, work, lwork, iwork.data (),
584  info);
585 
586  if (info < 0)
587  (*current_liboctave_error_handler) ("*ggsvd.f: argument %d illegal",
588  -info);
589  else
590  {
591  if (info > 0)
592  (*current_liboctave_error_handler)
593  ("*ggsvd.f: Jacobi-type procedure failed to converge.");
594  else
595  {
596  F77_INT i, j;
597 
599  {
600  R.resize(k+l, k+l);
601  int astart = n-k-l;
602  if (m - k - l >= 0)
603  {
604  astart = n-k-l;
605  // R is stored in A(1:K+L,N-K-L+1:N)
606  for (i = 0; i < k+l; i++)
607  for (j = 0; j < k+l; j++)
608  R.xelem (i, j) = atmp.xelem (i, astart + j);
609  }
610  else
611  {
612  // (R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N),
613  // ( 0 R22 R23 )
614 
615  for (i = 0; i < m; i++)
616  for (j = 0; j < k+l; j++)
617  R.xelem (i, j) = atmp.xelem (i, astart + j);
618  // and R33 is stored in B(M-K+1:L,N+M-K-L+1:N)
619  for (i = k+l-1; i >=m; i--)
620  {
621  for (j = 0; j < m; j++)
622  R.xelem(i, j) = 0.0;
623  for (j = m; j < k+l; j++)
624  R.xelem (i, j) = btmp.xelem (i - k, astart + j);
625  }
626  }
627  }
628 
629  if (m-k-l >= 0)
630  {
631  // Fills in C and S
632  sigmaA.resize (l, l);
633  sigmaB.resize (l, l);
634  for (i = 0; i < l; i++)
635  {
636  sigmaA.dgxelem(i) = alpha.elem(k+i);
637  sigmaB.dgxelem(i) = beta.elem(k+i);
638  }
639  }
640  else
641  {
642  // Fills in C and S
643  sigmaA.resize (m-k, m-k);
644  sigmaB.resize (m-k, m-k);
645  for (i = 0; i < m-k; i++)
646  {
647  sigmaA.dgxelem(i) = alpha.elem(k+i);
648  sigmaB.dgxelem(i) = beta.elem(k+i);
649  }
650  }
651  }
652  }
653  }
654 
655  // Instantiations we need.
656  template class gsvd<Matrix>;
657  template class gsvd<FloatMatrix>;
658  template class gsvd<ComplexMatrix>;
659  template class gsvd<FloatComplexMatrix>;
660  }
661 }
static bool gsvd_initialized
Definition: gsvd.cc:45
T::value_type P
Definition: gsvd.h:90
F77_RET_T(* type)(F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, const F77_INT &, const F77_INT &, const F77_INT &, F77_INT &, F77_INT &, T1 *, const F77_INT &, T1 *, const F77_INT &, T2 *, T2 *, T1 *, const F77_INT &, T1 *, const F77_INT &, T1 *, const F77_INT &, T1 *, const F77_INT &, T2 *, F77_INT *, F77_INT &F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL)
Definition: gsvd.cc:186
F77_RET_T const F77_INT F77_INT const F77_DBLE F77_DBLE const F77_INT F77_DBLE const F77_INT F77_INT F77_INT F77_DBLE F77_DBLE const F77_INT F77_INT &F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL
#define F77_DBLE_CMPLX_ARG(x)
Definition: f77-fcn.h:315
real_ggsvd3_ptr< F77_REAL >::type sggsvd3_type
Definition: gsvd.cc:219
comp_ggsvd3_ptr< F77_CMPLX, F77_REAL >::type cggsvd3_type
Definition: gsvd.cc:223
for large enough k
Definition: lu.cc:617
const T * fortran_vec(void) const
Definition: Array.h:584
T::real_matrix_type real_matrix
Definition: gsvd.h:91
comp_ggsvd_ptr< F77_CMPLX, F77_REAL >::type cggsvd_type
Definition: gsvd.cc:224
static T abs(T x)
Definition: pr-output.cc:1696
T R_matrix(void) const
Definition: gsvd.cc:474
void initialize_gsvd(void)
Definition: gsvd.cc:51
u
Definition: lu.cc:138
F77_RET_T F77_CONST_CHAR_ARG_DECL
F77_RET_T(* type)(F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, const F77_INT &, const F77_INT &, const F77_INT &, F77_INT &, F77_INT &, T1 *, const F77_INT &, T1 *, const F77_INT &, T2 *, T2 *, T1 *, const F77_INT &, T1 *, const F77_INT &, T1 *, const F77_INT &, T1 *, T2 *, F77_INT *, F77_INT &F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL)
Definition: gsvd.cc:153
F77_RET_T(F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, const F77_INT &, const F77_INT &, const F77_INT &, F77_INT &, F77_INT &, F77_DBLE *, const F77_INT &, F77_DBLE *, const F77_INT &, F77_DBLE *, F77_DBLE *, F77_DBLE *, const F77_INT &, F77_DBLE *, const F77_INT &, F77_DBLE *, const F77_INT &, F77_DBLE *, F77_INT *, F77_INT &F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL)
calling an anonymous function involves an overhead quite comparable to the overhead of an m file function Passing a handle to a built in function is because the interpreter is not involved in the internal loop For a
Definition: cellfun.cc:400
comp_ggsvd3_ptr< F77_DBLE_CMPLX, F77_DBLE >::type zggsvd3_type
Definition: gsvd.cc:221
gsvd(void)
Definition: gsvd.h:47
static octave::math::gsvd< T >::Type gsvd_type(int nargout)
Definition: gsvd.cc:45
T left_singular_matrix_B(void) const
Definition: gsvd.cc:446
idx type
Definition: ov.cc:3114
Definition: dMatrix.h:36
F77_RET_T(* type)(F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, const F77_INT &, const F77_INT &, const F77_INT &, F77_INT &, F77_INT &, T1 *, const F77_INT &, T1 *, const F77_INT &, T1 *, T1 *, T1 *, const F77_INT &, T1 *, const F77_INT &, T1 *, const F77_INT &, T1 *, F77_INT *, F77_INT &F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL)
Definition: gsvd.cc:88
F77_RET_T F77_FUNC(xerbla, XERBLA)
Definition: xerbla.c:57
F77_RET_T(* type)(F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, const F77_INT &, const F77_INT &, const F77_INT &, F77_INT &, F77_INT &, T1 *, const F77_INT &, T1 *, const F77_INT &, T1 *, T1 *, T1 *, const F77_INT &, T1 *, const F77_INT &, T1 *, const F77_INT &, T1 *, const F77_INT &, F77_INT *, F77_INT &F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL)
Definition: gsvd.cc:120
static bool have_DGGSVD3
Definition: gsvd.cc:44
#define F77_CMPLX_ARG(x)
Definition: f77-fcn.h:309
octave_f77_int_type F77_INT
Definition: f77-fcn.h:305
p
Definition: lu.cc:138
T left_singular_matrix_A(void) const
Definition: gsvd.cc:432
#define STRINGIZE(x)
Definition: gsvd.cc:49
real_ggsvd3_ptr< F77_DBLE >::type dggsvd3_type
Definition: gsvd.cc:217
b
Definition: cellfun.cc:400
T right_singular_matrix(void) const
Definition: gsvd.cc:460
comp_ggsvd_ptr< F77_DBLE_CMPLX, F77_DBLE >::type zggsvd_type
Definition: gsvd.cc:222
for i
Definition: data.cc:5264
void ggsvd(char &jobu, char &jobv, char &jobq, octave_f77_int_type m, octave_f77_int_type n, octave_f77_int_type p, octave_f77_int_type &k, octave_f77_int_type &l, P *tmp_dataA, octave_f77_int_type m1, P *tmp_dataB, octave_f77_int_type p1, real_matrix &alpha, real_matrix &beta, P *u, octave_f77_int_type nrow_u, P *v, octave_f77_int_type nrow_v, P *q, octave_f77_int_type nrow_q, T &work, octave_f77_int_type lwork, octave_f77_int_type *iwork, octave_f77_int_type &info)
real_ggsvd_ptr< F77_DBLE >::type dggsvd_type
Definition: gsvd.cc:218
std::complex< float > FloatComplex
Definition: oct-cmplx.h:32
std::complex< double > Complex
Definition: oct-cmplx.h:31
real_ggsvd_ptr< F77_REAL >::type sggsvd_type
Definition: gsvd.cc:220
void * search(const std::string &nm, name_mangler mangler=nullptr) const
Definition: oct-shlib.h:172
static std::map< std::string, void * > gsvd_fcn
Definition: gsvd.cc:42