1*> \brief \b CDRVRF1 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 CDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK ) 12* 13* .. Scalar Arguments .. 14* INTEGER LDA, NN, NOUT 15* REAL THRESH 16* .. 17* .. Array Arguments .. 18* INTEGER NVAL( NN ) 19* REAL WORK( * ) 20* COMPLEX A( LDA, * ), ARF( * ) 21* .. 22* 23* 24*> \par Purpose: 25* ============= 26*> 27*> \verbatim 28*> 29*> CDRVRF1 tests the LAPACK RFP routines: 30*> CLANHF.F 31*> \endverbatim 32* 33* Arguments: 34* ========== 35* 36*> \param[in] NOUT 37*> \verbatim 38*> NOUT is INTEGER 39*> The unit number for output. 40*> \endverbatim 41*> 42*> \param[in] NN 43*> \verbatim 44*> NN is INTEGER 45*> The number of values of N contained in the vector NVAL. 46*> \endverbatim 47*> 48*> \param[in] NVAL 49*> \verbatim 50*> NVAL is INTEGER array, dimension (NN) 51*> The values of the matrix dimension N. 52*> \endverbatim 53*> 54*> \param[in] THRESH 55*> \verbatim 56*> THRESH is REAL 57*> The threshold value for the test ratios. A result is 58*> included in the output file if RESULT >= THRESH. To have 59*> every test ratio printed, use THRESH = 0. 60*> \endverbatim 61*> 62*> \param[out] A 63*> \verbatim 64*> A is COMPLEX array, dimension (LDA,NMAX) 65*> \endverbatim 66*> 67*> \param[in] LDA 68*> \verbatim 69*> LDA is INTEGER 70*> The leading dimension of the array A. LDA >= max(1,NMAX). 71*> \endverbatim 72*> 73*> \param[out] ARF 74*> \verbatim 75*> ARF is COMPLEX array, dimension ((NMAX*(NMAX+1))/2). 76*> \endverbatim 77*> 78*> \param[out] WORK 79*> \verbatim 80*> WORK is COMPLEX array, dimension ( NMAX ) 81*> \endverbatim 82* 83* Authors: 84* ======== 85* 86*> \author Univ. of Tennessee 87*> \author Univ. of California Berkeley 88*> \author Univ. of Colorado Denver 89*> \author NAG Ltd. 90* 91*> \date December 2016 92* 93*> \ingroup complex_lin 94* 95* ===================================================================== 96 SUBROUTINE CDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK ) 97* 98* -- LAPACK test routine (version 3.7.0) -- 99* -- LAPACK is a software package provided by Univ. of Tennessee, -- 100* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 101* December 2016 102* 103* .. Scalar Arguments .. 104 INTEGER LDA, NN, NOUT 105 REAL THRESH 106* .. 107* .. Array Arguments .. 108 INTEGER NVAL( NN ) 109 REAL WORK( * ) 110 COMPLEX A( LDA, * ), ARF( * ) 111* .. 112* 113* ===================================================================== 114* .. 115* .. Parameters .. 116 REAL ONE 117 PARAMETER ( ONE = 1.0E+0 ) 118 INTEGER NTESTS 119 PARAMETER ( NTESTS = 1 ) 120* .. 121* .. Local Scalars .. 122 CHARACTER UPLO, CFORM, NORM 123 INTEGER I, IFORM, IIN, IIT, INFO, INORM, IUPLO, J, N, 124 + NERRS, NFAIL, NRUN 125 REAL EPS, LARGE, NORMA, NORMARF, SMALL 126* .. 127* .. Local Arrays .. 128 CHARACTER UPLOS( 2 ), FORMS( 2 ), NORMS( 4 ) 129 INTEGER ISEED( 4 ), ISEEDY( 4 ) 130 REAL RESULT( NTESTS ) 131* .. 132* .. External Functions .. 133 COMPLEX CLARND 134 REAL SLAMCH, CLANHE, CLANHF 135 EXTERNAL SLAMCH, CLARND, CLANHE, CLANHF 136* .. 137* .. External Subroutines .. 138 EXTERNAL CTRTTF 139* .. 140* .. Scalars in Common .. 141 CHARACTER*32 SRNAMT 142* .. 143* .. Common blocks .. 144 COMMON / SRNAMC / SRNAMT 145* .. 146* .. Data statements .. 147 DATA ISEEDY / 1988, 1989, 1990, 1991 / 148 DATA UPLOS / 'U', 'L' / 149 DATA FORMS / 'N', 'C' / 150 DATA NORMS / 'M', '1', 'I', 'F' / 151* .. 152* .. Executable Statements .. 153* 154* Initialize constants and the random number seed. 155* 156 NRUN = 0 157 NFAIL = 0 158 NERRS = 0 159 INFO = 0 160 DO 10 I = 1, 4 161 ISEED( I ) = ISEEDY( I ) 162 10 CONTINUE 163* 164 EPS = SLAMCH( 'Precision' ) 165 SMALL = SLAMCH( 'Safe minimum' ) 166 LARGE = ONE / SMALL 167 SMALL = SMALL * LDA * LDA 168 LARGE = LARGE / LDA / LDA 169* 170 DO 130 IIN = 1, NN 171* 172 N = NVAL( IIN ) 173* 174 DO 120 IIT = 1, 3 175* Nothing to do for N=0 176 IF ( N .EQ. 0 ) EXIT 177* 178* IIT = 1 : random matrix 179* IIT = 2 : random matrix scaled near underflow 180* IIT = 3 : random matrix scaled near overflow 181* 182 DO J = 1, N 183 DO I = 1, N 184 A( I, J) = CLARND( 4, ISEED ) 185 END DO 186 END DO 187* 188 IF ( IIT.EQ.2 ) THEN 189 DO J = 1, N 190 DO I = 1, N 191 A( I, J) = A( I, J ) * LARGE 192 END DO 193 END DO 194 END IF 195* 196 IF ( IIT.EQ.3 ) THEN 197 DO J = 1, N 198 DO I = 1, N 199 A( I, J) = A( I, J) * SMALL 200 END DO 201 END DO 202 END IF 203* 204* Do first for UPLO = 'U', then for UPLO = 'L' 205* 206 DO 110 IUPLO = 1, 2 207* 208 UPLO = UPLOS( IUPLO ) 209* 210* Do first for CFORM = 'N', then for CFORM = 'C' 211* 212 DO 100 IFORM = 1, 2 213* 214 CFORM = FORMS( IFORM ) 215* 216 SRNAMT = 'CTRTTF' 217 CALL CTRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO ) 218* 219* Check error code from CTRTTF 220* 221 IF( INFO.NE.0 ) THEN 222 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN 223 WRITE( NOUT, * ) 224 WRITE( NOUT, FMT = 9999 ) 225 END IF 226 WRITE( NOUT, FMT = 9998 ) SRNAMT, UPLO, CFORM, N 227 NERRS = NERRS + 1 228 GO TO 100 229 END IF 230* 231 DO 90 INORM = 1, 4 232* 233* Check all four norms: 'M', '1', 'I', 'F' 234* 235 NORM = NORMS( INORM ) 236 NORMARF = CLANHF( NORM, CFORM, UPLO, N, ARF, WORK ) 237 NORMA = CLANHE( NORM, UPLO, N, A, LDA, WORK ) 238* 239 RESULT(1) = ( NORMA - NORMARF ) / NORMA / EPS 240 NRUN = NRUN + 1 241* 242 IF( RESULT(1).GE.THRESH ) THEN 243 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN 244 WRITE( NOUT, * ) 245 WRITE( NOUT, FMT = 9999 ) 246 END IF 247 WRITE( NOUT, FMT = 9997 ) 'CLANHF', 248 + N, IIT, UPLO, CFORM, NORM, RESULT(1) 249 NFAIL = NFAIL + 1 250 END IF 251 90 CONTINUE 252 100 CONTINUE 253 110 CONTINUE 254 120 CONTINUE 255 130 CONTINUE 256* 257* Print a summary of the results. 258* 259 IF ( NFAIL.EQ.0 ) THEN 260 WRITE( NOUT, FMT = 9996 )'CLANHF', NRUN 261 ELSE 262 WRITE( NOUT, FMT = 9995 ) 'CLANHF', NFAIL, NRUN 263 END IF 264 IF ( NERRS.NE.0 ) THEN 265 WRITE( NOUT, FMT = 9994 ) NERRS, 'CLANHF' 266 END IF 267* 268 9999 FORMAT( 1X, ' *** Error(s) or Failure(s) while testing CLANHF 269 + ***') 270 9998 FORMAT( 1X, ' Error in ',A6,' with UPLO=''',A1,''', FORM=''', 271 + A1,''', N=',I5) 272 9997 FORMAT( 1X, ' Failure in ',A6,' N=',I5,' TYPE=',I5,' UPLO=''', 273 + A1, ''', FORM =''',A1,''', NORM=''',A1,''', test=',G12.5) 274 9996 FORMAT( 1X, 'All tests for ',A6,' auxiliary routine passed the ', 275 + 'threshold ( ',I5,' tests run)') 276 9995 FORMAT( 1X, A6, ' auxiliary routine: ',I5,' out of ',I5, 277 + ' tests failed to pass the threshold') 278 9994 FORMAT( 26X, I5,' error message recorded (',A6,')') 279* 280 RETURN 281* 282* End of CDRVRF1 283* 284 END 285