SUBROUTINE SG03BX( DICO, TRANS, A, LDA, E, LDE, B, LDB, U, LDU,
     $                   SCALE, M1, LDM1, M2, LDM2, INFO )
C
C     SLICOT RELEASE 5.0.
C
C     Copyright (c) 2002-2009 NICONET e.V.
C
C     This program is free software: you can redistribute it and/or
C     modify it under the terms of the GNU General Public License as
C     published by the Free Software Foundation, either version 2 of
C     the License, or (at your option) any later version.
C
C     This program is distributed in the hope that it will be useful,
C     but WITHOUT ANY WARRANTY; without even the implied warranty of
C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C     GNU General Public License for more details.
C
C     You should have received a copy of the GNU General Public License
C     along with this program.  If not, see
C     <http://www.gnu.org/licenses/>.
C
C     PURPOSE
C
C     To solve for X = op(U)**T * op(U) either the generalized c-stable
C     continuous-time Lyapunov equation
C
C             T                    T
C        op(A)  * X * op(E) + op(E)  * X * op(A)
C
C                 2        T
C        = - SCALE  * op(B)  * op(B),                                (1)
C
C     or the generalized d-stable discrete-time Lyapunov equation
C
C             T                    T
C        op(A)  * X * op(A) - op(E)  * X * op(E)
C
C                 2        T
C        = - SCALE  * op(B)  * op(B),                                (2)
C
C     where op(K) is either K or K**T for K = A, B, E, U. The Cholesky
C     factor U of the solution is computed without first finding X.
C
C     Furthermore, the auxiliary matrices
C
C                                   -1        -1
C        M1 := op(U) * op(A) * op(E)   * op(U)
C
C                           -1        -1
C        M2 := op(B) * op(E)   * op(U)
C
C     are computed in a numerically reliable way.
C
C     The matrices A, B, E, M1, M2, and U are real 2-by-2 matrices. The
C     pencil A - lambda * E must have a pair of complex conjugate
C     eigenvalues. The eigenvalues must be in the open right half plane
C     (in the continuous-time case) or inside the unit circle (in the
C     discrete-time case).
C
C     The resulting matrix U is upper triangular. The entries on its
C     main diagonal are non-negative. SCALE is an output scale factor
C     set to avoid overflow in U.
C
C     ARGUMENTS
C
C     Mode Parameters
C
C     DICO    CHARACTER*1
C             Specifies whether the continuous-time or the discrete-time
C             equation is to be solved:
C             = 'C':  Solve continuous-time equation (1);
C             = 'D':  Solve discrete-time equation (2).
C
C     TRANS   CHARACTER*1
C             Specifies whether the transposed equation is to be solved
C             or not:
C             = 'N':  op(K) = K,     K = A, B, E, U;
C             = 'T':  op(K) = K**T,  K = A, B, E, U.
C
C     Input/Output Parameters
C
C     A       (input) DOUBLE PRECISION array, dimension (LDA,2)
C             The leading 2-by-2 part of this array must contain the
C             matrix A.
C
C     LDA     INTEGER
C             The leading dimension of the array A.  LDA >= 2.
C
C     E       (input) DOUBLE PRECISION array, dimension (LDE,2)
C             The leading 2-by-2 upper triangular part of this array
C             must contain the matrix E.
C
C     LDE     INTEGER
C             The leading dimension of the array E.  LDE >= 2.
C
C     B       (input) DOUBLE PRECISION array, dimension (LDB,2)
C             The leading 2-by-2 upper triangular part of this array
C             must contain the matrix B.
C
C     LDB     INTEGER
C             The leading dimension of the array B.  LDB >= 2.
C
C     U       (output) DOUBLE PRECISION array, dimension (LDU,2)
C             The leading 2-by-2 part of this array contains the upper
C             triangular matrix U.
C
C     LDU     INTEGER
C             The leading dimension of the array U.  LDU >= 2.
C
C     SCALE   (output) DOUBLE PRECISION
C             The scale factor set to avoid overflow in U.
C             0 < SCALE <= 1.
C
C     M1      (output) DOUBLE PRECISION array, dimension (LDM1,2)
C             The leading 2-by-2 part of this array contains the
C             matrix M1.
C
C     LDM1    INTEGER
C             The leading dimension of the array M1.  LDM1 >= 2.
C
C     M2      (output) DOUBLE PRECISION array, dimension (LDM2,2)
C             The leading 2-by-2 part of this array contains the
C             matrix M2.
C
C     LDM2    INTEGER
C             The leading dimension of the array M2.  LDM2 >= 2.
C
C     Error indicator
C
C     INFO    INTEGER
C             = 0:  successful exit;
C             = 2:  the eigenvalues of the pencil A - lambda * E are not
C                   a pair of complex conjugate numbers;
C             = 3:  the eigenvalues of the pencil A - lambda * E are
C                   not in the open right half plane (in the continuous-
C                   time case) or inside the unit circle (in the
C                   discrete-time case).
C
C     METHOD
C
C     The method used by the routine is based on a generalization of the
C     method due to Hammarling ([1], section 6) for Lyapunov equations
C     of order 2. A more detailed description is given in [2].
C
C     REFERENCES
C
C     [1] Hammarling, S.J.
C         Numerical solution of the stable, non-negative definite
C         Lyapunov equation.
C         IMA J. Num. Anal., 2, pp. 303-323, 1982.
C
C     [2] Penzl, T.
C         Numerical solution of generalized Lyapunov equations.
C         Advances in Comp. Math., vol. 8, pp. 33-48, 1998.
C
C     FURTHER COMMENTS
C
C     If the solution matrix U is singular, the matrices M1 and M2 are
C     properly set (see [1], equation (6.21)).
C
C     CONTRIBUTOR
C
C     T. Penzl, Technical University Chemnitz, Germany, Aug. 1998.
C
C     REVISIONS
C
C     Sep. 1998 (V. Sima).
C     Dec. 1998 (V. Sima).
C     July 2003 (V. Sima; suggested by Klaus Schnepper).
C     Oct. 2003 (A. Varga).
C
C     ******************************************************************
C
C     .. Parameters ..
      DOUBLE PRECISION  MONE, ONE, TWO, ZERO
      PARAMETER         ( MONE = -1.0D+0, ONE = 1.0D+0, TWO = 2.0D+0,
     $                    ZERO = 0.0D+0)
