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