LAPACK: TESTING/LIN/cerrsyx.f Source File

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