C     .. Scalar Arguments ..
      CHARACTER         DICO, TRANS
      DOUBLE PRECISION  SCALE
      INTEGER           INFO, LDA, LDB, LDE, LDM1, LDM2, LDU
C     .. Array Arguments ..
      DOUBLE PRECISION  A(LDA,*), B(LDB,*), E(LDE,*), M1(LDM1,*),
     $                  M2(LDM2,*), U(LDU,*)
C     .. Local Scalars ..
      DOUBLE PRECISION  ALPHA, B11, B12I, B12R, B22, BETAI, BETAR,
     $                  BIGNUM, CI, CR, EPS, L, LAMI, LAMR, SCALE1,
     $                  SCALE2, SI, SMLNUM, SR, T, V, W, XR, XI, YR, YI
      LOGICAL           ISCONT, ISTRNS
C     .. Local Arrays ..
      DOUBLE PRECISION  AA(2,2), AI(2,2), AR(2,2), BB(2,2), BI(2,2),
     $                  BR(2,2), EE(2,2), EI(2,2), ER(2,2), M1I(2,2),
     $                  M1R(2,2), M2I(2,2), M2R(2,2), QBI(2,2),
     $                  QBR(2,2), QI(2,2), QR(2,2), QUI(2,2), QUR(2,2),
     $                  TI(2,2), TR(2,2), UI(2,2), UR(2,2), ZI(2,2),
     $                  ZR(2,2)
C     .. External Functions ..
      DOUBLE PRECISION  DLAMCH, DLAPY2
      LOGICAL           LSAME
      EXTERNAL          DLAMCH, DLAPY2, LSAME
C     .. External Subroutines ..
      EXTERNAL          DCOPY, DGEMM, DGEMV, DLABAD, DLADIV, DLAG2,
     $                  SG03BY
C     .. Intrinsic Functions ..
      INTRINSIC         ABS, MAX, MIN, SQRT
C
C     Decode input parameters.
C
      ISTRNS = LSAME( TRANS, 'T' )
      ISCONT = LSAME( DICO,  'C' )
C
C     Do not check input parameters for errors.
C
C     Set constants to control overflow.
C
      EPS    = DLAMCH( 'P' )
      SMLNUM = DLAMCH( 'S' )/EPS
      BIGNUM = ONE/SMLNUM
      CALL DLABAD( SMLNUM, BIGNUM )
C
      INFO  = 0
      SCALE = ONE
C
C     Make copies of A, E, and B.
C
      AA(1,1) = A(1,1)
      AA(2,1) = A(2,1)
      AA(1,2) = A(1,2)
      AA(2,2) = A(2,2)
      EE(1,1) = E(1,1)
      EE(2,1) = ZERO
      EE(1,2) = E(1,2)
      EE(2,2) = E(2,2)
      BB(1,1) = B(1,1)
      BB(2,1) = ZERO
      BB(1,2) = B(1,2)
      BB(2,2) = B(2,2)
