|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE ZDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK ) 00002 * 00003 IMPLICIT NONE 00004 * 00005 * -- LAPACK test routine (version 3.2.0) -- 00006 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00007 * November 2008 00008 * 00009 * .. Scalar Arguments .. 00010 INTEGER LDA, NN, NOUT 00011 DOUBLE PRECISION THRESH 00012 * .. 00013 * .. Array Arguments .. 00014 INTEGER NVAL( NN ) 00015 DOUBLE PRECISION WORK( * ) 00016 COMPLEX*16 A( LDA, * ), ARF( * ) 00017 * .. 00018 * 00019 * Purpose 00020 * ======= 00021 * 00022 * ZDRVRF1 tests the LAPACK RFP routines: 00023 * ZLANHF.F 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * NOUT (input) INTEGER 00029 * The unit number for output. 00030 * 00031 * NN (input) INTEGER 00032 * The number of values of N contained in the vector NVAL. 00033 * 00034 * NVAL (input) INTEGER array, dimension (NN) 00035 * The values of the matrix dimension N. 00036 * 00037 * THRESH (input) DOUBLE PRECISION 00038 * The threshold value for the test ratios. A result is 00039 * included in the output file if RESULT >= THRESH. To have 00040 * every test ratio printed, use THRESH = 0. 00041 * 00042 * A (workspace) COMPLEX*16 array, dimension (LDA,NMAX) 00043 * 00044 * LDA (input) INTEGER 00045 * The leading dimension of the array A. LDA >= max(1,NMAX). 00046 * 00047 * ARF (workspace) COMPLEX*16 array, dimension ((NMAX*(NMAX+1))/2). 00048 * 00049 * WORK (workspace) DOUBLE PRECISION array, dimension ( NMAX ) 00050 * 00051 * ===================================================================== 00052 * .. 00053 * .. Parameters .. 00054 DOUBLE PRECISION ONE 00055 PARAMETER ( ONE = 1.0D+0 ) 00056 INTEGER NTESTS 00057 PARAMETER ( NTESTS = 1 ) 00058 * .. 00059 * .. Local Scalars .. 00060 CHARACTER UPLO, CFORM, NORM 00061 INTEGER I, IFORM, IIN, IIT, INFO, INORM, IUPLO, J, N, 00062 + NERRS, NFAIL, NRUN 00063 DOUBLE PRECISION EPS, LARGE, NORMA, NORMARF, SMALL 00064 * .. 00065 * .. Local Arrays .. 00066 CHARACTER UPLOS( 2 ), FORMS( 2 ), NORMS( 4 ) 00067 INTEGER ISEED( 4 ), ISEEDY( 4 ) 00068 DOUBLE PRECISION RESULT( NTESTS ) 00069 * .. 00070 * .. External Functions .. 00071 COMPLEX*16 ZLARND 00072 DOUBLE PRECISION DLAMCH, ZLANHE, ZLANHF 00073 EXTERNAL DLAMCH, ZLARND, ZLANHE, ZLANHF 00074 * .. 00075 * .. External Subroutines .. 00076 EXTERNAL ZTRTTF 00077 * .. 00078 * .. Scalars in Common .. 00079 CHARACTER*32 SRNAMT 00080 * .. 00081 * .. Common blocks .. 00082 COMMON / SRNAMC / SRNAMT 00083 * .. 00084 * .. Data statements .. 00085 DATA ISEEDY / 1988, 1989, 1990, 1991 / 00086 DATA UPLOS / 'U', 'L' / 00087 DATA FORMS / 'N', 'C' / 00088 DATA NORMS / 'M', '1', 'I', 'F' / 00089 * .. 00090 * .. Executable Statements .. 00091 * 00092 * Initialize constants and the random number seed. 00093 * 00094 NRUN = 0 00095 NFAIL = 0 00096 NERRS = 0 00097 INFO = 0 00098 DO 10 I = 1, 4 00099 ISEED( I ) = ISEEDY( I ) 00100 10 CONTINUE 00101 * 00102 EPS = DLAMCH( 'Precision' ) 00103 SMALL = DLAMCH( 'Safe minimum' ) 00104 LARGE = ONE / SMALL 00105 SMALL = SMALL * LDA * LDA 00106 LARGE = LARGE / LDA / LDA 00107 * 00108 DO 130 IIN = 1, NN 00109 * 00110 N = NVAL( IIN ) 00111 * 00112 DO 120 IIT = 1, 3 00113 * 00114 * IIT = 1 : random matrix 00115 * IIT = 2 : random matrix scaled near underflow 00116 * IIT = 3 : random matrix scaled near overflow 00117 * 00118 DO J = 1, N 00119 DO I = 1, N 00120 A( I, J) = ZLARND( 4, ISEED ) 00121 END DO 00122 END DO 00123 * 00124 IF ( IIT.EQ.2 ) THEN 00125 DO J = 1, N 00126 DO I = 1, N 00127 A( I, J) = A( I, J ) * LARGE 00128 END DO 00129 END DO 00130 END IF 00131 * 00132 IF ( IIT.EQ.3 ) THEN 00133 DO J = 1, N 00134 DO I = 1, N 00135 A( I, J) = A( I, J) * SMALL 00136 END DO 00137 END DO 00138 END IF 00139 * 00140 * Do first for UPLO = 'U', then for UPLO = 'L' 00141 * 00142 DO 110 IUPLO = 1, 2 00143 * 00144 UPLO = UPLOS( IUPLO ) 00145 * 00146 * Do first for CFORM = 'N', then for CFORM = 'C' 00147 * 00148 DO 100 IFORM = 1, 2 00149 * 00150 CFORM = FORMS( IFORM ) 00151 * 00152 SRNAMT = 'ZTRTTF' 00153 CALL ZTRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO ) 00154 * 00155 * Check error code from ZTRTTF 00156 * 00157 IF( INFO.NE.0 ) THEN 00158 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN 00159 WRITE( NOUT, * ) 00160 WRITE( NOUT, FMT = 9999 ) 00161 END IF 00162 WRITE( NOUT, FMT = 9998 ) SRNAMT, UPLO, CFORM, N 00163 NERRS = NERRS + 1 00164 GO TO 100 00165 END IF 00166 * 00167 DO 90 INORM = 1, 4 00168 * 00169 * Check all four norms: 'M', '1', 'I', 'F' 00170 * 00171 NORM = NORMS( INORM ) 00172 NORMARF = ZLANHF( NORM, CFORM, UPLO, N, ARF, WORK ) 00173 NORMA = ZLANHE( NORM, UPLO, N, A, LDA, WORK ) 00174 * 00175 RESULT(1) = ( NORMA - NORMARF ) / NORMA / EPS 00176 NRUN = NRUN + 1 00177 * 00178 IF( RESULT(1).GE.THRESH ) THEN 00179 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN 00180 WRITE( NOUT, * ) 00181 WRITE( NOUT, FMT = 9999 ) 00182 END IF 00183 WRITE( NOUT, FMT = 9997 ) 'ZLANHF', 00184 + N, IIT, UPLO, CFORM, NORM, RESULT(1) 00185 NFAIL = NFAIL + 1 00186 END IF 00187 90 CONTINUE 00188 100 CONTINUE 00189 110 CONTINUE 00190 120 CONTINUE 00191 130 CONTINUE 00192 * 00193 * Print a summary of the results. 00194 * 00195 IF ( NFAIL.EQ.0 ) THEN 00196 WRITE( NOUT, FMT = 9996 ) 'ZLANHF', NRUN 00197 ELSE 00198 WRITE( NOUT, FMT = 9995 ) 'ZLANHF', NFAIL, NRUN 00199 END IF 00200 IF ( NERRS.NE.0 ) THEN 00201 WRITE( NOUT, FMT = 9994 ) NERRS, 'ZLANHF' 00202 END IF 00203 * 00204 9999 FORMAT( 1X, 00205 ' *** Error(s) or Failure(s) while testing ZLANHF + ***') 00206 9998 FORMAT( 1X, ' Error in ',A6,' with UPLO=''',A1,''', FORM=''', 00207 + A1,''', N=',I5) 00208 9997 FORMAT( 1X, ' Failure in ',A6,' N=',I5,' TYPE=',I5,' UPLO=''', 00209 + A1, ''', FORM =''',A1,''', NORM=''',A1,''', test=',G12.5) 00210 9996 FORMAT( 1X, 'All tests for ',A6,' auxiliary routine passed the ', 00211 + 'threshold (',I5,' tests run)') 00212 9995 FORMAT( 1X, A6, ' auxiliary routine:',I5,' out of ',I5, 00213 + ' tests failed to pass the threshold') 00214 9994 FORMAT( 26X, I5,' error message recorded (',A6,')') 00215 * 00216 RETURN 00217 * 00218 * End of ZDRVRF1 00219 * 00220 END
1.7.3 
