![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SERRLS 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 SERRLS( 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 *> SERRLS tests the error exits for the REAL least squares 00025 *> driver routines (SGELS, SGELSS, SGELSX, SGELSY, SGELSD). 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 SERRLS( 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 CHARACTER*2 C2 00076 INTEGER INFO, IRNK 00077 REAL RCOND 00078 * .. 00079 * .. Local Arrays .. 00080 INTEGER IP( NMAX ) 00081 REAL A( NMAX, NMAX ), B( NMAX, NMAX ), S( NMAX ), 00082 $ W( NMAX ) 00083 * .. 00084 * .. External Functions .. 00085 LOGICAL LSAMEN 00086 EXTERNAL LSAMEN 00087 * .. 00088 * .. External Subroutines .. 00089 EXTERNAL ALAESM, CHKXER, SGELS, SGELSD, SGELSS, SGELSX, 00090 $ SGELSY 00091 * .. 00092 * .. Scalars in Common .. 00093 LOGICAL LERR, OK 00094 CHARACTER*32 SRNAMT 00095 INTEGER INFOT, NOUT 00096 * .. 00097 * .. Common blocks .. 00098 COMMON / INFOC / INFOT, NOUT, OK, LERR 00099 COMMON / SRNAMC / SRNAMT 00100 * .. 00101 * .. Executable Statements .. 00102 * 00103 NOUT = NUNIT 00104 WRITE( NOUT, FMT = * ) 00105 C2 = PATH( 2: 3 ) 00106 A( 1, 1 ) = 1.0E+0 00107 A( 1, 2 ) = 2.0E+0 00108 A( 2, 2 ) = 3.0E+0 00109 A( 2, 1 ) = 4.0E+0 00110 OK = .TRUE. 00111 * 00112 IF( LSAMEN( 2, C2, 'LS' ) ) THEN 00113 * 00114 * Test error exits for the least squares driver routines. 00115 * 00116 * SGELS 00117 * 00118 SRNAMT = 'SGELS ' 00119 INFOT = 1 00120 CALL SGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO ) 00121 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00122 INFOT = 2 00123 CALL SGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO ) 00124 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00125 INFOT = 3 00126 CALL SGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO ) 00127 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00128 INFOT = 4 00129 CALL SGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO ) 00130 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00131 INFOT = 6 00132 CALL SGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO ) 00133 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00134 INFOT = 8 00135 CALL SGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO ) 00136 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00137 INFOT = 10 00138 CALL SGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO ) 00139 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00140 * 00141 * SGELSS 00142 * 00143 SRNAMT = 'SGELSS' 00144 INFOT = 1 00145 CALL SGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 00146 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK ) 00147 INFOT = 2 00148 CALL SGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 00149 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK ) 00150 INFOT = 3 00151 CALL SGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 00152 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK ) 00153 INFOT = 5 00154 CALL SGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, INFO ) 00155 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK ) 00156 INFOT = 7 00157 CALL SGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, INFO ) 00158 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK ) 00159 * 00160 * SGELSX 00161 * 00162 SRNAMT = 'SGELSX' 00163 INFOT = 1 00164 CALL SGELSX( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO ) 00165 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK ) 00166 INFOT = 2 00167 CALL SGELSX( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO ) 00168 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK ) 00169 INFOT = 3 00170 CALL SGELSX( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, INFO ) 00171 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK ) 00172 INFOT = 5 00173 CALL SGELSX( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, INFO ) 00174 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK ) 00175 INFOT = 7 00176 CALL SGELSX( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, INFO ) 00177 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK ) 00178 * 00179 * SGELSY 00180 * 00181 SRNAMT = 'SGELSY' 00182 INFOT = 1 00183 CALL SGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 00184 $ INFO ) 00185 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK ) 00186 INFOT = 2 00187 CALL SGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 00188 $ INFO ) 00189 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK ) 00190 INFOT = 3 00191 CALL SGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 00192 $ INFO ) 00193 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK ) 00194 INFOT = 5 00195 CALL SGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10, 00196 $ INFO ) 00197 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK ) 00198 INFOT = 7 00199 CALL SGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10, 00200 $ INFO ) 00201 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK ) 00202 INFOT = 12 00203 CALL SGELSY( 2, 2, 1, A, 2, B, 2, IP, RCOND, IRNK, W, 1, INFO ) 00204 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK ) 00205 * 00206 * SGELSD 00207 * 00208 SRNAMT = 'SGELSD' 00209 INFOT = 1 00210 CALL SGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, 00211 $ IP, INFO ) 00212 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK ) 00213 INFOT = 2 00214 CALL SGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, 00215 $ IP, INFO ) 00216 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK ) 00217 INFOT = 3 00218 CALL SGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10, 00219 $ IP, INFO ) 00220 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK ) 00221 INFOT = 5 00222 CALL SGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10, 00223 $ IP, INFO ) 00224 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK ) 00225 INFOT = 7 00226 CALL SGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10, 00227 $ IP, INFO ) 00228 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK ) 00229 INFOT = 12 00230 CALL SGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, IP, 00231 $ INFO ) 00232 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK ) 00233 END IF 00234 * 00235 * Print a summary line. 00236 * 00237 CALL ALAESM( PATH, OK, NOUT ) 00238 * 00239 RETURN 00240 * 00241 * End of SERRLS 00242 * 00243 END