LAPACK: TESTING/LIN/derrqr.f Source File

Go to the documentation of this file.
00001       SUBROUTINE DERRQR( PATH, NUNIT )
00002 *
00003 *  -- LAPACK test routine (version 3.3.0) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2010
00006 *
00007 *     .. Scalar Arguments ..
00008       CHARACTER*3        PATH
00009       INTEGER            NUNIT
00010 *     ..
00011 *
00012 *  Purpose
00013 *  =======
00014 *
00015 *  DERRQR tests the error exits for the DOUBLE PRECISION routines
00016 *  that use the QR 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, DGEQR2, DGEQR2P, DGEQRF,
00042      $                   DGEQRFP, DGEQRS, DORG2R, DORGQR, DORM2R,
00043      $                   DORMQR
00044 *     ..
00045 *     .. Scalars in Common ..
00046       LOGICAL            LERR, OK
00047       CHARACTER*32       SRNAMT
00048       INTEGER            INFOT, NOUT
00049 *     ..
00050 *     .. Common blocks ..
00051       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00052       COMMON             / SRNAMC / SRNAMT
00053 *     ..
00054 *     .. Intrinsic Functions ..
00055       INTRINSIC          DBLE
00056 *     ..
00057 *     .. Executable Statements ..
00058 *
00059       NOUT = NUNIT
00060       WRITE( NOUT, FMT = * )
00061 *
00062 *     Set the variables to innocuous values.
00063 *
00064       DO 20 J = 1, NMAX
00065          DO 10 I = 1, NMAX
00066             A( I, J ) = 1.D0 / DBLE( I+J )
00067             AF( I, J ) = 1.D0 / DBLE( I+J )
00068    10    CONTINUE
00069          B( J ) = 0.D0
00070          W( J ) = 0.D0
00071          X( J ) = 0.D0
00072    20 CONTINUE
00073       OK = .TRUE.
00074 *
00075 *     Error exits for QR factorization
00076 *
00077 *     DGEQRF
00078 *
00079       SRNAMT = 'DGEQRF'
00080       INFOT = 1
00081       CALL DGEQRF( -1, 0, A, 1, B, W, 1, INFO )
00082       CALL CHKXER( 'DGEQRF', INFOT, NOUT, LERR, OK )
00083       INFOT = 2
00084       CALL DGEQRF( 0, -1, A, 1, B, W, 1, INFO )
00085       CALL CHKXER( 'DGEQRF', INFOT, NOUT, LERR, OK )
00086       INFOT = 4
00087       CALL DGEQRF( 2, 1, A, 1, B, W, 1, INFO )
00088       CALL CHKXER( 'DGEQRF', INFOT, NOUT, LERR, OK )
00089       INFOT = 7
00090       CALL DGEQRF( 1, 2, A, 1, B, W, 1, INFO )
00091       CALL CHKXER( 'DGEQRF', INFOT, NOUT, LERR, OK )
00092 *
00093 *     DGEQRFP
00094 *
00095       SRNAMT = 'DGEQRFP'
00096       INFOT = 1
00097       CALL DGEQRFP( -1, 0, A, 1, B, W, 1, INFO )
00098       CALL CHKXER( 'DGEQRFP', INFOT, NOUT, LERR, OK )
00099       INFOT = 2
00100       CALL DGEQRFP( 0, -1, A, 1, B, W, 1, INFO )
00101       CALL CHKXER( 'DGEQRFP', INFOT, NOUT, LERR, OK )
00102       INFOT = 4
00103       CALL DGEQRFP( 2, 1, A, 1, B, W, 1, INFO )
00104       CALL CHKXER( 'DGEQRFP', INFOT, NOUT, LERR, OK )
00105       INFOT = 7
00106       CALL DGEQRFP( 1, 2, A, 1, B, W, 1, INFO )
00107       CALL CHKXER( 'DGEQRFP', INFOT, NOUT, LERR, OK )
00108 *
00109 *     DGEQR2
00110 *
00111       SRNAMT = 'DGEQR2'
00112       INFOT = 1
00113       CALL DGEQR2( -1, 0, A, 1, B, W, INFO )
00114       CALL CHKXER( 'DGEQR2', INFOT, NOUT, LERR, OK )
00115       INFOT = 2
00116       CALL DGEQR2( 0, -1, A, 1, B, W, INFO )
00117       CALL CHKXER( 'DGEQR2', INFOT, NOUT, LERR, OK )
00118       INFOT = 4
00119       CALL DGEQR2( 2, 1, A, 1, B, W, INFO )
00120       CALL CHKXER( 'DGEQR2', INFOT, NOUT, LERR, OK )
00121 *
00122 *     DGEQR2P
00123 *
00124       SRNAMT = 'DGEQR2P'
00125       INFOT = 1
00126       CALL DGEQR2P( -1, 0, A, 1, B, W, INFO )
00127       CALL CHKXER( 'DGEQR2P', INFOT, NOUT, LERR, OK )
00128       INFOT = 2
00129       CALL DGEQR2P( 0, -1, A, 1, B, W, INFO )
00130       CALL CHKXER( 'DGEQR2P', INFOT, NOUT, LERR, OK )
00131       INFOT = 4
00132       CALL DGEQR2P( 2, 1, A, 1, B, W, INFO )
00133       CALL CHKXER( 'DGEQR2P', INFOT, NOUT, LERR, OK )
00134 *
00135 *     DGEQRS
00136 *
00137       SRNAMT = 'DGEQRS'
00138       INFOT = 1
00139       CALL DGEQRS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
00140       CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
00141       INFOT = 2
00142       CALL DGEQRS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
00143       CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
00144       INFOT = 2
00145       CALL DGEQRS( 1, 2, 0, A, 2, X, B, 2, W, 1, INFO )
00146       CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
00147       INFOT = 3
00148       CALL DGEQRS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
00149       CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
00150       INFOT = 5
00151       CALL DGEQRS( 2, 1, 0, A, 1, X, B, 2, W, 1, INFO )
00152       CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
00153       INFOT = 8
00154       CALL DGEQRS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
00155       CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
00156       INFOT = 10
00157       CALL DGEQRS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
00158       CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
00159 *
00160 *     DORGQR
00161 *
00162       SRNAMT = 'DORGQR'
00163       INFOT = 1
00164       CALL DORGQR( -1, 0, 0, A, 1, X, W, 1, INFO )
00165       CALL CHKXER( 'DORGQR', INFOT, NOUT, LERR, OK )
00166       INFOT = 2
00167       CALL DORGQR( 0, -1, 0, A, 1, X, W, 1, INFO )
00168       CALL CHKXER( 'DORGQR', INFOT, NOUT, LERR, OK )
00169       INFOT = 2
00170       CALL DORGQR( 1, 2, 0, A, 1, X, W, 2, INFO )
00171       CALL CHKXER( 'DORGQR', INFOT, NOUT, LERR, OK )
00172       INFOT = 3
00173       CALL DORGQR( 0, 0, -1, A, 1, X, W, 1, INFO )
00174       CALL CHKXER( 'DORGQR', INFOT, NOUT, LERR, OK )
00175       INFOT = 3
00176       CALL DORGQR( 1, 1, 2, A, 1, X, W, 1, INFO )
00177       CALL CHKXER( 'DORGQR', INFOT, NOUT, LERR, OK )
00178       INFOT = 5
00179       CALL DORGQR( 2, 2, 0, A, 1, X, W, 2, INFO )
00180       CALL CHKXER( 'DORGQR', INFOT, NOUT, LERR, OK )
00181       INFOT = 8
00182       CALL DORGQR( 2, 2, 0, A, 2, X, W, 1, INFO )
00183       CALL CHKXER( 'DORGQR', INFOT, NOUT, LERR, OK )
00184 *
00185 *     DORG2R
00186 *
00187       SRNAMT = 'DORG2R'
00188       INFOT = 1
00189       CALL DORG2R( -1, 0, 0, A, 1, X, W, INFO )
00190       CALL CHKXER( 'DORG2R', INFOT, NOUT, LERR, OK )
00191       INFOT = 2
00192       CALL DORG2R( 0, -1, 0, A, 1, X, W, INFO )
00193       CALL CHKXER( 'DORG2R', INFOT, NOUT, LERR, OK )
00194       INFOT = 2
00195       CALL DORG2R( 1, 2, 0, A, 1, X, W, INFO )
00196       CALL CHKXER( 'DORG2R', INFOT, NOUT, LERR, OK )
00197       INFOT = 3
00198       CALL DORG2R( 0, 0, -1, A, 1, X, W, INFO )
00199       CALL CHKXER( 'DORG2R', INFOT, NOUT, LERR, OK )
00200       INFOT = 3
00201       CALL DORG2R( 2, 1, 2, A, 2, X, W, INFO )
00202       CALL CHKXER( 'DORG2R', INFOT, NOUT, LERR, OK )
00203       INFOT = 5
00204       CALL DORG2R( 2, 1, 0, A, 1, X, W, INFO )
00205       CALL CHKXER( 'DORG2R', INFOT, NOUT, LERR, OK )
00206 *
00207 *     DORMQR
00208 *
00209       SRNAMT = 'DORMQR'
00210       INFOT = 1
00211       CALL DORMQR( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00212       CALL CHKXER( 'DORMQR', INFOT, NOUT, LERR, OK )
00213       INFOT = 2
00214       CALL DORMQR( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00215       CALL CHKXER( 'DORMQR', INFOT, NOUT, LERR, OK )
00216       INFOT = 3
00217       CALL DORMQR( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00218       CALL CHKXER( 'DORMQR', INFOT, NOUT, LERR, OK )
00219       INFOT = 4
00220       CALL DORMQR( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, 1, INFO )
00221       CALL CHKXER( 'DORMQR', INFOT, NOUT, LERR, OK )
00222       INFOT = 5
00223       CALL DORMQR( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, 1, INFO )
00224       CALL CHKXER( 'DORMQR', INFOT, NOUT, LERR, OK )
00225       INFOT = 5
00226       CALL DORMQR( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO )
00227       CALL CHKXER( 'DORMQR', INFOT, NOUT, LERR, OK )
00228       INFOT = 5
00229       CALL DORMQR( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO )
00230       CALL CHKXER( 'DORMQR', INFOT, NOUT, LERR, OK )
00231       INFOT = 7
00232       CALL DORMQR( 'L', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
00233       CALL CHKXER( 'DORMQR', INFOT, NOUT, LERR, OK )
00234       INFOT = 7
00235       CALL DORMQR( 'R', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
00236       CALL CHKXER( 'DORMQR', INFOT, NOUT, LERR, OK )
00237       INFOT = 10
00238       CALL DORMQR( 'L', 'N', 2, 1, 0, A, 2, X, AF, 1, W, 1, INFO )
00239       CALL CHKXER( 'DORMQR', INFOT, NOUT, LERR, OK )
00240       INFOT = 12
00241       CALL DORMQR( 'L', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
00242       CALL CHKXER( 'DORMQR', INFOT, NOUT, LERR, OK )
00243       INFOT = 12
00244       CALL DORMQR( 'R', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
00245       CALL CHKXER( 'DORMQR', INFOT, NOUT, LERR, OK )
00246 *
00247 *     DORM2R
00248 *
00249       SRNAMT = 'DORM2R'
00250       INFOT = 1
00251       CALL DORM2R( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
00252       CALL CHKXER( 'DORM2R', INFOT, NOUT, LERR, OK )
00253       INFOT = 2
00254       CALL DORM2R( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
00255       CALL CHKXER( 'DORM2R', INFOT, NOUT, LERR, OK )
00256       INFOT = 3
00257       CALL DORM2R( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, INFO )
00258       CALL CHKXER( 'DORM2R', INFOT, NOUT, LERR, OK )
00259       INFOT = 4
00260       CALL DORM2R( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, INFO )
00261       CALL CHKXER( 'DORM2R', INFOT, NOUT, LERR, OK )
00262       INFOT = 5
00263       CALL DORM2R( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, INFO )
00264       CALL CHKXER( 'DORM2R', INFOT, NOUT, LERR, OK )
00265       INFOT = 5
00266       CALL DORM2R( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, INFO )
00267       CALL CHKXER( 'DORM2R', INFOT, NOUT, LERR, OK )
00268       INFOT = 5
00269       CALL DORM2R( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, INFO )
00270       CALL CHKXER( 'DORM2R', INFOT, NOUT, LERR, OK )
00271       INFOT = 7
00272       CALL DORM2R( 'L', 'N', 2, 1, 0, A, 1, X, AF, 2, W, INFO )
00273       CALL CHKXER( 'DORM2R', INFOT, NOUT, LERR, OK )
00274       INFOT = 7
00275       CALL DORM2R( 'R', 'N', 1, 2, 0, A, 1, X, AF, 1, W, INFO )
00276       CALL CHKXER( 'DORM2R', INFOT, NOUT, LERR, OK )
00277       INFOT = 10
00278       CALL DORM2R( 'L', 'N', 2, 1, 0, A, 2, X, AF, 1, W, INFO )
00279       CALL CHKXER( 'DORM2R', INFOT, NOUT, LERR, OK )
00280 *
00281 *     Print a summary line.
00282 *
00283       CALL ALAESM( PATH, OK, NOUT )
00284 *
00285       RETURN
00286 *
00287 *     End of DERRQR
00288 *
00289       END