LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
serrbd.f
Go to the documentation of this file.
00001 *> \brief \b SERRBD
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE SERRBD( PATH, NUNIT )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       CHARACTER*3        PATH
00015 *       INTEGER            NUNIT
00016 *       ..
00017 *  
00018 *
00019 *> \par Purpose:
00020 *  =============
00021 *>
00022 *> \verbatim
00023 *>
00024 *> SERRBD tests the error exits for SGEBRD, SORGBR, SORMBR, SBDSQR and
00025 *> SBDSDC.
00026 *> \endverbatim
00027 *
00028 *  Arguments:
00029 *  ==========
00030 *
00031 *> \param[in] PATH
00032 *> \verbatim
00033 *>          PATH is CHARACTER*3
00034 *>          The LAPACK path name for the routines to be tested.
00035 *> \endverbatim
00036 *>
00037 *> \param[in] NUNIT
00038 *> \verbatim
00039 *>          NUNIT is INTEGER
00040 *>          The unit number for output.
00041 *> \endverbatim
00042 *
00043 *  Authors:
00044 *  ========
00045 *
00046 *> \author Univ. of Tennessee 
00047 *> \author Univ. of California Berkeley 
00048 *> \author Univ. of Colorado Denver 
00049 *> \author NAG Ltd. 
00050 *
00051 *> \date November 2011
00052 *
00053 *> \ingroup single_eig
00054 *
00055 *  =====================================================================
00056       SUBROUTINE SERRBD( PATH, NUNIT )
00057 *
00058 *  -- LAPACK test routine (version 3.4.0) --
00059 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00060 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00061 *     November 2011
00062 *
00063 *     .. Scalar Arguments ..
00064       CHARACTER*3        PATH
00065       INTEGER            NUNIT
00066 *     ..
00067 *
00068 *  =====================================================================
00069 *
00070 *     .. Parameters ..
00071       INTEGER            NMAX, LW
00072       PARAMETER          ( NMAX = 4, LW = NMAX )
00073 *     ..
00074 *     .. Local Scalars ..
00075       CHARACTER*2        C2
00076       INTEGER            I, INFO, J, NT
00077 *     ..
00078 *     .. Local Arrays ..
00079       INTEGER            IQ( NMAX, NMAX ), IW( NMAX )
00080       REAL               A( NMAX, NMAX ), D( NMAX ), E( NMAX ),
00081      $                   Q( NMAX, NMAX ), TP( NMAX ), TQ( NMAX ),
00082      $                   U( NMAX, NMAX ), V( NMAX, NMAX ), W( LW )
00083 *     ..
00084 *     .. External Functions ..
00085       LOGICAL            LSAMEN
00086       EXTERNAL           LSAMEN
00087 *     ..
00088 *     .. External Subroutines ..
00089       EXTERNAL           CHKXER, SBDSDC, SBDSQR, SGEBD2, SGEBRD, SORGBR,
00090      $                   SORMBR
00091 *     ..
00092 *     .. Scalars in Common ..
00093       LOGICAL            LERR, OK
00094       CHARACTER*32       SRNAMT
00095       INTEGER            INFOT, NOUT
00096 *     ..
00097 *     .. Common blocks ..
00098       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00099       COMMON             / SRNAMC / SRNAMT
00100 *     ..
00101 *     .. Intrinsic Functions ..
00102       INTRINSIC          REAL
00103 *     ..
00104 *     .. Executable Statements ..
00105 *
00106       NOUT = NUNIT
00107       WRITE( NOUT, FMT = * )
00108       C2 = PATH( 2: 3 )
00109 *
00110 *     Set the variables to innocuous values.
00111 *
00112       DO 20 J = 1, NMAX
00113          DO 10 I = 1, NMAX
00114             A( I, J ) = 1. / REAL( I+J )
00115    10    CONTINUE
00116    20 CONTINUE
00117       OK = .TRUE.
00118       NT = 0
00119 *
00120 *     Test error exits of the SVD routines.
00121 *
00122       IF( LSAMEN( 2, C2, 'BD' ) ) THEN
00123 *
00124 *        SGEBRD
00125 *
00126          SRNAMT = 'SGEBRD'
00127          INFOT = 1
00128          CALL SGEBRD( -1, 0, A, 1, D, E, TQ, TP, W, 1, INFO )
00129          CALL CHKXER( 'SGEBRD', INFOT, NOUT, LERR, OK )
00130          INFOT = 2
00131          CALL SGEBRD( 0, -1, A, 1, D, E, TQ, TP, W, 1, INFO )
00132          CALL CHKXER( 'SGEBRD', INFOT, NOUT, LERR, OK )
00133          INFOT = 4
00134          CALL SGEBRD( 2, 1, A, 1, D, E, TQ, TP, W, 2, INFO )
00135          CALL CHKXER( 'SGEBRD', INFOT, NOUT, LERR, OK )
00136          INFOT = 10
00137          CALL SGEBRD( 2, 1, A, 2, D, E, TQ, TP, W, 1, INFO )
00138          CALL CHKXER( 'SGEBRD', INFOT, NOUT, LERR, OK )
00139          NT = NT + 4
00140 *
00141 *        SGEBD2
00142 *
00143          SRNAMT = 'SGEBD2'
00144          INFOT = 1
00145          CALL SGEBD2( -1, 0, A, 1, D, E, TQ, TP, W, INFO )
00146          CALL CHKXER( 'SGEBD2', INFOT, NOUT, LERR, OK )
00147          INFOT = 2
00148          CALL SGEBD2( 0, -1, A, 1, D, E, TQ, TP, W, INFO )
00149          CALL CHKXER( 'SGEBD2', INFOT, NOUT, LERR, OK )
00150          INFOT = 4
00151          CALL SGEBD2( 2, 1, A, 1, D, E, TQ, TP, W, INFO )
00152          CALL CHKXER( 'SGEBD2', INFOT, NOUT, LERR, OK )
00153          NT = NT + 3
00154 *
00155 *        SORGBR
00156 *
00157          SRNAMT = 'SORGBR'
00158          INFOT = 1
00159          CALL SORGBR( '/', 0, 0, 0, A, 1, TQ, W, 1, INFO )
00160          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00161          INFOT = 2
00162          CALL SORGBR( 'Q', -1, 0, 0, A, 1, TQ, W, 1, INFO )
00163          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00164          INFOT = 3
00165          CALL SORGBR( 'Q', 0, -1, 0, A, 1, TQ, W, 1, INFO )
00166          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00167          INFOT = 3
00168          CALL SORGBR( 'Q', 0, 1, 0, A, 1, TQ, W, 1, INFO )
00169          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00170          INFOT = 3
00171          CALL SORGBR( 'Q', 1, 0, 1, A, 1, TQ, W, 1, INFO )
00172          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00173          INFOT = 3
00174          CALL SORGBR( 'P', 1, 0, 0, A, 1, TQ, W, 1, INFO )
00175          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00176          INFOT = 3
00177          CALL SORGBR( 'P', 0, 1, 1, A, 1, TQ, W, 1, INFO )
00178          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00179          INFOT = 4
00180          CALL SORGBR( 'Q', 0, 0, -1, A, 1, TQ, W, 1, INFO )
00181          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00182          INFOT = 6
00183          CALL SORGBR( 'Q', 2, 1, 1, A, 1, TQ, W, 1, INFO )
00184          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00185          INFOT = 9
00186          CALL SORGBR( 'Q', 2, 2, 1, A, 2, TQ, W, 1, INFO )
00187          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00188          NT = NT + 10
00189 *
00190 *        SORMBR
00191 *
00192          SRNAMT = 'SORMBR'
00193          INFOT = 1
00194          CALL SORMBR( '/', 'L', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
00195      $                INFO )
00196          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00197          INFOT = 2
00198          CALL SORMBR( 'Q', '/', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
00199      $                INFO )
00200          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00201          INFOT = 3
00202          CALL SORMBR( 'Q', 'L', '/', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
00203      $                INFO )
00204          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00205          INFOT = 4
00206          CALL SORMBR( 'Q', 'L', 'T', -1, 0, 0, A, 1, TQ, U, 1, W, 1,
00207      $                INFO )
00208          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00209          INFOT = 5
00210          CALL SORMBR( 'Q', 'L', 'T', 0, -1, 0, A, 1, TQ, U, 1, W, 1,
00211      $                INFO )
00212          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00213          INFOT = 6
00214          CALL SORMBR( 'Q', 'L', 'T', 0, 0, -1, A, 1, TQ, U, 1, W, 1,
00215      $                INFO )
00216          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00217          INFOT = 8
00218          CALL SORMBR( 'Q', 'L', 'T', 2, 0, 0, A, 1, TQ, U, 2, W, 1,
00219      $                INFO )
00220          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00221          INFOT = 8
00222          CALL SORMBR( 'Q', 'R', 'T', 0, 2, 0, A, 1, TQ, U, 1, W, 1,
00223      $                INFO )
00224          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00225          INFOT = 8
00226          CALL SORMBR( 'P', 'L', 'T', 2, 0, 2, A, 1, TQ, U, 2, W, 1,
00227      $                INFO )
00228          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00229          INFOT = 8
00230          CALL SORMBR( 'P', 'R', 'T', 0, 2, 2, A, 1, TQ, U, 1, W, 1,
00231      $                INFO )
00232          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00233          INFOT = 11
00234          CALL SORMBR( 'Q', 'R', 'T', 2, 0, 0, A, 1, TQ, U, 1, W, 1,
00235      $                INFO )
00236          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00237          INFOT = 13
00238          CALL SORMBR( 'Q', 'L', 'T', 0, 2, 0, A, 1, TQ, U, 1, W, 1,
00239      $                INFO )
00240          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00241          INFOT = 13
00242          CALL SORMBR( 'Q', 'R', 'T', 2, 0, 0, A, 1, TQ, U, 2, W, 1,
00243      $                INFO )
00244          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00245          NT = NT + 13
00246 *
00247 *        SBDSQR
00248 *
00249          SRNAMT = 'SBDSQR'
00250          INFOT = 1
00251          CALL SBDSQR( '/', 0, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
00252          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00253          INFOT = 2
00254          CALL SBDSQR( 'U', -1, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W,
00255      $                INFO )
00256          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00257          INFOT = 3
00258          CALL SBDSQR( 'U', 0, -1, 0, 0, D, E, V, 1, U, 1, A, 1, W,
00259      $                INFO )
00260          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00261          INFOT = 4
00262          CALL SBDSQR( 'U', 0, 0, -1, 0, D, E, V, 1, U, 1, A, 1, W,
00263      $                INFO )
00264          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00265          INFOT = 5
00266          CALL SBDSQR( 'U', 0, 0, 0, -1, D, E, V, 1, U, 1, A, 1, W,
00267      $                INFO )
00268          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00269          INFOT = 9
00270          CALL SBDSQR( 'U', 2, 1, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
00271          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00272          INFOT = 11
00273          CALL SBDSQR( 'U', 0, 0, 2, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
00274          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00275          INFOT = 13
00276          CALL SBDSQR( 'U', 2, 0, 0, 1, D, E, V, 1, U, 1, A, 1, W, INFO )
00277          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00278          NT = NT + 8
00279 *
00280 *        SBDSDC
00281 *
00282          SRNAMT = 'SBDSDC'
00283          INFOT = 1
00284          CALL SBDSDC( '/', 'N', 0, D, E, U, 1, V, 1, Q, IQ, W, IW,
00285      $                INFO )
00286          CALL CHKXER( 'SBDSDC', INFOT, NOUT, LERR, OK )
00287          INFOT = 2
00288          CALL SBDSDC( 'U', '/', 0, D, E, U, 1, V, 1, Q, IQ, W, IW,
00289      $                INFO )
00290          CALL CHKXER( 'SBDSDC', INFOT, NOUT, LERR, OK )
00291          INFOT = 3
00292          CALL SBDSDC( 'U', 'N', -1, D, E, U, 1, V, 1, Q, IQ, W, IW,
00293      $                INFO )
00294          CALL CHKXER( 'SBDSDC', INFOT, NOUT, LERR, OK )
00295          INFOT = 7
00296          CALL SBDSDC( 'U', 'I', 2, D, E, U, 1, V, 1, Q, IQ, W, IW,
00297      $                INFO )
00298          CALL CHKXER( 'SBDSDC', INFOT, NOUT, LERR, OK )
00299          INFOT = 9
00300          CALL SBDSDC( 'U', 'I', 2, D, E, U, 2, V, 1, Q, IQ, W, IW,
00301      $                INFO )
00302          CALL CHKXER( 'SBDSDC', INFOT, NOUT, LERR, OK )
00303          NT = NT + 5
00304       END IF
00305 *
00306 *     Print a summary line.
00307 *
00308       IF( OK ) THEN
00309          WRITE( NOUT, FMT = 9999 )PATH, NT
00310       ELSE
00311          WRITE( NOUT, FMT = 9998 )PATH
00312       END IF
00313 *
00314  9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits',
00315      $      ' (', I3, ' tests done)' )
00316  9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
00317      $      'exits ***' )
00318 *
00319       RETURN
00320 *
00321 *     End of SERRBD
00322 *
00323       END
 All Files Functions