LAPACK: TESTING/EIG/zerrbd.f Source File

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