C
C     If the transposed equation (op(K)=K**T, K=A,B,E,U) is to be
C     solved, transpose the matrices A, E, B with respect to the
C     anti-diagonal. This results in a non-transposed equation.
C
      IF ( ISTRNS ) THEN
         V = AA(1,1)
         AA(1,1) = AA(2,2)
         AA(2,2) = V
         V = EE(1,1)
         EE(1,1) = EE(2,2)
         EE(2,2) = V
         V = BB(1,1)
         BB(1,1) = BB(2,2)
         BB(2,2) = V
      END IF
C
C     Perform QZ-step to transform the pencil A - lambda * E to
C     generalized Schur form. The main diagonal of the Schur factor of E
C     is real and positive.
C
C     Compute eigenvalues (LAMR + LAMI * I, LAMR - LAMI * I).
C
      T = MAX( EPS*MAX( ABS( EE(1,1) ), ABS( EE(1,2) ),
     $                  ABS( EE(2,2) ) ), SMLNUM )
      IF ( MIN( ABS( EE(1,1) ), ABS( EE(2,2) ) ) .LT. T ) THEN
         INFO = 3
         RETURN
      END IF
      CALL DLAG2( AA, 2, EE, 2, SMLNUM*EPS, SCALE1, SCALE2, LAMR,
     $            W, LAMI )
      IF (LAMI .LE. ZERO) THEN
         INFO = 2
         RETURN
      END IF
C
C     Compute right orthogonal transformation matrix Q.
C
      CALL SG03BY( SCALE1*AA(1,1) - EE(1,1)*LAMR, -EE(1,1)*LAMI,
     $             SCALE1*AA(2,1), ZERO, CR, CI, SR, SI, L )
      QR(1,1) =  CR
      QR(1,2) =  SR
      QR(2,1) = -SR
      QR(2,2) =  CR
      QI(1,1) = -CI
      QI(1,2) = -SI
      QI(2,1) = -SI
      QI(2,2) =  CI
C
C     A := Q * A
C
      CALL DGEMM( 'N', 'N', 2, 2, 2, ONE, QR, 2, AA, 2, ZERO, AR, 2 )
      CALL DGEMM( 'N', 'N', 2, 2, 2, ONE, QI, 2, AA, 2, ZERO, AI, 2 )
C
C     E := Q * E
C
      CALL DGEMM( 'N', 'N', 2, 2, 2, ONE, QR, 2, EE, 2, ZERO, ER, 2 )
      CALL DGEMM( 'N', 'N', 2, 2, 2, ONE, QI, 2, EE, 2, ZERO, EI, 2 )
C
C     Compute left orthogonal transformation matrix Z.
C
      CALL SG03BY( ER(2,2), EI(2,2), ER(2,1), EI(2,1), CR, CI, SR, SI,
     $             L )
      ZR(1,1) =  CR
      ZR(1,2) =  SR
      ZR(2,1) = -SR
      ZR(2,2) =  CR
      ZI(1,1) =  CI
      ZI(1,2) = -SI
      ZI(2,1) = -SI
      ZI(2,2) = -CI
C
C     E := E * Z
C
      CALL DGEMV( 'T', 2, 2,  ONE, ZR, 2, ER, 2, ZERO, TR, 2 )
      CALL DGEMV( 'T', 2, 2, MONE, ZI, 2, EI, 2,  ONE, TR, 2 )
      CALL DGEMV( 'T', 2, 2,  ONE, ZI, 2, ER, 2, ZERO, TI, 2 )
      CALL DGEMV( 'T', 2, 2,  ONE, ZR, 2, EI, 2,  ONE, TI, 2 )
      CALL DCOPY( 2, TR, 2, ER, 2 )
      CALL DCOPY( 2, TI, 2, EI, 2 )
      ER(2,1) = ZERO
      ER(2,2) = L
      EI(2,1) = ZERO
      EI(2,2) = ZERO
C
C     Make main diagonal entries of E real and positive.
C     (Note:  Z and E are altered.)
C
      V = DLAPY2( ER(1,1), EI(1,1) )
      CALL DLADIV( V, ZERO, ER(1,1), EI(1,1), XR, XI )
      ER(1,1) = V
      EI(1,1) = ZERO
      YR = ZR(1,1)
      YI = ZI(1,1)
      ZR(1,1) = XR*YR - XI*YI
      ZI(1,1) = XR*YI + XI*YR
      YR = ZR(2,1)
      YI = ZI(2,1)
      ZR(2,1) = XR*YR - XI*YI
      ZI(2,1) = XR*YI + XI*YR
