LAPACK: TESTING/LIN/cerrhex.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CERRHE( 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 *  CERRHE tests the error exits for the COMPLEX routines
00016 *  for Hermitian indefinite matrices.
00017 *
00018 *  Note that this file is used only when the XBLAS are available,
00019 *  otherwise cerrhe.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 *
00033 *     .. Parameters ..
00034       INTEGER            NMAX
00035       PARAMETER          ( NMAX = 4 )
00036 *     ..
00037 *     .. Local Scalars ..
00038       CHARACTER          EQ
00039       CHARACTER*2        C2
00040       INTEGER            I, INFO, J, N_ERR_BNDS, NPARAMS
00041       REAL               ANRM, RCOND, BERR
00042 *     ..
00043 *     .. Local Arrays ..
00044       INTEGER            IP( NMAX )
00045       REAL               R( NMAX ), R1( NMAX ), R2( NMAX ),
00046      $                   S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
00047      $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
00048       COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
00049      $                   W( 2*NMAX ), X( NMAX )
00050 *     ..
00051 *     .. External Functions ..
00052       LOGICAL            LSAMEN
00053       EXTERNAL           LSAMEN
00054 *     ..
00055 *     .. External Subroutines ..
00056       EXTERNAL           ALAESM, CHECON, CHERFS, CHETF2, CHETRF, CHETRI,
00057      $                   CHETRS, CHKXER, CHPCON, CHPRFS, CHPTRF, CHPTRI,
00058      $                   CHPTRS, CHERFSX
00059 *     ..
00060 *     .. Scalars in Common ..
00061       LOGICAL            LERR, OK
00062       CHARACTER*32       SRNAMT
00063       INTEGER            INFOT, NOUT
00064 *     ..
00065 *     .. Common blocks ..
00066       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00067       COMMON             / SRNAMC / SRNAMT
00068 *     ..
00069 *     .. Intrinsic Functions ..
00070       INTRINSIC          CMPLX, REAL
00071 *     ..
00072 *     .. Executable Statements ..
00073 *
00074       NOUT = NUNIT
00075       WRITE( NOUT, FMT = * )
00076       C2 = PATH( 2: 3 )
00077 *
00078 *     Set the variables to innocuous values.
00079 *
00080       DO 20 J = 1, NMAX
00081          DO 10 I = 1, NMAX
00082             A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
00083             AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
00084    10    CONTINUE
00085          B( J ) = 0.
00086          R1( J ) = 0.
00087          R2( J ) = 0.
00088          W( J ) = 0.
00089          X( J ) = 0.
00090          S( J ) = 0.
00091          IP( J ) = J
00092    20 CONTINUE
00093       ANRM = 1.0
00094       OK = .TRUE.
00095 *
00096 *     Test error exits of the routines that use the diagonal pivoting
00097 *     factorization of a Hermitian indefinite matrix.
00098 *
00099       IF( LSAMEN( 2, C2, 'HE' ) ) THEN
00100 *
00101 *        CHETRF
00102 *
00103          SRNAMT = 'CHETRF'
00104          INFOT = 1
00105          CALL CHETRF( '/', 0, A, 1, IP, W, 1, INFO )
00106          CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
00107          INFOT = 2
00108          CALL CHETRF( 'U', -1, A, 1, IP, W, 1, INFO )
00109          CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
00110          INFOT = 4
00111          CALL CHETRF( 'U', 2, A, 1, IP, W, 4, INFO )
00112          CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
00113 *
00114 *        CHETF2
00115 *
00116          SRNAMT = 'CHETF2'
00117          INFOT = 1
00118          CALL CHETF2( '/', 0, A, 1, IP, INFO )
00119          CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK )
00120          INFOT = 2
00121          CALL CHETF2( 'U', -1, A, 1, IP, INFO )
00122          CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK )
00123          INFOT = 4
00124          CALL CHETF2( 'U', 2, A, 1, IP, INFO )
00125          CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK )
00126 *
00127 *        CHETRI
00128 *
00129          SRNAMT = 'CHETRI'
00130          INFOT = 1
00131          CALL CHETRI( '/', 0, A, 1, IP, W, INFO )
00132          CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK )
00133          INFOT = 2
00134          CALL CHETRI( 'U', -1, A, 1, IP, W, INFO )
00135          CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK )
00136          INFOT = 4
00137          CALL CHETRI( 'U', 2, A, 1, IP, W, INFO )
00138          CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK )
00139 *
00140 *        CHETRS
00141 *
00142          SRNAMT = 'CHETRS'
00143          INFOT = 1
00144          CALL CHETRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
00145          CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
00146          INFOT = 2
00147          CALL CHETRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
00148          CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
00149          INFOT = 3
00150          CALL CHETRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
00151          CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
00152          INFOT = 5
00153          CALL CHETRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
00154          CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
00155          INFOT = 8
00156          CALL CHETRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
00157          CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
00158 *
00159 *        CHERFS
00160 *
00161          SRNAMT = 'CHERFS'
00162          INFOT = 1
00163          CALL CHERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
00164      $                R, INFO )
00165          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
00166          INFOT = 2
00167          CALL CHERFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
00168      $                W, R, INFO )
00169          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
00170          INFOT = 3
00171          CALL CHERFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
00172      $                W, R, INFO )
00173          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
00174          INFOT = 5
00175          CALL CHERFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
00176      $                R, INFO )
00177          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
00178          INFOT = 7
00179          CALL CHERFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
00180      $                R, INFO )
00181          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
00182          INFOT = 10
00183          CALL CHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
00184      $                R, INFO )
00185          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
00186          INFOT = 12
00187          CALL CHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
00188      $                R, INFO )
00189          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
00190 *
00191 *        CHECON
00192 *
00193          SRNAMT = 'CHECON'
00194          INFOT = 1
00195          CALL CHECON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
00196          CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
00197          INFOT = 2
00198          CALL CHECON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
00199          CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
00200          INFOT = 4
00201          CALL CHECON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
00202          CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
00203          INFOT = 6
00204          CALL CHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
00205          CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
00206 *
00207 *     Test error exits of the routines that use the diagonal pivoting
00208 *     factorization of a Hermitian indefinite packed matrix.
00209 *
00210       ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
00211 *
00212 *        CHPTRF
00213 *
00214          SRNAMT = 'CHPTRF'
00215          INFOT = 1
00216          CALL CHPTRF( '/', 0, A, IP, INFO )
00217          CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK )
00218          INFOT = 2
00219          CALL CHPTRF( 'U', -1, A, IP, INFO )
00220          CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK )
00221 *
00222 *        CHPTRI
00223 *
00224          SRNAMT = 'CHPTRI'
00225          INFOT = 1
00226          CALL CHPTRI( '/', 0, A, IP, W, INFO )
00227          CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK )
00228          INFOT = 2
00229          CALL CHPTRI( 'U', -1, A, IP, W, INFO )
00230          CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK )
00231 *
00232 *        CHPTRS
00233 *
00234          SRNAMT = 'CHPTRS'
00235          INFOT = 1
00236          CALL CHPTRS( '/', 0, 0, A, IP, B, 1, INFO )
00237          CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
00238          INFOT = 2
00239          CALL CHPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
00240          CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
00241          INFOT = 3
00242          CALL CHPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
00243          CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
00244          INFOT = 7
00245          CALL CHPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
00246          CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
00247 *
00248 *        CHPRFS
00249 *
00250          SRNAMT = 'CHPRFS'
00251          INFOT = 1
00252          CALL CHPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00253      $                INFO )
00254          CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
00255          INFOT = 2
00256          CALL CHPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00257      $                INFO )
00258          CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
00259          INFOT = 3
00260          CALL CHPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00261      $                INFO )
00262          CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
00263          INFOT = 8
00264          CALL CHPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
00265      $                INFO )
00266          CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
00267          INFOT = 10
00268          CALL CHPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
00269      $                INFO )
00270          CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
00271 *
00272 *        CHERFSX
00273 *
00274          N_ERR_BNDS = 3
00275          NPARAMS = 0
00276          SRNAMT = 'CHERFSX'
00277          INFOT = 1
00278          CALL CHERFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
00279      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00280      $        PARAMS, W, R, INFO )
00281          CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
00282          INFOT = 2
00283          CALL CHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
00284      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00285      $        PARAMS, W, R, INFO )
00286          CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
00287          EQ = 'N'
00288          INFOT = 3
00289          CALL CHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
00290      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00291      $        PARAMS, W, R, INFO )
00292          CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
00293          INFOT = 4
00294          CALL CHERFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1,
00295      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00296      $        PARAMS, W, R, INFO )
00297          CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
00298          INFOT = 6
00299          CALL CHERFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2,
00300      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00301      $        PARAMS, W, R, INFO )
00302          CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
00303          INFOT = 8
00304          CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2,
00305      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00306      $        PARAMS, W, R, INFO )
00307          CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
00308          INFOT = 11
00309          CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2,
00310      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00311      $        PARAMS, W, R, INFO )
00312          CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
00313          INFOT = 13
00314          CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1,
00315      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
00316      $        PARAMS, W, R, INFO )
00317          CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
00318 *
00319 *        CHPCON
00320 *
00321          SRNAMT = 'CHPCON'
00322          INFOT = 1
00323          CALL CHPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO )
00324          CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK )
00325          INFOT = 2
00326          CALL CHPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO )
00327          CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK )
00328          INFOT = 5
00329          CALL CHPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
00330          CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK )
00331       END IF
00332 *
00333 *     Print a summary line.
00334 *
00335       CALL ALAESM( PATH, OK, NOUT )
00336 *
00337       RETURN
00338 *
00339 *     End of CERRHE
00340 *
00341       END