LAPACK  3.4.2 LAPACK: Linear Algebra PACKage
slatm7.f
Go to the documentation of this file.
1 *> \brief \b SLATM7
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 SLATM7( MODE, COND, IRSIGN, IDIST, ISEED, D, N,
12 * RANK, INFO )
13 *
14 * .. Scalar Arguments ..
15 * REAL COND
16 * INTEGER IDIST, INFO, IRSIGN, MODE, N, RANK
17 * ..
18 * .. Array Arguments ..
19 * REAL D( * )
20 * INTEGER ISEED( 4 )
21 * ..
22 *
23 *
24 *> \par Purpose:
25 * =============
26 *>
27 *> \verbatim
28 *>
29 *> SLATM7 computes the entries of D as specified by MODE
30 *> COND and IRSIGN. IDIST and ISEED determine the generation
31 *> of random numbers. SLATM7 is called by SLATMT to generate
32 *> random test matrices.
33 *> \endverbatim
34 *
35 * Arguments:
36 * ==========
37 *
38 *> \verbatim
39 *> MODE - INTEGER
40 *> On entry describes how D is to be computed:
41 *> MODE = 0 means do not change D.
42 *>
43 *> MODE = 1 sets D(1)=1 and D(2:RANK)=1.0/COND
44 *> MODE = 2 sets D(1:RANK-1)=1 and D(RANK)=1.0/COND
45 *> MODE = 3 sets D(I)=COND**(-(I-1)/(RANK-1)) I=1:RANK
46 *>
47 *> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
48 *> MODE = 5 sets D to random numbers in the range
49 *> ( 1/COND , 1 ) such that their logarithms
50 *> are uniformly distributed.
51 *> MODE = 6 set D to random numbers from same distribution
52 *> as the rest of the matrix.
53 *> MODE < 0 has the same meaning as ABS(MODE), except that
54 *> the order of the elements of D is reversed.
55 *> Thus if MODE is positive, D has entries ranging from
56 *> 1 to 1/COND, if negative, from 1/COND to 1,
57 *> Not modified.
58 *>
59 *> COND - REAL
60 *> On entry, used as described under MODE above.
61 *> If used, it must be >= 1. Not modified.
62 *>
63 *> IRSIGN - INTEGER
64 *> On entry, if MODE neither -6, 0 nor 6, determines sign of
65 *> entries of D
66 *> 0 => leave entries of D unchanged
67 *> 1 => multiply each entry of D by 1 or -1 with probability .5
68 *>
69 *> IDIST - CHARACTER*1
70 *> On entry, IDIST specifies the type of distribution to be
71 *> used to generate a random matrix .
72 *> 1 => UNIFORM( 0, 1 )
73 *> 2 => UNIFORM( -1, 1 )
74 *> 3 => NORMAL( 0, 1 )
75 *> Not modified.
76 *>
77 *> ISEED - INTEGER array, dimension ( 4 )
78 *> On entry ISEED specifies the seed of the random number
79 *> generator. The random number generator uses a
80 *> linear congruential sequence limited to small
81 *> integers, and so should produce machine independent
82 *> random numbers. The values of ISEED are changed on
83 *> exit, and can be used in the next call to SLATM7
84 *> to continue the same random number sequence.
85 *> Changed on exit.
86 *>
87 *> D - REAL array, dimension ( MIN( M , N ) )
88 *> Array to be computed according to MODE, COND and IRSIGN.
89 *> May be changed on exit if MODE is nonzero.
90 *>
91 *> N - INTEGER
92 *> Number of entries of D. Not modified.
93 *>
94 *> RANK - INTEGER
95 *> The rank of matrix to be generated for modes 1,2,3 only.
96 *> D( RANK+1:N ) = 0.
97 *> Not modified.
98 *>
99 *> INFO - INTEGER
100 *> 0 => normal termination
101 *> -1 => if MODE not in range -6 to 6
102 *> -2 => if MODE neither -6, 0 nor 6, and
103 *> IRSIGN neither 0 nor 1
104 *> -3 => if MODE neither -6, 0 nor 6 and COND less than 1
105 *> -4 => if MODE equals 6 or -6 and IDIST not in range 1 to 3
106 *> -7 => if N negative
107 *> \endverbatim
108 *
109 * Authors:
110 * ========
111 *
112 *> \author Univ. of Tennessee
113 *> \author Univ. of California Berkeley
114 *> \author Univ. of Colorado Denver
115 *> \author NAG Ltd.
116 *
117 *> \date September 2012
118 *
119 *> \ingroup real_matgen
120 *
121 * =====================================================================
122  SUBROUTINE slatm7( MODE, COND, IRSIGN, IDIST, ISEED, D, N,
123  \$ rank, info )
124 *
125 * -- LAPACK computational routine (version 3.4.2) --
126 * -- LAPACK is a software package provided by Univ. of Tennessee, --
127 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
128 * September 2012
129 *
130 * .. Scalar Arguments ..
131  REAL cond
132  INTEGER idist, info, irsign, mode, n, rank
133 * ..
134 * .. Array Arguments ..
135  REAL d( * )
136  INTEGER iseed( 4 )
137 * ..
138 *
139 * =====================================================================
140 *
141 * .. Parameters ..
142  REAL one
143  parameter( one = 1.0e0 )
144  REAL zero
145  parameter( zero = 0.0e0 )
146  REAL half
147  parameter( half = 0.5e0 )
148 * ..
149 * .. Local Scalars ..
150  REAL alpha, temp
151  INTEGER i
152 * ..
153 * .. External Functions ..
154  REAL slaran
155  EXTERNAL slaran
156 * ..
157 * .. External Subroutines ..
158  EXTERNAL slarnv, xerbla
159 * ..
160 * .. Intrinsic Functions ..
161  INTRINSIC abs, exp, log, real
162 * ..
163 * .. Executable Statements ..
164 *
165 * Decode and Test the input parameters. Initialize flags & seed.
166 *
167  info = 0
168 *
169 * Quick return if possible
170 *
171  IF( n.EQ.0 )
172  \$ return
173 *
174 * Set INFO if an error
175 *
176  IF( mode.LT.-6 .OR. mode.GT.6 ) THEN
177  info = -1
178  ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
179  \$ ( irsign.NE.0 .AND. irsign.NE.1 ) ) THEN
180  info = -2
181  ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
182  \$ cond.LT.one ) THEN
183  info = -3
184  ELSE IF( ( mode.EQ.6 .OR. mode.EQ.-6 ) .AND.
185  \$ ( idist.LT.1 .OR. idist.GT.3 ) ) THEN
186  info = -4
187  ELSE IF( n.LT.0 ) THEN
188  info = -7
189  END IF
190 *
191  IF( info.NE.0 ) THEN
192  CALL xerbla( 'SLATM7', -info )
193  return
194  END IF
195 *
196 * Compute D according to COND and MODE
197 *
198  IF( mode.NE.0 ) THEN
199  go to( 100, 130, 160, 190, 210, 230 )abs( mode )
200 *
201 * One large D value:
202 *
203  100 continue
204  DO 110 i = 2, rank
205  d( i ) = one / cond
206  110 continue
207  DO 120 i = rank + 1, n
208  d( i ) = zero
209  120 continue
210  d( 1 ) = one
211  go to 240
212 *
213 * One small D value:
214 *
215  130 continue
216  DO 140 i = 1, rank - 1
217  d( i ) = one
218  140 continue
219  DO 150 i = rank + 1, n
220  d( i ) = zero
221  150 continue
222  d( rank ) = one / cond
223  go to 240
224 *
225 * Exponentially distributed D values:
226 *
227  160 continue
228  d( 1 ) = one
229  IF( n.GT.1 .AND. rank.GT.1 ) THEN
230  alpha = cond**( -one / REAL( RANK-1 ) )
231  DO 170 i = 2, rank
232  d( i ) = alpha**( i-1 )
233  170 continue
234  DO 180 i = rank + 1, n
235  d( i ) = zero
236  180 continue
237  END IF
238  go to 240
239 *
240 * Arithmetically distributed D values:
241 *
242  190 continue
243  d( 1 ) = one
244  IF( n.GT.1 ) THEN
245  temp = one / cond
246  alpha = ( one-temp ) / REAL( n-1 )
247  DO 200 i = 2, n
248  d( i ) = REAL( n-i )*alpha + temp
249  200 continue
250  END IF
251  go to 240
252 *
253 * Randomly distributed D values on ( 1/COND , 1):
254 *
255  210 continue
256  alpha = log( one / cond )
257  DO 220 i = 1, n
258  d( i ) = exp( alpha*slaran( iseed ) )
259  220 continue
260  go to 240
261 *
262 * Randomly distributed D values from IDIST
263 *
264  230 continue
265  CALL slarnv( idist, iseed, n, d )
266 *
267  240 continue
268 *
269 * If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign
270 * random signs to D
271 *
272  IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
273  \$ irsign.EQ.1 ) THEN
274  DO 250 i = 1, n
275  temp = slaran( iseed )
276  IF( temp.GT.half )
277  \$ d( i ) = -d( i )
278  250 continue
279  END IF
280 *
281 * Reverse if MODE < 0
282 *
283  IF( mode.LT.0 ) THEN
284  DO 260 i = 1, n / 2
285  temp = d( i )
286  d( i ) = d( n+1-i )
287  d( n+1-i ) = temp
288  260 continue
289  END IF
290 *
291  END IF
292 *
293  return
294 *
295 * End of SLATM7
296 *
297  END