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