C
C     A := A * Z
C
      CALL DGEMM( 'N', 'N', 2, 2, 2,  ONE, AR, 2, ZR, 2, ZERO, TR, 2 )
      CALL DGEMM( 'N', 'N', 2, 2, 2, MONE, AI, 2, ZI, 2,  ONE, TR, 2 )
      CALL DGEMM( 'N', 'N', 2, 2, 2,  ONE, AR, 2, ZI, 2, ZERO, TI, 2 )
      CALL DGEMM( 'N', 'N', 2, 2, 2,  ONE, AI, 2, ZR, 2,  ONE, TI, 2 )
      CALL DCOPY( 4, TR, 1, AR, 1 )
      CALL DCOPY( 4, TI, 1, AI, 1 )
C
C     End of QZ-step.
C
C     B := B * Z
C
      CALL DGEMM( 'N', 'N', 2, 2, 2, ONE, BB, 2, ZR, 2, ZERO, BR, 2 )
      CALL DGEMM( 'N', 'N', 2, 2, 2, ONE, BB, 2, ZI, 2, ZERO, BI, 2 )
C
C     Overwrite B with the upper triangular matrix of its
C     QR-factorization. The elements on the main diagonal are real
C     and non-negative.
C
      CALL SG03BY( BR(1,1), BI(1,1), BR(2,1), BI(2,1), CR, CI, SR, SI,
     $             L )
      QBR(1,1) =  CR
      QBR(1,2) =  SR
      QBR(2,1) = -SR
      QBR(2,2) =  CR
      QBI(1,1) = -CI
      QBI(1,2) = -SI
      QBI(2,1) = -SI
      QBI(2,2) =  CI
      CALL DGEMV( 'N', 2, 2,  ONE, QBR, 2, BR(1,2), 1, ZERO, TR, 1 )
      CALL DGEMV( 'N', 2, 2, MONE, QBI, 2, BI(1,2), 1,  ONE, TR, 1 )
      CALL DGEMV( 'N', 2, 2,  ONE, QBI, 2, BR(1,2), 1, ZERO, TI, 1 )
      CALL DGEMV( 'N', 2, 2,  ONE, QBR, 2, BI(1,2), 1,  ONE, TI, 1 )
      CALL DCOPY( 2, TR, 1, BR(1,2), 1 )
      CALL DCOPY( 2, TI, 1, BI(1,2), 1 )
      BR(1,1) = L
      BR(2,1) = ZERO
      BI(1,1) = ZERO
      BI(2,1) = ZERO
      V = DLAPY2( BR(2,2), BI(2,2) )
      IF ( V .GE. MAX( EPS*MAX( BR(1,1), DLAPY2( BR(1,2), BI(1,2) ) ),
     $                 SMLNUM ) ) THEN
         CALL DLADIV( V, ZERO, BR(2,2), BI(2,2), XR, XI )
         BR(2,2) = V
         YR = QBR(2,1)
         YI = QBI(2,1)
         QBR(2,1) = XR*YR - XI*YI
         QBI(2,1) = XR*YI + XI*YR
         YR = QBR(2,2)
         YI = QBI(2,2)
         QBR(2,2) = XR*YR - XI*YI
         QBI(2,2) = XR*YI + XI*YR
      ELSE
         BR(2,2) = ZERO
      END IF
      BI(2,2) = ZERO
C
C     Compute the Cholesky factor of the solution of the reduced
C     equation. The solution may be scaled to avoid overflow.
C
      IF ( ISCONT ) THEN
C
C        Continuous-time equation.
C
C        Step I:  Compute U(1,1). Set U(2,1) = 0.
C
         V = -TWO*( AR(1,1)*ER(1,1) + AI(1,1)*EI(1,1) )
         IF ( V .LE. ZERO ) THEN
            INFO = 3
            RETURN
         END IF
         V = SQRT( V )
         T = TWO*ABS( BR(1,1) )*SMLNUM
         IF ( T .GT. V ) THEN
            SCALE1  = V/T
            SCALE   = SCALE1*SCALE
            BR(1,1) = SCALE1*BR(1,1)
            BR(1,2) = SCALE1*BR(1,2)
            BI(1,2) = SCALE1*BI(1,2)
            BR(2,2) = SCALE1*BR(2,2)
         END IF
         UR(1,1) = BR(1,1)/V
         UI(1,1) = ZERO
         UR(2,1) = ZERO
         UI(2,1) = ZERO
