![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DDRVRF1 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE DDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER LDA, NN, NOUT 00015 * DOUBLE PRECISION THRESH 00016 * .. 00017 * .. Array Arguments .. 00018 * INTEGER NVAL( NN ) 00019 * DOUBLE PRECISION A( LDA, * ), ARF( * ), WORK( * ) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> DDRVRF1 tests the LAPACK RFP routines: 00029 *> DLANSF 00030 *> \endverbatim 00031 * 00032 * Arguments: 00033 * ========== 00034 * 00035 *> \param[in] NOUT 00036 *> \verbatim 00037 *> NOUT is INTEGER 00038 *> The unit number for output. 00039 *> \endverbatim 00040 *> 00041 *> \param[in] NN 00042 *> \verbatim 00043 *> NN is INTEGER 00044 *> The number of values of N contained in the vector NVAL. 00045 *> \endverbatim 00046 *> 00047 *> \param[in] NVAL 00048 *> \verbatim 00049 *> NVAL is INTEGER array, dimension (NN) 00050 *> The values of the matrix dimension N. 00051 *> \endverbatim 00052 *> 00053 *> \param[in] THRESH 00054 *> \verbatim 00055 *> THRESH is DOUBLE PRECISION 00056 *> The threshold value for the test ratios. A result is 00057 *> included in the output file if RESULT >= THRESH. To have 00058 *> every test ratio printed, use THRESH = 0. 00059 *> \endverbatim 00060 *> 00061 *> \param[out] A 00062 *> \verbatim 00063 *> A is DOUBLE PRECISION array, dimension (LDA,NMAX) 00064 *> \endverbatim 00065 *> 00066 *> \param[in] LDA 00067 *> \verbatim 00068 *> LDA is INTEGER 00069 *> The leading dimension of the array A. LDA >= max(1,NMAX). 00070 *> \endverbatim 00071 *> 00072 *> \param[out] ARF 00073 *> \verbatim 00074 *> ARF is DOUBLE PRECISION array, dimension ((NMAX*(NMAX+1))/2). 00075 *> \endverbatim 00076 *> 00077 *> \param[out] WORK 00078 *> \verbatim 00079 *> WORK is DOUBLE PRECISION array, dimension ( NMAX ) 00080 *> \endverbatim 00081 * 00082 * Authors: 00083 * ======== 00084 * 00085 *> \author Univ. of Tennessee 00086 *> \author Univ. of California Berkeley 00087 *> \author Univ. of Colorado Denver 00088 *> \author NAG Ltd. 00089 * 00090 *> \date November 2011 00091 * 00092 *> \ingroup double_lin 00093 * 00094 * ===================================================================== 00095 SUBROUTINE DDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK ) 00096 * 00097 * -- LAPACK test routine (version 3.4.0) -- 00098 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00099 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00100 * November 2011 00101 * 00102 * .. Scalar Arguments .. 00103 INTEGER LDA, NN, NOUT 00104 DOUBLE PRECISION THRESH 00105 * .. 00106 * .. Array Arguments .. 00107 INTEGER NVAL( NN ) 00108 DOUBLE PRECISION A( LDA, * ), ARF( * ), WORK( * ) 00109 * .. 00110 * 00111 * ===================================================================== 00112 * .. 00113 * .. Parameters .. 00114 DOUBLE PRECISION ONE 00115 PARAMETER ( ONE = 1.0D+0 ) 00116 INTEGER NTESTS 00117 PARAMETER ( NTESTS = 1 ) 00118 * .. 00119 * .. Local Scalars .. 00120 CHARACTER UPLO, CFORM, NORM 00121 INTEGER I, IFORM, IIN, IIT, INFO, INORM, IUPLO, J, N, 00122 + NERRS, NFAIL, NRUN 00123 DOUBLE PRECISION EPS, LARGE, NORMA, NORMARF, SMALL 00124 * .. 00125 * .. Local Arrays .. 00126 CHARACTER UPLOS( 2 ), FORMS( 2 ), NORMS( 4 ) 00127 INTEGER ISEED( 4 ), ISEEDY( 4 ) 00128 DOUBLE PRECISION RESULT( NTESTS ) 00129 * .. 00130 * .. External Functions .. 00131 DOUBLE PRECISION DLAMCH, DLANSY, DLANSF, DLARND 00132 EXTERNAL DLAMCH, DLANSY, DLANSF, DLARND 00133 * .. 00134 * .. External Subroutines .. 00135 EXTERNAL DTRTTF 00136 * .. 00137 * .. Scalars in Common .. 00138 CHARACTER*32 SRNAMT 00139 * .. 00140 * .. Common blocks .. 00141 COMMON / SRNAMC / SRNAMT 00142 * .. 00143 * .. Data statements .. 00144 DATA ISEEDY / 1988, 1989, 1990, 1991 / 00145 DATA UPLOS / 'U', 'L' / 00146 DATA FORMS / 'N', 'T' / 00147 DATA NORMS / 'M', '1', 'I', 'F' / 00148 * .. 00149 * .. Executable Statements .. 00150 * 00151 * Initialize constants and the random number seed. 00152 * 00153 NRUN = 0 00154 NFAIL = 0 00155 NERRS = 0 00156 INFO = 0 00157 DO 10 I = 1, 4 00158 ISEED( I ) = ISEEDY( I ) 00159 10 CONTINUE 00160 * 00161 EPS = DLAMCH( 'Precision' ) 00162 SMALL = DLAMCH( 'Safe minimum' ) 00163 LARGE = ONE / SMALL 00164 SMALL = SMALL * LDA * LDA 00165 LARGE = LARGE / LDA / LDA 00166 * 00167 DO 130 IIN = 1, NN 00168 * 00169 N = NVAL( IIN ) 00170 * 00171 DO 120 IIT = 1, 3 00172 * Nothing to do for N=0 00173 IF ( N .EQ. 0 ) EXIT 00174 * 00175 * IIT = 1 : random matrix 00176 * IIT = 2 : random matrix scaled near underflow 00177 * IIT = 3 : random matrix scaled near overflow 00178 * 00179 DO J = 1, N 00180 DO I = 1, N 00181 A( I, J) = DLARND( 2, ISEED ) 00182 END DO 00183 END DO 00184 * 00185 IF ( IIT.EQ.2 ) THEN 00186 DO J = 1, N 00187 DO I = 1, N 00188 A( I, J) = A( I, J ) * LARGE 00189 END DO 00190 END DO 00191 END IF 00192 * 00193 IF ( IIT.EQ.3 ) THEN 00194 DO J = 1, N 00195 DO I = 1, N 00196 A( I, J) = A( I, J) * SMALL 00197 END DO 00198 END DO 00199 END IF 00200 * 00201 * Do first for UPLO = 'U', then for UPLO = 'L' 00202 * 00203 DO 110 IUPLO = 1, 2 00204 * 00205 UPLO = UPLOS( IUPLO ) 00206 * 00207 * Do first for CFORM = 'N', then for CFORM = 'C' 00208 * 00209 DO 100 IFORM = 1, 2 00210 * 00211 CFORM = FORMS( IFORM ) 00212 * 00213 SRNAMT = 'DTRTTF' 00214 CALL DTRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO ) 00215 * 00216 * Check error code from DTRTTF 00217 * 00218 IF( INFO.NE.0 ) THEN 00219 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN 00220 WRITE( NOUT, * ) 00221 WRITE( NOUT, FMT = 9999 ) 00222 END IF 00223 WRITE( NOUT, FMT = 9998 ) SRNAMT, UPLO, CFORM, N 00224 NERRS = NERRS + 1 00225 GO TO 100 00226 END IF 00227 * 00228 DO 90 INORM = 1, 4 00229 * 00230 * Check all four norms: 'M', '1', 'I', 'F' 00231 * 00232 NORM = NORMS( INORM ) 00233 NORMARF = DLANSF( NORM, CFORM, UPLO, N, ARF, WORK ) 00234 NORMA = DLANSY( NORM, UPLO, N, A, LDA, WORK ) 00235 * 00236 RESULT(1) = ( NORMA - NORMARF ) / NORMA / EPS 00237 NRUN = NRUN + 1 00238 * 00239 IF( RESULT(1).GE.THRESH ) THEN 00240 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN 00241 WRITE( NOUT, * ) 00242 WRITE( NOUT, FMT = 9999 ) 00243 END IF 00244 WRITE( NOUT, FMT = 9997 ) 'DLANSF', 00245 + N, IIT, UPLO, CFORM, NORM, RESULT(1) 00246 NFAIL = NFAIL + 1 00247 END IF 00248 90 CONTINUE 00249 100 CONTINUE 00250 110 CONTINUE 00251 120 CONTINUE 00252 130 CONTINUE 00253 * 00254 * Print a summary of the results. 00255 * 00256 IF ( NFAIL.EQ.0 ) THEN 00257 WRITE( NOUT, FMT = 9996 ) 'DLANSF', NRUN 00258 ELSE 00259 WRITE( NOUT, FMT = 9995 ) 'DLANSF', NFAIL, NRUN 00260 END IF 00261 IF ( NERRS.NE.0 ) THEN 00262 WRITE( NOUT, FMT = 9994 ) NERRS, 'DLANSF' 00263 END IF 00264 * 00265 9999 FORMAT( 1X, 00266 ' *** Error(s) or Failure(s) while testing DLANSF + ***') 00267 9998 FORMAT( 1X, ' Error in ',A6,' with UPLO=''',A1,''', FORM=''', 00268 + A1,''', N=',I5) 00269 9997 FORMAT( 1X, ' Failure in ',A6,' N=',I5,' TYPE=',I5,' UPLO=''', 00270 + A1, ''', FORM =''',A1,''', NORM=''',A1,''', test=',G12.5) 00271 9996 FORMAT( 1X, 'All tests for ',A6,' auxiliary routine passed the ', 00272 + 'threshold ( ',I5,' tests run)') 00273 9995 FORMAT( 1X, A6, ' auxiliary routine: ',I5,' out of ',I5, 00274 + ' tests failed to pass the threshold') 00275 9994 FORMAT( 26X, I5,' error message recorded (',A6,')') 00276 * 00277 RETURN 00278 * 00279 * End of DDRVRF1 00280 * 00281 END