![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZCHKQ3 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 ZCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 00012 * THRESH, A, COPYA, S, TAU, WORK, RWORK, 00013 * IWORK, NOUT ) 00014 * 00015 * .. Scalar Arguments .. 00016 * INTEGER NM, NN, NNB, NOUT 00017 * DOUBLE PRECISION THRESH 00018 * .. 00019 * .. Array Arguments .. 00020 * LOGICAL DOTYPE( * ) 00021 * INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), 00022 * $ NXVAL( * ) 00023 * DOUBLE PRECISION S( * ), RWORK( * ) 00024 * COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * ) 00025 * .. 00026 * 00027 * 00028 *> \par Purpose: 00029 * ============= 00030 *> 00031 *> \verbatim 00032 *> 00033 *> ZCHKQ3 tests ZGEQP3. 00034 *> \endverbatim 00035 * 00036 * Arguments: 00037 * ========== 00038 * 00039 *> \param[in] DOTYPE 00040 *> \verbatim 00041 *> DOTYPE is LOGICAL array, dimension (NTYPES) 00042 *> The matrix types to be used for testing. Matrices of type j 00043 *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 00044 *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 00045 *> \endverbatim 00046 *> 00047 *> \param[in] NM 00048 *> \verbatim 00049 *> NM is INTEGER 00050 *> The number of values of M contained in the vector MVAL. 00051 *> \endverbatim 00052 *> 00053 *> \param[in] MVAL 00054 *> \verbatim 00055 *> MVAL is INTEGER array, dimension (NM) 00056 *> The values of the matrix row dimension M. 00057 *> \endverbatim 00058 *> 00059 *> \param[in] NN 00060 *> \verbatim 00061 *> NN is INTEGER 00062 *> The number of values of N contained in the vector NVAL. 00063 *> \endverbatim 00064 *> 00065 *> \param[in] NVAL 00066 *> \verbatim 00067 *> NVAL is INTEGER array, dimension (NN) 00068 *> The values of the matrix column dimension N. 00069 *> \endverbatim 00070 *> 00071 *> \param[in] NNB 00072 *> \verbatim 00073 *> NNB is INTEGER 00074 *> The number of values of NB and NX contained in the 00075 *> vectors NBVAL and NXVAL. The blocking parameters are used 00076 *> in pairs (NB,NX). 00077 *> \endverbatim 00078 *> 00079 *> \param[in] NBVAL 00080 *> \verbatim 00081 *> NBVAL is INTEGER array, dimension (NNB) 00082 *> The values of the blocksize NB. 00083 *> \endverbatim 00084 *> 00085 *> \param[in] NXVAL 00086 *> \verbatim 00087 *> NXVAL is INTEGER array, dimension (NNB) 00088 *> The values of the crossover point NX. 00089 *> \endverbatim 00090 *> 00091 *> \param[in] THRESH 00092 *> \verbatim 00093 *> THRESH is DOUBLE PRECISION 00094 *> The threshold value for the test ratios. A result is 00095 *> included in the output file if RESULT >= THRESH. To have 00096 *> every test ratio printed, use THRESH = 0. 00097 *> \endverbatim 00098 *> 00099 *> \param[out] A 00100 *> \verbatim 00101 *> A is COMPLEX*16 array, dimension (MMAX*NMAX) 00102 *> where MMAX is the maximum value of M in MVAL and NMAX is the 00103 *> maximum value of N in NVAL. 00104 *> \endverbatim 00105 *> 00106 *> \param[out] COPYA 00107 *> \verbatim 00108 *> COPYA is COMPLEX*16 array, dimension (MMAX*NMAX) 00109 *> \endverbatim 00110 *> 00111 *> \param[out] S 00112 *> \verbatim 00113 *> S is DOUBLE PRECISION array, dimension 00114 *> (min(MMAX,NMAX)) 00115 *> \endverbatim 00116 *> 00117 *> \param[out] TAU 00118 *> \verbatim 00119 *> TAU is COMPLEX*16 array, dimension (MMAX) 00120 *> \endverbatim 00121 *> 00122 *> \param[out] WORK 00123 *> \verbatim 00124 *> WORK is COMPLEX*16 array, dimension 00125 *> (max(M*max(M,N) + 4*min(M,N) + max(M,N))) 00126 *> \endverbatim 00127 *> 00128 *> \param[out] RWORK 00129 *> \verbatim 00130 *> RWORK is DOUBLE PRECISION array, dimension (4*NMAX) 00131 *> \endverbatim 00132 *> 00133 *> \param[out] IWORK 00134 *> \verbatim 00135 *> IWORK is INTEGER array, dimension (2*NMAX) 00136 *> \endverbatim 00137 *> 00138 *> \param[in] NOUT 00139 *> \verbatim 00140 *> NOUT is INTEGER 00141 *> The unit number for output. 00142 *> \endverbatim 00143 * 00144 * Authors: 00145 * ======== 00146 * 00147 *> \author Univ. of Tennessee 00148 *> \author Univ. of California Berkeley 00149 *> \author Univ. of Colorado Denver 00150 *> \author NAG Ltd. 00151 * 00152 *> \date November 2011 00153 * 00154 *> \ingroup complex16_lin 00155 * 00156 * ===================================================================== 00157 SUBROUTINE ZCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 00158 $ THRESH, A, COPYA, S, TAU, WORK, RWORK, 00159 $ IWORK, NOUT ) 00160 * 00161 * -- LAPACK test routine (version 3.4.0) -- 00162 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00163 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00164 * November 2011 00165 * 00166 * .. Scalar Arguments .. 00167 INTEGER NM, NN, NNB, NOUT 00168 DOUBLE PRECISION THRESH 00169 * .. 00170 * .. Array Arguments .. 00171 LOGICAL DOTYPE( * ) 00172 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), 00173 $ NXVAL( * ) 00174 DOUBLE PRECISION S( * ), RWORK( * ) 00175 COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * ) 00176 * .. 00177 * 00178 * ===================================================================== 00179 * 00180 * .. Parameters .. 00181 INTEGER NTYPES 00182 PARAMETER ( NTYPES = 6 ) 00183 INTEGER NTESTS 00184 PARAMETER ( NTESTS = 3 ) 00185 DOUBLE PRECISION ONE, ZERO 00186 COMPLEX*16 CZERO 00187 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0, 00188 $ CZERO = ( 0.0D+0, 0.0D+0 ) ) 00189 * .. 00190 * .. Local Scalars .. 00191 CHARACTER*3 PATH 00192 INTEGER I, IHIGH, ILOW, IM, IMODE, IN, INB, INFO, 00193 $ ISTEP, K, LDA, LW, LWORK, M, MNMIN, MODE, N, 00194 $ NB, NERRS, NFAIL, NRUN, NX 00195 DOUBLE PRECISION EPS 00196 * .. 00197 * .. Local Arrays .. 00198 INTEGER ISEED( 4 ), ISEEDY( 4 ) 00199 DOUBLE PRECISION RESULT( NTESTS ) 00200 * .. 00201 * .. External Functions .. 00202 DOUBLE PRECISION DLAMCH, ZQPT01, ZQRT11, ZQRT12 00203 EXTERNAL DLAMCH, ZQPT01, ZQRT11, ZQRT12 00204 * .. 00205 * .. External Subroutines .. 00206 EXTERNAL ALAHD, ALASUM, DLAORD, ICOPY, XLAENV, ZGEQP3, 00207 $ ZLACPY, ZLASET, ZLATMS 00208 * .. 00209 * .. Intrinsic Functions .. 00210 INTRINSIC MAX, MIN 00211 * .. 00212 * .. Scalars in Common .. 00213 LOGICAL LERR, OK 00214 CHARACTER*32 SRNAMT 00215 INTEGER INFOT, IOUNIT 00216 * .. 00217 * .. Common blocks .. 00218 COMMON / INFOC / INFOT, IOUNIT, OK, LERR 00219 COMMON / SRNAMC / SRNAMT 00220 * .. 00221 * .. Data statements .. 00222 DATA ISEEDY / 1988, 1989, 1990, 1991 / 00223 * .. 00224 * .. Executable Statements .. 00225 * 00226 * Initialize constants and the random number seed. 00227 * 00228 PATH( 1: 1 ) = 'Zomplex precision' 00229 PATH( 2: 3 ) = 'Q3' 00230 NRUN = 0 00231 NFAIL = 0 00232 NERRS = 0 00233 DO 10 I = 1, 4 00234 ISEED( I ) = ISEEDY( I ) 00235 10 CONTINUE 00236 EPS = DLAMCH( 'Epsilon' ) 00237 INFOT = 0 00238 * 00239 DO 90 IM = 1, NM 00240 * 00241 * Do for each value of M in MVAL. 00242 * 00243 M = MVAL( IM ) 00244 LDA = MAX( 1, M ) 00245 * 00246 DO 80 IN = 1, NN 00247 * 00248 * Do for each value of N in NVAL. 00249 * 00250 N = NVAL( IN ) 00251 MNMIN = MIN( M, N ) 00252 LWORK = MAX( 1, M*MAX( M, N )+4*MNMIN+MAX( M, N ) ) 00253 * 00254 DO 70 IMODE = 1, NTYPES 00255 IF( .NOT.DOTYPE( IMODE ) ) 00256 $ GO TO 70 00257 * 00258 * Do for each type of matrix 00259 * 1: zero matrix 00260 * 2: one small singular value 00261 * 3: geometric distribution of singular values 00262 * 4: first n/2 columns fixed 00263 * 5: last n/2 columns fixed 00264 * 6: every second column fixed 00265 * 00266 MODE = IMODE 00267 IF( IMODE.GT.3 ) 00268 $ MODE = 1 00269 * 00270 * Generate test matrix of size m by n using 00271 * singular value distribution indicated by `mode'. 00272 * 00273 DO 20 I = 1, N 00274 IWORK( I ) = 0 00275 20 CONTINUE 00276 IF( IMODE.EQ.1 ) THEN 00277 CALL ZLASET( 'Full', M, N, CZERO, CZERO, COPYA, LDA ) 00278 DO 30 I = 1, MNMIN 00279 S( I ) = ZERO 00280 30 CONTINUE 00281 ELSE 00282 CALL ZLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S, 00283 $ MODE, ONE / EPS, ONE, M, N, 'No packing', 00284 $ COPYA, LDA, WORK, INFO ) 00285 IF( IMODE.GE.4 ) THEN 00286 IF( IMODE.EQ.4 ) THEN 00287 ILOW = 1 00288 ISTEP = 1 00289 IHIGH = MAX( 1, N / 2 ) 00290 ELSE IF( IMODE.EQ.5 ) THEN 00291 ILOW = MAX( 1, N / 2 ) 00292 ISTEP = 1 00293 IHIGH = N 00294 ELSE IF( IMODE.EQ.6 ) THEN 00295 ILOW = 1 00296 ISTEP = 2 00297 IHIGH = N 00298 END IF 00299 DO 40 I = ILOW, IHIGH, ISTEP 00300 IWORK( I ) = 1 00301 40 CONTINUE 00302 END IF 00303 CALL DLAORD( 'Decreasing', MNMIN, S, 1 ) 00304 END IF 00305 * 00306 DO 60 INB = 1, NNB 00307 * 00308 * Do for each pair of values (NB,NX) in NBVAL and NXVAL. 00309 * 00310 NB = NBVAL( INB ) 00311 CALL XLAENV( 1, NB ) 00312 NX = NXVAL( INB ) 00313 CALL XLAENV( 3, NX ) 00314 * 00315 * Save A and its singular values and a copy of 00316 * vector IWORK. 00317 * 00318 CALL ZLACPY( 'All', M, N, COPYA, LDA, A, LDA ) 00319 CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) 00320 * 00321 * Workspace needed. 00322 * 00323 LW = NB*( N+1 ) 00324 * 00325 SRNAMT = 'ZGEQP3' 00326 CALL ZGEQP3( M, N, A, LDA, IWORK( N+1 ), TAU, WORK, 00327 $ LW, RWORK, INFO ) 00328 * 00329 * Compute norm(svd(a) - svd(r)) 00330 * 00331 RESULT( 1 ) = ZQRT12( M, N, A, LDA, S, WORK, 00332 $ LWORK, RWORK ) 00333 * 00334 * Compute norm( A*P - Q*R ) 00335 * 00336 RESULT( 2 ) = ZQPT01( M, N, MNMIN, COPYA, A, LDA, TAU, 00337 $ IWORK( N+1 ), WORK, LWORK ) 00338 * 00339 * Compute Q'*Q 00340 * 00341 RESULT( 3 ) = ZQRT11( M, MNMIN, A, LDA, TAU, WORK, 00342 $ LWORK ) 00343 * 00344 * Print information about the tests that did not pass 00345 * the threshold. 00346 * 00347 DO 50 K = 1, NTESTS 00348 IF( RESULT( K ).GE.THRESH ) THEN 00349 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00350 $ CALL ALAHD( NOUT, PATH ) 00351 WRITE( NOUT, FMT = 9999 )'ZGEQP3', M, N, NB, 00352 $ IMODE, K, RESULT( K ) 00353 NFAIL = NFAIL + 1 00354 END IF 00355 50 CONTINUE 00356 NRUN = NRUN + NTESTS 00357 * 00358 60 CONTINUE 00359 70 CONTINUE 00360 80 CONTINUE 00361 90 CONTINUE 00362 * 00363 * Print a summary of the results. 00364 * 00365 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 00366 * 00367 9999 FORMAT( 1X, A, ' M =', I5, ', N =', I5, ', NB =', I4, ', type ', 00368 $ I2, ', test ', I2, ', ratio =', G12.5 ) 00369 * 00370 * End of ZCHKQ3 00371 * 00372 END