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