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