1*> \brief \b SCHKORHR_COL 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 SCHKORHR_COL( 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*> SCHKORHR_COL tests: 28*> 1) SORGTSQR and SORHR_COL using SLATSQR, SGEMQRT, 29*> 2) SORGTSQR_ROW and SORHR_COL inside DGETSQRHRT 30*> (which calls SLATSQR, SORGTSQR_ROW and SORHR_COL) using SGEMQRT. 31*> Therefore, SLATSQR (part of SGEQR), SGEMQRT (part of SGEMQR) 32*> have to be tested before this test. 33*> 34*> \endverbatim 35* 36* Arguments: 37* ========== 38* 39*> \param[in] THRESH 40*> \verbatim 41*> THRESH is REAL 42*> The threshold value for the test ratios. A result is 43*> included in the output file if RESULT >= THRESH. To have 44*> every test ratio printed, use THRESH = 0. 45*> \endverbatim 46*> 47*> \param[in] TSTERR 48*> \verbatim 49*> TSTERR is LOGICAL 50*> Flag that indicates whether error exits are to be tested. 51*> \endverbatim 52*> 53*> \param[in] NM 54*> \verbatim 55*> NM is INTEGER 56*> The number of values of M contained in the vector MVAL. 57*> \endverbatim 58*> 59*> \param[in] MVAL 60*> \verbatim 61*> MVAL is INTEGER array, dimension (NM) 62*> The values of the matrix row dimension M. 63*> \endverbatim 64*> 65*> \param[in] NN 66*> \verbatim 67*> NN is INTEGER 68*> The number of values of N contained in the vector NVAL. 69*> \endverbatim 70*> 71*> \param[in] NVAL 72*> \verbatim 73*> NVAL is INTEGER array, dimension (NN) 74*> The values of the matrix column dimension N. 75*> \endverbatim 76*> 77*> \param[in] NNB 78*> \verbatim 79*> NNB is INTEGER 80*> The number of values of NB contained in the vector NBVAL. 81*> \endverbatim 82*> 83*> \param[in] NBVAL 84*> \verbatim 85*> NBVAL is INTEGER array, dimension (NBVAL) 86*> The values of the blocksize NB. 87*> \endverbatim 88*> 89*> \param[in] NOUT 90*> \verbatim 91*> NOUT is INTEGER 92*> The unit number for output. 93*> \endverbatim 94* 95* Authors: 96* ======== 97* 98*> \author Univ. of Tennessee 99*> \author Univ. of California Berkeley 100*> \author Univ. of Colorado Denver 101*> \author NAG Ltd. 102* 103*> \ingroup single_lin 104* 105* ===================================================================== 106 SUBROUTINE SCHKORHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, 107 $ NNB, NBVAL, NOUT ) 108 IMPLICIT NONE 109* 110* -- LAPACK test routine -- 111* -- LAPACK is a software package provided by Univ. of Tennessee, -- 112* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 113* 114* .. Scalar Arguments .. 115 LOGICAL TSTERR 116 INTEGER NM, NN, NNB, NOUT 117 REAL THRESH 118* .. 119* .. Array Arguments .. 120 INTEGER MVAL( * ), NBVAL( * ), NVAL( * ) 121* .. 122* 123* ===================================================================== 124* 125* .. Parameters .. 126 INTEGER NTESTS 127 PARAMETER ( NTESTS = 6 ) 128* .. 129* .. Local Scalars .. 130 CHARACTER(LEN=3) PATH 131 INTEGER I, IMB1, INB1, INB2, J, T, M, N, MB1, NB1, 132 $ NB2, NFAIL, NERRS, NRUN 133* 134* .. Local Arrays .. 135 REAL RESULT( NTESTS ) 136* .. 137* .. External Subroutines .. 138 EXTERNAL ALAHD, ALASUM, SERRORHR_COL, SORHR_COL01, 139 $ SORHR_COL02 140* .. 141* .. Intrinsic Functions .. 142 INTRINSIC MAX, MIN 143* .. 144* .. Scalars in Common .. 145 LOGICAL LERR, OK 146 CHARACTER(LEN=32) SRNAMT 147 INTEGER INFOT, NUNIT 148* .. 149* .. Common blocks .. 150 COMMON / INFOC / INFOT, NUNIT, OK, LERR 151 COMMON / SRNAMC / SRNAMT 152* .. 153* .. Executable Statements .. 154* 155* Initialize constants 156* 157 PATH( 1: 1 ) = 'S' 158 PATH( 2: 3 ) = 'HH' 159 NRUN = 0 160 NFAIL = 0 161 NERRS = 0 162* 163* Test the error exits 164* 165 IF( TSTERR ) CALL SERRORHR_COL( PATH, NOUT ) 166 INFOT = 0 167* 168* Do for each value of M in MVAL. 169* 170 DO I = 1, NM 171 M = MVAL( I ) 172* 173* Do for each value of N in NVAL. 174* 175 DO J = 1, NN 176 N = NVAL( J ) 177* 178* Only for M >= N 179* 180 IF ( MIN( M, N ).GT.0 .AND. M.GE.N ) THEN 181* 182* Do for each possible value of MB1 183* 184 DO IMB1 = 1, NNB 185 MB1 = NBVAL( IMB1 ) 186* 187* Only for MB1 > N 188* 189 IF ( MB1.GT.N ) THEN 190* 191* Do for each possible value of NB1 192* 193 DO INB1 = 1, NNB 194 NB1 = NBVAL( INB1 ) 195* 196* Do for each possible value of NB2 197* 198 DO INB2 = 1, NNB 199 NB2 = NBVAL( INB2 ) 200* 201 IF( NB1.GT.0 .AND. NB2.GT.0 ) THEN 202* 203* Test SORHR_COL 204* 205 CALL SORHR_COL01( M, N, MB1, NB1, 206 $ NB2, RESULT ) 207* 208* Print information about the tests that did 209* not pass the threshold. 210* 211 DO T = 1, NTESTS 212 IF( RESULT( T ).GE.THRESH ) THEN 213 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 214 $ CALL ALAHD( NOUT, PATH ) 215 WRITE( NOUT, FMT = 9999 ) M, N, MB1, 216 $ NB1, NB2, T, RESULT( T ) 217 NFAIL = NFAIL + 1 218 END IF 219 END DO 220 NRUN = NRUN + NTESTS 221 END IF 222 END DO 223 END DO 224 END IF 225 END DO 226 END IF 227 END DO 228 END DO 229* 230* Do for each value of M in MVAL. 231* 232 DO I = 1, NM 233 M = MVAL( I ) 234* 235* Do for each value of N in NVAL. 236* 237 DO J = 1, NN 238 N = NVAL( J ) 239* 240* Only for M >= N 241* 242 IF ( MIN( M, N ).GT.0 .AND. M.GE.N ) THEN 243* 244* Do for each possible value of MB1 245* 246 DO IMB1 = 1, NNB 247 MB1 = NBVAL( IMB1 ) 248* 249* Only for MB1 > N 250* 251 IF ( MB1.GT.N ) THEN 252* 253* Do for each possible value of NB1 254* 255 DO INB1 = 1, NNB 256 NB1 = NBVAL( INB1 ) 257* 258* Do for each possible value of NB2 259* 260 DO INB2 = 1, NNB 261 NB2 = NBVAL( INB2 ) 262* 263 IF( NB1.GT.0 .AND. NB2.GT.0 ) THEN 264* 265* Test SORHR_COL 266* 267 CALL SORHR_COL02( M, N, MB1, NB1, 268 $ NB2, RESULT ) 269* 270* Print information about the tests that did 271* not pass the threshold. 272* 273 DO T = 1, NTESTS 274 IF( RESULT( T ).GE.THRESH ) THEN 275 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 276 $ CALL ALAHD( NOUT, PATH ) 277 WRITE( NOUT, FMT = 9998 ) M, N, MB1, 278 $ NB1, NB2, T, RESULT( T ) 279 NFAIL = NFAIL + 1 280 END IF 281 END DO 282 NRUN = NRUN + NTESTS 283 END IF 284 END DO 285 END DO 286 END IF 287 END DO 288 END IF 289 END DO 290 END DO 291* 292* Print a summary of the results. 293* 294 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 295* 296 9999 FORMAT( 'SORGTSQR and SORHR_COL: M=', I5, ', N=', I5, 297 $ ', MB1=', I5, ', NB1=', I5, ', NB2=', I5, 298 $ ' test(', I2, ')=', G12.5 ) 299 9998 FORMAT( 'SORGTSQR_ROW and SORHR_COL: M=', I5, ', N=', I5, 300 $ ', MB1=', I5, ', NB1=', I5, ', NB2=', I5, 301 $ ' test(', I2, ')=', G12.5 ) 302 RETURN 303* 304* End of SCHKORHR_COL 305* 306 END