LAPACK 3.3.1
Linear Algebra PACKage

derrpo.f

Go to the documentation of this file.
00001       SUBROUTINE DERRPO( 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 *  DERRPO tests the error exits for the DOUBLE PRECISION 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       DOUBLE PRECISION   ANRM, RCOND
00037 *     ..
00038 *     .. Local Arrays ..
00039       INTEGER            IW( NMAX )
00040       DOUBLE PRECISION   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, DPBCON, DPBEQU, DPBRFS, DPBTF2,
00049      $                   DPBTRF, DPBTRS, DPOCON, DPOEQU, DPORFS, DPOTF2,
00050      $                   DPOTRF, DPOTRI, DPOTRS, DPPCON, DPPEQU, DPPRFS,
00051      $                   DPPTRF, DPPTRI, DPPTRS
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
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.D0 / DBLE( I+J )
00076             AF( I, J ) = 1.D0 / DBLE( I+J )
00077    10    CONTINUE
00078          B( J ) = 0.D0
00079          R1( J ) = 0.D0
00080          R2( J ) = 0.D0
00081          W( J ) = 0.D0
00082          X( J ) = 0.D0
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 *        DPOTRF
00093 *
00094          SRNAMT = 'DPOTRF'
00095          INFOT = 1
00096          CALL DPOTRF( '/', 0, A, 1, INFO )
00097          CALL CHKXER( 'DPOTRF', INFOT, NOUT, LERR, OK )
00098          INFOT = 2
00099          CALL DPOTRF( 'U', -1, A, 1, INFO )
00100          CALL CHKXER( 'DPOTRF', INFOT, NOUT, LERR, OK )
00101          INFOT = 4
00102          CALL DPOTRF( 'U', 2, A, 1, INFO )
00103          CALL CHKXER( 'DPOTRF', INFOT, NOUT, LERR, OK )
00104 *
00105 *        DPOTF2
00106 *
00107          SRNAMT = 'DPOTF2'
00108          INFOT = 1
00109          CALL DPOTF2( '/', 0, A, 1, INFO )
00110          CALL CHKXER( 'DPOTF2', INFOT, NOUT, LERR, OK )
00111          INFOT = 2
00112          CALL DPOTF2( 'U', -1, A, 1, INFO )
00113          CALL CHKXER( 'DPOTF2', INFOT, NOUT, LERR, OK )
00114          INFOT = 4
00115          CALL DPOTF2( 'U', 2, A, 1, INFO )
00116          CALL CHKXER( 'DPOTF2', INFOT, NOUT, LERR, OK )
00117 *
00118 *        DPOTRI
00119 *
00120          SRNAMT = 'DPOTRI'
00121          INFOT = 1
00122          CALL DPOTRI( '/', 0, A, 1, INFO )
00123          CALL CHKXER( 'DPOTRI', INFOT, NOUT, LERR, OK )
00124          INFOT = 2
00125          CALL DPOTRI( 'U', -1, A, 1, INFO )
00126          CALL CHKXER( 'DPOTRI', INFOT, NOUT, LERR, OK )
00127          INFOT = 4
00128          CALL DPOTRI( 'U', 2, A, 1, INFO )
00129          CALL CHKXER( 'DPOTRI', INFOT, NOUT, LERR, OK )
00130 *
00131 *        DPOTRS
00132 *
00133          SRNAMT = 'DPOTRS'
00134          INFOT = 1
00135          CALL DPOTRS( '/', 0, 0, A, 1, B, 1, INFO )
00136          CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK )
00137          INFOT = 2
00138          CALL DPOTRS( 'U', -1, 0, A, 1, B, 1, INFO )
00139          CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK )
00140          INFOT = 3
00141          CALL DPOTRS( 'U', 0, -1, A, 1, B, 1, INFO )
00142          CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK )
00143          INFOT = 5
00144          CALL DPOTRS( 'U', 2, 1, A, 1, B, 2, INFO )
00145          CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK )
00146          INFOT = 7
00147          CALL DPOTRS( 'U', 2, 1, A, 2, B, 1, INFO )
00148          CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK )
00149 *
00150 *        DPORFS
00151 *
00152          SRNAMT = 'DPORFS'
00153          INFOT = 1
00154          CALL DPORFS( '/', 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, IW,
00155      $                INFO )
00156          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
00157          INFOT = 2
00158          CALL DPORFS( 'U', -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00159      $                IW, INFO )
00160          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
00161          INFOT = 3
00162          CALL DPORFS( 'U', 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00163      $                IW, INFO )
00164          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
00165          INFOT = 5
00166          CALL DPORFS( 'U', 2, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, IW,
00167      $                INFO )
00168          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
00169          INFOT = 7
00170          CALL DPORFS( 'U', 2, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, IW,
00171      $                INFO )
00172          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
00173          INFOT = 9
00174          CALL DPORFS( 'U', 2, 1, A, 2, AF, 2, B, 1, X, 2, R1, R2, W, IW,
00175      $                INFO )
00176          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
00177          INFOT = 11
00178          CALL DPORFS( 'U', 2, 1, A, 2, AF, 2, B, 2, X, 1, R1, R2, W, IW,
00179      $                INFO )
00180          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
00181 *
00182 *        DPOCON
00183 *
00184          SRNAMT = 'DPOCON'
00185          INFOT = 1
00186          CALL DPOCON( '/', 0, A, 1, ANRM, RCOND, W, IW, INFO )
00187          CALL CHKXER( 'DPOCON', INFOT, NOUT, LERR, OK )
00188          INFOT = 2
00189          CALL DPOCON( 'U', -1, A, 1, ANRM, RCOND, W, IW, INFO )
00190          CALL CHKXER( 'DPOCON', INFOT, NOUT, LERR, OK )
00191          INFOT = 4
00192          CALL DPOCON( 'U', 2, A, 1, ANRM, RCOND, W, IW, INFO )
00193          CALL CHKXER( 'DPOCON', INFOT, NOUT, LERR, OK )
00194 *
00195 *        DPOEQU
00196 *
00197          SRNAMT = 'DPOEQU'
00198          INFOT = 1
00199          CALL DPOEQU( -1, A, 1, R1, RCOND, ANRM, INFO )
00200          CALL CHKXER( 'DPOEQU', INFOT, NOUT, LERR, OK )
00201          INFOT = 3
00202          CALL DPOEQU( 2, A, 1, R1, RCOND, ANRM, INFO )
00203          CALL CHKXER( 'DPOEQU', 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 *        DPPTRF
00211 *
00212          SRNAMT = 'DPPTRF'
00213          INFOT = 1
00214          CALL DPPTRF( '/', 0, A, INFO )
00215          CALL CHKXER( 'DPPTRF', INFOT, NOUT, LERR, OK )
00216          INFOT = 2
00217          CALL DPPTRF( 'U', -1, A, INFO )
00218          CALL CHKXER( 'DPPTRF', INFOT, NOUT, LERR, OK )
00219 *
00220 *        DPPTRI
00221 *
00222          SRNAMT = 'DPPTRI'
00223          INFOT = 1
00224          CALL DPPTRI( '/', 0, A, INFO )
00225          CALL CHKXER( 'DPPTRI', INFOT, NOUT, LERR, OK )
00226          INFOT = 2
00227          CALL DPPTRI( 'U', -1, A, INFO )
00228          CALL CHKXER( 'DPPTRI', INFOT, NOUT, LERR, OK )
00229 *
00230 *        DPPTRS
00231 *
00232          SRNAMT = 'DPPTRS'
00233          INFOT = 1
00234          CALL DPPTRS( '/', 0, 0, A, B, 1, INFO )
00235          CALL CHKXER( 'DPPTRS', INFOT, NOUT, LERR, OK )
00236          INFOT = 2
00237          CALL DPPTRS( 'U', -1, 0, A, B, 1, INFO )
00238          CALL CHKXER( 'DPPTRS', INFOT, NOUT, LERR, OK )
00239          INFOT = 3
00240          CALL DPPTRS( 'U', 0, -1, A, B, 1, INFO )
00241          CALL CHKXER( 'DPPTRS', INFOT, NOUT, LERR, OK )
00242          INFOT = 6
00243          CALL DPPTRS( 'U', 2, 1, A, B, 1, INFO )
00244          CALL CHKXER( 'DPPTRS', INFOT, NOUT, LERR, OK )
00245 *
00246 *        DPPRFS
00247 *
00248          SRNAMT = 'DPPRFS'
00249          INFOT = 1
00250          CALL DPPRFS( '/', 0, 0, A, AF, B, 1, X, 1, R1, R2, W, IW,
00251      $                INFO )
00252          CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK )
00253          INFOT = 2
00254          CALL DPPRFS( 'U', -1, 0, A, AF, B, 1, X, 1, R1, R2, W, IW,
00255      $                INFO )
00256          CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK )
00257          INFOT = 3
00258          CALL DPPRFS( 'U', 0, -1, A, AF, B, 1, X, 1, R1, R2, W, IW,
00259      $                INFO )
00260          CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK )
00261          INFOT = 7
00262          CALL DPPRFS( 'U', 2, 1, A, AF, B, 1, X, 2, R1, R2, W, IW,
00263      $                INFO )
00264          CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK )
00265          INFOT = 9
00266          CALL DPPRFS( 'U', 2, 1, A, AF, B, 2, X, 1, R1, R2, W, IW,
00267      $                INFO )
00268          CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK )
00269 *
00270 *        DPPCON
00271 *
00272          SRNAMT = 'DPPCON'
00273          INFOT = 1
00274          CALL DPPCON( '/', 0, A, ANRM, RCOND, W, IW, INFO )
00275          CALL CHKXER( 'DPPCON', INFOT, NOUT, LERR, OK )
00276          INFOT = 2
00277          CALL DPPCON( 'U', -1, A, ANRM, RCOND, W, IW, INFO )
00278          CALL CHKXER( 'DPPCON', INFOT, NOUT, LERR, OK )
00279 *
00280 *        DPPEQU
00281 *
00282          SRNAMT = 'DPPEQU'
00283          INFOT = 1
00284          CALL DPPEQU( '/', 0, A, R1, RCOND, ANRM, INFO )
00285          CALL CHKXER( 'DPPEQU', INFOT, NOUT, LERR, OK )
00286          INFOT = 2
00287          CALL DPPEQU( 'U', -1, A, R1, RCOND, ANRM, INFO )
00288          CALL CHKXER( 'DPPEQU', 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 *        DPBTRF
00296 *
00297          SRNAMT = 'DPBTRF'
00298          INFOT = 1
00299          CALL DPBTRF( '/', 0, 0, A, 1, INFO )
00300          CALL CHKXER( 'DPBTRF', INFOT, NOUT, LERR, OK )
00301          INFOT = 2
00302          CALL DPBTRF( 'U', -1, 0, A, 1, INFO )
00303          CALL CHKXER( 'DPBTRF', INFOT, NOUT, LERR, OK )
00304          INFOT = 3
00305          CALL DPBTRF( 'U', 1, -1, A, 1, INFO )
00306          CALL CHKXER( 'DPBTRF', INFOT, NOUT, LERR, OK )
00307          INFOT = 5
00308          CALL DPBTRF( 'U', 2, 1, A, 1, INFO )
00309          CALL CHKXER( 'DPBTRF', INFOT, NOUT, LERR, OK )
00310 *
00311 *        DPBTF2
00312 *
00313          SRNAMT = 'DPBTF2'
00314          INFOT = 1
00315          CALL DPBTF2( '/', 0, 0, A, 1, INFO )
00316          CALL CHKXER( 'DPBTF2', INFOT, NOUT, LERR, OK )
00317          INFOT = 2
00318          CALL DPBTF2( 'U', -1, 0, A, 1, INFO )
00319          CALL CHKXER( 'DPBTF2', INFOT, NOUT, LERR, OK )
00320          INFOT = 3
00321          CALL DPBTF2( 'U', 1, -1, A, 1, INFO )
00322          CALL CHKXER( 'DPBTF2', INFOT, NOUT, LERR, OK )
00323          INFOT = 5
00324          CALL DPBTF2( 'U', 2, 1, A, 1, INFO )
00325          CALL CHKXER( 'DPBTF2', INFOT, NOUT, LERR, OK )
00326 *
00327 *        DPBTRS
00328 *
00329          SRNAMT = 'DPBTRS'
00330          INFOT = 1
00331          CALL DPBTRS( '/', 0, 0, 0, A, 1, B, 1, INFO )
00332          CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK )
00333          INFOT = 2
00334          CALL DPBTRS( 'U', -1, 0, 0, A, 1, B, 1, INFO )
00335          CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK )
00336          INFOT = 3
00337          CALL DPBTRS( 'U', 1, -1, 0, A, 1, B, 1, INFO )
00338          CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK )
00339          INFOT = 4
00340          CALL DPBTRS( 'U', 0, 0, -1, A, 1, B, 1, INFO )
00341          CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK )
00342          INFOT = 6
00343          CALL DPBTRS( 'U', 2, 1, 1, A, 1, B, 1, INFO )
00344          CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK )
00345          INFOT = 8
00346          CALL DPBTRS( 'U', 2, 0, 1, A, 1, B, 1, INFO )
00347          CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK )
00348 *
00349 *        DPBRFS
00350 *
00351          SRNAMT = 'DPBRFS'
00352          INFOT = 1
00353          CALL DPBRFS( '/', 0, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00354      $                IW, INFO )
00355          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
00356          INFOT = 2
00357          CALL DPBRFS( 'U', -1, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00358      $                IW, INFO )
00359          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
00360          INFOT = 3
00361          CALL DPBRFS( 'U', 1, -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00362      $                IW, INFO )
00363          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
00364          INFOT = 4
00365          CALL DPBRFS( 'U', 0, 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
00366      $                IW, INFO )
00367          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
00368          INFOT = 6
00369          CALL DPBRFS( 'U', 2, 1, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W,
00370      $                IW, INFO )
00371          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
00372          INFOT = 8
00373          CALL DPBRFS( 'U', 2, 1, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W,
00374      $                IW, INFO )
00375          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
00376          INFOT = 10
00377          CALL DPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 1, X, 2, R1, R2, W,
00378      $                IW, INFO )
00379          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
00380          INFOT = 12
00381          CALL DPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 2, X, 1, R1, R2, W,
00382      $                IW, INFO )
00383          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
00384 *
00385 *        DPBCON
00386 *
00387          SRNAMT = 'DPBCON'
00388          INFOT = 1
00389          CALL DPBCON( '/', 0, 0, A, 1, ANRM, RCOND, W, IW, INFO )
00390          CALL CHKXER( 'DPBCON', INFOT, NOUT, LERR, OK )
00391          INFOT = 2
00392          CALL DPBCON( 'U', -1, 0, A, 1, ANRM, RCOND, W, IW, INFO )
00393          CALL CHKXER( 'DPBCON', INFOT, NOUT, LERR, OK )
00394          INFOT = 3
00395          CALL DPBCON( 'U', 1, -1, A, 1, ANRM, RCOND, W, IW, INFO )
00396          CALL CHKXER( 'DPBCON', INFOT, NOUT, LERR, OK )
00397          INFOT = 5
00398          CALL DPBCON( 'U', 2, 1, A, 1, ANRM, RCOND, W, IW, INFO )
00399          CALL CHKXER( 'DPBCON', INFOT, NOUT, LERR, OK )
00400 *
00401 *        DPBEQU
00402 *
00403          SRNAMT = 'DPBEQU'
00404          INFOT = 1
00405          CALL DPBEQU( '/', 0, 0, A, 1, R1, RCOND, ANRM, INFO )
00406          CALL CHKXER( 'DPBEQU', INFOT, NOUT, LERR, OK )
00407          INFOT = 2
00408          CALL DPBEQU( 'U', -1, 0, A, 1, R1, RCOND, ANRM, INFO )
00409          CALL CHKXER( 'DPBEQU', INFOT, NOUT, LERR, OK )
00410          INFOT = 3
00411          CALL DPBEQU( 'U', 1, -1, A, 1, R1, RCOND, ANRM, INFO )
00412          CALL CHKXER( 'DPBEQU', INFOT, NOUT, LERR, OK )
00413          INFOT = 5
00414          CALL DPBEQU( 'U', 2, 1, A, 1, R1, RCOND, ANRM, INFO )
00415          CALL CHKXER( 'DPBEQU', 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 DERRPO
00425 *
00426       END
 All Files Functions