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