LAPACK: TESTING/LIN/derrql.f Source File

Go to the documentation of this file.
00001       SUBROUTINE DERRQL( 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 *  DERRQL tests the error exits for the DOUBLE PRECISION routines
00016 *  that use the QL decomposition of a general matrix.
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 = 2 )
00032 *     ..
00033 *     .. Local Scalars ..
00034       INTEGER            I, INFO, J
00035 *     ..
00036 *     .. Local Arrays ..
00037       DOUBLE PRECISION   A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
00038      $                   W( NMAX ), X( NMAX )
00039 *     ..
00040 *     .. External Subroutines ..
00041       EXTERNAL           ALAESM, CHKXER, DGEQL2, DGEQLF, DGEQLS, DORG2L,
00042      $                   DORGQL, DORM2L, DORMQL
00043 *     ..
00044 *     .. Scalars in Common ..
00045       LOGICAL            LERR, OK
00046       CHARACTER*32       SRNAMT
00047       INTEGER            INFOT, NOUT
00048 *     ..
00049 *     .. Common blocks ..
00050       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00051       COMMON             / SRNAMC / SRNAMT
00052 *     ..
00053 *     .. Intrinsic Functions ..
00054       INTRINSIC          DBLE
00055 *     ..
00056 *     .. Executable Statements ..
00057 *
00058       NOUT = NUNIT
00059       WRITE( NOUT, FMT = * )
00060 *
00061 *     Set the variables to innocuous values.
00062 *
00063       DO 20 J = 1, NMAX
00064          DO 10 I = 1, NMAX
00065             A( I, J ) = 1.D0 / DBLE( I+J )
00066             AF( I, J ) = 1.D0 / DBLE( I+J )
00067    10    CONTINUE
00068          B( J ) = 0.D0
00069          W( J ) = 0.D0
00070          X( J ) = 0.D0
00071    20 CONTINUE
00072       OK = .TRUE.
00073 *
00074 *     Error exits for QL factorization
00075 *
00076 *     DGEQLF
00077 *
00078       SRNAMT = 'DGEQLF'
00079       INFOT = 1
00080       CALL DGEQLF( -1, 0, A, 1, B, W, 1, INFO )
00081       CALL CHKXER( 'DGEQLF', INFOT, NOUT, LERR, OK )
00082       INFOT = 2
00083       CALL DGEQLF( 0, -1, A, 1, B, W, 1, INFO )
00084       CALL CHKXER( 'DGEQLF', INFOT, NOUT, LERR, OK )
00085       INFOT = 4
00086       CALL DGEQLF( 2, 1, A, 1, B, W, 1, INFO )
00087       CALL CHKXER( 'DGEQLF', INFOT, NOUT, LERR, OK )
00088       INFOT = 7
00089       CALL DGEQLF( 1, 2, A, 1, B, W, 1, INFO )
00090       CALL CHKXER( 'DGEQLF', INFOT, NOUT, LERR, OK )
00091 *
00092 *     DGEQL2
00093 *
00094       SRNAMT = 'DGEQL2'
00095       INFOT = 1
00096       CALL DGEQL2( -1, 0, A, 1, B, W, INFO )
00097       CALL CHKXER( 'DGEQL2', INFOT, NOUT, LERR, OK )
00098       INFOT = 2
00099       CALL DGEQL2( 0, -1, A, 1, B, W, INFO )
00100       CALL CHKXER( 'DGEQL2', INFOT, NOUT, LERR, OK )
00101       INFOT = 4
00102       CALL DGEQL2( 2, 1, A, 1, B, W, INFO )
00103       CALL CHKXER( 'DGEQL2', INFOT, NOUT, LERR, OK )
00104 *
00105 *     DGEQLS
00106 *
00107       SRNAMT = 'DGEQLS'
00108       INFOT = 1
00109       CALL DGEQLS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
00110       CALL CHKXER( 'DGEQLS', INFOT, NOUT, LERR, OK )
00111       INFOT = 2
00112       CALL DGEQLS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
00113       CALL CHKXER( 'DGEQLS', INFOT, NOUT, LERR, OK )
00114       INFOT = 2
00115       CALL DGEQLS( 1, 2, 0, A, 1, X, B, 1, W, 1, INFO )
00116       CALL CHKXER( 'DGEQLS', INFOT, NOUT, LERR, OK )
00117       INFOT = 3
00118       CALL DGEQLS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
00119       CALL CHKXER( 'DGEQLS', INFOT, NOUT, LERR, OK )
00120       INFOT = 5
00121       CALL DGEQLS( 2, 1, 0, A, 1, X, B, 2, W, 1, INFO )
00122       CALL CHKXER( 'DGEQLS', INFOT, NOUT, LERR, OK )
00123       INFOT = 8
00124       CALL DGEQLS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
00125       CALL CHKXER( 'DGEQLS', INFOT, NOUT, LERR, OK )
00126       INFOT = 10
00127       CALL DGEQLS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
00128       CALL CHKXER( 'DGEQLS', INFOT, NOUT, LERR, OK )
00129 *
00130 *     DORGQL
00131 *
00132       SRNAMT = 'DORGQL'
00133       INFOT = 1
00134       CALL DORGQL( -1, 0, 0, A, 1, X, W, 1, INFO )
00135       CALL CHKXER( 'DORGQL', INFOT, NOUT, LERR, OK )
00136       INFOT = 2
00137       CALL DORGQL( 0, -1, 0, A, 1, X, W, 1, INFO )
00138       CALL CHKXER( 'DORGQL', INFOT, NOUT, LERR, OK )
00139       INFOT = 2
00140       CALL DORGQL( 1, 2, 0, A, 1, X, W, 2, INFO )
00141       CALL CHKXER( 'DORGQL', INFOT, NOUT, LERR, OK )
00142       INFOT = 3
00143       CALL DORGQL( 0, 0, -1, A, 1, X, W, 1, INFO )
00144       CALL CHKXER( 'DORGQL', INFOT, NOUT, LERR, OK )
00145       INFOT = 3
00146       CALL DORGQL( 1, 1, 2, A, 1, X, W, 1, INFO )
00147       CALL CHKXER( 'DORGQL', INFOT, NOUT, LERR, OK )
00148       INFOT = 5
00149       CALL DORGQL( 2, 1, 0, A, 1, X, W, 1, INFO )
00150       CALL CHKXER( 'DORGQL', INFOT, NOUT, LERR, OK )
00151       INFOT = 8
00152       CALL DORGQL( 2, 2, 0, A, 2, X, W, 1, INFO )
00153       CALL CHKXER( 'DORGQL', INFOT, NOUT, LERR, OK )
00154 *
00155 *     DORG2L
00156 *
00157       SRNAMT = 'DORG2L'
00158       INFOT = 1
00159       CALL DORG2L( -1, 0, 0, A, 1, X, W, INFO )
00160       CALL CHKXER( 'DORG2L', INFOT, NOUT, LERR, OK )
00161       INFOT = 2
00162       CALL DORG2L( 0, -1, 0, A, 1, X, W, INFO )
00163       CALL CHKXER( 'DORG2L', INFOT, NOUT, LERR, OK )
00164       INFOT = 2
00165       CALL DORG2L( 1, 2, 0, A, 1, X, W, INFO )
00166       CALL CHKXER( 'DORG2L', INFOT, NOUT, LERR, OK )
00167       INFOT = 3
00168       CALL DORG2L( 0, 0, -1, A, 1, X, W, INFO )
00169       CALL CHKXER( 'DORG2L', INFOT, NOUT, LERR, OK )
00170       INFOT = 3
00171       CALL DORG2L( 2, 1, 2, A, 2, X, W, INFO )
00172       CALL CHKXER( 'DORG2L', INFOT, NOUT, LERR, OK )
00173       INFOT = 5
00174       CALL DORG2L( 2, 1, 0, A, 1, X, W, INFO )
00175       CALL CHKXER( 'DORG2L', INFOT, NOUT, LERR, OK )
00176 *
00177 *     DORMQL
00178 *
00179       SRNAMT = 'DORMQL'
00180       INFOT = 1
00181       CALL DORMQL( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00182       CALL CHKXER( 'DORMQL', INFOT, NOUT, LERR, OK )
00183       INFOT = 2
00184       CALL DORMQL( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00185       CALL CHKXER( 'DORMQL', INFOT, NOUT, LERR, OK )
00186       INFOT = 3
00187       CALL DORMQL( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00188       CALL CHKXER( 'DORMQL', INFOT, NOUT, LERR, OK )
00189       INFOT = 4
00190       CALL DORMQL( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, 1, INFO )
00191       CALL CHKXER( 'DORMQL', INFOT, NOUT, LERR, OK )
00192       INFOT = 5
00193       CALL DORMQL( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, 1, INFO )
00194       CALL CHKXER( 'DORMQL', INFOT, NOUT, LERR, OK )
00195       INFOT = 5
00196       CALL DORMQL( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO )
00197       CALL CHKXER( 'DORMQL', INFOT, NOUT, LERR, OK )
00198       INFOT = 5
00199       CALL DORMQL( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO )
00200       CALL CHKXER( 'DORMQL', INFOT, NOUT, LERR, OK )
00201       INFOT = 7
00202       CALL DORMQL( 'L', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
00203       CALL CHKXER( 'DORMQL', INFOT, NOUT, LERR, OK )
00204       INFOT = 7
00205       CALL DORMQL( 'R', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
00206       CALL CHKXER( 'DORMQL', INFOT, NOUT, LERR, OK )
00207       INFOT = 10
00208       CALL DORMQL( 'L', 'N', 2, 1, 0, A, 2, X, AF, 1, W, 1, INFO )
00209       CALL CHKXER( 'DORMQL', INFOT, NOUT, LERR, OK )
00210       INFOT = 12
00211       CALL DORMQL( 'L', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
00212       CALL CHKXER( 'DORMQL', INFOT, NOUT, LERR, OK )
00213       INFOT = 12
00214       CALL DORMQL( 'R', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
00215       CALL CHKXER( 'DORMQL', INFOT, NOUT, LERR, OK )
00216 *
00217 *     DORM2L
00218 *
00219       SRNAMT = 'DORM2L'
00220       INFOT = 1
00221       CALL DORM2L( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
00222       CALL CHKXER( 'DORM2L', INFOT, NOUT, LERR, OK )
00223       INFOT = 2
00224       CALL DORM2L( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
00225       CALL CHKXER( 'DORM2L', INFOT, NOUT, LERR, OK )
00226       INFOT = 3
00227       CALL DORM2L( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, INFO )
00228       CALL CHKXER( 'DORM2L', INFOT, NOUT, LERR, OK )
00229       INFOT = 4
00230       CALL DORM2L( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, INFO )
00231       CALL CHKXER( 'DORM2L', INFOT, NOUT, LERR, OK )
00232       INFOT = 5
00233       CALL DORM2L( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, INFO )
00234       CALL CHKXER( 'DORM2L', INFOT, NOUT, LERR, OK )
00235       INFOT = 5
00236       CALL DORM2L( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, INFO )
00237       CALL CHKXER( 'DORM2L', INFOT, NOUT, LERR, OK )
00238       INFOT = 5
00239       CALL DORM2L( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, INFO )
00240       CALL CHKXER( 'DORM2L', INFOT, NOUT, LERR, OK )
00241       INFOT = 7
00242       CALL DORM2L( 'L', 'N', 2, 1, 0, A, 1, X, AF, 2, W, INFO )
00243       CALL CHKXER( 'DORM2L', INFOT, NOUT, LERR, OK )
00244       INFOT = 7
00245       CALL DORM2L( 'R', 'N', 1, 2, 0, A, 1, X, AF, 1, W, INFO )
00246       CALL CHKXER( 'DORM2L', INFOT, NOUT, LERR, OK )
00247       INFOT = 10
00248       CALL DORM2L( 'L', 'N', 2, 1, 0, A, 2, X, AF, 1, W, INFO )
00249       CALL CHKXER( 'DORM2L', INFOT, NOUT, LERR, OK )
00250 *
00251 *     Print a summary line.
00252 *
00253       CALL ALAESM( PATH, OK, NOUT )
00254 *
00255       RETURN
00256 *
00257 *     End of DERRQL
00258 *
00259       END