LAPACK: TESTING/LIN/serrlq.f Source File

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