114
115
116
117
118
119
120 CHARACTER UPLO, WAY
121 INTEGER INFO, LDA, N
122
123
124 INTEGER IPIV( * )
125 COMPLEX*16 A( LDA, * ), E( * )
126
127
128
129
130
131 COMPLEX*16 ZERO
132 parameter( zero = (0.0d+0,0.0d+0) )
133
134
135 LOGICAL LSAME
137
138
140
141 LOGICAL UPPER, CONVERT
142 INTEGER I, IP, J
143 COMPLEX*16 TEMP
144
145
146
147 info = 0
148 upper =
lsame( uplo,
'U' )
149 convert =
lsame( way,
'C' )
150 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
151 info = -1
152 ELSE IF( .NOT.convert .AND. .NOT.
lsame( way,
'R' ) )
THEN
153 info = -2
154 ELSE IF( n.LT.0 ) THEN
155 info = -3
156 ELSE IF( lda.LT.max( 1, n ) ) THEN
157 info = -5
158
159 END IF
160 IF( info.NE.0 ) THEN
161 CALL xerbla(
'ZSYCONV', -info )
162 RETURN
163 END IF
164
165
166
167 IF( n.EQ.0 )
168 $ RETURN
169
170 IF( upper ) THEN
171
172
173
174 IF ( convert ) THEN
175
176
177
178
179
180 i=n
181 e(1)=zero
182 DO WHILE ( i .GT. 1 )
183 IF( ipiv(i) .LT. 0 ) THEN
184 e(i)=a(i-1,i)
185 e(i-1)=zero
186 a(i-1,i)=zero
187 i=i-1
188 ELSE
189 e(i)=zero
190 ENDIF
191 i=i-1
192 END DO
193
194
195
196 i=n
197 DO WHILE ( i .GE. 1 )
198 IF( ipiv(i) .GT. 0) THEN
199 ip=ipiv(i)
200 IF( i .LT. n) THEN
201 DO 12 j= i+1,n
202 temp=a(ip,j)
203 a(ip,j)=a(i,j)
204 a(i,j)=temp
205 12 CONTINUE
206 ENDIF
207 ELSE
208 ip=-ipiv(i)
209 IF( i .LT. n) THEN
210 DO 13 j= i+1,n
211 temp=a(ip,j)
212 a(ip,j)=a(i-1,j)
213 a(i-1,j)=temp
214 13 CONTINUE
215 ENDIF
216 i=i-1
217 ENDIF
218 i=i-1
219 END DO
220
221 ELSE
222
223
224
225
226
227 i=1
228 DO WHILE ( i .LE. n )
229 IF( ipiv(i) .GT. 0 ) THEN
230 ip=ipiv(i)
231 IF( i .LT. n) THEN
232 DO j= i+1,n
233 temp=a(ip,j)
234 a(ip,j)=a(i,j)
235 a(i,j)=temp
236 END DO
237 ENDIF
238 ELSE
239 ip=-ipiv(i)
240 i=i+1
241 IF( i .LT. n) THEN
242 DO j= i+1,n
243 temp=a(ip,j)
244 a(ip,j)=a(i-1,j)
245 a(i-1,j)=temp
246 END DO
247 ENDIF
248 ENDIF
249 i=i+1
250 END DO
251
252
253
254 i=n
255 DO WHILE ( i .GT. 1 )
256 IF( ipiv(i) .LT. 0 ) THEN
257 a(i-1,i)=e(i)
258 i=i-1
259 ENDIF
260 i=i-1
261 END DO
262 END IF
263
264 ELSE
265
266
267
268 IF ( convert ) THEN
269
270
271
272
273
274 i=1
275 e(n)=zero
276 DO WHILE ( i .LE. n )
277 IF( i.LT.n .AND. ipiv(i) .LT. 0 ) THEN
278 e(i)=a(i+1,i)
279 e(i+1)=zero
280 a(i+1,i)=zero
281 i=i+1
282 ELSE
283 e(i)=zero
284 ENDIF
285 i=i+1
286 END DO
287
288
289
290 i=1
291 DO WHILE ( i .LE. n )
292 IF( ipiv(i) .GT. 0 ) THEN
293 ip=ipiv(i)
294 IF (i .GT. 1) THEN
295 DO 22 j= 1,i-1
296 temp=a(ip,j)
297 a(ip,j)=a(i,j)
298 a(i,j)=temp
299 22 CONTINUE
300 ENDIF
301 ELSE
302 ip=-ipiv(i)
303 IF (i .GT. 1) THEN
304 DO 23 j= 1,i-1
305 temp=a(ip,j)
306 a(ip,j)=a(i+1,j)
307 a(i+1,j)=temp
308 23 CONTINUE
309 ENDIF
310 i=i+1
311 ENDIF
312 i=i+1
313 END DO
314
315 ELSE
316
317
318
319
320
321 i=n
322 DO WHILE ( i .GE. 1 )
323 IF( ipiv(i) .GT. 0 ) THEN
324 ip=ipiv(i)
325 IF (i .GT. 1) THEN
326 DO j= 1,i-1
327 temp=a(i,j)
328 a(i,j)=a(ip,j)
329 a(ip,j)=temp
330 END DO
331 ENDIF
332 ELSE
333 ip=-ipiv(i)
334 i=i-1
335 IF (i .GT. 1) THEN
336 DO j= 1,i-1
337 temp=a(i+1,j)
338 a(i+1,j)=a(ip,j)
339 a(ip,j)=temp
340 END DO
341 ENDIF
342 ENDIF
343 i=i-1
344 END DO
345
346
347
348 i=1
349 DO WHILE ( i .LE. n-1 )
350 IF( ipiv(i) .LT. 0 ) THEN
351 a(i+1,i)=e(i)
352 i=i+1
353 ENDIF
354 i=i+1
355 END DO
356 END IF
357 END IF
358
359 RETURN
360
361
362
subroutine xerbla(srname, info)
logical function lsame(ca, cb)
LSAME