1*> \brief \b SCHKQRT 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 SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, 12* NBVAL, NOUT ) 13* 14* .. Scalar Arguments .. 15* LOGICAL TSTERR 16* INTEGER NM, NN, NNB, NOUT 17* REAL THRESH 18* .. 19* .. Array Arguments .. 20* INTEGER MVAL( * ), NBVAL( * ), NVAL( * ) 21* 22*> \par Purpose: 23* ============= 24*> 25*> \verbatim 26*> 27*> SCHKTSQR tests SGETSQR and SORMTSQR. 28*> \endverbatim 29* 30* Arguments: 31* ========== 32* 33*> \param[in] THRESH 34*> \verbatim 35*> THRESH is REAL 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 (NBVAL) 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*> \date December 2016 98* 99*> \ingroup double_lin 100* 101* ===================================================================== 102 SUBROUTINE SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, 103 $ NBVAL, NOUT ) 104 IMPLICIT NONE 105* 106* -- LAPACK test routine (version 3.7.0) -- 107* -- LAPACK is a software package provided by Univ. of Tennessee, -- 108* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 109* December 2016 110* 111* .. Scalar Arguments .. 112 LOGICAL TSTERR 113 INTEGER NM, NN, NNB, NOUT 114 REAL THRESH 115* .. 116* .. Array Arguments .. 117 INTEGER MVAL( * ), NBVAL( * ), NVAL( * ) 118* .. 119* 120* ===================================================================== 121* 122* .. Parameters .. 123 INTEGER NTESTS 124 PARAMETER ( NTESTS = 6 ) 125* .. 126* .. Local Scalars .. 127 CHARACTER*3 PATH 128 INTEGER I, J, K, T, M, N, NB, NFAIL, NERRS, NRUN, INB, 129 $ MINMN, MB, IMB 130* 131* .. Local Arrays .. 132 REAL RESULT( NTESTS ) 133* .. 134* .. External Subroutines .. 135 EXTERNAL ALAERH, ALAHD, ALASUM, SERRTSQR, 136 $ STSQR01, XLAENV 137* .. 138* .. Intrinsic Functions .. 139 INTRINSIC MAX, MIN 140* .. 141* .. Scalars in Common .. 142 LOGICAL LERR, OK 143 CHARACTER*32 SRNAMT 144 INTEGER INFOT, NUNIT 145* .. 146* .. Common blocks .. 147 COMMON / INFOC / INFOT, NUNIT, OK, LERR 148 COMMON / SRNAMC / SRNAMT 149* .. 150* .. Executable Statements .. 151* 152* Initialize constants 153* 154 PATH( 1: 1 ) = 'S' 155 PATH( 2: 3 ) = 'TS' 156 NRUN = 0 157 NFAIL = 0 158 NERRS = 0 159* 160* Test the error exits 161* 162 CALL XLAENV( 1, 0 ) 163 CALL XLAENV( 2, 0 ) 164 IF( TSTERR ) CALL SERRTSQR( PATH, NOUT ) 165 INFOT = 0 166* 167* Do for each value of M in MVAL. 168* 169 DO I = 1, NM 170 M = MVAL( I ) 171* 172* Do for each value of N in NVAL. 173* 174 DO J = 1, NN 175 N = NVAL( J ) 176 IF (MIN(M,N).NE.0) THEN 177 DO INB = 1, NNB 178 MB = NBVAL( INB ) 179 CALL XLAENV( 1, MB ) 180 DO IMB = 1, NNB 181 NB = NBVAL( IMB ) 182 CALL XLAENV( 2, NB ) 183* 184* Test SGEQR and SGEMQR 185* 186 CALL STSQR01('TS', M, N, MB, NB, RESULT ) 187* 188* Print information about the tests that did not 189* pass the threshold. 190* 191 DO T = 1, NTESTS 192 IF( RESULT( T ).GE.THRESH ) THEN 193 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 194 $ CALL ALAHD( NOUT, PATH ) 195 WRITE( NOUT, FMT = 9999 )M, N, MB, NB, 196 $ T, RESULT( T ) 197 NFAIL = NFAIL + 1 198 END IF 199 END DO 200 NRUN = NRUN + NTESTS 201 END DO 202 END DO 203 END IF 204 END DO 205 END DO 206* 207* Do for each value of M in MVAL. 208* 209 DO I = 1, NM 210 M = MVAL( I ) 211* 212* Do for each value of N in NVAL. 213* 214 DO J = 1, NN 215 N = NVAL( J ) 216 IF (MIN(M,N).NE.0) THEN 217 DO INB = 1, NNB 218 MB = NBVAL( INB ) 219 CALL XLAENV( 1, MB ) 220 DO IMB = 1, NNB 221 NB = NBVAL( IMB ) 222 CALL XLAENV( 2, NB ) 223* 224* Test SGEQR and SGEMQR 225* 226 CALL STSQR01('SW', M, N, MB, NB, RESULT ) 227* 228* Print information about the tests that did not 229* pass the threshold. 230* 231 DO T = 1, NTESTS 232 IF( RESULT( T ).GE.THRESH ) THEN 233 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 234 $ CALL ALAHD( NOUT, PATH ) 235 WRITE( NOUT, FMT = 9998 )M, N, MB, NB, 236 $ T, RESULT( T ) 237 NFAIL = NFAIL + 1 238 END IF 239 END DO 240 NRUN = NRUN + NTESTS 241 END DO 242 END DO 243 END IF 244 END DO 245 END DO 246* 247* Print a summary of the results. 248* 249 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 250* 251 9999 FORMAT( 'TS: M=', I5, ', N=', I5, ', MB=', I5, 252 $ ', NB=', I5,' test(', I2, ')=', G12.5 ) 253 9998 FORMAT( 'SW: M=', I5, ', N=', I5, ', MB=', I5, 254 $ ', NB=', I5,' test(', I2, ')=', G12.5 ) 255 RETURN 256* 257* End of SCHKQRT 258* 259 END 260