LAPACK: TESTING/LIN/serrqr.f Source File

Go to the documentation of this file.
00001       SUBROUTINE SERRQR( 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 *  SERRQR tests the error exits for the REAL 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       REAL               A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
00038      $                   W( NMAX ), X( NMAX )
00039 *     ..
00040 *     .. External Subroutines ..
00041       EXTERNAL           ALAESM, CHKXER, SGEQR2, SGEQR2P, SGEQRF,
00042      $                   SGEQRFP, SGEQRS, SORG2R, SORGQR, SORM2R,
00043      $                   SORMQR
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          REAL
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. / REAL( I+J )
00067             AF( I, J ) = 1. / REAL( I+J )
00068    10    CONTINUE
00069          B( J ) = 0.
00070          W( J ) = 0.
00071          X( J ) = 0.
00072    20 CONTINUE
00073       OK = .TRUE.
00074 *
00075 *     Error exits for QR factorization
00076 *
00077 *     SGEQRF
00078 *
00079       SRNAMT = 'SGEQRF'
00080       INFOT = 1
00081       CALL SGEQRF( -1, 0, A, 1, B, W, 1, INFO )
00082       CALL CHKXER( 'SGEQRF', INFOT, NOUT, LERR, OK )
00083       INFOT = 2
00084       CALL SGEQRF( 0, -1, A, 1, B, W, 1, INFO )
00085       CALL CHKXER( 'SGEQRF', INFOT, NOUT, LERR, OK )
00086       INFOT = 4
00087       CALL SGEQRF( 2, 1, A, 1, B, W, 1, INFO )
00088       CALL CHKXER( 'SGEQRF', INFOT, NOUT, LERR, OK )
00089       INFOT = 7
00090       CALL SGEQRF( 1, 2, A, 1, B, W, 1, INFO )
00091       CALL CHKXER( 'SGEQRF', INFOT, NOUT, LERR, OK )
00092 *
00093 *     SGEQRFP
00094 *
00095       SRNAMT = 'SGEQRFP'
00096       INFOT = 1
00097       CALL SGEQRFP( -1, 0, A, 1, B, W, 1, INFO )
00098       CALL CHKXER( 'SGEQRFP', INFOT, NOUT, LERR, OK )
00099       INFOT = 2
00100       CALL SGEQRFP( 0, -1, A, 1, B, W, 1, INFO )
00101       CALL CHKXER( 'SGEQRFP', INFOT, NOUT, LERR, OK )
00102       INFOT = 4
00103       CALL SGEQRFP( 2, 1, A, 1, B, W, 1, INFO )
00104       CALL CHKXER( 'SGEQRFP', INFOT, NOUT, LERR, OK )
00105       INFOT = 7
00106       CALL SGEQRFP( 1, 2, A, 1, B, W, 1, INFO )
00107       CALL CHKXER( 'SGEQRFP', INFOT, NOUT, LERR, OK )
00108 *
00109 *     SGEQR2
00110 *
00111       SRNAMT = 'SGEQR2'
00112       INFOT = 1
00113       CALL SGEQR2( -1, 0, A, 1, B, W, INFO )
00114       CALL CHKXER( 'SGEQR2', INFOT, NOUT, LERR, OK )
00115       INFOT = 2
00116       CALL SGEQR2( 0, -1, A, 1, B, W, INFO )
00117       CALL CHKXER( 'SGEQR2', INFOT, NOUT, LERR, OK )
00118       INFOT = 4
00119       CALL SGEQR2( 2, 1, A, 1, B, W, INFO )
00120       CALL CHKXER( 'SGEQR2', INFOT, NOUT, LERR, OK )
00121 *
00122 *     SGEQR2P
00123 *
00124       SRNAMT = 'SGEQR2P'
00125       INFOT = 1
00126       CALL SGEQR2P( -1, 0, A, 1, B, W, INFO )
00127       CALL CHKXER( 'SGEQR2P', INFOT, NOUT, LERR, OK )
00128       INFOT = 2
00129       CALL SGEQR2P( 0, -1, A, 1, B, W, INFO )
00130       CALL CHKXER( 'SGEQR2P', INFOT, NOUT, LERR, OK )
00131       INFOT = 4
00132       CALL SGEQR2P( 2, 1, A, 1, B, W, INFO )
00133       CALL CHKXER( 'SGEQR2P', INFOT, NOUT, LERR, OK )
00134 *
00135 *     SGEQRS
00136 *
00137       SRNAMT = 'SGEQRS'
00138       INFOT = 1
00139       CALL SGEQRS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
00140       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
00141       INFOT = 2
00142       CALL SGEQRS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
00143       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
00144       INFOT = 2
00145       CALL SGEQRS( 1, 2, 0, A, 2, X, B, 2, W, 1, INFO )
00146       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
00147       INFOT = 3
00148       CALL SGEQRS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
00149       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
00150       INFOT = 5
00151       CALL SGEQRS( 2, 1, 0, A, 1, X, B, 2, W, 1, INFO )
00152       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
00153       INFOT = 8
00154       CALL SGEQRS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
00155       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
00156       INFOT = 10
00157       CALL SGEQRS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
00158       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
00159 *
00160 *     SORGQR
00161 *
00162       SRNAMT = 'SORGQR'
00163       INFOT = 1
00164       CALL SORGQR( -1, 0, 0, A, 1, X, W, 1, INFO )
00165       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
00166       INFOT = 2
00167       CALL SORGQR( 0, -1, 0, A, 1, X, W, 1, INFO )
00168       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
00169       INFOT = 2
00170       CALL SORGQR( 1, 2, 0, A, 1, X, W, 2, INFO )
00171       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
00172       INFOT = 3
00173       CALL SORGQR( 0, 0, -1, A, 1, X, W, 1, INFO )
00174       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
00175       INFOT = 3
00176       CALL SORGQR( 1, 1, 2, A, 1, X, W, 1, INFO )
00177       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
00178       INFOT = 5
00179       CALL SORGQR( 2, 2, 0, A, 1, X, W, 2, INFO )
00180       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
00181       INFOT = 8
00182       CALL SORGQR( 2, 2, 0, A, 2, X, W, 1, INFO )
00183       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
00184 *
00185 *     SORG2R
00186 *
00187       SRNAMT = 'SORG2R'
00188       INFOT = 1
00189       CALL SORG2R( -1, 0, 0, A, 1, X, W, INFO )
00190       CALL CHKXER( 'SORG2R', INFOT, NOUT, LERR, OK )
00191       INFOT = 2
00192       CALL SORG2R( 0, -1, 0, A, 1, X, W, INFO )
00193       CALL CHKXER( 'SORG2R', INFOT, NOUT, LERR, OK )
00194       INFOT = 2
00195       CALL SORG2R( 1, 2, 0, A, 1, X, W, INFO )
00196       CALL CHKXER( 'SORG2R', INFOT, NOUT, LERR, OK )
00197       INFOT = 3
00198       CALL SORG2R( 0, 0, -1, A, 1, X, W, INFO )
00199       CALL CHKXER( 'SORG2R', INFOT, NOUT, LERR, OK )
00200       INFOT = 3
00201       CALL SORG2R( 2, 1, 2, A, 2, X, W, INFO )
00202       CALL CHKXER( 'SORG2R', INFOT, NOUT, LERR, OK )
00203       INFOT = 5
00204       CALL SORG2R( 2, 1, 0, A, 1, X, W, INFO )
00205       CALL CHKXER( 'SORG2R', INFOT, NOUT, LERR, OK )
00206 *
00207 *     SORMQR
00208 *
00209       SRNAMT = 'SORMQR'
00210       INFOT = 1
00211       CALL SORMQR( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00212       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
00213       INFOT = 2
00214       CALL SORMQR( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00215       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
00216       INFOT = 3
00217       CALL SORMQR( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00218       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
00219       INFOT = 4
00220       CALL SORMQR( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, 1, INFO )
00221       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
00222       INFOT = 5
00223       CALL SORMQR( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, 1, INFO )
00224       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
00225       INFOT = 5
00226       CALL SORMQR( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO )
00227       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
00228       INFOT = 5
00229       CALL SORMQR( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO )
00230       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
00231       INFOT = 7
00232       CALL SORMQR( 'L', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
00233       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
00234       INFOT = 7
00235       CALL SORMQR( 'R', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
00236       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
00237       INFOT = 10
00238       CALL SORMQR( 'L', 'N', 2, 1, 0, A, 2, X, AF, 1, W, 1, INFO )
00239       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
00240       INFOT = 12
00241       CALL SORMQR( 'L', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
00242       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
00243       INFOT = 12
00244       CALL SORMQR( 'R', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
00245       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
00246 *
00247 *     SORM2R
00248 *
00249       SRNAMT = 'SORM2R'
00250       INFOT = 1
00251       CALL SORM2R( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
00252       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
00253       INFOT = 2
00254       CALL SORM2R( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
00255       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
00256       INFOT = 3
00257       CALL SORM2R( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, INFO )
00258       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
00259       INFOT = 4
00260       CALL SORM2R( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, INFO )
00261       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
00262       INFOT = 5
00263       CALL SORM2R( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, INFO )
00264       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
00265       INFOT = 5
00266       CALL SORM2R( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, INFO )
00267       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
00268       INFOT = 5
00269       CALL SORM2R( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, INFO )
00270       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
00271       INFOT = 7
00272       CALL SORM2R( 'L', 'N', 2, 1, 0, A, 1, X, AF, 2, W, INFO )
00273       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
00274       INFOT = 7
00275       CALL SORM2R( 'R', 'N', 1, 2, 0, A, 1, X, AF, 1, W, INFO )
00276       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
00277       INFOT = 10
00278       CALL SORM2R( 'L', 'N', 2, 1, 0, A, 2, X, AF, 1, W, INFO )
00279       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
00280 *
00281 *     Print a summary line.
00282 *
00283       CALL ALAESM( PATH, OK, NOUT )
00284 *
00285       RETURN
00286 *
00287 *     End of SERRQR
00288 *
00289       END