1 SUBROUTINE ZSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO )
2 *
3 * -- LAPACK PROTOTYPE routine (version 3.2.2) --
4 *
5 * -- Written by Julie Langou of the Univ. of TN --
6 * May 2010
7 *
8 * -- LAPACK is a software package provided by Univ. of Tennessee, --
9 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
10 *
11 * .. Scalar Arguments ..
12 CHARACTER UPLO, WAY
13 INTEGER INFO, LDA, N
14 * ..
15 * .. Array Arguments ..
16 INTEGER IPIV( * )
17 DOUBLE COMPLEX A( LDA, * ), WORK( * )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * ZSYCONV converts A given by ZHETRF into L and D or vice-versa.
24 * Get nondiagonal elements of D (returned in workspace) and
25 * apply or reverse permutation done in TRF.
26 *
27 * Arguments
28 * =========
29 *
30 * UPLO (input) CHARACTER*1
31 * Specifies whether the details of the factorization are stored
32 * as an upper or lower triangular matrix.
33 * = 'U': Upper triangular, form is A = U*D*U**T;
34 * = 'L': Lower triangular, form is A = L*D*L**T.
35 *
36 * WAY (input) CHARACTER*1
37 * = 'C': Convert
38 * = 'R': Revert
39 *
40 * N (input) INTEGER
41 * The order of the matrix A. N >= 0.
42 *
43 * A (input) DOUBLE COMPLEX array, dimension (LDA,N)
44 * The block diagonal matrix D and the multipliers used to
45 * obtain the factor U or L as computed by ZSYTRF.
46 *
47 * LDA (input) INTEGER
48 * The leading dimension of the array A. LDA >= max(1,N).
49 *
50 * IPIV (input) INTEGER array, dimension (N)
51 * Details of the interchanges and the block structure of D
52 * as determined by ZSYTRF.
53 *
54 * WORK (workspace) DOUBLE COMPLEX array, dimension (N)
55 *
56 * LWORK (input) INTEGER
57 * The length of WORK. LWORK >=1.
58 * LWORK = N
59 *
60 * If LWORK = -1, then a workspace query is assumed; the routine
61 * only calculates the optimal size of the WORK array, returns
62 * this value as the first entry of the WORK array, and no error
63 * message related to LWORK is issued by XERBLA.
64 *
65 * INFO (output) INTEGER
66 * = 0: successful exit
67 * < 0: if INFO = -i, the i-th argument had an illegal value
68 *
69 * =====================================================================
70 *
71 * .. Parameters ..
72 DOUBLE COMPLEX ZERO
73 PARAMETER ( ZERO = (0.0D+0,0.0D+0) )
74 * ..
75 * .. External Functions ..
76 LOGICAL LSAME
77 EXTERNAL LSAME
78 *
79 * .. External Subroutines ..
80 EXTERNAL XERBLA
81 * .. Local Scalars ..
82 LOGICAL UPPER, CONVERT
83 INTEGER I, IP, J
84 DOUBLE COMPLEX TEMP
85 * ..
86 * .. Executable Statements ..
87 *
88 INFO = 0
89 UPPER = LSAME( UPLO, 'U' )
90 CONVERT = LSAME( WAY, 'C' )
91 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
92 INFO = -1
93 ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
94 INFO = -2
95 ELSE IF( N.LT.0 ) THEN
96 INFO = -3
97 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
98 INFO = -5
99
100 END IF
101 IF( INFO.NE.0 ) THEN
102 CALL XERBLA( 'ZSYCONV', -INFO )
103 RETURN
104 END IF
105 *
106 * Quick return if possible
107 *
108 IF( N.EQ.0 )
109 $ RETURN
110 *
111 IF( UPPER ) THEN
112 *
113 * A is UPPER
114 *
115 IF ( CONVERT ) THEN
116 *
117 * Convert A (A is upper)
118 *
119 * Convert VALUE
120 *
121 I=N
122 WORK(1)=ZERO
123 DO WHILE ( I .GT. 1 )
124 IF( IPIV(I) .LT. 0 ) THEN
125 WORK(I)=A(I-1,I)
126 A(I-1,I)=ZERO
127 I=I-1
128 ELSE
129 WORK(I)=ZERO
130 ENDIF
131 I=I-1
132 END DO
133 *
134 * Convert PERMUTATIONS
135 *
136 I=N
137 DO WHILE ( I .GE. 1 )
138 IF( IPIV(I) .GT. 0) THEN
139 IP=IPIV(I)
140 IF( I .LT. N) THEN
141 DO 12 J= I+1,N
142 TEMP=A(IP,J)
143 A(IP,J)=A(I,J)
144 A(I,J)=TEMP
145 12 CONTINUE
146 ENDIF
147 ELSE
148 IP=-IPIV(I)
149 IF( I .LT. N) THEN
150 DO 13 J= I+1,N
151 TEMP=A(IP,J)
152 A(IP,J)=A(I-1,J)
153 A(I-1,J)=TEMP
154 13 CONTINUE
155 ENDIF
156 I=I-1
157 ENDIF
158 I=I-1
159 END DO
160 *
161 ELSE
162 *
163 * Revert A (A is upper)
164 *
165 * Revert PERMUTATIONS
166 *
167 I=1
168 DO WHILE ( I .LE. N )
169 IF( IPIV(I) .GT. 0 ) THEN
170 IP=IPIV(I)
171 IF( I .LT. N) THEN
172 DO J= I+1,N
173 TEMP=A(IP,J)
174 A(IP,J)=A(I,J)
175 A(I,J)=TEMP
176 END DO
177 ENDIF
178 ELSE
179 IP=-IPIV(I)
180 I=I+1
181 IF( I .LT. N) THEN
182 DO J= I+1,N
183 TEMP=A(IP,J)
184 A(IP,J)=A(I-1,J)
185 A(I-1,J)=TEMP
186 END DO
187 ENDIF
188 ENDIF
189 I=I+1
190 END DO
191 *
192 * Revert VALUE
193 *
194 I=N
195 DO WHILE ( I .GT. 1 )
196 IF( IPIV(I) .LT. 0 ) THEN
197 A(I-1,I)=WORK(I)
198 I=I-1
199 ENDIF
200 I=I-1
201 END DO
202 END IF
203 *
204 ELSE
205 *
206 * A is LOWER
207 *
208 IF ( CONVERT ) THEN
209 *
210 * Convert A (A is lower)
211 *
212 * Convert VALUE
213 *
214 I=1
215 WORK(N)=ZERO
216 DO WHILE ( I .LE. N )
217 IF( I.LT.N .AND. IPIV(I) .LT. 0 ) THEN
218 WORK(I)=A(I+1,I)
219 A(I+1,I)=ZERO
220 I=I+1
221 ELSE
222 WORK(I)=ZERO
223 ENDIF
224 I=I+1
225 END DO
226 *
227 * Convert PERMUTATIONS
228 *
229 I=1
230 DO WHILE ( I .LE. N )
231 IF( IPIV(I) .GT. 0 ) THEN
232 IP=IPIV(I)
233 IF (I .GT. 1) THEN
234 DO 22 J= 1,I-1
235 TEMP=A(IP,J)
236 A(IP,J)=A(I,J)
237 A(I,J)=TEMP
238 22 CONTINUE
239 ENDIF
240 ELSE
241 IP=-IPIV(I)
242 IF (I .GT. 1) THEN
243 DO 23 J= 1,I-1
244 TEMP=A(IP,J)
245 A(IP,J)=A(I+1,J)
246 A(I+1,J)=TEMP
247 23 CONTINUE
248 ENDIF
249 I=I+1
250 ENDIF
251 I=I+1
252 END DO
253 *
254 ELSE
255 *
256 * Revert A (A is lower)
257 *
258 * Revert PERMUTATIONS
259 *
260 I=N
261 DO WHILE ( I .GE. 1 )
262 IF( IPIV(I) .GT. 0 ) THEN
263 IP=IPIV(I)
264 IF (I .GT. 1) THEN
265 DO J= 1,I-1
266 TEMP=A(I,J)
267 A(I,J)=A(IP,J)
268 A(IP,J)=TEMP
269 END DO
270 ENDIF
271 ELSE
272 IP=-IPIV(I)
273 I=I-1
274 IF (I .GT. 1) THEN
275 DO J= 1,I-1
276 TEMP=A(I+1,J)
277 A(I+1,J)=A(IP,J)
278 A(IP,J)=TEMP
279 END DO
280 ENDIF
281 ENDIF
282 I=I-1
283 END DO
284 *
285 * Revert VALUE
286 *
287 I=1
288 DO WHILE ( I .LE. N-1 )
289 IF( IPIV(I) .LT. 0 ) THEN
290 A(I+1,I)=WORK(I)
291 I=I+1
292 ENDIF
293 I=I+1
294 END DO
295 END IF
296 END IF
297 *
298 RETURN
299 *
300 * End of ZSYCONV
301 *
302 END
2 *
3 * -- LAPACK PROTOTYPE routine (version 3.2.2) --
4 *
5 * -- Written by Julie Langou of the Univ. of TN --
6 * May 2010
7 *
8 * -- LAPACK is a software package provided by Univ. of Tennessee, --
9 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
10 *
11 * .. Scalar Arguments ..
12 CHARACTER UPLO, WAY
13 INTEGER INFO, LDA, N
14 * ..
15 * .. Array Arguments ..
16 INTEGER IPIV( * )
17 DOUBLE COMPLEX A( LDA, * ), WORK( * )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * ZSYCONV converts A given by ZHETRF into L and D or vice-versa.
24 * Get nondiagonal elements of D (returned in workspace) and
25 * apply or reverse permutation done in TRF.
26 *
27 * Arguments
28 * =========
29 *
30 * UPLO (input) CHARACTER*1
31 * Specifies whether the details of the factorization are stored
32 * as an upper or lower triangular matrix.
33 * = 'U': Upper triangular, form is A = U*D*U**T;
34 * = 'L': Lower triangular, form is A = L*D*L**T.
35 *
36 * WAY (input) CHARACTER*1
37 * = 'C': Convert
38 * = 'R': Revert
39 *
40 * N (input) INTEGER
41 * The order of the matrix A. N >= 0.
42 *
43 * A (input) DOUBLE COMPLEX array, dimension (LDA,N)
44 * The block diagonal matrix D and the multipliers used to
45 * obtain the factor U or L as computed by ZSYTRF.
46 *
47 * LDA (input) INTEGER
48 * The leading dimension of the array A. LDA >= max(1,N).
49 *
50 * IPIV (input) INTEGER array, dimension (N)
51 * Details of the interchanges and the block structure of D
52 * as determined by ZSYTRF.
53 *
54 * WORK (workspace) DOUBLE COMPLEX array, dimension (N)
55 *
56 * LWORK (input) INTEGER
57 * The length of WORK. LWORK >=1.
58 * LWORK = N
59 *
60 * If LWORK = -1, then a workspace query is assumed; the routine
61 * only calculates the optimal size of the WORK array, returns
62 * this value as the first entry of the WORK array, and no error
63 * message related to LWORK is issued by XERBLA.
64 *
65 * INFO (output) INTEGER
66 * = 0: successful exit
67 * < 0: if INFO = -i, the i-th argument had an illegal value
68 *
69 * =====================================================================
70 *
71 * .. Parameters ..
72 DOUBLE COMPLEX ZERO
73 PARAMETER ( ZERO = (0.0D+0,0.0D+0) )
74 * ..
75 * .. External Functions ..
76 LOGICAL LSAME
77 EXTERNAL LSAME
78 *
79 * .. External Subroutines ..
80 EXTERNAL XERBLA
81 * .. Local Scalars ..
82 LOGICAL UPPER, CONVERT
83 INTEGER I, IP, J
84 DOUBLE COMPLEX TEMP
85 * ..
86 * .. Executable Statements ..
87 *
88 INFO = 0
89 UPPER = LSAME( UPLO, 'U' )
90 CONVERT = LSAME( WAY, 'C' )
91 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
92 INFO = -1
93 ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
94 INFO = -2
95 ELSE IF( N.LT.0 ) THEN
96 INFO = -3
97 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
98 INFO = -5
99
100 END IF
101 IF( INFO.NE.0 ) THEN
102 CALL XERBLA( 'ZSYCONV', -INFO )
103 RETURN
104 END IF
105 *
106 * Quick return if possible
107 *
108 IF( N.EQ.0 )
109 $ RETURN
110 *
111 IF( UPPER ) THEN
112 *
113 * A is UPPER
114 *
115 IF ( CONVERT ) THEN
116 *
117 * Convert A (A is upper)
118 *
119 * Convert VALUE
120 *
121 I=N
122 WORK(1)=ZERO
123 DO WHILE ( I .GT. 1 )
124 IF( IPIV(I) .LT. 0 ) THEN
125 WORK(I)=A(I-1,I)
126 A(I-1,I)=ZERO
127 I=I-1
128 ELSE
129 WORK(I)=ZERO
130 ENDIF
131 I=I-1
132 END DO
133 *
134 * Convert PERMUTATIONS
135 *
136 I=N
137 DO WHILE ( I .GE. 1 )
138 IF( IPIV(I) .GT. 0) THEN
139 IP=IPIV(I)
140 IF( I .LT. N) THEN
141 DO 12 J= I+1,N
142 TEMP=A(IP,J)
143 A(IP,J)=A(I,J)
144 A(I,J)=TEMP
145 12 CONTINUE
146 ENDIF
147 ELSE
148 IP=-IPIV(I)
149 IF( I .LT. N) THEN
150 DO 13 J= I+1,N
151 TEMP=A(IP,J)
152 A(IP,J)=A(I-1,J)
153 A(I-1,J)=TEMP
154 13 CONTINUE
155 ENDIF
156 I=I-1
157 ENDIF
158 I=I-1
159 END DO
160 *
161 ELSE
162 *
163 * Revert A (A is upper)
164 *
165 * Revert PERMUTATIONS
166 *
167 I=1
168 DO WHILE ( I .LE. N )
169 IF( IPIV(I) .GT. 0 ) THEN
170 IP=IPIV(I)
171 IF( I .LT. N) THEN
172 DO J= I+1,N
173 TEMP=A(IP,J)
174 A(IP,J)=A(I,J)
175 A(I,J)=TEMP
176 END DO
177 ENDIF
178 ELSE
179 IP=-IPIV(I)
180 I=I+1
181 IF( I .LT. N) THEN
182 DO J= I+1,N
183 TEMP=A(IP,J)
184 A(IP,J)=A(I-1,J)
185 A(I-1,J)=TEMP
186 END DO
187 ENDIF
188 ENDIF
189 I=I+1
190 END DO
191 *
192 * Revert VALUE
193 *
194 I=N
195 DO WHILE ( I .GT. 1 )
196 IF( IPIV(I) .LT. 0 ) THEN
197 A(I-1,I)=WORK(I)
198 I=I-1
199 ENDIF
200 I=I-1
201 END DO
202 END IF
203 *
204 ELSE
205 *
206 * A is LOWER
207 *
208 IF ( CONVERT ) THEN
209 *
210 * Convert A (A is lower)
211 *
212 * Convert VALUE
213 *
214 I=1
215 WORK(N)=ZERO
216 DO WHILE ( I .LE. N )
217 IF( I.LT.N .AND. IPIV(I) .LT. 0 ) THEN
218 WORK(I)=A(I+1,I)
219 A(I+1,I)=ZERO
220 I=I+1
221 ELSE
222 WORK(I)=ZERO
223 ENDIF
224 I=I+1
225 END DO
226 *
227 * Convert PERMUTATIONS
228 *
229 I=1
230 DO WHILE ( I .LE. N )
231 IF( IPIV(I) .GT. 0 ) THEN
232 IP=IPIV(I)
233 IF (I .GT. 1) THEN
234 DO 22 J= 1,I-1
235 TEMP=A(IP,J)
236 A(IP,J)=A(I,J)
237 A(I,J)=TEMP
238 22 CONTINUE
239 ENDIF
240 ELSE
241 IP=-IPIV(I)
242 IF (I .GT. 1) THEN
243 DO 23 J= 1,I-1
244 TEMP=A(IP,J)
245 A(IP,J)=A(I+1,J)
246 A(I+1,J)=TEMP
247 23 CONTINUE
248 ENDIF
249 I=I+1
250 ENDIF
251 I=I+1
252 END DO
253 *
254 ELSE
255 *
256 * Revert A (A is lower)
257 *
258 * Revert PERMUTATIONS
259 *
260 I=N
261 DO WHILE ( I .GE. 1 )
262 IF( IPIV(I) .GT. 0 ) THEN
263 IP=IPIV(I)
264 IF (I .GT. 1) THEN
265 DO J= 1,I-1
266 TEMP=A(I,J)
267 A(I,J)=A(IP,J)
268 A(IP,J)=TEMP
269 END DO
270 ENDIF
271 ELSE
272 IP=-IPIV(I)
273 I=I-1
274 IF (I .GT. 1) THEN
275 DO J= 1,I-1
276 TEMP=A(I+1,J)
277 A(I+1,J)=A(IP,J)
278 A(IP,J)=TEMP
279 END DO
280 ENDIF
281 ENDIF
282 I=I-1
283 END DO
284 *
285 * Revert VALUE
286 *
287 I=1
288 DO WHILE ( I .LE. N-1 )
289 IF( IPIV(I) .LT. 0 ) THEN
290 A(I+1,I)=WORK(I)
291 I=I+1
292 ENDIF
293 I=I+1
294 END DO
295 END IF
296 END IF
297 *
298 RETURN
299 *
300 * End of ZSYCONV
301 *
302 END