|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE ZERRLS( 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 * ZERRLS tests the error exits for the COMPLEX*16 least squares 00016 * driver routines (ZGELS, CGELSS, CGELSX, CGELSY, CGELSD). 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 DOUBLE PRECISION RCOND 00037 * .. 00038 * .. Local Arrays .. 00039 INTEGER IP( NMAX ) 00040 DOUBLE PRECISION RW( NMAX ), S( NMAX ) 00041 COMPLEX*16 A( NMAX, NMAX ), B( NMAX, NMAX ), W( NMAX ) 00042 * .. 00043 * .. External Functions .. 00044 LOGICAL LSAMEN 00045 EXTERNAL LSAMEN 00046 * .. 00047 * .. External Subroutines .. 00048 EXTERNAL ALAESM, CHKXER, ZGELS, ZGELSD, ZGELSS, ZGELSX, 00049 $ ZGELSY 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 C2 = PATH( 2: 3 ) 00064 A( 1, 1 ) = ( 1.0D+0, 0.0D+0 ) 00065 A( 1, 2 ) = ( 2.0D+0, 0.0D+0 ) 00066 A( 2, 2 ) = ( 3.0D+0, 0.0D+0 ) 00067 A( 2, 1 ) = ( 4.0D+0, 0.0D+0 ) 00068 OK = .TRUE. 00069 WRITE( NOUT, FMT = * ) 00070 * 00071 * Test error exits for the least squares driver routines. 00072 * 00073 IF( LSAMEN( 2, C2, 'LS' ) ) THEN 00074 * 00075 * ZGELS 00076 * 00077 SRNAMT = 'ZGELS ' 00078 INFOT = 1 00079 CALL ZGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO ) 00080 CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK ) 00081 INFOT = 2 00082 CALL ZGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO ) 00083 CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK ) 00084 INFOT = 3 00085 CALL ZGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO ) 00086 CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK ) 00087 INFOT = 4 00088 CALL ZGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO ) 00089 CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK ) 00090 INFOT = 6 00091 CALL ZGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO ) 00092 CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK ) 00093 INFOT = 8 00094 CALL ZGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO ) 00095 CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK ) 00096 INFOT = 10 00097 CALL ZGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO ) 00098 CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK ) 00099 * 00100 * ZGELSS 00101 * 00102 SRNAMT = 'ZGELSS' 00103 INFOT = 1 00104 CALL ZGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW, 00105 $ INFO ) 00106 CALL CHKXER( 'ZGELSS', INFOT, NOUT, LERR, OK ) 00107 INFOT = 2 00108 CALL ZGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW, 00109 $ INFO ) 00110 CALL CHKXER( 'ZGELSS', INFOT, NOUT, LERR, OK ) 00111 INFOT = 3 00112 CALL ZGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW, 00113 $ INFO ) 00114 CALL CHKXER( 'ZGELSS', INFOT, NOUT, LERR, OK ) 00115 INFOT = 5 00116 CALL ZGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, RW, 00117 $ INFO ) 00118 CALL CHKXER( 'ZGELSS', INFOT, NOUT, LERR, OK ) 00119 INFOT = 7 00120 CALL ZGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, RW, 00121 $ INFO ) 00122 CALL CHKXER( 'ZGELSS', INFOT, NOUT, LERR, OK ) 00123 * 00124 * ZGELSX 00125 * 00126 SRNAMT = 'ZGELSX' 00127 INFOT = 1 00128 CALL ZGELSX( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, RW, 00129 $ INFO ) 00130 CALL CHKXER( 'ZGELSX', INFOT, NOUT, LERR, OK ) 00131 INFOT = 2 00132 CALL ZGELSX( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, RW, 00133 $ INFO ) 00134 CALL CHKXER( 'ZGELSX', INFOT, NOUT, LERR, OK ) 00135 INFOT = 3 00136 CALL ZGELSX( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, RW, 00137 $ INFO ) 00138 CALL CHKXER( 'ZGELSX', INFOT, NOUT, LERR, OK ) 00139 INFOT = 5 00140 CALL ZGELSX( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, RW, 00141 $ INFO ) 00142 CALL CHKXER( 'ZGELSX', INFOT, NOUT, LERR, OK ) 00143 INFOT = 7 00144 CALL ZGELSX( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, RW, 00145 $ INFO ) 00146 CALL CHKXER( 'ZGELSX', INFOT, NOUT, LERR, OK ) 00147 * 00148 * ZGELSY 00149 * 00150 SRNAMT = 'ZGELSY' 00151 INFOT = 1 00152 CALL ZGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW, 00153 $ INFO ) 00154 CALL CHKXER( 'ZGELSY', INFOT, NOUT, LERR, OK ) 00155 INFOT = 2 00156 CALL ZGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW, 00157 $ INFO ) 00158 CALL CHKXER( 'ZGELSY', INFOT, NOUT, LERR, OK ) 00159 INFOT = 3 00160 CALL ZGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW, 00161 $ INFO ) 00162 CALL CHKXER( 'ZGELSY', INFOT, NOUT, LERR, OK ) 00163 INFOT = 5 00164 CALL ZGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10, RW, 00165 $ INFO ) 00166 CALL CHKXER( 'ZGELSY', INFOT, NOUT, LERR, OK ) 00167 INFOT = 7 00168 CALL ZGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10, RW, 00169 $ INFO ) 00170 CALL CHKXER( 'ZGELSY', INFOT, NOUT, LERR, OK ) 00171 INFOT = 12 00172 CALL ZGELSY( 0, 3, 0, A, 1, B, 3, IP, RCOND, IRNK, W, 1, RW, 00173 $ INFO ) 00174 CALL CHKXER( 'ZGELSY', INFOT, NOUT, LERR, OK ) 00175 * 00176 * ZGELSD 00177 * 00178 SRNAMT = 'ZGELSD' 00179 INFOT = 1 00180 CALL ZGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, RW, 00181 $ IP, INFO ) 00182 CALL CHKXER( 'ZGELSD', INFOT, NOUT, LERR, OK ) 00183 INFOT = 2 00184 CALL ZGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, RW, 00185 $ IP, INFO ) 00186 CALL CHKXER( 'ZGELSD', INFOT, NOUT, LERR, OK ) 00187 INFOT = 3 00188 CALL ZGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10, RW, 00189 $ IP, INFO ) 00190 CALL CHKXER( 'ZGELSD', INFOT, NOUT, LERR, OK ) 00191 INFOT = 5 00192 CALL ZGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10, RW, 00193 $ IP, INFO ) 00194 CALL CHKXER( 'ZGELSD', INFOT, NOUT, LERR, OK ) 00195 INFOT = 7 00196 CALL ZGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10, RW, 00197 $ IP, INFO ) 00198 CALL CHKXER( 'ZGELSD', INFOT, NOUT, LERR, OK ) 00199 INFOT = 12 00200 CALL ZGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, RW, IP, 00201 $ INFO ) 00202 CALL CHKXER( 'ZGELSD', INFOT, NOUT, LERR, OK ) 00203 END IF 00204 * 00205 * Print a summary line. 00206 * 00207 CALL ALAESM( PATH, OK, NOUT ) 00208 * 00209 RETURN 00210 * 00211 * End of ZERRLS 00212 * 00213 END
1.7.3 