C
C        Step II:  Compute U(1,2).
C
         T = MAX( EPS*MAX( BR(2,2), DLAPY2( BR(1,2), BI(1,2) ) ),
     $            SMLNUM )
         IF ( ABS( BR(1,1) ) .LT. T ) THEN
            UR(1,2) = ZERO
            UI(1,2) = ZERO
         ELSE
            XR = AR(1,1)*ER(1,2) + AI(1,1)*EI(1,2)
            XI = AI(1,1)*ER(1,2) - AR(1,1)*EI(1,2)
            XR = XR + AR(1,2)*ER(1,1) + AI(1,2)*EI(1,1)
            XI = XI - AI(1,2)*ER(1,1) + AR(1,2)*EI(1,1)
            XR = -BR(1,2)*V - XR*UR(1,1)
            XI =  BI(1,2)*V - XI*UR(1,1)
            YR =  AR(2,2)*ER(1,1) + AI(2,2)*EI(1,1)
            YI = -AI(2,2)*ER(1,1) + AR(2,2)*EI(1,1)
            YR = YR + ER(2,2)*AR(1,1) + EI(2,2)*AI(1,1)
            YI = YI - EI(2,2)*AR(1,1) + ER(2,2)*AI(1,1)
            T  = TWO*DLAPY2( XR, XI )*SMLNUM
            IF ( T .GT. DLAPY2( YR, YI ) ) THEN
               SCALE1  = DLAPY2( YR, YI )/T
               SCALE   = SCALE1*SCALE
               BR(1,1) = SCALE1*BR(1,1)
               BR(1,2) = SCALE1*BR(1,2)
               BI(1,2) = SCALE1*BI(1,2)
               BR(2,2) = SCALE1*BR(2,2)
               UR(1,1) = SCALE1*UR(1,1)
               XR = SCALE1*XR
               XI = SCALE1*XI
            END IF
            CALL DLADIV( XR, XI, YR, YI, UR(1,2), UI(1,2) )
            UI(1,2) = -UI(1,2)
         END IF
C
C        Step III:  Compute U(2,2).
C
         XR = ( ER(1,2)*UR(1,1) + ER(2,2)*UR(1,2) - EI(2,2)*UI(1,2) )*V
         XI = (-EI(1,2)*UR(1,1) - ER(2,2)*UI(1,2) - EI(2,2)*UR(1,2) )*V
         T  = TWO*DLAPY2( XR, XI )*SMLNUM
         IF ( T .GT. DLAPY2( ER(1,1), EI(1,1) ) ) THEN
            SCALE1  = DLAPY2( ER(1,1), EI(1,1) )/T
            SCALE   = SCALE1*SCALE
            UR(1,1) = SCALE1*UR(1,1)
            UR(1,2) = SCALE1*UR(1,2)
            UI(1,2) = SCALE1*UI(1,2)
            BR(1,1) = SCALE1*BR(1,1)
            BR(1,2) = SCALE1*BR(1,2)
            BI(1,2) = SCALE1*BI(1,2)
            BR(2,2) = SCALE1*BR(2,2)
            XR = SCALE1*XR
            XI = SCALE1*XI
         END IF
         CALL DLADIV( XR, XI, ER(1,1), -EI(1,1), YR, YI )
         YR =  BR(1,2) - YR
         YI = -BI(1,2) - YI
         V  = -TWO*( AR(2,2)*ER(2,2) + AI(2,2)*EI(2,2) )
         IF ( V .LE. ZERO ) THEN
            INFO = 3
            RETURN
         END IF
         V = SQRT( V )
         W = DLAPY2( DLAPY2( BR(2,2), BI(2,2) ), DLAPY2( YR, YI ) )
         T = TWO*W*SMLNUM
         IF ( T .GT. V ) THEN
            SCALE1  = V/T
            SCALE   = SCALE1*SCALE
            UR(1,1) = SCALE1*UR(1,1)
            UR(1,2) = SCALE1*UR(1,2)
            UI(1,2) = SCALE1*UI(1,2)
            BR(1,1) = SCALE1*BR(1,1)
            BR(1,2) = SCALE1*BR(1,2)
            BI(1,2) = SCALE1*BI(1,2)
            BR(2,2) = SCALE1*BR(2,2)
            W = SCALE1*W
         END IF
         UR(2,2) = W/V
         UI(2,2) = ZERO
