1*> \brief \b ZQRT15 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 ZQRT15( SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, 12* RANK, NORMA, NORMB, ISEED, WORK, LWORK ) 13* 14* .. Scalar Arguments .. 15* INTEGER LDA, LDB, LWORK, M, N, NRHS, RANK, RKSEL, SCALE 16* DOUBLE PRECISION NORMA, NORMB 17* .. 18* .. Array Arguments .. 19* INTEGER ISEED( 4 ) 20* DOUBLE PRECISION S( * ) 21* COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( LWORK ) 22* .. 23* 24* 25*> \par Purpose: 26* ============= 27*> 28*> \verbatim 29*> 30*> ZQRT15 generates a matrix with full or deficient rank and of various 31*> norms. 32*> \endverbatim 33* 34* Arguments: 35* ========== 36* 37*> \param[in] SCALE 38*> \verbatim 39*> SCALE is INTEGER 40*> SCALE = 1: normally scaled matrix 41*> SCALE = 2: matrix scaled up 42*> SCALE = 3: matrix scaled down 43*> \endverbatim 44*> 45*> \param[in] RKSEL 46*> \verbatim 47*> RKSEL is INTEGER 48*> RKSEL = 1: full rank matrix 49*> RKSEL = 2: rank-deficient matrix 50*> \endverbatim 51*> 52*> \param[in] M 53*> \verbatim 54*> M is INTEGER 55*> The number of rows of the matrix A. 56*> \endverbatim 57*> 58*> \param[in] N 59*> \verbatim 60*> N is INTEGER 61*> The number of columns of A. 62*> \endverbatim 63*> 64*> \param[in] NRHS 65*> \verbatim 66*> NRHS is INTEGER 67*> The number of columns of B. 68*> \endverbatim 69*> 70*> \param[out] A 71*> \verbatim 72*> A is COMPLEX*16 array, dimension (LDA,N) 73*> The M-by-N matrix A. 74*> \endverbatim 75*> 76*> \param[in] LDA 77*> \verbatim 78*> LDA is INTEGER 79*> The leading dimension of the array A. 80*> \endverbatim 81*> 82*> \param[out] B 83*> \verbatim 84*> B is COMPLEX*16 array, dimension (LDB, NRHS) 85*> A matrix that is in the range space of matrix A. 86*> \endverbatim 87*> 88*> \param[in] LDB 89*> \verbatim 90*> LDB is INTEGER 91*> The leading dimension of the array B. 92*> \endverbatim 93*> 94*> \param[out] S 95*> \verbatim 96*> S is DOUBLE PRECISION array, dimension MIN(M,N) 97*> Singular values of A. 98*> \endverbatim 99*> 100*> \param[out] RANK 101*> \verbatim 102*> RANK is INTEGER 103*> number of nonzero singular values of A. 104*> \endverbatim 105*> 106*> \param[out] NORMA 107*> \verbatim 108*> NORMA is DOUBLE PRECISION 109*> one-norm norm of A. 110*> \endverbatim 111*> 112*> \param[out] NORMB 113*> \verbatim 114*> NORMB is DOUBLE PRECISION 115*> one-norm norm of B. 116*> \endverbatim 117*> 118*> \param[in,out] ISEED 119*> \verbatim 120*> ISEED is integer array, dimension (4) 121*> seed for random number generator. 122*> \endverbatim 123*> 124*> \param[out] WORK 125*> \verbatim 126*> WORK is COMPLEX*16 array, dimension (LWORK) 127*> \endverbatim 128*> 129*> \param[in] LWORK 130*> \verbatim 131*> LWORK is INTEGER 132*> length of work space required. 133*> LWORK >= MAX(M+MIN(M,N),NRHS*MIN(M,N),2*N+M) 134*> \endverbatim 135* 136* Authors: 137* ======== 138* 139*> \author Univ. of Tennessee 140*> \author Univ. of California Berkeley 141*> \author Univ. of Colorado Denver 142*> \author NAG Ltd. 143* 144*> \date November 2011 145* 146*> \ingroup complex16_lin 147* 148* ===================================================================== 149 SUBROUTINE ZQRT15( SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, 150 $ RANK, NORMA, NORMB, ISEED, WORK, LWORK ) 151* 152* -- LAPACK test routine (version 3.4.0) -- 153* -- LAPACK is a software package provided by Univ. of Tennessee, -- 154* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 155* November 2011 156* 157* .. Scalar Arguments .. 158 INTEGER LDA, LDB, LWORK, M, N, NRHS, RANK, RKSEL, SCALE 159 DOUBLE PRECISION NORMA, NORMB 160* .. 161* .. Array Arguments .. 162 INTEGER ISEED( 4 ) 163 DOUBLE PRECISION S( * ) 164 COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( LWORK ) 165* .. 166* 167* ===================================================================== 168* 169* .. Parameters .. 170 DOUBLE PRECISION ZERO, ONE, TWO, SVMIN 171 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0, 172 $ SVMIN = 0.1D+0 ) 173 COMPLEX*16 CZERO, CONE 174 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), 175 $ CONE = ( 1.0D+0, 0.0D+0 ) ) 176* .. 177* .. Local Scalars .. 178 INTEGER INFO, J, MN 179 DOUBLE PRECISION BIGNUM, EPS, SMLNUM, TEMP 180* .. 181* .. Local Arrays .. 182 DOUBLE PRECISION DUMMY( 1 ) 183* .. 184* .. External Functions .. 185 DOUBLE PRECISION DASUM, DLAMCH, DLARND, DZNRM2, ZLANGE 186 EXTERNAL DASUM, DLAMCH, DLARND, DZNRM2, ZLANGE 187* .. 188* .. External Subroutines .. 189 EXTERNAL DLABAD, DLAORD, DLASCL, XERBLA, ZDSCAL, ZGEMM, 190 $ ZLARF, ZLARNV, ZLAROR, ZLASCL, ZLASET 191* .. 192* .. Intrinsic Functions .. 193 INTRINSIC ABS, DCMPLX, MAX, MIN 194* .. 195* .. Executable Statements .. 196* 197 MN = MIN( M, N ) 198 IF( LWORK.LT.MAX( M+MN, MN*NRHS, 2*N+M ) ) THEN 199 CALL XERBLA( 'ZQRT15', 16 ) 200 RETURN 201 END IF 202* 203 SMLNUM = DLAMCH( 'Safe minimum' ) 204 BIGNUM = ONE / SMLNUM 205 CALL DLABAD( SMLNUM, BIGNUM ) 206 EPS = DLAMCH( 'Epsilon' ) 207 SMLNUM = ( SMLNUM / EPS ) / EPS 208 BIGNUM = ONE / SMLNUM 209* 210* Determine rank and (unscaled) singular values 211* 212 IF( RKSEL.EQ.1 ) THEN 213 RANK = MN 214 ELSE IF( RKSEL.EQ.2 ) THEN 215 RANK = ( 3*MN ) / 4 216 DO 10 J = RANK + 1, MN 217 S( J ) = ZERO 218 10 CONTINUE 219 ELSE 220 CALL XERBLA( 'ZQRT15', 2 ) 221 END IF 222* 223 IF( RANK.GT.0 ) THEN 224* 225* Nontrivial case 226* 227 S( 1 ) = ONE 228 DO 30 J = 2, RANK 229 20 CONTINUE 230 TEMP = DLARND( 1, ISEED ) 231 IF( TEMP.GT.SVMIN ) THEN 232 S( J ) = ABS( TEMP ) 233 ELSE 234 GO TO 20 235 END IF 236 30 CONTINUE 237 CALL DLAORD( 'Decreasing', RANK, S, 1 ) 238* 239* Generate 'rank' columns of a random orthogonal matrix in A 240* 241 CALL ZLARNV( 2, ISEED, M, WORK ) 242 CALL ZDSCAL( M, ONE / DZNRM2( M, WORK, 1 ), WORK, 1 ) 243 CALL ZLASET( 'Full', M, RANK, CZERO, CONE, A, LDA ) 244 CALL ZLARF( 'Left', M, RANK, WORK, 1, DCMPLX( TWO ), A, LDA, 245 $ WORK( M+1 ) ) 246* 247* workspace used: m+mn 248* 249* Generate consistent rhs in the range space of A 250* 251 CALL ZLARNV( 2, ISEED, RANK*NRHS, WORK ) 252 CALL ZGEMM( 'No transpose', 'No transpose', M, NRHS, RANK, 253 $ CONE, A, LDA, WORK, RANK, CZERO, B, LDB ) 254* 255* work space used: <= mn *nrhs 256* 257* generate (unscaled) matrix A 258* 259 DO 40 J = 1, RANK 260 CALL ZDSCAL( M, S( J ), A( 1, J ), 1 ) 261 40 CONTINUE 262 IF( RANK.LT.N ) 263 $ CALL ZLASET( 'Full', M, N-RANK, CZERO, CZERO, 264 $ A( 1, RANK+1 ), LDA ) 265 CALL ZLAROR( 'Right', 'No initialization', M, N, A, LDA, ISEED, 266 $ WORK, INFO ) 267* 268 ELSE 269* 270* work space used 2*n+m 271* 272* Generate null matrix and rhs 273* 274 DO 50 J = 1, MN 275 S( J ) = ZERO 276 50 CONTINUE 277 CALL ZLASET( 'Full', M, N, CZERO, CZERO, A, LDA ) 278 CALL ZLASET( 'Full', M, NRHS, CZERO, CZERO, B, LDB ) 279* 280 END IF 281* 282* Scale the matrix 283* 284 IF( SCALE.NE.1 ) THEN 285 NORMA = ZLANGE( 'Max', M, N, A, LDA, DUMMY ) 286 IF( NORMA.NE.ZERO ) THEN 287 IF( SCALE.EQ.2 ) THEN 288* 289* matrix scaled up 290* 291 CALL ZLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, 292 $ LDA, INFO ) 293 CALL DLASCL( 'General', 0, 0, NORMA, BIGNUM, MN, 1, S, 294 $ MN, INFO ) 295 CALL ZLASCL( 'General', 0, 0, NORMA, BIGNUM, M, NRHS, B, 296 $ LDB, INFO ) 297 ELSE IF( SCALE.EQ.3 ) THEN 298* 299* matrix scaled down 300* 301 CALL ZLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, 302 $ LDA, INFO ) 303 CALL DLASCL( 'General', 0, 0, NORMA, SMLNUM, MN, 1, S, 304 $ MN, INFO ) 305 CALL ZLASCL( 'General', 0, 0, NORMA, SMLNUM, M, NRHS, B, 306 $ LDB, INFO ) 307 ELSE 308 CALL XERBLA( 'ZQRT15', 1 ) 309 RETURN 310 END IF 311 END IF 312 END IF 313* 314 NORMA = DASUM( MN, S, 1 ) 315 NORMB = ZLANGE( 'One-norm', M, NRHS, B, LDB, DUMMY ) 316* 317 RETURN 318* 319* End of ZQRT15 320* 321 END 322