LAPACK 3.3.0

derrrq.f

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