LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
dsyconv.f
Go to the documentation of this file.
1 *> \brief \b DSYCONV
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
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">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE DSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, 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, * ), WORK( * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> DSYCONV convert A given by TRF into L and D and vice-versa.
39 *> Get Non-diag elements of D (returned in workspace) and
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
58 *> = 'C': Convert
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 *>
68 *> \param[in] A
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 *>
88 *> \param[out] WORK
89 *> \verbatim
90 *> WORK is DOUBLE PRECISION array, dimension (N)
91 *> \endverbatim
92 *>
93 *> \param[out] INFO
94 *> \verbatim
95 *> INFO is INTEGER
96 *> = 0: successful exit
97 *> < 0: if INFO = -i, the i-th argument had an illegal value
98 *> \endverbatim
99 *
100 * Authors:
101 * ========
102 *
103 *> \author Univ. of Tennessee
104 *> \author Univ. of California Berkeley
105 *> \author Univ. of Colorado Denver
106 *> \author NAG Ltd.
107 *
108 *> \date November 2011
109 *
110 *> \ingroup doubleSYcomputational
111 *
112 * =====================================================================
113  SUBROUTINE dsyconv( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO )
114 *
115 * -- LAPACK computational routine (version 3.4.0) --
116 * -- LAPACK is a software package provided by Univ. of Tennessee, --
117 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
118 * November 2011
119 *
120 * .. Scalar Arguments ..
121  CHARACTER uplo, way
122  INTEGER info, lda, n
123 * ..
124 * .. Array Arguments ..
125  INTEGER ipiv( * )
126  DOUBLE PRECISION a( lda, * ), work( * )
127 * ..
128 *
129 * =====================================================================
130 *
131 * .. Parameters ..
132  DOUBLE PRECISION zero
133  parameter( zero = 0.0d+0 )
134 * ..
135 * .. External Functions ..
136  LOGICAL lsame
137  EXTERNAL lsame
138 *
139 * .. External Subroutines ..
140  EXTERNAL xerbla
141 * .. Local Scalars ..
142  LOGICAL upper, convert
143  INTEGER i, ip, j
144  DOUBLE PRECISION temp
145 * ..
146 * .. Executable Statements ..
147 *
148  info = 0
149  upper = lsame( uplo, 'U' )
150  convert = lsame( way, 'C' )
151  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
152  info = -1
153  ELSE IF( .NOT.convert .AND. .NOT.lsame( way, 'R' ) ) THEN
154  info = -2
155  ELSE IF( n.LT.0 ) THEN
156  info = -3
157  ELSE IF( lda.LT.max( 1, n ) ) THEN
158  info = -5
159 
160  END IF
161  IF( info.NE.0 ) THEN
162  CALL xerbla( 'DSYCONV', -info )
163  return
164  END IF
165 *
166 * Quick return if possible
167 *
168  IF( n.EQ.0 )
169  $ return
170 *
171  IF( upper ) THEN
172 *
173 * A is UPPER
174 *
175 * Convert A (A is upper)
176 *
177 * Convert VALUE
178 *
179  IF ( convert ) THEN
180  i=n
181  work(1)=zero
182  DO WHILE ( i .GT. 1 )
183  IF( ipiv(i) .LT. 0 ) THEN
184  work(i)=a(i-1,i)
185  a(i-1,i)=zero
186  i=i-1
187  ELSE
188  work(i)=zero
189  ENDIF
190  i=i-1
191  END DO
192 *
193 * Convert PERMUTATIONS
194 *
195  i=n
196  DO WHILE ( i .GE. 1 )
197  IF( ipiv(i) .GT. 0) THEN
198  ip=ipiv(i)
199  IF( i .LT. n) THEN
200  DO 12 j= i+1,n
201  temp=a(ip,j)
202  a(ip,j)=a(i,j)
203  a(i,j)=temp
204  12 continue
205  ENDIF
206  ELSE
207  ip=-ipiv(i)
208  IF( i .LT. n) THEN
209  DO 13 j= i+1,n
210  temp=a(ip,j)
211  a(ip,j)=a(i-1,j)
212  a(i-1,j)=temp
213  13 continue
214  ENDIF
215  i=i-1
216  ENDIF
217  i=i-1
218  END DO
219 
220  ELSE
221 *
222 * Revert A (A is upper)
223 *
224 *
225 * Revert PERMUTATIONS
226 *
227  i=1
228  DO WHILE ( i .LE. n )
229  IF( ipiv(i) .GT. 0 ) THEN
230  ip=ipiv(i)
231  IF( i .LT. n) THEN
232  DO j= i+1,n
233  temp=a(ip,j)
234  a(ip,j)=a(i,j)
235  a(i,j)=temp
236  END DO
237  ENDIF
238  ELSE
239  ip=-ipiv(i)
240  i=i+1
241  IF( i .LT. n) THEN
242  DO j= i+1,n
243  temp=a(ip,j)
244  a(ip,j)=a(i-1,j)
245  a(i-1,j)=temp
246  END DO
247  ENDIF
248  ENDIF
249  i=i+1
250  END DO
251 *
252 * Revert VALUE
253 *
254  i=n
255  DO WHILE ( i .GT. 1 )
256  IF( ipiv(i) .LT. 0 ) THEN
257  a(i-1,i)=work(i)
258  i=i-1
259  ENDIF
260  i=i-1
261  END DO
262  END IF
263  ELSE
264 *
265 * A is LOWER
266 *
267  IF ( convert ) THEN
268 *
269 * Convert A (A is lower)
270 *
271 *
272 * Convert VALUE
273 *
274  i=1
275  work(n)=zero
276  DO WHILE ( i .LE. n )
277  IF( i.LT.n .AND. ipiv(i) .LT. 0 ) THEN
278  work(i)=a(i+1,i)
279  a(i+1,i)=zero
280  i=i+1
281  ELSE
282  work(i)=zero
283  ENDIF
284  i=i+1
285  END DO
286 *
287 * Convert PERMUTATIONS
288 *
289  i=1
290  DO WHILE ( i .LE. n )
291  IF( ipiv(i) .GT. 0 ) THEN
292  ip=ipiv(i)
293  IF (i .GT. 1) THEN
294  DO 22 j= 1,i-1
295  temp=a(ip,j)
296  a(ip,j)=a(i,j)
297  a(i,j)=temp
298  22 continue
299  ENDIF
300  ELSE
301  ip=-ipiv(i)
302  IF (i .GT. 1) THEN
303  DO 23 j= 1,i-1
304  temp=a(ip,j)
305  a(ip,j)=a(i+1,j)
306  a(i+1,j)=temp
307  23 continue
308  ENDIF
309  i=i+1
310  ENDIF
311  i=i+1
312  END DO
313  ELSE
314 *
315 * Revert A (A is lower)
316 *
317 *
318 * Revert PERMUTATIONS
319 *
320  i=n
321  DO WHILE ( i .GE. 1 )
322  IF( ipiv(i) .GT. 0 ) THEN
323  ip=ipiv(i)
324  IF (i .GT. 1) THEN
325  DO j= 1,i-1
326  temp=a(i,j)
327  a(i,j)=a(ip,j)
328  a(ip,j)=temp
329  END DO
330  ENDIF
331  ELSE
332  ip=-ipiv(i)
333  i=i-1
334  IF (i .GT. 1) THEN
335  DO j= 1,i-1
336  temp=a(i+1,j)
337  a(i+1,j)=a(ip,j)
338  a(ip,j)=temp
339  END DO
340  ENDIF
341  ENDIF
342  i=i-1
343  END DO
344 *
345 * Revert VALUE
346 *
347  i=1
348  DO WHILE ( i .LE. n-1 )
349  IF( ipiv(i) .LT. zero ) THEN
350  a(i+1,i)=work(i)
351  i=i+1
352  ENDIF
353  i=i+1
354  END DO
355  END IF
356  END IF
357 
358  return
359 *
360 * End of DSYCONV
361 *
362  END