![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SERRRQ 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE SERRRQ( PATH, NUNIT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER*3 PATH 00015 * INTEGER NUNIT 00016 * .. 00017 * 00018 * 00019 *> \par Purpose: 00020 * ============= 00021 *> 00022 *> \verbatim 00023 *> 00024 *> SERRRQ tests the error exits for the REAL routines 00025 *> that use the RQ decomposition of a general matrix. 00026 *> \endverbatim 00027 * 00028 * Arguments: 00029 * ========== 00030 * 00031 *> \param[in] PATH 00032 *> \verbatim 00033 *> PATH is CHARACTER*3 00034 *> The LAPACK path name for the routines to be tested. 00035 *> \endverbatim 00036 *> 00037 *> \param[in] NUNIT 00038 *> \verbatim 00039 *> NUNIT is INTEGER 00040 *> The unit number for output. 00041 *> \endverbatim 00042 * 00043 * Authors: 00044 * ======== 00045 * 00046 *> \author Univ. of Tennessee 00047 *> \author Univ. of California Berkeley 00048 *> \author Univ. of Colorado Denver 00049 *> \author NAG Ltd. 00050 * 00051 *> \date November 2011 00052 * 00053 *> \ingroup single_lin 00054 * 00055 * ===================================================================== 00056 SUBROUTINE SERRRQ( PATH, NUNIT ) 00057 * 00058 * -- LAPACK test routine (version 3.4.0) -- 00059 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00060 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00061 * November 2011 00062 * 00063 * .. Scalar Arguments .. 00064 CHARACTER*3 PATH 00065 INTEGER NUNIT 00066 * .. 00067 * 00068 * ===================================================================== 00069 * 00070 * .. Parameters .. 00071 INTEGER NMAX 00072 PARAMETER ( NMAX = 2 ) 00073 * .. 00074 * .. Local Scalars .. 00075 INTEGER I, INFO, J 00076 * .. 00077 * .. Local Arrays .. 00078 REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00079 $ W( NMAX ), X( NMAX ) 00080 * .. 00081 * .. External Subroutines .. 00082 EXTERNAL ALAESM, CHKXER, SGERQ2, SGERQF, SGERQS, SORGR2, 00083 $ SORGRQ, SORMR2, SORMRQ 00084 * .. 00085 * .. Scalars in Common .. 00086 LOGICAL LERR, OK 00087 CHARACTER*32 SRNAMT 00088 INTEGER INFOT, NOUT 00089 * .. 00090 * .. Common blocks .. 00091 COMMON / INFOC / INFOT, NOUT, OK, LERR 00092 COMMON / SRNAMC / SRNAMT 00093 * .. 00094 * .. Intrinsic Functions .. 00095 INTRINSIC REAL 00096 * .. 00097 * .. Executable Statements .. 00098 * 00099 NOUT = NUNIT 00100 WRITE( NOUT, FMT = * ) 00101 * 00102 * Set the variables to innocuous values. 00103 * 00104 DO 20 J = 1, NMAX 00105 DO 10 I = 1, NMAX 00106 A( I, J ) = 1. / REAL( I+J ) 00107 AF( I, J ) = 1. / REAL( I+J ) 00108 10 CONTINUE 00109 B( J ) = 0. 00110 W( J ) = 0. 00111 X( J ) = 0. 00112 20 CONTINUE 00113 OK = .TRUE. 00114 * 00115 * Error exits for RQ factorization 00116 * 00117 * SGERQF 00118 * 00119 SRNAMT = 'SGERQF' 00120 INFOT = 1 00121 CALL SGERQF( -1, 0, A, 1, B, W, 1, INFO ) 00122 CALL CHKXER( 'SGERQF', INFOT, NOUT, LERR, OK ) 00123 INFOT = 2 00124 CALL SGERQF( 0, -1, A, 1, B, W, 1, INFO ) 00125 CALL CHKXER( 'SGERQF', INFOT, NOUT, LERR, OK ) 00126 INFOT = 4 00127 CALL SGERQF( 2, 1, A, 1, B, W, 2, INFO ) 00128 CALL CHKXER( 'SGERQF', INFOT, NOUT, LERR, OK ) 00129 INFOT = 7 00130 CALL SGERQF( 2, 1, A, 2, B, W, 1, INFO ) 00131 CALL CHKXER( 'SGERQF', INFOT, NOUT, LERR, OK ) 00132 * 00133 * SGERQ2 00134 * 00135 SRNAMT = 'SGERQ2' 00136 INFOT = 1 00137 CALL SGERQ2( -1, 0, A, 1, B, W, INFO ) 00138 CALL CHKXER( 'SGERQ2', INFOT, NOUT, LERR, OK ) 00139 INFOT = 2 00140 CALL SGERQ2( 0, -1, A, 1, B, W, INFO ) 00141 CALL CHKXER( 'SGERQ2', INFOT, NOUT, LERR, OK ) 00142 INFOT = 4 00143 CALL SGERQ2( 2, 1, A, 1, B, W, INFO ) 00144 CALL CHKXER( 'SGERQ2', INFOT, NOUT, LERR, OK ) 00145 * 00146 * SGERQS 00147 * 00148 SRNAMT = 'SGERQS' 00149 INFOT = 1 00150 CALL SGERQS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO ) 00151 CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK ) 00152 INFOT = 2 00153 CALL SGERQS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO ) 00154 CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK ) 00155 INFOT = 2 00156 CALL SGERQS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO ) 00157 CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK ) 00158 INFOT = 3 00159 CALL SGERQS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO ) 00160 CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK ) 00161 INFOT = 5 00162 CALL SGERQS( 2, 2, 0, A, 1, X, B, 2, W, 1, INFO ) 00163 CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK ) 00164 INFOT = 8 00165 CALL SGERQS( 2, 2, 0, A, 2, X, B, 1, W, 1, INFO ) 00166 CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK ) 00167 INFOT = 10 00168 CALL SGERQS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO ) 00169 CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK ) 00170 * 00171 * SORGRQ 00172 * 00173 SRNAMT = 'SORGRQ' 00174 INFOT = 1 00175 CALL SORGRQ( -1, 0, 0, A, 1, X, W, 1, INFO ) 00176 CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK ) 00177 INFOT = 2 00178 CALL SORGRQ( 0, -1, 0, A, 1, X, W, 1, INFO ) 00179 CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK ) 00180 INFOT = 2 00181 CALL SORGRQ( 2, 1, 0, A, 2, X, W, 2, INFO ) 00182 CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK ) 00183 INFOT = 3 00184 CALL SORGRQ( 0, 0, -1, A, 1, X, W, 1, INFO ) 00185 CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK ) 00186 INFOT = 3 00187 CALL SORGRQ( 1, 2, 2, A, 1, X, W, 1, INFO ) 00188 CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK ) 00189 INFOT = 5 00190 CALL SORGRQ( 2, 2, 0, A, 1, X, W, 2, INFO ) 00191 CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK ) 00192 INFOT = 8 00193 CALL SORGRQ( 2, 2, 0, A, 2, X, W, 1, INFO ) 00194 CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK ) 00195 * 00196 * SORGR2 00197 * 00198 SRNAMT = 'SORGR2' 00199 INFOT = 1 00200 CALL SORGR2( -1, 0, 0, A, 1, X, W, INFO ) 00201 CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK ) 00202 INFOT = 2 00203 CALL SORGR2( 0, -1, 0, A, 1, X, W, INFO ) 00204 CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK ) 00205 INFOT = 2 00206 CALL SORGR2( 2, 1, 0, A, 2, X, W, INFO ) 00207 CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK ) 00208 INFOT = 3 00209 CALL SORGR2( 0, 0, -1, A, 1, X, W, INFO ) 00210 CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK ) 00211 INFOT = 3 00212 CALL SORGR2( 1, 2, 2, A, 2, X, W, INFO ) 00213 CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK ) 00214 INFOT = 5 00215 CALL SORGR2( 2, 2, 0, A, 1, X, W, INFO ) 00216 CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK ) 00217 * 00218 * SORMRQ 00219 * 00220 SRNAMT = 'SORMRQ' 00221 INFOT = 1 00222 CALL SORMRQ( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 00223 CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK ) 00224 INFOT = 2 00225 CALL SORMRQ( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 00226 CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK ) 00227 INFOT = 3 00228 CALL SORMRQ( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 00229 CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK ) 00230 INFOT = 4 00231 CALL SORMRQ( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, 1, INFO ) 00232 CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK ) 00233 INFOT = 5 00234 CALL SORMRQ( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, 1, INFO ) 00235 CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK ) 00236 INFOT = 5 00237 CALL SORMRQ( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO ) 00238 CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK ) 00239 INFOT = 5 00240 CALL SORMRQ( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO ) 00241 CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK ) 00242 INFOT = 7 00243 CALL SORMRQ( 'L', 'N', 2, 1, 2, A, 1, X, AF, 2, W, 1, INFO ) 00244 CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK ) 00245 INFOT = 7 00246 CALL SORMRQ( 'R', 'N', 1, 2, 2, A, 1, X, AF, 1, W, 1, INFO ) 00247 CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK ) 00248 INFOT = 10 00249 CALL SORMRQ( 'L', 'N', 2, 1, 0, A, 1, X, AF, 1, W, 1, INFO ) 00250 CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK ) 00251 INFOT = 12 00252 CALL SORMRQ( 'L', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO ) 00253 CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK ) 00254 INFOT = 12 00255 CALL SORMRQ( 'R', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO ) 00256 CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK ) 00257 * 00258 * SORMR2 00259 * 00260 SRNAMT = 'SORMR2' 00261 INFOT = 1 00262 CALL SORMR2( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, INFO ) 00263 CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK ) 00264 INFOT = 2 00265 CALL SORMR2( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO ) 00266 CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK ) 00267 INFOT = 3 00268 CALL SORMR2( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, INFO ) 00269 CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK ) 00270 INFOT = 4 00271 CALL SORMR2( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, INFO ) 00272 CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK ) 00273 INFOT = 5 00274 CALL SORMR2( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, INFO ) 00275 CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK ) 00276 INFOT = 5 00277 CALL SORMR2( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, INFO ) 00278 CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK ) 00279 INFOT = 5 00280 CALL SORMR2( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, INFO ) 00281 CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK ) 00282 INFOT = 7 00283 CALL SORMR2( 'L', 'N', 2, 1, 2, A, 1, X, AF, 2, W, INFO ) 00284 CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK ) 00285 INFOT = 7 00286 CALL SORMR2( 'R', 'N', 1, 2, 2, A, 1, X, AF, 1, W, INFO ) 00287 CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK ) 00288 INFOT = 10 00289 CALL SORMR2( 'L', 'N', 2, 1, 0, A, 1, X, AF, 1, W, INFO ) 00290 CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK ) 00291 * 00292 * Print a summary line. 00293 * 00294 CALL ALAESM( PATH, OK, NOUT ) 00295 * 00296 RETURN 00297 * 00298 * End of SERRRQ 00299 * 00300 END