LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
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*
sisnan
logical function sisnan(SIN)
SISNAN tests input for NaN.
Definition: sisnan.f:59
cgemm
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
Definition: cgemm.f:187
clatmr
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
clange
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
clacpy
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
ctrsyl
subroutine ctrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
CTRSYL
Definition: ctrsyl.f:157
ctrsyl3
subroutine ctrsyl3(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, SWORK, LDSWORK, INFO)
CTRSYL3
Definition: ctrsyl3.f:156
slamch
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: