LAPACK: TESTING/LIN/cerrlq.f Source File

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