![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CCKGQR 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 CCKGQR( NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED, 00012 * THRESH, NMAX, A, AF, AQ, AR, TAUA, B, BF, BZ, 00013 * BT, BWK, TAUB, WORK, RWORK, NIN, NOUT, INFO ) 00014 * 00015 * .. Scalar Arguments .. 00016 * INTEGER INFO, NIN, NM, NMATS, NMAX, NN, NOUT, NP 00017 * REAL THRESH 00018 * .. 00019 * .. Array Arguments .. 00020 * INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * ) 00021 * REAL RWORK( * ) 00022 * COMPLEX A( * ), AF( * ), AQ( * ), AR( * ), B( * ), 00023 * $ BF( * ), BT( * ), BWK( * ), BZ( * ), TAUA( * ), 00024 * $ TAUB( * ), WORK( * ) 00025 * .. 00026 * 00027 * 00028 *> \par Purpose: 00029 * ============= 00030 *> 00031 *> \verbatim 00032 *> 00033 *> CCKGQR tests 00034 *> CGGQRF: GQR factorization for N-by-M matrix A and N-by-P matrix B, 00035 *> CGGRQF: GRQ factorization for M-by-N matrix A and P-by-N matrix B. 00036 *> \endverbatim 00037 * 00038 * Arguments: 00039 * ========== 00040 * 00041 *> \param[in] NM 00042 *> \verbatim 00043 *> NM is INTEGER 00044 *> The number of values of M contained in the vector MVAL. 00045 *> \endverbatim 00046 *> 00047 *> \param[in] MVAL 00048 *> \verbatim 00049 *> MVAL is INTEGER array, dimension (NM) 00050 *> The values of the matrix row(column) dimension M. 00051 *> \endverbatim 00052 *> 00053 *> \param[in] NP 00054 *> \verbatim 00055 *> NP is INTEGER 00056 *> The number of values of P contained in the vector PVAL. 00057 *> \endverbatim 00058 *> 00059 *> \param[in] PVAL 00060 *> \verbatim 00061 *> PVAL is INTEGER array, dimension (NP) 00062 *> The values of the matrix row(column) dimension P. 00063 *> \endverbatim 00064 *> 00065 *> \param[in] NN 00066 *> \verbatim 00067 *> NN is INTEGER 00068 *> The number of values of N contained in the vector NVAL. 00069 *> \endverbatim 00070 *> 00071 *> \param[in] NVAL 00072 *> \verbatim 00073 *> NVAL is INTEGER array, dimension (NN) 00074 *> The values of the matrix column(row) dimension N. 00075 *> \endverbatim 00076 *> 00077 *> \param[in] NMATS 00078 *> \verbatim 00079 *> NMATS is INTEGER 00080 *> The number of matrix types to be tested for each combination 00081 *> of matrix dimensions. If NMATS >= NTYPES (the maximum 00082 *> number of matrix types), then all the different types are 00083 *> generated for testing. If NMATS < NTYPES, another input line 00084 *> is read to get the numbers of the matrix types to be used. 00085 *> \endverbatim 00086 *> 00087 *> \param[in,out] ISEED 00088 *> \verbatim 00089 *> ISEED is INTEGER array, dimension (4) 00090 *> On entry, the seed of the random number generator. The array 00091 *> elements should be between 0 and 4095, otherwise they will be 00092 *> reduced mod 4096, and ISEED(4) must be odd. 00093 *> On exit, the next seed in the random number sequence after 00094 *> all the test matrices have been generated. 00095 *> \endverbatim 00096 *> 00097 *> \param[in] THRESH 00098 *> \verbatim 00099 *> THRESH is REAL 00100 *> The threshold value for the test ratios. A result is 00101 *> included in the output file if RESULT >= THRESH. To have 00102 *> every test ratio printed, use THRESH = 0. 00103 *> \endverbatim 00104 *> 00105 *> \param[in] NMAX 00106 *> \verbatim 00107 *> NMAX is INTEGER 00108 *> The maximum value permitted for M or N, used in dimensioning 00109 *> the work arrays. 00110 *> \endverbatim 00111 *> 00112 *> \param[out] A 00113 *> \verbatim 00114 *> A is COMPLEX array, dimension (NMAX*NMAX) 00115 *> \endverbatim 00116 *> 00117 *> \param[out] AF 00118 *> \verbatim 00119 *> AF is COMPLEX array, dimension (NMAX*NMAX) 00120 *> \endverbatim 00121 *> 00122 *> \param[out] AQ 00123 *> \verbatim 00124 *> AQ is COMPLEX array, dimension (NMAX*NMAX) 00125 *> \endverbatim 00126 *> 00127 *> \param[out] AR 00128 *> \verbatim 00129 *> AR is COMPLEX array, dimension (NMAX*NMAX) 00130 *> \endverbatim 00131 *> 00132 *> \param[out] TAUA 00133 *> \verbatim 00134 *> TAUA is COMPLEX array, dimension (NMAX) 00135 *> \endverbatim 00136 *> 00137 *> \param[out] B 00138 *> \verbatim 00139 *> B is COMPLEX array, dimension (NMAX*NMAX) 00140 *> \endverbatim 00141 *> 00142 *> \param[out] BF 00143 *> \verbatim 00144 *> BF is COMPLEX array, dimension (NMAX*NMAX) 00145 *> \endverbatim 00146 *> 00147 *> \param[out] BZ 00148 *> \verbatim 00149 *> BZ is COMPLEX array, dimension (NMAX*NMAX) 00150 *> \endverbatim 00151 *> 00152 *> \param[out] BT 00153 *> \verbatim 00154 *> BT is COMPLEX array, dimension (NMAX*NMAX) 00155 *> \endverbatim 00156 *> 00157 *> \param[out] BWK 00158 *> \verbatim 00159 *> BWK is COMPLEX array, dimension (NMAX*NMAX) 00160 *> \endverbatim 00161 *> 00162 *> \param[out] TAUB 00163 *> \verbatim 00164 *> TAUB is COMPLEX array, dimension (NMAX) 00165 *> \endverbatim 00166 *> 00167 *> \param[out] WORK 00168 *> \verbatim 00169 *> WORK is COMPLEX array, dimension (NMAX*NMAX) 00170 *> \endverbatim 00171 *> 00172 *> \param[out] RWORK 00173 *> \verbatim 00174 *> RWORK is REAL array, dimension (NMAX) 00175 *> \endverbatim 00176 *> 00177 *> \param[in] NIN 00178 *> \verbatim 00179 *> NIN is INTEGER 00180 *> The unit number for input. 00181 *> \endverbatim 00182 *> 00183 *> \param[in] NOUT 00184 *> \verbatim 00185 *> NOUT is INTEGER 00186 *> The unit number for output. 00187 *> \endverbatim 00188 *> 00189 *> \param[out] INFO 00190 *> \verbatim 00191 *> INFO is INTEGER 00192 *> = 0 : successful exit 00193 *> > 0 : If CLATMS returns an error code, the absolute value 00194 *> of it is returned. 00195 *> \endverbatim 00196 * 00197 * Authors: 00198 * ======== 00199 * 00200 *> \author Univ. of Tennessee 00201 *> \author Univ. of California Berkeley 00202 *> \author Univ. of Colorado Denver 00203 *> \author NAG Ltd. 00204 * 00205 *> \date November 2011 00206 * 00207 *> \ingroup complex_eig 00208 * 00209 * ===================================================================== 00210 SUBROUTINE CCKGQR( NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED, 00211 $ THRESH, NMAX, A, AF, AQ, AR, TAUA, B, BF, BZ, 00212 $ BT, BWK, TAUB, WORK, RWORK, NIN, NOUT, INFO ) 00213 * 00214 * -- LAPACK test routine (version 3.4.0) -- 00215 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00216 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00217 * November 2011 00218 * 00219 * .. Scalar Arguments .. 00220 INTEGER INFO, NIN, NM, NMATS, NMAX, NN, NOUT, NP 00221 REAL THRESH 00222 * .. 00223 * .. Array Arguments .. 00224 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * ) 00225 REAL RWORK( * ) 00226 COMPLEX A( * ), AF( * ), AQ( * ), AR( * ), B( * ), 00227 $ BF( * ), BT( * ), BWK( * ), BZ( * ), TAUA( * ), 00228 $ TAUB( * ), WORK( * ) 00229 * .. 00230 * 00231 * ===================================================================== 00232 * 00233 * .. Parameters .. 00234 INTEGER NTESTS 00235 PARAMETER ( NTESTS = 7 ) 00236 INTEGER NTYPES 00237 PARAMETER ( NTYPES = 8 ) 00238 * .. 00239 * .. Local Scalars .. 00240 LOGICAL FIRSTT 00241 CHARACTER DISTA, DISTB, TYPE 00242 CHARACTER*3 PATH 00243 INTEGER I, IINFO, IM, IMAT, IN, IP, KLA, KLB, KUA, KUB, 00244 $ LDA, LDB, LWORK, M, MODEA, MODEB, N, NFAIL, 00245 $ NRUN, NT, P 00246 REAL ANORM, BNORM, CNDNMA, CNDNMB 00247 * .. 00248 * .. Local Arrays .. 00249 LOGICAL DOTYPE( NTYPES ) 00250 REAL RESULT( NTESTS ) 00251 * .. 00252 * .. External Subroutines .. 00253 EXTERNAL ALAHDG, ALAREQ, ALASUM, CGQRTS, CGRQTS, CLATMS, 00254 $ SLATB9 00255 * .. 00256 * .. Intrinsic Functions .. 00257 INTRINSIC ABS 00258 * .. 00259 * .. Executable Statements .. 00260 * 00261 * Initialize constants. 00262 * 00263 PATH( 1: 3 ) = 'GQR' 00264 INFO = 0 00265 NRUN = 0 00266 NFAIL = 0 00267 FIRSTT = .TRUE. 00268 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00269 LDA = NMAX 00270 LDB = NMAX 00271 LWORK = NMAX*NMAX 00272 * 00273 * Do for each value of M in MVAL. 00274 * 00275 DO 60 IM = 1, NM 00276 M = MVAL( IM ) 00277 * 00278 * Do for each value of P in PVAL. 00279 * 00280 DO 50 IP = 1, NP 00281 P = PVAL( IP ) 00282 * 00283 * Do for each value of N in NVAL. 00284 * 00285 DO 40 IN = 1, NN 00286 N = NVAL( IN ) 00287 * 00288 DO 30 IMAT = 1, NTYPES 00289 * 00290 * Do the tests only if DOTYPE( IMAT ) is true. 00291 * 00292 IF( .NOT.DOTYPE( IMAT ) ) 00293 $ GO TO 30 00294 * 00295 * Test CGGRQF 00296 * 00297 * Set up parameters with SLATB9 and generate test 00298 * matrices A and B with CLATMS. 00299 * 00300 CALL SLATB9( 'GRQ', IMAT, M, P, N, TYPE, KLA, KUA, 00301 $ KLB, KUB, ANORM, BNORM, MODEA, MODEB, 00302 $ CNDNMA, CNDNMB, DISTA, DISTB ) 00303 * 00304 CALL CLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA, 00305 $ CNDNMA, ANORM, KLA, KUA, 'No packing', A, 00306 $ LDA, WORK, IINFO ) 00307 IF( IINFO.NE.0 ) THEN 00308 WRITE( NOUT, FMT = 9999 )IINFO 00309 INFO = ABS( IINFO ) 00310 GO TO 30 00311 END IF 00312 * 00313 CALL CLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB, 00314 $ CNDNMB, BNORM, KLB, KUB, 'No packing', B, 00315 $ LDB, WORK, IINFO ) 00316 IF( IINFO.NE.0 ) THEN 00317 WRITE( NOUT, FMT = 9999 )IINFO 00318 INFO = ABS( IINFO ) 00319 GO TO 30 00320 END IF 00321 * 00322 NT = 4 00323 * 00324 CALL CGRQTS( M, P, N, A, AF, AQ, AR, LDA, TAUA, B, BF, 00325 $ BZ, BT, BWK, LDB, TAUB, WORK, LWORK, 00326 $ RWORK, RESULT ) 00327 * 00328 * Print information about the tests that did not 00329 * pass the threshold. 00330 * 00331 DO 10 I = 1, NT 00332 IF( RESULT( I ).GE.THRESH ) THEN 00333 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN 00334 FIRSTT = .FALSE. 00335 CALL ALAHDG( NOUT, 'GRQ' ) 00336 END IF 00337 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I, 00338 $ RESULT( I ) 00339 NFAIL = NFAIL + 1 00340 END IF 00341 10 CONTINUE 00342 NRUN = NRUN + NT 00343 * 00344 * Test CGGQRF 00345 * 00346 * Set up parameters with SLATB9 and generate test 00347 * matrices A and B with CLATMS. 00348 * 00349 CALL SLATB9( 'GQR', IMAT, M, P, N, TYPE, KLA, KUA, 00350 $ KLB, KUB, ANORM, BNORM, MODEA, MODEB, 00351 $ CNDNMA, CNDNMB, DISTA, DISTB ) 00352 * 00353 CALL CLATMS( N, M, DISTA, ISEED, TYPE, RWORK, MODEA, 00354 $ CNDNMA, ANORM, KLA, KUA, 'No packing', A, 00355 $ LDA, WORK, IINFO ) 00356 IF( IINFO.NE.0 ) THEN 00357 WRITE( NOUT, FMT = 9999 )IINFO 00358 INFO = ABS( IINFO ) 00359 GO TO 30 00360 END IF 00361 * 00362 CALL CLATMS( N, P, DISTB, ISEED, TYPE, RWORK, MODEA, 00363 $ CNDNMA, BNORM, KLB, KUB, 'No packing', B, 00364 $ LDB, WORK, IINFO ) 00365 IF( IINFO.NE.0 ) THEN 00366 WRITE( NOUT, FMT = 9999 )IINFO 00367 INFO = ABS( IINFO ) 00368 GO TO 30 00369 END IF 00370 * 00371 NT = 4 00372 * 00373 CALL CGQRTS( N, M, P, A, AF, AQ, AR, LDA, TAUA, B, BF, 00374 $ BZ, BT, BWK, LDB, TAUB, WORK, LWORK, 00375 $ RWORK, RESULT ) 00376 * 00377 * Print information about the tests that did not 00378 * pass the threshold. 00379 * 00380 DO 20 I = 1, NT 00381 IF( RESULT( I ).GE.THRESH ) THEN 00382 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN 00383 FIRSTT = .FALSE. 00384 CALL ALAHDG( NOUT, PATH ) 00385 END IF 00386 WRITE( NOUT, FMT = 9997 )N, M, P, IMAT, I, 00387 $ RESULT( I ) 00388 NFAIL = NFAIL + 1 00389 END IF 00390 20 CONTINUE 00391 NRUN = NRUN + NT 00392 * 00393 30 CONTINUE 00394 40 CONTINUE 00395 50 CONTINUE 00396 60 CONTINUE 00397 * 00398 * Print a summary of the results. 00399 * 00400 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 ) 00401 * 00402 9999 FORMAT( ' CLATMS in CCKGQR: INFO = ', I5 ) 00403 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2, 00404 $ ', test ', I2, ', ratio=', G13.6 ) 00405 9997 FORMAT( ' N=', I4, ' M=', I4, ', P=', I4, ', type ', I2, 00406 $ ', test ', I2, ', ratio=', G13.6 ) 00407 RETURN 00408 * 00409 * End of CCKGQR 00410 * 00411 END