LAPACK: TESTING/LIN/cerrqr.f Source File

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