LAPACK: TESTING/LIN/zerrqr.f Source File

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