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