LAPACK: TESTING/LIN/zerrhe.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZERRHE( PATH, NUNIT )
00002 *
00003 *  -- LAPACK test routine (version 3.1) --
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 *  Arguments
00019 *  =========
00020 *
00021 *  PATH    (input) CHARACTER*3
00022 *          The LAPACK path name for the routines to be tested.
00023 *
00024 *  NUNIT   (input) INTEGER
00025 *          The unit number for output.
00026 *
00027 *  =====================================================================
00028 *
00029 *
00030 *     .. Parameters ..
00031       INTEGER            NMAX
00032       PARAMETER          ( NMAX = 4 )
00033 *     ..
00034 *     .. Local Scalars ..
00035       CHARACTER*2        C2
00036       INTEGER            I, INFO, J
00037       DOUBLE PRECISION   ANRM, RCOND
00038 *     ..
00039 *     .. Local Arrays ..
00040       INTEGER            IP( NMAX )
00041       DOUBLE PRECISION   R( NMAX ), R1( NMAX ), R2( NMAX )
00042       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
00043      $                   W( 2*NMAX ), X( NMAX )
00044 *     ..
00045 *     .. External Functions ..
00046       LOGICAL            LSAMEN
00047       EXTERNAL           LSAMEN
00048 *     ..
00049 *     .. External Subroutines ..
00050       EXTERNAL           ALAESM, CHKXER, ZHECON, ZHERFS, ZHETF2, ZHETRF,
00051      $                   ZHETRI, ZHETRS, ZHPCON, ZHPRFS, ZHPTRF, ZHPTRI,
00052      $                   ZHPTRS
00053 *     ..
00054 *     .. Scalars in Common ..
00055       LOGICAL            LERR, OK
00056       CHARACTER*32       SRNAMT
00057       INTEGER            INFOT, NOUT
00058 *     ..
00059 *     .. Common blocks ..
00060       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00061       COMMON             / SRNAMC / SRNAMT
00062 *     ..
00063 *     .. Intrinsic Functions ..
00064       INTRINSIC          DBLE, DCMPLX
00065 *     ..
00066 *     .. Executable Statements ..
00067 *
00068       NOUT = NUNIT
00069       WRITE( NOUT, FMT = * )
00070       C2 = PATH( 2: 3 )
00071 *
00072 *     Set the variables to innocuous values.
00073 *
00074       DO 20 J = 1, NMAX
00075          DO 10 I = 1, NMAX
00076             A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ),
00077      $                  -1.D0 / DBLE( I+J ) )
00078             AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ),
00079      $                   -1.D0 / DBLE( I+J ) )
00080    10    CONTINUE
00081          B( J ) = 0.D0
00082          R1( J ) = 0.D0
00083          R2( J ) = 0.D0
00084          W( J ) = 0.D0
00085          X( J ) = 0.D0
00086          IP( J ) = J
00087    20 CONTINUE
00088       ANRM = 1.0D0
00089       OK = .TRUE.
00090 *
00091 *     Test error exits of the routines that use the diagonal pivoting
00092 *     factorization of a Hermitian indefinite matrix.
00093 *
00094       IF( LSAMEN( 2, C2, 'HE' ) ) THEN
00095 *
00096 *        ZHETRF
00097 *
00098          SRNAMT = 'ZHETRF'
00099          INFOT = 1
00100          CALL ZHETRF( '/', 0, A, 1, IP, W, 1, INFO )
00101          CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
00102          INFOT = 2
00103          CALL ZHETRF( 'U', -1, A, 1, IP, W, 1, INFO )
00104          CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
00105          INFOT = 4
00106          CALL ZHETRF( 'U', 2, A, 1, IP, W, 4, INFO )
00107          CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
00108 *
00109 *        ZHETF2
00110 *
00111          SRNAMT = 'ZHETF2'
00112          INFOT = 1
00113          CALL ZHETF2( '/', 0, A, 1, IP, INFO )
00114          CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK )
00115          INFOT = 2
00116          CALL ZHETF2( 'U', -1, A, 1, IP, INFO )
00117          CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK )
00118          INFOT = 4
00119          CALL ZHETF2( 'U', 2, A, 1, IP, INFO )
00120          CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK )
00121 *
00122 *        ZHETRI
00123 *
00124          SRNAMT = 'ZHETRI'
00125          INFOT = 1
00126          CALL ZHETRI( '/', 0, A, 1, IP, W, INFO )
00127          CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK )
00128          INFOT = 2
00129          CALL ZHETRI( 'U', -1, A, 1, IP, W, INFO )
00130          CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK )
00131          INFOT = 4
00132          CALL ZHETRI( 'U', 2, A, 1, IP, W, INFO )
00133          CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK )
00134 *
00135 *        ZHETRS
00136 *
00137          SRNAMT = 'ZHETRS'
00138          INFOT = 1
00139          CALL ZHETRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
00140          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
00141          INFOT = 2
00142          CALL ZHETRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
00143          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
00144          INFOT = 3
00145          CALL ZHETRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
00146          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
00147          INFOT = 5
00148          CALL ZHETRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
00149          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
00150          INFOT = 8
00151          CALL ZHETRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
00152          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
00153 *
00154 *        ZHERFS
00155 *
00156          SRNAMT = 'ZHERFS'
00157          INFOT = 1
00158          CALL ZHERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
00159      $                R, INFO )
00160          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
00161          INFOT = 2
00162          CALL ZHERFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
00163      $                W, R, INFO )
00164          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
00165          INFOT = 3
00166          CALL ZHERFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
00167      $                W, R, INFO )
00168          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
00169          INFOT = 5
00170          CALL ZHERFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
00171      $                R, INFO )
00172          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
00173          INFOT = 7
00174          CALL ZHERFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
00175      $                R, INFO )
00176          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
00177          INFOT = 10
00178          CALL ZHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
00179      $                R, INFO )
00180          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
00181          INFOT = 12
00182          CALL ZHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
00183      $                R, INFO )
00184          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
00185 *
00186 *        ZHECON
00187 *
00188          SRNAMT = 'ZHECON'
00189          INFOT = 1
00190          CALL ZHECON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
00191          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
00192          INFOT = 2
00193          CALL ZHECON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
00194          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
00195          INFOT = 4
00196          CALL ZHECON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
00197          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
00198          INFOT = 6
00199          CALL ZHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
00200          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
00201 *
00202 *     Test error exits of the routines that use the diagonal pivoting
00203 *     factorization of a Hermitian indefinite packed matrix.
00204 *
00205       ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
00206 *
00207 *        ZHPTRF
00208 *
00209          SRNAMT = 'ZHPTRF'
00210          INFOT = 1
00211          CALL ZHPTRF( '/', 0, A, IP, INFO )
00212          CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK )
00213          INFOT = 2
00214          CALL ZHPTRF( 'U', -1, A, IP, INFO )
00215          CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK )
00216 *
00217 *        ZHPTRI
00218 *
00219          SRNAMT = 'ZHPTRI'
00220          INFOT = 1
00221          CALL ZHPTRI( '/', 0, A, IP, W, INFO )
00222          CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK )
00223          INFOT = 2
00224          CALL ZHPTRI( 'U', -1, A, IP, W, INFO )
00225          CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK )
00226 *
00227 *        ZHPTRS
00228 *
00229          SRNAMT = 'ZHPTRS'
00230          INFOT = 1
00231          CALL ZHPTRS( '/', 0, 0, A, IP, B, 1, INFO )
00232          CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
00233          INFOT = 2
00234          CALL ZHPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
00235          CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
00236          INFOT = 3
00237          CALL ZHPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
00238          CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
00239          INFOT = 7
00240          CALL ZHPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
00241          CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
00242 *
00243 *        ZHPRFS
00244 *
00245          SRNAMT = 'ZHPRFS'
00246          INFOT = 1
00247          CALL ZHPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00248      $                INFO )
00249          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
00250          INFOT = 2
00251          CALL ZHPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00252      $                INFO )
00253          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
00254          INFOT = 3
00255          CALL ZHPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
00256      $                INFO )
00257          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
00258          INFOT = 8
00259          CALL ZHPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
00260      $                INFO )
00261          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
00262          INFOT = 10
00263          CALL ZHPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
00264      $                INFO )
00265          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
00266 *
00267 *        ZHPCON
00268 *
00269          SRNAMT = 'ZHPCON'
00270          INFOT = 1
00271          CALL ZHPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO )
00272          CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK )
00273          INFOT = 2
00274          CALL ZHPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO )
00275          CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK )
00276          INFOT = 5
00277          CALL ZHPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
00278          CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK )
00279       END IF
00280 *
00281 *     Print a summary line.
00282 *
00283       CALL ALAESM( PATH, OK, NOUT )
00284 *
00285       RETURN
00286 *
00287 *     End of ZERRHE
00288 *
00289       END