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, IPIV, E, 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 coverts 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 parametes A and E into
49: *> the factorization output format used in DSYTRF that is stored
50: *> on exit in parameter A. It also coverts 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: *> \date December 2016
193: *
194: *> \ingroup doubleSYcomputational
195: *
196: *> \par Contributors:
197: * ==================
198: *>
199: *> \verbatim
200: *>
201: *> December 2016, Igor Kozachenko,
202: *> Computer Science Division,
203: *> University of California, Berkeley
204: *>
205: *> \endverbatim
206: * =====================================================================
207: SUBROUTINE DSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
208: *
209: * -- LAPACK computational routine (version 3.7.0) --
210: * -- LAPACK is a software package provided by Univ. of Tennessee, --
211: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
212: * December 2016
213: *
214: * .. Scalar Arguments ..
215: CHARACTER UPLO, WAY
216: INTEGER INFO, LDA, N
217: * ..
218: * .. Array Arguments ..
219: INTEGER IPIV( * )
220: DOUBLE PRECISION A( LDA, * ), E( * )
221: * ..
222: *
223: * =====================================================================
224: *
225: * .. Parameters ..
226: DOUBLE PRECISION ZERO
227: PARAMETER ( ZERO = 0.0D+0 )
228: * ..
229: * .. External Functions ..
230: LOGICAL LSAME
231: EXTERNAL LSAME
232: *
233: * .. External Subroutines ..
234: EXTERNAL DSWAP, XERBLA
235: * .. Local Scalars ..
236: LOGICAL UPPER, CONVERT
237: INTEGER I, IP
238: * ..
239: * .. Executable Statements ..
240: *
241: INFO = 0
242: UPPER = LSAME( UPLO, 'U' )
243: CONVERT = LSAME( WAY, 'C' )
244: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
245: INFO = -1
246: ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
247: INFO = -2
248: ELSE IF( N.LT.0 ) THEN
249: INFO = -3
250: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
251: INFO = -5
252:
253: END IF
254: IF( INFO.NE.0 ) THEN
255: CALL XERBLA( 'DSYCONVF', -INFO )
256: RETURN
257: END IF
258: *
259: * Quick return if possible
260: *
261: IF( N.EQ.0 )
262: $ RETURN
263: *
264: IF( UPPER ) THEN
265: *
266: * Begin A is UPPER
267: *
268: IF ( CONVERT ) THEN
269: *
270: * Convert A (A is upper)
271: *
272: *
273: * Convert VALUE
274: *
275: * Assign superdiagonal entries of D to array E and zero out
276: * corresponding entries in input storage A
277: *
278: I = N
279: E( 1 ) = ZERO
280: DO WHILE ( I.GT.1 )
281: IF( IPIV( I ).LT.0 ) THEN
282: E( I ) = A( I-1, I )
283: E( I-1 ) = ZERO
284: A( I-1, I ) = ZERO
285: I = I - 1
286: ELSE
287: E( I ) = ZERO
288: END IF
289: I = I - 1
290: END DO
291: *
292: * Convert PERMUTATIONS and IPIV
293: *
294: * Apply permutaions to submatrices of upper part of A
295: * in factorization order where i decreases from N to 1
296: *
297: I = N
298: DO WHILE ( I.GE.1 )
299: IF( IPIV( I ).GT.0 ) THEN
300: *
301: * 1-by-1 pivot interchange
302: *
303: * Swap rows i and IPIV(i) in A(1:i,N-i:N)
304: *
305: IP = IPIV( I )
306: IF( I.LT.N ) THEN
307: IF( IP.NE.I ) THEN
308: CALL DSWAP( N-I, A( I, I+1 ), LDA,
309: $ A( IP, I+1 ), LDA )
310: END IF
311: END IF
312: *
313: ELSE
314: *
315: * 2-by-2 pivot interchange
316: *
317: * Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
318: *
319: IP = -IPIV( I )
320: IF( I.LT.N ) THEN
321: IF( IP.NE.(I-1) ) THEN
322: CALL DSWAP( N-I, A( I-1, I+1 ), LDA,
323: $ A( IP, I+1 ), LDA )
324: END IF
325: END IF
326: *
327: * Convert IPIV
328: * There is no interchnge of rows i and and IPIV(i),
329: * so this should be reflected in IPIV format for
330: * *SYTRF_RK ( or *SYTRF_BK)
331: *
332: IPIV( I ) = I
333: *
334: I = I - 1
335: *
336: END IF
337: I = I - 1
338: END DO
339: *
340: ELSE
341: *
342: * Revert A (A is upper)
343: *
344: *
345: * Revert PERMUTATIONS and IPIV
346: *
347: * Apply permutaions to submatrices of upper part of A
348: * in reverse factorization order where i increases from 1 to N
349: *
350: I = 1
351: DO WHILE ( I.LE.N )
352: IF( IPIV( I ).GT.0 ) THEN
353: *
354: * 1-by-1 pivot interchange
355: *
356: * Swap rows i and IPIV(i) in A(1:i,N-i:N)
357: *
358: IP = IPIV( I )
359: IF( I.LT.N ) THEN
360: IF( IP.NE.I ) THEN
361: CALL DSWAP( N-I, A( IP, I+1 ), LDA,
362: $ A( I, I+1 ), LDA )
363: END IF
364: END IF
365: *
366: ELSE
367: *
368: * 2-by-2 pivot interchange
369: *
370: * Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
371: *
372: I = I + 1
373: IP = -IPIV( I )
374: IF( I.LT.N ) THEN
375: IF( IP.NE.(I-1) ) THEN
376: CALL DSWAP( N-I, A( IP, I+1 ), LDA,
377: $ A( I-1, I+1 ), LDA )
378: END IF
379: END IF
380: *
381: * Convert IPIV
382: * There is one interchange of rows i-1 and IPIV(i-1),
383: * so this should be recorded in two consecutive entries
384: * in IPIV format for *SYTRF
385: *
386: IPIV( I ) = IPIV( I-1 )
387: *
388: END IF
389: I = I + 1
390: END DO
391: *
392: * Revert VALUE
393: * Assign superdiagonal entries of D from array E to
394: * superdiagonal entries of A.
395: *
396: I = N
397: DO WHILE ( I.GT.1 )
398: IF( IPIV( I ).LT.0 ) THEN
399: A( I-1, I ) = E( I )
400: I = I - 1
401: END IF
402: I = I - 1
403: END DO
404: *
405: * End A is UPPER
406: *
407: END IF
408: *
409: ELSE
410: *
411: * Begin A is LOWER
412: *
413: IF ( CONVERT ) THEN
414: *
415: * Convert A (A is lower)
416: *
417: *
418: * Convert VALUE
419: * Assign subdiagonal entries of D to array E and zero out
420: * corresponding entries in input storage A
421: *
422: I = 1
423: E( N ) = ZERO
424: DO WHILE ( I.LE.N )
425: IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
426: E( I ) = A( I+1, I )
427: E( I+1 ) = ZERO
428: A( I+1, I ) = ZERO
429: I = I + 1
430: ELSE
431: E( I ) = ZERO
432: END IF
433: I = I + 1
434: END DO
435: *
436: * Convert PERMUTATIONS and IPIV
437: *
438: * Apply permutaions to submatrices of lower part of A
439: * in factorization order where k increases from 1 to N
440: *
441: I = 1
442: DO WHILE ( I.LE.N )
443: IF( IPIV( I ).GT.0 ) THEN
444: *
445: * 1-by-1 pivot interchange
446: *
447: * Swap rows i and IPIV(i) in A(i:N,1:i-1)
448: *
449: IP = IPIV( I )
450: IF ( I.GT.1 ) THEN
451: IF( IP.NE.I ) THEN
452: CALL DSWAP( I-1, A( I, 1 ), LDA,
453: $ A( IP, 1 ), LDA )
454: END IF
455: END IF
456: *
457: ELSE
458: *
459: * 2-by-2 pivot interchange
460: *
461: * Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
462: *
463: IP = -IPIV( I )
464: IF ( I.GT.1 ) THEN
465: IF( IP.NE.(I+1) ) THEN
466: CALL DSWAP( I-1, A( I+1, 1 ), LDA,
467: $ A( IP, 1 ), LDA )
468: END IF
469: END IF
470: *
471: * Convert IPIV
472: * There is no interchnge of rows i and and IPIV(i),
473: * so this should be reflected in IPIV format for
474: * *SYTRF_RK ( or *SYTRF_BK)
475: *
476: IPIV( I ) = I
477: *
478: I = I + 1
479: *
480: END IF
481: I = I + 1
482: END DO
483: *
484: ELSE
485: *
486: * Revert A (A is lower)
487: *
488: *
489: * Revert PERMUTATIONS and IPIV
490: *
491: * Apply permutaions to submatrices of lower part of A
492: * in reverse factorization order where i decreases from N to 1
493: *
494: I = N
495: DO WHILE ( I.GE.1 )
496: IF( IPIV( I ).GT.0 ) THEN
497: *
498: * 1-by-1 pivot interchange
499: *
500: * Swap rows i and IPIV(i) in A(i:N,1:i-1)
501: *
502: IP = IPIV( I )
503: IF ( I.GT.1 ) THEN
504: IF( IP.NE.I ) THEN
505: CALL DSWAP( I-1, A( IP, 1 ), LDA,
506: $ A( I, 1 ), LDA )
507: END IF
508: END IF
509: *
510: ELSE
511: *
512: * 2-by-2 pivot interchange
513: *
514: * Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
515: *
516: I = I - 1
517: IP = -IPIV( I )
518: IF ( I.GT.1 ) THEN
519: IF( IP.NE.(I+1) ) THEN
520: CALL DSWAP( I-1, A( IP, 1 ), LDA,
521: $ A( I+1, 1 ), LDA )
522: END IF
523: END IF
524: *
525: * Convert IPIV
526: * There is one interchange of rows i+1 and IPIV(i+1),
527: * so this should be recorded in consecutive entries
528: * in IPIV format for *SYTRF
529: *
530: IPIV( I ) = IPIV( I+1 )
531: *
532: END IF
533: I = I - 1
534: END DO
535: *
536: * Revert VALUE
537: * Assign subdiagonal entries of D from array E to
538: * subgiagonal entries of A.
539: *
540: I = 1
541: DO WHILE ( I.LE.N-1 )
542: IF( IPIV( I ).LT.0 ) THEN
543: A( I + 1, I ) = E( I )
544: I = I + 1
545: END IF
546: I = I + 1
547: END DO
548: *
549: END IF
550: *
551: * End A is LOWER
552: *
553: END IF
554:
555: RETURN
556: *
557: * End of DSYCONVF
558: *
559: 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