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

◆ cget35()

subroutine cget35 ( real  RMAX,
integer  LMAX,
integer  NINFO,
integer  KNT,
integer  NIN 
)

CGET35

Purpose:
 CGET35 tests CTRSYL, a routine for solving the Sylvester matrix
 equation

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

 A and B are assumed to be in Schur canonical form, op() represents an
 optional 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 is order 1:

    norm(op(A)*X + ISGN*X*op(B) - scale*C) /
        (EPS*max(norm(A),norm(B))*norm(X))
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 83 of file cget35.f.

84*
85* -- LAPACK test routine --
86* -- LAPACK is a software package provided by Univ. of Tennessee, --
87* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
88*
89* .. Scalar Arguments ..
90 INTEGER KNT, LMAX, NIN, NINFO
91 REAL RMAX
92* ..
93*
94* =====================================================================
95*
96* .. Parameters ..
97 INTEGER LDT
98 parameter( ldt = 10 )
99 REAL ZERO, ONE, TWO
100 parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0 )
101 REAL LARGE
102 parameter( large = 1.0e6 )
103 COMPLEX CONE
104 parameter( cone = 1.0e0 )
105* ..
106* .. Local Scalars ..
107 CHARACTER TRANA, TRANB
108 INTEGER I, IMLA, IMLAD, IMLB, IMLC, INFO, ISGN, ITRANA,
109 $ ITRANB, J, M, N
110 REAL BIGNUM, EPS, RES, RES1, SCALE, SMLNUM, TNRM,
111 $ XNRM
112 COMPLEX RMUL
113* ..
114* .. Local Arrays ..
115 REAL DUM( 1 ), VM1( 3 ), VM2( 3 )
116 COMPLEX A( LDT, LDT ), ATMP( LDT, LDT ), B( LDT, LDT ),
117 $ BTMP( LDT, LDT ), C( LDT, LDT ),
118 $ CSAV( LDT, LDT ), CTMP( LDT, LDT )
119* ..
120* .. External Functions ..
121 REAL CLANGE, SLAMCH
122 EXTERNAL clange, slamch
123* ..
124* .. External Subroutines ..
125 EXTERNAL cgemm, ctrsyl
126* ..
127* .. Intrinsic Functions ..
128 INTRINSIC abs, max, real, sqrt
129* ..
130* .. Executable Statements ..
131*
132* Get machine parameters
133*
134 eps = slamch( 'P' )
135 smlnum = slamch( 'S' ) / eps
136 bignum = one / smlnum
137 CALL slabad( smlnum, bignum )
138*
139* Set up test case parameters
140*
141 vm1( 1 ) = sqrt( smlnum )
142 vm1( 2 ) = one
143 vm1( 3 ) = large
144 vm2( 1 ) = one
145 vm2( 2 ) = one + two*eps
146 vm2( 3 ) = two
147*
148 knt = 0
149 ninfo = 0
150 lmax = 0
151 rmax = zero
152*
153* Begin test loop
154*
155 10 CONTINUE
156 READ( nin, fmt = * )m, n
157 IF( n.EQ.0 )
158 $ RETURN
159 DO 20 i = 1, m
160 READ( nin, fmt = * )( atmp( i, j ), j = 1, m )
161 20 CONTINUE
162 DO 30 i = 1, n
163 READ( nin, fmt = * )( btmp( i, j ), j = 1, n )
164 30 CONTINUE
165 DO 40 i = 1, m
166 READ( nin, fmt = * )( ctmp( i, j ), j = 1, n )
167 40 CONTINUE
168 DO 170 imla = 1, 3
169 DO 160 imlad = 1, 3
170 DO 150 imlb = 1, 3
171 DO 140 imlc = 1, 3
172 DO 130 itrana = 1, 2
173 DO 120 itranb = 1, 2
174 DO 110 isgn = -1, 1, 2
175 IF( itrana.EQ.1 )
176 $ trana = 'N'
177 IF( itrana.EQ.2 )
178 $ trana = 'C'
179 IF( itranb.EQ.1 )
180 $ tranb = 'N'
181 IF( itranb.EQ.2 )
182 $ tranb = 'C'
183 tnrm = zero
184 DO 60 i = 1, m
185 DO 50 j = 1, m
186 a( i, j ) = atmp( i, j )*vm1( imla )
187 tnrm = max( tnrm, abs( a( i, j ) ) )
188 50 CONTINUE
189 a( i, i ) = a( i, i )*vm2( imlad )
190 tnrm = max( tnrm, abs( a( i, i ) ) )
191 60 CONTINUE
192 DO 80 i = 1, n
193 DO 70 j = 1, n
194 b( i, j ) = btmp( i, j )*vm1( imlb )
195 tnrm = max( tnrm, abs( b( i, j ) ) )
196 70 CONTINUE
197 80 CONTINUE
198 IF( tnrm.EQ.zero )
199 $ tnrm = one
200 DO 100 i = 1, m
201 DO 90 j = 1, n
202 c( i, j ) = ctmp( i, j )*vm1( imlc )
203 csav( i, j ) = c( i, j )
204 90 CONTINUE
205 100 CONTINUE
206 knt = knt + 1
207 CALL ctrsyl( trana, tranb, isgn, m, n, a,
208 $ ldt, b, ldt, c, ldt, scale,
209 $ info )
210 IF( info.NE.0 )
211 $ ninfo = ninfo + 1
212 xnrm = clange( 'M', m, n, c, ldt, dum )
213 rmul = cone
214 IF( xnrm.GT.one .AND. tnrm.GT.one ) THEN
215 IF( xnrm.GT.bignum / tnrm ) THEN
216 rmul = max( xnrm, tnrm )
217 rmul = cone / rmul
218 END IF
219 END IF
220 CALL cgemm( trana, 'N', m, n, m, rmul, a,
221 $ ldt, c, ldt, -scale*rmul, csav,
222 $ ldt )
223 CALL cgemm( 'N', tranb, m, n, n,
224 $ real( isgn )*rmul, c, ldt, b,
225 $ ldt, cone, csav, ldt )
226 res1 = clange( 'M', m, n, csav, ldt, dum )
227 res = res1 / max( smlnum, smlnum*xnrm,
228 $ ( ( abs( rmul )*tnrm )*eps )*xnrm )
229 IF( res.GT.rmax ) THEN
230 lmax = knt
231 rmax = res
232 END IF
233 110 CONTINUE
234 120 CONTINUE
235 130 CONTINUE
236 140 CONTINUE
237 150 CONTINUE
238 160 CONTINUE
239 170 CONTINUE
240 GO TO 10
241*
242* End of CGET35
243*
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
Definition: cgemm.f:187
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 ctrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
CTRSYL
Definition: ctrsyl.f:157
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: