|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE SERRLS( 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 * SERRLS tests the error exits for the REAL least squares 00016 * driver routines (SGELS, SGELSS, SGELSX, SGELSY, SGELSD). 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 CHARACTER*2 C2 00035 INTEGER INFO, IRNK 00036 REAL RCOND 00037 * .. 00038 * .. Local Arrays .. 00039 INTEGER IP( NMAX ) 00040 REAL A( NMAX, NMAX ), B( NMAX, NMAX ), S( NMAX ), 00041 $ W( NMAX ) 00042 * .. 00043 * .. External Functions .. 00044 LOGICAL LSAMEN 00045 EXTERNAL LSAMEN 00046 * .. 00047 * .. External Subroutines .. 00048 EXTERNAL ALAESM, CHKXER, SGELS, SGELSD, SGELSS, SGELSX, 00049 $ SGELSY 00050 * .. 00051 * .. Scalars in Common .. 00052 LOGICAL LERR, OK 00053 CHARACTER*32 SRNAMT 00054 INTEGER INFOT, NOUT 00055 * .. 00056 * .. Common blocks .. 00057 COMMON / INFOC / INFOT, NOUT, OK, LERR 00058 COMMON / SRNAMC / SRNAMT 00059 * .. 00060 * .. Executable Statements .. 00061 * 00062 NOUT = NUNIT 00063 WRITE( NOUT, FMT = * ) 00064 C2 = PATH( 2: 3 ) 00065 A( 1, 1 ) = 1.0E+0 00066 A( 1, 2 ) = 2.0E+0 00067 A( 2, 2 ) = 3.0E+0 00068 A( 2, 1 ) = 4.0E+0 00069 OK = .TRUE. 00070 * 00071 IF( LSAMEN( 2, C2, 'LS' ) ) THEN 00072 * 00073 * Test error exits for the least squares driver routines. 00074 * 00075 * SGELS 00076 * 00077 SRNAMT = 'SGELS ' 00078 INFOT = 1 00079 CALL SGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO ) 00080 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00081 INFOT = 2 00082 CALL SGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO ) 00083 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00084 INFOT = 3 00085 CALL SGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO ) 00086 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00087 INFOT = 4 00088 CALL SGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO ) 00089 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00090 INFOT = 6 00091 CALL SGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO ) 00092 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00093 INFOT = 8 00094 CALL SGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO ) 00095 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00096 INFOT = 10 00097 CALL SGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO ) 00098 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK ) 00099 * 00100 * SGELSS 00101 * 00102 SRNAMT = 'SGELSS' 00103 INFOT = 1 00104 CALL SGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 00105 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK ) 00106 INFOT = 2 00107 CALL SGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 00108 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK ) 00109 INFOT = 3 00110 CALL SGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 00111 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK ) 00112 INFOT = 5 00113 CALL SGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, INFO ) 00114 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK ) 00115 INFOT = 7 00116 CALL SGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, INFO ) 00117 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK ) 00118 * 00119 * SGELSX 00120 * 00121 SRNAMT = 'SGELSX' 00122 INFOT = 1 00123 CALL SGELSX( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO ) 00124 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK ) 00125 INFOT = 2 00126 CALL SGELSX( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO ) 00127 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK ) 00128 INFOT = 3 00129 CALL SGELSX( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, INFO ) 00130 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK ) 00131 INFOT = 5 00132 CALL SGELSX( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, INFO ) 00133 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK ) 00134 INFOT = 7 00135 CALL SGELSX( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, INFO ) 00136 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK ) 00137 * 00138 * SGELSY 00139 * 00140 SRNAMT = 'SGELSY' 00141 INFOT = 1 00142 CALL SGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 00143 $ INFO ) 00144 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK ) 00145 INFOT = 2 00146 CALL SGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 00147 $ INFO ) 00148 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK ) 00149 INFOT = 3 00150 CALL SGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 00151 $ INFO ) 00152 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK ) 00153 INFOT = 5 00154 CALL SGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10, 00155 $ INFO ) 00156 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK ) 00157 INFOT = 7 00158 CALL SGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10, 00159 $ INFO ) 00160 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK ) 00161 INFOT = 12 00162 CALL SGELSY( 2, 2, 1, A, 2, B, 2, IP, RCOND, IRNK, W, 1, INFO ) 00163 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK ) 00164 * 00165 * SGELSD 00166 * 00167 SRNAMT = 'SGELSD' 00168 INFOT = 1 00169 CALL SGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, 00170 $ IP, INFO ) 00171 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK ) 00172 INFOT = 2 00173 CALL SGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, 00174 $ IP, INFO ) 00175 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK ) 00176 INFOT = 3 00177 CALL SGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10, 00178 $ IP, INFO ) 00179 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK ) 00180 INFOT = 5 00181 CALL SGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10, 00182 $ IP, INFO ) 00183 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK ) 00184 INFOT = 7 00185 CALL SGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10, 00186 $ IP, INFO ) 00187 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK ) 00188 INFOT = 12 00189 CALL SGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, IP, 00190 $ INFO ) 00191 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK ) 00192 END IF 00193 * 00194 * Print a summary line. 00195 * 00196 CALL ALAESM( PATH, OK, NOUT ) 00197 * 00198 RETURN 00199 * 00200 * End of SERRLS 00201 * 00202 END
1.7.3 
