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 December 2016
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.7.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*     December 2016
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