|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE SERRRFP( 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 * SERRRFP tests the error exits for the REAL driver routines 00015 * for solving linear systems of equations. 00016 * 00017 * SDRVRFP tests the REAL LAPACK RFP routines: 00018 * STFSM, STFTRI, SSFRK, STFTTP, STFTTR, SPFTRF, SPFTRS, STPTTF, 00019 * STPTTR, STRTTF, and STRTTP 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 REAL ALPHA, BETA 00033 * .. 00034 * .. Local Arrays .. 00035 REAL A( 1, 1), B( 1, 1) 00036 * .. 00037 * .. External Subroutines .. 00038 EXTERNAL CHKXER, STFSM, STFTRI, SSFRK, STFTTP, STFTTR, 00039 + SPFTRI, SPFTRF, SPFTRS, STPTTF, STPTTR, STRTTF, 00040 + STRTTP 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.0E+0 00056 B( 1, 1 ) = 1.0E+0 00057 ALPHA = 1.0E+0 00058 BETA = 1.0E+0 00059 * 00060 SRNAMT = 'SPFTRF' 00061 INFOT = 1 00062 CALL SPFTRF( '/', 'U', 0, A, INFO ) 00063 CALL CHKXER( 'SPFTRF', INFOT, NOUT, LERR, OK ) 00064 INFOT = 2 00065 CALL SPFTRF( 'N', '/', 0, A, INFO ) 00066 CALL CHKXER( 'SPFTRF', INFOT, NOUT, LERR, OK ) 00067 INFOT = 3 00068 CALL SPFTRF( 'N', 'U', -1, A, INFO ) 00069 CALL CHKXER( 'SPFTRF', INFOT, NOUT, LERR, OK ) 00070 * 00071 SRNAMT = 'SPFTRS' 00072 INFOT = 1 00073 CALL SPFTRS( '/', 'U', 0, 0, A, B, 1, INFO ) 00074 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 00075 INFOT = 2 00076 CALL SPFTRS( 'N', '/', 0, 0, A, B, 1, INFO ) 00077 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 00078 INFOT = 3 00079 CALL SPFTRS( 'N', 'U', -1, 0, A, B, 1, INFO ) 00080 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 00081 INFOT = 4 00082 CALL SPFTRS( 'N', 'U', 0, -1, A, B, 1, INFO ) 00083 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 00084 INFOT = 7 00085 CALL SPFTRS( 'N', 'U', 0, 0, A, B, 0, INFO ) 00086 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 00087 * 00088 SRNAMT = 'SPFTRI' 00089 INFOT = 1 00090 CALL SPFTRI( '/', 'U', 0, A, INFO ) 00091 CALL CHKXER( 'SPFTRI', INFOT, NOUT, LERR, OK ) 00092 INFOT = 2 00093 CALL SPFTRI( 'N', '/', 0, A, INFO ) 00094 CALL CHKXER( 'SPFTRI', INFOT, NOUT, LERR, OK ) 00095 INFOT = 3 00096 CALL SPFTRI( 'N', 'U', -1, A, INFO ) 00097 CALL CHKXER( 'SPFTRI', INFOT, NOUT, LERR, OK ) 00098 * 00099 SRNAMT = 'STFSM ' 00100 INFOT = 1 00101 CALL STFSM( '/', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 ) 00102 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00103 INFOT = 2 00104 CALL STFSM( 'N', '/', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 ) 00105 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00106 INFOT = 3 00107 CALL STFSM( 'N', 'L', '/', 'T', 'U', 0, 0, ALPHA, A, B, 1 ) 00108 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00109 INFOT = 4 00110 CALL STFSM( 'N', 'L', 'U', '/', 'U', 0, 0, ALPHA, A, B, 1 ) 00111 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00112 INFOT = 5 00113 CALL STFSM( 'N', 'L', 'U', 'T', '/', 0, 0, ALPHA, A, B, 1 ) 00114 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00115 INFOT = 6 00116 CALL STFSM( 'N', 'L', 'U', 'T', 'U', -1, 0, ALPHA, A, B, 1 ) 00117 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00118 INFOT = 7 00119 CALL STFSM( 'N', 'L', 'U', 'T', 'U', 0, -1, ALPHA, A, B, 1 ) 00120 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00121 INFOT = 11 00122 CALL STFSM( 'N', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 0 ) 00123 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 00124 * 00125 SRNAMT = 'STFTRI' 00126 INFOT = 1 00127 CALL STFTRI( '/', 'L', 'N', 0, A, INFO ) 00128 CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK ) 00129 INFOT = 2 00130 CALL STFTRI( 'N', '/', 'N', 0, A, INFO ) 00131 CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK ) 00132 INFOT = 3 00133 CALL STFTRI( 'N', 'L', '/', 0, A, INFO ) 00134 CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK ) 00135 INFOT = 4 00136 CALL STFTRI( 'N', 'L', 'N', -1, A, INFO ) 00137 CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK ) 00138 * 00139 SRNAMT = 'STFTTR' 00140 INFOT = 1 00141 CALL STFTTR( '/', 'U', 0, A, B, 1, INFO ) 00142 CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK ) 00143 INFOT = 2 00144 CALL STFTTR( 'N', '/', 0, A, B, 1, INFO ) 00145 CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK ) 00146 INFOT = 3 00147 CALL STFTTR( 'N', 'U', -1, A, B, 1, INFO ) 00148 CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK ) 00149 INFOT = 6 00150 CALL STFTTR( 'N', 'U', 0, A, B, 0, INFO ) 00151 CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK ) 00152 * 00153 SRNAMT = 'STRTTF' 00154 INFOT = 1 00155 CALL STRTTF( '/', 'U', 0, A, 1, B, INFO ) 00156 CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK ) 00157 INFOT = 2 00158 CALL STRTTF( 'N', '/', 0, A, 1, B, INFO ) 00159 CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK ) 00160 INFOT = 3 00161 CALL STRTTF( 'N', 'U', -1, A, 1, B, INFO ) 00162 CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK ) 00163 INFOT = 5 00164 CALL STRTTF( 'N', 'U', 0, A, 0, B, INFO ) 00165 CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK ) 00166 * 00167 SRNAMT = 'STFTTP' 00168 INFOT = 1 00169 CALL STFTTP( '/', 'U', 0, A, B, INFO ) 00170 CALL CHKXER( 'STFTTP', INFOT, NOUT, LERR, OK ) 00171 INFOT = 2 00172 CALL STFTTP( 'N', '/', 0, A, B, INFO ) 00173 CALL CHKXER( 'STFTTP', INFOT, NOUT, LERR, OK ) 00174 INFOT = 3 00175 CALL STFTTP( 'N', 'U', -1, A, B, INFO ) 00176 CALL CHKXER( 'STFTTP', INFOT, NOUT, LERR, OK ) 00177 * 00178 SRNAMT = 'STPTTF' 00179 INFOT = 1 00180 CALL STPTTF( '/', 'U', 0, A, B, INFO ) 00181 CALL CHKXER( 'STPTTF', INFOT, NOUT, LERR, OK ) 00182 INFOT = 2 00183 CALL STPTTF( 'N', '/', 0, A, B, INFO ) 00184 CALL CHKXER( 'STPTTF', INFOT, NOUT, LERR, OK ) 00185 INFOT = 3 00186 CALL STPTTF( 'N', 'U', -1, A, B, INFO ) 00187 CALL CHKXER( 'STPTTF', INFOT, NOUT, LERR, OK ) 00188 * 00189 SRNAMT = 'STRTTP' 00190 INFOT = 1 00191 CALL STRTTP( '/', 0, A, 1, B, INFO ) 00192 CALL CHKXER( 'STRTTP', INFOT, NOUT, LERR, OK ) 00193 INFOT = 2 00194 CALL STRTTP( 'U', -1, A, 1, B, INFO ) 00195 CALL CHKXER( 'STRTTP', INFOT, NOUT, LERR, OK ) 00196 INFOT = 4 00197 CALL STRTTP( 'U', 0, A, 0, B, INFO ) 00198 CALL CHKXER( 'STRTTP', INFOT, NOUT, LERR, OK ) 00199 * 00200 SRNAMT = 'STPTTR' 00201 INFOT = 1 00202 CALL STPTTR( '/', 0, A, B, 1, INFO ) 00203 CALL CHKXER( 'STPTTR', INFOT, NOUT, LERR, OK ) 00204 INFOT = 2 00205 CALL STPTTR( 'U', -1, A, B, 1, INFO ) 00206 CALL CHKXER( 'STPTTR', INFOT, NOUT, LERR, OK ) 00207 INFOT = 5 00208 CALL STPTTR( 'U', 0, A, B, 0, INFO ) 00209 CALL CHKXER( 'STPTTR', INFOT, NOUT, LERR, OK ) 00210 * 00211 SRNAMT = 'SSFRK ' 00212 INFOT = 1 00213 CALL SSFRK( '/', 'U', 'N', 0, 0, ALPHA, A, 1, BETA, B ) 00214 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 00215 INFOT = 2 00216 CALL SSFRK( 'N', '/', 'N', 0, 0, ALPHA, A, 1, BETA, B ) 00217 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 00218 INFOT = 3 00219 CALL SSFRK( 'N', 'U', '/', 0, 0, ALPHA, A, 1, BETA, B ) 00220 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 00221 INFOT = 4 00222 CALL SSFRK( 'N', 'U', 'N', -1, 0, ALPHA, A, 1, BETA, B ) 00223 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 00224 INFOT = 5 00225 CALL SSFRK( 'N', 'U', 'N', 0, -1, ALPHA, A, 1, BETA, B ) 00226 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 00227 INFOT = 8 00228 CALL SSFRK( 'N', 'U', 'N', 0, 0, ALPHA, A, 0, BETA, B ) 00229 CALL CHKXER( 'SSFRK ', 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, 'REAL 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 SERRRFP 00246 * 00247 END
1.7.3 
