LAPACK: TESTING/LIN/serrpo.f Source File

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