1*> \brief \b DERRLS 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE DERRLS( PATH, NUNIT ) 12* 13* .. Scalar Arguments .. 14* CHARACTER*3 PATH 15* INTEGER NUNIT 16* .. 17* 18* 19*> \par Purpose: 20* ============= 21*> 22*> \verbatim 23*> 24*> DERRLS tests the error exits for the DOUBLE PRECISION least squares 25*> driver routines (DGELS, SGELSS, SGELSX, SGELSY, SGELSD). 26*> \endverbatim 27* 28* Arguments: 29* ========== 30* 31*> \param[in] PATH 32*> \verbatim 33*> PATH is CHARACTER*3 34*> The LAPACK path name for the routines to be tested. 35*> \endverbatim 36*> 37*> \param[in] NUNIT 38*> \verbatim 39*> NUNIT is INTEGER 40*> The unit number for output. 41*> \endverbatim 42* 43* Authors: 44* ======== 45* 46*> \author Univ. of Tennessee 47*> \author Univ. of California Berkeley 48*> \author Univ. of Colorado Denver 49*> \author NAG Ltd. 50* 51*> \date November 2011 52* 53*> \ingroup double_lin 54* 55* ===================================================================== 56 SUBROUTINE DERRLS( PATH, NUNIT ) 57* 58* -- LAPACK test routine (version 3.4.0) -- 59* -- LAPACK is a software package provided by Univ. of Tennessee, -- 60* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 61* November 2011 62* 63* .. Scalar Arguments .. 64 CHARACTER*3 PATH 65 INTEGER NUNIT 66* .. 67* 68* ===================================================================== 69* 70* .. Parameters .. 71 INTEGER NMAX 72 PARAMETER ( NMAX = 2 ) 73* .. 74* .. Local Scalars .. 75 CHARACTER*2 C2 76 INTEGER INFO, IRNK 77 DOUBLE PRECISION RCOND 78* .. 79* .. Local Arrays .. 80 INTEGER IP( NMAX ) 81 DOUBLE PRECISION A( NMAX, NMAX ), B( NMAX, NMAX ), S( NMAX ), 82 $ W( NMAX ) 83* .. 84* .. External Functions .. 85 LOGICAL LSAMEN 86 EXTERNAL LSAMEN 87* .. 88* .. External Subroutines .. 89 EXTERNAL ALAESM, CHKXER, DGELS, DGELSD, DGELSS, DGELSX, 90 $ DGELSY 91* .. 92* .. Scalars in Common .. 93 LOGICAL LERR, OK 94 CHARACTER*32 SRNAMT 95 INTEGER INFOT, NOUT 96* .. 97* .. Common blocks .. 98 COMMON / INFOC / INFOT, NOUT, OK, LERR 99 COMMON / SRNAMC / SRNAMT 100* .. 101* .. Executable Statements .. 102* 103 NOUT = NUNIT 104 WRITE( NOUT, FMT = * ) 105 C2 = PATH( 2: 3 ) 106 A( 1, 1 ) = 1.0D+0 107 A( 1, 2 ) = 2.0D+0 108 A( 2, 2 ) = 3.0D+0 109 A( 2, 1 ) = 4.0D+0 110 OK = .TRUE. 111* 112 IF( LSAMEN( 2, C2, 'LS' ) ) THEN 113* 114* Test error exits for the least squares driver routines. 115* 116* DGELS 117* 118 SRNAMT = 'DGELS ' 119 INFOT = 1 120 CALL DGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO ) 121 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 122 INFOT = 2 123 CALL DGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO ) 124 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 125 INFOT = 3 126 CALL DGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO ) 127 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 128 INFOT = 4 129 CALL DGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO ) 130 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 131 INFOT = 6 132 CALL DGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO ) 133 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 134 INFOT = 8 135 CALL DGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO ) 136 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 137 INFOT = 10 138 CALL DGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO ) 139 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 140* 141* DGELSS 142* 143 SRNAMT = 'DGELSS' 144 INFOT = 1 145 CALL DGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 146 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 147 INFOT = 2 148 CALL DGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 149 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 150 INFOT = 3 151 CALL DGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 152 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 153 INFOT = 5 154 CALL DGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, INFO ) 155 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 156 INFOT = 7 157 CALL DGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, INFO ) 158 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 159* 160* DGELSX 161* 162 SRNAMT = 'DGELSX' 163 INFOT = 1 164 CALL DGELSX( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO ) 165 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK ) 166 INFOT = 2 167 CALL DGELSX( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO ) 168 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK ) 169 INFOT = 3 170 CALL DGELSX( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, INFO ) 171 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK ) 172 INFOT = 5 173 CALL DGELSX( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, INFO ) 174 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK ) 175 INFOT = 7 176 CALL DGELSX( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, INFO ) 177 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK ) 178* 179* DGELSY 180* 181 SRNAMT = 'DGELSY' 182 INFOT = 1 183 CALL DGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 184 $ INFO ) 185 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 186 INFOT = 2 187 CALL DGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 188 $ INFO ) 189 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 190 INFOT = 3 191 CALL DGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 192 $ INFO ) 193 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 194 INFOT = 5 195 CALL DGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10, 196 $ INFO ) 197 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 198 INFOT = 7 199 CALL DGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10, 200 $ INFO ) 201 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 202 INFOT = 12 203 CALL DGELSY( 2, 2, 1, A, 2, B, 2, IP, RCOND, IRNK, W, 1, INFO ) 204 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 205* 206* DGELSD 207* 208 SRNAMT = 'DGELSD' 209 INFOT = 1 210 CALL DGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP, 211 $ INFO ) 212 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 213 INFOT = 2 214 CALL DGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP, 215 $ INFO ) 216 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 217 INFOT = 3 218 CALL DGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP, 219 $ INFO ) 220 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 221 INFOT = 5 222 CALL DGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10, IP, 223 $ INFO ) 224 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 225 INFOT = 7 226 CALL DGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10, IP, 227 $ INFO ) 228 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 229 INFOT = 12 230 CALL DGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, IP, 231 $ INFO ) 232 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 233 END IF 234* 235* Print a summary line. 236* 237 CALL ALAESM( PATH, OK, NOUT ) 238* 239 RETURN 240* 241* End of DERRLS 242* 243 END 244