1*> \brief \b ZERRHE 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 ZERRHE( PATH, NUNIT ) 12* 13* .. Scalar Arguments .. 14* CHARACTER*3 PATH 15* INTEGER NUNIT 16* .. 17* 18* 19*> \par Purpose: 20* ============= 21*> 22*> \verbatim 23*> 24*> ZERRHE tests the error exits for the COMPLEX*16 routines 25*> for Hermitian indefinite matrices. 26*> \endverbatim 27* 28* Arguments: 29* ========== 30* 31*> \param[in] PATH 32*> \verbatim 33*> PATH is CHARACTER*3 34*> The LAPACK path name for the routines to be tested. 35*> \endverbatim 36*> 37*> \param[in] NUNIT 38*> \verbatim 39*> NUNIT is INTEGER 40*> The unit number for output. 41*> \endverbatim 42* 43* Authors: 44* ======== 45* 46*> \author Univ. of Tennessee 47*> \author Univ. of California Berkeley 48*> \author Univ. of Colorado Denver 49*> \author NAG Ltd. 50* 51*> \date November 2011 52* 53*> \ingroup complex16_lin 54* 55* ===================================================================== 56 SUBROUTINE ZERRHE( PATH, NUNIT ) 57* 58* -- LAPACK test routine (version 3.4.0) -- 59* -- LAPACK is a software package provided by Univ. of Tennessee, -- 60* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 61* November 2011 62* 63* .. Scalar Arguments .. 64 CHARACTER*3 PATH 65 INTEGER NUNIT 66* .. 67* 68* ===================================================================== 69* 70* 71* .. Parameters .. 72 INTEGER NMAX 73 PARAMETER ( NMAX = 4 ) 74* .. 75* .. Local Scalars .. 76 CHARACTER*2 C2 77 INTEGER I, INFO, J 78 DOUBLE PRECISION ANRM, RCOND 79* .. 80* .. Local Arrays .. 81 INTEGER IP( NMAX ) 82 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ) 83 COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 84 $ W( 2*NMAX ), X( NMAX ) 85* .. 86* .. External Functions .. 87 LOGICAL LSAMEN 88 EXTERNAL LSAMEN 89* .. 90* .. External Subroutines .. 91 EXTERNAL ALAESM, CHKXER, ZHECON, ZHERFS, ZHETF2, ZHETRF, 92 $ ZHETRI, ZHETRI2, ZHETRS, ZHPCON, ZHPRFS, 93 $ ZHPTRF, ZHPTRI, ZHPTRS 94* .. 95* .. Scalars in Common .. 96 LOGICAL LERR, OK 97 CHARACTER*32 SRNAMT 98 INTEGER INFOT, NOUT 99* .. 100* .. Common blocks .. 101 COMMON / INFOC / INFOT, NOUT, OK, LERR 102 COMMON / SRNAMC / SRNAMT 103* .. 104* .. Intrinsic Functions .. 105 INTRINSIC DBLE, DCMPLX 106* .. 107* .. Executable Statements .. 108* 109 NOUT = NUNIT 110 WRITE( NOUT, FMT = * ) 111 C2 = PATH( 2: 3 ) 112* 113* Set the variables to innocuous values. 114* 115 DO 20 J = 1, NMAX 116 DO 10 I = 1, NMAX 117 A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 118 $ -1.D0 / DBLE( I+J ) ) 119 AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 120 $ -1.D0 / DBLE( I+J ) ) 121 10 CONTINUE 122 B( J ) = 0.D0 123 R1( J ) = 0.D0 124 R2( J ) = 0.D0 125 W( J ) = 0.D0 126 X( J ) = 0.D0 127 IP( J ) = J 128 20 CONTINUE 129 ANRM = 1.0D0 130 OK = .TRUE. 131* 132* Test error exits of the routines that use the diagonal pivoting 133* factorization of a Hermitian indefinite matrix. 134* 135 IF( LSAMEN( 2, C2, 'HE' ) ) THEN 136* 137* ZHETRF 138* 139 SRNAMT = 'ZHETRF' 140 INFOT = 1 141 CALL ZHETRF( '/', 0, A, 1, IP, W, 1, INFO ) 142 CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK ) 143 INFOT = 2 144 CALL ZHETRF( 'U', -1, A, 1, IP, W, 1, INFO ) 145 CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK ) 146 INFOT = 4 147 CALL ZHETRF( 'U', 2, A, 1, IP, W, 4, INFO ) 148 CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK ) 149* 150* ZHETF2 151* 152 SRNAMT = 'ZHETF2' 153 INFOT = 1 154 CALL ZHETF2( '/', 0, A, 1, IP, INFO ) 155 CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK ) 156 INFOT = 2 157 CALL ZHETF2( 'U', -1, A, 1, IP, INFO ) 158 CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK ) 159 INFOT = 4 160 CALL ZHETF2( 'U', 2, A, 1, IP, INFO ) 161 CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK ) 162* 163* ZHETRI 164* 165 SRNAMT = 'ZHETRI' 166 INFOT = 1 167 CALL ZHETRI( '/', 0, A, 1, IP, W, INFO ) 168 CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK ) 169 INFOT = 2 170 CALL ZHETRI( 'U', -1, A, 1, IP, W, INFO ) 171 CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK ) 172 INFOT = 4 173 CALL ZHETRI( 'U', 2, A, 1, IP, W, INFO ) 174 CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK ) 175* 176* ZHETRI2 177* 178 SRNAMT = 'ZHETRI2' 179 INFOT = 1 180 CALL ZHETRI2( '/', 0, A, 1, IP, W, 1, INFO ) 181 CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK ) 182 INFOT = 2 183 CALL ZHETRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 184 CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK ) 185 INFOT = 4 186 CALL ZHETRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 187 CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK ) 188* 189* ZHETRS 190* 191 SRNAMT = 'ZHETRS' 192 INFOT = 1 193 CALL ZHETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 194 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 195 INFOT = 2 196 CALL ZHETRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 197 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 198 INFOT = 3 199 CALL ZHETRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 200 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 201 INFOT = 5 202 CALL ZHETRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 203 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 204 INFOT = 8 205 CALL ZHETRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 206 CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK ) 207* 208* ZHERFS 209* 210 SRNAMT = 'ZHERFS' 211 INFOT = 1 212 CALL ZHERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 213 $ R, INFO ) 214 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 215 INFOT = 2 216 CALL ZHERFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 217 $ W, R, INFO ) 218 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 219 INFOT = 3 220 CALL ZHERFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 221 $ W, R, INFO ) 222 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 223 INFOT = 5 224 CALL ZHERFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 225 $ R, INFO ) 226 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 227 INFOT = 7 228 CALL ZHERFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 229 $ R, INFO ) 230 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 231 INFOT = 10 232 CALL ZHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 233 $ R, INFO ) 234 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 235 INFOT = 12 236 CALL ZHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 237 $ R, INFO ) 238 CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK ) 239* 240* ZHECON 241* 242 SRNAMT = 'ZHECON' 243 INFOT = 1 244 CALL ZHECON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 245 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 246 INFOT = 2 247 CALL ZHECON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 248 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 249 INFOT = 4 250 CALL ZHECON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 251 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 252 INFOT = 6 253 CALL ZHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 254 CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK ) 255* 256* Test error exits of the routines that use the diagonal pivoting 257* factorization of a Hermitian indefinite packed matrix. 258* 259 ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN 260* 261* ZHPTRF 262* 263 SRNAMT = 'ZHPTRF' 264 INFOT = 1 265 CALL ZHPTRF( '/', 0, A, IP, INFO ) 266 CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK ) 267 INFOT = 2 268 CALL ZHPTRF( 'U', -1, A, IP, INFO ) 269 CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK ) 270* 271* ZHPTRI 272* 273 SRNAMT = 'ZHPTRI' 274 INFOT = 1 275 CALL ZHPTRI( '/', 0, A, IP, W, INFO ) 276 CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK ) 277 INFOT = 2 278 CALL ZHPTRI( 'U', -1, A, IP, W, INFO ) 279 CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK ) 280* 281* ZHPTRS 282* 283 SRNAMT = 'ZHPTRS' 284 INFOT = 1 285 CALL ZHPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 286 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 287 INFOT = 2 288 CALL ZHPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 289 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 290 INFOT = 3 291 CALL ZHPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 292 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 293 INFOT = 7 294 CALL ZHPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 295 CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK ) 296* 297* ZHPRFS 298* 299 SRNAMT = 'ZHPRFS' 300 INFOT = 1 301 CALL ZHPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 302 $ INFO ) 303 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 304 INFOT = 2 305 CALL ZHPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 306 $ INFO ) 307 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 308 INFOT = 3 309 CALL ZHPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 310 $ INFO ) 311 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 312 INFOT = 8 313 CALL ZHPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 314 $ INFO ) 315 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 316 INFOT = 10 317 CALL ZHPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 318 $ INFO ) 319 CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK ) 320* 321* ZHPCON 322* 323 SRNAMT = 'ZHPCON' 324 INFOT = 1 325 CALL ZHPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 326 CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK ) 327 INFOT = 2 328 CALL ZHPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 329 CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK ) 330 INFOT = 5 331 CALL ZHPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 332 CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK ) 333 END IF 334* 335* Print a summary line. 336* 337 CALL ALAESM( PATH, OK, NOUT ) 338* 339 RETURN 340* 341* End of ZERRHE 342* 343 END 344