1*> \brief \b DCHKQRT 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 ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, 12* NBVAL, NOUT ) 13* 14* .. Scalar Arguments .. 15* LOGICAL TSTERR 16* INTEGER NM, NN, NNB, NOUT 17* DOUBLE PRECISION THRESH 18* .. 19* .. Array Arguments .. 20* INTEGER MVAL( * ), NBVAL( * ), NVAL( * ) 21* 22*> \par Purpose: 23* ============= 24*> 25*> \verbatim 26*> 27*> ZCHKTSQR tests ZGEQR and ZGEMQR. 28*> \endverbatim 29* 30* Arguments: 31* ========== 32* 33*> \param[in] THRESH 34*> \verbatim 35*> THRESH is DOUBLE PRECISION 36*> The threshold value for the test ratios. A result is 37*> included in the output file if RESULT >= THRESH. To have 38*> every test ratio printed, use THRESH = 0. 39*> \endverbatim 40*> 41*> \param[in] TSTERR 42*> \verbatim 43*> TSTERR is LOGICAL 44*> Flag that indicates whether error exits are to be tested. 45*> \endverbatim 46*> 47*> \param[in] NM 48*> \verbatim 49*> NM is INTEGER 50*> The number of values of M contained in the vector MVAL. 51*> \endverbatim 52*> 53*> \param[in] MVAL 54*> \verbatim 55*> MVAL is INTEGER array, dimension (NM) 56*> The values of the matrix row dimension M. 57*> \endverbatim 58*> 59*> \param[in] NN 60*> \verbatim 61*> NN is INTEGER 62*> The number of values of N contained in the vector NVAL. 63*> \endverbatim 64*> 65*> \param[in] NVAL 66*> \verbatim 67*> NVAL is INTEGER array, dimension (NN) 68*> The values of the matrix column dimension N. 69*> \endverbatim 70*> 71*> \param[in] NNB 72*> \verbatim 73*> NNB is INTEGER 74*> The number of values of NB contained in the vector NBVAL. 75*> \endverbatim 76*> 77*> \param[in] NBVAL 78*> \verbatim 79*> NBVAL is INTEGER array, dimension (NNB) 80*> The values of the blocksize NB. 81*> \endverbatim 82*> 83*> \param[in] NOUT 84*> \verbatim 85*> NOUT is INTEGER 86*> The unit number for output. 87*> \endverbatim 88* 89* Authors: 90* ======== 91* 92*> \author Univ. of Tennessee 93*> \author Univ. of California Berkeley 94*> \author Univ. of Colorado Denver 95*> \author NAG Ltd. 96* 97*> \ingroup double_lin 98* 99* ===================================================================== 100 SUBROUTINE ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, 101 $ NBVAL, NOUT ) 102 IMPLICIT NONE 103* 104* -- LAPACK test routine -- 105* -- LAPACK is a software package provided by Univ. of Tennessee, -- 106* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 107* 108* .. Scalar Arguments .. 109 LOGICAL TSTERR 110 INTEGER NM, NN, NNB, NOUT 111 DOUBLE PRECISION THRESH 112* .. 113* .. Array Arguments .. 114 INTEGER MVAL( * ), NBVAL( * ), NVAL( * ) 115* .. 116* 117* ===================================================================== 118* 119* .. Parameters .. 120 INTEGER NTESTS 121 PARAMETER ( NTESTS = 6 ) 122* .. 123* .. Local Scalars .. 124 CHARACTER*3 PATH 125 INTEGER I, J, K, T, M, N, NB, NFAIL, NERRS, NRUN, INB, 126 $ MINMN, MB, IMB 127* 128* .. Local Arrays .. 129 DOUBLE PRECISION RESULT( NTESTS ) 130* .. 131* .. External Subroutines .. 132 EXTERNAL ALAERH, ALAHD, ALASUM, ZERRTSQR, 133 $ ZTSQR01, XLAENV 134* .. 135* .. Intrinsic Functions .. 136 INTRINSIC MAX, MIN 137* .. 138* .. Scalars in Common .. 139 LOGICAL LERR, OK 140 CHARACTER*32 SRNAMT 141 INTEGER INFOT, NUNIT 142* .. 143* .. Common blocks .. 144 COMMON / INFOC / INFOT, NUNIT, OK, LERR 145 COMMON / SRNAMC / SRNAMT 146* .. 147* .. Executable Statements .. 148* 149* Initialize constants 150* 151 PATH( 1: 1 ) = 'Z' 152 PATH( 2: 3 ) = 'TS' 153 NRUN = 0 154 NFAIL = 0 155 NERRS = 0 156* 157* Test the error exits 158* 159 CALL XLAENV( 1, 0 ) 160 CALL XLAENV( 2, 0 ) 161 IF( TSTERR ) CALL ZERRTSQR( PATH, NOUT ) 162 INFOT = 0 163* 164* Do for each value of M in MVAL. 165* 166 DO I = 1, NM 167 M = MVAL( I ) 168* 169* Do for each value of N in NVAL. 170* 171 DO J = 1, NN 172 N = NVAL( J ) 173 IF (MIN(M,N).NE.0) THEN 174 DO INB = 1, NNB 175 MB = NBVAL( INB ) 176 CALL XLAENV( 1, MB ) 177 DO IMB = 1, NNB 178 NB = NBVAL( IMB ) 179 CALL XLAENV( 2, NB ) 180* 181* Test ZGEQR and ZGEMQR 182* 183 CALL ZTSQR01( 'TS', M, N, MB, NB, RESULT ) 184* 185* Print information about the tests that did not 186* pass the threshold. 187* 188 DO T = 1, NTESTS 189 IF( RESULT( T ).GE.THRESH ) THEN 190 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 191 $ CALL ALAHD( NOUT, PATH ) 192 WRITE( NOUT, FMT = 9999 )M, N, MB, NB, 193 $ T, RESULT( T ) 194 NFAIL = NFAIL + 1 195 END IF 196 END DO 197 NRUN = NRUN + NTESTS 198 END DO 199 END DO 200 END IF 201 END DO 202 END DO 203* 204* Do for each value of M in MVAL. 205* 206 DO I = 1, NM 207 M = MVAL( I ) 208* 209* Do for each value of N in NVAL. 210* 211 DO J = 1, NN 212 N = NVAL( J ) 213 IF (MIN(M,N).NE.0) THEN 214 DO INB = 1, NNB 215 MB = NBVAL( INB ) 216 CALL XLAENV( 1, MB ) 217 DO IMB = 1, NNB 218 NB = NBVAL( IMB ) 219 CALL XLAENV( 2, NB ) 220* 221* Test ZGELQ and ZGEMLQ 222* 223 CALL ZTSQR01( 'SW', M, N, MB, NB, RESULT ) 224* 225* Print information about the tests that did not 226* pass the threshold. 227* 228 DO T = 1, NTESTS 229 IF( RESULT( T ).GE.THRESH ) THEN 230 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 231 $ CALL ALAHD( NOUT, PATH ) 232 WRITE( NOUT, FMT = 9998 )M, N, MB, NB, 233 $ T, RESULT( T ) 234 NFAIL = NFAIL + 1 235 END IF 236 END DO 237 NRUN = NRUN + NTESTS 238 END DO 239 END DO 240 END IF 241 END DO 242 END DO 243* 244* Print a summary of the results. 245* 246 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 247* 248 9999 FORMAT( 'TS: M=', I5, ', N=', I5, ', MB=', I5, 249 $ ', NB=', I5,' test(', I2, ')=', G12.5 ) 250 9998 FORMAT( 'SW: M=', I5, ', N=', I5, ', MB=', I5, 251 $ ', NB=', I5,' test(', I2, ')=', G12.5 ) 252 RETURN 253* 254* End of ZCHKTSQR 255* 256 END 257