![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CERRRFP 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 CERRRFP( NUNIT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER NUNIT 00015 * .. 00016 * 00017 * 00018 *> \par Purpose: 00019 * ============= 00020 *> 00021 *> \verbatim 00022 *> 00023 *> CERRRFP tests the error exits for the COMPLEX driver routines 00024 *> for solving linear systems of equations. 00025 *> 00026 *> CDRVRFP tests the COMPLEX LAPACK RFP routines: 00027 *> CTFSM, CTFTRI, CHFRK, CTFTTP, CTFTTR, CPFTRF, CPFTRS, CTPTTF, 00028 *> CTPTTR, CTRTTF, and CTRTTP 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 complex_lin 00051 * 00052 * ===================================================================== 00053 SUBROUTINE CERRRFP( 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 COMPLEX ALPHA, BETA 00070 * .. 00071 * .. Local Arrays .. 00072 COMPLEX A( 1, 1), B( 1, 1) 00073 * .. 00074 * .. External Subroutines .. 00075 EXTERNAL CHKXER, CTFSM, CTFTRI, CHFRK, CTFTTP, CTFTTR, 00076 + CPFTRI, CPFTRF, CPFTRS, CTPTTF, CTPTTR, CTRTTF, 00077 + CTRTTP 00078 * .. 00079 * .. Scalars in Common .. 00080 LOGICAL LERR, OK 00081 CHARACTER*32 SRNAMT 00082 INTEGER INFOT, NOUT 00083 * .. 00084 * .. Intrinsic Functions .. 00085 INTRINSIC CMPLX 00086 * .. 00087 * .. Common blocks .. 00088 COMMON / INFOC / INFOT, NOUT, OK, LERR 00089 COMMON / SRNAMC / SRNAMT 00090 * .. 00091 * .. Executable Statements .. 00092 * 00093 NOUT = NUNIT 00094 OK = .TRUE. 00095 A( 1, 1 ) = CMPLX( 1.D0 , 1.D0 ) 00096 B( 1, 1 ) = CMPLX( 1.D0 , 1.D0 ) 00097 ALPHA = CMPLX( 1.D0 , 1.D0 ) 00098 BETA = CMPLX( 1.D0 , 1.D0 ) 00099 * 00100 SRNAMT = 'CPFTRF' 00101 INFOT = 1 00102 CALL CPFTRF( '/', 'U', 0, A, INFO ) 00103 CALL CHKXER( 'CPFTRF', INFOT, NOUT, LERR, OK ) 00104 INFOT = 2 00105 CALL CPFTRF( 'N', '/', 0, A, INFO ) 00106 CALL CHKXER( 'CPFTRF', INFOT, NOUT, LERR, OK ) 00107 INFOT = 3 00108 CALL CPFTRF( 'N', 'U', -1, A, INFO ) 00109 CALL CHKXER( 'CPFTRF', INFOT, NOUT, LERR, OK ) 00110 * 00111 SRNAMT = 'CPFTRS' 00112 INFOT = 1 00113 CALL CPFTRS( '/', 'U', 0, 0, A, B, 1, INFO ) 00114 CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK ) 00115 INFOT = 2 00116 CALL CPFTRS( 'N', '/', 0, 0, A, B, 1, INFO ) 00117 CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK ) 00118 INFOT = 3 00119 CALL CPFTRS( 'N', 'U', -1, 0, A, B, 1, INFO ) 00120 CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK ) 00121 INFOT = 4 00122 CALL CPFTRS( 'N', 'U', 0, -1, A, B, 1, INFO ) 00123 CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK ) 00124 INFOT = 7 00125 CALL CPFTRS( 'N', 'U', 0, 0, A, B, 0, INFO ) 00126 CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK ) 00127 * 00128 SRNAMT = 'CPFTRI' 00129 INFOT = 1 00130 CALL CPFTRI( '/', 'U', 0, A, INFO ) 00131 CALL CHKXER( 'CPFTRI', INFOT, NOUT, LERR, OK ) 00132 INFOT = 2 00133 CALL CPFTRI( 'N', '/', 0, A, INFO ) 00134 CALL CHKXER( 'CPFTRI', INFOT, NOUT, LERR, OK ) 00135 INFOT = 3 00136 CALL CPFTRI( 'N', 'U', -1, A, INFO ) 00137 CALL CHKXER( 'CPFTRI', INFOT, NOUT, LERR, OK ) 00138 * 00139 SRNAMT = 'CTFSM ' 00140 INFOT = 1 00141 CALL CTFSM( '/', 'L', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 1 ) 00142 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 00143 INFOT = 2 00144 CALL CTFSM( 'N', '/', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 1 ) 00145 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 00146 INFOT = 3 00147 CALL CTFSM( 'N', 'L', '/', 'C', 'U', 0, 0, ALPHA, A, B, 1 ) 00148 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 00149 INFOT = 4 00150 CALL CTFSM( 'N', 'L', 'U', '/', 'U', 0, 0, ALPHA, A, B, 1 ) 00151 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 00152 INFOT = 5 00153 CALL CTFSM( 'N', 'L', 'U', 'C', '/', 0, 0, ALPHA, A, B, 1 ) 00154 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 00155 INFOT = 6 00156 CALL CTFSM( 'N', 'L', 'U', 'C', 'U', -1, 0, ALPHA, A, B, 1 ) 00157 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 00158 INFOT = 7 00159 CALL CTFSM( 'N', 'L', 'U', 'C', 'U', 0, -1, ALPHA, A, B, 1 ) 00160 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 00161 INFOT = 11 00162 CALL CTFSM( 'N', 'L', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 0 ) 00163 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 00164 * 00165 SRNAMT = 'CTFTRI' 00166 INFOT = 1 00167 CALL CTFTRI( '/', 'L', 'N', 0, A, INFO ) 00168 CALL CHKXER( 'CTFTRI', INFOT, NOUT, LERR, OK ) 00169 INFOT = 2 00170 CALL CTFTRI( 'N', '/', 'N', 0, A, INFO ) 00171 CALL CHKXER( 'CTFTRI', INFOT, NOUT, LERR, OK ) 00172 INFOT = 3 00173 CALL CTFTRI( 'N', 'L', '/', 0, A, INFO ) 00174 CALL CHKXER( 'CTFTRI', INFOT, NOUT, LERR, OK ) 00175 INFOT = 4 00176 CALL CTFTRI( 'N', 'L', 'N', -1, A, INFO ) 00177 CALL CHKXER( 'CTFTRI', INFOT, NOUT, LERR, OK ) 00178 * 00179 SRNAMT = 'CTFTTR' 00180 INFOT = 1 00181 CALL CTFTTR( '/', 'U', 0, A, B, 1, INFO ) 00182 CALL CHKXER( 'CTFTTR', INFOT, NOUT, LERR, OK ) 00183 INFOT = 2 00184 CALL CTFTTR( 'N', '/', 0, A, B, 1, INFO ) 00185 CALL CHKXER( 'CTFTTR', INFOT, NOUT, LERR, OK ) 00186 INFOT = 3 00187 CALL CTFTTR( 'N', 'U', -1, A, B, 1, INFO ) 00188 CALL CHKXER( 'CTFTTR', INFOT, NOUT, LERR, OK ) 00189 INFOT = 6 00190 CALL CTFTTR( 'N', 'U', 0, A, B, 0, INFO ) 00191 CALL CHKXER( 'CTFTTR', INFOT, NOUT, LERR, OK ) 00192 * 00193 SRNAMT = 'CTRTTF' 00194 INFOT = 1 00195 CALL CTRTTF( '/', 'U', 0, A, 1, B, INFO ) 00196 CALL CHKXER( 'CTRTTF', INFOT, NOUT, LERR, OK ) 00197 INFOT = 2 00198 CALL CTRTTF( 'N', '/', 0, A, 1, B, INFO ) 00199 CALL CHKXER( 'CTRTTF', INFOT, NOUT, LERR, OK ) 00200 INFOT = 3 00201 CALL CTRTTF( 'N', 'U', -1, A, 1, B, INFO ) 00202 CALL CHKXER( 'CTRTTF', INFOT, NOUT, LERR, OK ) 00203 INFOT = 5 00204 CALL CTRTTF( 'N', 'U', 0, A, 0, B, INFO ) 00205 CALL CHKXER( 'CTRTTF', INFOT, NOUT, LERR, OK ) 00206 * 00207 SRNAMT = 'CTFTTP' 00208 INFOT = 1 00209 CALL CTFTTP( '/', 'U', 0, A, B, INFO ) 00210 CALL CHKXER( 'CTFTTP', INFOT, NOUT, LERR, OK ) 00211 INFOT = 2 00212 CALL CTFTTP( 'N', '/', 0, A, B, INFO ) 00213 CALL CHKXER( 'CTFTTP', INFOT, NOUT, LERR, OK ) 00214 INFOT = 3 00215 CALL CTFTTP( 'N', 'U', -1, A, B, INFO ) 00216 CALL CHKXER( 'CTFTTP', INFOT, NOUT, LERR, OK ) 00217 * 00218 SRNAMT = 'CTPTTF' 00219 INFOT = 1 00220 CALL CTPTTF( '/', 'U', 0, A, B, INFO ) 00221 CALL CHKXER( 'CTPTTF', INFOT, NOUT, LERR, OK ) 00222 INFOT = 2 00223 CALL CTPTTF( 'N', '/', 0, A, B, INFO ) 00224 CALL CHKXER( 'CTPTTF', INFOT, NOUT, LERR, OK ) 00225 INFOT = 3 00226 CALL CTPTTF( 'N', 'U', -1, A, B, INFO ) 00227 CALL CHKXER( 'CTPTTF', INFOT, NOUT, LERR, OK ) 00228 * 00229 SRNAMT = 'CTRTTP' 00230 INFOT = 1 00231 CALL CTRTTP( '/', 0, A, 1, B, INFO ) 00232 CALL CHKXER( 'CTRTTP', INFOT, NOUT, LERR, OK ) 00233 INFOT = 2 00234 CALL CTRTTP( 'U', -1, A, 1, B, INFO ) 00235 CALL CHKXER( 'CTRTTP', INFOT, NOUT, LERR, OK ) 00236 INFOT = 4 00237 CALL CTRTTP( 'U', 0, A, 0, B, INFO ) 00238 CALL CHKXER( 'CTRTTP', INFOT, NOUT, LERR, OK ) 00239 * 00240 SRNAMT = 'CTPTTR' 00241 INFOT = 1 00242 CALL CTPTTR( '/', 0, A, B, 1, INFO ) 00243 CALL CHKXER( 'CTPTTR', INFOT, NOUT, LERR, OK ) 00244 INFOT = 2 00245 CALL CTPTTR( 'U', -1, A, B, 1, INFO ) 00246 CALL CHKXER( 'CTPTTR', INFOT, NOUT, LERR, OK ) 00247 INFOT = 5 00248 CALL CTPTTR( 'U', 0, A, B, 0, INFO ) 00249 CALL CHKXER( 'CTPTTR', INFOT, NOUT, LERR, OK ) 00250 * 00251 SRNAMT = 'CHFRK ' 00252 INFOT = 1 00253 CALL CHFRK( '/', 'U', 'N', 0, 0, ALPHA, A, 1, BETA, B ) 00254 CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK ) 00255 INFOT = 2 00256 CALL CHFRK( 'N', '/', 'N', 0, 0, ALPHA, A, 1, BETA, B ) 00257 CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK ) 00258 INFOT = 3 00259 CALL CHFRK( 'N', 'U', '/', 0, 0, ALPHA, A, 1, BETA, B ) 00260 CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK ) 00261 INFOT = 4 00262 CALL CHFRK( 'N', 'U', 'N', -1, 0, ALPHA, A, 1, BETA, B ) 00263 CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK ) 00264 INFOT = 5 00265 CALL CHFRK( 'N', 'U', 'N', 0, -1, ALPHA, A, 1, BETA, B ) 00266 CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK ) 00267 INFOT = 8 00268 CALL CHFRK( 'N', 'U', 'N', 0, 0, ALPHA, A, 0, BETA, B ) 00269 CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK ) 00270 * 00271 * Print a summary line. 00272 * 00273 IF( OK ) THEN 00274 WRITE( NOUT, FMT = 9999 ) 00275 ELSE 00276 WRITE( NOUT, FMT = 9998 ) 00277 END IF 00278 * 00279 9999 FORMAT( 1X, 'COMPLEX RFP routines passed the tests of the ', 00280 $ 'error exits' ) 00281 9998 FORMAT( ' *** RFP routines failed the tests of the error ', 00282 $ 'exits ***' ) 00283 RETURN 00284 * 00285 * End of CERRRFP 00286 * 00287 END