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