2
3
4
5
6
7
8 INTEGER IDIST, INFO, IRSIGN, MODE, N
9 REAL COND
10
11
12 INTEGER ISEED( 4 )
13 COMPLEX D( * )
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94 REAL ONE
95 parameter( one = 1.0e0 )
96
97
98 INTEGER I
99 REAL ALPHA, TEMP
100 COMPLEX CTEMP
101
102
103 REAL SLARAN
104 COMPLEX CLARND
106
107
109
110
111 INTRINSIC abs, exp, log, real
112
113
114
115
116
117 info = 0
118
119
120
121 IF( n.EQ.0 )
122 $ RETURN
123
124
125
126 IF( mode.LT.-6 .OR. mode.GT.6 ) THEN
127 info = -1
128 ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
129 $ ( irsign.NE.0 .AND. irsign.NE.1 ) ) THEN
130 info = -2
131 ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
132 $ cond.LT.one ) THEN
133 info = -3
134 ELSE IF( ( mode.EQ.6 .OR. mode.EQ.-6 ) .AND.
135 $ ( idist.LT.1 .OR. idist.GT.4 ) ) THEN
136 info = -4
137 ELSE IF( n.LT.0 ) THEN
138 info = -7
139 END IF
140
141 IF( info.NE.0 ) THEN
142 CALL xerbla( 'CLATM1', -info )
143 RETURN
144 END IF
145
146
147
148 IF( mode.NE.0 ) THEN
149 GO TO ( 10, 30, 50, 70, 90, 110 )abs( mode )
150
151
152
153 10 CONTINUE
154 DO 20 i = 1, n
155 d( i ) = one / cond
156 20 CONTINUE
157 d( 1 ) = one
158 GO TO 120
159
160
161
162 30 CONTINUE
163 DO 40 i = 1, n
164 d( i ) = one
165 40 CONTINUE
166 d( n ) = one / cond
167 GO TO 120
168
169
170
171 50 CONTINUE
172 d( 1 ) = one
173 IF( n.GT.1 ) THEN
174 alpha = cond**( -one / real( n-1 ) )
175 DO 60 i = 2, n
176 d( i ) = alpha**( i-1 )
177 60 CONTINUE
178 END IF
179 GO TO 120
180
181
182
183 70 CONTINUE
184 d( 1 ) = one
185 IF( n.GT.1 ) THEN
186 temp = one / cond
187 alpha = ( one-temp ) / real( n-1 )
188 DO 80 i = 2, n
189 d( i ) = real( n-i )*alpha + temp
190 80 CONTINUE
191 END IF
192 GO TO 120
193
194
195
196 90 CONTINUE
197 alpha = log( one / cond )
198 DO 100 i = 1, n
199 d( i ) = exp( alpha*
slaran( iseed ) )
200 100 CONTINUE
201 GO TO 120
202
203
204
205 110 CONTINUE
206 CALL clarnv( idist, iseed, n, d )
207
208 120 CONTINUE
209
210
211
212
213 IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
214 $ irsign.EQ.1 ) THEN
215 DO 130 i = 1, n
216 ctemp =
clarnd( 3, iseed )
217 d( i ) = d( i )*( ctemp / abs( ctemp ) )
218 130 CONTINUE
219 END IF
220
221
222
223 IF( mode.LT.0 ) THEN
224 DO 140 i = 1, n / 2
225 ctemp = d( i )
226 d( i ) = d( n+1-i )
227 d( n+1-i ) = ctemp
228 140 CONTINUE
229 END IF
230
231 END IF
232
233 RETURN
234
235
236
complex function clarnd(idist, iseed)
subroutine clarnv(idist, iseed, n, x)
real function slaran(iseed)