![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SERRRFP 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 SERRRFP( NUNIT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER NUNIT 00015 * .. 00016 * 00017 * 00018 *> \par Purpose: 00019 * ============= 00020 *> 00021 *> \verbatim 00022 *> 00023 *> SERRRFP tests the error exits for the REAL driver routines 00024 *> for solving linear systems of equations. 00025 *> 00026 *> SDRVRFP tests the REAL LAPACK RFP routines: 00027 *> STFSM, STFTRI, SSFRK, STFTTP, STFTTR, SPFTRF, SPFTRS, STPTTF, 00028 *> STPTTR, STRTTF, and STRTTP 00029 *> \endverbatim 00030 * 00031 * Arguments: 00032 * ========== 00033 * 00034 *> \param[in] NUNIT 00035 *> \verbatim 00036 *> NUNIT is INTEGER 00037 *> The unit number for output. 00038 *> \endverbatim 00039 * 00040 * Authors: 00041 * ======== 00042 * 00043 *> \author Univ. of Tennessee 00044 *> \author Univ. of California Berkeley 00045 *> \author Univ. of Colorado Denver 00046 *> \author NAG Ltd. 00047 * 00048 *> \date November 2011 00049 * 00050 *> \ingroup single_lin 00051 * 00052 * ===================================================================== 00053 SUBROUTINE SERRRFP( NUNIT ) 00054 * 00055 * -- LAPACK test routine (version 3.4.0) -- 00056 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00057 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00058 * November 2011 00059 * 00060 * .. Scalar Arguments .. 00061 INTEGER NUNIT 00062 * .. 00063 * 00064 * ===================================================================== 00065 * 00066 * .. 00067 * .. Local Scalars .. 00068 INTEGER INFO 00069 REAL ALPHA, BETA 00070 * .. 00071 * .. Local Arrays .. 00072 REAL A( 1, 1), B( 1, 1) 00073 * .. 00074 * .. External Subroutines .. 00075 EXTERNAL CHKXER, STFSM, STFTRI, SSFRK, STFTTP, STFTTR, 00076 + SPFTRI, SPFTRF, SPFTRS, STPTTF, STPTTR, STRTTF, 00077 + STRTTP 00078 * .. 00079 * .. Scalars in Common .. 00080 LOGICAL LERR, OK 00081 CHARACTER*32 SRNAMT 00082 INTEGER INFOT, NOUT 00083 * .. 00084 * .. Common blocks .. 00085 COMMON / INFOC / INFOT, NOUT, OK, LERR 00086 COMMON / SRNAMC / SRNAMT 00087 * .. 00088 * .. Executable Statements .. 00089 * 00090 NOUT = NUNIT 00091 OK = .TRUE. 00092 A( 1, 1 ) = 1.0E+0 00093 B( 1, 1 ) = 1.0E+0 00094 ALPHA = 1.0E+0 00095 BETA = 1.0E+0 00096 * 00097 SRNAMT = 'SPFTRF' 00098 INFOT = 1 00099 CALL SPFTRF( '/', 'U', 0, A, INFO ) 00100 CALL CHKXER( 'SPFTRF', INFOT, NOUT, LERR, OK ) 00101 INFOT = 2 00102 CALL SPFTRF( 'N', '/', 0, A, INFO ) 00103 CALL CHKXER( 'SPFTRF', INFOT, NOUT, LERR, OK ) 00104 INFOT = 3 00105 CALL SPFTRF( 'N', 'U', -1, A, INFO ) 00106 CALL CHKXER( 'SPFTRF', INFOT, NOUT, LERR, OK ) 00107 * 00108 SRNAMT = 'SPFTRS' 00109 INFOT = 1 00110 CALL SPFTRS( '/', 'U', 0, 0, A, B, 1, INFO ) 00111 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 00112 INFOT = 2 00113 CALL SPFTRS( 'N', '/', 0, 0, A, B, 1, INFO ) 00114 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 00115 INFOT = 3 00116 CALL SPFTRS( 'N', 'U', -1, 0, A, B, 1, INFO ) 00117 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 00118 INFOT = 4 00119 CALL SPFTRS( 'N', 'U', 0, -1, A, B, 1, INFO ) 00120 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 00121 INFOT = 7 00122 CALL SPFTRS( 'N', 'U', 0, 0, A, B, 0, INFO ) 00123 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 00124 * 00125 SRNAMT = 'SPFTRI' 00126 INFOT = 1 00127 CALL SPFTRI( '/', 'U', 0, A, INFO ) 00128 CALL CHKXER( 'SPFTRI', INFOT, NOUT, LERR, OK ) 00129 INFOT = 2 00130 CALL SPFTRI( 'N', '/', 0, A, INFO ) 00131 CALL CHKXER( 'SPFTRI', INFOT, NOUT, LERR, OK ) 00132 INFOT = 3 00133 CALL SPFTRI( 'N', 'U', -1, A, INFO ) 00134 CALL CHKXER( 'SPFTRI', INFOT, NOUT, LERR, OK ) 00135 * 00136 SRNAMT = 'STFSM ' 00137 INFOT = 1 00138 CALL STFSM( '/', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 ) 00139 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00140 INFOT = 2 00141 CALL STFSM( 'N', '/', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 ) 00142 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00143 INFOT = 3 00144 CALL STFSM( 'N', 'L', '/', 'T', 'U', 0, 0, ALPHA, A, B, 1 ) 00145 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00146 INFOT = 4 00147 CALL STFSM( 'N', 'L', 'U', '/', 'U', 0, 0, ALPHA, A, B, 1 ) 00148 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00149 INFOT = 5 00150 CALL STFSM( 'N', 'L', 'U', 'T', '/', 0, 0, ALPHA, A, B, 1 ) 00151 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00152 INFOT = 6 00153 CALL STFSM( 'N', 'L', 'U', 'T', 'U', -1, 0, ALPHA, A, B, 1 ) 00154 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00155 INFOT = 7 00156 CALL STFSM( 'N', 'L', 'U', 'T', 'U', 0, -1, ALPHA, A, B, 1 ) 00157 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00158 INFOT = 11 00159 CALL STFSM( 'N', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 0 ) 00160 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00161 * 00162 SRNAMT = 'STFTRI' 00163 INFOT = 1 00164 CALL STFTRI( '/', 'L', 'N', 0, A, INFO ) 00165 CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK ) 00166 INFOT = 2 00167 CALL STFTRI( 'N', '/', 'N', 0, A, INFO ) 00168 CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK ) 00169 INFOT = 3 00170 CALL STFTRI( 'N', 'L', '/', 0, A, INFO ) 00171 CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK ) 00172 INFOT = 4 00173 CALL STFTRI( 'N', 'L', 'N', -1, A, INFO ) 00174 CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK ) 00175 * 00176 SRNAMT = 'STFTTR' 00177 INFOT = 1 00178 CALL STFTTR( '/', 'U', 0, A, B, 1, INFO ) 00179 CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK ) 00180 INFOT = 2 00181 CALL STFTTR( 'N', '/', 0, A, B, 1, INFO ) 00182 CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK ) 00183 INFOT = 3 00184 CALL STFTTR( 'N', 'U', -1, A, B, 1, INFO ) 00185 CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK ) 00186 INFOT = 6 00187 CALL STFTTR( 'N', 'U', 0, A, B, 0, INFO ) 00188 CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK ) 00189 * 00190 SRNAMT = 'STRTTF' 00191 INFOT = 1 00192 CALL STRTTF( '/', 'U', 0, A, 1, B, INFO ) 00193 CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK ) 00194 INFOT = 2 00195 CALL STRTTF( 'N', '/', 0, A, 1, B, INFO ) 00196 CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK ) 00197 INFOT = 3 00198 CALL STRTTF( 'N', 'U', -1, A, 1, B, INFO ) 00199 CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK ) 00200 INFOT = 5 00201 CALL STRTTF( 'N', 'U', 0, A, 0, B, INFO ) 00202 CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK ) 00203 * 00204 SRNAMT = 'STFTTP' 00205 INFOT = 1 00206 CALL STFTTP( '/', 'U', 0, A, B, INFO ) 00207 CALL CHKXER( 'STFTTP', INFOT, NOUT, LERR, OK ) 00208 INFOT = 2 00209 CALL STFTTP( 'N', '/', 0, A, B, INFO ) 00210 CALL CHKXER( 'STFTTP', INFOT, NOUT, LERR, OK ) 00211 INFOT = 3 00212 CALL STFTTP( 'N', 'U', -1, A, B, INFO ) 00213 CALL CHKXER( 'STFTTP', INFOT, NOUT, LERR, OK ) 00214 * 00215 SRNAMT = 'STPTTF' 00216 INFOT = 1 00217 CALL STPTTF( '/', 'U', 0, A, B, INFO ) 00218 CALL CHKXER( 'STPTTF', INFOT, NOUT, LERR, OK ) 00219 INFOT = 2 00220 CALL STPTTF( 'N', '/', 0, A, B, INFO ) 00221 CALL CHKXER( 'STPTTF', INFOT, NOUT, LERR, OK ) 00222 INFOT = 3 00223 CALL STPTTF( 'N', 'U', -1, A, B, INFO ) 00224 CALL CHKXER( 'STPTTF', INFOT, NOUT, LERR, OK ) 00225 * 00226 SRNAMT = 'STRTTP' 00227 INFOT = 1 00228 CALL STRTTP( '/', 0, A, 1, B, INFO ) 00229 CALL CHKXER( 'STRTTP', INFOT, NOUT, LERR, OK ) 00230 INFOT = 2 00231 CALL STRTTP( 'U', -1, A, 1, B, INFO ) 00232 CALL CHKXER( 'STRTTP', INFOT, NOUT, LERR, OK ) 00233 INFOT = 4 00234 CALL STRTTP( 'U', 0, A, 0, B, INFO ) 00235 CALL CHKXER( 'STRTTP', INFOT, NOUT, LERR, OK ) 00236 * 00237 SRNAMT = 'STPTTR' 00238 INFOT = 1 00239 CALL STPTTR( '/', 0, A, B, 1, INFO ) 00240 CALL CHKXER( 'STPTTR', INFOT, NOUT, LERR, OK ) 00241 INFOT = 2 00242 CALL STPTTR( 'U', -1, A, B, 1, INFO ) 00243 CALL CHKXER( 'STPTTR', INFOT, NOUT, LERR, OK ) 00244 INFOT = 5 00245 CALL STPTTR( 'U', 0, A, B, 0, INFO ) 00246 CALL CHKXER( 'STPTTR', INFOT, NOUT, LERR, OK ) 00247 * 00248 SRNAMT = 'SSFRK ' 00249 INFOT = 1 00250 CALL SSFRK( '/', 'U', 'N', 0, 0, ALPHA, A, 1, BETA, B ) 00251 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 00252 INFOT = 2 00253 CALL SSFRK( 'N', '/', 'N', 0, 0, ALPHA, A, 1, BETA, B ) 00254 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 00255 INFOT = 3 00256 CALL SSFRK( 'N', 'U', '/', 0, 0, ALPHA, A, 1, BETA, B ) 00257 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 00258 INFOT = 4 00259 CALL SSFRK( 'N', 'U', 'N', -1, 0, ALPHA, A, 1, BETA, B ) 00260 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 00261 INFOT = 5 00262 CALL SSFRK( 'N', 'U', 'N', 0, -1, ALPHA, A, 1, BETA, B ) 00263 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 00264 INFOT = 8 00265 CALL SSFRK( 'N', 'U', 'N', 0, 0, ALPHA, A, 0, BETA, B ) 00266 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 00267 * 00268 * Print a summary line. 00269 * 00270 IF( OK ) THEN 00271 WRITE( NOUT, FMT = 9999 ) 00272 ELSE 00273 WRITE( NOUT, FMT = 9998 ) 00274 END IF 00275 * 00276 9999 FORMAT( 1X, 'REAL RFP routines passed the tests of ', 00277 $ 'the error exits' ) 00278 9998 FORMAT( ' *** RFP routines failed the tests of the error ', 00279 $ 'exits ***' ) 00280 RETURN 00281 * 00282 * End of SERRRFP 00283 * 00284 END