/*  -- translated by f2c (version 20191129).
   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 */
    IGRAPH_F77_SAVE real t0, t1;
    extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *, 
	    integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer *
	    , integer *, char *, ftnlen), igraphsecond_(real *);
    integer logfil, ndigit, 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 */
    igraphsecond_(&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]);
    }

    igraphsecond_(&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_ */

