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*> \ingroup double_eig 75* 76* ===================================================================== 77 SUBROUTINE DGET35( RMAX, LMAX, NINFO, KNT ) 78* 79* -- LAPACK test routine -- 80* -- LAPACK is a software package provided by Univ. of Tennessee, -- 81* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 82* 83* .. Scalar Arguments .. 84 INTEGER KNT, LMAX, NINFO 85 DOUBLE PRECISION RMAX 86* .. 87* 88* ===================================================================== 89* 90* .. Parameters .. 91 DOUBLE PRECISION ZERO, ONE 92 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 93 DOUBLE PRECISION TWO, FOUR 94 PARAMETER ( TWO = 2.0D0, FOUR = 4.0D0 ) 95* .. 96* .. Local Scalars .. 97 CHARACTER TRANA, TRANB 98 INTEGER I, IMA, IMB, IMLDA1, IMLDA2, IMLDB1, IMLOFF, 99 $ INFO, ISGN, ITRANA, ITRANB, J, M, N 100 DOUBLE PRECISION BIGNUM, CNRM, EPS, RES, RES1, RMUL, SCALE, 101 $ SMLNUM, TNRM, XNRM 102* .. 103* .. Local Arrays .. 104 INTEGER IDIM( 8 ), IVAL( 6, 6, 8 ) 105 DOUBLE PRECISION A( 6, 6 ), B( 6, 6 ), C( 6, 6 ), CC( 6, 6 ), 106 $ DUM( 1 ), VM1( 3 ), VM2( 3 ) 107* .. 108* .. External Functions .. 109 DOUBLE PRECISION DLAMCH, DLANGE 110 EXTERNAL DLAMCH, DLANGE 111* .. 112* .. External Subroutines .. 113 EXTERNAL DGEMM, DLABAD, DTRSYL 114* .. 115* .. Intrinsic Functions .. 116 INTRINSIC ABS, DBLE, MAX, SIN, SQRT 117* .. 118* .. Data statements .. 119 DATA IDIM / 1, 2, 3, 4, 3, 3, 6, 4 / 120 DATA IVAL / 1, 35*0, 1, 2, 4*0, -2, 0, 28*0, 1, 5*0, 121 $ 5, 1, 2, 3*0, -8, -2, 1, 21*0, 3, 4, 4*0, -5, 122 $ 3, 4*0, 1, 2, 1, 4, 2*0, -3, -9, -1, 1, 14*0, 123 $ 1, 5*0, 2, 3, 4*0, 5, 6, 7, 21*0, 1, 5*0, 1, 3, 124 $ -4, 3*0, 2, 5, 2, 21*0, 1, 2, 4*0, -2, 0, 4*0, 125 $ 5, 6, 3, 4, 2*0, -1, -9, -5, 2, 2*0, 4*8, 5, 6, 126 $ 4*9, -7, 5, 1, 5*0, 1, 5, 2, 3*0, 2, -21, 5, 127 $ 3*0, 1, 2, 3, 4, 14*0 / 128* .. 129* .. Executable Statements .. 130* 131* Get machine parameters 132* 133 EPS = DLAMCH( 'P' ) 134 SMLNUM = DLAMCH( 'S' )*FOUR / EPS 135 BIGNUM = ONE / SMLNUM 136 CALL DLABAD( SMLNUM, BIGNUM ) 137* 138* Set up test case parameters 139* 140 VM1( 1 ) = SQRT( SMLNUM ) 141 VM1( 2 ) = ONE 142 VM1( 3 ) = SQRT( BIGNUM ) 143 VM2( 1 ) = ONE 144 VM2( 2 ) = ONE + TWO*EPS 145 VM2( 3 ) = TWO 146* 147 KNT = 0 148 NINFO = 0 149 LMAX = 0 150 RMAX = ZERO 151* 152* Begin test loop 153* 154 DO 150 ITRANA = 1, 2 155 DO 140 ITRANB = 1, 2 156 DO 130 ISGN = -1, 1, 2 157 DO 120 IMA = 1, 8 158 DO 110 IMLDA1 = 1, 3 159 DO 100 IMLDA2 = 1, 3 160 DO 90 IMLOFF = 1, 2 161 DO 80 IMB = 1, 8 162 DO 70 IMLDB1 = 1, 3 163 IF( ITRANA.EQ.1 ) 164 $ TRANA = 'N' 165 IF( ITRANA.EQ.2 ) 166 $ TRANA = 'T' 167 IF( ITRANB.EQ.1 ) 168 $ TRANB = 'N' 169 IF( ITRANB.EQ.2 ) 170 $ TRANB = 'T' 171 M = IDIM( IMA ) 172 N = IDIM( IMB ) 173 TNRM = ZERO 174 DO 20 I = 1, M 175 DO 10 J = 1, M 176 A( I, J ) = IVAL( I, J, IMA ) 177 IF( ABS( I-J ).LE.1 ) THEN 178 A( I, J ) = A( I, J )* 179 $ VM1( IMLDA1 ) 180 A( I, J ) = A( I, J )* 181 $ VM2( IMLDA2 ) 182 ELSE 183 A( I, J ) = A( I, J )* 184 $ VM1( IMLOFF ) 185 END IF 186 TNRM = MAX( TNRM, 187 $ ABS( A( I, J ) ) ) 188 10 CONTINUE 189 20 CONTINUE 190 DO 40 I = 1, N 191 DO 30 J = 1, N 192 B( I, J ) = IVAL( I, J, IMB ) 193 IF( ABS( I-J ).LE.1 ) THEN 194 B( I, J ) = B( I, J )* 195 $ VM1( IMLDB1 ) 196 ELSE 197 B( I, J ) = B( I, J )* 198 $ VM1( IMLOFF ) 199 END IF 200 TNRM = MAX( TNRM, 201 $ ABS( B( I, J ) ) ) 202 30 CONTINUE 203 40 CONTINUE 204 CNRM = ZERO 205 DO 60 I = 1, M 206 DO 50 J = 1, N 207 C( I, J ) = SIN( DBLE( I*J ) ) 208 CNRM = MAX( CNRM, C( I, J ) ) 209 CC( I, J ) = C( I, J ) 210 50 CONTINUE 211 60 CONTINUE 212 KNT = KNT + 1 213 CALL DTRSYL( TRANA, TRANB, ISGN, M, N, 214 $ A, 6, B, 6, C, 6, SCALE, 215 $ INFO ) 216 IF( INFO.NE.0 ) 217 $ NINFO = NINFO + 1 218 XNRM = DLANGE( 'M', M, N, C, 6, DUM ) 219 RMUL = ONE 220 IF( XNRM.GT.ONE .AND. TNRM.GT.ONE ) 221 $ THEN 222 IF( XNRM.GT.BIGNUM / TNRM ) THEN 223 RMUL = ONE / MAX( XNRM, TNRM ) 224 END IF 225 END IF 226 CALL DGEMM( TRANA, 'N', M, N, M, RMUL, 227 $ A, 6, C, 6, -SCALE*RMUL, 228 $ CC, 6 ) 229 CALL DGEMM( 'N', TRANB, M, N, N, 230 $ DBLE( ISGN )*RMUL, C, 6, B, 231 $ 6, ONE, CC, 6 ) 232 RES1 = DLANGE( 'M', M, N, CC, 6, DUM ) 233 RES = RES1 / MAX( SMLNUM, SMLNUM*XNRM, 234 $ ( ( RMUL*TNRM )*EPS )*XNRM ) 235 IF( RES.GT.RMAX ) THEN 236 LMAX = KNT 237 RMAX = RES 238 END IF 239 70 CONTINUE 240 80 CONTINUE 241 90 CONTINUE 242 100 CONTINUE 243 110 CONTINUE 244 120 CONTINUE 245 130 CONTINUE 246 140 CONTINUE 247 150 CONTINUE 248* 249 RETURN 250* 251* End of DGET35 252* 253 END 254