1*> \brief \b ZQRT13
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 ZQRT13( SCALE, M, N, A, LDA, NORMA, ISEED )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            LDA, M, N, SCALE
15*       DOUBLE PRECISION   NORMA
16*       ..
17*       .. Array Arguments ..
18*       INTEGER            ISEED( 4 )
19*       COMPLEX*16         A( LDA, * )
20*       ..
21*
22*
23*> \par Purpose:
24*  =============
25*>
26*> \verbatim
27*>
28*> ZQRT13 generates a full-rank matrix that may be scaled to have large
29*> or small norm.
30*> \endverbatim
31*
32*  Arguments:
33*  ==========
34*
35*> \param[in] SCALE
36*> \verbatim
37*>          SCALE is INTEGER
38*>          SCALE = 1: normally scaled matrix
39*>          SCALE = 2: matrix scaled up
40*>          SCALE = 3: matrix scaled down
41*> \endverbatim
42*>
43*> \param[in] M
44*> \verbatim
45*>          M is INTEGER
46*>          The number of rows of the matrix A.
47*> \endverbatim
48*>
49*> \param[in] N
50*> \verbatim
51*>          N is INTEGER
52*>          The number of columns of A.
53*> \endverbatim
54*>
55*> \param[out] A
56*> \verbatim
57*>          A is COMPLEX*16 array, dimension (LDA,N)
58*>          The M-by-N matrix A.
59*> \endverbatim
60*>
61*> \param[in] LDA
62*> \verbatim
63*>          LDA is INTEGER
64*>          The leading dimension of the array A.
65*> \endverbatim
66*>
67*> \param[out] NORMA
68*> \verbatim
69*>          NORMA is DOUBLE PRECISION
70*>          The one-norm of A.
71*> \endverbatim
72*>
73*> \param[in,out] ISEED
74*> \verbatim
75*>          ISEED is integer array, dimension (4)
76*>          Seed for random number generator
77*> \endverbatim
78*
79*  Authors:
80*  ========
81*
82*> \author Univ. of Tennessee
83*> \author Univ. of California Berkeley
84*> \author Univ. of Colorado Denver
85*> \author NAG Ltd.
86*
87*> \ingroup complex16_lin
88*
89*  =====================================================================
90      SUBROUTINE ZQRT13( SCALE, M, N, A, LDA, NORMA, ISEED )
91*
92*  -- LAPACK test routine --
93*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
94*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
95*
96*     .. Scalar Arguments ..
97      INTEGER            LDA, M, N, SCALE
98      DOUBLE PRECISION   NORMA
99*     ..
100*     .. Array Arguments ..
101      INTEGER            ISEED( 4 )
102      COMPLEX*16         A( LDA, * )
103*     ..
104*
105*  =====================================================================
106*
107*     .. Parameters ..
108      DOUBLE PRECISION   ONE
109      PARAMETER          ( ONE = 1.0D0 )
110*     ..
111*     .. Local Scalars ..
112      INTEGER            INFO, J
113      DOUBLE PRECISION   BIGNUM, SMLNUM
114*     ..
115*     .. External Functions ..
116      DOUBLE PRECISION   DLAMCH, DZASUM, ZLANGE
117      EXTERNAL           DLAMCH, DZASUM, ZLANGE
118*     ..
119*     .. External Subroutines ..
120      EXTERNAL           DLABAD, ZLARNV, ZLASCL
121*     ..
122*     .. Intrinsic Functions ..
123      INTRINSIC          DBLE, DCMPLX, SIGN
124*     ..
125*     .. Local Arrays ..
126      DOUBLE PRECISION   DUMMY( 1 )
127*     ..
128*     .. Executable Statements ..
129*
130      IF( M.LE.0 .OR. N.LE.0 )
131     $   RETURN
132*
133*     benign matrix
134*
135      DO 10 J = 1, N
136         CALL ZLARNV( 2, ISEED, M, A( 1, J ) )
137         IF( J.LE.M ) THEN
138            A( J, J ) = A( J, J ) + DCMPLX( SIGN( DZASUM( M, A( 1, J ),
139     $                  1 ), DBLE( A( J, J ) ) ) )
140         END IF
141   10 CONTINUE
142*
143*     scaled versions
144*
145      IF( SCALE.NE.1 ) THEN
146         NORMA = ZLANGE( 'Max', M, N, A, LDA, DUMMY )
147         SMLNUM = DLAMCH( 'Safe minimum' )
148         BIGNUM = ONE / SMLNUM
149         CALL DLABAD( SMLNUM, BIGNUM )
150         SMLNUM = SMLNUM / DLAMCH( 'Epsilon' )
151         BIGNUM = ONE / SMLNUM
152*
153         IF( SCALE.EQ.2 ) THEN
154*
155*           matrix scaled up
156*
157            CALL ZLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, LDA,
158     $                   INFO )
159         ELSE IF( SCALE.EQ.3 ) THEN
160*
161*           matrix scaled down
162*
163            CALL ZLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, LDA,
164     $                   INFO )
165         END IF
166      END IF
167*
168      NORMA = ZLANGE( 'One-norm', M, N, A, LDA, DUMMY )
169      RETURN
170*
171*     End of ZQRT13
172*
173      END
174