C
C        Compute matrices M1 and M2 for the reduced equation.
C
         M1R(2,1) = ZERO
         M1I(2,1) = ZERO
         M2R(2,1) = ZERO
         M2I(2,1) = ZERO
         CALL DLADIV( AR(1,1), AI(1,1), ER(1,1), EI(1,1), BETAR, BETAI )
         M1R(1,1) =  BETAR
         M1I(1,1) =  BETAI
         M1R(2,2) =  BETAR
         M1I(2,2) = -BETAI
         ALPHA = SQRT( -TWO*BETAR )
         M2R(1,1) = ALPHA
         M2I(1,1) = ZERO
         V  = ER(1,1)*ER(2,2)
         XR = ( -BR(1,1)*ER(1,2) + ER(1,1)*BR(1,2) )/V
         XI = ( -BR(1,1)*EI(1,2) + ER(1,1)*BI(1,2) )/V
         YR =  XR - ALPHA*UR(1,2)
         YI = -XI + ALPHA*UI(1,2)
         IF ( ( YR.NE.ZERO ) .OR. ( YI.NE.ZERO ) ) THEN
            M2R(1,2) =  YR/UR(2,2)
            M2I(1,2) = -YI/UR(2,2)
            M2R(2,2) =  BR(2,2)/( ER(2,2)*UR(2,2) )
            M2I(2,2) =  ZERO
            M1R(1,2) = -ALPHA*M2R(1,2)
            M1I(1,2) = -ALPHA*M2I(1,2)
         ELSE
            M2R(1,2) = ZERO
            M2I(1,2) = ZERO
            M2R(2,2) = ALPHA
            M2I(2,2) = ZERO
            M1R(1,2) = ZERO
            M1I(1,2) = ZERO
         END IF
      ELSE
C
C        Discrete-time equation.
C
C        Step I:  Compute U(1,1). Set U(2,1) = 0.
C
         V = ER(1,1)**2 + EI(1,1)**2 - AR(1,1)**2 - AI(1,1)**2
         IF ( V .LE. ZERO ) THEN
            INFO = 3
            RETURN
         END IF
         V = SQRT( V )
         T = TWO*ABS( BR(1,1) )*SMLNUM
         IF ( T .GT. V ) THEN
            SCALE1  = V/T
            SCALE   = SCALE1*SCALE
            BR(1,1) = SCALE1*BR(1,1)
            BR(1,2) = SCALE1*BR(1,2)
            BI(1,2) = SCALE1*BI(1,2)
            BR(2,2) = SCALE1*BR(2,2)
         END IF
         UR(1,1) = BR(1,1)/V
         UI(1,1) = ZERO
         UR(2,1) = ZERO
         UI(2,1) = ZERO
C
C        Step II:  Compute U(1,2).
C
         T = MAX( EPS*MAX( BR(2,2), DLAPY2( BR(1,2), BI(1,2) ) ),
     $            SMLNUM )
         IF ( ABS( BR(1,1) ) .LT. T ) THEN
            UR(1,2) = ZERO
            UI(1,2) = ZERO
         ELSE
            XR =  AR(1,1)*AR(1,2) + AI(1,1)*AI(1,2)
            XI =  AI(1,1)*AR(1,2) - AR(1,1)*AI(1,2)
            XR =  XR - ER(1,2)*ER(1,1) - EI(1,2)*EI(1,1)
            XI =  XI + EI(1,2)*ER(1,1) - ER(1,2)*EI(1,1)
            XR = -BR(1,2)*V - XR*UR(1,1)
            XI =  BI(1,2)*V - XI*UR(1,1)
            YR =  AR(2,2)*AR(1,1) + AI(2,2)*AI(1,1)
            YI = -AI(2,2)*AR(1,1) + AR(2,2)*AI(1,1)
            YR = YR - ER(2,2)*ER(1,1) - EI(2,2)*EI(1,1)
            YI = YI + EI(2,2)*ER(1,1) - ER(2,2)*EI(1,1)
            T  = TWO*DLAPY2( XR, XI )*SMLNUM
            IF ( T .GT. DLAPY2( YR, YI ) ) THEN
               SCALE1  = DLAPY2( YR, YI )/T
               SCALE   = SCALE1*SCALE
               BR(1,1) = SCALE1*BR(1,1)
               BR(1,2) = SCALE1*BR(1,2)
               BI(1,2) = SCALE1*BI(1,2)
               BR(2,2) = SCALE1*BR(2,2)
               UR(1,1) = SCALE1*UR(1,1)
               XR = SCALE1*XR
               XI = SCALE1*XI
            END IF
            CALL DLADIV( XR, XI, YR, YI, UR(1,2), UI(1,2) )
            UI(1,2) = -UI(1,2)
         END IF
