LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 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.
Date
November 2011

Definition at line 87 of file cget36.f.

87 *
88 * -- LAPACK test routine (version 3.4.0) --
89 * -- LAPACK is a software package provided by Univ. of Tennessee, --
90 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
91 * November 2011
92 *
93 * .. Scalar Arguments ..
94  INTEGER knt, lmax, nin, ninfo
95  REAL rmax
96 * ..
97 *
98 * =====================================================================
99 *
100 * .. Parameters ..
101  REAL zero, one
102  parameter ( zero = 0.0e+0, one = 1.0e+0 )
103  COMPLEX czero, cone
104  parameter ( czero = ( 0.0e+0, 0.0e+0 ),
105  \$ cone = ( 1.0e+0, 0.0e+0 ) )
106  INTEGER ldt, lwork
107  parameter ( ldt = 10, lwork = 2*ldt*ldt )
108 * ..
109 * .. Local Scalars ..
110  INTEGER i, ifst, ilst, info1, info2, j, n
111  REAL eps, res
112  COMPLEX ctemp
113 * ..
114 * .. Local Arrays ..
115  REAL result( 2 ), rwork( ldt )
116  COMPLEX diag( ldt ), q( ldt, ldt ), t1( ldt, ldt ),
117  \$ t2( ldt, ldt ), tmp( ldt, ldt ), work( lwork )
118 * ..
119 * .. External Functions ..
120  REAL slamch
121  EXTERNAL slamch
122 * ..
123 * .. External Subroutines ..
124  EXTERNAL ccopy, chst01, clacpy, claset, ctrexc
125 * ..
126 * .. Executable Statements ..
127 *
128  eps = slamch( 'P' )
129  rmax = zero
130  lmax = 0
131  knt = 0
132  ninfo = 0
133 *
134 * Read input data until N=0
135 *
136  10 CONTINUE
137  READ( nin, fmt = * )n, ifst, ilst
138  IF( n.EQ.0 )
139  \$ RETURN
140  knt = knt + 1
141  DO 20 i = 1, n
142  READ( nin, fmt = * )( tmp( i, j ), j = 1, n )
143  20 CONTINUE
144  CALL clacpy( 'F', n, n, tmp, ldt, t1, ldt )
145  CALL clacpy( 'F', n, n, tmp, ldt, t2, ldt )
146  res = zero
147 *
148 * Test without accumulating Q
149 *
150  CALL claset( 'Full', n, n, czero, cone, q, ldt )
151  CALL ctrexc( 'N', n, t1, ldt, q, ldt, ifst, ilst, info1 )
152  DO 40 i = 1, n
153  DO 30 j = 1, n
154  IF( i.EQ.j .AND. q( i, j ).NE.cone )
155  \$ res = res + one / eps
156  IF( i.NE.j .AND. q( i, j ).NE.czero )
157  \$ res = res + one / eps
158  30 CONTINUE
159  40 CONTINUE
160 *
161 * Test with accumulating Q
162 *
163  CALL claset( 'Full', n, n, czero, cone, q, ldt )
164  CALL ctrexc( 'V', n, t2, ldt, q, ldt, ifst, ilst, info2 )
165 *
166 * Compare T1 with T2
167 *
168  DO 60 i = 1, n
169  DO 50 j = 1, n
170  IF( t1( i, j ).NE.t2( i, j ) )
171  \$ res = res + one / eps
172  50 CONTINUE
173  60 CONTINUE
174  IF( info1.NE.0 .OR. info2.NE.0 )
175  \$ ninfo = ninfo + 1
176  IF( info1.NE.info2 )
177  \$ res = res + one / eps
178 *
179 * Test for successful reordering of T2
180 *
181  CALL ccopy( n, tmp, ldt+1, diag, 1 )
182  IF( ifst.LT.ilst ) THEN
183  DO 70 i = ifst + 1, ilst
184  ctemp = diag( i )
185  diag( i ) = diag( i-1 )
186  diag( i-1 ) = ctemp
187  70 CONTINUE
188  ELSE IF( ifst.GT.ilst ) THEN
189  DO 80 i = ifst - 1, ilst, -1
190  ctemp = diag( i+1 )
191  diag( i+1 ) = diag( i )
192  diag( i ) = ctemp
193  80 CONTINUE
194  END IF
195  DO 90 i = 1, n
196  IF( t2( i, i ).NE.diag( i ) )
197  \$ res = res + one / eps
198  90 CONTINUE
199 *
200 * Test for small residual, and orthogonality of Q
201 *
202  CALL chst01( n, 1, n, tmp, ldt, t2, ldt, q, ldt, work, lwork,
203  \$ rwork, result )
204  res = res + result( 1 ) + result( 2 )
205 *
206 * Test for T2 being in Schur form
207 *
208  DO 110 j = 1, n - 1
209  DO 100 i = j + 1, n
210  IF( t2( i, j ).NE.czero )
211  \$ res = res + one / eps
212  100 CONTINUE
213  110 CONTINUE
214  IF( res.GT.rmax ) THEN
215  rmax = res
216  lmax = knt
217  END IF
218  GO TO 10
219 *
220 * End of CGET36
221 *
subroutine chst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RWORK, RESULT)
CHST01
Definition: chst01.f:142
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:52
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine ctrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO)
CTREXC
Definition: ctrexc.f:126

Here is the call graph for this function:

Here is the caller graph for this function: