LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches
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*> \ingroup real_matgen
118*
119* =====================================================================
120 SUBROUTINE slatm7( MODE, COND, IRSIGN, IDIST, ISEED, D, N,
121 \$ RANK, INFO )
122*
123* -- LAPACK computational routine --
124* -- LAPACK is a software package provided by Univ. of Tennessee, --
125* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
126*
127* .. Scalar Arguments ..
128 REAL COND
129 INTEGER IDIST, INFO, IRSIGN, MODE, N, RANK
130* ..
131* .. Array Arguments ..
132 REAL D( * )
133 INTEGER ISEED( 4 )
134* ..
135*
136* =====================================================================
137*
138* .. Parameters ..
139 REAL ONE
140 parameter( one = 1.0e0 )
141 REAL ZERO
142 parameter( zero = 0.0e0 )
143 REAL HALF
144 parameter( half = 0.5e0 )
145* ..
146* .. Local Scalars ..
147 REAL ALPHA, TEMP
148 INTEGER I
149* ..
150* .. External Functions ..
151 REAL SLARAN
152 EXTERNAL slaran
153* ..
154* .. External Subroutines ..
155 EXTERNAL slarnv, xerbla
156* ..
157* .. Intrinsic Functions ..
158 INTRINSIC abs, exp, log, real
159* ..
160* .. Executable Statements ..
161*
162* Decode and Test the input parameters. Initialize flags & seed.
163*
164 info = 0
165*
166* Quick return if possible
167*
168 IF( n.EQ.0 )
169 \$ RETURN
170*
171* Set INFO if an error
172*
173 IF( mode.LT.-6 .OR. mode.GT.6 ) THEN
174 info = -1
175 ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
176 \$ ( irsign.NE.0 .AND. irsign.NE.1 ) ) THEN
177 info = -2
178 ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
179 \$ cond.LT.one ) THEN
180 info = -3
181 ELSE IF( ( mode.EQ.6 .OR. mode.EQ.-6 ) .AND.
182 \$ ( idist.LT.1 .OR. idist.GT.3 ) ) THEN
183 info = -4
184 ELSE IF( n.LT.0 ) THEN
185 info = -7
186 END IF
187*
188 IF( info.NE.0 ) THEN
189 CALL xerbla( 'SLATM7', -info )
190 RETURN
191 END IF
192*
193* Compute D according to COND and MODE
194*
195 IF( mode.NE.0 ) THEN
196 GO TO ( 100, 130, 160, 190, 210, 230 )abs( mode )
197*
198* One large D value:
199*
200 100 CONTINUE
201 DO 110 i = 2, rank
202 d( i ) = one / cond
203 110 CONTINUE
204 DO 120 i = rank + 1, n
205 d( i ) = zero
206 120 CONTINUE
207 d( 1 ) = one
208 GO TO 240
209*
210* One small D value:
211*
212 130 CONTINUE
213 DO 140 i = 1, rank - 1
214 d( i ) = one
215 140 CONTINUE
216 DO 150 i = rank + 1, n
217 d( i ) = zero
218 150 CONTINUE
219 d( rank ) = one / cond
220 GO TO 240
221*
222* Exponentially distributed D values:
223*
224 160 CONTINUE
225 d( 1 ) = one
226 IF( n.GT.1 .AND. rank.GT.1 ) THEN
227 alpha = cond**( -one / real( rank-1 ) )
228 DO 170 i = 2, rank
229 d( i ) = alpha**( i-1 )
230 170 CONTINUE
231 DO 180 i = rank + 1, n
232 d( i ) = zero
233 180 CONTINUE
234 END IF
235 GO TO 240
236*
237* Arithmetically distributed D values:
238*
239 190 CONTINUE
240 d( 1 ) = one
241 IF( n.GT.1 ) THEN
242 temp = one / cond
243 alpha = ( one-temp ) / real( n-1 )
244 DO 200 i = 2, n
245 d( i ) = real( n-i )*alpha + temp
246 200 CONTINUE
247 END IF
248 GO TO 240
249*
250* Randomly distributed D values on ( 1/COND , 1):
251*
252 210 CONTINUE
253 alpha = log( one / cond )
254 DO 220 i = 1, n
255 d( i ) = exp( alpha*slaran( iseed ) )
256 220 CONTINUE
257 GO TO 240
258*
259* Randomly distributed D values from IDIST
260*
261 230 CONTINUE
262 CALL slarnv( idist, iseed, n, d )
263*
264 240 CONTINUE
265*
266* If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign
267* random signs to D
268*
269 IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
270 \$ irsign.EQ.1 ) THEN
271 DO 250 i = 1, n
272 temp = slaran( iseed )
273 IF( temp.GT.half )
274 \$ d( i ) = -d( i )
275 250 CONTINUE
276 END IF
277*
278* Reverse if MODE < 0
279*
280 IF( mode.LT.0 ) THEN
281 DO 260 i = 1, n / 2
282 temp = d( i )
283 d( i ) = d( n+1-i )
284 d( n+1-i ) = temp
285 260 CONTINUE
286 END IF
287*
288 END IF
289*
290 RETURN
291*
292* End of SLATM7
293*
294 END
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: slarnv.f:97
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine slatm7(MODE, COND, IRSIGN, IDIST, ISEED, D, N, RANK, INFO)
SLATM7
Definition: slatm7.f:122