1: *> \brief \b DSYCONVF
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download DSYCONVF + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyconvf.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyconvf.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyconvf.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE DSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
22: *
23: * .. Scalar Arguments ..
24: * CHARACTER UPLO, WAY
25: * INTEGER INFO, LDA, N
26: * ..
27: * .. Array Arguments ..
28: * INTEGER IPIV( * )
29: * DOUBLE PRECISION A( LDA, * ), E( * )
30: * ..
31: *
32: *
33: *> \par Purpose:
34: * =============
35: *>
36: *> \verbatim
37: *> If parameter WAY = 'C':
38: *> DSYCONVF converts the factorization output format used in
39: *> DSYTRF provided on entry in parameter A into the factorization
40: *> output format used in DSYTRF_RK (or DSYTRF_BK) that is stored
41: *> on exit in parameters A and E. It also converts in place details of
42: *> the intechanges stored in IPIV from the format used in DSYTRF into
43: *> the format used in DSYTRF_RK (or DSYTRF_BK).
44: *>
45: *> If parameter WAY = 'R':
46: *> DSYCONVF performs the conversion in reverse direction, i.e.
47: *> converts the factorization output format used in DSYTRF_RK
48: *> (or DSYTRF_BK) provided on entry in parameters A and E into
49: *> the factorization output format used in DSYTRF that is stored
50: *> on exit in parameter A. It also converts in place details of
51: *> the intechanges stored in IPIV from the format used in DSYTRF_RK
52: *> (or DSYTRF_BK) into the format used in DSYTRF.
53: *> \endverbatim
54: *
55: * Arguments:
56: * ==========
57: *
58: *> \param[in] UPLO
59: *> \verbatim
60: *> UPLO is CHARACTER*1
61: *> Specifies whether the details of the factorization are
62: *> stored as an upper or lower triangular matrix A.
63: *> = 'U': Upper triangular
64: *> = 'L': Lower triangular
65: *> \endverbatim
66: *>
67: *> \param[in] WAY
68: *> \verbatim
69: *> WAY is CHARACTER*1
70: *> = 'C': Convert
71: *> = 'R': Revert
72: *> \endverbatim
73: *>
74: *> \param[in] N
75: *> \verbatim
76: *> N is INTEGER
77: *> The order of the matrix A. N >= 0.
78: *> \endverbatim
79: *>
80: *> \param[in,out] A
81: *> \verbatim
82: *> A is DOUBLE PRECISION array, dimension (LDA,N)
83: *>
84: *> 1) If WAY ='C':
85: *>
86: *> On entry, contains factorization details in format used in
87: *> DSYTRF:
88: *> a) all elements of the symmetric block diagonal
89: *> matrix D on the diagonal of A and on superdiagonal
90: *> (or subdiagonal) of A, and
91: *> b) If UPLO = 'U': multipliers used to obtain factor U
92: *> in the superdiagonal part of A.
93: *> If UPLO = 'L': multipliers used to obtain factor L
94: *> in the superdiagonal part of A.
95: *>
96: *> On exit, contains factorization details in format used in
97: *> DSYTRF_RK or DSYTRF_BK:
98: *> a) ONLY diagonal elements of the symmetric block diagonal
99: *> matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
100: *> (superdiagonal (or subdiagonal) elements of D
101: *> are stored on exit in array E), and
102: *> b) If UPLO = 'U': factor U in the superdiagonal part of A.
103: *> If UPLO = 'L': factor L in the subdiagonal part of A.
104: *>
105: *> 2) If WAY = 'R':
106: *>
107: *> On entry, contains factorization details in format used in
108: *> DSYTRF_RK or DSYTRF_BK:
109: *> a) ONLY diagonal elements of the symmetric block diagonal
110: *> matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
111: *> (superdiagonal (or subdiagonal) elements of D
112: *> are stored on exit in array E), and
113: *> b) If UPLO = 'U': factor U in the superdiagonal part of A.
114: *> If UPLO = 'L': factor L in the subdiagonal part of A.
115: *>
116: *> On exit, contains factorization details in format used in
117: *> DSYTRF:
118: *> a) all elements of the symmetric block diagonal
119: *> matrix D on the diagonal of A and on superdiagonal
120: *> (or subdiagonal) of A, and
121: *> b) If UPLO = 'U': multipliers used to obtain factor U
122: *> in the superdiagonal part of A.
123: *> If UPLO = 'L': multipliers used to obtain factor L
124: *> in the superdiagonal part of A.
125: *> \endverbatim
126: *>
127: *> \param[in] LDA
128: *> \verbatim
129: *> LDA is INTEGER
130: *> The leading dimension of the array A. LDA >= max(1,N).
131: *> \endverbatim
132: *>
133: *> \param[in,out] E
134: *> \verbatim
135: *> E is DOUBLE PRECISION array, dimension (N)
136: *>
137: *> 1) If WAY ='C':
138: *>
139: *> On entry, just a workspace.
140: *>
141: *> On exit, contains the superdiagonal (or subdiagonal)
142: *> elements of the symmetric block diagonal matrix D
143: *> with 1-by-1 or 2-by-2 diagonal blocks, where
144: *> If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
145: *> If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
146: *>
147: *> 2) If WAY = 'R':
148: *>
149: *> On entry, contains the superdiagonal (or subdiagonal)
150: *> elements of the symmetric block diagonal matrix D
151: *> with 1-by-1 or 2-by-2 diagonal blocks, where
152: *> If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
153: *> If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
154: *>
155: *> On exit, is not changed
156: *> \endverbatim
157: *.
158: *> \param[in,out] IPIV
159: *> \verbatim
160: *> IPIV is INTEGER array, dimension (N)
161: *>
162: *> 1) If WAY ='C':
163: *> On entry, details of the interchanges and the block
164: *> structure of D in the format used in DSYTRF.
165: *> On exit, details of the interchanges and the block
166: *> structure of D in the format used in DSYTRF_RK
167: *> ( or DSYTRF_BK).
168: *>
169: *> 1) If WAY ='R':
170: *> On entry, details of the interchanges and the block
171: *> structure of D in the format used in DSYTRF_RK
172: *> ( or DSYTRF_BK).
173: *> On exit, details of the interchanges and the block
174: *> structure of D in the format used in DSYTRF.
175: *> \endverbatim
176: *>
177: *> \param[out] INFO
178: *> \verbatim
179: *> INFO is INTEGER
180: *> = 0: successful exit
181: *> < 0: if INFO = -i, the i-th argument had an illegal value
182: *> \endverbatim
183: *
184: * Authors:
185: * ========
186: *
187: *> \author Univ. of Tennessee
188: *> \author Univ. of California Berkeley
189: *> \author Univ. of Colorado Denver
190: *> \author NAG Ltd.
191: *
192: *> \ingroup doubleSYcomputational
193: *
194: *> \par Contributors:
195: * ==================
196: *>
197: *> \verbatim
198: *>
199: *> November 2017, Igor Kozachenko,
200: *> Computer Science Division,
201: *> University of California, Berkeley
202: *>
203: *> \endverbatim
204: * =====================================================================
205: SUBROUTINE DSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
206: *
207: * -- LAPACK computational routine --
208: * -- LAPACK is a software package provided by Univ. of Tennessee, --
209: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
210: *
211: * .. Scalar Arguments ..
212: CHARACTER UPLO, WAY
213: INTEGER INFO, LDA, N
214: * ..
215: * .. Array Arguments ..
216: INTEGER IPIV( * )
217: DOUBLE PRECISION A( LDA, * ), E( * )
218: * ..
219: *
220: * =====================================================================
221: *
222: * .. Parameters ..
223: DOUBLE PRECISION ZERO
224: PARAMETER ( ZERO = 0.0D+0 )
225: * ..
226: * .. External Functions ..
227: LOGICAL LSAME
228: EXTERNAL LSAME
229: *
230: * .. External Subroutines ..
231: EXTERNAL DSWAP, XERBLA
232: * .. Local Scalars ..
233: LOGICAL UPPER, CONVERT
234: INTEGER I, IP
235: * ..
236: * .. Executable Statements ..
237: *
238: INFO = 0
239: UPPER = LSAME( UPLO, 'U' )
240: CONVERT = LSAME( WAY, 'C' )
241: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
242: INFO = -1
243: ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
244: INFO = -2
245: ELSE IF( N.LT.0 ) THEN
246: INFO = -3
247: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
248: INFO = -5
249:
250: END IF
251: IF( INFO.NE.0 ) THEN
252: CALL XERBLA( 'DSYCONVF', -INFO )
253: RETURN
254: END IF
255: *
256: * Quick return if possible
257: *
258: IF( N.EQ.0 )
259: $ RETURN
260: *
261: IF( UPPER ) THEN
262: *
263: * Begin A is UPPER
264: *
265: IF ( CONVERT ) THEN
266: *
267: * Convert A (A is upper)
268: *
269: *
270: * Convert VALUE
271: *
272: * Assign superdiagonal entries of D to array E and zero out
273: * corresponding entries in input storage A
274: *
275: I = N
276: E( 1 ) = ZERO
277: DO WHILE ( I.GT.1 )
278: IF( IPIV( I ).LT.0 ) THEN
279: E( I ) = A( I-1, I )
280: E( I-1 ) = ZERO
281: A( I-1, I ) = ZERO
282: I = I - 1
283: ELSE
284: E( I ) = ZERO
285: END IF
286: I = I - 1
287: END DO
288: *
289: * Convert PERMUTATIONS and IPIV
290: *
291: * Apply permutations to submatrices of upper part of A
292: * in factorization order where i decreases from N to 1
293: *
294: I = N
295: DO WHILE ( I.GE.1 )
296: IF( IPIV( I ).GT.0 ) THEN
297: *
298: * 1-by-1 pivot interchange
299: *
300: * Swap rows i and IPIV(i) in A(1:i,N-i:N)
301: *
302: IP = IPIV( I )
303: IF( I.LT.N ) THEN
304: IF( IP.NE.I ) THEN
305: CALL DSWAP( N-I, A( I, I+1 ), LDA,
306: $ A( IP, I+1 ), LDA )
307: END IF
308: END IF
309: *
310: ELSE
311: *
312: * 2-by-2 pivot interchange
313: *
314: * Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
315: *
316: IP = -IPIV( I )
317: IF( I.LT.N ) THEN
318: IF( IP.NE.(I-1) ) THEN
319: CALL DSWAP( N-I, A( I-1, I+1 ), LDA,
320: $ A( IP, I+1 ), LDA )
321: END IF
322: END IF
323: *
324: * Convert IPIV
325: * There is no interchnge of rows i and and IPIV(i),
326: * so this should be reflected in IPIV format for
327: * *SYTRF_RK ( or *SYTRF_BK)
328: *
329: IPIV( I ) = I
330: *
331: I = I - 1
332: *
333: END IF
334: I = I - 1
335: END DO
336: *
337: ELSE
338: *
339: * Revert A (A is upper)
340: *
341: *
342: * Revert PERMUTATIONS and IPIV
343: *
344: * Apply permutations to submatrices of upper part of A
345: * in reverse factorization order where i increases from 1 to N
346: *
347: I = 1
348: DO WHILE ( I.LE.N )
349: IF( IPIV( I ).GT.0 ) THEN
350: *
351: * 1-by-1 pivot interchange
352: *
353: * Swap rows i and IPIV(i) in A(1:i,N-i:N)
354: *
355: IP = IPIV( I )
356: IF( I.LT.N ) THEN
357: IF( IP.NE.I ) THEN
358: CALL DSWAP( N-I, A( IP, I+1 ), LDA,
359: $ A( I, I+1 ), LDA )
360: END IF
361: END IF
362: *
363: ELSE
364: *
365: * 2-by-2 pivot interchange
366: *
367: * Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
368: *
369: I = I + 1
370: IP = -IPIV( I )
371: IF( I.LT.N ) THEN
372: IF( IP.NE.(I-1) ) THEN
373: CALL DSWAP( N-I, A( IP, I+1 ), LDA,
374: $ A( I-1, I+1 ), LDA )
375: END IF
376: END IF
377: *
378: * Convert IPIV
379: * There is one interchange of rows i-1 and IPIV(i-1),
380: * so this should be recorded in two consecutive entries
381: * in IPIV format for *SYTRF
382: *
383: IPIV( I ) = IPIV( I-1 )
384: *
385: END IF
386: I = I + 1
387: END DO
388: *
389: * Revert VALUE
390: * Assign superdiagonal entries of D from array E to
391: * superdiagonal entries of A.
392: *
393: I = N
394: DO WHILE ( I.GT.1 )
395: IF( IPIV( I ).LT.0 ) THEN
396: A( I-1, I ) = E( I )
397: I = I - 1
398: END IF
399: I = I - 1
400: END DO
401: *
402: * End A is UPPER
403: *
404: END IF
405: *
406: ELSE
407: *
408: * Begin A is LOWER
409: *
410: IF ( CONVERT ) THEN
411: *
412: * Convert A (A is lower)
413: *
414: *
415: * Convert VALUE
416: * Assign subdiagonal entries of D to array E and zero out
417: * corresponding entries in input storage A
418: *
419: I = 1
420: E( N ) = ZERO
421: DO WHILE ( I.LE.N )
422: IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
423: E( I ) = A( I+1, I )
424: E( I+1 ) = ZERO
425: A( I+1, I ) = ZERO
426: I = I + 1
427: ELSE
428: E( I ) = ZERO
429: END IF
430: I = I + 1
431: END DO
432: *
433: * Convert PERMUTATIONS and IPIV
434: *
435: * Apply permutations to submatrices of lower part of A
436: * in factorization order where k increases from 1 to N
437: *
438: I = 1
439: DO WHILE ( I.LE.N )
440: IF( IPIV( I ).GT.0 ) THEN
441: *
442: * 1-by-1 pivot interchange
443: *
444: * Swap rows i and IPIV(i) in A(i:N,1:i-1)
445: *
446: IP = IPIV( I )
447: IF ( I.GT.1 ) THEN
448: IF( IP.NE.I ) THEN
449: CALL DSWAP( I-1, A( I, 1 ), LDA,
450: $ A( IP, 1 ), LDA )
451: END IF
452: END IF
453: *
454: ELSE
455: *
456: * 2-by-2 pivot interchange
457: *
458: * Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
459: *
460: IP = -IPIV( I )
461: IF ( I.GT.1 ) THEN
462: IF( IP.NE.(I+1) ) THEN
463: CALL DSWAP( I-1, A( I+1, 1 ), LDA,
464: $ A( IP, 1 ), LDA )
465: END IF
466: END IF
467: *
468: * Convert IPIV
469: * There is no interchnge of rows i and and IPIV(i),
470: * so this should be reflected in IPIV format for
471: * *SYTRF_RK ( or *SYTRF_BK)
472: *
473: IPIV( I ) = I
474: *
475: I = I + 1
476: *
477: END IF
478: I = I + 1
479: END DO
480: *
481: ELSE
482: *
483: * Revert A (A is lower)
484: *
485: *
486: * Revert PERMUTATIONS and IPIV
487: *
488: * Apply permutations to submatrices of lower part of A
489: * in reverse factorization order where i decreases from N to 1
490: *
491: I = N
492: DO WHILE ( I.GE.1 )
493: IF( IPIV( I ).GT.0 ) THEN
494: *
495: * 1-by-1 pivot interchange
496: *
497: * Swap rows i and IPIV(i) in A(i:N,1:i-1)
498: *
499: IP = IPIV( I )
500: IF ( I.GT.1 ) THEN
501: IF( IP.NE.I ) THEN
502: CALL DSWAP( I-1, A( IP, 1 ), LDA,
503: $ A( I, 1 ), LDA )
504: END IF
505: END IF
506: *
507: ELSE
508: *
509: * 2-by-2 pivot interchange
510: *
511: * Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
512: *
513: I = I - 1
514: IP = -IPIV( I )
515: IF ( I.GT.1 ) THEN
516: IF( IP.NE.(I+1) ) THEN
517: CALL DSWAP( I-1, A( IP, 1 ), LDA,
518: $ A( I+1, 1 ), LDA )
519: END IF
520: END IF
521: *
522: * Convert IPIV
523: * There is one interchange of rows i+1 and IPIV(i+1),
524: * so this should be recorded in consecutive entries
525: * in IPIV format for *SYTRF
526: *
527: IPIV( I ) = IPIV( I+1 )
528: *
529: END IF
530: I = I - 1
531: END DO
532: *
533: * Revert VALUE
534: * Assign subdiagonal entries of D from array E to
535: * subgiagonal entries of A.
536: *
537: I = 1
538: DO WHILE ( I.LE.N-1 )
539: IF( IPIV( I ).LT.0 ) THEN
540: A( I + 1, I ) = E( I )
541: I = I + 1
542: END IF
543: I = I + 1
544: END DO
545: *
546: END IF
547: *
548: * End A is LOWER
549: *
550: END IF
551:
552: RETURN
553: *
554: * End of DSYCONVF
555: *
556: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dsyconvf.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack