![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZGET35 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE ZGET35( RMAX, LMAX, NINFO, KNT, NIN ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER KNT, LMAX, NIN, NINFO 00015 * DOUBLE PRECISION RMAX 00016 * .. 00017 * 00018 * 00019 *> \par Purpose: 00020 * ============= 00021 *> 00022 *> \verbatim 00023 *> 00024 *> ZGET35 tests ZTRSYL, a routine for solving the Sylvester matrix 00025 *> equation 00026 *> 00027 *> op(A)*X + ISGN*X*op(B) = scale*C, 00028 *> 00029 *> A and B are assumed to be in Schur canonical form, op() represents an 00030 *> optional transpose, and ISGN can be -1 or +1. Scale is an output 00031 *> less than or equal to 1, chosen to avoid overflow in X. 00032 *> 00033 *> The test code verifies that the following residual is order 1: 00034 *> 00035 *> norm(op(A)*X + ISGN*X*op(B) - scale*C) / 00036 *> (EPS*max(norm(A),norm(B))*norm(X)) 00037 *> \endverbatim 00038 * 00039 * Arguments: 00040 * ========== 00041 * 00042 *> \param[out] RMAX 00043 *> \verbatim 00044 *> RMAX is DOUBLE PRECISION 00045 *> Value of the largest test ratio. 00046 *> \endverbatim 00047 *> 00048 *> \param[out] LMAX 00049 *> \verbatim 00050 *> LMAX is INTEGER 00051 *> Example number where largest test ratio achieved. 00052 *> \endverbatim 00053 *> 00054 *> \param[out] NINFO 00055 *> \verbatim 00056 *> NINFO is INTEGER 00057 *> Number of examples where INFO is nonzero. 00058 *> \endverbatim 00059 *> 00060 *> \param[out] KNT 00061 *> \verbatim 00062 *> KNT is INTEGER 00063 *> Total number of examples tested. 00064 *> \endverbatim 00065 *> 00066 *> \param[in] NIN 00067 *> \verbatim 00068 *> NIN is INTEGER 00069 *> Input logical unit number. 00070 *> \endverbatim 00071 * 00072 * Authors: 00073 * ======== 00074 * 00075 *> \author Univ. of Tennessee 00076 *> \author Univ. of California Berkeley 00077 *> \author Univ. of Colorado Denver 00078 *> \author NAG Ltd. 00079 * 00080 *> \date November 2011 00081 * 00082 *> \ingroup complex16_eig 00083 * 00084 * ===================================================================== 00085 SUBROUTINE ZGET35( RMAX, LMAX, NINFO, KNT, NIN ) 00086 * 00087 * -- LAPACK test routine (version 3.4.0) -- 00088 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00089 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00090 * November 2011 00091 * 00092 * .. Scalar Arguments .. 00093 INTEGER KNT, LMAX, NIN, NINFO 00094 DOUBLE PRECISION RMAX 00095 * .. 00096 * 00097 * ===================================================================== 00098 * 00099 * .. Parameters .. 00100 INTEGER LDT 00101 PARAMETER ( LDT = 10 ) 00102 DOUBLE PRECISION ZERO, ONE, TWO 00103 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 ) 00104 DOUBLE PRECISION LARGE 00105 PARAMETER ( LARGE = 1.0D6 ) 00106 COMPLEX*16 CONE 00107 PARAMETER ( CONE = 1.0D0 ) 00108 * .. 00109 * .. Local Scalars .. 00110 CHARACTER TRANA, TRANB 00111 INTEGER I, IMLA, IMLAD, IMLB, IMLC, INFO, ISGN, ITRANA, 00112 $ ITRANB, J, M, N 00113 DOUBLE PRECISION BIGNUM, EPS, RES, RES1, SCALE, SMLNUM, TNRM, 00114 $ XNRM 00115 COMPLEX*16 RMUL 00116 * .. 00117 * .. Local Arrays .. 00118 DOUBLE PRECISION DUM( 1 ), VM1( 3 ), VM2( 3 ) 00119 COMPLEX*16 A( LDT, LDT ), ATMP( LDT, LDT ), B( LDT, LDT ), 00120 $ BTMP( LDT, LDT ), C( LDT, LDT ), 00121 $ CSAV( LDT, LDT ), CTMP( LDT, LDT ) 00122 * .. 00123 * .. External Functions .. 00124 DOUBLE PRECISION DLAMCH, ZLANGE 00125 EXTERNAL DLAMCH, ZLANGE 00126 * .. 00127 * .. External Subroutines .. 00128 EXTERNAL DLABAD, ZGEMM, ZTRSYL 00129 * .. 00130 * .. Intrinsic Functions .. 00131 INTRINSIC ABS, DBLE, MAX, SQRT 00132 * .. 00133 * .. Executable Statements .. 00134 * 00135 * Get machine parameters 00136 * 00137 EPS = DLAMCH( 'P' ) 00138 SMLNUM = DLAMCH( 'S' ) / EPS 00139 BIGNUM = ONE / SMLNUM 00140 CALL DLABAD( SMLNUM, BIGNUM ) 00141 * 00142 * Set up test case parameters 00143 * 00144 VM1( 1 ) = SQRT( SMLNUM ) 00145 VM1( 2 ) = ONE 00146 VM1( 3 ) = LARGE 00147 VM2( 1 ) = ONE 00148 VM2( 2 ) = ONE + TWO*EPS 00149 VM2( 3 ) = TWO 00150 * 00151 KNT = 0 00152 NINFO = 0 00153 LMAX = 0 00154 RMAX = ZERO 00155 * 00156 * Begin test loop 00157 * 00158 10 CONTINUE 00159 READ( NIN, FMT = * )M, N 00160 IF( N.EQ.0 ) 00161 $ RETURN 00162 DO 20 I = 1, M 00163 READ( NIN, FMT = * )( ATMP( I, J ), J = 1, M ) 00164 20 CONTINUE 00165 DO 30 I = 1, N 00166 READ( NIN, FMT = * )( BTMP( I, J ), J = 1, N ) 00167 30 CONTINUE 00168 DO 40 I = 1, M 00169 READ( NIN, FMT = * )( CTMP( I, J ), J = 1, N ) 00170 40 CONTINUE 00171 DO 170 IMLA = 1, 3 00172 DO 160 IMLAD = 1, 3 00173 DO 150 IMLB = 1, 3 00174 DO 140 IMLC = 1, 3 00175 DO 130 ITRANA = 1, 2 00176 DO 120 ITRANB = 1, 2 00177 DO 110 ISGN = -1, 1, 2 00178 IF( ITRANA.EQ.1 ) 00179 $ TRANA = 'N' 00180 IF( ITRANA.EQ.2 ) 00181 $ TRANA = 'C' 00182 IF( ITRANB.EQ.1 ) 00183 $ TRANB = 'N' 00184 IF( ITRANB.EQ.2 ) 00185 $ TRANB = 'C' 00186 TNRM = ZERO 00187 DO 60 I = 1, M 00188 DO 50 J = 1, M 00189 A( I, J ) = ATMP( I, J )*VM1( IMLA ) 00190 TNRM = MAX( TNRM, ABS( A( I, J ) ) ) 00191 50 CONTINUE 00192 A( I, I ) = A( I, I )*VM2( IMLAD ) 00193 TNRM = MAX( TNRM, ABS( A( I, I ) ) ) 00194 60 CONTINUE 00195 DO 80 I = 1, N 00196 DO 70 J = 1, N 00197 B( I, J ) = BTMP( I, J )*VM1( IMLB ) 00198 TNRM = MAX( TNRM, ABS( B( I, J ) ) ) 00199 70 CONTINUE 00200 80 CONTINUE 00201 IF( TNRM.EQ.ZERO ) 00202 $ TNRM = ONE 00203 DO 100 I = 1, M 00204 DO 90 J = 1, N 00205 C( I, J ) = CTMP( I, J )*VM1( IMLC ) 00206 CSAV( I, J ) = C( I, J ) 00207 90 CONTINUE 00208 100 CONTINUE 00209 KNT = KNT + 1 00210 CALL ZTRSYL( TRANA, TRANB, ISGN, M, N, A, 00211 $ LDT, B, LDT, C, LDT, SCALE, 00212 $ INFO ) 00213 IF( INFO.NE.0 ) 00214 $ NINFO = NINFO + 1 00215 XNRM = ZLANGE( 'M', M, N, C, LDT, DUM ) 00216 RMUL = CONE 00217 IF( XNRM.GT.ONE .AND. TNRM.GT.ONE ) THEN 00218 IF( XNRM.GT.BIGNUM / TNRM ) THEN 00219 RMUL = MAX( XNRM, TNRM ) 00220 RMUL = CONE / RMUL 00221 END IF 00222 END IF 00223 CALL ZGEMM( TRANA, 'N', M, N, M, RMUL, A, 00224 $ LDT, C, LDT, -SCALE*RMUL, CSAV, 00225 $ LDT ) 00226 CALL ZGEMM( 'N', TRANB, M, N, N, 00227 $ DBLE( ISGN )*RMUL, C, LDT, B, 00228 $ LDT, CONE, CSAV, LDT ) 00229 RES1 = ZLANGE( 'M', M, N, CSAV, LDT, DUM ) 00230 RES = RES1 / MAX( SMLNUM, SMLNUM*XNRM, 00231 $ ( ( ABS( RMUL )*TNRM )*EPS )*XNRM ) 00232 IF( RES.GT.RMAX ) THEN 00233 LMAX = KNT 00234 RMAX = RES 00235 END IF 00236 110 CONTINUE 00237 120 CONTINUE 00238 130 CONTINUE 00239 140 CONTINUE 00240 150 CONTINUE 00241 160 CONTINUE 00242 170 CONTINUE 00243 GO TO 10 00244 * 00245 * End of ZGET35 00246 * 00247 END