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*> \ingroup complex16_lin 145* 146* ===================================================================== 147 SUBROUTINE ZQRT15( SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, 148 $ RANK, NORMA, NORMB, ISEED, WORK, LWORK ) 149* 150* -- LAPACK test routine -- 151* -- LAPACK is a software package provided by Univ. of Tennessee, -- 152* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 153* 154* .. Scalar Arguments .. 155 INTEGER LDA, LDB, LWORK, M, N, NRHS, RANK, RKSEL, SCALE 156 DOUBLE PRECISION NORMA, NORMB 157* .. 158* .. Array Arguments .. 159 INTEGER ISEED( 4 ) 160 DOUBLE PRECISION S( * ) 161 COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( LWORK ) 162* .. 163* 164* ===================================================================== 165* 166* .. Parameters .. 167 DOUBLE PRECISION ZERO, ONE, TWO, SVMIN 168 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0, 169 $ SVMIN = 0.1D+0 ) 170 COMPLEX*16 CZERO, CONE 171 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), 172 $ CONE = ( 1.0D+0, 0.0D+0 ) ) 173* .. 174* .. Local Scalars .. 175 INTEGER INFO, J, MN 176 DOUBLE PRECISION BIGNUM, EPS, SMLNUM, TEMP 177* .. 178* .. Local Arrays .. 179 DOUBLE PRECISION DUMMY( 1 ) 180* .. 181* .. External Functions .. 182 DOUBLE PRECISION DASUM, DLAMCH, DLARND, DZNRM2, ZLANGE 183 EXTERNAL DASUM, DLAMCH, DLARND, DZNRM2, ZLANGE 184* .. 185* .. External Subroutines .. 186 EXTERNAL DLABAD, DLAORD, DLASCL, XERBLA, ZDSCAL, ZGEMM, 187 $ ZLARF, ZLARNV, ZLAROR, ZLASCL, ZLASET 188* .. 189* .. Intrinsic Functions .. 190 INTRINSIC ABS, DCMPLX, MAX, MIN 191* .. 192* .. Executable Statements .. 193* 194 MN = MIN( M, N ) 195 IF( LWORK.LT.MAX( M+MN, MN*NRHS, 2*N+M ) ) THEN 196 CALL XERBLA( 'ZQRT15', 16 ) 197 RETURN 198 END IF 199* 200 SMLNUM = DLAMCH( 'Safe minimum' ) 201 BIGNUM = ONE / SMLNUM 202 CALL DLABAD( SMLNUM, BIGNUM ) 203 EPS = DLAMCH( 'Epsilon' ) 204 SMLNUM = ( SMLNUM / EPS ) / EPS 205 BIGNUM = ONE / SMLNUM 206* 207* Determine rank and (unscaled) singular values 208* 209 IF( RKSEL.EQ.1 ) THEN 210 RANK = MN 211 ELSE IF( RKSEL.EQ.2 ) THEN 212 RANK = ( 3*MN ) / 4 213 DO 10 J = RANK + 1, MN 214 S( J ) = ZERO 215 10 CONTINUE 216 ELSE 217 CALL XERBLA( 'ZQRT15', 2 ) 218 END IF 219* 220 IF( RANK.GT.0 ) THEN 221* 222* Nontrivial case 223* 224 S( 1 ) = ONE 225 DO 30 J = 2, RANK 226 20 CONTINUE 227 TEMP = DLARND( 1, ISEED ) 228 IF( TEMP.GT.SVMIN ) THEN 229 S( J ) = ABS( TEMP ) 230 ELSE 231 GO TO 20 232 END IF 233 30 CONTINUE 234 CALL DLAORD( 'Decreasing', RANK, S, 1 ) 235* 236* Generate 'rank' columns of a random orthogonal matrix in A 237* 238 CALL ZLARNV( 2, ISEED, M, WORK ) 239 CALL ZDSCAL( M, ONE / DZNRM2( M, WORK, 1 ), WORK, 1 ) 240 CALL ZLASET( 'Full', M, RANK, CZERO, CONE, A, LDA ) 241 CALL ZLARF( 'Left', M, RANK, WORK, 1, DCMPLX( TWO ), A, LDA, 242 $ WORK( M+1 ) ) 243* 244* workspace used: m+mn 245* 246* Generate consistent rhs in the range space of A 247* 248 CALL ZLARNV( 2, ISEED, RANK*NRHS, WORK ) 249 CALL ZGEMM( 'No transpose', 'No transpose', M, NRHS, RANK, 250 $ CONE, A, LDA, WORK, RANK, CZERO, B, LDB ) 251* 252* work space used: <= mn *nrhs 253* 254* generate (unscaled) matrix A 255* 256 DO 40 J = 1, RANK 257 CALL ZDSCAL( M, S( J ), A( 1, J ), 1 ) 258 40 CONTINUE 259 IF( RANK.LT.N ) 260 $ CALL ZLASET( 'Full', M, N-RANK, CZERO, CZERO, 261 $ A( 1, RANK+1 ), LDA ) 262 CALL ZLAROR( 'Right', 'No initialization', M, N, A, LDA, ISEED, 263 $ WORK, INFO ) 264* 265 ELSE 266* 267* work space used 2*n+m 268* 269* Generate null matrix and rhs 270* 271 DO 50 J = 1, MN 272 S( J ) = ZERO 273 50 CONTINUE 274 CALL ZLASET( 'Full', M, N, CZERO, CZERO, A, LDA ) 275 CALL ZLASET( 'Full', M, NRHS, CZERO, CZERO, B, LDB ) 276* 277 END IF 278* 279* Scale the matrix 280* 281 IF( SCALE.NE.1 ) THEN 282 NORMA = ZLANGE( 'Max', M, N, A, LDA, DUMMY ) 283 IF( NORMA.NE.ZERO ) THEN 284 IF( SCALE.EQ.2 ) THEN 285* 286* matrix scaled up 287* 288 CALL ZLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, 289 $ LDA, INFO ) 290 CALL DLASCL( 'General', 0, 0, NORMA, BIGNUM, MN, 1, S, 291 $ MN, INFO ) 292 CALL ZLASCL( 'General', 0, 0, NORMA, BIGNUM, M, NRHS, B, 293 $ LDB, INFO ) 294 ELSE IF( SCALE.EQ.3 ) THEN 295* 296* matrix scaled down 297* 298 CALL ZLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, 299 $ LDA, INFO ) 300 CALL DLASCL( 'General', 0, 0, NORMA, SMLNUM, MN, 1, S, 301 $ MN, INFO ) 302 CALL ZLASCL( 'General', 0, 0, NORMA, SMLNUM, M, NRHS, B, 303 $ LDB, INFO ) 304 ELSE 305 CALL XERBLA( 'ZQRT15', 1 ) 306 RETURN 307 END IF 308 END IF 309 END IF 310* 311 NORMA = DASUM( MN, S, 1 ) 312 NORMB = ZLANGE( 'One-norm', M, NRHS, B, LDB, DUMMY ) 313* 314 RETURN 315* 316* End of ZQRT15 317* 318 END 319