1*> \brief \b DERRTSQR 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 DERRTSQR( 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*> DERRTSQR tests the error exits for the DOUBLE PRECISION routines 25*> that use the TSQR decomposition of a general matrix. 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 DERRTSQR( PATH, NUNIT ) 55 IMPLICIT NONE 56* 57* -- LAPACK test routine -- 58* -- LAPACK is a software package provided by Univ. of Tennessee, -- 59* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 60* 61* .. Scalar Arguments .. 62 CHARACTER*3 PATH 63 INTEGER NUNIT 64* .. 65* 66* ===================================================================== 67* 68* .. Parameters .. 69 INTEGER NMAX 70 PARAMETER ( NMAX = 2 ) 71* .. 72* .. Local Scalars .. 73 INTEGER I, INFO, J, NB 74* .. 75* .. Local Arrays .. 76 DOUBLE PRECISION A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ), 77 $ C( NMAX, NMAX ), TAU(NMAX*2) 78* .. 79* .. External Subroutines .. 80 EXTERNAL ALAESM, CHKXER, DGEQR, 81 $ DGEMQR, DGELQ, DGEMLQ 82* .. 83* .. Scalars in Common .. 84 LOGICAL LERR, OK 85 CHARACTER*32 SRNAMT 86 INTEGER INFOT, NOUT 87* .. 88* .. Common blocks .. 89 COMMON / INFOC / INFOT, NOUT, OK, LERR 90 COMMON / SRNAMC / SRNAMT 91* .. 92* .. Intrinsic Functions .. 93 INTRINSIC DBLE 94* .. 95* .. Executable Statements .. 96* 97 NOUT = NUNIT 98 WRITE( NOUT, FMT = * ) 99* 100* Set the variables to innocuous values. 101* 102 DO J = 1, NMAX 103 DO I = 1, NMAX 104 A( I, J ) = 1.D0 / DBLE( I+J ) 105 C( I, J ) = 1.D0 / DBLE( I+J ) 106 T( I, J ) = 1.D0 / DBLE( I+J ) 107 END DO 108 W( J ) = 0.D0 109 END DO 110 OK = .TRUE. 111* 112* Error exits for TS factorization 113* 114* DGEQR 115* 116 SRNAMT = 'DGEQR' 117 INFOT = 1 118 CALL DGEQR( -1, 0, A, 1, TAU, 1, W, 1, INFO ) 119 CALL CHKXER( 'DGEQR', INFOT, NOUT, LERR, OK ) 120 INFOT = 2 121 CALL DGEQR( 0, -1, A, 1, TAU, 1, W, 1, INFO ) 122 CALL CHKXER( 'DGEQR', INFOT, NOUT, LERR, OK ) 123 INFOT = 4 124 CALL DGEQR( 1, 1, A, 0, TAU, 1, W, 1, INFO ) 125 CALL CHKXER( 'DGEQR', INFOT, NOUT, LERR, OK ) 126 INFOT = 6 127 CALL DGEQR( 3, 2, A, 3, TAU, 1, W, 1, INFO ) 128 CALL CHKXER( 'DGEQR', INFOT, NOUT, LERR, OK ) 129 INFOT = 8 130 CALL DGEQR( 3, 2, A, 3, TAU, 7, W, 0, INFO ) 131 CALL CHKXER( 'DGEQR', INFOT, NOUT, LERR, OK ) 132* 133* DGEMQR 134* 135 TAU(1)=1 136 TAU(2)=1 137 TAU(3)=1 138 TAU(4)=1 139 SRNAMT = 'DGEMQR' 140 NB=1 141 INFOT = 1 142 CALL DGEMQR( '/', 'N', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO) 143 CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK ) 144 INFOT = 2 145 CALL DGEMQR( 'L', '/', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO) 146 CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK ) 147 INFOT = 3 148 CALL DGEMQR( 'L', 'N', -1, 0, 0, A, 1, TAU, 1, C, 1, W,1,INFO) 149 CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK ) 150 INFOT = 4 151 CALL DGEMQR( 'L', 'N', 0, -1, 0, A, 1, TAU, 1, C, 1, W,1,INFO) 152 CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK ) 153 INFOT = 5 154 CALL DGEMQR( 'L', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO) 155 CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK ) 156 INFOT = 5 157 CALL DGEMQR( 'R', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO) 158 CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK ) 159 INFOT = 7 160 CALL DGEMQR( 'L', 'N', 2, 1, 0, A, 0, TAU, 1, C, 1, W, 1,INFO) 161 CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK ) 162 INFOT = 9 163 CALL DGEMQR( 'R', 'N', 2, 2, 1, A, 2, TAU, 0, C, 1, W, 1,INFO) 164 CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK ) 165 INFOT = 9 166 CALL DGEMQR( 'L', 'N', 2, 2, 1, A, 2, TAU, 0, C, 1, W, 1,INFO) 167 CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK ) 168 INFOT = 11 169 CALL DGEMQR( 'L', 'N', 2, 1, 1, A, 2, TAU, 6, C, 0, W, 1,INFO) 170 CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK ) 171 INFOT = 13 172 CALL DGEMQR( 'L', 'N', 2, 2, 1, A, 2, TAU, 6, C, 2, W, 0,INFO) 173 CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK ) 174* 175* DGELQ 176* 177 SRNAMT = 'DGELQ' 178 INFOT = 1 179 CALL DGELQ( -1, 0, A, 1, TAU, 1, W, 1, INFO ) 180 CALL CHKXER( 'DGELQ', INFOT, NOUT, LERR, OK ) 181 INFOT = 2 182 CALL DGELQ( 0, -1, A, 1, TAU, 1, W, 1, INFO ) 183 CALL CHKXER( 'DGELQ', INFOT, NOUT, LERR, OK ) 184 INFOT = 4 185 CALL DGELQ( 1, 1, A, 0, TAU, 1, W, 1, INFO ) 186 CALL CHKXER( 'DGELQ', INFOT, NOUT, LERR, OK ) 187 INFOT = 6 188 CALL DGELQ( 2, 3, A, 3, TAU, 1, W, 1, INFO ) 189 CALL CHKXER( 'DGELQ', INFOT, NOUT, LERR, OK ) 190 INFOT = 8 191 CALL DGELQ( 2, 3, A, 3, TAU, 7, W, 0, INFO ) 192 CALL CHKXER( 'DGELQ', INFOT, NOUT, LERR, OK ) 193* 194* DGEMLQ 195* 196 TAU(1)=1 197 TAU(2)=1 198 SRNAMT = 'DGEMLQ' 199 NB=1 200 INFOT = 1 201 CALL DGEMLQ( '/', 'N', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO) 202 CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK ) 203 INFOT = 2 204 CALL DGEMLQ( 'L', '/', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO) 205 CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK ) 206 INFOT = 3 207 CALL DGEMLQ( 'L', 'N', -1, 0, 0, A, 1, TAU, 1, C, 1, W,1,INFO) 208 CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK ) 209 INFOT = 4 210 CALL DGEMLQ( 'L', 'N', 0, -1, 0, A, 1, TAU, 1, C, 1, W,1,INFO) 211 CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK ) 212 INFOT = 5 213 CALL DGEMLQ( 'L', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO) 214 CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK ) 215 INFOT = 5 216 CALL DGEMLQ( 'R', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO) 217 CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK ) 218 INFOT = 7 219 CALL DGEMLQ( 'L', 'N', 1, 2, 0, A, 0, TAU, 1, C, 1, W, 1,INFO) 220 CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK ) 221 INFOT = 9 222 CALL DGEMLQ( 'R', 'N', 2, 2, 1, A, 1, TAU, 0, C, 1, W, 1,INFO) 223 CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK ) 224 INFOT = 9 225 CALL DGEMLQ( 'L', 'N', 2, 2, 1, A, 1, TAU, 0, C, 1, W, 1,INFO) 226 CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK ) 227 INFOT = 11 228 CALL DGEMLQ( 'L', 'N', 1, 2, 1, A, 1, TAU, 6, C, 0, W, 1,INFO) 229 CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK ) 230 INFOT = 13 231 CALL DGEMLQ( 'L', 'N', 2, 2, 1, A, 2, TAU, 6, C, 2, W, 0,INFO) 232 CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK ) 233* 234* Print a summary line. 235* 236 CALL ALAESM( PATH, OK, NOUT ) 237* 238 RETURN 239* 240* End of DERRTSQR 241* 242 END 243