LAPACK: TESTING/LIN/zerrsyx.f Source 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      $                   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 *        ZSYTRS
00142 *
00143          SRNAMT = 'ZSYTRS'
00144          INFOT = 1
00145          CALL ZSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
00146          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
00147          INFOT = 2
00148          CALL ZSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
00149          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
00150          INFOT = 3
00151          CALL ZSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
00152          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
00153          INFOT = 5
00154          CALL ZSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
00155          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
00156          INFOT = 8
00157          CALL ZSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
00158          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
00159 *
00160 *        ZSYRFS
00161 *
00162          SRNAMT = 'ZSYRFS'
00163          INFOT = 1
00164          CALL ZSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
00165      $                R, INFO )
00166          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00167          INFOT = 2
00168          CALL ZSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
00169      $                W, R, INFO )
00170          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00171          INFOT = 3
00172          CALL ZSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
00173      $                W, R, INFO )
00174          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00175          INFOT = 5
00176          CALL ZSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
00177      $                R, INFO )
00178          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00179          INFOT = 7
00180          CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
00181      $                R, INFO )
00182          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00183          INFOT = 10
00184          CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
00185      $                R, INFO )
00186          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00187          INFOT = 12
00188          CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
00189      $                R, INFO )
00190          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
00191 *
00192 *        ZSYRFSX
00193 *
00194          N_ERR_BNDS = 3
00195          NPARAMS = 0
00196          SRNAMT = 'ZSYRFSX'
00197          INFOT = 1
00198          CALL ZSYRFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
00199      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00200      $        PARAMS, W, R, INFO )
00201          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00202          INFOT = 2
00203          CALL ZSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
00204      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00205      $        PARAMS, W, R, INFO )
00206          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00207          EQ = 'N'
00208          INFOT = 3
00209          CALL ZSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
00210      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00211      $        PARAMS, W, R, INFO )
00212          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00213          INFOT = 4
00214          CALL ZSYRFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1,
00215      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00216      $        PARAMS, W, R, INFO )
00217          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00218          INFOT = 6
00219          CALL ZSYRFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2,
00220      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00221      $        PARAMS, W, R, INFO )
00222          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00223          INFOT = 8
00224          CALL ZSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2,
00225      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00226      $        PARAMS, W, R, INFO )
00227          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00228          INFOT = 11
00229          CALL ZSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2,
00230      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00231      $        PARAMS, W, R, INFO )
00232          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00233          INFOT = 13
00234          CALL ZSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1,
00235      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00236      $        PARAMS, W, R, INFO )
00237          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
00238 *
00239 *        ZSYCON
00240 *
00241          SRNAMT = 'ZSYCON'
00242          INFOT = 1
00243          CALL ZSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
00244          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
00245          INFOT = 2
00246          CALL ZSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
00247          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
00248          INFOT = 4
00249          CALL ZSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
00250          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
00251          INFOT = 6
00252          CALL ZSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
00253          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
00254 *
00255 *     Test error exits of the routines that use the diagonal pivoting
00256 *     factorization of a symmetric indefinite packed matrix.
00257 *
00258       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
00259 *
00260 *        ZSPTRF
00261 *
00262          SRNAMT = 'ZSPTRF'
00263          INFOT = 1
00264          CALL ZSPTRF( '/', 0, A, IP, INFO )
00265          CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK )
00266          INFOT = 2
00267          CALL ZSPTRF( 'U', -1, A, IP, INFO )
00268          CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK )
00269 *
00270 *        ZSPTRI
00271 *
00272          SRNAMT = 'ZSPTRI'
00273          INFOT = 1
00274          CALL ZSPTRI( '/', 0, A, IP, W, INFO )
00275          CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK )
00276          INFOT = 2
00277          CALL ZSPTRI( 'U', -1, A, IP, W, INFO )
00278          CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK )
00279 *
00280 *        ZSPTRS
00281 *
00282          SRNAMT = 'ZSPTRS'
00283          INFOT = 1
00284          CALL ZSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
00285          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
00286          INFOT = 2
00287          CALL ZSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
00288          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
00289          INFOT = 3
00290          CALL ZSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
00291          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
00292          INFOT = 7
00293          CALL ZSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
00294          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
00295 *
00296 *        ZSPRFS
00297 *
00298          SRNAMT = 'ZSPRFS'
00299          INFOT = 1
00300          CALL ZSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00301      $                INFO )
00302          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
00303          INFOT = 2
00304          CALL ZSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00305      $                INFO )
00306          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
00307          INFOT = 3
00308          CALL ZSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00309      $                INFO )
00310          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
00311          INFOT = 8
00312          CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
00313      $                INFO )
00314          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
00315          INFOT = 10
00316          CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
00317      $                INFO )
00318          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
00319 *
00320 *        ZSPCON
00321 *
00322          SRNAMT = 'ZSPCON'
00323          INFOT = 1
00324          CALL ZSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO )
00325          CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK )
00326          INFOT = 2
00327          CALL ZSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO )
00328          CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK )
00329          INFOT = 5
00330          CALL ZSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
00331          CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK )
00332       END IF
00333 *
00334 *     Print a summary line.
00335 *
00336       CALL ALAESM( PATH, OK, NOUT )
00337 *
00338       RETURN
00339 *
00340 *     End of ZERRSY
00341 *
00342       END