 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE DLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, 00002 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB, 00003 $ DISTA, DISTB ) 00004 * 00005 * -- LAPACK test routine (version 3.1) -- 00006 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 CHARACTER DISTA, DISTB, TYPE 00011 CHARACTER*3 PATH 00012 INTEGER IMAT, KLA, KLB, KUA, KUB, M, MODEA, MODEB, N, P 00013 DOUBLE PRECISION ANORM, BNORM, CNDNMA, CNDNMB 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * DLATB9 sets parameters for the matrix generator based on the type of 00020 * matrix to be generated. 00021 * 00022 * Arguments 00023 * ========= 00024 * 00025 * PATH (input) CHARACTER*3 00026 * The LAPACK path name. 00027 * 00028 * IMAT (input) INTEGER 00029 * An integer key describing which matrix to generate for this 00030 * path. 00031 * 00032 * M (input) INTEGER 00033 * The number of rows in the matrix to be generated. 00034 * 00035 * N (input) INTEGER 00036 * The number of columns in the matrix to be generated. 00037 * 00038 * TYPE (output) CHARACTER*1 00039 * The type of the matrix to be generated: 00040 * = 'S': symmetric matrix; 00041 * = 'P': symmetric positive (semi)definite matrix; 00042 * = 'N': nonsymmetric matrix. 00043 * 00044 * KL (output) INTEGER 00045 * The lower band width of the matrix to be generated. 00046 * 00047 * KU (output) INTEGER 00048 * The upper band width of the matrix to be generated. 00049 * 00050 * ANORM (output) DOUBLE PRECISION 00051 * The desired norm of the matrix to be generated. The diagonal 00052 * matrix of singular values or eigenvalues is scaled by this 00053 * value. 00054 * 00055 * MODE (output) INTEGER 00056 * A key indicating how to choose the vector of eigenvalues. 00057 * 00058 * CNDNUM (output) DOUBLE PRECISION 00059 * The desired condition number. 00060 * 00061 * DIST (output) CHARACTER*1 00062 * The type of distribution to be used by the random number 00063 * generator. 00064 * 00065 * ===================================================================== 00066 * 00067 * .. Parameters .. 00068 DOUBLE PRECISION SHRINK, TENTH 00069 PARAMETER ( SHRINK = 0.25D0, TENTH = 0.1D+0 ) 00070 DOUBLE PRECISION ONE, TEN 00071 PARAMETER ( ONE = 1.0D+0, TEN = 1.0D+1 ) 00072 * .. 00073 * .. Local Scalars .. 00074 LOGICAL FIRST 00075 DOUBLE PRECISION BADC1, BADC2, EPS, LARGE, SMALL 00076 * .. 00077 * .. External Functions .. 00078 LOGICAL LSAMEN 00079 DOUBLE PRECISION DLAMCH 00080 EXTERNAL LSAMEN, DLAMCH 00081 * .. 00082 * .. Intrinsic Functions .. 00083 INTRINSIC MAX, SQRT 00084 * .. 00085 * .. External Subroutines .. 00086 EXTERNAL DLABAD 00087 * .. 00088 * .. Save statement .. 00089 SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST 00090 * .. 00091 * .. Data statements .. 00092 DATA FIRST / .TRUE. / 00093 * .. 00094 * .. Executable Statements .. 00095 * 00096 * Set some constants for use in the subroutine. 00097 * 00098 IF( FIRST ) THEN 00099 FIRST = .FALSE. 00100 EPS = DLAMCH( 'Precision' ) 00101 BADC2 = TENTH / EPS 00102 BADC1 = SQRT( BADC2 ) 00103 SMALL = DLAMCH( 'Safe minimum' ) 00104 LARGE = ONE / SMALL 00105 * 00106 * If it looks like we're on a Cray, take the square root of 00107 * SMALL and LARGE to avoid overflow and underflow problems. 00108 * 00109 CALL DLABAD( SMALL, LARGE ) 00110 SMALL = SHRINK*( SMALL / EPS ) 00111 LARGE = ONE / SMALL 00112 END IF 00113 * 00114 * Set some parameters we don't plan to change. 00115 * 00116 TYPE = 'N' 00117 DISTA = 'S' 00118 DISTB = 'S' 00119 MODEA = 3 00120 MODEB = 4 00121 * 00122 * Set the lower and upper bandwidths. 00123 * 00124 IF( LSAMEN( 3, PATH, 'GRQ' ) .OR. LSAMEN( 3, PATH, 'LSE' ) .OR. 00125 $ LSAMEN( 3, PATH, 'GSV' ) ) THEN 00126 * 00127 * A: M by N, B: P by N 00128 * 00129 IF( IMAT.EQ.1 ) THEN 00130 * 00131 * A: diagonal, B: upper triangular 00132 * 00133 KLA = 0 00134 KUA = 0 00135 KLB = 0 00136 KUB = MAX( N-1, 0 ) 00137 * 00138 ELSE IF( IMAT.EQ.2 ) THEN 00139 * 00140 * A: upper triangular, B: upper triangular 00141 * 00142 KLA = 0 00143 KUA = MAX( N-1, 0 ) 00144 KLB = 0 00145 KUB = MAX( N-1, 0 ) 00146 * 00147 ELSE IF( IMAT.EQ.3 ) THEN 00148 * 00149 * A: lower triangular, B: upper triangular 00150 * 00151 KLA = MAX( M-1, 0 ) 00152 KUA = 0 00153 KLB = 0 00154 KUB = MAX( N-1, 0 ) 00155 * 00156 ELSE 00157 * 00158 * A: general dense, B: general dense 00159 * 00160 KLA = MAX( M-1, 0 ) 00161 KUA = MAX( N-1, 0 ) 00162 KLB = MAX( P-1, 0 ) 00163 KUB = MAX( N-1, 0 ) 00164 * 00165 END IF 00166 * 00167 ELSE IF( LSAMEN( 3, PATH, 'GQR' ) .OR. LSAMEN( 3, PATH, 'GLM' ) ) 00168 $ THEN 00169 * 00170 * A: N by M, B: N by P 00171 * 00172 IF( IMAT.EQ.1 ) THEN 00173 * 00174 * A: diagonal, B: lower triangular 00175 * 00176 KLA = 0 00177 KUA = 0 00178 KLB = MAX( N-1, 0 ) 00179 KUB = 0 00180 ELSE IF( IMAT.EQ.2 ) THEN 00181 * 00182 * A: lower triangular, B: diagonal 00183 * 00184 KLA = MAX( N-1, 0 ) 00185 KUA = 0 00186 KLB = 0 00187 KUB = 0 00188 * 00189 ELSE IF( IMAT.EQ.3 ) THEN 00190 * 00191 * A: lower triangular, B: upper triangular 00192 * 00193 KLA = MAX( N-1, 0 ) 00194 KUA = 0 00195 KLB = 0 00196 KUB = MAX( P-1, 0 ) 00197 * 00198 ELSE 00199 * 00200 * A: general dense, B: general dense 00201 * 00202 KLA = MAX( N-1, 0 ) 00203 KUA = MAX( M-1, 0 ) 00204 KLB = MAX( N-1, 0 ) 00205 KUB = MAX( P-1, 0 ) 00206 END IF 00207 * 00208 END IF 00209 * 00210 * Set the condition number and norm. 00211 * 00212 CNDNMA = TEN*TEN 00213 CNDNMB = TEN 00214 IF( LSAMEN( 3, PATH, 'GQR' ) .OR. LSAMEN( 3, PATH, 'GRQ' ) .OR. 00215 $ LSAMEN( 3, PATH, 'GSV' ) ) THEN 00216 IF( IMAT.EQ.5 ) THEN 00217 CNDNMA = BADC1 00218 CNDNMB = BADC1 00219 ELSE IF( IMAT.EQ.6 ) THEN 00220 CNDNMA = BADC2 00221 CNDNMB = BADC2 00222 ELSE IF( IMAT.EQ.7 ) THEN 00223 CNDNMA = BADC1 00224 CNDNMB = BADC2 00225 ELSE IF( IMAT.EQ.8 ) THEN 00226 CNDNMA = BADC2 00227 CNDNMB = BADC1 00228 END IF 00229 END IF 00230 * 00231 ANORM = TEN 00232 BNORM = TEN*TEN*TEN 00233 IF( LSAMEN( 3, PATH, 'GQR' ) .OR. LSAMEN( 3, PATH, 'GRQ' ) ) THEN 00234 IF( IMAT.EQ.7 ) THEN 00235 ANORM = SMALL 00236 BNORM = LARGE 00237 ELSE IF( IMAT.EQ.8 ) THEN 00238 ANORM = LARGE 00239 BNORM = SMALL 00240 END IF 00241 END IF 00242 * 00243 IF( N.LE.1 ) THEN 00244 CNDNMA = ONE 00245 CNDNMB = ONE 00246 END IF 00247 * 00248 RETURN 00249 * 00250 * End of DLATB9 00251 * 00252 END
1.7.3 
