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