abdelrahman/agent_compositor_test
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
03d1d728f6e25093e0d09315f812e125af0d6774
agent_compositor_test/references/igraph-1.0.1/vendor/lapack/dngets.c
T
Abdelrahman Said a11edf0c53 Add graph references
2026-06-28 13:49:01 +01:00

276 lines
9.2 KiB
C
Raw Blame History

/* -- translated by f2c (version 20240504).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
*/
#include "f2c.h"
/* Table of constant values */
static logical c_true = TRUE_;
static integer c__1 = 1;
/* -----------------------------------------------------------------------
\BeginDoc
\Name: dngets
\Description:
Given the eigenvalues of the upper Hessenberg matrix H,
computes the NP shifts AMU that are zeros of the polynomial of
degree NP which filters out components of the unwanted eigenvectors
corresponding to the AMU's based on some given criteria.
NOTE: call this even in the case of user specified shifts in order
to sort the eigenvalues, and error bounds of H for later use.
\Usage:
call dngets
( ISHIFT, WHICH, KEV, NP, RITZR, RITZI, BOUNDS, SHIFTR, SHIFTI )
\Arguments
ISHIFT Integer. (INPUT)
Method for selecting the implicit shifts at each iteration.
ISHIFT = 0: user specified shifts
ISHIFT = 1: exact shift with respect to the matrix H.
WHICH Character*2. (INPUT)
Shift selection criteria.
'LM' -> want the KEV eigenvalues of largest magnitude.
'SM' -> want the KEV eigenvalues of smallest magnitude.
'LR' -> want the KEV eigenvalues of largest real part.
'SR' -> want the KEV eigenvalues of smallest real part.
'LI' -> want the KEV eigenvalues of largest imaginary part.
'SI' -> want the KEV eigenvalues of smallest imaginary part.
KEV Integer. (INPUT/OUTPUT)
INPUT: KEV+NP is the size of the matrix H.
OUTPUT: Possibly increases KEV by one to keep complex conjugate
pairs together.
NP Integer. (INPUT/OUTPUT)
Number of implicit shifts to be computed.
OUTPUT: Possibly decreases NP by one to keep complex conjugate
pairs together.
RITZR, Double precision array of length KEV+NP. (INPUT/OUTPUT)
RITZI On INPUT, RITZR and RITZI contain the real and imaginary
parts of the eigenvalues of H.
On OUTPUT, RITZR and RITZI are sorted so that the unwanted
eigenvalues are in the first NP locations and the wanted
portion is in the last KEV locations. When exact shifts are
selected, the unwanted part corresponds to the shifts to
be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
are further sorted so that the ones with largest Ritz values
are first.
BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT)
Error bounds corresponding to the ordering in RITZ.
SHIFTR, SHIFTI *** USE deprecated as of version 2.1. ***
\EndDoc
-----------------------------------------------------------------------
\BeginLib
\Local variables:
xxxxxx real
\Routines called:
dsortc ARPACK sorting routine.
dcopy Level 1 BLAS that copies one vector to another .
\Author
Danny Sorensen Phuong Vu
Richard Lehoucq CRPC / Rice University
Dept. of Computational & Houston, Texas
Applied Mathematics
Rice University
Houston, Texas
\Revision history:
xx/xx/92: Version ' 2.1'
\SCCS Information: @(#)
FILE: ngets.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
\Remarks
1. xxxx
\EndLib
-----------------------------------------------------------------------
Subroutine */ int igraphdngets_(integer *ishift, char *which, integer *kev,
integer *np, doublereal *ritzr, doublereal *ritzi, doublereal *bounds,
doublereal *shiftr, doublereal *shifti)
{
/* System generated locals */
integer i__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
real t0, t1;
extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *,
integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer *
, integer *, char *, ftnlen), igrapharscnd_(real *);
integer logfil=6, ndigit=-3, mngets=0;
extern /* Subroutine */ int igraphdsortc_(char *, logical *, integer *,
doublereal *, doublereal *, doublereal *);
integer msglvl;
real tngets=0;
/* %----------------------------------------------------%
| Include files for debugging and timing information |
%----------------------------------------------------%
%------------------%
| Scalar Arguments |
%------------------%
%-----------------%
| Array Arguments |
%-----------------%
%------------%
| Parameters |
%------------%
%---------------%
| Local Scalars |
%---------------%
%----------------------%
| External Subroutines |
%----------------------%
%----------------------%
| Intrinsics Functions |
%----------------------%
%-----------------------%
| Executable Statements |
%-----------------------%
%-------------------------------%
| Initialize timing statistics |
| & message level for debugging |
%-------------------------------%
Parameter adjustments */
--bounds;
--ritzi;
--ritzr;
--shiftr;
--shifti;
/* Function Body */
igrapharscnd_(&t0);
msglvl = mngets;
/* %----------------------------------------------------%
| LM, SM, LR, SR, LI, SI case. |
| Sort the eigenvalues of H into the desired order |
| and apply the resulting order to BOUNDS. |
| The eigenvalues are sorted so that the wanted part |
| are always in the last KEV locations. |
| We first do a pre-processing sort in order to keep |
| complex conjugate pairs together |
%----------------------------------------------------% */
if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) {
i__1 = *kev + *np;
igraphdsortc_("LR", &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]);
} else if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) {
i__1 = *kev + *np;
igraphdsortc_("SR", &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]);
} else if (s_cmp(which, "LR", (ftnlen)2, (ftnlen)2) == 0) {
i__1 = *kev + *np;
igraphdsortc_("LM", &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]);
} else if (s_cmp(which, "SR", (ftnlen)2, (ftnlen)2) == 0) {
i__1 = *kev + *np;
igraphdsortc_("SM", &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]);
} else if (s_cmp(which, "LI", (ftnlen)2, (ftnlen)2) == 0) {
i__1 = *kev + *np;
igraphdsortc_("LM", &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]);
} else if (s_cmp(which, "SI", (ftnlen)2, (ftnlen)2) == 0) {
i__1 = *kev + *np;
igraphdsortc_("SM", &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]);
}
i__1 = *kev + *np;
igraphdsortc_(which, &c_true, &i__1, &ritzr[1], &ritzi[1], &bounds[1]);
/* %-------------------------------------------------------%
| Increase KEV by one if the ( ritzr(np),ritzi(np) ) |
| = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero |
| Accordingly decrease NP by one. In other words keep |
| complex conjugate pairs together. |
%-------------------------------------------------------% */
if (ritzr[*np + 1] - ritzr[*np] == 0. && ritzi[*np + 1] + ritzi[*np] ==
0.) {
--(*np);
++(*kev);
}
if (*ishift == 1) {
/* %-------------------------------------------------------%
| Sort the unwanted Ritz values used as shifts so that |
| the ones with largest Ritz estimates are first |
| This will tend to minimize the effects of the |
| forward instability of the iteration when they shifts |
| are applied in subroutine dnapps. |
| Be careful and use 'SR' since we want to sort BOUNDS! |
%-------------------------------------------------------% */
igraphdsortc_("SR", &c_true, np, &bounds[1], &ritzr[1], &ritzi[1]);
}
igrapharscnd_(&t1);
tngets += t1 - t0;
if (msglvl > 0) {
igraphivout_(&logfil, &c__1, kev, &ndigit, "_ngets: KEV is", (ftnlen)14);
igraphivout_(&logfil, &c__1, np, &ndigit, "_ngets: NP is", (ftnlen)13);
i__1 = *kev + *np;
igraphdvout_(&logfil, &i__1, &ritzr[1], &ndigit, "_ngets: Eigenvalues of c"
"urrent H matrix -- real part", (ftnlen)52);
i__1 = *kev + *np;
igraphdvout_(&logfil, &i__1, &ritzi[1], &ndigit, "_ngets: Eigenvalues of c"
"urrent H matrix -- imag part", (ftnlen)52);
i__1 = *kev + *np;
igraphdvout_(&logfil, &i__1, &bounds[1], &ndigit, "_ngets: Ritz estimates "
"of the current KEV+NP Ritz values", (ftnlen)56);
}
return 0;
/* %---------------%
| End of dngets |
%---------------% */
} /* igraphdngets_ */
Reference in New Issue View Git Blame Copy Permalink