1*> \brief \b ZQRT14 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* DOUBLE PRECISION FUNCTION ZQRT14( TRANS, M, N, NRHS, A, LDA, X, 12* LDX, WORK, LWORK ) 13* 14* .. Scalar Arguments .. 15* CHARACTER TRANS 16* INTEGER LDA, LDX, LWORK, M, N, NRHS 17* .. 18* .. Array Arguments .. 19* COMPLEX*16 A( LDA, * ), WORK( LWORK ), X( LDX, * ) 20* .. 21* 22* 23*> \par Purpose: 24* ============= 25*> 26*> \verbatim 27*> 28*> ZQRT14 checks whether X is in the row space of A or A'. It does so 29*> by scaling both X and A such that their norms are in the range 30*> [sqrt(eps), 1/sqrt(eps)], then computing a QR factorization of [A,X] 31*> (if TRANS = 'C') or an LQ factorization of [A',X]' (if TRANS = 'N'), 32*> and returning the norm of the trailing triangle, scaled by 33*> MAX(M,N,NRHS)*eps. 34*> \endverbatim 35* 36* Arguments: 37* ========== 38* 39*> \param[in] TRANS 40*> \verbatim 41*> TRANS is CHARACTER*1 42*> = 'N': No transpose, check for X in the row space of A 43*> = 'C': Conjugate transpose, check for X in row space of A'. 44*> \endverbatim 45*> 46*> \param[in] M 47*> \verbatim 48*> M is INTEGER 49*> The number of rows of the matrix A. 50*> \endverbatim 51*> 52*> \param[in] N 53*> \verbatim 54*> N is INTEGER 55*> The number of columns of the matrix A. 56*> \endverbatim 57*> 58*> \param[in] NRHS 59*> \verbatim 60*> NRHS is INTEGER 61*> The number of right hand sides, i.e., the number of columns 62*> of X. 63*> \endverbatim 64*> 65*> \param[in] A 66*> \verbatim 67*> A is COMPLEX*16 array, dimension (LDA,N) 68*> The M-by-N matrix A. 69*> \endverbatim 70*> 71*> \param[in] LDA 72*> \verbatim 73*> LDA is INTEGER 74*> The leading dimension of the array A. 75*> \endverbatim 76*> 77*> \param[in] X 78*> \verbatim 79*> X is COMPLEX*16 array, dimension (LDX,NRHS) 80*> If TRANS = 'N', the N-by-NRHS matrix X. 81*> IF TRANS = 'C', the M-by-NRHS matrix X. 82*> \endverbatim 83*> 84*> \param[in] LDX 85*> \verbatim 86*> LDX is INTEGER 87*> The leading dimension of the array X. 88*> \endverbatim 89*> 90*> \param[out] WORK 91*> \verbatim 92*> WORK is COMPLEX*16 array dimension (LWORK) 93*> \endverbatim 94*> 95*> \param[in] LWORK 96*> \verbatim 97*> LWORK is INTEGER 98*> length of workspace array required 99*> If TRANS = 'N', LWORK >= (M+NRHS)*(N+2); 100*> if TRANS = 'C', LWORK >= (N+NRHS)*(M+2). 101*> \endverbatim 102* 103* Authors: 104* ======== 105* 106*> \author Univ. of Tennessee 107*> \author Univ. of California Berkeley 108*> \author Univ. of Colorado Denver 109*> \author NAG Ltd. 110* 111*> \date November 2011 112* 113*> \ingroup complex16_lin 114* 115* ===================================================================== 116 DOUBLE PRECISION FUNCTION ZQRT14( TRANS, M, N, NRHS, A, LDA, X, 117 $ LDX, WORK, LWORK ) 118* 119* -- LAPACK test routine (version 3.4.0) -- 120* -- LAPACK is a software package provided by Univ. of Tennessee, -- 121* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 122* November 2011 123* 124* .. Scalar Arguments .. 125 CHARACTER TRANS 126 INTEGER LDA, LDX, LWORK, M, N, NRHS 127* .. 128* .. Array Arguments .. 129 COMPLEX*16 A( LDA, * ), WORK( LWORK ), X( LDX, * ) 130* .. 131* 132* ===================================================================== 133* 134* .. Parameters .. 135 DOUBLE PRECISION ZERO, ONE 136 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 137* .. 138* .. Local Scalars .. 139 LOGICAL TPSD 140 INTEGER I, INFO, J, LDWORK 141 DOUBLE PRECISION ANRM, ERR, XNRM 142* .. 143* .. Local Arrays .. 144 DOUBLE PRECISION RWORK( 1 ) 145* .. 146* .. External Functions .. 147 LOGICAL LSAME 148 DOUBLE PRECISION DLAMCH, ZLANGE 149 EXTERNAL LSAME, DLAMCH, ZLANGE 150* .. 151* .. External Subroutines .. 152 EXTERNAL XERBLA, ZGELQ2, ZGEQR2, ZLACPY, ZLASCL 153* .. 154* .. Intrinsic Functions .. 155 INTRINSIC ABS, DBLE, DCONJG, MAX, MIN 156* .. 157* .. Executable Statements .. 158* 159 ZQRT14 = ZERO 160 IF( LSAME( TRANS, 'N' ) ) THEN 161 LDWORK = M + NRHS 162 TPSD = .FALSE. 163 IF( LWORK.LT.( M+NRHS )*( N+2 ) ) THEN 164 CALL XERBLA( 'ZQRT14', 10 ) 165 RETURN 166 ELSE IF( N.LE.0 .OR. NRHS.LE.0 ) THEN 167 RETURN 168 END IF 169 ELSE IF( LSAME( TRANS, 'C' ) ) THEN 170 LDWORK = M 171 TPSD = .TRUE. 172 IF( LWORK.LT.( N+NRHS )*( M+2 ) ) THEN 173 CALL XERBLA( 'ZQRT14', 10 ) 174 RETURN 175 ELSE IF( M.LE.0 .OR. NRHS.LE.0 ) THEN 176 RETURN 177 END IF 178 ELSE 179 CALL XERBLA( 'ZQRT14', 1 ) 180 RETURN 181 END IF 182* 183* Copy and scale A 184* 185 CALL ZLACPY( 'All', M, N, A, LDA, WORK, LDWORK ) 186 ANRM = ZLANGE( 'M', M, N, WORK, LDWORK, RWORK ) 187 IF( ANRM.NE.ZERO ) 188 $ CALL ZLASCL( 'G', 0, 0, ANRM, ONE, M, N, WORK, LDWORK, INFO ) 189* 190* Copy X or X' into the right place and scale it 191* 192 IF( TPSD ) THEN 193* 194* Copy X into columns n+1:n+nrhs of work 195* 196 CALL ZLACPY( 'All', M, NRHS, X, LDX, WORK( N*LDWORK+1 ), 197 $ LDWORK ) 198 XNRM = ZLANGE( 'M', M, NRHS, WORK( N*LDWORK+1 ), LDWORK, 199 $ RWORK ) 200 IF( XNRM.NE.ZERO ) 201 $ CALL ZLASCL( 'G', 0, 0, XNRM, ONE, M, NRHS, 202 $ WORK( N*LDWORK+1 ), LDWORK, INFO ) 203 ANRM = ZLANGE( 'One-norm', M, N+NRHS, WORK, LDWORK, RWORK ) 204* 205* Compute QR factorization of X 206* 207 CALL ZGEQR2( M, N+NRHS, WORK, LDWORK, 208 $ WORK( LDWORK*( N+NRHS )+1 ), 209 $ WORK( LDWORK*( N+NRHS )+MIN( M, N+NRHS )+1 ), 210 $ INFO ) 211* 212* Compute largest entry in upper triangle of 213* work(n+1:m,n+1:n+nrhs) 214* 215 ERR = ZERO 216 DO 20 J = N + 1, N + NRHS 217 DO 10 I = N + 1, MIN( M, J ) 218 ERR = MAX( ERR, ABS( WORK( I+( J-1 )*M ) ) ) 219 10 CONTINUE 220 20 CONTINUE 221* 222 ELSE 223* 224* Copy X' into rows m+1:m+nrhs of work 225* 226 DO 40 I = 1, N 227 DO 30 J = 1, NRHS 228 WORK( M+J+( I-1 )*LDWORK ) = DCONJG( X( I, J ) ) 229 30 CONTINUE 230 40 CONTINUE 231* 232 XNRM = ZLANGE( 'M', NRHS, N, WORK( M+1 ), LDWORK, RWORK ) 233 IF( XNRM.NE.ZERO ) 234 $ CALL ZLASCL( 'G', 0, 0, XNRM, ONE, NRHS, N, WORK( M+1 ), 235 $ LDWORK, INFO ) 236* 237* Compute LQ factorization of work 238* 239 CALL ZGELQ2( LDWORK, N, WORK, LDWORK, WORK( LDWORK*N+1 ), 240 $ WORK( LDWORK*( N+1 )+1 ), INFO ) 241* 242* Compute largest entry in lower triangle in 243* work(m+1:m+nrhs,m+1:n) 244* 245 ERR = ZERO 246 DO 60 J = M + 1, N 247 DO 50 I = J, LDWORK 248 ERR = MAX( ERR, ABS( WORK( I+( J-1 )*LDWORK ) ) ) 249 50 CONTINUE 250 60 CONTINUE 251* 252 END IF 253* 254 ZQRT14 = ERR / ( DBLE( MAX( M, N, NRHS ) )*DLAMCH( 'Epsilon' ) ) 255* 256 RETURN 257* 258* End of ZQRT14 259* 260 END 261