TESTING/LIN/zerrsy.f

   1 *> \brief \b ZERRSY
   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 ZERRSY( 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 *> ZERRSY tests the error exits for the COMPLEX*16 routines
  25 *> for symmetric 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 2013
  52 *
  53 *> \ingroup complex16_lin
  54 *
  55 *  =====================================================================
  56       SUBROUTINE ZERRSY( PATH, NUNIT )
  57 *
  58 *  -- LAPACK test routine (version 3.5.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 2013
  62 *
  63 *     .. Scalar Arguments ..
  64       CHARACTER*3        PATH
  65       INTEGER            NUNIT
  66 *     ..
  67 *
  68 *  =====================================================================
  69 *
  70 *     .. Parameters ..
  71       INTEGER            NMAX
  72       PARAMETER          ( NMAX = 4 )
  73 *     ..
  74 *     .. Local Scalars ..
  75       CHARACTER*2        C2
  76       INTEGER            I, INFO, J
  77       DOUBLE PRECISION   ANRM, RCOND
  78 *     ..
  79 *     .. Local Arrays ..
  80       INTEGER            IP( NMAX )
  81       DOUBLE PRECISION   R( NMAX ), R1( NMAX ), R2( NMAX )
  82       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
  83      $                   W( 2*NMAX ), X( NMAX )
  84 *     ..
  85 *     .. External Functions ..
  86       LOGICAL            LSAMEN
  87       EXTERNAL           LSAMEN
  88 *     ..
  89 *     .. External Subroutines ..
  90       EXTERNAL           ALAESM, CHKXER, ZSPCON, ZSPRFS, ZSPTRF, ZSPTRI,
  91      $                   ZSPTRS, ZSYCON, ZSYCON_ROOK, ZSYRFS, ZSYTF2,
  92      $                   ZSYTF2_ROOK, ZSYTRF, ZSYTRF_ROOK, ZSYTRI,
  93      $                   ZSYTRI_ROOK, ZSYTRI2, ZSYTRS, ZSYTRS_ROOK
  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 factorization
 133 *     of a symmetric indefinite matrix with patrial
 134 *     (Bunch-Kaufman) diagonal pivoting method.
 135 *
 136       IF( LSAMEN( 2, C2, 'SY' ) ) THEN
 137 *
 138 *        ZSYTRF
 139 *
 140          SRNAMT = 'ZSYTRF'
 141          INFOT = 1
 142          CALL ZSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
 143          CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
 144          INFOT = 2
 145          CALL ZSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
 146          CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
 147          INFOT = 4
 148          CALL ZSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
 149          CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
 150 *
 151 *        ZSYTF2
 152 *
 153          SRNAMT = 'ZSYTF2'
 154          INFOT = 1
 155          CALL ZSYTF2( '/', 0, A, 1, IP, INFO )
 156          CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK )
 157          INFOT = 2
 158          CALL ZSYTF2( 'U', -1, A, 1, IP, INFO )
 159          CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK )
 160          INFOT = 4
 161          CALL ZSYTF2( 'U', 2, A, 1, IP, INFO )
 162          CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK )
 163 *
 164 *        ZSYTRI
 165 *
 166          SRNAMT = 'ZSYTRI'
 167          INFOT = 1
 168          CALL ZSYTRI( '/', 0, A, 1, IP, W, INFO )
 169          CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK )
 170          INFOT = 2
 171          CALL ZSYTRI( 'U', -1, A, 1, IP, W, INFO )
 172          CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK )
 173          INFOT = 4
 174          CALL ZSYTRI( 'U', 2, A, 1, IP, W, INFO )
 175          CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK )
 176 *
 177 *        ZSYTRI2
 178 *
 179          SRNAMT = 'ZSYTRI2'
 180          INFOT = 1
 181          CALL ZSYTRI2( '/', 0, A, 1, IP, W, 1, INFO )
 182          CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK )
 183          INFOT = 2
 184          CALL ZSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO )
 185          CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK )
 186          INFOT = 4
 187          CALL ZSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO )
 188          CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK )
 189 *
 190 *        ZSYTRS
 191 *
 192          SRNAMT = 'ZSYTRS'
 193          INFOT = 1
 194          CALL ZSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
 195          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
 196          INFOT = 2
 197          CALL ZSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
 198          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
 199          INFOT = 3
 200          CALL ZSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
 201          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
 202          INFOT = 5
 203          CALL ZSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
 204          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
 205          INFOT = 8
 206          CALL ZSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
 207          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
 208 *
 209 *        ZSYRFS
 210 *
 211          SRNAMT = 'ZSYRFS'
 212          INFOT = 1
 213          CALL ZSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
 214      $                R, INFO )
 215          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
 216          INFOT = 2
 217          CALL ZSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
 218      $                W, R, INFO )
 219          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
 220          INFOT = 3
 221          CALL ZSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
 222      $                W, R, INFO )
 223          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
 224          INFOT = 5
 225          CALL ZSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
 226      $                R, INFO )
 227          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
 228          INFOT = 7
 229          CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
 230      $                R, INFO )
 231          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
 232          INFOT = 10
 233          CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
 234      $                R, INFO )
 235          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
 236          INFOT = 12
 237          CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
 238      $                R, INFO )
 239          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
 240 *
 241 *        ZSYCON
 242 *
 243          SRNAMT = 'ZSYCON'
 244          INFOT = 1
 245          CALL ZSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
 246          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
 247          INFOT = 2
 248          CALL ZSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
 249          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
 250          INFOT = 4
 251          CALL ZSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
 252          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
 253          INFOT = 6
 254          CALL ZSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
 255          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
 256 *
 257 *     Test error exits of the routines that use factorization
 258 *     of a symmetric indefinite matrix with "rook"
 259 *     (bounded Bunch-Kaufman) diagonal pivoting method.
 260 *
 261       ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
 262 *
 263 *        ZSYTRF_ROOK
 264 *
 265          SRNAMT = 'ZSYTRF_ROOK'
 266          INFOT = 1
 267          CALL ZSYTRF_ROOK( '/', 0, A, 1, IP, W, 1, INFO )
 268          CALL CHKXER( 'ZSYTRF_ROOK', INFOT, NOUT, LERR, OK )
 269          INFOT = 2
 270          CALL ZSYTRF_ROOK( 'U', -1, A, 1, IP, W, 1, INFO )
 271          CALL CHKXER( 'ZSYTRF_ROOK', INFOT, NOUT, LERR, OK )
 272          INFOT = 4
 273          CALL ZSYTRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
 274          CALL CHKXER( 'ZSYTRF_ROOK', INFOT, NOUT, LERR, OK )
 275 *
 276 *        ZSYTF2_ROOK
 277 *
 278          SRNAMT = 'ZSYTF2_ROOK'
 279          INFOT = 1
 280          CALL ZSYTF2_ROOK( '/', 0, A, 1, IP, INFO )
 281          CALL CHKXER( 'ZSYTF2_ROOK', INFOT, NOUT, LERR, OK )
 282          INFOT = 2
 283          CALL ZSYTF2_ROOK( 'U', -1, A, 1, IP, INFO )
 284          CALL CHKXER( 'ZSYTF2_ROOK', INFOT, NOUT, LERR, OK )
 285          INFOT = 4
 286          CALL ZSYTF2_ROOK( 'U', 2, A, 1, IP, INFO )
 287          CALL CHKXER( 'ZSYTF2_ROOK', INFOT, NOUT, LERR, OK )
 288 *
 289 *        ZSYTRI_ROOK
 290 *
 291          SRNAMT = 'ZSYTRI_ROOK'
 292          INFOT = 1
 293          CALL ZSYTRI_ROOK( '/', 0, A, 1, IP, W, INFO )
 294          CALL CHKXER( 'ZSYTRI_ROOK', INFOT, NOUT, LERR, OK )
 295          INFOT = 2
 296          CALL ZSYTRI_ROOK( 'U', -1, A, 1, IP, W, INFO )
 297          CALL CHKXER( 'ZSYTRI_ROOK', INFOT, NOUT, LERR, OK )
 298          INFOT = 4
 299          CALL ZSYTRI_ROOK( 'U', 2, A, 1, IP, W, INFO )
 300          CALL CHKXER( 'ZSYTRI_ROOK', INFOT, NOUT, LERR, OK )
 301 *
 302 *        ZSYTRS_ROOK
 303 *
 304          SRNAMT = 'ZSYTRS_ROOK'
 305          INFOT = 1
 306          CALL ZSYTRS_ROOK( '/', 0, 0, A, 1, IP, B, 1, INFO )
 307          CALL CHKXER( 'ZSYTRS_ROOK', INFOT, NOUT, LERR, OK )
 308          INFOT = 2
 309          CALL ZSYTRS_ROOK( 'U', -1, 0, A, 1, IP, B, 1, INFO )
 310          CALL CHKXER( 'ZSYTRS_ROOK', INFOT, NOUT, LERR, OK )
 311          INFOT = 3
 312          CALL ZSYTRS_ROOK( 'U', 0, -1, A, 1, IP, B, 1, INFO )
 313          CALL CHKXER( 'ZSYTRS_ROOK', INFOT, NOUT, LERR, OK )
 314          INFOT = 5
 315          CALL ZSYTRS_ROOK( 'U', 2, 1, A, 1, IP, B, 2, INFO )
 316          CALL CHKXER( 'ZSYTRS_ROOK', INFOT, NOUT, LERR, OK )
 317          INFOT = 8
 318          CALL ZSYTRS_ROOK( 'U', 2, 1, A, 2, IP, B, 1, INFO )
 319          CALL CHKXER( 'ZSYTRS_ROOK', INFOT, NOUT, LERR, OK )
 320 *
 321 *        ZSYCON_ROOK
 322 *
 323          SRNAMT = 'ZSYCON_ROOK'
 324          INFOT = 1
 325          CALL ZSYCON_ROOK( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
 326          CALL CHKXER( 'ZSYCON_ROOK', INFOT, NOUT, LERR, OK )
 327          INFOT = 2
 328          CALL ZSYCON_ROOK( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
 329          CALL CHKXER( 'ZSYCON_ROOK', INFOT, NOUT, LERR, OK )
 330          INFOT = 4
 331          CALL ZSYCON_ROOK( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
 332          CALL CHKXER( 'ZSYCON_ROOK', INFOT, NOUT, LERR, OK )
 333          INFOT = 6
 334          CALL ZSYCON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
 335          CALL CHKXER( 'ZSYCON_ROOK', INFOT, NOUT, LERR, OK )
 336 *
 337 *        Test error exits of the routines that use factorization
 338 *        of a symmetric indefinite packed matrix with patrial
 339 *        (Bunch-Kaufman) pivoting.
 340 *
 341       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 342 *
 343 *        ZSPTRF
 344 *
 345          SRNAMT = 'ZSPTRF'
 346          INFOT = 1
 347          CALL ZSPTRF( '/', 0, A, IP, INFO )
 348          CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK )
 349          INFOT = 2
 350          CALL ZSPTRF( 'U', -1, A, IP, INFO )
 351          CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK )
 352 *
 353 *        ZSPTRI
 354 *
 355          SRNAMT = 'ZSPTRI'
 356          INFOT = 1
 357          CALL ZSPTRI( '/', 0, A, IP, W, INFO )
 358          CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK )
 359          INFOT = 2
 360          CALL ZSPTRI( 'U', -1, A, IP, W, INFO )
 361          CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK )
 362 *
 363 *        ZSPTRS
 364 *
 365          SRNAMT = 'ZSPTRS'
 366          INFOT = 1
 367          CALL ZSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
 368          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
 369          INFOT = 2
 370          CALL ZSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
 371          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
 372          INFOT = 3
 373          CALL ZSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
 374          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
 375          INFOT = 7
 376          CALL ZSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
 377          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
 378 *
 379 *        ZSPRFS
 380 *
 381          SRNAMT = 'ZSPRFS'
 382          INFOT = 1
 383          CALL ZSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
 384      $                INFO )
 385          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
 386          INFOT = 2
 387          CALL ZSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
 388      $                INFO )
 389          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
 390          INFOT = 3
 391          CALL ZSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
 392      $                INFO )
 393          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
 394          INFOT = 8
 395          CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
 396      $                INFO )
 397          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
 398          INFOT = 10
 399          CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
 400      $                INFO )
 401          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
 402 *
 403 *        ZSPCON
 404 *
 405          SRNAMT = 'ZSPCON'
 406          INFOT = 1
 407          CALL ZSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO )
 408          CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK )
 409          INFOT = 2
 410          CALL ZSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO )
 411          CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK )
 412          INFOT = 5
 413          CALL ZSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
 414          CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK )
 415       END IF
 416 *
 417 *     Print a summary line.
 418 *
 419       CALL ALAESM( PATH, OK, NOUT )
 420 *
 421       RETURN
 422 *
 423 *     End of ZERRSY
 424 *
 425       END