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
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zsyconv.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack