LAPACK: TESTING/LIN/cerrpo.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CERRPO( 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 *  CERRPO tests the error exits for the COMPLEX 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       REAL               ANRM, RCOND
00037 *     ..
00038 *     .. Local Arrays ..
00039       REAL               R( NMAX ), R1( NMAX ), R2( NMAX )
00040       COMPLEX            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, CPBCON, CPBEQU, CPBRFS, CPBTF2,
00049      $                   CPBTRF, CPBTRS, CPOCON, CPOEQU, CPORFS, CPOTF2,
00050      $                   CPOTRF, CPOTRI, CPOTRS, CPPCON, CPPEQU, CPPRFS,
00051      $                   CPPTRF, CPPTRI, CPPTRS
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          CMPLX, REAL
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 ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
00076             AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
00077    10    CONTINUE
00078          B( J ) = 0.
00079          R1( J ) = 0.
00080          R2( J ) = 0.
00081          W( J ) = 0.
00082          X( J ) = 0.
00083    20 CONTINUE
00084       ANRM = 1.
00085       OK = .TRUE.
00086 *
00087 *     Test error exits of the routines that use the Cholesky
00088 *     decomposition of a Hermitian positive definite matrix.
00089 *
00090       IF( LSAMEN( 2, C2, 'PO' ) ) THEN
00091 *
00092 *        CPOTRF
00093 *
00094          SRNAMT = 'CPOTRF'
00095          INFOT = 1
00096          CALL CPOTRF( '/', 0, A, 1, INFO )
00097          CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK )
00098          INFOT = 2
00099          CALL CPOTRF( 'U', -1, A, 1, INFO )
00100          CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK )
00101          INFOT = 4
00102          CALL CPOTRF( 'U', 2, A, 1, INFO )
00103          CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK )
00104 *
00105 *        CPOTF2
00106 *
00107          SRNAMT = 'CPOTF2'
00108          INFOT = 1
00109          CALL CPOTF2( '/', 0, A, 1, INFO )
00110          CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK )
00111          INFOT = 2
00112          CALL CPOTF2( 'U', -1, A, 1, INFO )
00113          CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK )
00114          INFOT = 4
00115          CALL CPOTF2( 'U', 2, A, 1, INFO )
00116          CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK )
00117 *
00118 *        CPOTRI
00119 *
00120          SRNAMT = 'CPOTRI'
00121          INFOT = 1
00122          CALL CPOTRI( '/', 0, A, 1, INFO )
00123          CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK )
00124          INFOT = 2
00125          CALL CPOTRI( 'U', -1, A, 1, INFO )
00126          CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK )
00127          INFOT = 4
00128          CALL CPOTRI( 'U', 2, A, 1, INFO )
00129          CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK )
00130 *
00131 *        CPOTRS
00132 *
00133          SRNAMT = 'CPOTRS'
00134          INFOT = 1
00135          CALL CPOTRS( '/', 0, 0, A, 1, B, 1, INFO )
00136          CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
00137          INFOT = 2
00138          CALL CPOTRS( 'U', -1, 0, A, 1, B, 1, INFO )
00139          CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
00140          INFOT = 3
00141          CALL CPOTRS( 'U', 0, -1, A, 1, B, 1, INFO )
00142          CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
00143          INFOT = 5
00144          CALL CPOTRS( 'U', 2, 1, A, 1, B, 2, INFO )
00145          CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
00146          INFOT = 7
00147          CALL CPOTRS( 'U', 2, 1, A, 2, B, 1, INFO )
00148          CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
00149 *
00150 *        CPORFS
00151 *
00152          SRNAMT = 'CPORFS'
00153          INFOT = 1
00154          CALL CPORFS( '/', 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
00155      $                INFO )
00156          CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
00157          INFOT = 2
00158          CALL CPORFS( 'U', -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
00159      $                INFO )
00160          CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
00161          INFOT = 3
00162          CALL CPORFS( 'U', 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
00163      $                INFO )
00164          CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
00165          INFOT = 5
00166          CALL CPORFS( 'U', 2, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, R,
00167      $                INFO )
00168          CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
00169          INFOT = 7
00170          CALL CPORFS( 'U', 2, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, R,
00171      $                INFO )
00172          CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
00173          INFOT = 9
00174          CALL CPORFS( 'U', 2, 1, A, 2, AF, 2, B, 1, X, 2, R1, R2, W, R,
00175      $                INFO )
00176          CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
00177          INFOT = 11
00178          CALL CPORFS( 'U', 2, 1, A, 2, AF, 2, B, 2, X, 1, R1, R2, W, R,
00179      $                INFO )
00180          CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
00181 *
00182 *        CPOCON
00183 *
00184          SRNAMT = 'CPOCON'
00185          INFOT = 1
00186          CALL CPOCON( '/', 0, A, 1, ANRM, RCOND, W, R, INFO )
00187          CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK )
00188          INFOT = 2
00189          CALL CPOCON( 'U', -1, A, 1, ANRM, RCOND, W, R, INFO )
00190          CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK )
00191          INFOT = 4
00192          CALL CPOCON( 'U', 2, A, 1, ANRM, RCOND, W, R, INFO )
00193          CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK )
00194          INFOT = 5
00195          CALL CPOCON( 'U', 1, A, 1, -ANRM, RCOND, W, R, INFO )
00196          CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK )
00197 *
00198 *        CPOEQU
00199 *
00200          SRNAMT = 'CPOEQU'
00201          INFOT = 1
00202          CALL CPOEQU( -1, A, 1, R1, RCOND, ANRM, INFO )
00203          CALL CHKXER( 'CPOEQU', INFOT, NOUT, LERR, OK )
00204          INFOT = 3
00205          CALL CPOEQU( 2, A, 1, R1, RCOND, ANRM, INFO )
00206          CALL CHKXER( 'CPOEQU', INFOT, NOUT, LERR, OK )
00207 *
00208 *     Test error exits of the routines that use the Cholesky
00209 *     decomposition of a Hermitian positive definite packed matrix.
00210 *
00211       ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN
00212 *
00213 *        CPPTRF
00214 *
00215          SRNAMT = 'CPPTRF'
00216          INFOT = 1
00217          CALL CPPTRF( '/', 0, A, INFO )
00218          CALL CHKXER( 'CPPTRF', INFOT, NOUT, LERR, OK )
00219          INFOT = 2
00220          CALL CPPTRF( 'U', -1, A, INFO )
00221          CALL CHKXER( 'CPPTRF', INFOT, NOUT, LERR, OK )
00222 *
00223 *        CPPTRI
00224 *
00225          SRNAMT = 'CPPTRI'
00226          INFOT = 1
00227          CALL CPPTRI( '/', 0, A, INFO )
00228          CALL CHKXER( 'CPPTRI', INFOT, NOUT, LERR, OK )
00229          INFOT = 2
00230          CALL CPPTRI( 'U', -1, A, INFO )
00231          CALL CHKXER( 'CPPTRI', INFOT, NOUT, LERR, OK )
00232 *
00233 *        CPPTRS
00234 *
00235          SRNAMT = 'CPPTRS'
00236          INFOT = 1
00237          CALL CPPTRS( '/', 0, 0, A, B, 1, INFO )
00238          CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK )
00239          INFOT = 2
00240          CALL CPPTRS( 'U', -1, 0, A, B, 1, INFO )
00241          CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK )
00242          INFOT = 3
00243          CALL CPPTRS( 'U', 0, -1, A, B, 1, INFO )
00244          CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK )
00245          INFOT = 6
00246          CALL CPPTRS( 'U', 2, 1, A, B, 1, INFO )
00247          CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK )
00248 *
00249 *        CPPRFS
00250 *
00251          SRNAMT = 'CPPRFS'
00252          INFOT = 1
00253          CALL CPPRFS( '/', 0, 0, A, AF, B, 1, X, 1, R1, R2, W, R, INFO )
00254          CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
00255          INFOT = 2
00256          CALL CPPRFS( 'U', -1, 0, A, AF, B, 1, X, 1, R1, R2, W, R,
00257      $                INFO )
00258          CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
00259          INFOT = 3
00260          CALL CPPRFS( 'U', 0, -1, A, AF, B, 1, X, 1, R1, R2, W, R,
00261      $                INFO )
00262          CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
00263          INFOT = 7
00264          CALL CPPRFS( 'U', 2, 1, A, AF, B, 1, X, 2, R1, R2, W, R, INFO )
00265          CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
00266          INFOT = 9
00267          CALL CPPRFS( 'U', 2, 1, A, AF, B, 2, X, 1, R1, R2, W, R, INFO )
00268          CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
00269 *
00270 *        CPPCON
00271 *
00272          SRNAMT = 'CPPCON'
00273          INFOT = 1
00274          CALL CPPCON( '/', 0, A, ANRM, RCOND, W, R, INFO )
00275          CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK )
00276          INFOT = 2
00277          CALL CPPCON( 'U', -1, A, ANRM, RCOND, W, R, INFO )
00278          CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK )
00279          INFOT = 4
00280          CALL CPPCON( 'U', 1, A, -ANRM, RCOND, W, R, INFO )
00281          CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK )
00282 *
00283 *        CPPEQU
00284 *
00285          SRNAMT = 'CPPEQU'
00286          INFOT = 1
00287          CALL CPPEQU( '/', 0, A, R1, RCOND, ANRM, INFO )
00288          CALL CHKXER( 'CPPEQU', INFOT, NOUT, LERR, OK )
00289          INFOT = 2
00290          CALL CPPEQU( 'U', -1, A, R1, RCOND, ANRM, INFO )
00291          CALL CHKXER( 'CPPEQU', INFOT, NOUT, LERR, OK )
00292 *
00293 *     Test error exits of the routines that use the Cholesky
00294 *     decomposition of a Hermitian positive definite band matrix.
00295 *
00296       ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN
00297 *
00298 *        CPBTRF
00299 *
00300          SRNAMT = 'CPBTRF'
00301          INFOT = 1
00302          CALL CPBTRF( '/', 0, 0, A, 1, INFO )
00303          CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK )
00304          INFOT = 2
00305          CALL CPBTRF( 'U', -1, 0, A, 1, INFO )
00306          CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK )
00307          INFOT = 3
00308          CALL CPBTRF( 'U', 1, -1, A, 1, INFO )
00309          CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK )
00310          INFOT = 5
00311          CALL CPBTRF( 'U', 2, 1, A, 1, INFO )
00312          CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK )
00313 *
00314 *        CPBTF2
00315 *
00316          SRNAMT = 'CPBTF2'
00317          INFOT = 1
00318          CALL CPBTF2( '/', 0, 0, A, 1, INFO )
00319          CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK )
00320          INFOT = 2
00321          CALL CPBTF2( 'U', -1, 0, A, 1, INFO )
00322          CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK )
00323          INFOT = 3
00324          CALL CPBTF2( 'U', 1, -1, A, 1, INFO )
00325          CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK )
00326          INFOT = 5
00327          CALL CPBTF2( 'U', 2, 1, A, 1, INFO )
00328          CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK )
00329 *
00330 *        CPBTRS
00331 *
00332          SRNAMT = 'CPBTRS'
00333          INFOT = 1
00334          CALL CPBTRS( '/', 0, 0, 0, A, 1, B, 1, INFO )
00335          CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
00336          INFOT = 2
00337          CALL CPBTRS( 'U', -1, 0, 0, A, 1, B, 1, INFO )
00338          CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
00339          INFOT = 3
00340          CALL CPBTRS( 'U', 1, -1, 0, A, 1, B, 1, INFO )
00341          CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
00342          INFOT = 4
00343          CALL CPBTRS( 'U', 0, 0, -1, A, 1, B, 1, INFO )
00344          CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
00345          INFOT = 6
00346          CALL CPBTRS( 'U', 2, 1, 1, A, 1, B, 1, INFO )
00347          CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
00348          INFOT = 8
00349          CALL CPBTRS( 'U', 2, 0, 1, A, 1, B, 1, INFO )
00350          CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
00351 *
00352 *        CPBRFS
00353 *
00354          SRNAMT = 'CPBRFS'
00355          INFOT = 1
00356          CALL CPBRFS( '/', 0, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00357      $                R, INFO )
00358          CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
00359          INFOT = 2
00360          CALL CPBRFS( 'U', -1, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00361      $                R, INFO )
00362          CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
00363          INFOT = 3
00364          CALL CPBRFS( 'U', 1, -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00365      $                R, INFO )
00366          CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
00367          INFOT = 4
00368          CALL CPBRFS( 'U', 0, 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00369      $                R, INFO )
00370          CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
00371          INFOT = 6
00372          CALL CPBRFS( 'U', 2, 1, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W,
00373      $                R, INFO )
00374          CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
00375          INFOT = 8
00376          CALL CPBRFS( 'U', 2, 1, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W,
00377      $                R, INFO )
00378          CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
00379          INFOT = 10
00380          CALL CPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 1, X, 2, R1, R2, W,
00381      $                R, INFO )
00382          CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
00383          INFOT = 12
00384          CALL CPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 2, X, 1, R1, R2, W,
00385      $                R, INFO )
00386          CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
00387 *
00388 *        CPBCON
00389 *
00390          SRNAMT = 'CPBCON'
00391          INFOT = 1
00392          CALL CPBCON( '/', 0, 0, A, 1, ANRM, RCOND, W, R, INFO )
00393          CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
00394          INFOT = 2
00395          CALL CPBCON( 'U', -1, 0, A, 1, ANRM, RCOND, W, R, INFO )
00396          CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
00397          INFOT = 3
00398          CALL CPBCON( 'U', 1, -1, A, 1, ANRM, RCOND, W, R, INFO )
00399          CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
00400          INFOT = 5
00401          CALL CPBCON( 'U', 2, 1, A, 1, ANRM, RCOND, W, R, INFO )
00402          CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
00403          INFOT = 6
00404          CALL CPBCON( 'U', 1, 0, A, 1, -ANRM, RCOND, W, R, INFO )
00405          CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
00406 *
00407 *        CPBEQU
00408 *
00409          SRNAMT = 'CPBEQU'
00410          INFOT = 1
00411          CALL CPBEQU( '/', 0, 0, A, 1, R1, RCOND, ANRM, INFO )
00412          CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK )
00413          INFOT = 2
00414          CALL CPBEQU( 'U', -1, 0, A, 1, R1, RCOND, ANRM, INFO )
00415          CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK )
00416          INFOT = 3
00417          CALL CPBEQU( 'U', 1, -1, A, 1, R1, RCOND, ANRM, INFO )
00418          CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK )
00419          INFOT = 5
00420          CALL CPBEQU( 'U', 2, 1, A, 1, R1, RCOND, ANRM, INFO )
00421          CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK )
00422       END IF
00423 *
00424 *     Print a summary line.
00425 *
00426       CALL ALAESM( PATH, OK, NOUT )
00427 *
00428       RETURN
00429 *
00430 *     End of CERRPO
00431 *
00432       END