C
C SPDX-License-Identifier: BSD-3-Clause
C
      SUBROUTINE AB09JX( DICO, STDOM, EVTYPE, N, ALPHA, ER, EI, ED,
     $                   TOLINF, INFO )
C
C     PURPOSE
C
C     To check stability/antistability of finite eigenvalues with
C     respect to a given stability domain.
C
C     ARGUMENTS
C
C     Mode Parameters
C
C     DICO    CHARACTER*1
C             Specifies the type of the stability domain as follows:
C             = 'C':  for a continuous-time system;
C             = 'D':  for a discrete-time system.
C
C     STDOM   CHARACTER*1
C             Specifies whether the domain of interest is of stability
C             type (left part of complex plane or inside of a circle)
C             or of instability type (right part of complex plane or
C             outside of a circle) as follows:
C             = 'S':  stability type domain;
C             = 'U':  instability type domain.
C
C     EVTYPE  CHARACTER*1
C             Specifies whether the eigenvalues arise from a standard
C             or a generalized eigenvalue problem as follows:
C             = 'S':  standard eigenvalue problem;
C             = 'G':  generalized eigenvalue problem;
C             = 'R':  reciprocal generalized eigenvalue problem.
C
C     Input/Output Parameters
C
C     N       (input) INTEGER
C             The dimension of vectors ER, EI and ED.  N >= 0.
C
C     ALPHA   (input) DOUBLE PRECISION
C             Specifies the boundary of the domain of interest for the
C             eigenvalues. For a continuous-time system
C             (DICO = 'C'), ALPHA is the boundary value for the real
C             parts of eigenvalues, while for a discrete-time system
C             (DICO = 'D'), ALPHA >= 0 represents the boundary value for
C             the moduli of eigenvalues.
C
C     ER, EI, (input) DOUBLE PRECISION arrays, dimension (N)
C     ED      If EVTYPE = 'S', ER(j) + EI(j)*i, j = 1,...,N, are
C             the eigenvalues of a real matrix.
C             ED is not referenced and is implicitly considered as
C             a vector having all elements equal to one.
C             If EVTYPE = 'G' or EVTYPE = 'R', (ER(j) + EI(j)*i)/ED(j),
C             j = 1,...,N, are the generalized eigenvalues of a pair of
C             real matrices. If ED(j) is zero, then the j-th generalized
C             eigenvalue is infinite.
C             Complex conjugate pairs of eigenvalues must appear
C             consecutively.
C
C     Tolerances
C
C     TOLINF  DOUBLE PRECISION
C             If EVTYPE = 'G' or 'R', TOLINF contains the tolerance for
C             detecting infinite generalized eigenvalues.
C             0 <= TOLINF < 1.
C
C     Error Indicator
C
C     INFO    INTEGER
C             =  0:  successful exit, i.e., all eigenvalues lie within
C                    the domain of interest defined by DICO, STDOM
C                    and ALPHA;
C             <  0:  if INFO = -i, the i-th argument had an illegal
C                    value;
C             =  1:  some eigenvalues lie outside the domain of interest
C                    defined by DICO, STDOM and ALPHA.
C     METHOD
C
C     The domain of interest for an eigenvalue lambda is defined by the
C     parameters ALPHA, DICO and STDOM as follows:
C        - for a continuous-time system (DICO = 'C'):
C               Real(lambda) < ALPHA if STDOM = 'S';
C               Real(lambda) > ALPHA if STDOM = 'U';
C        - for a discrete-time system (DICO = 'D'):
C               Abs(lambda) < ALPHA if STDOM = 'S';
C               Abs(lambda) > ALPHA if STDOM = 'U'.
C     If EVTYPE = 'R', the same conditions apply for 1/lambda.
C
C     CONTRIBUTORS
C
C     A. Varga, German Aerospace Center, Oberpfaffenhofen, May 2001.
C
C     REVISIONS
C
C     V. Sima, Research Institute for Informatics, Bucharest, June 2001,
C     July 2020.
C
C     KEYWORDS
C
C     Stability.
C
C     ******************************************************************
C
C     .. Parameters ..
      DOUBLE PRECISION ZERO, ONE
      PARAMETER        ( ZERO = 0.0D0, ONE = 1.0D0 )
C     .. Scalar Arguments ..
      CHARACTER        DICO, EVTYPE, STDOM
      INTEGER          INFO, N
      DOUBLE PRECISION ALPHA, TOLINF
