LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ csyl01()

 subroutine csyl01 ( real THRESH, integer, dimension( 3 ) NFAIL, real, dimension( 2 ) RMAX, integer, dimension( 2 ) NINFO, integer KNT )

CSYL01

Purpose:
``` CSYL01 tests CTRSYL and CTRSYL3, routines for solving the Sylvester matrix
equation

op(A)*X + ISGN*X*op(B) = scale*C,

where op(A) and op(B) are both upper triangular form, op() represents an
optional conjugate transpose, and ISGN can be -1 or +1. Scale is an output
less than or equal to 1, chosen to avoid overflow in X.

The test code verifies that the following residual does not exceed
the provided threshold:

norm(op(A)*X + ISGN*X*op(B) - scale*C) /
(EPS*max(norm(A),norm(B))*norm(X))

This routine complements CGET35 by testing with larger,
random matrices, of which some require rescaling of X to avoid overflow.```
Parameters
 [in] THRESH ``` THRESH is REAL A test will count as "failed" if the residual, computed as described above, exceeds THRESH.``` [out] NFAIL ``` NFAIL is INTEGER array, dimension (3) NFAIL(1) = No. of times residual CTRSYL exceeds threshold THRESH NFAIL(2) = No. of times residual CTRSYL3 exceeds threshold THRESH NFAIL(3) = No. of times CTRSYL3 and CTRSYL deviate``` [out] RMAX ``` RMAX is DOUBLE PRECISION array, dimension (2) RMAX(1) = Value of the largest test ratio of CTRSYL RMAX(2) = Value of the largest test ratio of CTRSYL3``` [out] NINFO ``` NINFO is INTEGER array, dimension (2) NINFO(1) = No. of times CTRSYL where INFO is nonzero NINFO(2) = No. of times CTRSYL3 where INFO is nonzero``` [out] KNT ``` KNT is INTEGER Total number of examples tested.```

Definition at line 88 of file csyl01.f.

