Go to the documentation of this file.
00001 *> \brief \b CERRSY
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE CERRSY( PATH, NUNIT )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       CHARACTER*3        PATH
00015 *       INTEGER            NUNIT
00016 *       ..
00017 *  
00018 *
00019 *> \par Purpose:
00020 *  =============
00021 *>
00022 *> \verbatim
00023 *>
00024 *> CERRSY tests the error exits for the COMPLEX routines
00025 *> for symmetric indefinite matrices.
00026 *> \endverbatim
00027 *
00028 *  Arguments:
00029 *  ==========
00030 *
00031 *> \param[in] PATH
00032 *> \verbatim
00033 *>          PATH is CHARACTER*3
00034 *>          The LAPACK path name for the routines to be tested.
00035 *> \endverbatim
00036 *>
00037 *> \param[in] NUNIT
00038 *> \verbatim
00039 *>          NUNIT is INTEGER
00040 *>          The unit number for output.
00041 *> \endverbatim
00042 *
00043 *  Authors:
00044 *  ========
00045 *
00046 *> \author Univ. of Tennessee 
00047 *> \author Univ. of California Berkeley 
00048 *> \author Univ. of Colorado Denver 
00049 *> \author NAG Ltd. 
00050 *
00051 *> \date November 2011
00052 *
00053 *> \ingroup complex_lin
00054 *
00055 *  =====================================================================
00056       SUBROUTINE CERRSY( PATH, NUNIT )
00057 *
00058 *  -- LAPACK test routine (version 3.4.0) --
00059 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00060 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00061 *     November 2011
00062 *
00063 *     .. Scalar Arguments ..
00064       CHARACTER*3        PATH
00065       INTEGER            NUNIT
00066 *     ..
00067 *
00068 *  =====================================================================
00069 *
00070 *     .. Parameters ..
00071       INTEGER            NMAX
00072       PARAMETER          ( NMAX = 4 )
00073 *     ..
00074 *     .. Local Scalars ..
00075       CHARACTER*2        C2
00076       INTEGER            I, INFO, J
00077       REAL               ANRM, RCOND
00078 *     ..
00079 *     .. Local Arrays ..
00080       INTEGER            IP( NMAX )
00081       REAL               R( NMAX ), R1( NMAX ), R2( NMAX )
00082       COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
00083      $                   W( 2*NMAX ), X( NMAX )
00084 *     ..
00085 *     .. External Functions ..
00086       LOGICAL            LSAMEN
00087       EXTERNAL           LSAMEN
00088 *     ..
00089 *     .. External Subroutines ..
00090       EXTERNAL           ALAESM, CHKXER, CSPCON, CSPRFS, CSPTRF, CSPTRI,
00091      $                   CSPTRS, CSYCON, CSYRFS, CSYTF2, CSYTRF, CSYTRI,
00092      $                   CSYTRI2, CSYTRS
00093 *     ..
00094 *     .. Scalars in Common ..
00095       LOGICAL            LERR, OK
00096       CHARACTER*32       SRNAMT
00097       INTEGER            INFOT, NOUT
00098 *     ..
00099 *     .. Common blocks ..
00100       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00101       COMMON             / SRNAMC / SRNAMT
00102 *     ..
00103 *     .. Intrinsic Functions ..
00104       INTRINSIC          CMPLX, REAL
00105 *     ..
00106 *     .. Executable Statements ..
00107 *
00108       NOUT = NUNIT
00109       WRITE( NOUT, FMT = * )
00110       C2 = PATH( 2: 3 )
00111 *
00112 *     Set the variables to innocuous values.
00113 *
00114       DO 20 J = 1, NMAX
00115          DO 10 I = 1, NMAX
00116             A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
00117             AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
00118    10    CONTINUE
00119          B( J ) = 0.
00120          R1( J ) = 0.
00121          R2( J ) = 0.
00122          W( J ) = 0.
00123          X( J ) = 0.
00124          IP( J ) = J
00125    20 CONTINUE
00126       ANRM = 1.0
00127       OK = .TRUE.
00128 *
00129 *     Test error exits of the routines that use the diagonal pivoting
00130 *     factorization of a symmetric indefinite matrix.
00131 *
00132       IF( LSAMEN( 2, C2, 'SY' ) ) THEN
00133 *
00134 *        CSYTRF
00135 *
00136          SRNAMT = 'CSYTRF'
00137          INFOT = 1
00138          CALL CSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
00139          CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
00140          INFOT = 2
00141          CALL CSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
00142          CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
00143          INFOT = 4
00144          CALL CSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
00145          CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
00146 *
00147 *        CSYTF2
00148 *
00149          SRNAMT = 'CSYTF2'
00150          INFOT = 1
00151          CALL CSYTF2( '/', 0, A, 1, IP, INFO )
00152          CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
00153          INFOT = 2
00154          CALL CSYTF2( 'U', -1, A, 1, IP, INFO )
00155          CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
00156          INFOT = 4
00157          CALL CSYTF2( 'U', 2, A, 1, IP, INFO )
00158          CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
00159 *
00160 *        CSYTRI
00161 *
00162          SRNAMT = 'CSYTRI'
00163          INFOT = 1
00164          CALL CSYTRI( '/', 0, A, 1, IP, W, INFO )
00165          CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
00166          INFOT = 2
00167          CALL CSYTRI( 'U', -1, A, 1, IP, W, INFO )
00168          CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
00169          INFOT = 4
00170          CALL CSYTRI( 'U', 2, A, 1, IP, W, INFO )
00171          CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
00172 *
00173 *        CSYTRI2
00174 *
00175          SRNAMT = 'CSYTRI2'
00176          INFOT = 1
00177          CALL CSYTRI2( '/', 0, A, 1, IP, W, 1, INFO )
00178          CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
00179          INFOT = 2
00180          CALL CSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO )
00181          CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
00182          INFOT = 4
00183          CALL CSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO )
00184          CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
00185 *
00186 *        CSYTRS
00187 *
00188          SRNAMT = 'CSYTRS'
00189          INFOT = 1
00190          CALL CSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
00191          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
00192          INFOT = 2
00193          CALL CSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
00194          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
00195          INFOT = 3
00196          CALL CSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
00197          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
00198          INFOT = 5
00199          CALL CSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
00200          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
00201          INFOT = 8
00202          CALL CSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
00203          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
00204 *
00205 *        CSYRFS
00206 *
00207          SRNAMT = 'CSYRFS'
00208          INFOT = 1
00209          CALL CSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
00210      $                R, INFO )
00211          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
00212          INFOT = 2
00213          CALL CSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
00214      $                W, R, INFO )
00215          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
00216          INFOT = 3
00217          CALL CSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
00218      $                W, R, INFO )
00219          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
00220          INFOT = 5
00221          CALL CSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
00222      $                R, INFO )
00223          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
00224          INFOT = 7
00225          CALL CSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
00226      $                R, INFO )
00227          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
00228          INFOT = 10
00229          CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
00230      $                R, INFO )
00231          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
00232          INFOT = 12
00233          CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
00234      $                R, INFO )
00235          CALL CHKXER( 'CSYRFS', 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