![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DDRVRF2 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 DDRVRF2( NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER LDA, NN, NOUT 00015 * .. 00016 * .. Array Arguments .. 00017 * INTEGER NVAL( NN ) 00018 * DOUBLE PRECISION A( LDA, * ), ARF( * ), AP(*), ASAV( LDA, * ) 00019 * .. 00020 * 00021 * 00022 *> \par Purpose: 00023 * ============= 00024 *> 00025 *> \verbatim 00026 *> 00027 *> DDRVRF2 tests the LAPACK RFP convertion routines. 00028 *> \endverbatim 00029 * 00030 * Arguments: 00031 * ========== 00032 * 00033 *> \param[in] NOUT 00034 *> \verbatim 00035 *> NOUT is INTEGER 00036 *> The unit number for output. 00037 *> \endverbatim 00038 *> 00039 *> \param[in] NN 00040 *> \verbatim 00041 *> NN is INTEGER 00042 *> The number of values of N contained in the vector NVAL. 00043 *> \endverbatim 00044 *> 00045 *> \param[in] NVAL 00046 *> \verbatim 00047 *> NVAL is INTEGER array, dimension (NN) 00048 *> The values of the matrix dimension N. 00049 *> \endverbatim 00050 *> 00051 *> \param[out] A 00052 *> \verbatim 00053 *> A is DOUBLE PRECISION array, dimension (LDA,NMAX) 00054 *> \endverbatim 00055 *> 00056 *> \param[in] LDA 00057 *> \verbatim 00058 *> LDA is INTEGER 00059 *> The leading dimension of the array A. LDA >= max(1,NMAX). 00060 *> \endverbatim 00061 *> 00062 *> \param[out] ARF 00063 *> \verbatim 00064 *> ARF is DOUBLE PRECISION array, dimension ((NMAX*(NMAX+1))/2). 00065 *> \endverbatim 00066 *> 00067 *> \param[out] AP 00068 *> \verbatim 00069 *> AP is DOUBLE PRECISION array, dimension ((NMAX*(NMAX+1))/2). 00070 *> \endverbatim 00071 *> 00072 *> \param[out] ASAV 00073 *> \verbatim 00074 *> ASAV is DOUBLE PRECISION array, dimension (LDA,NMAX) 00075 *> \endverbatim 00076 * 00077 * Authors: 00078 * ======== 00079 * 00080 *> \author Univ. of Tennessee 00081 *> \author Univ. of California Berkeley 00082 *> \author Univ. of Colorado Denver 00083 *> \author NAG Ltd. 00084 * 00085 *> \date November 2011 00086 * 00087 *> \ingroup double_lin 00088 * 00089 * ===================================================================== 00090 SUBROUTINE DDRVRF2( NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV ) 00091 * 00092 * -- LAPACK test routine (version 3.4.0) -- 00093 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00094 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00095 * November 2011 00096 * 00097 * .. Scalar Arguments .. 00098 INTEGER LDA, NN, NOUT 00099 * .. 00100 * .. Array Arguments .. 00101 INTEGER NVAL( NN ) 00102 DOUBLE PRECISION A( LDA, * ), ARF( * ), AP(*), ASAV( LDA, * ) 00103 * .. 00104 * 00105 * ===================================================================== 00106 * .. 00107 * .. Local Scalars .. 00108 LOGICAL LOWER, OK1, OK2 00109 CHARACTER UPLO, CFORM 00110 INTEGER I, IFORM, IIN, INFO, IUPLO, J, N, 00111 + NERRS, NRUN 00112 * .. 00113 * .. Local Arrays .. 00114 CHARACTER UPLOS( 2 ), FORMS( 2 ) 00115 INTEGER ISEED( 4 ), ISEEDY( 4 ) 00116 * .. 00117 * .. External Functions .. 00118 DOUBLE PRECISION DLARND 00119 EXTERNAL DLARND 00120 * .. 00121 * .. External Subroutines .. 00122 EXTERNAL DTFTTR, DTFTTP, DTRTTF, DTRTTP, DTPTTR, DTPTTF 00123 * .. 00124 * .. Scalars in Common .. 00125 CHARACTER*32 SRNAMT 00126 * .. 00127 * .. Common blocks .. 00128 COMMON / SRNAMC / SRNAMT 00129 * .. 00130 * .. Data statements .. 00131 DATA ISEEDY / 1988, 1989, 1990, 1991 / 00132 DATA UPLOS / 'U', 'L' / 00133 DATA FORMS / 'N', 'T' / 00134 * .. 00135 * .. Executable Statements .. 00136 * 00137 * Initialize constants and the random number seed. 00138 * 00139 NRUN = 0 00140 NERRS = 0 00141 INFO = 0 00142 DO 10 I = 1, 4 00143 ISEED( I ) = ISEEDY( I ) 00144 10 CONTINUE 00145 * 00146 DO 120 IIN = 1, NN 00147 * 00148 N = NVAL( IIN ) 00149 * 00150 * Do first for UPLO = 'U', then for UPLO = 'L' 00151 * 00152 DO 110 IUPLO = 1, 2 00153 * 00154 UPLO = UPLOS( IUPLO ) 00155 LOWER = .TRUE. 00156 IF ( IUPLO.EQ.1 ) LOWER = .FALSE. 00157 * 00158 * Do first for CFORM = 'N', then for CFORM = 'T' 00159 * 00160 DO 100 IFORM = 1, 2 00161 * 00162 CFORM = FORMS( IFORM ) 00163 * 00164 NRUN = NRUN + 1 00165 * 00166 DO J = 1, N 00167 DO I = 1, N 00168 A( I, J) = DLARND( 2, ISEED ) 00169 END DO 00170 END DO 00171 * 00172 SRNAMT = 'DTRTTF' 00173 CALL DTRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO ) 00174 * 00175 SRNAMT = 'DTFTTP' 00176 CALL DTFTTP( CFORM, UPLO, N, ARF, AP, INFO ) 00177 * 00178 SRNAMT = 'DTPTTR' 00179 CALL DTPTTR( UPLO, N, AP, ASAV, LDA, INFO ) 00180 * 00181 OK1 = .TRUE. 00182 IF ( LOWER ) THEN 00183 DO J = 1, N 00184 DO I = J, N 00185 IF ( A(I,J).NE.ASAV(I,J) ) THEN 00186 OK1 = .FALSE. 00187 END IF 00188 END DO 00189 END DO 00190 ELSE 00191 DO J = 1, N 00192 DO I = 1, J 00193 IF ( A(I,J).NE.ASAV(I,J) ) THEN 00194 OK1 = .FALSE. 00195 END IF 00196 END DO 00197 END DO 00198 END IF 00199 * 00200 NRUN = NRUN + 1 00201 * 00202 SRNAMT = 'DTRTTP' 00203 CALL DTRTTP( UPLO, N, A, LDA, AP, INFO ) 00204 * 00205 SRNAMT = 'DTPTTF' 00206 CALL DTPTTF( CFORM, UPLO, N, AP, ARF, INFO ) 00207 * 00208 SRNAMT = 'DTFTTR' 00209 CALL DTFTTR( CFORM, UPLO, N, ARF, ASAV, LDA, INFO ) 00210 * 00211 OK2 = .TRUE. 00212 IF ( LOWER ) THEN 00213 DO J = 1, N 00214 DO I = J, N 00215 IF ( A(I,J).NE.ASAV(I,J) ) THEN 00216 OK2 = .FALSE. 00217 END IF 00218 END DO 00219 END DO 00220 ELSE 00221 DO J = 1, N 00222 DO I = 1, J 00223 IF ( A(I,J).NE.ASAV(I,J) ) THEN 00224 OK2 = .FALSE. 00225 END IF 00226 END DO 00227 END DO 00228 END IF 00229 * 00230 IF (( .NOT.OK1 ).OR.( .NOT.OK2 )) THEN 00231 IF( NERRS.EQ.0 ) THEN 00232 WRITE( NOUT, * ) 00233 WRITE( NOUT, FMT = 9999 ) 00234 END IF 00235 WRITE( NOUT, FMT = 9998 ) N, UPLO, CFORM 00236 NERRS = NERRS + 1 00237 END IF 00238 * 00239 100 CONTINUE 00240 110 CONTINUE 00241 120 CONTINUE 00242 * 00243 * Print a summary of the results. 00244 * 00245 IF ( NERRS.EQ.0 ) THEN 00246 WRITE( NOUT, FMT = 9997 ) NRUN 00247 ELSE 00248 WRITE( NOUT, FMT = 9996 ) NERRS, NRUN 00249 END IF 00250 * 00251 9999 FORMAT( 1X, ' *** Error(s) while testing the RFP convertion', 00252 + ' routines ***') 00253 9998 FORMAT( 1X, ' Error in RFP,convertion routines N=',I5, 00254 + ' UPLO=''', A1, ''', FORM =''',A1,'''') 00255 9997 FORMAT( 1X, 'All tests for the RFP convertion routines passed ( ', 00256 + I5,' tests run)') 00257 9996 FORMAT( 1X, 'RFP convertion routines: ',I5,' out of ',I5, 00258 + ' error message recorded') 00259 * 00260 RETURN 00261 * 00262 * End of DDRVRF2 00263 * 00264 END