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