2019-06-19 14:34:30 +02:00
|
|
|
|
/*
|
|
|
|
|
* Copyright © 2004-2011 Ondra Kamenik
|
|
|
|
|
* Copyright © 2019 Dynare Team
|
|
|
|
|
*
|
|
|
|
|
* This file is part of Dynare.
|
|
|
|
|
*
|
|
|
|
|
* Dynare is free software: you can redistribute it and/or modify
|
|
|
|
|
* it under the terms of the GNU General Public License as published by
|
|
|
|
|
* the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
* (at your option) any later version.
|
|
|
|
|
*
|
|
|
|
|
* Dynare is distributed in the hope that it will be useful,
|
|
|
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
* GNU General Public License for more details.
|
|
|
|
|
*
|
|
|
|
|
* You should have received a copy of the GNU General Public License
|
|
|
|
|
* along with Dynare. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
|
*/
|
|
|
|
|
|
2019-01-08 17:12:05 +01:00
|
|
|
|
#include "SchurDecompEig.hh"
|
|
|
|
|
#include "SylvException.hh"
|
|
|
|
|
|
|
|
|
|
#include <dynlapack.h>
|
|
|
|
|
|
2019-04-30 12:58:21 +02:00
|
|
|
|
#include <memory>
|
2019-01-16 17:52:16 +01:00
|
|
|
|
|
2019-03-28 18:56:46 +01:00
|
|
|
|
/* Bubble diagonal 1×1 or 2×2 block from position ‘from’ to position
|
2019-03-27 19:22:35 +01:00
|
|
|
|
‘to’. If an eigenvalue cannot be swapped with its neighbour, the
|
|
|
|
|
neighbour is bubbled also in front. The method returns a new
|
|
|
|
|
position ‘to’, where the original block pointed by ‘to’ happens to
|
|
|
|
|
appear at the end. ‘from’ must be greater than ‘to’.
|
2019-12-20 14:36:20 +01:00
|
|
|
|
*/
|
2019-01-08 17:12:05 +01:00
|
|
|
|
SchurDecompEig::diag_iter
|
|
|
|
|
SchurDecompEig::bubbleEigen(diag_iter from, diag_iter to)
|
|
|
|
|
{
|
|
|
|
|
diag_iter run = from;
|
|
|
|
|
while (run != to)
|
|
|
|
|
{
|
|
|
|
|
diag_iter runm = run;
|
|
|
|
|
if (!tryToSwap(run, runm) && runm == to)
|
2019-01-25 15:27:20 +01:00
|
|
|
|
++to;
|
2019-01-08 17:12:05 +01:00
|
|
|
|
else
|
|
|
|
|
{
|
2019-03-27 19:22:35 +01:00
|
|
|
|
/* Bubble all eigenvalues from runm(incl.) to run(excl.),
|
|
|
|
|
this includes either bubbling generated eigenvalues due
|
|
|
|
|
to split, or an eigenvalue which couldn't be swapped */
|
2019-01-08 17:12:05 +01:00
|
|
|
|
while (runm != run)
|
|
|
|
|
{
|
|
|
|
|
to = bubbleEigen(runm, to);
|
|
|
|
|
++runm;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
return to;
|
|
|
|
|
}
|
|
|
|
|
|
2019-03-27 19:22:35 +01:00
|
|
|
|
/* This tries to swap two neighbouring eigenvalues, ‘it’ and ‘--it’,
|
|
|
|
|
and returns ‘itadd’. If the blocks can be swapped, new eigenvalues
|
2019-03-28 18:56:46 +01:00
|
|
|
|
can emerge due to possible 2×2 block splits. ‘it’ then points to
|
2019-03-27 19:22:35 +01:00
|
|
|
|
the last eigenvalue coming from block pointed by ‘it’ at the
|
|
|
|
|
begining, and ‘itadd’ points to the first. On swap failure, ‘it’ is
|
|
|
|
|
not changed, and ‘itadd’ points to previous eignevalue (which must
|
|
|
|
|
be moved backwards before). In either case, it is necessary to
|
|
|
|
|
resolve eigenvalues from ‘itadd’ to ‘it’, before the ‘it’ can be
|
|
|
|
|
resolved.
|
|
|
|
|
The success is signaled by returned true.
|
2019-12-20 14:36:20 +01:00
|
|
|
|
*/
|
2019-01-08 17:12:05 +01:00
|
|
|
|
bool
|
|
|
|
|
SchurDecompEig::tryToSwap(diag_iter &it, diag_iter &itadd)
|
|
|
|
|
{
|
|
|
|
|
itadd = it;
|
|
|
|
|
--itadd;
|
|
|
|
|
|
2019-01-24 13:08:05 +01:00
|
|
|
|
lapack_int n = getDim(), ldt = getT().getLD(), ldq = getQ().getLD();
|
2019-03-08 15:32:13 +01:00
|
|
|
|
lapack_int ifst = it->getIndex() + 1;
|
|
|
|
|
lapack_int ilst = itadd->getIndex() + 1;
|
2019-04-30 12:58:21 +02:00
|
|
|
|
auto work = std::make_unique<double[]>(n);
|
2019-01-08 17:12:05 +01:00
|
|
|
|
lapack_int info;
|
2019-04-30 12:58:21 +02:00
|
|
|
|
dtrexc("V", &n, getT().base(), &ldt, getQ().base(), &ldq, &ifst, &ilst, work.get(),
|
2019-01-08 17:12:05 +01:00
|
|
|
|
&info);
|
|
|
|
|
if (info < 0)
|
2019-01-16 17:52:16 +01:00
|
|
|
|
throw SYLV_MES_EXCEPTION("Wrong argument to dtrexc.");
|
2019-01-08 17:12:05 +01:00
|
|
|
|
|
|
|
|
|
if (info == 0)
|
|
|
|
|
{
|
|
|
|
|
// swap successful
|
|
|
|
|
getT().swapDiagLogically(itadd);
|
2019-03-28 18:56:46 +01:00
|
|
|
|
// check for 2×2 block splits
|
2019-01-08 17:12:05 +01:00
|
|
|
|
getT().checkDiagConsistency(it);
|
|
|
|
|
getT().checkDiagConsistency(itadd);
|
2019-03-27 19:22:35 +01:00
|
|
|
|
// and go back by ‘it’ in NEW eigenvalue set
|
2019-01-08 17:12:05 +01:00
|
|
|
|
--it;
|
|
|
|
|
return true;
|
|
|
|
|
}
|
|
|
|
|
return false;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
void
|
|
|
|
|
SchurDecompEig::orderEigen()
|
|
|
|
|
{
|
|
|
|
|
diag_iter run = getT().diag_begin();
|
|
|
|
|
diag_iter runp = run;
|
|
|
|
|
++runp;
|
|
|
|
|
double last_size = 0.0;
|
|
|
|
|
while (runp != getT().diag_end())
|
|
|
|
|
{
|
|
|
|
|
diag_iter least = getT().findNextLargerBlock(run, getT().diag_end(),
|
|
|
|
|
last_size);
|
2019-03-08 15:32:13 +01:00
|
|
|
|
last_size = least->getSize();
|
2019-01-08 17:12:05 +01:00
|
|
|
|
if (run == least)
|
|
|
|
|
++run;
|
|
|
|
|
else
|
|
|
|
|
run = bubbleEigen(least, run);
|
|
|
|
|
runp = run;
|
|
|
|
|
++runp;
|
|
|
|
|
}
|
|
|
|
|
}
|