1 SUBROUTINE DGET35( RMAX, LMAX, NINFO, KNT )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER KNT, LMAX, NINFO
9 DOUBLE PRECISION RMAX
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DGET35 tests DTRSYL, a routine for solving the Sylvester matrix
16 * equation
17 *
18 * op(A)*X + ISGN*X*op(B) = scale*C,
19 *
20 * A and B are assumed to be in Schur canonical form, op() represents an
21 * optional transpose, and ISGN can be -1 or +1. Scale is an output
22 * less than or equal to 1, chosen to avoid overflow in X.
23 *
24 * The test code verifies that the following residual is order 1:
25 *
26 * norm(op(A)*X + ISGN*X*op(B) - scale*C) /
27 * (EPS*max(norm(A),norm(B))*norm(X))
28 *
29 * Arguments
30 * ==========
31 *
32 * RMAX (output) DOUBLE PRECISION
33 * Value of the largest test ratio.
34 *
35 * LMAX (output) INTEGER
36 * Example number where largest test ratio achieved.
37 *
38 * NINFO (output) INTEGER
39 * Number of examples where INFO is nonzero.
40 *
41 * KNT (output) INTEGER
42 * Total number of examples tested.
43 *
44 * =====================================================================
45 *
46 * .. Parameters ..
47 DOUBLE PRECISION ZERO, ONE
48 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
49 DOUBLE PRECISION TWO, FOUR
50 PARAMETER ( TWO = 2.0D0, FOUR = 4.0D0 )
51 * ..
52 * .. Local Scalars ..
53 CHARACTER TRANA, TRANB
54 INTEGER I, IMA, IMB, IMLDA1, IMLDA2, IMLDB1, IMLOFF,
55 $ INFO, ISGN, ITRANA, ITRANB, J, M, N
56 DOUBLE PRECISION BIGNUM, CNRM, EPS, RES, RES1, RMUL, SCALE,
57 $ SMLNUM, TNRM, XNRM
58 * ..
59 * .. Local Arrays ..
60 INTEGER IDIM( 8 ), IVAL( 6, 6, 8 )
61 DOUBLE PRECISION A( 6, 6 ), B( 6, 6 ), C( 6, 6 ), CC( 6, 6 ),
62 $ DUM( 1 ), VM1( 3 ), VM2( 3 )
63 * ..
64 * .. External Functions ..
65 DOUBLE PRECISION DLAMCH, DLANGE
66 EXTERNAL DLAMCH, DLANGE
67 * ..
68 * .. External Subroutines ..
69 EXTERNAL DGEMM, DLABAD, DTRSYL
70 * ..
71 * .. Intrinsic Functions ..
72 INTRINSIC ABS, DBLE, MAX, SIN, SQRT
73 * ..
74 * .. Data statements ..
75 DATA IDIM / 1, 2, 3, 4, 3, 3, 6, 4 /
76 DATA IVAL / 1, 35*0, 1, 2, 4*0, -2, 0, 28*0, 1, 5*0,
77 $ 5, 1, 2, 3*0, -8, -2, 1, 21*0, 3, 4, 4*0, -5,
78 $ 3, 4*0, 1, 2, 1, 4, 2*0, -3, -9, -1, 1, 14*0,
79 $ 1, 5*0, 2, 3, 4*0, 5, 6, 7, 21*0, 1, 5*0, 1, 3,
80 $ -4, 3*0, 2, 5, 2, 21*0, 1, 2, 4*0, -2, 0, 4*0,
81 $ 5, 6, 3, 4, 2*0, -1, -9, -5, 2, 2*0, 4*8, 5, 6,
82 $ 4*9, -7, 5, 1, 5*0, 1, 5, 2, 3*0, 2, -21, 5,
83 $ 3*0, 1, 2, 3, 4, 14*0 /
84 * ..
85 * .. Executable Statements ..
86 *
87 * Get machine parameters
88 *
89 EPS = DLAMCH( 'P' )
90 SMLNUM = DLAMCH( 'S' )*FOUR / EPS
91 BIGNUM = ONE / SMLNUM
92 CALL DLABAD( SMLNUM, BIGNUM )
93 *
94 * Set up test case parameters
95 *
96 VM1( 1 ) = SQRT( SMLNUM )
97 VM1( 2 ) = ONE
98 VM1( 3 ) = SQRT( BIGNUM )
99 VM2( 1 ) = ONE
100 VM2( 2 ) = ONE + TWO*EPS
101 VM2( 3 ) = TWO
102 *
103 KNT = 0
104 NINFO = 0
105 LMAX = 0
106 RMAX = ZERO
107 *
108 * Begin test loop
109 *
110 DO 150 ITRANA = 1, 2
111 DO 140 ITRANB = 1, 2
112 DO 130 ISGN = -1, 1, 2
113 DO 120 IMA = 1, 8
114 DO 110 IMLDA1 = 1, 3
115 DO 100 IMLDA2 = 1, 3
116 DO 90 IMLOFF = 1, 2
117 DO 80 IMB = 1, 8
118 DO 70 IMLDB1 = 1, 3
119 IF( ITRANA.EQ.1 )
120 $ TRANA = 'N'
121 IF( ITRANA.EQ.2 )
122 $ TRANA = 'T'
123 IF( ITRANB.EQ.1 )
124 $ TRANB = 'N'
125 IF( ITRANB.EQ.2 )
126 $ TRANB = 'T'
127 M = IDIM( IMA )
128 N = IDIM( IMB )
129 TNRM = ZERO
130 DO 20 I = 1, M
131 DO 10 J = 1, M
132 A( I, J ) = IVAL( I, J, IMA )
133 IF( ABS( I-J ).LE.1 ) THEN
134 A( I, J ) = A( I, J )*
135 $ VM1( IMLDA1 )
136 A( I, J ) = A( I, J )*
137 $ VM2( IMLDA2 )
138 ELSE
139 A( I, J ) = A( I, J )*
140 $ VM1( IMLOFF )
141 END IF
142 TNRM = MAX( TNRM,
143 $ ABS( A( I, J ) ) )
144 10 CONTINUE
145 20 CONTINUE
146 DO 40 I = 1, N
147 DO 30 J = 1, N
148 B( I, J ) = IVAL( I, J, IMB )
149 IF( ABS( I-J ).LE.1 ) THEN
150 B( I, J ) = B( I, J )*
151 $ VM1( IMLDB1 )
152 ELSE
153 B( I, J ) = B( I, J )*
154 $ VM1( IMLOFF )
155 END IF
156 TNRM = MAX( TNRM,
157 $ ABS( B( I, J ) ) )
158 30 CONTINUE
159 40 CONTINUE
160 CNRM = ZERO
161 DO 60 I = 1, M
162 DO 50 J = 1, N
163 C( I, J ) = SIN( DBLE( I*J ) )
164 CNRM = MAX( CNRM, C( I, J ) )
165 CC( I, J ) = C( I, J )
166 50 CONTINUE
167 60 CONTINUE
168 KNT = KNT + 1
169 CALL DTRSYL( TRANA, TRANB, ISGN, M, N,
170 $ A, 6, B, 6, C, 6, SCALE,
171 $ INFO )
172 IF( INFO.NE.0 )
173 $ NINFO = NINFO + 1
174 XNRM = DLANGE( 'M', M, N, C, 6, DUM )
175 RMUL = ONE
176 IF( XNRM.GT.ONE .AND. TNRM.GT.ONE )
177 $ THEN
178 IF( XNRM.GT.BIGNUM / TNRM ) THEN
179 RMUL = ONE / MAX( XNRM, TNRM )
180 END IF
181 END IF
182 CALL DGEMM( TRANA, 'N', M, N, M, RMUL,
183 $ A, 6, C, 6, -SCALE*RMUL,
184 $ CC, 6 )
185 CALL DGEMM( 'N', TRANB, M, N, N,
186 $ DBLE( ISGN )*RMUL, C, 6, B,
187 $ 6, ONE, CC, 6 )
188 RES1 = DLANGE( 'M', M, N, CC, 6, DUM )
189 RES = RES1 / MAX( SMLNUM, SMLNUM*XNRM,
190 $ ( ( RMUL*TNRM )*EPS )*XNRM )
191 IF( RES.GT.RMAX ) THEN
192 LMAX = KNT
193 RMAX = RES
194 END IF
195 70 CONTINUE
196 80 CONTINUE
197 90 CONTINUE
198 100 CONTINUE
199 110 CONTINUE
200 120 CONTINUE
201 130 CONTINUE
202 140 CONTINUE
203 150 CONTINUE
204 *
205 RETURN
206 *
207 * End of DGET35
208 *
209 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER KNT, LMAX, NINFO
9 DOUBLE PRECISION RMAX
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DGET35 tests DTRSYL, a routine for solving the Sylvester matrix
16 * equation
17 *
18 * op(A)*X + ISGN*X*op(B) = scale*C,
19 *
20 * A and B are assumed to be in Schur canonical form, op() represents an
21 * optional transpose, and ISGN can be -1 or +1. Scale is an output
22 * less than or equal to 1, chosen to avoid overflow in X.
23 *
24 * The test code verifies that the following residual is order 1:
25 *
26 * norm(op(A)*X + ISGN*X*op(B) - scale*C) /
27 * (EPS*max(norm(A),norm(B))*norm(X))
28 *
29 * Arguments
30 * ==========
31 *
32 * RMAX (output) DOUBLE PRECISION
33 * Value of the largest test ratio.
34 *
35 * LMAX (output) INTEGER
36 * Example number where largest test ratio achieved.
37 *
38 * NINFO (output) INTEGER
39 * Number of examples where INFO is nonzero.
40 *
41 * KNT (output) INTEGER
42 * Total number of examples tested.
43 *
44 * =====================================================================
45 *
46 * .. Parameters ..
47 DOUBLE PRECISION ZERO, ONE
48 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
49 DOUBLE PRECISION TWO, FOUR
50 PARAMETER ( TWO = 2.0D0, FOUR = 4.0D0 )
51 * ..
52 * .. Local Scalars ..
53 CHARACTER TRANA, TRANB
54 INTEGER I, IMA, IMB, IMLDA1, IMLDA2, IMLDB1, IMLOFF,
55 $ INFO, ISGN, ITRANA, ITRANB, J, M, N
56 DOUBLE PRECISION BIGNUM, CNRM, EPS, RES, RES1, RMUL, SCALE,
57 $ SMLNUM, TNRM, XNRM
58 * ..
59 * .. Local Arrays ..
60 INTEGER IDIM( 8 ), IVAL( 6, 6, 8 )
61 DOUBLE PRECISION A( 6, 6 ), B( 6, 6 ), C( 6, 6 ), CC( 6, 6 ),
62 $ DUM( 1 ), VM1( 3 ), VM2( 3 )
63 * ..
64 * .. External Functions ..
65 DOUBLE PRECISION DLAMCH, DLANGE
66 EXTERNAL DLAMCH, DLANGE
67 * ..
68 * .. External Subroutines ..
69 EXTERNAL DGEMM, DLABAD, DTRSYL
70 * ..
71 * .. Intrinsic Functions ..
72 INTRINSIC ABS, DBLE, MAX, SIN, SQRT
73 * ..
74 * .. Data statements ..
75 DATA IDIM / 1, 2, 3, 4, 3, 3, 6, 4 /
76 DATA IVAL / 1, 35*0, 1, 2, 4*0, -2, 0, 28*0, 1, 5*0,
77 $ 5, 1, 2, 3*0, -8, -2, 1, 21*0, 3, 4, 4*0, -5,
78 $ 3, 4*0, 1, 2, 1, 4, 2*0, -3, -9, -1, 1, 14*0,
79 $ 1, 5*0, 2, 3, 4*0, 5, 6, 7, 21*0, 1, 5*0, 1, 3,
80 $ -4, 3*0, 2, 5, 2, 21*0, 1, 2, 4*0, -2, 0, 4*0,
81 $ 5, 6, 3, 4, 2*0, -1, -9, -5, 2, 2*0, 4*8, 5, 6,
82 $ 4*9, -7, 5, 1, 5*0, 1, 5, 2, 3*0, 2, -21, 5,
83 $ 3*0, 1, 2, 3, 4, 14*0 /
84 * ..
85 * .. Executable Statements ..
86 *
87 * Get machine parameters
88 *
89 EPS = DLAMCH( 'P' )
90 SMLNUM = DLAMCH( 'S' )*FOUR / EPS
91 BIGNUM = ONE / SMLNUM
92 CALL DLABAD( SMLNUM, BIGNUM )
93 *
94 * Set up test case parameters
95 *
96 VM1( 1 ) = SQRT( SMLNUM )
97 VM1( 2 ) = ONE
98 VM1( 3 ) = SQRT( BIGNUM )
99 VM2( 1 ) = ONE
100 VM2( 2 ) = ONE + TWO*EPS
101 VM2( 3 ) = TWO
102 *
103 KNT = 0
104 NINFO = 0
105 LMAX = 0
106 RMAX = ZERO
107 *
108 * Begin test loop
109 *
110 DO 150 ITRANA = 1, 2
111 DO 140 ITRANB = 1, 2
112 DO 130 ISGN = -1, 1, 2
113 DO 120 IMA = 1, 8
114 DO 110 IMLDA1 = 1, 3
115 DO 100 IMLDA2 = 1, 3
116 DO 90 IMLOFF = 1, 2
117 DO 80 IMB = 1, 8
118 DO 70 IMLDB1 = 1, 3
119 IF( ITRANA.EQ.1 )
120 $ TRANA = 'N'
121 IF( ITRANA.EQ.2 )
122 $ TRANA = 'T'
123 IF( ITRANB.EQ.1 )
124 $ TRANB = 'N'
125 IF( ITRANB.EQ.2 )
126 $ TRANB = 'T'
127 M = IDIM( IMA )
128 N = IDIM( IMB )
129 TNRM = ZERO
130 DO 20 I = 1, M
131 DO 10 J = 1, M
132 A( I, J ) = IVAL( I, J, IMA )
133 IF( ABS( I-J ).LE.1 ) THEN
134 A( I, J ) = A( I, J )*
135 $ VM1( IMLDA1 )
136 A( I, J ) = A( I, J )*
137 $ VM2( IMLDA2 )
138 ELSE
139 A( I, J ) = A( I, J )*
140 $ VM1( IMLOFF )
141 END IF
142 TNRM = MAX( TNRM,
143 $ ABS( A( I, J ) ) )
144 10 CONTINUE
145 20 CONTINUE
146 DO 40 I = 1, N
147 DO 30 J = 1, N
148 B( I, J ) = IVAL( I, J, IMB )
149 IF( ABS( I-J ).LE.1 ) THEN
150 B( I, J ) = B( I, J )*
151 $ VM1( IMLDB1 )
152 ELSE
153 B( I, J ) = B( I, J )*
154 $ VM1( IMLOFF )
155 END IF
156 TNRM = MAX( TNRM,
157 $ ABS( B( I, J ) ) )
158 30 CONTINUE
159 40 CONTINUE
160 CNRM = ZERO
161 DO 60 I = 1, M
162 DO 50 J = 1, N
163 C( I, J ) = SIN( DBLE( I*J ) )
164 CNRM = MAX( CNRM, C( I, J ) )
165 CC( I, J ) = C( I, J )
166 50 CONTINUE
167 60 CONTINUE
168 KNT = KNT + 1
169 CALL DTRSYL( TRANA, TRANB, ISGN, M, N,
170 $ A, 6, B, 6, C, 6, SCALE,
171 $ INFO )
172 IF( INFO.NE.0 )
173 $ NINFO = NINFO + 1
174 XNRM = DLANGE( 'M', M, N, C, 6, DUM )
175 RMUL = ONE
176 IF( XNRM.GT.ONE .AND. TNRM.GT.ONE )
177 $ THEN
178 IF( XNRM.GT.BIGNUM / TNRM ) THEN
179 RMUL = ONE / MAX( XNRM, TNRM )
180 END IF
181 END IF
182 CALL DGEMM( TRANA, 'N', M, N, M, RMUL,
183 $ A, 6, C, 6, -SCALE*RMUL,
184 $ CC, 6 )
185 CALL DGEMM( 'N', TRANB, M, N, N,
186 $ DBLE( ISGN )*RMUL, C, 6, B,
187 $ 6, ONE, CC, 6 )
188 RES1 = DLANGE( 'M', M, N, CC, 6, DUM )
189 RES = RES1 / MAX( SMLNUM, SMLNUM*XNRM,
190 $ ( ( RMUL*TNRM )*EPS )*XNRM )
191 IF( RES.GT.RMAX ) THEN
192 LMAX = KNT
193 RMAX = RES
194 END IF
195 70 CONTINUE
196 80 CONTINUE
197 90 CONTINUE
198 100 CONTINUE
199 110 CONTINUE
200 120 CONTINUE
201 130 CONTINUE
202 140 CONTINUE
203 150 CONTINUE
204 *
205 RETURN
206 *
207 * End of DGET35
208 *
209 END