LAPACK 3.3.0

serrbd.f

Go to the documentation of this file.
00001       SUBROUTINE SERRBD( 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 *  SERRBD tests the error exits for SGEBRD, SORGBR, SORMBR, SBDSQR and
00016 *  SBDSDC.
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       REAL               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, SBDSDC, SBDSQR, SGEBD2, SGEBRD, SORGBR,
00049      $                   SORMBR
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          REAL
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. / REAL( 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 *        SGEBRD
00084 *
00085          SRNAMT = 'SGEBRD'
00086          INFOT = 1
00087          CALL SGEBRD( -1, 0, A, 1, D, E, TQ, TP, W, 1, INFO )
00088          CALL CHKXER( 'SGEBRD', INFOT, NOUT, LERR, OK )
00089          INFOT = 2
00090          CALL SGEBRD( 0, -1, A, 1, D, E, TQ, TP, W, 1, INFO )
00091          CALL CHKXER( 'SGEBRD', INFOT, NOUT, LERR, OK )
00092          INFOT = 4
00093          CALL SGEBRD( 2, 1, A, 1, D, E, TQ, TP, W, 2, INFO )
00094          CALL CHKXER( 'SGEBRD', INFOT, NOUT, LERR, OK )
00095          INFOT = 10
00096          CALL SGEBRD( 2, 1, A, 2, D, E, TQ, TP, W, 1, INFO )
00097          CALL CHKXER( 'SGEBRD', INFOT, NOUT, LERR, OK )
00098          NT = NT + 4
00099 *
00100 *        SGEBD2
00101 *
00102          SRNAMT = 'SGEBD2'
00103          INFOT = 1
00104          CALL SGEBD2( -1, 0, A, 1, D, E, TQ, TP, W, INFO )
00105          CALL CHKXER( 'SGEBD2', INFOT, NOUT, LERR, OK )
00106          INFOT = 2
00107          CALL SGEBD2( 0, -1, A, 1, D, E, TQ, TP, W, INFO )
00108          CALL CHKXER( 'SGEBD2', INFOT, NOUT, LERR, OK )
00109          INFOT = 4
00110          CALL SGEBD2( 2, 1, A, 1, D, E, TQ, TP, W, INFO )
00111          CALL CHKXER( 'SGEBD2', INFOT, NOUT, LERR, OK )
00112          NT = NT + 3
00113 *
00114 *        SORGBR
00115 *
00116          SRNAMT = 'SORGBR'
00117          INFOT = 1
00118          CALL SORGBR( '/', 0, 0, 0, A, 1, TQ, W, 1, INFO )
00119          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00120          INFOT = 2
00121          CALL SORGBR( 'Q', -1, 0, 0, A, 1, TQ, W, 1, INFO )
00122          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00123          INFOT = 3
00124          CALL SORGBR( 'Q', 0, -1, 0, A, 1, TQ, W, 1, INFO )
00125          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00126          INFOT = 3
00127          CALL SORGBR( 'Q', 0, 1, 0, A, 1, TQ, W, 1, INFO )
00128          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00129          INFOT = 3
00130          CALL SORGBR( 'Q', 1, 0, 1, A, 1, TQ, W, 1, INFO )
00131          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00132          INFOT = 3
00133          CALL SORGBR( 'P', 1, 0, 0, A, 1, TQ, W, 1, INFO )
00134          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00135          INFOT = 3
00136          CALL SORGBR( 'P', 0, 1, 1, A, 1, TQ, W, 1, INFO )
00137          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00138          INFOT = 4
00139          CALL SORGBR( 'Q', 0, 0, -1, A, 1, TQ, W, 1, INFO )
00140          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00141          INFOT = 6
00142          CALL SORGBR( 'Q', 2, 1, 1, A, 1, TQ, W, 1, INFO )
00143          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00144          INFOT = 9
00145          CALL SORGBR( 'Q', 2, 2, 1, A, 2, TQ, W, 1, INFO )
00146          CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK )
00147          NT = NT + 10
00148 *
00149 *        SORMBR
00150 *
00151          SRNAMT = 'SORMBR'
00152          INFOT = 1
00153          CALL SORMBR( '/', 'L', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
00154      $                INFO )
00155          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00156          INFOT = 2
00157          CALL SORMBR( 'Q', '/', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
00158      $                INFO )
00159          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00160          INFOT = 3
00161          CALL SORMBR( 'Q', 'L', '/', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
00162      $                INFO )
00163          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00164          INFOT = 4
00165          CALL SORMBR( 'Q', 'L', 'T', -1, 0, 0, A, 1, TQ, U, 1, W, 1,
00166      $                INFO )
00167          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00168          INFOT = 5
00169          CALL SORMBR( 'Q', 'L', 'T', 0, -1, 0, A, 1, TQ, U, 1, W, 1,
00170      $                INFO )
00171          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00172          INFOT = 6
00173          CALL SORMBR( 'Q', 'L', 'T', 0, 0, -1, A, 1, TQ, U, 1, W, 1,
00174      $                INFO )
00175          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00176          INFOT = 8
00177          CALL SORMBR( 'Q', 'L', 'T', 2, 0, 0, A, 1, TQ, U, 2, W, 1,
00178      $                INFO )
00179          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00180          INFOT = 8
00181          CALL SORMBR( 'Q', 'R', 'T', 0, 2, 0, A, 1, TQ, U, 1, W, 1,
00182      $                INFO )
00183          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00184          INFOT = 8
00185          CALL SORMBR( 'P', 'L', 'T', 2, 0, 2, A, 1, TQ, U, 2, W, 1,
00186      $                INFO )
00187          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00188          INFOT = 8
00189          CALL SORMBR( 'P', 'R', 'T', 0, 2, 2, A, 1, TQ, U, 1, W, 1,
00190      $                INFO )
00191          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00192          INFOT = 11
00193          CALL SORMBR( 'Q', 'R', 'T', 2, 0, 0, A, 1, TQ, U, 1, W, 1,
00194      $                INFO )
00195          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00196          INFOT = 13
00197          CALL SORMBR( 'Q', 'L', 'T', 0, 2, 0, A, 1, TQ, U, 1, W, 1,
00198      $                INFO )
00199          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00200          INFOT = 13
00201          CALL SORMBR( 'Q', 'R', 'T', 2, 0, 0, A, 1, TQ, U, 2, W, 1,
00202      $                INFO )
00203          CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK )
00204          NT = NT + 13
00205 *
00206 *        SBDSQR
00207 *
00208          SRNAMT = 'SBDSQR'
00209          INFOT = 1
00210          CALL SBDSQR( '/', 0, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
00211          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00212          INFOT = 2
00213          CALL SBDSQR( 'U', -1, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W,
00214      $                INFO )
00215          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00216          INFOT = 3
00217          CALL SBDSQR( 'U', 0, -1, 0, 0, D, E, V, 1, U, 1, A, 1, W,
00218      $                INFO )
00219          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00220          INFOT = 4
00221          CALL SBDSQR( 'U', 0, 0, -1, 0, D, E, V, 1, U, 1, A, 1, W,
00222      $                INFO )
00223          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00224          INFOT = 5
00225          CALL SBDSQR( 'U', 0, 0, 0, -1, D, E, V, 1, U, 1, A, 1, W,
00226      $                INFO )
00227          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00228          INFOT = 9
00229          CALL SBDSQR( 'U', 2, 1, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
00230          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00231          INFOT = 11
00232          CALL SBDSQR( 'U', 0, 0, 2, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
00233          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00234          INFOT = 13
00235          CALL SBDSQR( 'U', 2, 0, 0, 1, D, E, V, 1, U, 1, A, 1, W, INFO )
00236          CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK )
00237          NT = NT + 8
00238 *
00239 *        SBDSDC
00240 *
00241          SRNAMT = 'SBDSDC'
00242          INFOT = 1
00243          CALL SBDSDC( '/', 'N', 0, D, E, U, 1, V, 1, Q, IQ, W, IW,
00244      $                INFO )
00245          CALL CHKXER( 'SBDSDC', INFOT, NOUT, LERR, OK )
00246          INFOT = 2
00247          CALL SBDSDC( 'U', '/', 0, D, E, U, 1, V, 1, Q, IQ, W, IW,
00248      $                INFO )
00249          CALL CHKXER( 'SBDSDC', INFOT, NOUT, LERR, OK )
00250          INFOT = 3
00251          CALL SBDSDC( 'U', 'N', -1, D, E, U, 1, V, 1, Q, IQ, W, IW,
00252      $                INFO )
00253          CALL CHKXER( 'SBDSDC', INFOT, NOUT, LERR, OK )
00254          INFOT = 7
00255          CALL SBDSDC( 'U', 'I', 2, D, E, U, 1, V, 1, Q, IQ, W, IW,
00256      $                INFO )
00257          CALL CHKXER( 'SBDSDC', INFOT, NOUT, LERR, OK )
00258          INFOT = 9
00259          CALL SBDSDC( 'U', 'I', 2, D, E, U, 2, V, 1, Q, IQ, W, IW,
00260      $                INFO )
00261          CALL CHKXER( 'SBDSDC', 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 SERRBD
00281 *
00282       END
 All Files Functions