LAPACK: TESTING/LIN/cerrsyx.f Source File

00001       SUBROUTINE CERRSY( 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 *  CERRSY tests the error exits for the COMPLEX routines
00016 *  for symmetric indefinite matrices.
00017 *
00018 *  Note that this file is used only when the XBLAS are available,
00019 *  otherwise cerrsy.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       REAL               ANRM, RCOND, BERR
00041 *     ..
00042 *     .. Local Arrays ..
00043       INTEGER            IP( NMAX )
00044       REAL               R( NMAX ), R1( NMAX ), R2( NMAX ),
00045      $                   S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
00046      $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
00047       COMPLEX            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, CSPCON, CSPRFS, CSPTRF, CSPTRI,
00056      $                   CSPTRS, CSYCON, CSYRFS, CSYTF2, CSYTRF, CSYTRI,
00057      $                   CSYTRS, CSYRFSX
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          CMPLX, REAL
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 ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
00082             AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
00083    10    CONTINUE
00084          B( J ) = 0.
00085          R1( J ) = 0.
00086          R2( J ) = 0.
00087          W( J ) = 0.
00088          X( J ) = 0.
00089          S( J ) = 0.
00090          IP( J ) = J
00091    20 CONTINUE
00092       ANRM = 1.0
00093       OK = .TRUE.
00094 *
00095 *     Test error exits of the routines that use the diagonal pivoting
00096 *     factorization of a symmetric indefinite matrix.
00097 *
00098       IF( LSAMEN( 2, C2, 'SY' ) ) THEN
00099 *
00100 *        CSYTRF
00101 *
00102          SRNAMT = 'CSYTRF'
00103          INFOT = 1
00104          CALL CSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
00105          CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
00106          INFOT = 2
00107          CALL CSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
00108          CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
00109          INFOT = 4
00110          CALL CSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
00111          CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
00112 *
00113 *        CSYTF2
00114 *
00115          SRNAMT = 'CSYTF2'
00116          INFOT = 1
00117          CALL CSYTF2( '/', 0, A, 1, IP, INFO )
00118          CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
00119          INFOT = 2
00120          CALL CSYTF2( 'U', -1, A, 1, IP, INFO )
00121          CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
00122          INFOT = 4
00123          CALL CSYTF2( 'U', 2, A, 1, IP, INFO )
00124          CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
00125 *
00126 *        CSYTRI
00127 *
00128          SRNAMT = 'CSYTRI'
00129          INFOT = 1
00130          CALL CSYTRI( '/', 0, A, 1, IP, W, INFO )
00131          CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
00132          INFOT = 2
00133          CALL CSYTRI( 'U', -1, A, 1, IP, W, INFO )
00134          CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
00135          INFOT = 4
00136          CALL CSYTRI( 'U', 2, A, 1, IP, W, INFO )
00137          CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
00138 *
00139 *        CSYTRS
00140 *
00141          SRNAMT = 'CSYTRS'
00142          INFOT = 1
00143          CALL CSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
00144          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
00145          INFOT = 2
00146          CALL CSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
00147          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
00148          INFOT = 3
00149          CALL CSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
00150          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
00151          INFOT = 5
00152          CALL CSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
00153          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
00154          INFOT = 8
00155          CALL CSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
00156          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
00157 *
00158 *        CSYRFS
00159 *
00160          SRNAMT = 'CSYRFS'
00161          INFOT = 1
00162          CALL CSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
00163      $                R, INFO )
00164          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
00165          INFOT = 2
00166          CALL CSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
00167      $                W, R, INFO )
00168          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
00169          INFOT = 3
00170          CALL CSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
00171      $                W, R, INFO )
00172          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
00173          INFOT = 5
00174          CALL CSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
00175      $                R, INFO )
00176          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
00177          INFOT = 7
00178          CALL CSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
00179      $                R, INFO )
00180          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
00181          INFOT = 10
00182          CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
00183      $                R, INFO )
00184          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
00185          INFOT = 12
00186          CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
00187      $                R, INFO )
00188          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
00189 *
00190 *        CSYRFSX
00191 *
00192          N_ERR_BNDS = 3
00193          NPARAMS = 0
00194          SRNAMT = 'CSYRFSX'
00195          INFOT = 1
00196          CALL CSYRFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 
00197      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00198      $        PARAMS, W, R, INFO )
00199          CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
00200          INFOT = 2
00201          CALL CSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
00202      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00203      $        PARAMS, W, R, INFO )
00204          CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
00205          EQ = 'N'
00206          INFOT = 3
00207          CALL CSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
00208      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00209      $        PARAMS, W, R, INFO )
00210          CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
00211          INFOT = 4
00212          CALL CSYRFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1, 
00213      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00214      $        PARAMS, W, R, INFO )
00215          CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
00216          INFOT = 6
00217          CALL CSYRFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2, 
00218      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00219      $        PARAMS, W, R, INFO )
00220          CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
00221          INFOT = 8
00222          CALL CSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2, 
00223      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00224      $        PARAMS, W, R, INFO )
00225          CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
00226          INFOT = 11
00227          CALL CSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2, 
00228      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00229      $        PARAMS, W, R, INFO )
00230          CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
00231          INFOT = 13
00232          CALL CSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1, 
00233      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00234      $        PARAMS, W, R, INFO )
00235          CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
00236 *
00237 *        CSYCON
00238 *
00239          SRNAMT = 'CSYCON'
00240          INFOT = 1
00241          CALL CSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
00242          CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
00243          INFOT = 2
00244          CALL CSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
00245          CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
00246          INFOT = 4
00247          CALL CSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
00248          CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
00249          INFOT = 6
00250          CALL CSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
00251          CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
00252 *
00253 *     Test error exits of the routines that use the diagonal pivoting
00254 *     factorization of a symmetric indefinite packed matrix.
00255 *
00256       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
00257 *
00258 *        CSPTRF
00259 *
00260          SRNAMT = 'CSPTRF'
00261          INFOT = 1
00262          CALL CSPTRF( '/', 0, A, IP, INFO )
00263          CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK )
00264          INFOT = 2
00265          CALL CSPTRF( 'U', -1, A, IP, INFO )
00266          CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK )
00267 *
00268 *        CSPTRI
00269 *
00270          SRNAMT = 'CSPTRI'
00271          INFOT = 1
00272          CALL CSPTRI( '/', 0, A, IP, W, INFO )
00273          CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK )
00274          INFOT = 2
00275          CALL CSPTRI( 'U', -1, A, IP, W, INFO )
00276          CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK )
00277 *
00278 *        CSPTRS
00279 *
00280          SRNAMT = 'CSPTRS'
00281          INFOT = 1
00282          CALL CSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
00283          CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
00284          INFOT = 2
00285          CALL CSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
00286          CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
00287          INFOT = 3
00288          CALL CSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
00289          CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
00290          INFOT = 7
00291          CALL CSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
00292          CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
00293 *
00294 *        CSPRFS
00295 *
00296          SRNAMT = 'CSPRFS'
00297          INFOT = 1
00298          CALL CSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00299      $                INFO )
00300          CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
00301          INFOT = 2
00302          CALL CSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00303      $                INFO )
00304          CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
00305          INFOT = 3
00306          CALL CSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00307      $                INFO )
00308          CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
00309          INFOT = 8
00310          CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
00311      $                INFO )
00312          CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
00313          INFOT = 10
00314          CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
00315      $                INFO )
00316          CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
00317 *
00318 *        CSPCON
00319 *
00320          SRNAMT = 'CSPCON'
00321          INFOT = 1
00322          CALL CSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO )
00323          CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
00324          INFOT = 2
00325          CALL CSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO )
00326          CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
00327          INFOT = 5
00328          CALL CSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
00329          CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
00330       END IF
00331 *
00332 *     Print a summary line.
00333 *
00334       CALL ALAESM( PATH, OK, NOUT )
00335 *
00336       RETURN
00337 *
00338 *     End of CERRSY
00339 *
00340       END