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