1*> \brief \b CGET35
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 CGET35( RMAX, LMAX, NINFO, KNT, NIN )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            KNT, LMAX, NIN, NINFO
15*       REAL               RMAX
16*       ..
17*
18*
19*> \par Purpose:
20*  =============
21*>
22*> \verbatim
23*>
24*> CGET35 tests CTRSYL, 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 REAL
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*> \param[in] NIN
67*> \verbatim
68*>          NIN is INTEGER
69*>          Input logical unit number.
70*> \endverbatim
71*
72*  Authors:
73*  ========
74*
75*> \author Univ. of Tennessee
76*> \author Univ. of California Berkeley
77*> \author Univ. of Colorado Denver
78*> \author NAG Ltd.
79*
80*> \ingroup complex_eig
81*
82*  =====================================================================
83      SUBROUTINE CGET35( RMAX, LMAX, NINFO, KNT, NIN )
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*
244      END
245