1*> \brief \b ZCHKTZ 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE ZCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, 12* COPYA, S, TAU, WORK, RWORK, NOUT ) 13* 14* .. Scalar Arguments .. 15* LOGICAL TSTERR 16* INTEGER NM, NN, NOUT 17* DOUBLE PRECISION THRESH 18* .. 19* .. Array Arguments .. 20* LOGICAL DOTYPE( * ) 21* INTEGER MVAL( * ), NVAL( * ) 22* DOUBLE PRECISION S( * ), RWORK( * ) 23* COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * ) 24* .. 25* 26* 27*> \par Purpose: 28* ============= 29*> 30*> \verbatim 31*> 32*> ZCHKTZ tests ZTZRZF. 33*> \endverbatim 34* 35* Arguments: 36* ========== 37* 38*> \param[in] DOTYPE 39*> \verbatim 40*> DOTYPE is LOGICAL array, dimension (NTYPES) 41*> The matrix types to be used for testing. Matrices of type j 42*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 43*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 44*> \endverbatim 45*> 46*> \param[in] NM 47*> \verbatim 48*> NM is INTEGER 49*> The number of values of M contained in the vector MVAL. 50*> \endverbatim 51*> 52*> \param[in] MVAL 53*> \verbatim 54*> MVAL is INTEGER array, dimension (NM) 55*> The values of the matrix row dimension M. 56*> \endverbatim 57*> 58*> \param[in] NN 59*> \verbatim 60*> NN is INTEGER 61*> The number of values of N contained in the vector NVAL. 62*> \endverbatim 63*> 64*> \param[in] NVAL 65*> \verbatim 66*> NVAL is INTEGER array, dimension (NN) 67*> The values of the matrix column dimension N. 68*> \endverbatim 69*> 70*> \param[in] THRESH 71*> \verbatim 72*> THRESH is DOUBLE PRECISION 73*> The threshold value for the test ratios. A result is 74*> included in the output file if RESULT >= THRESH. To have 75*> every test ratio printed, use THRESH = 0. 76*> \endverbatim 77*> 78*> \param[in] TSTERR 79*> \verbatim 80*> TSTERR is LOGICAL 81*> Flag that indicates whether error exits are to be tested. 82*> \endverbatim 83*> 84*> \param[out] A 85*> \verbatim 86*> A is COMPLEX*16 array, dimension (MMAX*NMAX) 87*> where MMAX is the maximum value of M in MVAL and NMAX is the 88*> maximum value of N in NVAL. 89*> \endverbatim 90*> 91*> \param[out] COPYA 92*> \verbatim 93*> COPYA is COMPLEX*16 array, dimension (MMAX*NMAX) 94*> \endverbatim 95*> 96*> \param[out] S 97*> \verbatim 98*> S is DOUBLE PRECISION array, dimension 99*> (min(MMAX,NMAX)) 100*> \endverbatim 101*> 102*> \param[out] TAU 103*> \verbatim 104*> TAU is COMPLEX*16 array, dimension (MMAX) 105*> \endverbatim 106*> 107*> \param[out] WORK 108*> \verbatim 109*> WORK is COMPLEX*16 array, dimension 110*> (MMAX*NMAX + 4*NMAX + MMAX) 111*> \endverbatim 112*> 113*> \param[out] RWORK 114*> \verbatim 115*> RWORK is DOUBLE PRECISION array, dimension (2*NMAX) 116*> \endverbatim 117*> 118*> \param[in] NOUT 119*> \verbatim 120*> NOUT is INTEGER 121*> The unit number for output. 122*> \endverbatim 123* 124* Authors: 125* ======== 126* 127*> \author Univ. of Tennessee 128*> \author Univ. of California Berkeley 129*> \author Univ. of Colorado Denver 130*> \author NAG Ltd. 131* 132*> \ingroup complex16_lin 133* 134* ===================================================================== 135 SUBROUTINE ZCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, 136 $ COPYA, S, TAU, WORK, RWORK, NOUT ) 137* 138* -- LAPACK test routine -- 139* -- LAPACK is a software package provided by Univ. of Tennessee, -- 140* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 141* 142* .. Scalar Arguments .. 143 LOGICAL TSTERR 144 INTEGER NM, NN, NOUT 145 DOUBLE PRECISION THRESH 146* .. 147* .. Array Arguments .. 148 LOGICAL DOTYPE( * ) 149 INTEGER MVAL( * ), NVAL( * ) 150 DOUBLE PRECISION S( * ), RWORK( * ) 151 COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * ) 152* .. 153* 154* ===================================================================== 155* 156* .. Parameters .. 157 INTEGER NTYPES 158 PARAMETER ( NTYPES = 3 ) 159 INTEGER NTESTS 160 PARAMETER ( NTESTS = 3 ) 161 DOUBLE PRECISION ONE, ZERO 162 PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 ) 163* .. 164* .. Local Scalars .. 165 CHARACTER*3 PATH 166 INTEGER I, IM, IMODE, IN, INFO, K, LDA, LWORK, M, 167 $ MNMIN, MODE, N, NERRS, NFAIL, NRUN 168 DOUBLE PRECISION EPS 169* .. 170* .. Local Arrays .. 171 INTEGER ISEED( 4 ), ISEEDY( 4 ) 172 DOUBLE PRECISION RESULT( NTESTS ) 173* .. 174* .. External Functions .. 175 DOUBLE PRECISION DLAMCH, ZQRT12, ZRZT01, ZRZT02 176 EXTERNAL DLAMCH, ZQRT12, ZRZT01, ZRZT02 177* .. 178* .. External Subroutines .. 179 EXTERNAL ALAHD, ALASUM, DLAORD, ZERRTZ, ZGEQR2, ZLACPY, 180 $ ZLASET, ZLATMS, ZTZRZF 181* .. 182* .. Intrinsic Functions .. 183 INTRINSIC DCMPLX, MAX, MIN 184* .. 185* .. Scalars in Common .. 186 LOGICAL LERR, OK 187 CHARACTER*32 SRNAMT 188 INTEGER INFOT, IOUNIT 189* .. 190* .. Common blocks .. 191 COMMON / INFOC / INFOT, IOUNIT, OK, LERR 192 COMMON / SRNAMC / SRNAMT 193* .. 194* .. Data statements .. 195 DATA ISEEDY / 1988, 1989, 1990, 1991 / 196* .. 197* .. Executable Statements .. 198* 199* Initialize constants and the random number seed. 200* 201 PATH( 1: 1 ) = 'Zomplex precision' 202 PATH( 2: 3 ) = 'TZ' 203 NRUN = 0 204 NFAIL = 0 205 NERRS = 0 206 DO 10 I = 1, 4 207 ISEED( I ) = ISEEDY( I ) 208 10 CONTINUE 209 EPS = DLAMCH( 'Epsilon' ) 210* 211* Test the error exits 212* 213 IF( TSTERR ) 214 $ CALL ZERRTZ( PATH, NOUT ) 215 INFOT = 0 216* 217 DO 70 IM = 1, NM 218* 219* Do for each value of M in MVAL. 220* 221 M = MVAL( IM ) 222 LDA = MAX( 1, M ) 223* 224 DO 60 IN = 1, NN 225* 226* Do for each value of N in NVAL for which M .LE. N. 227* 228 N = NVAL( IN ) 229 MNMIN = MIN( M, N ) 230 LWORK = MAX( 1, N*N+4*M+N ) 231* 232 IF( M.LE.N ) THEN 233 DO 50 IMODE = 1, NTYPES 234 IF( .NOT.DOTYPE( IMODE ) ) 235 $ GO TO 50 236* 237* Do for each type of singular value distribution. 238* 0: zero matrix 239* 1: one small singular value 240* 2: exponential distribution 241* 242 MODE = IMODE - 1 243* 244* Test ZTZRQF 245* 246* Generate test matrix of size m by n using 247* singular value distribution indicated by `mode'. 248* 249 IF( MODE.EQ.0 ) THEN 250 CALL ZLASET( 'Full', M, N, DCMPLX( ZERO ), 251 $ DCMPLX( ZERO ), A, LDA ) 252 DO 30 I = 1, MNMIN 253 S( I ) = ZERO 254 30 CONTINUE 255 ELSE 256 CALL ZLATMS( M, N, 'Uniform', ISEED, 257 $ 'Nonsymmetric', S, IMODE, 258 $ ONE / EPS, ONE, M, N, 'No packing', A, 259 $ LDA, WORK, INFO ) 260 CALL ZGEQR2( M, N, A, LDA, WORK, WORK( MNMIN+1 ), 261 $ INFO ) 262 CALL ZLASET( 'Lower', M-1, N, DCMPLX( ZERO ), 263 $ DCMPLX( ZERO ), A( 2 ), LDA ) 264 CALL DLAORD( 'Decreasing', MNMIN, S, 1 ) 265 END IF 266* 267* Save A and its singular values 268* 269 CALL ZLACPY( 'All', M, N, A, LDA, COPYA, LDA ) 270* 271* Call ZTZRZF to reduce the upper trapezoidal matrix to 272* upper triangular form. 273* 274 SRNAMT = 'ZTZRZF' 275 CALL ZTZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) 276* 277* Compute norm(svd(a) - svd(r)) 278* 279 RESULT( 1 ) = ZQRT12( M, M, A, LDA, S, WORK, 280 $ LWORK, RWORK ) 281* 282* Compute norm( A - R*Q ) 283* 284 RESULT( 2 ) = ZRZT01( M, N, COPYA, A, LDA, TAU, WORK, 285 $ LWORK ) 286* 287* Compute norm(Q'*Q - I). 288* 289 RESULT( 3 ) = ZRZT02( M, N, A, LDA, TAU, WORK, LWORK ) 290* 291* Print information about the tests that did not pass 292* the threshold. 293* 294 DO 40 K = 1, NTESTS 295 IF( RESULT( K ).GE.THRESH ) THEN 296 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 297 $ CALL ALAHD( NOUT, PATH ) 298 WRITE( NOUT, FMT = 9999 )M, N, IMODE, K, 299 $ RESULT( K ) 300 NFAIL = NFAIL + 1 301 END IF 302 40 CONTINUE 303 NRUN = NRUN + 3 304 50 CONTINUE 305 END IF 306 60 CONTINUE 307 70 CONTINUE 308* 309* Print a summary of the results. 310* 311 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 312* 313 9999 FORMAT( ' M =', I5, ', N =', I5, ', type ', I2, ', test ', I2, 314 $ ', ratio =', G12.5 ) 315* 316* End if ZCHKTZ 317* 318 END 319