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, 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*> \ingroup double_lin 52* 53* ===================================================================== 54 SUBROUTINE DERRLS( PATH, NUNIT ) 55* 56* -- LAPACK test routine -- 57* -- LAPACK is a software package provided by Univ. of Tennessee, -- 58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 59* 60* .. Scalar Arguments .. 61 CHARACTER*3 PATH 62 INTEGER NUNIT 63* .. 64* 65* ===================================================================== 66* 67* .. Parameters .. 68 INTEGER NMAX 69 PARAMETER ( NMAX = 2 ) 70* .. 71* .. Local Scalars .. 72 CHARACTER*2 C2 73 INTEGER INFO, IRNK 74 DOUBLE PRECISION RCOND 75* .. 76* .. Local Arrays .. 77 INTEGER IP( NMAX ) 78 DOUBLE PRECISION A( NMAX, NMAX ), B( NMAX, NMAX ), S( NMAX ), 79 $ W( NMAX ) 80* .. 81* .. External Functions .. 82 LOGICAL LSAMEN 83 EXTERNAL LSAMEN 84* .. 85* .. External Subroutines .. 86 EXTERNAL ALAESM, CHKXER, DGELS, DGELSD, DGELSS, DGELSY 87* .. 88* .. Scalars in Common .. 89 LOGICAL LERR, OK 90 CHARACTER*32 SRNAMT 91 INTEGER INFOT, NOUT 92* .. 93* .. Common blocks .. 94 COMMON / INFOC / INFOT, NOUT, OK, LERR 95 COMMON / SRNAMC / SRNAMT 96* .. 97* .. Executable Statements .. 98* 99 NOUT = NUNIT 100 WRITE( NOUT, FMT = * ) 101 C2 = PATH( 2: 3 ) 102 A( 1, 1 ) = 1.0D+0 103 A( 1, 2 ) = 2.0D+0 104 A( 2, 2 ) = 3.0D+0 105 A( 2, 1 ) = 4.0D+0 106 OK = .TRUE. 107* 108 IF( LSAMEN( 2, C2, 'LS' ) ) THEN 109* 110* Test error exits for the least squares driver routines. 111* 112* DGELS 113* 114 SRNAMT = 'DGELS ' 115 INFOT = 1 116 CALL DGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO ) 117 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 118 INFOT = 2 119 CALL DGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO ) 120 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 121 INFOT = 3 122 CALL DGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO ) 123 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 124 INFOT = 4 125 CALL DGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO ) 126 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 127 INFOT = 6 128 CALL DGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO ) 129 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 130 INFOT = 8 131 CALL DGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO ) 132 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 133 INFOT = 10 134 CALL DGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO ) 135 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 136* 137* DGELSS 138* 139 SRNAMT = 'DGELSS' 140 INFOT = 1 141 CALL DGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 142 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 143 INFOT = 2 144 CALL DGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 145 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 146 INFOT = 3 147 CALL DGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 148 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 149 INFOT = 5 150 CALL DGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, INFO ) 151 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 152 INFOT = 7 153 CALL DGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, INFO ) 154 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 155* 156* DGELSY 157* 158 SRNAMT = 'DGELSY' 159 INFOT = 1 160 CALL DGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 161 $ INFO ) 162 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 163 INFOT = 2 164 CALL DGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 165 $ INFO ) 166 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 167 INFOT = 3 168 CALL DGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 169 $ INFO ) 170 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 171 INFOT = 5 172 CALL DGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10, 173 $ INFO ) 174 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 175 INFOT = 7 176 CALL DGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10, 177 $ INFO ) 178 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 179 INFOT = 12 180 CALL DGELSY( 2, 2, 1, A, 2, B, 2, IP, RCOND, IRNK, W, 1, INFO ) 181 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 182* 183* DGELSD 184* 185 SRNAMT = 'DGELSD' 186 INFOT = 1 187 CALL DGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP, 188 $ INFO ) 189 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 190 INFOT = 2 191 CALL DGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP, 192 $ INFO ) 193 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 194 INFOT = 3 195 CALL DGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP, 196 $ INFO ) 197 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 198 INFOT = 5 199 CALL DGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10, IP, 200 $ INFO ) 201 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 202 INFOT = 7 203 CALL DGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10, IP, 204 $ INFO ) 205 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 206 INFOT = 12 207 CALL DGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, IP, 208 $ INFO ) 209 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 210 END IF 211* 212* Print a summary line. 213* 214 CALL ALAESM( PATH, OK, NOUT ) 215* 216 RETURN 217* 218* End of DERRLS 219* 220 END 221