LAPACK 3.3.0

serrrq.f

Go to the documentation of this file.
00001       SUBROUTINE SERRRQ( 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 *  SERRRQ tests the error exits for the REAL routines
00016 *  that use the RQ 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, SGERQ2, SGERQF, SGERQS, SORGR2,
00042      $                   SORGRQ, SORMR2, SORMRQ
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 RQ factorization
00075 *
00076 *     SGERQF
00077 *
00078       SRNAMT = 'SGERQF'
00079       INFOT = 1
00080       CALL SGERQF( -1, 0, A, 1, B, W, 1, INFO )
00081       CALL CHKXER( 'SGERQF', INFOT, NOUT, LERR, OK )
00082       INFOT = 2
00083       CALL SGERQF( 0, -1, A, 1, B, W, 1, INFO )
00084       CALL CHKXER( 'SGERQF', INFOT, NOUT, LERR, OK )
00085       INFOT = 4
00086       CALL SGERQF( 2, 1, A, 1, B, W, 2, INFO )
00087       CALL CHKXER( 'SGERQF', INFOT, NOUT, LERR, OK )
00088       INFOT = 7
00089       CALL SGERQF( 2, 1, A, 2, B, W, 1, INFO )
00090       CALL CHKXER( 'SGERQF', INFOT, NOUT, LERR, OK )
00091 *
00092 *     SGERQ2
00093 *
00094       SRNAMT = 'SGERQ2'
00095       INFOT = 1
00096       CALL SGERQ2( -1, 0, A, 1, B, W, INFO )
00097       CALL CHKXER( 'SGERQ2', INFOT, NOUT, LERR, OK )
00098       INFOT = 2
00099       CALL SGERQ2( 0, -1, A, 1, B, W, INFO )
00100       CALL CHKXER( 'SGERQ2', INFOT, NOUT, LERR, OK )
00101       INFOT = 4
00102       CALL SGERQ2( 2, 1, A, 1, B, W, INFO )
00103       CALL CHKXER( 'SGERQ2', INFOT, NOUT, LERR, OK )
00104 *
00105 *     SGERQS
00106 *
00107       SRNAMT = 'SGERQS'
00108       INFOT = 1
00109       CALL SGERQS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
00110       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
00111       INFOT = 2
00112       CALL SGERQS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
00113       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
00114       INFOT = 2
00115       CALL SGERQS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
00116       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
00117       INFOT = 3
00118       CALL SGERQS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
00119       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
00120       INFOT = 5
00121       CALL SGERQS( 2, 2, 0, A, 1, X, B, 2, W, 1, INFO )
00122       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
00123       INFOT = 8
00124       CALL SGERQS( 2, 2, 0, A, 2, X, B, 1, W, 1, INFO )
00125       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
00126       INFOT = 10
00127       CALL SGERQS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
00128       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
00129 *
00130 *     SORGRQ
00131 *
00132       SRNAMT = 'SORGRQ'
00133       INFOT = 1
00134       CALL SORGRQ( -1, 0, 0, A, 1, X, W, 1, INFO )
00135       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
00136       INFOT = 2
00137       CALL SORGRQ( 0, -1, 0, A, 1, X, W, 1, INFO )
00138       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
00139       INFOT = 2
00140       CALL SORGRQ( 2, 1, 0, A, 2, X, W, 2, INFO )
00141       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
00142       INFOT = 3
00143       CALL SORGRQ( 0, 0, -1, A, 1, X, W, 1, INFO )
00144       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
00145       INFOT = 3
00146       CALL SORGRQ( 1, 2, 2, A, 1, X, W, 1, INFO )
00147       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
00148       INFOT = 5
00149       CALL SORGRQ( 2, 2, 0, A, 1, X, W, 2, INFO )
00150       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
00151       INFOT = 8
00152       CALL SORGRQ( 2, 2, 0, A, 2, X, W, 1, INFO )
00153       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
00154 *
00155 *     SORGR2
00156 *
00157       SRNAMT = 'SORGR2'
00158       INFOT = 1
00159       CALL SORGR2( -1, 0, 0, A, 1, X, W, INFO )
00160       CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK )
00161       INFOT = 2
00162       CALL SORGR2( 0, -1, 0, A, 1, X, W, INFO )
00163       CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK )
00164       INFOT = 2
00165       CALL SORGR2( 2, 1, 0, A, 2, X, W, INFO )
00166       CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK )
00167       INFOT = 3
00168       CALL SORGR2( 0, 0, -1, A, 1, X, W, INFO )
00169       CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK )
00170       INFOT = 3
00171       CALL SORGR2( 1, 2, 2, A, 2, X, W, INFO )
00172       CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK )
00173       INFOT = 5
00174       CALL SORGR2( 2, 2, 0, A, 1, X, W, INFO )
00175       CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK )
00176 *
00177 *     SORMRQ
00178 *
00179       SRNAMT = 'SORMRQ'
00180       INFOT = 1
00181       CALL SORMRQ( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00182       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
00183       INFOT = 2
00184       CALL SORMRQ( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00185       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
00186       INFOT = 3
00187       CALL SORMRQ( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00188       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
00189       INFOT = 4
00190       CALL SORMRQ( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, 1, INFO )
00191       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
00192       INFOT = 5
00193       CALL SORMRQ( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, 1, INFO )
00194       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
00195       INFOT = 5
00196       CALL SORMRQ( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO )
00197       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
00198       INFOT = 5
00199       CALL SORMRQ( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO )
00200       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
00201       INFOT = 7
00202       CALL SORMRQ( 'L', 'N', 2, 1, 2, A, 1, X, AF, 2, W, 1, INFO )
00203       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
00204       INFOT = 7
00205       CALL SORMRQ( 'R', 'N', 1, 2, 2, A, 1, X, AF, 1, W, 1, INFO )
00206       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
00207       INFOT = 10
00208       CALL SORMRQ( 'L', 'N', 2, 1, 0, A, 1, X, AF, 1, W, 1, INFO )
00209       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
00210       INFOT = 12
00211       CALL SORMRQ( 'L', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
00212       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
00213       INFOT = 12
00214       CALL SORMRQ( 'R', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
00215       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
00216 *
00217 *     SORMR2
00218 *
00219       SRNAMT = 'SORMR2'
00220       INFOT = 1
00221       CALL SORMR2( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
00222       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
00223       INFOT = 2
00224       CALL SORMR2( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
00225       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
00226       INFOT = 3
00227       CALL SORMR2( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, INFO )
00228       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
00229       INFOT = 4
00230       CALL SORMR2( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, INFO )
00231       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
00232       INFOT = 5
00233       CALL SORMR2( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, INFO )
00234       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
00235       INFOT = 5
00236       CALL SORMR2( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, INFO )
00237       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
00238       INFOT = 5
00239       CALL SORMR2( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, INFO )
00240       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
00241       INFOT = 7
00242       CALL SORMR2( 'L', 'N', 2, 1, 2, A, 1, X, AF, 2, W, INFO )
00243       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
00244       INFOT = 7
00245       CALL SORMR2( 'R', 'N', 1, 2, 2, A, 1, X, AF, 1, W, INFO )
00246       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
00247       INFOT = 10
00248       CALL SORMR2( 'L', 'N', 2, 1, 0, A, 1, X, AF, 1, W, INFO )
00249       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
00250 *
00251 *     Print a summary line.
00252 *
00253       CALL ALAESM( PATH, OK, NOUT )
00254 *
00255       RETURN
00256 *
00257 *     End of SERRRQ
00258 *
00259       END
 All Files Functions