LAPACK: TESTING/LIN/zerrhex.f Source File

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