1*> \brief \b ZERRTSQR 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 ZERRTSQR( 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*> ZERRTSQR tests the error exits for the ZOUBLE 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 Zenver 49*> \author NAG Ltd. 50* 51*> \ingroup double_lin 52* 53* ===================================================================== 54 SUBROUTINE ZERRTSQR( 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 COMPLEX*16 A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ), 77 $ C( NMAX, NMAX ), TAU(NMAX) 78* .. 79* .. External Subroutines .. 80 EXTERNAL ALAESM, CHKXER, ZGEQR, 81 $ ZGEMQR, ZGELQ, ZGEMLQ 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* ZGEQR 115* 116 SRNAMT = 'ZGEQR' 117 INFOT = 1 118 CALL ZGEQR( -1, 0, A, 1, TAU, 1, W, 1, INFO ) 119 CALL CHKXER( 'ZGEQR', INFOT, NOUT, LERR, OK ) 120 INFOT = 2 121 CALL ZGEQR( 0, -1, A, 1, TAU, 1, W, 1, INFO ) 122 CALL CHKXER( 'ZGEQR', INFOT, NOUT, LERR, OK ) 123 INFOT = 4 124 CALL ZGEQR( 1, 1, A, 0, TAU, 1, W, 1, INFO ) 125 CALL CHKXER( 'ZGEQR', INFOT, NOUT, LERR, OK ) 126 INFOT = 6 127 CALL ZGEQR( 3, 2, A, 3, TAU, 1, W, 1, INFO ) 128 CALL CHKXER( 'ZGEQR', INFOT, NOUT, LERR, OK ) 129 INFOT = 8 130 CALL ZGEQR( 3, 2, A, 3, TAU, 8, W, 0, INFO ) 131 CALL CHKXER( 'ZGEQR', INFOT, NOUT, LERR, OK ) 132* 133* ZGEMQR 134* 135 TAU(1)=1 136 TAU(2)=1 137 SRNAMT = 'ZGEMQR' 138 NB=1 139 INFOT = 1 140 CALL ZGEMQR( '/', 'N', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO) 141 CALL CHKXER( 'ZGEMQR', INFOT, NOUT, LERR, OK ) 142 INFOT = 2 143 CALL ZGEMQR( 'L', '/', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO) 144 CALL CHKXER( 'ZGEMQR', INFOT, NOUT, LERR, OK ) 145 INFOT = 3 146 CALL ZGEMQR( 'L', 'N', -1, 0, 0, A, 1, TAU, 1, C, 1, W,1,INFO) 147 CALL CHKXER( 'ZGEMQR', INFOT, NOUT, LERR, OK ) 148 INFOT = 4 149 CALL ZGEMQR( 'L', 'N', 0, -1, 0, A, 1, TAU, 1, C, 1, W,1,INFO) 150 CALL CHKXER( 'ZGEMQR', INFOT, NOUT, LERR, OK ) 151 INFOT = 5 152 CALL ZGEMQR( 'L', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO) 153 CALL CHKXER( 'ZGEMQR', INFOT, NOUT, LERR, OK ) 154 INFOT = 5 155 CALL ZGEMQR( 'R', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO) 156 CALL CHKXER( 'ZGEMQR', INFOT, NOUT, LERR, OK ) 157 INFOT = 7 158 CALL ZGEMQR( 'L', 'N', 2, 1, 0, A, 0, TAU, 1, C, 1, W, 1,INFO) 159 CALL CHKXER( 'ZGEMQR', INFOT, NOUT, LERR, OK ) 160 INFOT = 9 161 CALL ZGEMQR( 'R', 'N', 2, 2, 1, A, 2, TAU, 0, C, 1, W, 1,INFO) 162 CALL CHKXER( 'ZGEMQR', INFOT, NOUT, LERR, OK ) 163 INFOT = 9 164 CALL ZGEMQR( 'L', 'N', 2, 2, 1, A, 2, TAU, 0, C, 1, W, 1,INFO) 165 CALL CHKXER( 'ZGEMQR', INFOT, NOUT, LERR, OK ) 166 INFOT = 11 167 CALL ZGEMQR( 'L', 'N', 2, 1, 1, A, 2, TAU, 6, C, 0, W, 1,INFO) 168 CALL CHKXER( 'ZGEMQR', INFOT, NOUT, LERR, OK ) 169 INFOT = 13 170 CALL ZGEMQR( 'L', 'N', 2, 2, 1, A, 2, TAU, 6, C, 2, W, 0,INFO) 171 CALL CHKXER( 'ZGEMQR', INFOT, NOUT, LERR, OK ) 172* 173* ZGELQ 174* 175 SRNAMT = 'ZGELQ' 176 INFOT = 1 177 CALL ZGELQ( -1, 0, A, 1, TAU, 1, W, 1, INFO ) 178 CALL CHKXER( 'ZGELQ', INFOT, NOUT, LERR, OK ) 179 INFOT = 2 180 CALL ZGELQ( 0, -1, A, 1, TAU, 1, W, 1, INFO ) 181 CALL CHKXER( 'ZGELQ', INFOT, NOUT, LERR, OK ) 182 INFOT = 4 183 CALL ZGELQ( 1, 1, A, 0, TAU, 1, W, 1, INFO ) 184 CALL CHKXER( 'ZGELQ', INFOT, NOUT, LERR, OK ) 185 INFOT = 6 186 CALL ZGELQ( 2, 3, A, 3, TAU, 1, W, 1, INFO ) 187 CALL CHKXER( 'ZGELQ', INFOT, NOUT, LERR, OK ) 188 INFOT = 8 189 CALL ZGELQ( 2, 3, A, 3, TAU, 8, W, 0, INFO ) 190 CALL CHKXER( 'ZGELQ', INFOT, NOUT, LERR, OK ) 191* 192* ZGEMLQ 193* 194 TAU(1)=1 195 TAU(2)=1 196 SRNAMT = 'ZGEMLQ' 197 NB=1 198 INFOT = 1 199 CALL ZGEMLQ( '/', 'N', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO) 200 CALL CHKXER( 'ZGEMLQ', INFOT, NOUT, LERR, OK ) 201 INFOT = 2 202 CALL ZGEMLQ( 'L', '/', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO) 203 CALL CHKXER( 'ZGEMLQ', INFOT, NOUT, LERR, OK ) 204 INFOT = 3 205 CALL ZGEMLQ( 'L', 'N', -1, 0, 0, A, 1, TAU, 1, C, 1, W,1,INFO) 206 CALL CHKXER( 'ZGEMLQ', INFOT, NOUT, LERR, OK ) 207 INFOT = 4 208 CALL ZGEMLQ( 'L', 'N', 0, -1, 0, A, 1, TAU, 1, C, 1, W,1,INFO) 209 CALL CHKXER( 'ZGEMLQ', INFOT, NOUT, LERR, OK ) 210 INFOT = 5 211 CALL ZGEMLQ( 'L', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO) 212 CALL CHKXER( 'ZGEMLQ', INFOT, NOUT, LERR, OK ) 213 INFOT = 5 214 CALL ZGEMLQ( 'R', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO) 215 CALL CHKXER( 'ZGEMLQ', INFOT, NOUT, LERR, OK ) 216 INFOT = 7 217 CALL ZGEMLQ( 'L', 'N', 1, 2, 0, A, 0, TAU, 1, C, 1, W, 1,INFO) 218 CALL CHKXER( 'ZGEMLQ', INFOT, NOUT, LERR, OK ) 219 INFOT = 9 220 CALL ZGEMLQ( 'R', 'N', 2, 2, 1, A, 1, TAU, 0, C, 1, W, 1,INFO) 221 CALL CHKXER( 'ZGEMLQ', INFOT, NOUT, LERR, OK ) 222 INFOT = 9 223 CALL ZGEMLQ( 'L', 'N', 2, 2, 1, A, 1, TAU, 0, C, 1, W, 1,INFO) 224 CALL CHKXER( 'ZGEMLQ', INFOT, NOUT, LERR, OK ) 225 INFOT = 11 226 CALL ZGEMLQ( 'L', 'N', 1, 2, 1, A, 1, TAU, 6, C, 0, W, 1,INFO) 227 CALL CHKXER( 'ZGEMLQ', INFOT, NOUT, LERR, OK ) 228 INFOT = 13 229 CALL ZGEMLQ( 'L', 'N', 2, 2, 1, A, 2, TAU, 6, C, 2, W, 0,INFO) 230 CALL CHKXER( 'ZGEMLQ', INFOT, NOUT, LERR, OK ) 231* 232* Print a summary line. 233* 234 CALL ALAESM( PATH, OK, NOUT ) 235* 236 RETURN 237* 238* End of ZERRTSQR 239* 240 END 241