1*> \brief \b DQRT13
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 DQRT13( 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*       DOUBLE PRECISION   A( LDA, * )
20*       ..
21*
22*
23*> \par Purpose:
24*  =============
25*>
26*> \verbatim
27*>
28*> DQRT13 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 DOUBLE PRECISION 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*> \date November 2011
88*
89*> \ingroup double_lin
90*
91*  =====================================================================
92      SUBROUTINE DQRT13( SCALE, M, N, A, LDA, NORMA, ISEED )
93*
94*  -- LAPACK test routine (version 3.4.0) --
95*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
96*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
97*     November 2011
98*
99*     .. Scalar Arguments ..
100      INTEGER            LDA, M, N, SCALE
101      DOUBLE PRECISION   NORMA
102*     ..
103*     .. Array Arguments ..
104      INTEGER            ISEED( 4 )
105      DOUBLE PRECISION   A( LDA, * )
106*     ..
107*
108*  =====================================================================
109*
110*     .. Parameters ..
111      DOUBLE PRECISION   ONE
112      PARAMETER          ( ONE = 1.0D0 )
113*     ..
114*     .. Local Scalars ..
115      INTEGER            INFO, J
116      DOUBLE PRECISION   BIGNUM, SMLNUM
117*     ..
118*     .. External Functions ..
119      DOUBLE PRECISION   DASUM, DLAMCH, DLANGE
120      EXTERNAL           DASUM, DLAMCH, DLANGE
121*     ..
122*     .. External Subroutines ..
123      EXTERNAL           DLABAD, DLARNV, DLASCL
124*     ..
125*     .. Intrinsic Functions ..
126      INTRINSIC          SIGN
127*     ..
128*     .. Local Arrays ..
129      DOUBLE PRECISION   DUMMY( 1 )
130*     ..
131*     .. Executable Statements ..
132*
133      IF( M.LE.0 .OR. N.LE.0 )
134     $   RETURN
135*
136*     benign matrix
137*
138      DO 10 J = 1, N
139         CALL DLARNV( 2, ISEED, M, A( 1, J ) )
140         IF( J.LE.M ) THEN
141            A( J, J ) = A( J, J ) + SIGN( DASUM( M, A( 1, J ), 1 ),
142     $                  A( J, J ) )
143         END IF
144   10 CONTINUE
145*
146*     scaled versions
147*
148      IF( SCALE.NE.1 ) THEN
149         NORMA = DLANGE( 'Max', M, N, A, LDA, DUMMY )
150         SMLNUM = DLAMCH( 'Safe minimum' )
151         BIGNUM = ONE / SMLNUM
152         CALL DLABAD( SMLNUM, BIGNUM )
153         SMLNUM = SMLNUM / DLAMCH( 'Epsilon' )
154         BIGNUM = ONE / SMLNUM
155*
156         IF( SCALE.EQ.2 ) THEN
157*
158*           matrix scaled up
159*
160            CALL DLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, LDA,
161     $                   INFO )
162         ELSE IF( SCALE.EQ.3 ) THEN
163*
164*           matrix scaled down
165*
166            CALL DLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, LDA,
167     $                   INFO )
168         END IF
169      END IF
170*
171      NORMA = DLANGE( 'One-norm', M, N, A, LDA, DUMMY )
172      RETURN
173*
174*     End of DQRT13
175*
176      END
177