1*> \brief \b SERRRFP 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 SERRRFP( NUNIT ) 12* 13* .. Scalar Arguments .. 14* INTEGER NUNIT 15* .. 16* 17* 18*> \par Purpose: 19* ============= 20*> 21*> \verbatim 22*> 23*> SERRRFP tests the error exits for the REAL driver routines 24*> for solving linear systems of equations. 25*> 26*> SDRVRFP tests the REAL LAPACK RFP routines: 27*> STFSM, STFTRI, SSFRK, STFTTP, STFTTR, SPFTRF, SPFTRS, STPTTF, 28*> STPTTR, STRTTF, and STRTTP 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*> \date December 2016 49* 50*> \ingroup single_lin 51* 52* ===================================================================== 53 SUBROUTINE SERRRFP( NUNIT ) 54* 55* -- LAPACK test routine (version 3.7.0) -- 56* -- LAPACK is a software package provided by Univ. of Tennessee, -- 57* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 58* December 2016 59* 60* .. Scalar Arguments .. 61 INTEGER NUNIT 62* .. 63* 64* ===================================================================== 65* 66* .. 67* .. Local Scalars .. 68 INTEGER INFO 69 REAL ALPHA, BETA 70* .. 71* .. Local Arrays .. 72 REAL A( 1, 1), B( 1, 1) 73* .. 74* .. External Subroutines .. 75 EXTERNAL CHKXER, STFSM, STFTRI, SSFRK, STFTTP, STFTTR, 76 + SPFTRI, SPFTRF, SPFTRS, STPTTF, STPTTR, STRTTF, 77 + STRTTP 78* .. 79* .. Scalars in Common .. 80 LOGICAL LERR, OK 81 CHARACTER*32 SRNAMT 82 INTEGER INFOT, NOUT 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 ) = 1.0E+0 93 B( 1, 1 ) = 1.0E+0 94 ALPHA = 1.0E+0 95 BETA = 1.0E+0 96* 97 SRNAMT = 'SPFTRF' 98 INFOT = 1 99 CALL SPFTRF( '/', 'U', 0, A, INFO ) 100 CALL CHKXER( 'SPFTRF', INFOT, NOUT, LERR, OK ) 101 INFOT = 2 102 CALL SPFTRF( 'N', '/', 0, A, INFO ) 103 CALL CHKXER( 'SPFTRF', INFOT, NOUT, LERR, OK ) 104 INFOT = 3 105 CALL SPFTRF( 'N', 'U', -1, A, INFO ) 106 CALL CHKXER( 'SPFTRF', INFOT, NOUT, LERR, OK ) 107* 108 SRNAMT = 'SPFTRS' 109 INFOT = 1 110 CALL SPFTRS( '/', 'U', 0, 0, A, B, 1, INFO ) 111 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 112 INFOT = 2 113 CALL SPFTRS( 'N', '/', 0, 0, A, B, 1, INFO ) 114 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 115 INFOT = 3 116 CALL SPFTRS( 'N', 'U', -1, 0, A, B, 1, INFO ) 117 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 118 INFOT = 4 119 CALL SPFTRS( 'N', 'U', 0, -1, A, B, 1, INFO ) 120 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 121 INFOT = 7 122 CALL SPFTRS( 'N', 'U', 0, 0, A, B, 0, INFO ) 123 CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK ) 124* 125 SRNAMT = 'SPFTRI' 126 INFOT = 1 127 CALL SPFTRI( '/', 'U', 0, A, INFO ) 128 CALL CHKXER( 'SPFTRI', INFOT, NOUT, LERR, OK ) 129 INFOT = 2 130 CALL SPFTRI( 'N', '/', 0, A, INFO ) 131 CALL CHKXER( 'SPFTRI', INFOT, NOUT, LERR, OK ) 132 INFOT = 3 133 CALL SPFTRI( 'N', 'U', -1, A, INFO ) 134 CALL CHKXER( 'SPFTRI', INFOT, NOUT, LERR, OK ) 135* 136 SRNAMT = 'STFSM ' 137 INFOT = 1 138 CALL STFSM( '/', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 ) 139 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 140 INFOT = 2 141 CALL STFSM( 'N', '/', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 ) 142 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 143 INFOT = 3 144 CALL STFSM( 'N', 'L', '/', 'T', 'U', 0, 0, ALPHA, A, B, 1 ) 145 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 146 INFOT = 4 147 CALL STFSM( 'N', 'L', 'U', '/', 'U', 0, 0, ALPHA, A, B, 1 ) 148 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 149 INFOT = 5 150 CALL STFSM( 'N', 'L', 'U', 'T', '/', 0, 0, ALPHA, A, B, 1 ) 151 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 152 INFOT = 6 153 CALL STFSM( 'N', 'L', 'U', 'T', 'U', -1, 0, ALPHA, A, B, 1 ) 154 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 155 INFOT = 7 156 CALL STFSM( 'N', 'L', 'U', 'T', 'U', 0, -1, ALPHA, A, B, 1 ) 157 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 158 INFOT = 11 159 CALL STFSM( 'N', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 0 ) 160 CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK ) 161* 162 SRNAMT = 'STFTRI' 163 INFOT = 1 164 CALL STFTRI( '/', 'L', 'N', 0, A, INFO ) 165 CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK ) 166 INFOT = 2 167 CALL STFTRI( 'N', '/', 'N', 0, A, INFO ) 168 CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK ) 169 INFOT = 3 170 CALL STFTRI( 'N', 'L', '/', 0, A, INFO ) 171 CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK ) 172 INFOT = 4 173 CALL STFTRI( 'N', 'L', 'N', -1, A, INFO ) 174 CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK ) 175* 176 SRNAMT = 'STFTTR' 177 INFOT = 1 178 CALL STFTTR( '/', 'U', 0, A, B, 1, INFO ) 179 CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK ) 180 INFOT = 2 181 CALL STFTTR( 'N', '/', 0, A, B, 1, INFO ) 182 CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK ) 183 INFOT = 3 184 CALL STFTTR( 'N', 'U', -1, A, B, 1, INFO ) 185 CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK ) 186 INFOT = 6 187 CALL STFTTR( 'N', 'U', 0, A, B, 0, INFO ) 188 CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK ) 189* 190 SRNAMT = 'STRTTF' 191 INFOT = 1 192 CALL STRTTF( '/', 'U', 0, A, 1, B, INFO ) 193 CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK ) 194 INFOT = 2 195 CALL STRTTF( 'N', '/', 0, A, 1, B, INFO ) 196 CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK ) 197 INFOT = 3 198 CALL STRTTF( 'N', 'U', -1, A, 1, B, INFO ) 199 CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK ) 200 INFOT = 5 201 CALL STRTTF( 'N', 'U', 0, A, 0, B, INFO ) 202 CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK ) 203* 204 SRNAMT = 'STFTTP' 205 INFOT = 1 206 CALL STFTTP( '/', 'U', 0, A, B, INFO ) 207 CALL CHKXER( 'STFTTP', INFOT, NOUT, LERR, OK ) 208 INFOT = 2 209 CALL STFTTP( 'N', '/', 0, A, B, INFO ) 210 CALL CHKXER( 'STFTTP', INFOT, NOUT, LERR, OK ) 211 INFOT = 3 212 CALL STFTTP( 'N', 'U', -1, A, B, INFO ) 213 CALL CHKXER( 'STFTTP', INFOT, NOUT, LERR, OK ) 214* 215 SRNAMT = 'STPTTF' 216 INFOT = 1 217 CALL STPTTF( '/', 'U', 0, A, B, INFO ) 218 CALL CHKXER( 'STPTTF', INFOT, NOUT, LERR, OK ) 219 INFOT = 2 220 CALL STPTTF( 'N', '/', 0, A, B, INFO ) 221 CALL CHKXER( 'STPTTF', INFOT, NOUT, LERR, OK ) 222 INFOT = 3 223 CALL STPTTF( 'N', 'U', -1, A, B, INFO ) 224 CALL CHKXER( 'STPTTF', INFOT, NOUT, LERR, OK ) 225* 226 SRNAMT = 'STRTTP' 227 INFOT = 1 228 CALL STRTTP( '/', 0, A, 1, B, INFO ) 229 CALL CHKXER( 'STRTTP', INFOT, NOUT, LERR, OK ) 230 INFOT = 2 231 CALL STRTTP( 'U', -1, A, 1, B, INFO ) 232 CALL CHKXER( 'STRTTP', INFOT, NOUT, LERR, OK ) 233 INFOT = 4 234 CALL STRTTP( 'U', 0, A, 0, B, INFO ) 235 CALL CHKXER( 'STRTTP', INFOT, NOUT, LERR, OK ) 236* 237 SRNAMT = 'STPTTR' 238 INFOT = 1 239 CALL STPTTR( '/', 0, A, B, 1, INFO ) 240 CALL CHKXER( 'STPTTR', INFOT, NOUT, LERR, OK ) 241 INFOT = 2 242 CALL STPTTR( 'U', -1, A, B, 1, INFO ) 243 CALL CHKXER( 'STPTTR', INFOT, NOUT, LERR, OK ) 244 INFOT = 5 245 CALL STPTTR( 'U', 0, A, B, 0, INFO ) 246 CALL CHKXER( 'STPTTR', INFOT, NOUT, LERR, OK ) 247* 248 SRNAMT = 'SSFRK ' 249 INFOT = 1 250 CALL SSFRK( '/', 'U', 'N', 0, 0, ALPHA, A, 1, BETA, B ) 251 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 252 INFOT = 2 253 CALL SSFRK( 'N', '/', 'N', 0, 0, ALPHA, A, 1, BETA, B ) 254 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 255 INFOT = 3 256 CALL SSFRK( 'N', 'U', '/', 0, 0, ALPHA, A, 1, BETA, B ) 257 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 258 INFOT = 4 259 CALL SSFRK( 'N', 'U', 'N', -1, 0, ALPHA, A, 1, BETA, B ) 260 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 261 INFOT = 5 262 CALL SSFRK( 'N', 'U', 'N', 0, -1, ALPHA, A, 1, BETA, B ) 263 CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK ) 264 INFOT = 8 265 CALL SSFRK( 'N', 'U', 'N', 0, 0, ALPHA, A, 0, BETA, B ) 266 CALL CHKXER( 'SSFRK ', 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, 'REAL RFP routines passed the tests of ', 277 $ 'the error exits' ) 278 9998 FORMAT( ' *** RFP routines failed the tests of the error ', 279 $ 'exits ***' ) 280 RETURN 281* 282* End of SERRRFP 283* 284 END 285