![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CLATM4 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 CLATM4( ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND, 00012 * TRIANG, IDIST, ISEED, A, LDA ) 00013 * 00014 * .. Scalar Arguments .. 00015 * LOGICAL RSIGN 00016 * INTEGER IDIST, ITYPE, LDA, N, NZ1, NZ2 00017 * REAL AMAGN, RCOND, TRIANG 00018 * .. 00019 * .. Array Arguments .. 00020 * INTEGER ISEED( 4 ) 00021 * COMPLEX A( LDA, * ) 00022 * .. 00023 * 00024 * 00025 *> \par Purpose: 00026 * ============= 00027 *> 00028 *> \verbatim 00029 *> 00030 *> CLATM4 generates basic square matrices, which may later be 00031 *> multiplied by others in order to produce test matrices. It is 00032 *> intended mainly to be used to test the generalized eigenvalue 00033 *> routines. 00034 *> 00035 *> It first generates the diagonal and (possibly) subdiagonal, 00036 *> according to the value of ITYPE, NZ1, NZ2, RSIGN, AMAGN, and RCOND. 00037 *> It then fills in the upper triangle with random numbers, if TRIANG is 00038 *> non-zero. 00039 *> \endverbatim 00040 * 00041 * Arguments: 00042 * ========== 00043 * 00044 *> \param[in] ITYPE 00045 *> \verbatim 00046 *> ITYPE is INTEGER 00047 *> The "type" of matrix on the diagonal and sub-diagonal. 00048 *> If ITYPE < 0, then type abs(ITYPE) is generated and then 00049 *> swapped end for end (A(I,J) := A'(N-J,N-I).) See also 00050 *> the description of AMAGN and RSIGN. 00051 *> 00052 *> Special types: 00053 *> = 0: the zero matrix. 00054 *> = 1: the identity. 00055 *> = 2: a transposed Jordan block. 00056 *> = 3: If N is odd, then a k+1 x k+1 transposed Jordan block 00057 *> followed by a k x k identity block, where k=(N-1)/2. 00058 *> If N is even, then k=(N-2)/2, and a zero diagonal entry 00059 *> is tacked onto the end. 00060 *> 00061 *> Diagonal types. The diagonal consists of NZ1 zeros, then 00062 *> k=N-NZ1-NZ2 nonzeros. The subdiagonal is zero. ITYPE 00063 *> specifies the nonzero diagonal entries as follows: 00064 *> = 4: 1, ..., k 00065 *> = 5: 1, RCOND, ..., RCOND 00066 *> = 6: 1, ..., 1, RCOND 00067 *> = 7: 1, a, a^2, ..., a^(k-1)=RCOND 00068 *> = 8: 1, 1-d, 1-2*d, ..., 1-(k-1)*d=RCOND 00069 *> = 9: random numbers chosen from (RCOND,1) 00070 *> = 10: random numbers with distribution IDIST (see CLARND.) 00071 *> \endverbatim 00072 *> 00073 *> \param[in] N 00074 *> \verbatim 00075 *> N is INTEGER 00076 *> The order of the matrix. 00077 *> \endverbatim 00078 *> 00079 *> \param[in] NZ1 00080 *> \verbatim 00081 *> NZ1 is INTEGER 00082 *> If abs(ITYPE) > 3, then the first NZ1 diagonal entries will 00083 *> be zero. 00084 *> \endverbatim 00085 *> 00086 *> \param[in] NZ2 00087 *> \verbatim 00088 *> NZ2 is INTEGER 00089 *> If abs(ITYPE) > 3, then the last NZ2 diagonal entries will 00090 *> be zero. 00091 *> \endverbatim 00092 *> 00093 *> \param[in] RSIGN 00094 *> \verbatim 00095 *> RSIGN is LOGICAL 00096 *> = .TRUE.: The diagonal and subdiagonal entries will be 00097 *> multiplied by random numbers of magnitude 1. 00098 *> = .FALSE.: The diagonal and subdiagonal entries will be 00099 *> left as they are (usually non-negative real.) 00100 *> \endverbatim 00101 *> 00102 *> \param[in] AMAGN 00103 *> \verbatim 00104 *> AMAGN is REAL 00105 *> The diagonal and subdiagonal entries will be multiplied by 00106 *> AMAGN. 00107 *> \endverbatim 00108 *> 00109 *> \param[in] RCOND 00110 *> \verbatim 00111 *> RCOND is REAL 00112 *> If abs(ITYPE) > 4, then the smallest diagonal entry will be 00113 *> RCOND. RCOND must be between 0 and 1. 00114 *> \endverbatim 00115 *> 00116 *> \param[in] TRIANG 00117 *> \verbatim 00118 *> TRIANG is REAL 00119 *> The entries above the diagonal will be random numbers with 00120 *> magnitude bounded by TRIANG (i.e., random numbers multiplied 00121 *> by TRIANG.) 00122 *> \endverbatim 00123 *> 00124 *> \param[in] IDIST 00125 *> \verbatim 00126 *> IDIST is INTEGER 00127 *> On entry, DIST specifies the type of distribution to be used 00128 *> to generate a random matrix . 00129 *> = 1: real and imaginary parts each UNIFORM( 0, 1 ) 00130 *> = 2: real and imaginary parts each UNIFORM( -1, 1 ) 00131 *> = 3: real and imaginary parts each NORMAL( 0, 1 ) 00132 *> = 4: complex number uniform in DISK( 0, 1 ) 00133 *> \endverbatim 00134 *> 00135 *> \param[in,out] ISEED 00136 *> \verbatim 00137 *> ISEED is INTEGER array, dimension (4) 00138 *> On entry ISEED specifies the seed of the random number 00139 *> generator. The values of ISEED are changed on exit, and can 00140 *> be used in the next call to CLATM4 to continue the same 00141 *> random number sequence. 00142 *> Note: ISEED(4) should be odd, for the random number generator 00143 *> used at present. 00144 *> \endverbatim 00145 *> 00146 *> \param[out] A 00147 *> \verbatim 00148 *> A is COMPLEX array, dimension (LDA, N) 00149 *> Array to be computed. 00150 *> \endverbatim 00151 *> 00152 *> \param[in] LDA 00153 *> \verbatim 00154 *> LDA is INTEGER 00155 *> Leading dimension of A. Must be at least 1 and at least N. 00156 *> \endverbatim 00157 * 00158 * Authors: 00159 * ======== 00160 * 00161 *> \author Univ. of Tennessee 00162 *> \author Univ. of California Berkeley 00163 *> \author Univ. of Colorado Denver 00164 *> \author NAG Ltd. 00165 * 00166 *> \date November 2011 00167 * 00168 *> \ingroup complex_eig 00169 * 00170 * ===================================================================== 00171 SUBROUTINE CLATM4( ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND, 00172 $ TRIANG, IDIST, ISEED, A, LDA ) 00173 * 00174 * -- LAPACK test routine (version 3.4.0) -- 00175 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00176 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00177 * November 2011 00178 * 00179 * .. Scalar Arguments .. 00180 LOGICAL RSIGN 00181 INTEGER IDIST, ITYPE, LDA, N, NZ1, NZ2 00182 REAL AMAGN, RCOND, TRIANG 00183 * .. 00184 * .. Array Arguments .. 00185 INTEGER ISEED( 4 ) 00186 COMPLEX A( LDA, * ) 00187 * .. 00188 * 00189 * ===================================================================== 00190 * 00191 * .. Parameters .. 00192 REAL ZERO, ONE 00193 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 00194 COMPLEX CZERO, CONE 00195 PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ), 00196 $ CONE = ( 1.0E+0, 0.0E+0 ) ) 00197 * .. 00198 * .. Local Scalars .. 00199 INTEGER I, ISDB, ISDE, JC, JD, JR, K, KBEG, KEND, KLEN 00200 REAL ALPHA 00201 COMPLEX CTEMP 00202 * .. 00203 * .. External Functions .. 00204 REAL SLARAN 00205 COMPLEX CLARND 00206 EXTERNAL SLARAN, CLARND 00207 * .. 00208 * .. External Subroutines .. 00209 EXTERNAL CLASET 00210 * .. 00211 * .. Intrinsic Functions .. 00212 INTRINSIC ABS, CMPLX, EXP, LOG, MAX, MIN, MOD, REAL 00213 * .. 00214 * .. Executable Statements .. 00215 * 00216 IF( N.LE.0 ) 00217 $ RETURN 00218 CALL CLASET( 'Full', N, N, CZERO, CZERO, A, LDA ) 00219 * 00220 * Insure a correct ISEED 00221 * 00222 IF( MOD( ISEED( 4 ), 2 ).NE.1 ) 00223 $ ISEED( 4 ) = ISEED( 4 ) + 1 00224 * 00225 * Compute diagonal and subdiagonal according to ITYPE, NZ1, NZ2, 00226 * and RCOND 00227 * 00228 IF( ITYPE.NE.0 ) THEN 00229 IF( ABS( ITYPE ).GE.4 ) THEN 00230 KBEG = MAX( 1, MIN( N, NZ1+1 ) ) 00231 KEND = MAX( KBEG, MIN( N, N-NZ2 ) ) 00232 KLEN = KEND + 1 - KBEG 00233 ELSE 00234 KBEG = 1 00235 KEND = N 00236 KLEN = N 00237 END IF 00238 ISDB = 1 00239 ISDE = 0 00240 GO TO ( 10, 30, 50, 80, 100, 120, 140, 160, 00241 $ 180, 200 )ABS( ITYPE ) 00242 * 00243 * abs(ITYPE) = 1: Identity 00244 * 00245 10 CONTINUE 00246 DO 20 JD = 1, N 00247 A( JD, JD ) = CONE 00248 20 CONTINUE 00249 GO TO 220 00250 * 00251 * abs(ITYPE) = 2: Transposed Jordan block 00252 * 00253 30 CONTINUE 00254 DO 40 JD = 1, N - 1 00255 A( JD+1, JD ) = CONE 00256 40 CONTINUE 00257 ISDB = 1 00258 ISDE = N - 1 00259 GO TO 220 00260 * 00261 * abs(ITYPE) = 3: Transposed Jordan block, followed by the 00262 * identity. 00263 * 00264 50 CONTINUE 00265 K = ( N-1 ) / 2 00266 DO 60 JD = 1, K 00267 A( JD+1, JD ) = CONE 00268 60 CONTINUE 00269 ISDB = 1 00270 ISDE = K 00271 DO 70 JD = K + 2, 2*K + 1 00272 A( JD, JD ) = CONE 00273 70 CONTINUE 00274 GO TO 220 00275 * 00276 * abs(ITYPE) = 4: 1,...,k 00277 * 00278 80 CONTINUE 00279 DO 90 JD = KBEG, KEND 00280 A( JD, JD ) = CMPLX( JD-NZ1 ) 00281 90 CONTINUE 00282 GO TO 220 00283 * 00284 * abs(ITYPE) = 5: One large D value: 00285 * 00286 100 CONTINUE 00287 DO 110 JD = KBEG + 1, KEND 00288 A( JD, JD ) = CMPLX( RCOND ) 00289 110 CONTINUE 00290 A( KBEG, KBEG ) = CONE 00291 GO TO 220 00292 * 00293 * abs(ITYPE) = 6: One small D value: 00294 * 00295 120 CONTINUE 00296 DO 130 JD = KBEG, KEND - 1 00297 A( JD, JD ) = CONE 00298 130 CONTINUE 00299 A( KEND, KEND ) = CMPLX( RCOND ) 00300 GO TO 220 00301 * 00302 * abs(ITYPE) = 7: Exponentially distributed D values: 00303 * 00304 140 CONTINUE 00305 A( KBEG, KBEG ) = CONE 00306 IF( KLEN.GT.1 ) THEN 00307 ALPHA = RCOND**( ONE / REAL( KLEN-1 ) ) 00308 DO 150 I = 2, KLEN 00309 A( NZ1+I, NZ1+I ) = CMPLX( ALPHA**REAL( I-1 ) ) 00310 150 CONTINUE 00311 END IF 00312 GO TO 220 00313 * 00314 * abs(ITYPE) = 8: Arithmetically distributed D values: 00315 * 00316 160 CONTINUE 00317 A( KBEG, KBEG ) = CONE 00318 IF( KLEN.GT.1 ) THEN 00319 ALPHA = ( ONE-RCOND ) / REAL( KLEN-1 ) 00320 DO 170 I = 2, KLEN 00321 A( NZ1+I, NZ1+I ) = CMPLX( REAL( KLEN-I )*ALPHA+RCOND ) 00322 170 CONTINUE 00323 END IF 00324 GO TO 220 00325 * 00326 * abs(ITYPE) = 9: Randomly distributed D values on ( RCOND, 1): 00327 * 00328 180 CONTINUE 00329 ALPHA = LOG( RCOND ) 00330 DO 190 JD = KBEG, KEND 00331 A( JD, JD ) = EXP( ALPHA*SLARAN( ISEED ) ) 00332 190 CONTINUE 00333 GO TO 220 00334 * 00335 * abs(ITYPE) = 10: Randomly distributed D values from DIST 00336 * 00337 200 CONTINUE 00338 DO 210 JD = KBEG, KEND 00339 A( JD, JD ) = CLARND( IDIST, ISEED ) 00340 210 CONTINUE 00341 * 00342 220 CONTINUE 00343 * 00344 * Scale by AMAGN 00345 * 00346 DO 230 JD = KBEG, KEND 00347 A( JD, JD ) = AMAGN*REAL( A( JD, JD ) ) 00348 230 CONTINUE 00349 DO 240 JD = ISDB, ISDE 00350 A( JD+1, JD ) = AMAGN*REAL( A( JD+1, JD ) ) 00351 240 CONTINUE 00352 * 00353 * If RSIGN = .TRUE., assign random signs to diagonal and 00354 * subdiagonal 00355 * 00356 IF( RSIGN ) THEN 00357 DO 250 JD = KBEG, KEND 00358 IF( REAL( A( JD, JD ) ).NE.ZERO ) THEN 00359 CTEMP = CLARND( 3, ISEED ) 00360 CTEMP = CTEMP / ABS( CTEMP ) 00361 A( JD, JD ) = CTEMP*REAL( A( JD, JD ) ) 00362 END IF 00363 250 CONTINUE 00364 DO 260 JD = ISDB, ISDE 00365 IF( REAL( A( JD+1, JD ) ).NE.ZERO ) THEN 00366 CTEMP = CLARND( 3, ISEED ) 00367 CTEMP = CTEMP / ABS( CTEMP ) 00368 A( JD+1, JD ) = CTEMP*REAL( A( JD+1, JD ) ) 00369 END IF 00370 260 CONTINUE 00371 END IF 00372 * 00373 * Reverse if ITYPE < 0 00374 * 00375 IF( ITYPE.LT.0 ) THEN 00376 DO 270 JD = KBEG, ( KBEG+KEND-1 ) / 2 00377 CTEMP = A( JD, JD ) 00378 A( JD, JD ) = A( KBEG+KEND-JD, KBEG+KEND-JD ) 00379 A( KBEG+KEND-JD, KBEG+KEND-JD ) = CTEMP 00380 270 CONTINUE 00381 DO 280 JD = 1, ( N-1 ) / 2 00382 CTEMP = A( JD+1, JD ) 00383 A( JD+1, JD ) = A( N+1-JD, N-JD ) 00384 A( N+1-JD, N-JD ) = CTEMP 00385 280 CONTINUE 00386 END IF 00387 * 00388 END IF 00389 * 00390 * Fill in upper triangle 00391 * 00392 IF( TRIANG.NE.ZERO ) THEN 00393 DO 300 JC = 2, N 00394 DO 290 JR = 1, JC - 1 00395 A( JR, JC ) = TRIANG*CLARND( IDIST, ISEED ) 00396 290 CONTINUE 00397 300 CONTINUE 00398 END IF 00399 * 00400 RETURN 00401 * 00402 * End of CLATM4 00403 * 00404 END