LAPACK: TESTING/EIG/derrbd.f Source File

Go to the documentation of this file.
00001       SUBROUTINE DERRBD( 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 *  DERRBD tests the error exits for DGEBRD, DORGBR, DORMBR, DBDSQR and
00016 *  DBDSDC.
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, LW
00031       PARAMETER          ( NMAX = 4, LW = NMAX )
00032 *     ..
00033 *     .. Local Scalars ..
00034       CHARACTER*2        C2
00035       INTEGER            I, INFO, J, NT
00036 *     ..
00037 *     .. Local Arrays ..
00038       INTEGER            IQ( NMAX, NMAX ), IW( NMAX )
00039       DOUBLE PRECISION   A( NMAX, NMAX ), D( NMAX ), E( NMAX ),
00040      $                   Q( NMAX, NMAX ), TP( NMAX ), TQ( NMAX ),
00041      $                   U( NMAX, NMAX ), V( NMAX, NMAX ), W( LW )
00042 *     ..
00043 *     .. External Functions ..
00044       LOGICAL            LSAMEN
00045       EXTERNAL           LSAMEN
00046 *     ..
00047 *     .. External Subroutines ..
00048       EXTERNAL           CHKXER, DBDSDC, DBDSQR, DGEBD2, DGEBRD, DORGBR,
00049      $                   DORMBR
00050 *     ..
00051 *     .. Scalars in Common ..
00052       LOGICAL            LERR, OK
00053       CHARACTER*32       SRNAMT
00054       INTEGER            INFOT, NOUT
00055 *     ..
00056 *     .. Common blocks ..
00057       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00058       COMMON             / SRNAMC / SRNAMT
00059 *     ..
00060 *     .. Intrinsic Functions ..
00061       INTRINSIC          DBLE
00062 *     ..
00063 *     .. Executable Statements ..
00064 *
00065       NOUT = NUNIT
00066       WRITE( NOUT, FMT = * )
00067       C2 = PATH( 2: 3 )
00068 *
00069 *     Set the variables to innocuous values.
00070 *
00071       DO 20 J = 1, NMAX
00072          DO 10 I = 1, NMAX
00073             A( I, J ) = 1.D0 / DBLE( I+J )
00074    10    CONTINUE
00075    20 CONTINUE
00076       OK = .TRUE.
00077       NT = 0
00078 *
00079 *     Test error exits of the SVD routines.
00080 *
00081       IF( LSAMEN( 2, C2, 'BD' ) ) THEN
00082 *
00083 *        DGEBRD
00084 *
00085          SRNAMT = 'DGEBRD'
00086          INFOT = 1
00087          CALL DGEBRD( -1, 0, A, 1, D, E, TQ, TP, W, 1, INFO )
00088          CALL CHKXER( 'DGEBRD', INFOT, NOUT, LERR, OK )
00089          INFOT = 2
00090          CALL DGEBRD( 0, -1, A, 1, D, E, TQ, TP, W, 1, INFO )
00091          CALL CHKXER( 'DGEBRD', INFOT, NOUT, LERR, OK )
00092          INFOT = 4
00093          CALL DGEBRD( 2, 1, A, 1, D, E, TQ, TP, W, 2, INFO )
00094          CALL CHKXER( 'DGEBRD', INFOT, NOUT, LERR, OK )
00095          INFOT = 10
00096          CALL DGEBRD( 2, 1, A, 2, D, E, TQ, TP, W, 1, INFO )
00097          CALL CHKXER( 'DGEBRD', INFOT, NOUT, LERR, OK )
00098          NT = NT + 4
00099 *
00100 *        DGEBD2
00101 *
00102          SRNAMT = 'DGEBD2'
00103          INFOT = 1
00104          CALL DGEBD2( -1, 0, A, 1, D, E, TQ, TP, W, INFO )
00105          CALL CHKXER( 'DGEBD2', INFOT, NOUT, LERR, OK )
00106          INFOT = 2
00107          CALL DGEBD2( 0, -1, A, 1, D, E, TQ, TP, W, INFO )
00108          CALL CHKXER( 'DGEBD2', INFOT, NOUT, LERR, OK )
00109          INFOT = 4
00110          CALL DGEBD2( 2, 1, A, 1, D, E, TQ, TP, W, INFO )
00111          CALL CHKXER( 'DGEBD2', INFOT, NOUT, LERR, OK )
00112          NT = NT + 3
00113 *
00114 *        DORGBR
00115 *
00116          SRNAMT = 'DORGBR'
00117          INFOT = 1
00118          CALL DORGBR( '/', 0, 0, 0, A, 1, TQ, W, 1, INFO )
00119          CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK )
00120          INFOT = 2
00121          CALL DORGBR( 'Q', -1, 0, 0, A, 1, TQ, W, 1, INFO )
00122          CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK )
00123          INFOT = 3
00124          CALL DORGBR( 'Q', 0, -1, 0, A, 1, TQ, W, 1, INFO )
00125          CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK )
00126          INFOT = 3
00127          CALL DORGBR( 'Q', 0, 1, 0, A, 1, TQ, W, 1, INFO )
00128          CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK )
00129          INFOT = 3
00130          CALL DORGBR( 'Q', 1, 0, 1, A, 1, TQ, W, 1, INFO )
00131          CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK )
00132          INFOT = 3
00133          CALL DORGBR( 'P', 1, 0, 0, A, 1, TQ, W, 1, INFO )
00134          CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK )
00135          INFOT = 3
00136          CALL DORGBR( 'P', 0, 1, 1, A, 1, TQ, W, 1, INFO )
00137          CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK )
00138          INFOT = 4
00139          CALL DORGBR( 'Q', 0, 0, -1, A, 1, TQ, W, 1, INFO )
00140          CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK )
00141          INFOT = 6
00142          CALL DORGBR( 'Q', 2, 1, 1, A, 1, TQ, W, 1, INFO )
00143          CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK )
00144          INFOT = 9
00145          CALL DORGBR( 'Q', 2, 2, 1, A, 2, TQ, W, 1, INFO )
00146          CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK )
00147          NT = NT + 10
00148 *
00149 *        DORMBR
00150 *
00151          SRNAMT = 'DORMBR'
00152          INFOT = 1
00153          CALL DORMBR( '/', 'L', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
00154      $                INFO )
00155          CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK )
00156          INFOT = 2
00157          CALL DORMBR( 'Q', '/', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
00158      $                INFO )
00159          CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK )
00160          INFOT = 3
00161          CALL DORMBR( 'Q', 'L', '/', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
00162      $                INFO )
00163          CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK )
00164          INFOT = 4
00165          CALL DORMBR( 'Q', 'L', 'T', -1, 0, 0, A, 1, TQ, U, 1, W, 1,
00166      $                INFO )
00167          CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK )
00168          INFOT = 5
00169          CALL DORMBR( 'Q', 'L', 'T', 0, -1, 0, A, 1, TQ, U, 1, W, 1,
00170      $                INFO )
00171          CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK )
00172          INFOT = 6
00173          CALL DORMBR( 'Q', 'L', 'T', 0, 0, -1, A, 1, TQ, U, 1, W, 1,
00174      $                INFO )
00175          CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK )
00176          INFOT = 8
00177          CALL DORMBR( 'Q', 'L', 'T', 2, 0, 0, A, 1, TQ, U, 2, W, 1,
00178      $                INFO )
00179          CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK )
00180          INFOT = 8
00181          CALL DORMBR( 'Q', 'R', 'T', 0, 2, 0, A, 1, TQ, U, 1, W, 1,
00182      $                INFO )
00183          CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK )
00184          INFOT = 8
00185          CALL DORMBR( 'P', 'L', 'T', 2, 0, 2, A, 1, TQ, U, 2, W, 1,
00186      $                INFO )
00187          CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK )
00188          INFOT = 8
00189          CALL DORMBR( 'P', 'R', 'T', 0, 2, 2, A, 1, TQ, U, 1, W, 1,
00190      $                INFO )
00191          CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK )
00192          INFOT = 11
00193          CALL DORMBR( 'Q', 'R', 'T', 2, 0, 0, A, 1, TQ, U, 1, W, 1,
00194      $                INFO )
00195          CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK )
00196          INFOT = 13
00197          CALL DORMBR( 'Q', 'L', 'T', 0, 2, 0, A, 1, TQ, U, 1, W, 1,
00198      $                INFO )
00199          CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK )
00200          INFOT = 13
00201          CALL DORMBR( 'Q', 'R', 'T', 2, 0, 0, A, 1, TQ, U, 2, W, 1,
00202      $                INFO )
00203          CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK )
00204          NT = NT + 13
00205 *
00206 *        DBDSQR
00207 *
00208          SRNAMT = 'DBDSQR'
00209          INFOT = 1
00210          CALL DBDSQR( '/', 0, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
00211          CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK )
00212          INFOT = 2
00213          CALL DBDSQR( 'U', -1, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W,
00214      $                INFO )
00215          CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK )
00216          INFOT = 3
00217          CALL DBDSQR( 'U', 0, -1, 0, 0, D, E, V, 1, U, 1, A, 1, W,
00218      $                INFO )
00219          CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK )
00220          INFOT = 4
00221          CALL DBDSQR( 'U', 0, 0, -1, 0, D, E, V, 1, U, 1, A, 1, W,
00222      $                INFO )
00223          CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK )
00224          INFOT = 5
00225          CALL DBDSQR( 'U', 0, 0, 0, -1, D, E, V, 1, U, 1, A, 1, W,
00226      $                INFO )
00227          CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK )
00228          INFOT = 9
00229          CALL DBDSQR( 'U', 2, 1, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
00230          CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK )
00231          INFOT = 11
00232          CALL DBDSQR( 'U', 0, 0, 2, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
00233          CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK )
00234          INFOT = 13
00235          CALL DBDSQR( 'U', 2, 0, 0, 1, D, E, V, 1, U, 1, A, 1, W, INFO )
00236          CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK )
00237          NT = NT + 8
00238 *
00239 *        DBDSDC
00240 *
00241          SRNAMT = 'DBDSDC'
00242          INFOT = 1
00243          CALL DBDSDC( '/', 'N', 0, D, E, U, 1, V, 1, Q, IQ, W, IW,
00244      $                INFO )
00245          CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK )
00246          INFOT = 2
00247          CALL DBDSDC( 'U', '/', 0, D, E, U, 1, V, 1, Q, IQ, W, IW,
00248      $                INFO )
00249          CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK )
00250          INFOT = 3
00251          CALL DBDSDC( 'U', 'N', -1, D, E, U, 1, V, 1, Q, IQ, W, IW,
00252      $                INFO )
00253          CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK )
00254          INFOT = 7
00255          CALL DBDSDC( 'U', 'I', 2, D, E, U, 1, V, 1, Q, IQ, W, IW,
00256      $                INFO )
00257          CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK )
00258          INFOT = 9
00259          CALL DBDSDC( 'U', 'I', 2, D, E, U, 2, V, 1, Q, IQ, W, IW,
00260      $                INFO )
00261          CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK )
00262          NT = NT + 5
00263       END IF
00264 *
00265 *     Print a summary line.
00266 *
00267       IF( OK ) THEN
00268          WRITE( NOUT, FMT = 9999 )PATH, NT
00269       ELSE
00270          WRITE( NOUT, FMT = 9998 )PATH
00271       END IF
00272 *
00273  9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits',
00274      $      ' (', I3, ' tests done)' )
00275  9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
00276      $      'exits ***' )
00277 *
00278       RETURN
00279 *
00280 *     End of DERRBD
00281 *
00282       END