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*> \ingroup complex16_lin 112* 113* ===================================================================== 114 DOUBLE PRECISION FUNCTION ZQRT14( TRANS, M, N, NRHS, A, LDA, X, 115 $ LDX, WORK, LWORK ) 116* 117* -- LAPACK test routine -- 118* -- LAPACK is a software package provided by Univ. of Tennessee, -- 119* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 120* 121* .. Scalar Arguments .. 122 CHARACTER TRANS 123 INTEGER LDA, LDX, LWORK, M, N, NRHS 124* .. 125* .. Array Arguments .. 126 COMPLEX*16 A( LDA, * ), WORK( LWORK ), X( LDX, * ) 127* .. 128* 129* ===================================================================== 130* 131* .. Parameters .. 132 DOUBLE PRECISION ZERO, ONE 133 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 134* .. 135* .. Local Scalars .. 136 LOGICAL TPSD 137 INTEGER I, INFO, J, LDWORK 138 DOUBLE PRECISION ANRM, ERR, XNRM 139* .. 140* .. Local Arrays .. 141 DOUBLE PRECISION RWORK( 1 ) 142* .. 143* .. External Functions .. 144 LOGICAL LSAME 145 DOUBLE PRECISION DLAMCH, ZLANGE 146 EXTERNAL LSAME, DLAMCH, ZLANGE 147* .. 148* .. External Subroutines .. 149 EXTERNAL XERBLA, ZGELQ2, ZGEQR2, ZLACPY, ZLASCL 150* .. 151* .. Intrinsic Functions .. 152 INTRINSIC ABS, DBLE, DCONJG, MAX, MIN 153* .. 154* .. Executable Statements .. 155* 156 ZQRT14 = ZERO 157 IF( LSAME( TRANS, 'N' ) ) THEN 158 LDWORK = M + NRHS 159 TPSD = .FALSE. 160 IF( LWORK.LT.( M+NRHS )*( N+2 ) ) THEN 161 CALL XERBLA( 'ZQRT14', 10 ) 162 RETURN 163 ELSE IF( N.LE.0 .OR. NRHS.LE.0 ) THEN 164 RETURN 165 END IF 166 ELSE IF( LSAME( TRANS, 'C' ) ) THEN 167 LDWORK = M 168 TPSD = .TRUE. 169 IF( LWORK.LT.( N+NRHS )*( M+2 ) ) THEN 170 CALL XERBLA( 'ZQRT14', 10 ) 171 RETURN 172 ELSE IF( M.LE.0 .OR. NRHS.LE.0 ) THEN 173 RETURN 174 END IF 175 ELSE 176 CALL XERBLA( 'ZQRT14', 1 ) 177 RETURN 178 END IF 179* 180* Copy and scale A 181* 182 CALL ZLACPY( 'All', M, N, A, LDA, WORK, LDWORK ) 183 ANRM = ZLANGE( 'M', M, N, WORK, LDWORK, RWORK ) 184 IF( ANRM.NE.ZERO ) 185 $ CALL ZLASCL( 'G', 0, 0, ANRM, ONE, M, N, WORK, LDWORK, INFO ) 186* 187* Copy X or X' into the right place and scale it 188* 189 IF( TPSD ) THEN 190* 191* Copy X into columns n+1:n+nrhs of work 192* 193 CALL ZLACPY( 'All', M, NRHS, X, LDX, WORK( N*LDWORK+1 ), 194 $ LDWORK ) 195 XNRM = ZLANGE( 'M', M, NRHS, WORK( N*LDWORK+1 ), LDWORK, 196 $ RWORK ) 197 IF( XNRM.NE.ZERO ) 198 $ CALL ZLASCL( 'G', 0, 0, XNRM, ONE, M, NRHS, 199 $ WORK( N*LDWORK+1 ), LDWORK, INFO ) 200* 201* Compute QR factorization of X 202* 203 CALL ZGEQR2( M, N+NRHS, WORK, LDWORK, 204 $ WORK( LDWORK*( N+NRHS )+1 ), 205 $ WORK( LDWORK*( N+NRHS )+MIN( M, N+NRHS )+1 ), 206 $ INFO ) 207* 208* Compute largest entry in upper triangle of 209* work(n+1:m,n+1:n+nrhs) 210* 211 ERR = ZERO 212 DO 20 J = N + 1, N + NRHS 213 DO 10 I = N + 1, MIN( M, J ) 214 ERR = MAX( ERR, ABS( WORK( I+( J-1 )*M ) ) ) 215 10 CONTINUE 216 20 CONTINUE 217* 218 ELSE 219* 220* Copy X' into rows m+1:m+nrhs of work 221* 222 DO 40 I = 1, N 223 DO 30 J = 1, NRHS 224 WORK( M+J+( I-1 )*LDWORK ) = DCONJG( X( I, J ) ) 225 30 CONTINUE 226 40 CONTINUE 227* 228 XNRM = ZLANGE( 'M', NRHS, N, WORK( M+1 ), LDWORK, RWORK ) 229 IF( XNRM.NE.ZERO ) 230 $ CALL ZLASCL( 'G', 0, 0, XNRM, ONE, NRHS, N, WORK( M+1 ), 231 $ LDWORK, INFO ) 232* 233* Compute LQ factorization of work 234* 235 CALL ZGELQ2( LDWORK, N, WORK, LDWORK, WORK( LDWORK*N+1 ), 236 $ WORK( LDWORK*( N+1 )+1 ), INFO ) 237* 238* Compute largest entry in lower triangle in 239* work(m+1:m+nrhs,m+1:n) 240* 241 ERR = ZERO 242 DO 60 J = M + 1, N 243 DO 50 I = J, LDWORK 244 ERR = MAX( ERR, ABS( WORK( I+( J-1 )*LDWORK ) ) ) 245 50 CONTINUE 246 60 CONTINUE 247* 248 END IF 249* 250 ZQRT14 = ERR / ( DBLE( MAX( M, N, NRHS ) )*DLAMCH( 'Epsilon' ) ) 251* 252 RETURN 253* 254* End of ZQRT14 255* 256 END 257