cget36()

subroutine cget36	(	real	rmax,
		integer	lmax,
		integer	ninfo,
		integer	knt,
		integer	nin
	)

CGET36

Purpose:

 CGET36 tests CTREXC, a routine for reordering diagonal entries of a
 matrix in complex Schur form. Thus, CLAEXC computes a unitary matrix
 Q such that

    Q' * T1 * Q  = T2

 and where one of the diagonal blocks of T1 (the one at row IFST) has
 been moved to position ILST.

 The test code verifies that the residual Q'*T1*Q-T2 is small, that T2
 is in Schur form, and that the final position of the IFST block is
 ILST.

 The test matrices are read from a file with logical unit number NIN.

Parameters

[out]	RMAX	RMAX is REAL Value of the largest test ratio.
[out]	LMAX	LMAX is INTEGER Example number where largest test ratio achieved.
[out]	NINFO	NINFO is INTEGER Number of examples where INFO is nonzero.
[out]	KNT	KNT is INTEGER Total number of examples tested.
[in]	NIN	NIN is INTEGER Input logical unit number.

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 84 of file cget36.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      INTEGER            KNT, LMAX, NIN, NINFO
      REAL               RMAX
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, ONE
      parameter( zero = 0.0e+0, one = 1.0e+0 )
      COMPLEX            CZERO, CONE
      parameter( czero = ( 0.0e+0, 0.0e+0 ),
     $                   cone = ( 1.0e+0, 0.0e+0 ) )
      INTEGER            LDT, LWORK
      parameter( ldt = 10, lwork = 2*ldt*ldt )
*     ..
*     .. Local Scalars ..
      INTEGER            I, IFST, ILST, INFO1, INFO2, J, N
      REAL               EPS, RES
      COMPLEX            CTEMP
*     ..
*     .. Local Arrays ..
      REAL               RESULT( 2 ), RWORK( LDT )
      COMPLEX            DIAG( LDT ), Q( LDT, LDT ), T1( LDT, LDT ),
     $                   T2( LDT, LDT ), TMP( LDT, LDT ), WORK( LWORK )
*     ..
*     .. External Functions ..
      REAL               SLAMCH
      EXTERNAL           slamch
*     ..
*     .. External Subroutines ..
      EXTERNAL           ccopy, chst01, clacpy, claset, ctrexc
*     ..
*     .. Executable Statements ..
*
      eps = slamch( 'P' )
      rmax = zero
      lmax = 0
      knt = 0
      ninfo = 0
*
*     Read input data until N=0
*
   10 CONTINUE
      READ( nin, fmt = * )n, ifst, ilst
      IF( n.EQ.0 )
     $   RETURN
      knt = knt + 1
      DO 20 i = 1, n
         READ( nin, fmt = * )( tmp( i, j ), j = 1, n )
   20 CONTINUE
      CALL clacpy( 'F', n, n, tmp, ldt, t1, ldt )
      CALL clacpy( 'F', n, n, tmp, ldt, t2, ldt )
      res = zero
*
*     Test without accumulating Q
*
      CALL claset( 'Full', n, n, czero, cone, q, ldt )
      CALL ctrexc( 'N', n, t1, ldt, q, ldt, ifst, ilst, info1 )
      DO 40 i = 1, n
         DO 30 j = 1, n
            IF( i.EQ.j .AND. q( i, j ).NE.cone )
     $         res = res + one / eps
            IF( i.NE.j .AND. q( i, j ).NE.czero )
     $         res = res + one / eps
   30    CONTINUE
   40 CONTINUE
*
*     Test with accumulating Q
*
      CALL claset( 'Full', n, n, czero, cone, q, ldt )
      CALL ctrexc( 'V', n, t2, ldt, q, ldt, ifst, ilst, info2 )
*
*     Compare T1 with T2
*
      DO 60 i = 1, n
         DO 50 j = 1, n
            IF( t1( i, j ).NE.t2( i, j ) )
     $         res = res + one / eps
   50    CONTINUE
   60 CONTINUE
      IF( info1.NE.0 .OR. info2.NE.0 )
     $   ninfo = ninfo + 1
      IF( info1.NE.info2 )
     $   res = res + one / eps
*
*     Test for successful reordering of T2
*
      CALL ccopy( n, tmp, ldt+1, diag, 1 )
      IF( ifst.LT.ilst ) THEN
         DO 70 i = ifst + 1, ilst
            ctemp = diag( i )
            diag( i ) = diag( i-1 )
            diag( i-1 ) = ctemp
   70    CONTINUE
      ELSE IF( ifst.GT.ilst ) THEN
         DO 80 i = ifst - 1, ilst, -1
            ctemp = diag( i+1 )
            diag( i+1 ) = diag( i )
            diag( i ) = ctemp
   80    CONTINUE
      END IF
      DO 90 i = 1, n
         IF( t2( i, i ).NE.diag( i ) )
     $      res = res + one / eps
   90 CONTINUE
*
*     Test for small residual, and orthogonality of Q
*
      CALL chst01( n, 1, n, tmp, ldt, t2, ldt, q, ldt, work, lwork,
     $             rwork, result )
      res = res + result( 1 ) + result( 2 )
*
*     Test for T2 being in Schur form
*
      DO 110 j = 1, n - 1
         DO 100 i = j + 1, n
            IF( t2( i, j ).NE.czero )
     $         res = res + one / eps
  100    CONTINUE
  110 CONTINUE
      IF( res.GT.rmax ) THEN
         rmax = res
         lmax = knt
      END IF
      GO TO 10
*
*     End of CGET36
*

Here is the call graph for this function:

Here is the caller graph for this function: