1 SUBROUTINE DQRT13( SCALE, M, N, A, LDA, NORMA, ISEED )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER LDA, M, N, SCALE
9 DOUBLE PRECISION NORMA
10 * ..
11 * .. Array Arguments ..
12 INTEGER ISEED( 4 )
13 DOUBLE PRECISION A( LDA, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DQRT13 generates a full-rank matrix that may be scaled to have large
20 * or small norm.
21 *
22 * Arguments
23 * =========
24 *
25 * SCALE (input) INTEGER
26 * SCALE = 1: normally scaled matrix
27 * SCALE = 2: matrix scaled up
28 * SCALE = 3: matrix scaled down
29 *
30 * M (input) INTEGER
31 * The number of rows of the matrix A.
32 *
33 * N (input) INTEGER
34 * The number of columns of A.
35 *
36 * A (output) DOUBLE PRECISION array, dimension (LDA,N)
37 * The M-by-N matrix A.
38 *
39 * LDA (input) INTEGER
40 * The leading dimension of the array A.
41 *
42 * NORMA (output) DOUBLE PRECISION
43 * The one-norm of A.
44 *
45 * ISEED (input/output) integer array, dimension (4)
46 * Seed for random number generator
47 *
48 * =====================================================================
49 *
50 * .. Parameters ..
51 DOUBLE PRECISION ONE
52 PARAMETER ( ONE = 1.0D0 )
53 * ..
54 * .. Local Scalars ..
55 INTEGER INFO, J
56 DOUBLE PRECISION BIGNUM, SMLNUM
57 * ..
58 * .. External Functions ..
59 DOUBLE PRECISION DASUM, DLAMCH, DLANGE
60 EXTERNAL DASUM, DLAMCH, DLANGE
61 * ..
62 * .. External Subroutines ..
63 EXTERNAL DLABAD, DLARNV, DLASCL
64 * ..
65 * .. Intrinsic Functions ..
66 INTRINSIC SIGN
67 * ..
68 * .. Local Arrays ..
69 DOUBLE PRECISION DUMMY( 1 )
70 * ..
71 * .. Executable Statements ..
72 *
73 IF( M.LE.0 .OR. N.LE.0 )
74 $ RETURN
75 *
76 * benign matrix
77 *
78 DO 10 J = 1, N
79 CALL DLARNV( 2, ISEED, M, A( 1, J ) )
80 IF( J.LE.M ) THEN
81 A( J, J ) = A( J, J ) + SIGN( DASUM( M, A( 1, J ), 1 ),
82 $ A( J, J ) )
83 END IF
84 10 CONTINUE
85 *
86 * scaled versions
87 *
88 IF( SCALE.NE.1 ) THEN
89 NORMA = DLANGE( 'Max', M, N, A, LDA, DUMMY )
90 SMLNUM = DLAMCH( 'Safe minimum' )
91 BIGNUM = ONE / SMLNUM
92 CALL DLABAD( SMLNUM, BIGNUM )
93 SMLNUM = SMLNUM / DLAMCH( 'Epsilon' )
94 BIGNUM = ONE / SMLNUM
95 *
96 IF( SCALE.EQ.2 ) THEN
97 *
98 * matrix scaled up
99 *
100 CALL DLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, LDA,
101 $ INFO )
102 ELSE IF( SCALE.EQ.3 ) THEN
103 *
104 * matrix scaled down
105 *
106 CALL DLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, LDA,
107 $ INFO )
108 END IF
109 END IF
110 *
111 NORMA = DLANGE( 'One-norm', M, N, A, LDA, DUMMY )
112 RETURN
113 *
114 * End of DQRT13
115 *
116 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER LDA, M, N, SCALE
9 DOUBLE PRECISION NORMA
10 * ..
11 * .. Array Arguments ..
12 INTEGER ISEED( 4 )
13 DOUBLE PRECISION A( LDA, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DQRT13 generates a full-rank matrix that may be scaled to have large
20 * or small norm.
21 *
22 * Arguments
23 * =========
24 *
25 * SCALE (input) INTEGER
26 * SCALE = 1: normally scaled matrix
27 * SCALE = 2: matrix scaled up
28 * SCALE = 3: matrix scaled down
29 *
30 * M (input) INTEGER
31 * The number of rows of the matrix A.
32 *
33 * N (input) INTEGER
34 * The number of columns of A.
35 *
36 * A (output) DOUBLE PRECISION array, dimension (LDA,N)
37 * The M-by-N matrix A.
38 *
39 * LDA (input) INTEGER
40 * The leading dimension of the array A.
41 *
42 * NORMA (output) DOUBLE PRECISION
43 * The one-norm of A.
44 *
45 * ISEED (input/output) integer array, dimension (4)
46 * Seed for random number generator
47 *
48 * =====================================================================
49 *
50 * .. Parameters ..
51 DOUBLE PRECISION ONE
52 PARAMETER ( ONE = 1.0D0 )
53 * ..
54 * .. Local Scalars ..
55 INTEGER INFO, J
56 DOUBLE PRECISION BIGNUM, SMLNUM
57 * ..
58 * .. External Functions ..
59 DOUBLE PRECISION DASUM, DLAMCH, DLANGE
60 EXTERNAL DASUM, DLAMCH, DLANGE
61 * ..
62 * .. External Subroutines ..
63 EXTERNAL DLABAD, DLARNV, DLASCL
64 * ..
65 * .. Intrinsic Functions ..
66 INTRINSIC SIGN
67 * ..
68 * .. Local Arrays ..
69 DOUBLE PRECISION DUMMY( 1 )
70 * ..
71 * .. Executable Statements ..
72 *
73 IF( M.LE.0 .OR. N.LE.0 )
74 $ RETURN
75 *
76 * benign matrix
77 *
78 DO 10 J = 1, N
79 CALL DLARNV( 2, ISEED, M, A( 1, J ) )
80 IF( J.LE.M ) THEN
81 A( J, J ) = A( J, J ) + SIGN( DASUM( M, A( 1, J ), 1 ),
82 $ A( J, J ) )
83 END IF
84 10 CONTINUE
85 *
86 * scaled versions
87 *
88 IF( SCALE.NE.1 ) THEN
89 NORMA = DLANGE( 'Max', M, N, A, LDA, DUMMY )
90 SMLNUM = DLAMCH( 'Safe minimum' )
91 BIGNUM = ONE / SMLNUM
92 CALL DLABAD( SMLNUM, BIGNUM )
93 SMLNUM = SMLNUM / DLAMCH( 'Epsilon' )
94 BIGNUM = ONE / SMLNUM
95 *
96 IF( SCALE.EQ.2 ) THEN
97 *
98 * matrix scaled up
99 *
100 CALL DLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, LDA,
101 $ INFO )
102 ELSE IF( SCALE.EQ.3 ) THEN
103 *
104 * matrix scaled down
105 *
106 CALL DLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, LDA,
107 $ INFO )
108 END IF
109 END IF
110 *
111 NORMA = DLANGE( 'One-norm', M, N, A, LDA, DUMMY )
112 RETURN
113 *
114 * End of DQRT13
115 *
116 END