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