LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine dget35 ( double precision  RMAX,
integer  LMAX,
integer  NINFO,
integer  KNT 
)

DGET35

Purpose: 
 DGET35 tests DTRSYL, 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 DOUBLE PRECISION
          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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 80 of file dget35.f.

80 *
81 * -- LAPACK test routine (version 3.4.0) --
82 * -- LAPACK is a software package provided by Univ. of Tennessee, --
83 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
84 * November 2011
85 *
86 * .. Scalar Arguments ..
87  INTEGER knt, lmax, ninfo
88  DOUBLE PRECISION rmax
89 * ..
90 *
91 * =====================================================================
92 *
93 * .. Parameters ..
94  DOUBLE PRECISION zero, one
95  parameter ( zero = 0.0d0, one = 1.0d0 )
96  DOUBLE PRECISION two, four
97  parameter ( two = 2.0d0, four = 4.0d0 )
98 * ..
99 * .. Local Scalars ..
100  CHARACTER trana, tranb
101  INTEGER i, ima, imb, imlda1, imlda2, imldb1, imloff,
102  $ info, isgn, itrana, itranb, j, m, n
103  DOUBLE PRECISION bignum, cnrm, eps, res, res1, rmul, scale,
104  $ smlnum, tnrm, xnrm
105 * ..
106 * .. Local Arrays ..
107  INTEGER idim( 8 ), ival( 6, 6, 8 )
108  DOUBLE PRECISION a( 6, 6 ), b( 6, 6 ), c( 6, 6 ), cc( 6, 6 ),
109  $ dum( 1 ), vm1( 3 ), vm2( 3 )
110 * ..
111 * .. External Functions ..
112  DOUBLE PRECISION dlamch, dlange
113  EXTERNAL dlamch, dlange
114 * ..
115 * .. External Subroutines ..
116  EXTERNAL dgemm, dlabad, dtrsyl
117 * ..
118 * .. Intrinsic Functions ..
119  INTRINSIC abs, dble, max, sin, sqrt
120 * ..
121 * .. Data statements ..
122  DATA idim / 1, 2, 3, 4, 3, 3, 6, 4 /
123  DATA ival / 1, 35*0, 1, 2, 4*0, -2, 0, 28*0, 1, 5*0,
124  $ 5, 1, 2, 3*0, -8, -2, 1, 21*0, 3, 4, 4*0, -5,
125  $ 3, 4*0, 1, 2, 1, 4, 2*0, -3, -9, -1, 1, 14*0,
126  $ 1, 5*0, 2, 3, 4*0, 5, 6, 7, 21*0, 1, 5*0, 1, 3,
127  $ -4, 3*0, 2, 5, 2, 21*0, 1, 2, 4*0, -2, 0, 4*0,
128  $ 5, 6, 3, 4, 2*0, -1, -9, -5, 2, 2*0, 4*8, 5, 6,
129  $ 4*9, -7, 5, 1, 5*0, 1, 5, 2, 3*0, 2, -21, 5,
130  $ 3*0, 1, 2, 3, 4, 14*0 /
131 * ..
132 * .. Executable Statements ..
133 *
134 * Get machine parameters
135 *
136  eps = dlamch( 'P' )
137  smlnum = dlamch( 'S' )*four / eps
138  bignum = one / smlnum
139  CALL dlabad( smlnum, bignum )
140 *
141 * Set up test case parameters
142 *
143  vm1( 1 ) = sqrt( smlnum )
144  vm1( 2 ) = one
145  vm1( 3 ) = sqrt( bignum )
146  vm2( 1 ) = one
147  vm2( 2 ) = one + two*eps
148  vm2( 3 ) = two
149 *
150  knt = 0
151  ninfo = 0
152  lmax = 0
153  rmax = zero
154 *
155 * Begin test loop
156 *
157  DO 150 itrana = 1, 2
158  DO 140 itranb = 1, 2
159  DO 130 isgn = -1, 1, 2
160  DO 120 ima = 1, 8
161  DO 110 imlda1 = 1, 3
162  DO 100 imlda2 = 1, 3
163  DO 90 imloff = 1, 2
164  DO 80 imb = 1, 8
165  DO 70 imldb1 = 1, 3
166  IF( itrana.EQ.1 )
167  $ trana = 'N'
168  IF( itrana.EQ.2 )
169  $ trana = 'T'
170  IF( itranb.EQ.1 )
171  $ tranb = 'N'
172  IF( itranb.EQ.2 )
173  $ tranb = 'T'
174  m = idim( ima )
175  n = idim( imb )
176  tnrm = zero
177  DO 20 i = 1, m
178  DO 10 j = 1, m
179  a( i, j ) = ival( i, j, ima )
180  IF( abs( i-j ).LE.1 ) THEN
181  a( i, j ) = a( i, j )*
182  $ vm1( imlda1 )
183  a( i, j ) = a( i, j )*
184  $ vm2( imlda2 )
185  ELSE
186  a( i, j ) = a( i, j )*
187  $ vm1( imloff )
188  END IF
189  tnrm = max( tnrm,
190  $ abs( a( i, j ) ) )
191  10 CONTINUE
192  20 CONTINUE
193  DO 40 i = 1, n
194  DO 30 j = 1, n
195  b( i, j ) = ival( i, j, imb )
196  IF( abs( i-j ).LE.1 ) THEN
197  b( i, j ) = b( i, j )*
198  $ vm1( imldb1 )
199  ELSE
200  b( i, j ) = b( i, j )*
201  $ vm1( imloff )
202  END IF
203  tnrm = max( tnrm,
204  $ abs( b( i, j ) ) )
205  30 CONTINUE
206  40 CONTINUE
207  cnrm = zero
208  DO 60 i = 1, m
209  DO 50 j = 1, n
210  c( i, j ) = sin( dble( i*j ) )
211  cnrm = max( cnrm, c( i, j ) )
212  cc( i, j ) = c( i, j )
213  50 CONTINUE
214  60 CONTINUE
215  knt = knt + 1
216  CALL dtrsyl( trana, tranb, isgn, m, n,
217  $ a, 6, b, 6, c, 6, scale,
218  $ info )
219  IF( info.NE.0 )
220  $ ninfo = ninfo + 1
221  xnrm = dlange( 'M', m, n, c, 6, dum )
222  rmul = one
223  IF( xnrm.GT.one .AND. tnrm.GT.one )
224  $ THEN
225  IF( xnrm.GT.bignum / tnrm ) THEN
226  rmul = one / max( xnrm, tnrm )
227  END IF
228  END IF
229  CALL dgemm( trana, 'N', m, n, m, rmul,
230  $ a, 6, c, 6, -scale*rmul,
231  $ cc, 6 )
232  CALL dgemm( 'N', tranb, m, n, n,
233  $ dble( isgn )*rmul, c, 6, b,
234  $ 6, one, cc, 6 )
235  res1 = dlange( 'M', m, n, cc, 6, dum )
236  res = res1 / max( smlnum, smlnum*xnrm,
237  $ ( ( rmul*tnrm )*eps )*xnrm )
238  IF( res.GT.rmax ) THEN
239  lmax = knt
240  rmax = res
241  END IF
242  70 CONTINUE
243  80 CONTINUE
244  90 CONTINUE
245  100 CONTINUE
246  110 CONTINUE
247  120 CONTINUE
248  130 CONTINUE
249  140 CONTINUE
250  150 CONTINUE
251 *
252  RETURN
253 *
254 * End of DGET35
255 *
dlamch
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
dgemm
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
Definition: dgemm.f:189
dlabad
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
dlange
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
dtrsyl
subroutine dtrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
DTRSYL
Definition: dtrsyl.f:166

Here is the call graph for this function:

Here is the caller graph for this function: