1*> \brief \b CERRRFP 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE CERRRFP( NUNIT ) 12* 13* .. Scalar Arguments .. 14* INTEGER NUNIT 15* .. 16* 17* 18*> \par Purpose: 19* ============= 20*> 21*> \verbatim 22*> 23*> CERRRFP tests the error exits for the COMPLEX driver routines 24*> for solving linear systems of equations. 25*> 26*> CDRVRFP tests the COMPLEX LAPACK RFP routines: 27*> CTFSM, CTFTRI, CHFRK, CTFTTP, CTFTTR, CPFTRF, CPFTRS, CTPTTF, 28*> CTPTTR, CTRTTF, and CTRTTP 29*> \endverbatim 30* 31* Arguments: 32* ========== 33* 34*> \param[in] NUNIT 35*> \verbatim 36*> NUNIT is INTEGER 37*> The unit number for output. 38*> \endverbatim 39* 40* Authors: 41* ======== 42* 43*> \author Univ. of Tennessee 44*> \author Univ. of California Berkeley 45*> \author Univ. of Colorado Denver 46*> \author NAG Ltd. 47* 48*> \ingroup complex_lin 49* 50* ===================================================================== 51 SUBROUTINE CERRRFP( NUNIT ) 52* 53* -- LAPACK test routine -- 54* -- LAPACK is a software package provided by Univ. of Tennessee, -- 55* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 56* 57* .. Scalar Arguments .. 58 INTEGER NUNIT 59* .. 60* 61* ===================================================================== 62* 63* .. 64* .. Local Scalars .. 65 INTEGER INFO 66 COMPLEX ALPHA, BETA 67* .. 68* .. Local Arrays .. 69 COMPLEX A( 1, 1), B( 1, 1) 70* .. 71* .. External Subroutines .. 72 EXTERNAL CHKXER, CTFSM, CTFTRI, CHFRK, CTFTTP, CTFTTR, 73 + CPFTRI, CPFTRF, CPFTRS, CTPTTF, CTPTTR, CTRTTF, 74 + CTRTTP 75* .. 76* .. Scalars in Common .. 77 LOGICAL LERR, OK 78 CHARACTER*32 SRNAMT 79 INTEGER INFOT, NOUT 80* .. 81* .. Intrinsic Functions .. 82 INTRINSIC CMPLX 83* .. 84* .. Common blocks .. 85 COMMON / INFOC / INFOT, NOUT, OK, LERR 86 COMMON / SRNAMC / SRNAMT 87* .. 88* .. Executable Statements .. 89* 90 NOUT = NUNIT 91 OK = .TRUE. 92 A( 1, 1 ) = CMPLX( 1.D0 , 1.D0 ) 93 B( 1, 1 ) = CMPLX( 1.D0 , 1.D0 ) 94 ALPHA = CMPLX( 1.D0 , 1.D0 ) 95 BETA = CMPLX( 1.D0 , 1.D0 ) 96* 97 SRNAMT = 'CPFTRF' 98 INFOT = 1 99 CALL CPFTRF( '/', 'U', 0, A, INFO ) 100 CALL CHKXER( 'CPFTRF', INFOT, NOUT, LERR, OK ) 101 INFOT = 2 102 CALL CPFTRF( 'N', '/', 0, A, INFO ) 103 CALL CHKXER( 'CPFTRF', INFOT, NOUT, LERR, OK ) 104 INFOT = 3 105 CALL CPFTRF( 'N', 'U', -1, A, INFO ) 106 CALL CHKXER( 'CPFTRF', INFOT, NOUT, LERR, OK ) 107* 108 SRNAMT = 'CPFTRS' 109 INFOT = 1 110 CALL CPFTRS( '/', 'U', 0, 0, A, B, 1, INFO ) 111 CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK ) 112 INFOT = 2 113 CALL CPFTRS( 'N', '/', 0, 0, A, B, 1, INFO ) 114 CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK ) 115 INFOT = 3 116 CALL CPFTRS( 'N', 'U', -1, 0, A, B, 1, INFO ) 117 CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK ) 118 INFOT = 4 119 CALL CPFTRS( 'N', 'U', 0, -1, A, B, 1, INFO ) 120 CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK ) 121 INFOT = 7 122 CALL CPFTRS( 'N', 'U', 0, 0, A, B, 0, INFO ) 123 CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK ) 124* 125 SRNAMT = 'CPFTRI' 126 INFOT = 1 127 CALL CPFTRI( '/', 'U', 0, A, INFO ) 128 CALL CHKXER( 'CPFTRI', INFOT, NOUT, LERR, OK ) 129 INFOT = 2 130 CALL CPFTRI( 'N', '/', 0, A, INFO ) 131 CALL CHKXER( 'CPFTRI', INFOT, NOUT, LERR, OK ) 132 INFOT = 3 133 CALL CPFTRI( 'N', 'U', -1, A, INFO ) 134 CALL CHKXER( 'CPFTRI', INFOT, NOUT, LERR, OK ) 135* 136 SRNAMT = 'CTFSM ' 137 INFOT = 1 138 CALL CTFSM( '/', 'L', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 1 ) 139 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 140 INFOT = 2 141 CALL CTFSM( 'N', '/', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 1 ) 142 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 143 INFOT = 3 144 CALL CTFSM( 'N', 'L', '/', 'C', 'U', 0, 0, ALPHA, A, B, 1 ) 145 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 146 INFOT = 4 147 CALL CTFSM( 'N', 'L', 'U', '/', 'U', 0, 0, ALPHA, A, B, 1 ) 148 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 149 INFOT = 5 150 CALL CTFSM( 'N', 'L', 'U', 'C', '/', 0, 0, ALPHA, A, B, 1 ) 151 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 152 INFOT = 6 153 CALL CTFSM( 'N', 'L', 'U', 'C', 'U', -1, 0, ALPHA, A, B, 1 ) 154 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 155 INFOT = 7 156 CALL CTFSM( 'N', 'L', 'U', 'C', 'U', 0, -1, ALPHA, A, B, 1 ) 157 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 158 INFOT = 11 159 CALL CTFSM( 'N', 'L', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 0 ) 160 CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK ) 161* 162 SRNAMT = 'CTFTRI' 163 INFOT = 1 164 CALL CTFTRI( '/', 'L', 'N', 0, A, INFO ) 165 CALL CHKXER( 'CTFTRI', INFOT, NOUT, LERR, OK ) 166 INFOT = 2 167 CALL CTFTRI( 'N', '/', 'N', 0, A, INFO ) 168 CALL CHKXER( 'CTFTRI', INFOT, NOUT, LERR, OK ) 169 INFOT = 3 170 CALL CTFTRI( 'N', 'L', '/', 0, A, INFO ) 171 CALL CHKXER( 'CTFTRI', INFOT, NOUT, LERR, OK ) 172 INFOT = 4 173 CALL CTFTRI( 'N', 'L', 'N', -1, A, INFO ) 174 CALL CHKXER( 'CTFTRI', INFOT, NOUT, LERR, OK ) 175* 176 SRNAMT = 'CTFTTR' 177 INFOT = 1 178 CALL CTFTTR( '/', 'U', 0, A, B, 1, INFO ) 179 CALL CHKXER( 'CTFTTR', INFOT, NOUT, LERR, OK ) 180 INFOT = 2 181 CALL CTFTTR( 'N', '/', 0, A, B, 1, INFO ) 182 CALL CHKXER( 'CTFTTR', INFOT, NOUT, LERR, OK ) 183 INFOT = 3 184 CALL CTFTTR( 'N', 'U', -1, A, B, 1, INFO ) 185 CALL CHKXER( 'CTFTTR', INFOT, NOUT, LERR, OK ) 186 INFOT = 6 187 CALL CTFTTR( 'N', 'U', 0, A, B, 0, INFO ) 188 CALL CHKXER( 'CTFTTR', INFOT, NOUT, LERR, OK ) 189* 190 SRNAMT = 'CTRTTF' 191 INFOT = 1 192 CALL CTRTTF( '/', 'U', 0, A, 1, B, INFO ) 193 CALL CHKXER( 'CTRTTF', INFOT, NOUT, LERR, OK ) 194 INFOT = 2 195 CALL CTRTTF( 'N', '/', 0, A, 1, B, INFO ) 196 CALL CHKXER( 'CTRTTF', INFOT, NOUT, LERR, OK ) 197 INFOT = 3 198 CALL CTRTTF( 'N', 'U', -1, A, 1, B, INFO ) 199 CALL CHKXER( 'CTRTTF', INFOT, NOUT, LERR, OK ) 200 INFOT = 5 201 CALL CTRTTF( 'N', 'U', 0, A, 0, B, INFO ) 202 CALL CHKXER( 'CTRTTF', INFOT, NOUT, LERR, OK ) 203* 204 SRNAMT = 'CTFTTP' 205 INFOT = 1 206 CALL CTFTTP( '/', 'U', 0, A, B, INFO ) 207 CALL CHKXER( 'CTFTTP', INFOT, NOUT, LERR, OK ) 208 INFOT = 2 209 CALL CTFTTP( 'N', '/', 0, A, B, INFO ) 210 CALL CHKXER( 'CTFTTP', INFOT, NOUT, LERR, OK ) 211 INFOT = 3 212 CALL CTFTTP( 'N', 'U', -1, A, B, INFO ) 213 CALL CHKXER( 'CTFTTP', INFOT, NOUT, LERR, OK ) 214* 215 SRNAMT = 'CTPTTF' 216 INFOT = 1 217 CALL CTPTTF( '/', 'U', 0, A, B, INFO ) 218 CALL CHKXER( 'CTPTTF', INFOT, NOUT, LERR, OK ) 219 INFOT = 2 220 CALL CTPTTF( 'N', '/', 0, A, B, INFO ) 221 CALL CHKXER( 'CTPTTF', INFOT, NOUT, LERR, OK ) 222 INFOT = 3 223 CALL CTPTTF( 'N', 'U', -1, A, B, INFO ) 224 CALL CHKXER( 'CTPTTF', INFOT, NOUT, LERR, OK ) 225* 226 SRNAMT = 'CTRTTP' 227 INFOT = 1 228 CALL CTRTTP( '/', 0, A, 1, B, INFO ) 229 CALL CHKXER( 'CTRTTP', INFOT, NOUT, LERR, OK ) 230 INFOT = 2 231 CALL CTRTTP( 'U', -1, A, 1, B, INFO ) 232 CALL CHKXER( 'CTRTTP', INFOT, NOUT, LERR, OK ) 233 INFOT = 4 234 CALL CTRTTP( 'U', 0, A, 0, B, INFO ) 235 CALL CHKXER( 'CTRTTP', INFOT, NOUT, LERR, OK ) 236* 237 SRNAMT = 'CTPTTR' 238 INFOT = 1 239 CALL CTPTTR( '/', 0, A, B, 1, INFO ) 240 CALL CHKXER( 'CTPTTR', INFOT, NOUT, LERR, OK ) 241 INFOT = 2 242 CALL CTPTTR( 'U', -1, A, B, 1, INFO ) 243 CALL CHKXER( 'CTPTTR', INFOT, NOUT, LERR, OK ) 244 INFOT = 5 245 CALL CTPTTR( 'U', 0, A, B, 0, INFO ) 246 CALL CHKXER( 'CTPTTR', INFOT, NOUT, LERR, OK ) 247* 248 SRNAMT = 'CHFRK ' 249 INFOT = 1 250 CALL CHFRK( '/', 'U', 'N', 0, 0, ALPHA, A, 1, BETA, B ) 251 CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK ) 252 INFOT = 2 253 CALL CHFRK( 'N', '/', 'N', 0, 0, ALPHA, A, 1, BETA, B ) 254 CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK ) 255 INFOT = 3 256 CALL CHFRK( 'N', 'U', '/', 0, 0, ALPHA, A, 1, BETA, B ) 257 CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK ) 258 INFOT = 4 259 CALL CHFRK( 'N', 'U', 'N', -1, 0, ALPHA, A, 1, BETA, B ) 260 CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK ) 261 INFOT = 5 262 CALL CHFRK( 'N', 'U', 'N', 0, -1, ALPHA, A, 1, BETA, B ) 263 CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK ) 264 INFOT = 8 265 CALL CHFRK( 'N', 'U', 'N', 0, 0, ALPHA, A, 0, BETA, B ) 266 CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK ) 267* 268* Print a summary line. 269* 270 IF( OK ) THEN 271 WRITE( NOUT, FMT = 9999 ) 272 ELSE 273 WRITE( NOUT, FMT = 9998 ) 274 END IF 275* 276 9999 FORMAT( 1X, 'COMPLEX RFP routines passed the tests of the ', 277 $ 'error exits' ) 278 9998 FORMAT( ' *** RFP routines failed the tests of the error ', 279 $ 'exits ***' ) 280 RETURN 281* 282* End of CERRRFP 283* 284 END 285