LAPACK: TESTING/LIN/zerrsyx.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZERRSY( PATH, NUNIT )
00002 *
00003 *  -- LAPACK test routine (version 3.2) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2006
00006 *
00007 *     .. Scalar Arguments ..
00008       CHARACTER*3        PATH
00009       INTEGER            NUNIT
00010 *     ..
00011 *
00012 *  Purpose
00013 *  =======
00014 *
00015 *  ZERRSY tests the error exits for the COMPLEX*16 routines
00016 *  for symmetric indefinite matrices.
00017 *
00018 *  Note that this file is used only when the XBLAS are available,
00019 *  otherwise zerrsy.f defines this subroutine.
00020 *
00021 *  Arguments
00022 *  =========
00023 *
00024 *  PATH    (input) CHARACTER*3
00025 *          The LAPACK path name for the routines to be tested.
00026 *
00027 *  NUNIT   (input) INTEGER
00028 *          The unit number for output.
00029 *
00030 *  =====================================================================
00031 *
00032 *     .. Parameters ..
00033       INTEGER            NMAX
00034       PARAMETER          ( NMAX = 4 )
00035 *     ..
00036 *     .. Local Scalars ..
00037       CHARACTER          EQ
00038       CHARACTER*2        C2
00039       INTEGER            I, INFO, J, N_ERR_BNDS, NPARAMS
00040       DOUBLE PRECISION   ANRM, RCOND, BERR
00041 *     ..
00042 *     .. Local Arrays ..
00043       INTEGER            IP( NMAX )
00044       DOUBLE PRECISION   R( NMAX ), R1( NMAX ), R2( NMAX ),
00045      $                   S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
00046      $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
00047       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
00048      $                   W( 2*NMAX ), X( NMAX )
00049 *     ..
00050 *     .. External Functions ..
00051       LOGICAL            LSAMEN
00052       EXTERNAL           LSAMEN
00053 *     ..
00054 *     .. External Subroutines ..
00055       EXTERNAL           ALAESM, CHKXER, ZSPCON, ZSPRFS, ZSPTRF, ZSPTRI,
00056      $                   ZSPTRS, ZSYCON, ZSYRFS, ZSYTF2, ZSYTRF, ZSYTRI,
00057      $                   ZSYTRI2, ZSYTRS, ZSYRFSX
00058 *     ..
00059 *     .. Scalars in Common ..
00060       LOGICAL            LERR, OK
00061       CHARACTER*32       SRNAMT
00062       INTEGER            INFOT, NOUT
00063 *     ..
00064 *     .. Common blocks ..
00065       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00066       COMMON             / SRNAMC / SRNAMT
00067 *     ..
00068 *     .. Intrinsic Functions ..
00069       INTRINSIC          DBLE, DCMPLX
00070 *     ..
00071 *     .. Executable Statements ..
00072 *
00073       NOUT = NUNIT
00074       WRITE( NOUT, FMT = * )
00075       C2 = PATH( 2: 3 )
00076 *
00077 *     Set the variables to innocuous values.
00078 *
00079       DO 20 J = 1, NMAX
00080          DO 10 I = 1, NMAX
00081             A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ),
00082      $                  -1.D0 / DBLE( I+J ) )
00083             AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ),
00084      $                   -1.D0 / DBLE( I+J ) )
00085    10    CONTINUE
00086          B( J ) = 0.D0
00087          R1( J ) = 0.D0
00088          R2( J ) = 0.D0
00089          W( J ) = 0.D0
00090          X( J ) = 0.D0
00091          S( J ) = 0.D0
00092          IP( J ) = J
00093    20 CONTINUE
00094       ANRM = 1.0D0
00095       OK = .TRUE.
00096 *
00097 *     Test error exits of the routines that use the diagonal pivoting
00098 *     factorization of a symmetric indefinite matrix.
00099 *
00100       IF( LSAMEN( 2, C2, 'SY' ) ) THEN
00101 *
00102 *        ZSYTRF
00103 *
00104          SRNAMT = 'ZSYTRF'
00105          INFOT = 1
00106          CALL ZSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
00107          CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
00108          INFOT = 2
00109          CALL ZSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
00110          CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
00111          INFOT = 4
00112          CALL ZSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
00113          CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
00114 *
00115 *        ZSYTF2
00116 *
00117          SRNAMT = 'ZSYTF2'
00118          INFOT = 1
00119          CALL ZSYTF2( '/', 0, A, 1, IP, INFO )
00120          CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK )
00121          INFOT = 2
00122          CALL ZSYTF2( 'U', -1, A, 1, IP, INFO )
00123          CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK )
00124          INFOT = 4
00125          CALL ZSYTF2( 'U', 2, A, 1, IP, INFO )
00126          CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK )
00127 *
00128 *        ZSYTRI
00129 *
00130          SRNAMT = 'ZSYTRI'
00131          INFOT = 1
00132          CALL ZSYTRI( '/', 0, A, 1, IP, W, INFO )
00133          CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK )
00134          INFOT = 2
00135          CALL ZSYTRI( 'U', -1, A, 1, IP, W, INFO )
00136          CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK )
00137          INFOT = 4
00138          CALL ZSYTRI( 'U', 2, A, 1, IP, W, INFO )
00139          CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK )
00140 *
00141 *        ZSYTRI2
00142 *
00143          SRNAMT = 'ZSYTRI2'
00144          INFOT = 1
00145          CALL ZSYTRI2( '/', 0, A, 1, IP, W, 1, INFO )
00146          CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK )
00147          INFOT = 2
00148          CALL ZSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO )
00149          CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK )
00150          INFOT = 4
00151          CALL ZSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO )
00152          CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK )
00153 *
00154 *        ZSYTRS
00155 *
00156          SRNAMT = 'ZSYTRS'
00157          INFOT = 1
00158          CALL ZSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
00159          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
00160          INFOT = 2
00161          CALL ZSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
00162          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
00163          INFOT = 3
00164          CALL ZSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
00165          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
00166          INFOT = 5
00167          CALL ZSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
00168          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
00169          INFOT = 8
00170          CALL ZSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
00171          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
00172 *
00173 *        ZSYRFS
00174 *
00175          SRNAMT = 'ZSYRFS'
00176          INFOT = 1
00177          CALL ZSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
00178      $                R, INFO )
00179          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00180          INFOT = 2
00181          CALL ZSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
00182      $                W, R, INFO )
00183          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00184          INFOT = 3
00185          CALL ZSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
00186      $                W, R, INFO )
00187          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00188          INFOT = 5
00189          CALL ZSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
00190      $                R, INFO )
00191          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00192          INFOT = 7
00193          CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
00194      $                R, INFO )
00195          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00196          INFOT = 10
00197          CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
00198      $                R, INFO )
00199          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00200          INFOT = 12
00201          CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
00202      $                R, INFO )
00203          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00204 *
00205 *        ZSYRFSX
00206 *
00207          N_ERR_BNDS = 3
00208          NPARAMS = 0
00209          SRNAMT = 'ZSYRFSX'
00210          INFOT = 1
00211          CALL ZSYRFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
00212      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00213      $        PARAMS, W, R, INFO )
00214          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00215          INFOT = 2
00216          CALL ZSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
00217      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00218      $        PARAMS, W, R, INFO )
00219          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00220          EQ = 'N'
00221          INFOT = 3
00222          CALL ZSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
00223      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00224      $        PARAMS, W, R, INFO )
00225          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00226          INFOT = 4
00227          CALL ZSYRFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1,
00228      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00229      $        PARAMS, W, R, INFO )
00230          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00231          INFOT = 6
00232          CALL ZSYRFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2,
00233      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00234      $        PARAMS, W, R, INFO )
00235          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00236          INFOT = 8
00237          CALL ZSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2,
00238      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00239      $        PARAMS, W, R, INFO )
00240          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00241          INFOT = 11
00242          CALL ZSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2,
00243      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00244      $        PARAMS, W, R, INFO )
00245          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00246          INFOT = 13
00247          CALL ZSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1,
00248      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00249      $        PARAMS, W, R, INFO )
00250          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00251 *
00252 *        ZSYCON
00253 *
00254          SRNAMT = 'ZSYCON'
00255          INFOT = 1
00256          CALL ZSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
00257          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
00258          INFOT = 2
00259          CALL ZSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
00260          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
00261          INFOT = 4
00262          CALL ZSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
00263          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
00264          INFOT = 6
00265          CALL ZSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
00266          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
00267 *
00268 *     Test error exits of the routines that use the diagonal pivoting
00269 *     factorization of a symmetric indefinite packed matrix.
00270 *
00271       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
00272 *
00273 *        ZSPTRF
00274 *
00275          SRNAMT = 'ZSPTRF'
00276          INFOT = 1
00277          CALL ZSPTRF( '/', 0, A, IP, INFO )
00278          CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK )
00279          INFOT = 2
00280          CALL ZSPTRF( 'U', -1, A, IP, INFO )
00281          CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK )
00282 *
00283 *        ZSPTRI
00284 *
00285          SRNAMT = 'ZSPTRI'
00286          INFOT = 1
00287          CALL ZSPTRI( '/', 0, A, IP, W, INFO )
00288          CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK )
00289          INFOT = 2
00290          CALL ZSPTRI( 'U', -1, A, IP, W, INFO )
00291          CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK )
00292 *
00293 *        ZSPTRS
00294 *
00295          SRNAMT = 'ZSPTRS'
00296          INFOT = 1
00297          CALL ZSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
00298          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
00299          INFOT = 2
00300          CALL ZSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
00301          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
00302          INFOT = 3
00303          CALL ZSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
00304          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
00305          INFOT = 7
00306          CALL ZSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
00307          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
00308 *
00309 *        ZSPRFS
00310 *
00311          SRNAMT = 'ZSPRFS'
00312          INFOT = 1
00313          CALL ZSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00314      $                INFO )
00315          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
00316          INFOT = 2
00317          CALL ZSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00318      $                INFO )
00319          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
00320          INFOT = 3
00321          CALL ZSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00322      $                INFO )
00323          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
00324          INFOT = 8
00325          CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
00326      $                INFO )
00327          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
00328          INFOT = 10
00329          CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
00330      $                INFO )
00331          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
00332 *
00333 *        ZSPCON
00334 *
00335          SRNAMT = 'ZSPCON'
00336          INFOT = 1
00337          CALL ZSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO )
00338          CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK )
00339          INFOT = 2
00340          CALL ZSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO )
00341          CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK )
00342          INFOT = 5
00343          CALL ZSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
00344          CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK )
00345       END IF
00346 *
00347 *     Print a summary line.
00348 *
00349       CALL ALAESM( PATH, OK, NOUT )
00350 *
00351       RETURN
00352 *
00353 *     End of ZERRSY
00354 *
00355       END