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