C     .. Array Arguments ..
      DOUBLE PRECISION ED(*), EI(*), ER(*)
C     .. Local Scalars
      LOGICAL          DISCR, RECEVP, STAB, STDEVP
      DOUBLE PRECISION ABSEV, RPEV, SCALE
      INTEGER          I
C     .. External Functions ..
      LOGICAL          LSAME
      DOUBLE PRECISION DLAPY2
      EXTERNAL         DLAPY2, LSAME
C     .. External Subroutines ..
      EXTERNAL         XERBLA
C     .. Intrinsic Functions ..
      INTRINSIC        ABS
C     .. Executable Statements ..
C
      INFO   = 0
      DISCR  = LSAME( DICO,   'D' )
      STAB   = LSAME( STDOM,  'S' )
      STDEVP = LSAME( EVTYPE, 'S' )
      RECEVP = LSAME( EVTYPE, 'R' )
C
C     Check the scalar input arguments.
C
      IF( .NOT. ( LSAME( DICO, 'C' ) .OR. DISCR ) ) THEN
         INFO = -1
      ELSE IF( .NOT. ( STAB .OR. LSAME( STDOM, 'U' ) ) ) THEN
         INFO = -2
      ELSE IF( .NOT. ( STDEVP .OR. LSAME( EVTYPE, 'G' ) .OR.
     $                 RECEVP ) ) THEN
         INFO = -3
      ELSE IF( N.LT.0 ) THEN
         INFO = -4
      ELSE IF( DISCR .AND. ALPHA.LT.ZERO ) THEN
         INFO = -5
      ELSE IF( TOLINF.LT.ZERO .OR. TOLINF.GE.ONE ) THEN
         INFO = -9
      END IF
C
      IF( INFO.NE.0 ) THEN
C
C        Error return.
C
         CALL XERBLA( 'AB09JX', -INFO )
         RETURN
      END IF
C
C     Quick return if possible.
C
      IF( N.EQ.0 )
     $   RETURN
C
      SCALE = ONE
C
      IF( STAB ) THEN
C
C        Check the stability of finite eigenvalues.
C
         IF( DISCR ) THEN
            DO 10 I = 1, N
               ABSEV = DLAPY2( ER(I), EI(I) )
               IF( RECEVP ) THEN
                  SCALE = ABSEV
                  ABSEV = ABS( ED(I) )
               ELSE IF( .NOT.STDEVP ) THEN
                  SCALE = ED(I)
               END IF
               IF( ABS( SCALE ).GT.TOLINF .AND.
     $            ABSEV.GE.ALPHA*SCALE ) THEN
                  INFO = 1
                  RETURN
               END IF
   10       CONTINUE
         ELSE
            DO 20 I = 1, N
               RPEV = ER(I)
               IF( RECEVP ) THEN
                  SCALE = RPEV
                  RPEV = ED(I)
               ELSE IF( .NOT.STDEVP ) THEN
                  SCALE = ED(I)
               END IF
               IF( ABS( SCALE ).GT.TOLINF .AND.
     $            RPEV.GE.ALPHA*SCALE ) THEN
                  INFO = 1
                  RETURN
               END IF
   20       CONTINUE
         END IF
      ELSE
C
C        Check the anti-stability of finite eigenvalues.
C
         IF( DISCR ) THEN
            DO 30 I = 1, N
               ABSEV = DLAPY2( ER(I), EI(I) )
               IF( RECEVP ) THEN
                  SCALE = ABSEV
                  ABSEV = ABS( ED(I) )
               ELSE IF( .NOT.STDEVP ) THEN
                  SCALE = ED(I)
               END IF
               IF( ABS( SCALE ).GT.TOLINF .AND.
     $            ABSEV.LE.ALPHA*SCALE ) THEN
                  INFO = 1
                  RETURN
               END IF
   30       CONTINUE
         ELSE
            DO 40 I = 1, N
               RPEV = ER(I)
               IF( RECEVP ) THEN
                  SCALE = RPEV
                  RPEV = ED(I)
               ELSE IF( .NOT.STDEVP ) THEN
                  SCALE = ED(I)
               END IF
               IF( ABS( SCALE ).GT.TOLINF .AND.
     $            RPEV.LE.ALPHA*SCALE ) THEN
                  INFO = 1
                  RETURN
               END IF
   40       CONTINUE
         END IF
      END IF
C
      RETURN
C *** Last line of AB09JX ***
      END
