1*> \brief \b DGET35
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE DGET35( RMAX, LMAX, NINFO, KNT )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            KNT, LMAX, NINFO
15*       DOUBLE PRECISION   RMAX
16*       ..
17*
18*
19*> \par Purpose:
20*  =============
21*>
22*> \verbatim
23*>
24*> DGET35 tests DTRSYL, a routine for solving the Sylvester matrix
25*> equation
26*>
27*>    op(A)*X + ISGN*X*op(B) = scale*C,
28*>
29*> A and B are assumed to be in Schur canonical form, op() represents an
30*> optional transpose, and ISGN can be -1 or +1.  Scale is an output
31*> less than or equal to 1, chosen to avoid overflow in X.
32*>
33*> The test code verifies that the following residual is order 1:
34*>
35*>    norm(op(A)*X + ISGN*X*op(B) - scale*C) /
36*>        (EPS*max(norm(A),norm(B))*norm(X))
37*> \endverbatim
38*
39*  Arguments:
40*  ==========
41*
42*> \param[out] RMAX
43*> \verbatim
44*>          RMAX is DOUBLE PRECISION
45*>          Value of the largest test ratio.
46*> \endverbatim
47*>
48*> \param[out] LMAX
49*> \verbatim
50*>          LMAX is INTEGER
51*>          Example number where largest test ratio achieved.
52*> \endverbatim
53*>
54*> \param[out] NINFO
55*> \verbatim
56*>          NINFO is INTEGER
57*>          Number of examples where INFO is nonzero.
58*> \endverbatim
59*>
60*> \param[out] KNT
61*> \verbatim
62*>          KNT is INTEGER
63*>          Total number of examples tested.
64*> \endverbatim
65*
66*  Authors:
67*  ========
68*
69*> \author Univ. of Tennessee
70*> \author Univ. of California Berkeley
71*> \author Univ. of Colorado Denver
72*> \author NAG Ltd.
73*
74*> \date November 2011
75*
76*> \ingroup double_eig
77*
78*  =====================================================================
79      SUBROUTINE DGET35( RMAX, LMAX, NINFO, KNT )
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*
256      END
257