![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dsyconv.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack|
Return to dsyconv.f CVS log | Up to [local] / rpl / lapack / lapack |
1.4 bertrand 1: *> \brief \b DSYCONV
2: *
3: * =========== DOCUMENTATION ===========
4: *
1.11 ! bertrand 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
1.4 bertrand 7: *
8: *> \htmlonly
1.11 ! bertrand 9: *> Download DSYCONV + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyconv.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyconv.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyconv.f">
1.4 bertrand 15: *> [TXT]</a>
1.11 ! bertrand 16: *> \endhtmlonly
1.4 bertrand 17: *
18: * Definition:
19: * ===========
20: *
1.9 bertrand 21: * SUBROUTINE DSYCONV( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
1.11 ! bertrand 22: *
1.4 bertrand 23: * .. Scalar Arguments ..
24: * CHARACTER UPLO, WAY
25: * INTEGER INFO, LDA, N
26: * ..
27: * .. Array Arguments ..
28: * INTEGER IPIV( * )
1.9 bertrand 29: * DOUBLE PRECISION A( LDA, * ), E( * )
1.4 bertrand 30: * ..
1.11 ! bertrand 31: *
1.4 bertrand 32: *
33: *> \par Purpose:
34: * =============
35: *>
36: *> \verbatim
37: *>
38: *> DSYCONV convert A given by TRF into L and D and vice-versa.
1.11 ! bertrand 39: *> Get Non-diag elements of D (returned in workspace) and
1.4 bertrand 40: *> apply or reverse permutation done in TRF.
41: *> \endverbatim
42: *
43: * Arguments:
44: * ==========
45: *
46: *> \param[in] UPLO
47: *> \verbatim
48: *> UPLO is CHARACTER*1
49: *> Specifies whether the details of the factorization are stored
50: *> as an upper or lower triangular matrix.
51: *> = 'U': Upper triangular, form is A = U*D*U**T;
52: *> = 'L': Lower triangular, form is A = L*D*L**T.
53: *> \endverbatim
54: *>
55: *> \param[in] WAY
56: *> \verbatim
57: *> WAY is CHARACTER*1
1.11 ! bertrand 58: *> = 'C': Convert
1.4 bertrand 59: *> = 'R': Revert
60: *> \endverbatim
61: *>
62: *> \param[in] N
63: *> \verbatim
64: *> N is INTEGER
65: *> The order of the matrix A. N >= 0.
66: *> \endverbatim
67: *>
1.9 bertrand 68: *> \param[in,out] A
1.4 bertrand 69: *> \verbatim
70: *> A is DOUBLE PRECISION array, dimension (LDA,N)
71: *> The block diagonal matrix D and the multipliers used to
72: *> obtain the factor U or L as computed by DSYTRF.
73: *> \endverbatim
74: *>
75: *> \param[in] LDA
76: *> \verbatim
77: *> LDA is INTEGER
78: *> The leading dimension of the array A. LDA >= max(1,N).
79: *> \endverbatim
80: *>
81: *> \param[in] IPIV
82: *> \verbatim
83: *> IPIV is INTEGER array, dimension (N)
84: *> Details of the interchanges and the block structure of D
85: *> as determined by DSYTRF.
86: *> \endverbatim
87: *>
1.9 bertrand 88: *> \param[out] E
1.4 bertrand 89: *> \verbatim
1.9 bertrand 90: *> E is DOUBLE PRECISION array, dimension (N)
91: *> E stores the supdiagonal/subdiagonal of the symmetric 1-by-1
92: *> or 2-by-2 block diagonal matrix D in LDLT.
1.4 bertrand 93: *> \endverbatim
94: *>
95: *> \param[out] INFO
96: *> \verbatim
97: *> INFO is INTEGER
98: *> = 0: successful exit
99: *> < 0: if INFO = -i, the i-th argument had an illegal value
100: *> \endverbatim
101: *
102: * Authors:
103: * ========
104: *
1.11 ! bertrand 105: *> \author Univ. of Tennessee
! 106: *> \author Univ. of California Berkeley
! 107: *> \author Univ. of Colorado Denver
! 108: *> \author NAG Ltd.
1.4 bertrand 109: *
1.11 ! bertrand 110: *> \date December 2016
1.4 bertrand 111: *
112: *> \ingroup doubleSYcomputational
113: *
114: * =====================================================================
1.9 bertrand 115: SUBROUTINE DSYCONV( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
1.1 bertrand 116: *
1.11 ! bertrand 117: * -- LAPACK computational routine (version 3.7.0) --
1.1 bertrand 118: * -- LAPACK is a software package provided by Univ. of Tennessee, --
119: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.11 ! bertrand 120: * December 2016
1.1 bertrand 121: *
122: * .. Scalar Arguments ..
123: CHARACTER UPLO, WAY
124: INTEGER INFO, LDA, N
125: * ..
126: * .. Array Arguments ..
127: INTEGER IPIV( * )
1.9 bertrand 128: DOUBLE PRECISION A( LDA, * ), E( * )
1.1 bertrand 129: * ..
130: *
131: * =====================================================================
132: *
133: * .. Parameters ..
134: DOUBLE PRECISION ZERO
135: PARAMETER ( ZERO = 0.0D+0 )
136: * ..
137: * .. External Functions ..
138: LOGICAL LSAME
139: EXTERNAL LSAME
140: *
141: * .. External Subroutines ..
142: EXTERNAL XERBLA
143: * .. Local Scalars ..
144: LOGICAL UPPER, CONVERT
145: INTEGER I, IP, J
146: DOUBLE PRECISION TEMP
147: * ..
148: * .. Executable Statements ..
149: *
150: INFO = 0
151: UPPER = LSAME( UPLO, 'U' )
152: CONVERT = LSAME( WAY, 'C' )
153: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
154: INFO = -1
155: ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
156: INFO = -2
157: ELSE IF( N.LT.0 ) THEN
158: INFO = -3
159: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
160: INFO = -5
161:
162: END IF
163: IF( INFO.NE.0 ) THEN
164: CALL XERBLA( 'DSYCONV', -INFO )
165: RETURN
166: END IF
167: *
168: * Quick return if possible
169: *
170: IF( N.EQ.0 )
171: $ RETURN
172: *
173: IF( UPPER ) THEN
174: *
175: * A is UPPER
176: *
177: * Convert A (A is upper)
178: *
179: * Convert VALUE
180: *
181: IF ( CONVERT ) THEN
182: I=N
1.9 bertrand 183: E(1)=ZERO
1.1 bertrand 184: DO WHILE ( I .GT. 1 )
185: IF( IPIV(I) .LT. 0 ) THEN
1.9 bertrand 186: E(I)=A(I-1,I)
187: E(I-1)=ZERO
1.1 bertrand 188: A(I-1,I)=ZERO
189: I=I-1
190: ELSE
1.9 bertrand 191: E(I)=ZERO
1.1 bertrand 192: ENDIF
193: I=I-1
194: END DO
195: *
196: * Convert PERMUTATIONS
1.11 ! bertrand 197: *
1.1 bertrand 198: I=N
199: DO WHILE ( I .GE. 1 )
200: IF( IPIV(I) .GT. 0) THEN
201: IP=IPIV(I)
202: IF( I .LT. N) THEN
203: DO 12 J= I+1,N
204: TEMP=A(IP,J)
205: A(IP,J)=A(I,J)
206: A(I,J)=TEMP
207: 12 CONTINUE
208: ENDIF
209: ELSE
210: IP=-IPIV(I)
211: IF( I .LT. N) THEN
212: DO 13 J= I+1,N
213: TEMP=A(IP,J)
214: A(IP,J)=A(I-1,J)
215: A(I-1,J)=TEMP
216: 13 CONTINUE
217: ENDIF
218: I=I-1
219: ENDIF
220: I=I-1
221: END DO
222:
223: ELSE
224: *
225: * Revert A (A is upper)
226: *
227: *
228: * Revert PERMUTATIONS
1.11 ! bertrand 229: *
1.1 bertrand 230: I=1
231: DO WHILE ( I .LE. N )
232: IF( IPIV(I) .GT. 0 ) THEN
233: IP=IPIV(I)
234: IF( I .LT. N) THEN
235: DO J= I+1,N
236: TEMP=A(IP,J)
237: A(IP,J)=A(I,J)
238: A(I,J)=TEMP
239: END DO
240: ENDIF
241: ELSE
242: IP=-IPIV(I)
243: I=I+1
244: IF( I .LT. N) THEN
245: DO J= I+1,N
246: TEMP=A(IP,J)
247: A(IP,J)=A(I-1,J)
248: A(I-1,J)=TEMP
249: END DO
250: ENDIF
251: ENDIF
252: I=I+1
253: END DO
254: *
255: * Revert VALUE
256: *
257: I=N
258: DO WHILE ( I .GT. 1 )
259: IF( IPIV(I) .LT. 0 ) THEN
1.9 bertrand 260: A(I-1,I)=E(I)
1.1 bertrand 261: I=I-1
262: ENDIF
263: I=I-1
264: END DO
265: END IF
266: ELSE
267: *
268: * A is LOWER
269: *
270: IF ( CONVERT ) THEN
271: *
272: * Convert A (A is lower)
273: *
274: *
275: * Convert VALUE
276: *
277: I=1
1.9 bertrand 278: E(N)=ZERO
1.1 bertrand 279: DO WHILE ( I .LE. N )
280: IF( I.LT.N .AND. IPIV(I) .LT. 0 ) THEN
1.9 bertrand 281: E(I)=A(I+1,I)
282: E(I+1)=ZERO
1.1 bertrand 283: A(I+1,I)=ZERO
284: I=I+1
285: ELSE
1.9 bertrand 286: E(I)=ZERO
1.1 bertrand 287: ENDIF
288: I=I+1
289: END DO
290: *
291: * Convert PERMUTATIONS
292: *
293: I=1
294: DO WHILE ( I .LE. N )
295: IF( IPIV(I) .GT. 0 ) THEN
296: IP=IPIV(I)
297: IF (I .GT. 1) THEN
298: DO 22 J= 1,I-1
299: TEMP=A(IP,J)
300: A(IP,J)=A(I,J)
301: A(I,J)=TEMP
302: 22 CONTINUE
303: ENDIF
304: ELSE
305: IP=-IPIV(I)
306: IF (I .GT. 1) THEN
307: DO 23 J= 1,I-1
308: TEMP=A(IP,J)
309: A(IP,J)=A(I+1,J)
310: A(I+1,J)=TEMP
311: 23 CONTINUE
312: ENDIF
313: I=I+1
314: ENDIF
315: I=I+1
316: END DO
317: ELSE
318: *
319: * Revert A (A is lower)
320: *
321: *
322: * Revert PERMUTATIONS
323: *
324: I=N
325: DO WHILE ( I .GE. 1 )
326: IF( IPIV(I) .GT. 0 ) THEN
327: IP=IPIV(I)
328: IF (I .GT. 1) THEN
329: DO J= 1,I-1
330: TEMP=A(I,J)
331: A(I,J)=A(IP,J)
332: A(IP,J)=TEMP
333: END DO
334: ENDIF
335: ELSE
336: IP=-IPIV(I)
337: I=I-1
338: IF (I .GT. 1) THEN
339: DO J= 1,I-1
340: TEMP=A(I+1,J)
341: A(I+1,J)=A(IP,J)
342: A(IP,J)=TEMP
343: END DO
344: ENDIF
345: ENDIF
346: I=I-1
347: END DO
348: *
349: * Revert VALUE
350: *
351: I=1
352: DO WHILE ( I .LE. N-1 )
1.9 bertrand 353: IF( IPIV(I) .LT. 0 ) THEN
354: A(I+1,I)=E(I)
1.1 bertrand 355: I=I+1
356: ENDIF
357: I=I+1
358: END DO
359: END IF
360: END IF
361:
362: RETURN
363: *
364: * End of DSYCONV
365: *
366: END