LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dlatm1.f
Go to the documentation of this file.
1*> \brief \b DLATM1
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 DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO )
12*
13* .. Scalar Arguments ..
14* INTEGER IDIST, INFO, IRSIGN, MODE, N
15* DOUBLE PRECISION COND
16* ..
17* .. Array Arguments ..
18* INTEGER ISEED( 4 )
19* DOUBLE PRECISION D( * )
20* ..
21*
22*
23*> \par Purpose:
24* =============
25*>
26*> \verbatim
27*>
28*> DLATM1 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. DLATM1 is called by DLATMR 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 DOUBLE PRECISION
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 INTEGER
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 DLATM1
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 DOUBLE PRECISION array, dimension ( 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*> \ingroup double_matgen
132*
133* =====================================================================
134 SUBROUTINE dlatm1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO )
135*
136* -- LAPACK auxiliary routine --
137* -- LAPACK is a software package provided by Univ. of Tennessee, --
138* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
139*
140* .. Scalar Arguments ..
141 INTEGER IDIST, INFO, IRSIGN, MODE, N
142 DOUBLE PRECISION COND
143* ..
144* .. Array Arguments ..
145 INTEGER ISEED( 4 )
146 DOUBLE PRECISION D( * )
147* ..
148*
149* =====================================================================
150*
151* .. Parameters ..
152 DOUBLE PRECISION ONE
153 parameter( one = 1.0d0 )
154 DOUBLE PRECISION HALF
155 parameter( half = 0.5d0 )
156* ..
157* .. Local Scalars ..
158 INTEGER I
159 DOUBLE PRECISION ALPHA, TEMP
160* ..
161* .. External Functions ..
162 DOUBLE PRECISION DLARAN
163 EXTERNAL dlaran
164* ..
165* .. External Subroutines ..
166 EXTERNAL dlarnv, xerbla
167* ..
168* .. Intrinsic Functions ..
169 INTRINSIC abs, dble, exp, log
170* ..
171* .. Executable Statements ..
172*
173* Decode and Test the input parameters. Initialize flags & seed.
174*
175 info = 0
176*
177* Quick return if possible
178*
179 IF( n.EQ.0 )
180 $ RETURN
181*
182* Set INFO if an error
183*
184 IF( mode.LT.-6 .OR. mode.GT.6 ) THEN
185 info = -1
186 ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
187 $ ( irsign.NE.0 .AND. irsign.NE.1 ) ) THEN
188 info = -2
189 ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
190 $ cond.LT.one ) THEN
191 info = -3
192 ELSE IF( ( mode.EQ.6 .OR. mode.EQ.-6 ) .AND.
193 $ ( idist.LT.1 .OR. idist.GT.3 ) ) THEN
194 info = -4
195 ELSE IF( n.LT.0 ) THEN
196 info = -7
197 END IF
198*
199 IF( info.NE.0 ) THEN
200 CALL xerbla( 'DLATM1', -info )
201 RETURN
202 END IF
203*
204* Compute D according to COND and MODE
205*
206 IF( mode.NE.0 ) THEN
207 GO TO ( 10, 30, 50, 70, 90, 110 )abs( mode )
208*
209* One large D value:
210*
211 10 CONTINUE
212 DO 20 i = 1, n
213 d( i ) = one / cond
214 20 CONTINUE
215 d( 1 ) = one
216 GO TO 120
217*
218* One small D value:
219*
220 30 CONTINUE
221 DO 40 i = 1, n
222 d( i ) = one
223 40 CONTINUE
224 d( n ) = one / cond
225 GO TO 120
226*
227* Exponentially distributed D values:
228*
229 50 CONTINUE
230 d( 1 ) = one
231 IF( n.GT.1 ) THEN
232 alpha = cond**( -one / dble( n-1 ) )
233 DO 60 i = 2, n
234 d( i ) = alpha**( i-1 )
235 60 CONTINUE
236 END IF
237 GO TO 120
238*
239* Arithmetically distributed D values:
240*
241 70 CONTINUE
242 d( 1 ) = one
243 IF( n.GT.1 ) THEN
244 temp = one / cond
245 alpha = ( one-temp ) / dble( n-1 )
246 DO 80 i = 2, n
247 d( i ) = dble( n-i )*alpha + temp
248 80 CONTINUE
249 END IF
250 GO TO 120
251*
252* Randomly distributed D values on ( 1/COND , 1):
253*
254 90 CONTINUE
255 alpha = log( one / cond )
256 DO 100 i = 1, n
257 d( i ) = exp( alpha*dlaran( iseed ) )
258 100 CONTINUE
259 GO TO 120
260*
261* Randomly distributed D values from IDIST
262*
263 110 CONTINUE
264 CALL dlarnv( idist, iseed, n, d )
265*
266 120 CONTINUE
267*
268* If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign
269* random signs to D
270*
271 IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
272 $ irsign.EQ.1 ) THEN
273 DO 130 i = 1, n
274 temp = dlaran( iseed )
275 IF( temp.GT.half )
276 $ d( i ) = -d( i )
277 130 CONTINUE
278 END IF
279*
280* Reverse if MODE < 0
281*
282 IF( mode.LT.0 ) THEN
283 DO 140 i = 1, n / 2
284 temp = d( i )
285 d( i ) = d( n+1-i )
286 d( n+1-i ) = temp
287 140 CONTINUE
288 END IF
289*
290 END IF
291*
292 RETURN
293*
294* End of DLATM1
295*
296 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine dlatm1(mode, cond, irsign, idist, iseed, d, n, info)
DLATM1
Definition dlatm1.f:135
subroutine dlarnv(idist, iseed, n, x)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition dlarnv.f:97