LAPACK: TESTING/LIN/serrqr.f Source File

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