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