C
C        Step III:  Compute U(2,2).
C
         XR =  ER(1,2)*UR(1,1) + ER(2,2)*UR(1,2) - EI(2,2)*UI(1,2)
         XI = -EI(1,2)*UR(1,1) - ER(2,2)*UI(1,2) - EI(2,2)*UR(1,2)
         YR =  AR(1,2)*UR(1,1) + AR(2,2)*UR(1,2) - AI(2,2)*UI(1,2)
         YI = -AI(1,2)*UR(1,1) - AR(2,2)*UI(1,2) - AI(2,2)*UR(1,2)
         V  = ER(2,2)**2 + EI(2,2)**2 - AR(2,2)**2 - AI(2,2)**2
         IF ( V .LE. ZERO ) THEN
            INFO = 3
            RETURN
         END IF
         V = SQRT( V )
         T = MAX( ABS( BR(2,2) ), ABS( BR(1,2) ), ABS( BI(1,2) ),
     $            ABS( XR ), ABS( XI ), ABS( YR ), ABS( YI) )
         IF ( T .LE. SMLNUM ) T = ONE
         W = ( BR(2,2)/T )**2 + ( BR(1,2)/T )**2 + ( BI(1,2)/T )**2 -
     $       ( XR/T )**2 - ( XI/T )**2 + ( YR/T )**2 + ( YI/T )**2
         IF ( W .LT. ZERO ) THEN
            INFO = 3
            RETURN
         END IF
         W = T*SQRT( W )
         T = TWO*W*SMLNUM
         IF ( T .GT. V ) THEN
            SCALE1  = V/T
            SCALE   = SCALE1*SCALE
            UR(1,1) = SCALE1*UR(1,1)
            UR(1,2) = SCALE1*UR(1,2)
            UI(1,2) = SCALE1*UI(1,2)
            BR(1,1) = SCALE1*BR(1,1)
            BR(1,2) = SCALE1*BR(1,2)
            BI(1,2) = SCALE1*BI(1,2)
            BR(2,2) = SCALE1*BR(2,2)
            W = SCALE1*W
         END IF
         UR(2,2) = W/V
         UI(2,2) = ZERO
C
C        Compute matrices M1 and M2 for the reduced equation.
C
         B11  = BR(1,1)/ER(1,1)
         T    = ER(1,1)*ER(2,2)
         B12R = ( ER(1,1)*BR(1,2) - BR(1,1)*ER(1,2) )/T
         B12I = ( ER(1,1)*BI(1,2) - BR(1,1)*EI(1,2) )/T
         B22  = BR(2,2)/ER(2,2)
         M1R(2,1) = ZERO
         M1I(2,1) = ZERO
         M2R(2,1) = ZERO
         M2I(2,1) = ZERO
         CALL DLADIV( AR(1,1), AI(1,1), ER(1,1), EI(1,1), BETAR, BETAI )
         M1R(1,1) =  BETAR
         M1I(1,1) =  BETAI
         M1R(2,2) =  BETAR
         M1I(2,2) = -BETAI
         V = DLAPY2( BETAR, BETAI )
         ALPHA = SQRT( ( ONE - V )*( ONE + V ) )
         M2R(1,1) = ALPHA
         M2I(1,1) = ZERO
         XR = ( AI(1,1)*EI(1,2) - AR(1,1)*ER(1,2) )/T + AR(1,2)/ER(2,2)
         XI = ( AR(1,1)*EI(1,2) + AI(1,1)*ER(1,2) )/T - AI(1,2)/ER(2,2)
         XR = -TWO*BETAI*B12I - B11*XR
         XI = -TWO*BETAI*B12R - B11*XI
         V  =  ONE + ( BETAI - BETAR )*( BETAI + BETAR )
         W  = -TWO*BETAI*BETAR
         CALL DLADIV( XR, XI, V, W, YR, YI )
         IF ( ( YR.NE.ZERO ) .OR. ( YI.NE.ZERO ) ) THEN
            M2R(1,2) =  ( YR*BETAR - YI*BETAI )/UR(2,2)
            M2I(1,2) = -( YI*BETAR + YR*BETAI )/UR(2,2)
            M2R(2,2) =  B22/UR(2,2)
            M2I(2,2) =  ZERO
            M1R(1,2) = -ALPHA*YR/UR(2,2)
            M1I(1,2) =  ALPHA*YI/UR(2,2)
         ELSE
            M2R(1,2) = ZERO
            M2I(1,2) = ZERO
            M2R(2,2) = ALPHA
            M2I(2,2) = ZERO
            M1R(1,2) = ZERO
            M1I(1,2) = ZERO
         END IF
      END IF
C
C     Transform U back:  U := U * Q.
C     (Note:  Z is used as workspace.)
C
      CALL DGEMM( 'N', 'N', 2, 2, 2,  ONE, UR, 2, QR, 2, ZERO, ZR, 2 )
      CALL DGEMM( 'N', 'N', 2, 2, 2, MONE, UI, 2, QI, 2,  ONE, ZR, 2 )
      CALL DGEMM( 'N', 'N', 2, 2, 2,  ONE, UR, 2, QI, 2, ZERO, ZI, 2 )
      CALL DGEMM( 'N', 'N', 2, 2, 2,  ONE, UI, 2, QR, 2,  ONE, ZI, 2 )
