![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLATB9 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 SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, 00012 * KLB, KUB, ANORM, BNORM, MODEA, MODEB, 00013 * CNDNMA, CNDNMB, DISTA, DISTB ) 00014 * 00015 * .. Scalar Arguments .. 00016 * CHARACTER DISTA, DISTB, TYPE 00017 * CHARACTER*3 PATH 00018 * INTEGER IMAT, KLA, KUA, KLB, KUB, M, P, MODEA, MODEB, N 00019 * REAL ANORM, BNORM, CNDNMA, CNDNMB 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> SLATB9 sets parameters for the matrix generator based on the type of 00029 *> matrix to be generated. 00030 *> \endverbatim 00031 * 00032 * Arguments: 00033 * ========== 00034 * 00035 *> \param[in] PATH 00036 *> \verbatim 00037 *> PATH is CHARACTER*3 00038 *> The LAPACK path name. 00039 *> \endverbatim 00040 *> 00041 *> \param[in] IMAT 00042 *> \verbatim 00043 *> IMAT is INTEGER 00044 *> An integer key describing which matrix to generate for this 00045 *> path. 00046 *> = 1: A: diagonal, B: upper triangular 00047 *> = 2: A: upper triangular, B: upper triangular 00048 *> = 3: A: lower triangular, B: upper triangular 00049 *> Else: A: general dense, B: general dense 00050 *> \endverbatim 00051 *> 00052 *> \param[in] M 00053 *> \verbatim 00054 *> M is INTEGER 00055 *> The number of rows in the matrix to be generated. 00056 *> \endverbatim 00057 *> 00058 *> \param[in] P 00059 *> \verbatim 00060 *> P is INTEGER 00061 *> \endverbatim 00062 *> 00063 *> \param[in] N 00064 *> \verbatim 00065 *> N is INTEGER 00066 *> The number of columns in the matrix to be generated. 00067 *> \endverbatim 00068 *> 00069 *> \param[out] TYPE 00070 *> \verbatim 00071 *> TYPE is CHARACTER*1 00072 *> The type of the matrix to be generated: 00073 *> = 'S': symmetric matrix; 00074 *> = 'P': symmetric positive (semi)definite matrix; 00075 *> = 'N': nonsymmetric matrix. 00076 *> \endverbatim 00077 *> 00078 *> \param[out] KLA 00079 *> \verbatim 00080 *> KLA is INTEGER 00081 *> The lower band width of the matrix to be generated. 00082 *> \endverbatim 00083 *> 00084 *> \param[out] KUA 00085 *> \verbatim 00086 *> KUA is INTEGER 00087 *> The upper band width of the matrix to be generated. 00088 *> \endverbatim 00089 *> 00090 *> \param[out] KLB 00091 *> \verbatim 00092 *> KLB is INTEGER 00093 *> The lower band width of the matrix to be generated. 00094 *> \endverbatim 00095 *> 00096 *> \param[out] KUB 00097 *> \verbatim 00098 *> KUA is INTEGER 00099 *> The upper band width of the matrix to be generated. 00100 *> \endverbatim 00101 *> 00102 *> \param[out] ANORM 00103 *> \verbatim 00104 *> ANORM is REAL 00105 *> The desired norm of the matrix to be generated. The diagonal 00106 *> matrix of singular values or eigenvalues is scaled by this 00107 *> value. 00108 *> \endverbatim 00109 *> 00110 *> \param[out] BNORM 00111 *> \verbatim 00112 *> BNORM is REAL 00113 *> The desired norm of the matrix to be generated. The diagonal 00114 *> matrix of singular values or eigenvalues is scaled by this 00115 *> value. 00116 *> \endverbatim 00117 *> 00118 *> \param[out] MODEA 00119 *> \verbatim 00120 *> MODEA is INTEGER 00121 *> A key indicating how to choose the vector of eigenvalues. 00122 *> \endverbatim 00123 *> 00124 *> \param[out] MODEB 00125 *> \verbatim 00126 *> MODEB is INTEGER 00127 *> A key indicating how to choose the vector of eigenvalues. 00128 *> \endverbatim 00129 *> 00130 *> \param[out] CNDNMA 00131 *> \verbatim 00132 *> CNDNMA is REAL 00133 *> The desired condition number. 00134 *> \endverbatim 00135 *> 00136 *> \param[out] CNDNMB 00137 *> \verbatim 00138 *> CNDNMB is REAL 00139 *> The desired condition number. 00140 *> \endverbatim 00141 *> 00142 *> \param[out] DISTA 00143 *> \verbatim 00144 *> DISTA is CHARACTER*1 00145 *> The type of distribution to be used by the random number 00146 *> generator. 00147 *> \endverbatim 00148 *> 00149 *> \param[out] DISTB 00150 *> \verbatim 00151 *> DISTB is CHARACTER*1 00152 *> The type of distribution to be used by the random number 00153 *> generator. 00154 *> \endverbatim 00155 * 00156 * Authors: 00157 * ======== 00158 * 00159 *> \author Univ. of Tennessee 00160 *> \author Univ. of California Berkeley 00161 *> \author Univ. of Colorado Denver 00162 *> \author NAG Ltd. 00163 * 00164 *> \date November 2011 00165 * 00166 *> \ingroup single_eig 00167 * 00168 * ===================================================================== 00169 SUBROUTINE SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, 00170 $ KLB, KUB, ANORM, BNORM, MODEA, MODEB, 00171 $ CNDNMA, CNDNMB, DISTA, DISTB ) 00172 * 00173 * -- LAPACK test routine (version 3.4.0) -- 00174 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00175 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00176 * November 2011 00177 * 00178 * .. Scalar Arguments .. 00179 CHARACTER DISTA, DISTB, TYPE 00180 CHARACTER*3 PATH 00181 INTEGER IMAT, KLA, KUA, KLB, KUB, M, P, MODEA, MODEB, N 00182 REAL ANORM, BNORM, CNDNMA, CNDNMB 00183 * .. 00184 * 00185 * ===================================================================== 00186 * 00187 * .. Parameters .. 00188 REAL SHRINK, TENTH 00189 PARAMETER ( SHRINK = 0.25E0, TENTH = 0.1E+0 ) 00190 REAL ONE, TEN 00191 PARAMETER ( ONE = 1.0E+0, TEN = 1.0E+1 ) 00192 * .. 00193 * .. Local Scalars .. 00194 LOGICAL FIRST 00195 REAL BADC1, BADC2, EPS, LARGE, SMALL 00196 * .. 00197 * .. External Functions .. 00198 LOGICAL LSAMEN 00199 REAL SLAMCH 00200 EXTERNAL LSAMEN, SLAMCH 00201 * .. 00202 * .. Intrinsic Functions .. 00203 INTRINSIC MAX, SQRT 00204 * .. 00205 * .. External Subroutines .. 00206 EXTERNAL SLABAD 00207 * .. 00208 * .. Save statement .. 00209 SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST 00210 * .. 00211 * .. Data statements .. 00212 DATA FIRST / .TRUE. / 00213 * .. 00214 * .. Executable Statements .. 00215 * 00216 * Set some constants for use in the subroutine. 00217 * 00218 IF( FIRST ) THEN 00219 FIRST = .FALSE. 00220 EPS = SLAMCH( 'Precision' ) 00221 BADC2 = TENTH / EPS 00222 BADC1 = SQRT( BADC2 ) 00223 SMALL = SLAMCH( 'Safe minimum' ) 00224 LARGE = ONE / SMALL 00225 * 00226 * If it looks like we're on a Cray, take the square root of 00227 * SMALL and LARGE to avoid overflow and underflow problems. 00228 * 00229 CALL SLABAD( SMALL, LARGE ) 00230 SMALL = SHRINK*( SMALL / EPS ) 00231 LARGE = ONE / SMALL 00232 END IF 00233 * 00234 * Set some parameters we don't plan to change. 00235 * 00236 TYPE = 'N' 00237 DISTA = 'S' 00238 DISTB = 'S' 00239 MODEA = 3 00240 MODEB = 4 00241 * 00242 * Set the lower and upper bandwidths. 00243 * 00244 IF( LSAMEN( 3, PATH, 'GRQ') .OR. LSAMEN( 3, PATH, 'LSE') .OR. 00245 $ LSAMEN( 3, PATH, 'GSV') )THEN 00246 * 00247 * A: M by N, B: P by N 00248 * 00249 IF( IMAT.EQ.1 ) THEN 00250 * 00251 * A: diagonal, B: upper triangular 00252 * 00253 KLA = 0 00254 KUA = 0 00255 KLB = 0 00256 KUB = MAX( N-1,0 ) 00257 * 00258 ELSE IF( IMAT.EQ.2 ) THEN 00259 * 00260 * A: upper triangular, B: upper triangular 00261 * 00262 KLA = 0 00263 KUA = MAX( N-1, 0 ) 00264 KLB = 0 00265 KUB = MAX( N-1, 0 ) 00266 * 00267 ELSE IF( IMAT.EQ.3 ) THEN 00268 * 00269 * A: lower triangular, B: upper triangular 00270 * 00271 KLA = MAX( M-1, 0 ) 00272 KUA = 0 00273 KLB = 0 00274 KUB = MAX( N-1, 0 ) 00275 * 00276 ELSE 00277 * 00278 * A: general dense, B: general dense 00279 * 00280 KLA = MAX( M-1, 0 ) 00281 KUA = MAX( N-1, 0 ) 00282 KLB = MAX( P-1, 0 ) 00283 KUB = MAX( N-1, 0 ) 00284 * 00285 END IF 00286 * 00287 ELSE IF( LSAMEN( 3, PATH, 'GQR' ) .OR. 00288 $ LSAMEN( 3, PATH, 'GLM') )THEN 00289 * 00290 * A: N by M, B: N by P 00291 * 00292 IF( IMAT.EQ.1 ) THEN 00293 * 00294 * A: diagonal, B: lower triangular 00295 * 00296 KLA = 0 00297 KUA = 0 00298 KLB = MAX( N-1,0 ) 00299 KUB = 0 00300 ELSE IF( IMAT.EQ.2 ) THEN 00301 * 00302 * A: lower triangular, B: diagonal 00303 * 00304 KLA = MAX( N-1, 0 ) 00305 KUA = 0 00306 KLB = 0 00307 KUB = 0 00308 * 00309 ELSE IF( IMAT.EQ.3 ) THEN 00310 * 00311 * A: lower triangular, B: upper triangular 00312 * 00313 KLA = MAX( N-1, 0 ) 00314 KUA = 0 00315 KLB = 0 00316 KUB = MAX( P-1, 0 ) 00317 * 00318 ELSE 00319 * 00320 * A: general dense, B: general dense 00321 * 00322 KLA = MAX( N-1, 0 ) 00323 KUA = MAX( M-1, 0 ) 00324 KLB = MAX( N-1, 0 ) 00325 KUB = MAX( P-1, 0 ) 00326 END IF 00327 * 00328 END IF 00329 * 00330 * Set the condition number and norm. 00331 * 00332 CNDNMA = TEN*TEN 00333 CNDNMB = TEN 00334 IF( LSAMEN( 3, PATH, 'GQR') .OR. LSAMEN( 3, PATH, 'GRQ') .OR. 00335 $ LSAMEN( 3, PATH, 'GSV') )THEN 00336 IF( IMAT.EQ.5 ) THEN 00337 CNDNMA = BADC1 00338 CNDNMB = BADC1 00339 ELSE IF( IMAT.EQ.6 ) THEN 00340 CNDNMA = BADC2 00341 CNDNMB = BADC2 00342 ELSE IF( IMAT.EQ.7 ) THEN 00343 CNDNMA = BADC1 00344 CNDNMB = BADC2 00345 ELSE IF( IMAT.EQ.8 ) THEN 00346 CNDNMA = BADC2 00347 CNDNMB = BADC1 00348 END IF 00349 END IF 00350 * 00351 ANORM = TEN 00352 BNORM = TEN*TEN*TEN 00353 IF( LSAMEN( 3, PATH, 'GQR') .OR. LSAMEN( 3, PATH, 'GRQ') )THEN 00354 IF( IMAT.EQ.7 ) THEN 00355 ANORM = SMALL 00356 BNORM = LARGE 00357 ELSE IF( IMAT.EQ.8 ) THEN 00358 ANORM = LARGE 00359 BNORM = SMALL 00360 END IF 00361 END IF 00362 * 00363 IF( N.LE.1 )THEN 00364 CNDNMA = ONE 00365 CNDNMB = ONE 00366 END IF 00367 * 00368 RETURN 00369 * 00370 * End of SLATB9 00371 * 00372 END