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*> \date December 2016 52* 53*> \ingroup double_lin 54* 55* ===================================================================== 56 SUBROUTINE DERRLS( PATH, NUNIT ) 57* 58* -- LAPACK test routine (version 3.7.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* December 2016 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, DGELSY 90* .. 91* .. Scalars in Common .. 92 LOGICAL LERR, OK 93 CHARACTER*32 SRNAMT 94 INTEGER INFOT, NOUT 95* .. 96* .. Common blocks .. 97 COMMON / INFOC / INFOT, NOUT, OK, LERR 98 COMMON / SRNAMC / SRNAMT 99* .. 100* .. Executable Statements .. 101* 102 NOUT = NUNIT 103 WRITE( NOUT, FMT = * ) 104 C2 = PATH( 2: 3 ) 105 A( 1, 1 ) = 1.0D+0 106 A( 1, 2 ) = 2.0D+0 107 A( 2, 2 ) = 3.0D+0 108 A( 2, 1 ) = 4.0D+0 109 OK = .TRUE. 110* 111 IF( LSAMEN( 2, C2, 'LS' ) ) THEN 112* 113* Test error exits for the least squares driver routines. 114* 115* DGELS 116* 117 SRNAMT = 'DGELS ' 118 INFOT = 1 119 CALL DGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO ) 120 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 121 INFOT = 2 122 CALL DGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO ) 123 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 124 INFOT = 3 125 CALL DGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO ) 126 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 127 INFOT = 4 128 CALL DGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO ) 129 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 130 INFOT = 6 131 CALL DGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO ) 132 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 133 INFOT = 8 134 CALL DGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO ) 135 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 136 INFOT = 10 137 CALL DGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO ) 138 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK ) 139* 140* DGELSS 141* 142 SRNAMT = 'DGELSS' 143 INFOT = 1 144 CALL DGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 145 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 146 INFOT = 2 147 CALL DGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 148 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 149 INFOT = 3 150 CALL DGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO ) 151 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 152 INFOT = 5 153 CALL DGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, INFO ) 154 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 155 INFOT = 7 156 CALL DGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, INFO ) 157 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK ) 158* 159* DGELSY 160* 161 SRNAMT = 'DGELSY' 162 INFOT = 1 163 CALL DGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 164 $ INFO ) 165 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 166 INFOT = 2 167 CALL DGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 168 $ INFO ) 169 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 170 INFOT = 3 171 CALL DGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10, 172 $ INFO ) 173 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 174 INFOT = 5 175 CALL DGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10, 176 $ INFO ) 177 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 178 INFOT = 7 179 CALL DGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10, 180 $ INFO ) 181 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 182 INFOT = 12 183 CALL DGELSY( 2, 2, 1, A, 2, B, 2, IP, RCOND, IRNK, W, 1, INFO ) 184 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK ) 185* 186* DGELSD 187* 188 SRNAMT = 'DGELSD' 189 INFOT = 1 190 CALL DGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP, 191 $ INFO ) 192 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 193 INFOT = 2 194 CALL DGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP, 195 $ INFO ) 196 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 197 INFOT = 3 198 CALL DGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP, 199 $ INFO ) 200 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 201 INFOT = 5 202 CALL DGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10, IP, 203 $ INFO ) 204 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 205 INFOT = 7 206 CALL DGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10, IP, 207 $ INFO ) 208 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 209 INFOT = 12 210 CALL DGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, IP, 211 $ INFO ) 212 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK ) 213 END IF 214* 215* Print a summary line. 216* 217 CALL ALAESM( PATH, OK, NOUT ) 218* 219 RETURN 220* 221* End of DERRLS 222* 223 END 224