89 IMPLICIT NONE
90*
91* -- LAPACK test routine --
92* -- LAPACK is a software package provided by Univ. of Tennessee, --
93* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
94*
95* .. Scalar Arguments ..
96 INTEGER KNT
97 REAL THRESH
98* ..
99* .. Array Arguments ..
100 INTEGER NFAIL( 3 ), NINFO( 2 )
101 REAL RMAX( 2 )
102* ..
103*
104* =====================================================================
105* ..
106* .. Parameters ..
107 COMPLEX CONE
108 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
109 REAL ONE, ZERO
110 parameter( zero = 0.0e+0, one = 1.0e+0 )
111 INTEGER MAXM, MAXN, LDSWORK
112 parameter( maxm = 101, maxn = 138, ldswork = 18 )
113* ..
114* .. Local Scalars ..
115 CHARACTER TRANA, TRANB
116 INTEGER I, INFO, IINFO, ISGN, ITRANA, ITRANB, J, KLA,
117 \$ KUA, KLB, KUB, M, N
118 REAL ANRM, BNRM, BIGNUM, EPS, RES, RES1,
119 \$ SCALE, SCALE3, SMLNUM, TNRM, XNRM
120 COMPLEX RMUL
121* ..
122* .. Local Arrays ..
123 COMPLEX A( MAXM, MAXM ), B( MAXN, MAXN ),
124 \$ C( MAXM, MAXN ), CC( MAXM, MAXN ),
125 \$ X( MAXM, MAXN ),
126 \$ DUML( MAXM ), DUMR( MAXN ),
127 \$ D( MIN( MAXM, MAXN ) )
128 REAL SWORK( LDSWORK, 54 ), DUM( MAXN ), VM( 2 )
129 INTEGER ISEED( 4 ), IWORK( MAXM + MAXN + 2 )
130* ..
131* .. External Functions ..
132 LOGICAL SISNAN
133 REAL SLAMCH, CLANGE
134 EXTERNAL sisnan, slamch, clange
135* ..
136* .. External Subroutines ..
137 EXTERNAL clatmr, clacpy, cgemm, ctrsyl, ctrsyl3
138* ..
139* .. Intrinsic Functions ..
140 INTRINSIC abs, real, max
141* ..
142* .. Executable Statements ..
143*
144* Get machine parameters
145*
146 eps = slamch( 'P' )
147 smlnum = slamch( 'S' ) / eps
148 bignum = one / smlnum
149*
150* Expect INFO = 0
151 vm( 1 ) = one
152* Expect INFO = 1
153 vm( 2 ) = 0.5e+0
154*
155* Begin test loop
156*
157 ninfo( 1 ) = 0
158 ninfo( 2 ) = 0
159 nfail( 1 ) = 0
160 nfail( 2 ) = 0
161 nfail( 3 ) = 0
162 rmax( 1 ) = zero
163 rmax( 2 ) = zero
164 knt = 0
165 iseed( 1 ) = 1
166 iseed( 2 ) = 1
167 iseed( 3 ) = 1
168 iseed( 4 ) = 1
169 scale = one
170 scale3 = one
171 DO j = 1, 2
172 DO isgn = -1, 1, 2
173* Reset seed (overwritten by LATMR)
174 iseed( 1 ) = 1
175 iseed( 2 ) = 1
176 iseed( 3 ) = 1
177 iseed( 4 ) = 1
178 DO m = 32, maxm, 23
179 kla = 0
180 kua = m - 1
181 CALL clatmr( m, m, 'S', iseed, 'N', d,
182 \$ 6, one, cone, 'T', 'N',
183 \$ duml, 1, one, dumr, 1, one,
184 \$ 'N', iwork, kla, kua, zero,
185 \$ one, 'NO', a, maxm, iwork,
186 \$ iinfo )
187 DO i = 1, m
188 a( i, i ) = a( i, i ) * vm( j )
189 END DO
190 anrm = clange( 'M', m, m, a, maxm, dum )
191 DO n = 51, maxn, 29
192 klb = 0
193 kub = n - 1
194 CALL clatmr( n, n, 'S', iseed, 'N', d,
195 \$ 6, one, cone, 'T', 'N',
196 \$ duml, 1, one, dumr, 1, one,
197 \$ 'N', iwork, klb, kub, zero,
198 \$ one, 'NO', b, maxn, iwork,
199 \$ iinfo )
200 DO i = 1, n
201 b( i, i ) = b( i, i ) * vm( j )
202 END DO
203 bnrm = clange( 'M', n, n, b, maxn, dum )
204 tnrm = max( anrm, bnrm )
205 CALL clatmr( m, n, 'S', iseed, 'N', d,
206 \$ 6, one, cone, 'T', 'N',
207 \$ duml, 1, one, dumr, 1, one,
208 \$ 'N', iwork, m, n, zero, one,
209 \$ 'NO', c, maxm, iwork, iinfo )
210 DO itrana = 1, 2
211 IF( itrana.EQ.1 )
212 \$ trana = 'N'
213 IF( itrana.EQ.2 )
214 \$ trana = 'C'
215 DO itranb = 1, 2
216 IF( itranb.EQ.1 )
217 \$ tranb = 'N'
218 IF( itranb.EQ.2 )
219 \$ tranb = 'C'
220 knt = knt + 1
221*
222 CALL clacpy( 'All', m, n, c, maxm, x, maxm)
223 CALL clacpy( 'All', m, n, c, maxm, cc, maxm)
224 CALL ctrsyl( trana, tranb, isgn, m, n,
225 \$ a, maxm, b, maxn, x, maxm,
226 \$ scale, iinfo )
227 IF( iinfo.NE.0 )
228 \$ ninfo( 1 ) = ninfo( 1 ) + 1
229 xnrm = clange( 'M', m, n, x, maxm, dum )
230 rmul = cone
231 IF( xnrm.GT.one .AND. tnrm.GT.one ) THEN
232 IF( xnrm.GT.bignum / tnrm ) THEN
233 rmul = cone / max( xnrm, tnrm )
234 END IF
235 END IF
236 CALL cgemm( trana, 'N', m, n, m, rmul,
237 \$ a, maxm, x, maxm, -scale*rmul,
238 \$ cc, maxm )
239 CALL cgemm( 'N', tranb, m, n, n,
240 \$ real( isgn )*rmul, x, maxm, b,
241 \$ maxn, cone, cc, maxm )
242 res1 = clange( 'M', m, n, cc, maxm, dum )
243 res = res1 / max( smlnum, smlnum*xnrm,
244 \$ ( ( abs( rmul )*tnrm )*eps )*xnrm )
245 IF( res.GT.thresh )
246 \$ nfail( 1 ) = nfail( 1 ) + 1
247 IF( res.GT.rmax( 1 ) )
248 \$ rmax( 1 ) = res
249*
250 CALL clacpy( 'All', m, n, c, maxm, x, maxm )
251 CALL clacpy( 'All', m, n, c, maxm, cc, maxm )
252 CALL ctrsyl3( trana, tranb, isgn, m, n,
253 \$ a, maxm, b, maxn, x, maxm,
254 \$ scale3, swork, ldswork, info)
255 IF( info.NE.0 )
256 \$ ninfo( 2 ) = ninfo( 2 ) + 1
257 xnrm = clange( 'M', m, n, x, maxm, dum )
258 rmul = cone
259 IF( xnrm.GT.one .AND. tnrm.GT.one ) THEN
260 IF( xnrm.GT.bignum / tnrm ) THEN
261 rmul = cone / max( xnrm, tnrm )
262 END IF
263 END IF
264 CALL cgemm( trana, 'N', m, n, m, rmul,
265 \$ a, maxm, x, maxm, -scale3*rmul,
266 \$ cc, maxm )
267 CALL cgemm( 'N', tranb, m, n, n,
268 \$ real( isgn )*rmul, x, maxm, b,
269 \$ maxn, cone, cc, maxm )
270 res1 = clange( 'M', m, n, cc, maxm, dum )
271 res = res1 / max( smlnum, smlnum*xnrm,
272 \$ ( ( abs( rmul )*tnrm )*eps )*xnrm )
273* Verify that TRSYL3 only flushes if TRSYL flushes (but
274* there may be cases where TRSYL3 avoid flushing).
275 IF( scale3.EQ.zero .AND. scale.GT.zero .OR.
276 \$ iinfo.NE.info ) THEN
277 nfail( 3 ) = nfail( 3 ) + 1
278 END IF
279 IF( res.GT.thresh .OR. sisnan( res ) )
280 \$ nfail( 2 ) = nfail( 2 ) + 1
281 IF( res.GT.rmax( 2 ) )
282 \$ rmax( 2 ) = res
283 END DO
284 END DO
285 END DO
286 END DO
287 END DO
288 END DO
289*
290 RETURN
291*
292* End of CSYL01
293*
logical function sisnan(SIN)
SISNAN tests input for NaN.
Definition: sisnan.f:59
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
Definition: cgemm.f:187
subroutine clatmr(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER, CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM, PACK, A, LDA, IWORK, INFO)
CLATMR
Definition: clatmr.f:490
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: clange.f:115
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:103
subroutine ctrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
CTRSYL
Definition: ctrsyl.f:157
subroutine ctrsyl3(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, SWORK, LDSWORK, INFO)
CTRSYL3
Definition: ctrsyl3.f:156
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the call graph for this function:
Here is the caller graph for this function: