|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE DERRRFP( NUNIT ) 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 NUNIT 00009 * .. 00010 * 00011 * Purpose 00012 * ======= 00013 * 00014 * DERRRFP tests the error exits for the DOUBLE PRECISION driver routines 00015 * for solving linear systems of equations. 00016 * 00017 * DDRVRFP tests the DOUBLE PRECISION LAPACK RFP routines: 00018 * DTFSM, DTFTRI, DSFRK, DTFTTP, DTFTTR, DPFTRF, DPFTRS, DTPTTF, 00019 * DTPTTR, DTRTTF, and DTRTTP 00020 * 00021 * Arguments 00022 * ========= 00023 * 00024 * NUNIT (input) INTEGER 00025 * The unit number for output. 00026 * 00027 * ===================================================================== 00028 * 00029 * .. 00030 * .. Local Scalars .. 00031 INTEGER INFO 00032 DOUBLE PRECISION ALPHA, BETA 00033 * .. 00034 * .. Local Arrays .. 00035 DOUBLE PRECISION A( 1, 1), B( 1, 1) 00036 * .. 00037 * .. External Subroutines .. 00038 EXTERNAL CHKXER, DTFSM, DTFTRI, DSFRK, DTFTTP, DTFTTR, 00039 + DPFTRI, DPFTRF, DPFTRS, DTPTTF, DTPTTR, DTRTTF, 00040 + DTRTTP 00041 * .. 00042 * .. Scalars in Common .. 00043 LOGICAL LERR, OK 00044 CHARACTER*32 SRNAMT 00045 INTEGER INFOT, NOUT 00046 * .. 00047 * .. Common blocks .. 00048 COMMON / INFOC / INFOT, NOUT, OK, LERR 00049 COMMON / SRNAMC / SRNAMT 00050 * .. 00051 * .. Executable Statements .. 00052 * 00053 NOUT = NUNIT 00054 OK = .TRUE. 00055 A( 1, 1 ) = 1.0D+0 00056 B( 1, 1 ) = 1.0D+0 00057 ALPHA = 1.0D+0 00058 BETA = 1.0D+0 00059 * 00060 SRNAMT = 'DPFTRF' 00061 INFOT = 1 00062 CALL DPFTRF( '/', 'U', 0, A, INFO ) 00063 CALL CHKXER( 'DPFTRF', INFOT, NOUT, LERR, OK ) 00064 INFOT = 2 00065 CALL DPFTRF( 'N', '/', 0, A, INFO ) 00066 CALL CHKXER( 'DPFTRF', INFOT, NOUT, LERR, OK ) 00067 INFOT = 3 00068 CALL DPFTRF( 'N', 'U', -1, A, INFO ) 00069 CALL CHKXER( 'DPFTRF', INFOT, NOUT, LERR, OK ) 00070 * 00071 SRNAMT = 'DPFTRS' 00072 INFOT = 1 00073 CALL DPFTRS( '/', 'U', 0, 0, A, B, 1, INFO ) 00074 CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK ) 00075 INFOT = 2 00076 CALL DPFTRS( 'N', '/', 0, 0, A, B, 1, INFO ) 00077 CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK ) 00078 INFOT = 3 00079 CALL DPFTRS( 'N', 'U', -1, 0, A, B, 1, INFO ) 00080 CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK ) 00081 INFOT = 4 00082 CALL DPFTRS( 'N', 'U', 0, -1, A, B, 1, INFO ) 00083 CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK ) 00084 INFOT = 7 00085 CALL DPFTRS( 'N', 'U', 0, 0, A, B, 0, INFO ) 00086 CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK ) 00087 * 00088 SRNAMT = 'DPFTRI' 00089 INFOT = 1 00090 CALL DPFTRI( '/', 'U', 0, A, INFO ) 00091 CALL CHKXER( 'DPFTRI', INFOT, NOUT, LERR, OK ) 00092 INFOT = 2 00093 CALL DPFTRI( 'N', '/', 0, A, INFO ) 00094 CALL CHKXER( 'DPFTRI', INFOT, NOUT, LERR, OK ) 00095 INFOT = 3 00096 CALL DPFTRI( 'N', 'U', -1, A, INFO ) 00097 CALL CHKXER( 'DPFTRI', INFOT, NOUT, LERR, OK ) 00098 * 00099 SRNAMT = 'DTFSM ' 00100 INFOT = 1 00101 CALL DTFSM( '/', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 ) 00102 CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK ) 00103 INFOT = 2 00104 CALL DTFSM( 'N', '/', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 ) 00105 CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK ) 00106 INFOT = 3 00107 CALL DTFSM( 'N', 'L', '/', 'T', 'U', 0, 0, ALPHA, A, B, 1 ) 00108 CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK ) 00109 INFOT = 4 00110 CALL DTFSM( 'N', 'L', 'U', '/', 'U', 0, 0, ALPHA, A, B, 1 ) 00111 CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK ) 00112 INFOT = 5 00113 CALL DTFSM( 'N', 'L', 'U', 'T', '/', 0, 0, ALPHA, A, B, 1 ) 00114 CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK ) 00115 INFOT = 6 00116 CALL DTFSM( 'N', 'L', 'U', 'T', 'U', -1, 0, ALPHA, A, B, 1 ) 00117 CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK ) 00118 INFOT = 7 00119 CALL DTFSM( 'N', 'L', 'U', 'T', 'U', 0, -1, ALPHA, A, B, 1 ) 00120 CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK ) 00121 INFOT = 11 00122 CALL DTFSM( 'N', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 0 ) 00123 CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK ) 00124 * 00125 SRNAMT = 'DTFTRI' 00126 INFOT = 1 00127 CALL DTFTRI( '/', 'L', 'N', 0, A, INFO ) 00128 CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK ) 00129 INFOT = 2 00130 CALL DTFTRI( 'N', '/', 'N', 0, A, INFO ) 00131 CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK ) 00132 INFOT = 3 00133 CALL DTFTRI( 'N', 'L', '/', 0, A, INFO ) 00134 CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK ) 00135 INFOT = 4 00136 CALL DTFTRI( 'N', 'L', 'N', -1, A, INFO ) 00137 CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK ) 00138 * 00139 SRNAMT = 'DTFTTR' 00140 INFOT = 1 00141 CALL DTFTTR( '/', 'U', 0, A, B, 1, INFO ) 00142 CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK ) 00143 INFOT = 2 00144 CALL DTFTTR( 'N', '/', 0, A, B, 1, INFO ) 00145 CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK ) 00146 INFOT = 3 00147 CALL DTFTTR( 'N', 'U', -1, A, B, 1, INFO ) 00148 CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK ) 00149 INFOT = 6 00150 CALL DTFTTR( 'N', 'U', 0, A, B, 0, INFO ) 00151 CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK ) 00152 * 00153 SRNAMT = 'DTRTTF' 00154 INFOT = 1 00155 CALL DTRTTF( '/', 'U', 0, A, 1, B, INFO ) 00156 CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK ) 00157 INFOT = 2 00158 CALL DTRTTF( 'N', '/', 0, A, 1, B, INFO ) 00159 CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK ) 00160 INFOT = 3 00161 CALL DTRTTF( 'N', 'U', -1, A, 1, B, INFO ) 00162 CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK ) 00163 INFOT = 5 00164 CALL DTRTTF( 'N', 'U', 0, A, 0, B, INFO ) 00165 CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK ) 00166 * 00167 SRNAMT = 'DTFTTP' 00168 INFOT = 1 00169 CALL DTFTTP( '/', 'U', 0, A, B, INFO ) 00170 CALL CHKXER( 'DTFTTP', INFOT, NOUT, LERR, OK ) 00171 INFOT = 2 00172 CALL DTFTTP( 'N', '/', 0, A, B, INFO ) 00173 CALL CHKXER( 'DTFTTP', INFOT, NOUT, LERR, OK ) 00174 INFOT = 3 00175 CALL DTFTTP( 'N', 'U', -1, A, B, INFO ) 00176 CALL CHKXER( 'DTFTTP', INFOT, NOUT, LERR, OK ) 00177 * 00178 SRNAMT = 'DTPTTF' 00179 INFOT = 1 00180 CALL DTPTTF( '/', 'U', 0, A, B, INFO ) 00181 CALL CHKXER( 'DTPTTF', INFOT, NOUT, LERR, OK ) 00182 INFOT = 2 00183 CALL DTPTTF( 'N', '/', 0, A, B, INFO ) 00184 CALL CHKXER( 'DTPTTF', INFOT, NOUT, LERR, OK ) 00185 INFOT = 3 00186 CALL DTPTTF( 'N', 'U', -1, A, B, INFO ) 00187 CALL CHKXER( 'DTPTTF', INFOT, NOUT, LERR, OK ) 00188 * 00189 SRNAMT = 'DTRTTP' 00190 INFOT = 1 00191 CALL DTRTTP( '/', 0, A, 1, B, INFO ) 00192 CALL CHKXER( 'DTRTTP', INFOT, NOUT, LERR, OK ) 00193 INFOT = 2 00194 CALL DTRTTP( 'U', -1, A, 1, B, INFO ) 00195 CALL CHKXER( 'DTRTTP', INFOT, NOUT, LERR, OK ) 00196 INFOT = 4 00197 CALL DTRTTP( 'U', 0, A, 0, B, INFO ) 00198 CALL CHKXER( 'DTRTTP', INFOT, NOUT, LERR, OK ) 00199 * 00200 SRNAMT = 'DTPTTR' 00201 INFOT = 1 00202 CALL DTPTTR( '/', 0, A, B, 1, INFO ) 00203 CALL CHKXER( 'DTPTTR', INFOT, NOUT, LERR, OK ) 00204 INFOT = 2 00205 CALL DTPTTR( 'U', -1, A, B, 1, INFO ) 00206 CALL CHKXER( 'DTPTTR', INFOT, NOUT, LERR, OK ) 00207 INFOT = 5 00208 CALL DTPTTR( 'U', 0, A, B, 0, INFO ) 00209 CALL CHKXER( 'DTPTTR', INFOT, NOUT, LERR, OK ) 00210 * 00211 SRNAMT = 'DSFRK ' 00212 INFOT = 1 00213 CALL DSFRK( '/', 'U', 'N', 0, 0, ALPHA, A, 1, BETA, B ) 00214 CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK ) 00215 INFOT = 2 00216 CALL DSFRK( 'N', '/', 'N', 0, 0, ALPHA, A, 1, BETA, B ) 00217 CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK ) 00218 INFOT = 3 00219 CALL DSFRK( 'N', 'U', '/', 0, 0, ALPHA, A, 1, BETA, B ) 00220 CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK ) 00221 INFOT = 4 00222 CALL DSFRK( 'N', 'U', 'N', -1, 0, ALPHA, A, 1, BETA, B ) 00223 CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK ) 00224 INFOT = 5 00225 CALL DSFRK( 'N', 'U', 'N', 0, -1, ALPHA, A, 1, BETA, B ) 00226 CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK ) 00227 INFOT = 8 00228 CALL DSFRK( 'N', 'U', 'N', 0, 0, ALPHA, A, 0, BETA, B ) 00229 CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK ) 00230 * 00231 * Print a summary line. 00232 * 00233 IF( OK ) THEN 00234 WRITE( NOUT, FMT = 9999 ) 00235 ELSE 00236 WRITE( NOUT, FMT = 9998 ) 00237 END IF 00238 * 00239 9999 FORMAT( 1X, 'DOUBLE PRECISION RFP routines passed the tests of ', 00240 $ 'the error exits' ) 00241 9998 FORMAT( ' *** RFP routines failed the tests of the error ', 00242 $ 'exits ***' ) 00243 RETURN 00244 * 00245 * End of DERRRFP 00246 * 00247 END
1.7.3 