C
C     Overwrite U with the upper triangular matrix of its
C     QR-factorization. The elements on the main diagonal are real
C     and non-negative.
C
      CALL SG03BY( ZR(1,1), ZI(1,1), ZR(2,1), ZI(2,1), CR, CI, SR, SI,
     $             L )
      QUR(1,1) =  CR
      QUR(1,2) =  SR
      QUR(2,1) = -SR
      QUR(2,2) =  CR
      QUI(1,1) = -CI
      QUI(1,2) = -SI
      QUI(2,1) = -SI
      QUI(2,2) =  CI
      CALL DGEMV( 'N', 2, 2,  ONE, QUR, 2, ZR(1,2), 1, ZERO,  U(1,2), 1)
      CALL DGEMV( 'N', 2, 2, MONE, QUI, 2, ZI(1,2), 1,  ONE,  U(1,2), 1)
      CALL DGEMV( 'N', 2, 2,  ONE, QUI, 2, ZR(1,2), 1, ZERO, UI(1,2), 1)
      CALL DGEMV( 'N', 2, 2,  ONE, QUR, 2, ZI(1,2), 1,  ONE, UI(1,2), 1)
      U(1,1) = L
      U(2,1) = ZERO
      V = DLAPY2( U(2,2), UI(2,2) )
      IF ( V .NE. ZERO ) THEN
         CALL DLADIV( V, ZERO, U(2,2), UI(2,2), XR, XI )
         YR = QUR(2,1)
         YI = QUI(2,1)
         QUR(2,1) = XR*YR - XI*YI
         QUI(2,1) = XR*YI + XI*YR
         YR = QUR(2,2)
         YI = QUI(2,2)
         QUR(2,2) = XR*YR - XI*YI
         QUI(2,2) = XR*YI + XI*YR
      END IF
      U(2,2) = V
C
C     Transform the matrices M1 and M2 back.
C
C        M1 := QU * M1 * QU**H
C        M2 := QB**H * M2 * QU**H
C
      CALL DGEMM( 'N', 'T', 2, 2, 2,  ONE, M1R, 2, QUR, 2, ZERO, TR, 2 )
      CALL DGEMM( 'N', 'T', 2, 2, 2,  ONE, M1I, 2, QUI, 2,  ONE, TR, 2 )
      CALL DGEMM( 'N', 'T', 2, 2, 2, MONE, M1R, 2, QUI, 2, ZERO, TI, 2 )
      CALL DGEMM( 'N', 'T', 2, 2, 2,  ONE, M1I, 2, QUR, 2,  ONE, TI, 2 )
      CALL DGEMM( 'N', 'N', 2, 2, 2,  ONE, QUR, 2, TR,  2, ZERO, M1,
     $            LDM1 )
      CALL DGEMM( 'N', 'N', 2, 2, 2, MONE, QUI, 2, TI,  2,  ONE, M1,
     $            LDM1 )
C
      CALL DGEMM( 'N', 'T', 2, 2, 2,  ONE, M2R, 2, QUR, 2, ZERO, TR, 2 )
      CALL DGEMM( 'N', 'T', 2, 2, 2,  ONE, M2I, 2, QUI, 2,  ONE, TR, 2 )
      CALL DGEMM( 'N', 'T', 2, 2, 2, MONE, M2R, 2, QUI, 2, ZERO, TI, 2 )
      CALL DGEMM( 'N', 'T', 2, 2, 2,  ONE, M2I, 2, QUR, 2,  ONE, TI, 2 )
      CALL DGEMM( 'T', 'N', 2, 2, 2,  ONE, QBR, 2,  TR, 2, ZERO, M2,
     $            LDM2 )
      CALL DGEMM( 'T', 'N', 2, 2, 2,  ONE, QBI, 2,  TI, 2,  ONE, M2,
     $            LDM2 )
C
C     If the transposed equation (op(K)=K**T, K=A,B,E,U) is to be
C     solved, transpose the matrix U with respect to the
C     anti-diagonal and the matrices M1, M2 with respect to the diagonal
C     and the anti-diagonal.
C
      IF ( ISTRNS ) THEN
         V = U(1,1)
         U(1,1) = U(2,2)
         U(2,2) = V
         V = M1(1,1)
         M1(1,1) = M1(2,2)
         M1(2,2) = V
         V = M2(1,1)
         M2(1,1) = M2(2,2)
         M2(2,2) = V
      END IF
C
      RETURN
C *** Last line of SG03BX ***
      END