LAPACK: TESTING/LIN/zerrpo.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZERRPO( 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 *  ZERRPO tests the error exits for the COMPLEX*16 routines
00016 *  for Hermitian positive definite 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 *     .. Parameters ..
00030       INTEGER            NMAX
00031       PARAMETER          ( NMAX = 4 )
00032 *     ..
00033 *     .. Local Scalars ..
00034       CHARACTER*2        C2
00035       INTEGER            I, INFO, J
00036       DOUBLE PRECISION   ANRM, RCOND
00037 *     ..
00038 *     .. Local Arrays ..
00039       DOUBLE PRECISION   R( NMAX ), R1( NMAX ), R2( NMAX )
00040       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
00041      $                   W( 2*NMAX ), X( NMAX )
00042 *     ..
00043 *     .. External Functions ..
00044       LOGICAL            LSAMEN
00045       EXTERNAL           LSAMEN
00046 *     ..
00047 *     .. External Subroutines ..
00048       EXTERNAL           ALAESM, CHKXER, ZPBCON, ZPBEQU, ZPBRFS, ZPBTF2,
00049      $                   ZPBTRF, ZPBTRS, ZPOCON, ZPOEQU, ZPORFS, ZPOTF2,
00050      $                   ZPOTRF, ZPOTRI, ZPOTRS, ZPPCON, ZPPEQU, ZPPRFS,
00051      $                   ZPPTRF, ZPPTRI, ZPPTRS
00052 *     ..
00053 *     .. Scalars in Common ..
00054       LOGICAL            LERR, OK
00055       CHARACTER*32       SRNAMT
00056       INTEGER            INFOT, NOUT
00057 *     ..
00058 *     .. Common blocks ..
00059       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00060       COMMON             / SRNAMC / SRNAMT
00061 *     ..
00062 *     .. Intrinsic Functions ..
00063       INTRINSIC          DBLE, DCMPLX
00064 *     ..
00065 *     .. Executable Statements ..
00066 *
00067       NOUT = NUNIT
00068       WRITE( NOUT, FMT = * )
00069       C2 = PATH( 2: 3 )
00070 *
00071 *     Set the variables to innocuous values.
00072 *
00073       DO 20 J = 1, NMAX
00074          DO 10 I = 1, NMAX
00075             A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ),
00076      $                  -1.D0 / DBLE( I+J ) )
00077             AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ),
00078      $                   -1.D0 / DBLE( I+J ) )
00079    10    CONTINUE
00080          B( J ) = 0.D0
00081          R1( J ) = 0.D0
00082          R2( J ) = 0.D0
00083          W( J ) = 0.D0
00084          X( J ) = 0.D0
00085    20 CONTINUE
00086       ANRM = 1.D0
00087       OK = .TRUE.
00088 *
00089 *     Test error exits of the routines that use the Cholesky
00090 *     decomposition of a Hermitian positive definite matrix.
00091 *
00092       IF( LSAMEN( 2, C2, 'PO' ) ) THEN
00093 *
00094 *        ZPOTRF
00095 *
00096          SRNAMT = 'ZPOTRF'
00097          INFOT = 1
00098          CALL ZPOTRF( '/', 0, A, 1, INFO )
00099          CALL CHKXER( 'ZPOTRF', INFOT, NOUT, LERR, OK )
00100          INFOT = 2
00101          CALL ZPOTRF( 'U', -1, A, 1, INFO )
00102          CALL CHKXER( 'ZPOTRF', INFOT, NOUT, LERR, OK )
00103          INFOT = 4
00104          CALL ZPOTRF( 'U', 2, A, 1, INFO )
00105          CALL CHKXER( 'ZPOTRF', INFOT, NOUT, LERR, OK )
00106 *
00107 *        ZPOTF2
00108 *
00109          SRNAMT = 'ZPOTF2'
00110          INFOT = 1
00111          CALL ZPOTF2( '/', 0, A, 1, INFO )
00112          CALL CHKXER( 'ZPOTF2', INFOT, NOUT, LERR, OK )
00113          INFOT = 2
00114          CALL ZPOTF2( 'U', -1, A, 1, INFO )
00115          CALL CHKXER( 'ZPOTF2', INFOT, NOUT, LERR, OK )
00116          INFOT = 4
00117          CALL ZPOTF2( 'U', 2, A, 1, INFO )
00118          CALL CHKXER( 'ZPOTF2', INFOT, NOUT, LERR, OK )
00119 *
00120 *        ZPOTRI
00121 *
00122          SRNAMT = 'ZPOTRI'
00123          INFOT = 1
00124          CALL ZPOTRI( '/', 0, A, 1, INFO )
00125          CALL CHKXER( 'ZPOTRI', INFOT, NOUT, LERR, OK )
00126          INFOT = 2
00127          CALL ZPOTRI( 'U', -1, A, 1, INFO )
00128          CALL CHKXER( 'ZPOTRI', INFOT, NOUT, LERR, OK )
00129          INFOT = 4
00130          CALL ZPOTRI( 'U', 2, A, 1, INFO )
00131          CALL CHKXER( 'ZPOTRI', INFOT, NOUT, LERR, OK )
00132 *
00133 *        ZPOTRS
00134 *
00135          SRNAMT = 'ZPOTRS'
00136          INFOT = 1
00137          CALL ZPOTRS( '/', 0, 0, A, 1, B, 1, INFO )
00138          CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
00139          INFOT = 2
00140          CALL ZPOTRS( 'U', -1, 0, A, 1, B, 1, INFO )
00141          CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
00142          INFOT = 3
00143          CALL ZPOTRS( 'U', 0, -1, A, 1, B, 1, INFO )
00144          CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
00145          INFOT = 5
00146          CALL ZPOTRS( 'U', 2, 1, A, 1, B, 2, INFO )
00147          CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
00148          INFOT = 7
00149          CALL ZPOTRS( 'U', 2, 1, A, 2, B, 1, INFO )
00150          CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
00151 *
00152 *        ZPORFS
00153 *
00154          SRNAMT = 'ZPORFS'
00155          INFOT = 1
00156          CALL ZPORFS( '/', 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
00157      $                INFO )
00158          CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
00159          INFOT = 2
00160          CALL ZPORFS( 'U', -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
00161      $                INFO )
00162          CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
00163          INFOT = 3
00164          CALL ZPORFS( 'U', 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
00165      $                INFO )
00166          CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
00167          INFOT = 5
00168          CALL ZPORFS( 'U', 2, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, R,
00169      $                INFO )
00170          CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
00171          INFOT = 7
00172          CALL ZPORFS( 'U', 2, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, R,
00173      $                INFO )
00174          CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
00175          INFOT = 9
00176          CALL ZPORFS( 'U', 2, 1, A, 2, AF, 2, B, 1, X, 2, R1, R2, W, R,
00177      $                INFO )
00178          CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
00179          INFOT = 11
00180          CALL ZPORFS( 'U', 2, 1, A, 2, AF, 2, B, 2, X, 1, R1, R2, W, R,
00181      $                INFO )
00182          CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
00183 *
00184 *        ZPOCON
00185 *
00186          SRNAMT = 'ZPOCON'
00187          INFOT = 1
00188          CALL ZPOCON( '/', 0, A, 1, ANRM, RCOND, W, R, INFO )
00189          CALL CHKXER( 'ZPOCON', INFOT, NOUT, LERR, OK )
00190          INFOT = 2
00191          CALL ZPOCON( 'U', -1, A, 1, ANRM, RCOND, W, R, INFO )
00192          CALL CHKXER( 'ZPOCON', INFOT, NOUT, LERR, OK )
00193          INFOT = 4
00194          CALL ZPOCON( 'U', 2, A, 1, ANRM, RCOND, W, R, INFO )
00195          CALL CHKXER( 'ZPOCON', INFOT, NOUT, LERR, OK )
00196          INFOT = 5
00197          CALL ZPOCON( 'U', 1, A, 1, -ANRM, RCOND, W, R, INFO )
00198          CALL CHKXER( 'ZPOCON', INFOT, NOUT, LERR, OK )
00199 *
00200 *        ZPOEQU
00201 *
00202          SRNAMT = 'ZPOEQU'
00203          INFOT = 1
00204          CALL ZPOEQU( -1, A, 1, R1, RCOND, ANRM, INFO )
00205          CALL CHKXER( 'ZPOEQU', INFOT, NOUT, LERR, OK )
00206          INFOT = 3
00207          CALL ZPOEQU( 2, A, 1, R1, RCOND, ANRM, INFO )
00208          CALL CHKXER( 'ZPOEQU', INFOT, NOUT, LERR, OK )
00209 *
00210 *     Test error exits of the routines that use the Cholesky
00211 *     decomposition of a Hermitian positive definite packed matrix.
00212 *
00213       ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN
00214 *
00215 *        ZPPTRF
00216 *
00217          SRNAMT = 'ZPPTRF'
00218          INFOT = 1
00219          CALL ZPPTRF( '/', 0, A, INFO )
00220          CALL CHKXER( 'ZPPTRF', INFOT, NOUT, LERR, OK )
00221          INFOT = 2
00222          CALL ZPPTRF( 'U', -1, A, INFO )
00223          CALL CHKXER( 'ZPPTRF', INFOT, NOUT, LERR, OK )
00224 *
00225 *        ZPPTRI
00226 *
00227          SRNAMT = 'ZPPTRI'
00228          INFOT = 1
00229          CALL ZPPTRI( '/', 0, A, INFO )
00230          CALL CHKXER( 'ZPPTRI', INFOT, NOUT, LERR, OK )
00231          INFOT = 2
00232          CALL ZPPTRI( 'U', -1, A, INFO )
00233          CALL CHKXER( 'ZPPTRI', INFOT, NOUT, LERR, OK )
00234 *
00235 *        ZPPTRS
00236 *
00237          SRNAMT = 'ZPPTRS'
00238          INFOT = 1
00239          CALL ZPPTRS( '/', 0, 0, A, B, 1, INFO )
00240          CALL CHKXER( 'ZPPTRS', INFOT, NOUT, LERR, OK )
00241          INFOT = 2
00242          CALL ZPPTRS( 'U', -1, 0, A, B, 1, INFO )
00243          CALL CHKXER( 'ZPPTRS', INFOT, NOUT, LERR, OK )
00244          INFOT = 3
00245          CALL ZPPTRS( 'U', 0, -1, A, B, 1, INFO )
00246          CALL CHKXER( 'ZPPTRS', INFOT, NOUT, LERR, OK )
00247          INFOT = 6
00248          CALL ZPPTRS( 'U', 2, 1, A, B, 1, INFO )
00249          CALL CHKXER( 'ZPPTRS', INFOT, NOUT, LERR, OK )
00250 *
00251 *        ZPPRFS
00252 *
00253          SRNAMT = 'ZPPRFS'
00254          INFOT = 1
00255          CALL ZPPRFS( '/', 0, 0, A, AF, B, 1, X, 1, R1, R2, W, R, INFO )
00256          CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
00257          INFOT = 2
00258          CALL ZPPRFS( 'U', -1, 0, A, AF, B, 1, X, 1, R1, R2, W, R,
00259      $                INFO )
00260          CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
00261          INFOT = 3
00262          CALL ZPPRFS( 'U', 0, -1, A, AF, B, 1, X, 1, R1, R2, W, R,
00263      $                INFO )
00264          CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
00265          INFOT = 7
00266          CALL ZPPRFS( 'U', 2, 1, A, AF, B, 1, X, 2, R1, R2, W, R, INFO )
00267          CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
00268          INFOT = 9
00269          CALL ZPPRFS( 'U', 2, 1, A, AF, B, 2, X, 1, R1, R2, W, R, INFO )
00270          CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
00271 *
00272 *        ZPPCON
00273 *
00274          SRNAMT = 'ZPPCON'
00275          INFOT = 1
00276          CALL ZPPCON( '/', 0, A, ANRM, RCOND, W, R, INFO )
00277          CALL CHKXER( 'ZPPCON', INFOT, NOUT, LERR, OK )
00278          INFOT = 2
00279          CALL ZPPCON( 'U', -1, A, ANRM, RCOND, W, R, INFO )
00280          CALL CHKXER( 'ZPPCON', INFOT, NOUT, LERR, OK )
00281          INFOT = 4
00282          CALL ZPPCON( 'U', 1, A, -ANRM, RCOND, W, R, INFO )
00283          CALL CHKXER( 'ZPPCON', INFOT, NOUT, LERR, OK )
00284 *
00285 *        ZPPEQU
00286 *
00287          SRNAMT = 'ZPPEQU'
00288          INFOT = 1
00289          CALL ZPPEQU( '/', 0, A, R1, RCOND, ANRM, INFO )
00290          CALL CHKXER( 'ZPPEQU', INFOT, NOUT, LERR, OK )
00291          INFOT = 2
00292          CALL ZPPEQU( 'U', -1, A, R1, RCOND, ANRM, INFO )
00293          CALL CHKXER( 'ZPPEQU', INFOT, NOUT, LERR, OK )
00294 *
00295 *     Test error exits of the routines that use the Cholesky
00296 *     decomposition of a Hermitian positive definite band matrix.
00297 *
00298       ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN
00299 *
00300 *        ZPBTRF
00301 *
00302          SRNAMT = 'ZPBTRF'
00303          INFOT = 1
00304          CALL ZPBTRF( '/', 0, 0, A, 1, INFO )
00305          CALL CHKXER( 'ZPBTRF', INFOT, NOUT, LERR, OK )
00306          INFOT = 2
00307          CALL ZPBTRF( 'U', -1, 0, A, 1, INFO )
00308          CALL CHKXER( 'ZPBTRF', INFOT, NOUT, LERR, OK )
00309          INFOT = 3
00310          CALL ZPBTRF( 'U', 1, -1, A, 1, INFO )
00311          CALL CHKXER( 'ZPBTRF', INFOT, NOUT, LERR, OK )
00312          INFOT = 5
00313          CALL ZPBTRF( 'U', 2, 1, A, 1, INFO )
00314          CALL CHKXER( 'ZPBTRF', INFOT, NOUT, LERR, OK )
00315 *
00316 *        ZPBTF2
00317 *
00318          SRNAMT = 'ZPBTF2'
00319          INFOT = 1
00320          CALL ZPBTF2( '/', 0, 0, A, 1, INFO )
00321          CALL CHKXER( 'ZPBTF2', INFOT, NOUT, LERR, OK )
00322          INFOT = 2
00323          CALL ZPBTF2( 'U', -1, 0, A, 1, INFO )
00324          CALL CHKXER( 'ZPBTF2', INFOT, NOUT, LERR, OK )
00325          INFOT = 3
00326          CALL ZPBTF2( 'U', 1, -1, A, 1, INFO )
00327          CALL CHKXER( 'ZPBTF2', INFOT, NOUT, LERR, OK )
00328          INFOT = 5
00329          CALL ZPBTF2( 'U', 2, 1, A, 1, INFO )
00330          CALL CHKXER( 'ZPBTF2', INFOT, NOUT, LERR, OK )
00331 *
00332 *        ZPBTRS
00333 *
00334          SRNAMT = 'ZPBTRS'
00335          INFOT = 1
00336          CALL ZPBTRS( '/', 0, 0, 0, A, 1, B, 1, INFO )
00337          CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
00338          INFOT = 2
00339          CALL ZPBTRS( 'U', -1, 0, 0, A, 1, B, 1, INFO )
00340          CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
00341          INFOT = 3
00342          CALL ZPBTRS( 'U', 1, -1, 0, A, 1, B, 1, INFO )
00343          CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
00344          INFOT = 4
00345          CALL ZPBTRS( 'U', 0, 0, -1, A, 1, B, 1, INFO )
00346          CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
00347          INFOT = 6
00348          CALL ZPBTRS( 'U', 2, 1, 1, A, 1, B, 1, INFO )
00349          CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
00350          INFOT = 8
00351          CALL ZPBTRS( 'U', 2, 0, 1, A, 1, B, 1, INFO )
00352          CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
00353 *
00354 *        ZPBRFS
00355 *
00356          SRNAMT = 'ZPBRFS'
00357          INFOT = 1
00358          CALL ZPBRFS( '/', 0, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00359      $                R, INFO )
00360          CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
00361          INFOT = 2
00362          CALL ZPBRFS( 'U', -1, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00363      $                R, INFO )
00364          CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
00365          INFOT = 3
00366          CALL ZPBRFS( 'U', 1, -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00367      $                R, INFO )
00368          CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
00369          INFOT = 4
00370          CALL ZPBRFS( 'U', 0, 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00371      $                R, INFO )
00372          CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
00373          INFOT = 6
00374          CALL ZPBRFS( 'U', 2, 1, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W,
00375      $                R, INFO )
00376          CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
00377          INFOT = 8
00378          CALL ZPBRFS( 'U', 2, 1, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W,
00379      $                R, INFO )
00380          CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
00381          INFOT = 10
00382          CALL ZPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 1, X, 2, R1, R2, W,
00383      $                R, INFO )
00384          CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
00385          INFOT = 12
00386          CALL ZPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 2, X, 1, R1, R2, W,
00387      $                R, INFO )
00388          CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
00389 *
00390 *        ZPBCON
00391 *
00392          SRNAMT = 'ZPBCON'
00393          INFOT = 1
00394          CALL ZPBCON( '/', 0, 0, A, 1, ANRM, RCOND, W, R, INFO )
00395          CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
00396          INFOT = 2
00397          CALL ZPBCON( 'U', -1, 0, A, 1, ANRM, RCOND, W, R, INFO )
00398          CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
00399          INFOT = 3
00400          CALL ZPBCON( 'U', 1, -1, A, 1, ANRM, RCOND, W, R, INFO )
00401          CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
00402          INFOT = 5
00403          CALL ZPBCON( 'U', 2, 1, A, 1, ANRM, RCOND, W, R, INFO )
00404          CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
00405          INFOT = 6
00406          CALL ZPBCON( 'U', 1, 0, A, 1, -ANRM, RCOND, W, R, INFO )
00407          CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
00408 *
00409 *        ZPBEQU
00410 *
00411          SRNAMT = 'ZPBEQU'
00412          INFOT = 1
00413          CALL ZPBEQU( '/', 0, 0, A, 1, R1, RCOND, ANRM, INFO )
00414          CALL CHKXER( 'ZPBEQU', INFOT, NOUT, LERR, OK )
00415          INFOT = 2
00416          CALL ZPBEQU( 'U', -1, 0, A, 1, R1, RCOND, ANRM, INFO )
00417          CALL CHKXER( 'ZPBEQU', INFOT, NOUT, LERR, OK )
00418          INFOT = 3
00419          CALL ZPBEQU( 'U', 1, -1, A, 1, R1, RCOND, ANRM, INFO )
00420          CALL CHKXER( 'ZPBEQU', INFOT, NOUT, LERR, OK )
00421          INFOT = 5
00422          CALL ZPBEQU( 'U', 2, 1, A, 1, R1, RCOND, ANRM, INFO )
00423          CALL CHKXER( 'ZPBEQU', INFOT, NOUT, LERR, OK )
00424       END IF
00425 *
00426 *     Print a summary line.
00427 *
00428       CALL ALAESM( PATH, OK, NOUT )
00429 *
00430       RETURN
00431 *
00432 *     End of ZERRPO
00433 *
00434       END