LAPACK  3.10.0 LAPACK: Linear Algebra PACKage
dtrttf.f
Go to the documentation of this file.
1 *> \brief \b DTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed format (TF).
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download DTRTTF + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrttf.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrttf.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrttf.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE DTRTTF( TRANSR, UPLO, N, A, LDA, ARF, INFO )
22 *
23 * .. Scalar Arguments ..
24 * CHARACTER TRANSR, UPLO
25 * INTEGER INFO, N, LDA
26 * ..
27 * .. Array Arguments ..
28 * DOUBLE PRECISION A( 0: LDA-1, 0: * ), ARF( 0: * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> DTRTTF copies a triangular matrix A from standard full format (TR)
38 *> to rectangular full packed format (TF) .
39 *> \endverbatim
40 *
41 * Arguments:
42 * ==========
43 *
44 *> \param[in] TRANSR
45 *> \verbatim
46 *> TRANSR is CHARACTER*1
47 *> = 'N': ARF in Normal form is wanted;
48 *> = 'T': ARF in Transpose form is wanted.
49 *> \endverbatim
50 *>
51 *> \param[in] UPLO
52 *> \verbatim
53 *> UPLO is CHARACTER*1
54 *> = 'U': Upper triangle of A is stored;
55 *> = 'L': Lower triangle of A is stored.
56 *> \endverbatim
57 *>
58 *> \param[in] N
59 *> \verbatim
60 *> N is INTEGER
61 *> The order of the matrix A. N >= 0.
62 *> \endverbatim
63 *>
64 *> \param[in] A
65 *> \verbatim
66 *> A is DOUBLE PRECISION array, dimension (LDA,N).
67 *> On entry, the triangular matrix A. If UPLO = 'U', the
68 *> leading N-by-N upper triangular part of the array A contains
69 *> the upper triangular matrix, and the strictly lower
70 *> triangular part of A is not referenced. If UPLO = 'L', the
71 *> leading N-by-N lower triangular part of the array A contains
72 *> the lower triangular matrix, and the strictly upper
73 *> triangular part of A is not referenced.
74 *> \endverbatim
75 *>
76 *> \param[in] LDA
77 *> \verbatim
78 *> LDA is INTEGER
79 *> The leading dimension of the matrix A. LDA >= max(1,N).
80 *> \endverbatim
81 *>
82 *> \param[out] ARF
83 *> \verbatim
84 *> ARF is DOUBLE PRECISION array, dimension (NT).
85 *> NT=N*(N+1)/2. On exit, the triangular matrix A in RFP format.
86 *> \endverbatim
87 *>
88 *> \param[out] INFO
89 *> \verbatim
90 *> INFO is INTEGER
91 *> = 0: successful exit
92 *> < 0: if INFO = -i, the i-th argument had an illegal value
93 *> \endverbatim
94 *
95 * Authors:
96 * ========
97 *
98 *> \author Univ. of Tennessee
99 *> \author Univ. of California Berkeley
100 *> \author Univ. of Colorado Denver
101 *> \author NAG Ltd.
102 *
103 *> \ingroup doubleOTHERcomputational
104 *
105 *> \par Further Details:
106 * =====================
107 *>
108 *> \verbatim
109 *>
110 *> We first consider Rectangular Full Packed (RFP) Format when N is
111 *> even. We give an example where N = 6.
112 *>
113 *> AP is Upper AP is Lower
114 *>
115 *> 00 01 02 03 04 05 00
116 *> 11 12 13 14 15 10 11
117 *> 22 23 24 25 20 21 22
118 *> 33 34 35 30 31 32 33
119 *> 44 45 40 41 42 43 44
120 *> 55 50 51 52 53 54 55
121 *>
122 *>
123 *> Let TRANSR = 'N'. RFP holds AP as follows:
124 *> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
125 *> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
126 *> the transpose of the first three columns of AP upper.
127 *> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
128 *> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
129 *> the transpose of the last three columns of AP lower.
130 *> This covers the case N even and TRANSR = 'N'.
131 *>
132 *> RFP A RFP A
133 *>
134 *> 03 04 05 33 43 53
135 *> 13 14 15 00 44 54
136 *> 23 24 25 10 11 55
137 *> 33 34 35 20 21 22
138 *> 00 44 45 30 31 32
139 *> 01 11 55 40 41 42
140 *> 02 12 22 50 51 52
141 *>
142 *> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
143 *> transpose of RFP A above. One therefore gets:
144 *>
145 *>
146 *> RFP A RFP A
147 *>
148 *> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
149 *> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
150 *> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
151 *>
152 *>
153 *> We then consider Rectangular Full Packed (RFP) Format when N is
154 *> odd. We give an example where N = 5.
155 *>
156 *> AP is Upper AP is Lower
157 *>
158 *> 00 01 02 03 04 00
159 *> 11 12 13 14 10 11
160 *> 22 23 24 20 21 22
161 *> 33 34 30 31 32 33
162 *> 44 40 41 42 43 44
163 *>
164 *>
165 *> Let TRANSR = 'N'. RFP holds AP as follows:
166 *> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
167 *> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
168 *> the transpose of the first two columns of AP upper.
169 *> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
170 *> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
171 *> the transpose of the last two columns of AP lower.
172 *> This covers the case N odd and TRANSR = 'N'.
173 *>
174 *> RFP A RFP A
175 *>
176 *> 02 03 04 00 33 43
177 *> 12 13 14 10 11 44
178 *> 22 23 24 20 21 22
179 *> 00 33 34 30 31 32
180 *> 01 11 44 40 41 42
181 *>
182 *> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
183 *> transpose of RFP A above. One therefore gets:
184 *>
185 *> RFP A RFP A
186 *>
187 *> 02 12 22 00 01 00 10 20 30 40 50
188 *> 03 13 23 33 11 33 11 21 31 41 51
189 *> 04 14 24 34 44 43 44 22 32 42 52
190 *> \endverbatim
191 *
192 * =====================================================================
193  SUBROUTINE dtrttf( TRANSR, UPLO, N, A, LDA, ARF, INFO )
194 *
195 * -- LAPACK computational routine --
196 * -- LAPACK is a software package provided by Univ. of Tennessee, --
197 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
198 *
199 * .. Scalar Arguments ..
200  CHARACTER TRANSR, UPLO
201  INTEGER INFO, N, LDA
202 * ..
203 * .. Array Arguments ..
204  DOUBLE PRECISION A( 0: LDA-1, 0: * ), ARF( 0: * )
205 * ..
206 *
207 * =====================================================================
208 *
209 * ..
210 * .. Local Scalars ..
211  LOGICAL LOWER, NISODD, NORMALTRANSR
212  INTEGER I, IJ, J, K, L, N1, N2, NT, NX2, NP1X2
213 * ..
214 * .. External Functions ..
215  LOGICAL LSAME
216  EXTERNAL lsame
217 * ..
218 * .. External Subroutines ..
219  EXTERNAL xerbla
220 * ..
221 * .. Intrinsic Functions ..
222  INTRINSIC max, mod
223 * ..
224 * .. Executable Statements ..
225 *
226 * Test the input parameters.
227 *
228  info = 0
229  normaltransr = lsame( transr, 'N' )
230  lower = lsame( uplo, 'L' )
231  IF( .NOT.normaltransr .AND. .NOT.lsame( transr, 'T' ) ) THEN
232  info = -1
233  ELSE IF( .NOT.lower .AND. .NOT.lsame( uplo, 'U' ) ) THEN
234  info = -2
235  ELSE IF( n.LT.0 ) THEN
236  info = -3
237  ELSE IF( lda.LT.max( 1, n ) ) THEN
238  info = -5
239  END IF
240  IF( info.NE.0 ) THEN
241  CALL xerbla( 'DTRTTF', -info )
242  RETURN
243  END IF
244 *
245 * Quick return if possible
246 *
247  IF( n.LE.1 ) THEN
248  IF( n.EQ.1 ) THEN
249  arf( 0 ) = a( 0, 0 )
250  END IF
251  RETURN
252  END IF
253 *
254 * Size of array ARF(0:nt-1)
255 *
256  nt = n*( n+1 ) / 2
257 *
258 * Set N1 and N2 depending on LOWER: for N even N1=N2=K
259 *
260  IF( lower ) THEN
261  n2 = n / 2
262  n1 = n - n2
263  ELSE
264  n1 = n / 2
265  n2 = n - n1
266  END IF
267 *
268 * If N is odd, set NISODD = .TRUE., LDA=N+1 and A is (N+1)--by--K2.
269 * If N is even, set K = N/2 and NISODD = .FALSE., LDA=N and A is
270 * N--by--(N+1)/2.
271 *
272  IF( mod( n, 2 ).EQ.0 ) THEN
273  k = n / 2
274  nisodd = .false.
275  IF( .NOT.lower )
276  \$ np1x2 = n + n + 2
277  ELSE
278  nisodd = .true.
279  IF( .NOT.lower )
280  \$ nx2 = n + n
281  END IF
282 *
283  IF( nisodd ) THEN
284 *
285 * N is odd
286 *
287  IF( normaltransr ) THEN
288 *
289 * N is odd and TRANSR = 'N'
290 *
291  IF( lower ) THEN
292 *
293 * N is odd, TRANSR = 'N', and UPLO = 'L'
294 *
295  ij = 0
296  DO j = 0, n2
297  DO i = n1, n2 + j
298  arf( ij ) = a( n2+j, i )
299  ij = ij + 1
300  END DO
301  DO i = j, n - 1
302  arf( ij ) = a( i, j )
303  ij = ij + 1
304  END DO
305  END DO
306 *
307  ELSE
308 *
309 * N is odd, TRANSR = 'N', and UPLO = 'U'
310 *
311  ij = nt - n
312  DO j = n - 1, n1, -1
313  DO i = 0, j
314  arf( ij ) = a( i, j )
315  ij = ij + 1
316  END DO
317  DO l = j - n1, n1 - 1
318  arf( ij ) = a( j-n1, l )
319  ij = ij + 1
320  END DO
321  ij = ij - nx2
322  END DO
323 *
324  END IF
325 *
326  ELSE
327 *
328 * N is odd and TRANSR = 'T'
329 *
330  IF( lower ) THEN
331 *
332 * N is odd, TRANSR = 'T', and UPLO = 'L'
333 *
334  ij = 0
335  DO j = 0, n2 - 1
336  DO i = 0, j
337  arf( ij ) = a( j, i )
338  ij = ij + 1
339  END DO
340  DO i = n1 + j, n - 1
341  arf( ij ) = a( i, n1+j )
342  ij = ij + 1
343  END DO
344  END DO
345  DO j = n2, n - 1
346  DO i = 0, n1 - 1
347  arf( ij ) = a( j, i )
348  ij = ij + 1
349  END DO
350  END DO
351 *
352  ELSE
353 *
354 * N is odd, TRANSR = 'T', and UPLO = 'U'
355 *
356  ij = 0
357  DO j = 0, n1
358  DO i = n1, n - 1
359  arf( ij ) = a( j, i )
360  ij = ij + 1
361  END DO
362  END DO
363  DO j = 0, n1 - 1
364  DO i = 0, j
365  arf( ij ) = a( i, j )
366  ij = ij + 1
367  END DO
368  DO l = n2 + j, n - 1
369  arf( ij ) = a( n2+j, l )
370  ij = ij + 1
371  END DO
372  END DO
373 *
374  END IF
375 *
376  END IF
377 *
378  ELSE
379 *
380 * N is even
381 *
382  IF( normaltransr ) THEN
383 *
384 * N is even and TRANSR = 'N'
385 *
386  IF( lower ) THEN
387 *
388 * N is even, TRANSR = 'N', and UPLO = 'L'
389 *
390  ij = 0
391  DO j = 0, k - 1
392  DO i = k, k + j
393  arf( ij ) = a( k+j, i )
394  ij = ij + 1
395  END DO
396  DO i = j, n - 1
397  arf( ij ) = a( i, j )
398  ij = ij + 1
399  END DO
400  END DO
401 *
402  ELSE
403 *
404 * N is even, TRANSR = 'N', and UPLO = 'U'
405 *
406  ij = nt - n - 1
407  DO j = n - 1, k, -1
408  DO i = 0, j
409  arf( ij ) = a( i, j )
410  ij = ij + 1
411  END DO
412  DO l = j - k, k - 1
413  arf( ij ) = a( j-k, l )
414  ij = ij + 1
415  END DO
416  ij = ij - np1x2
417  END DO
418 *
419  END IF
420 *
421  ELSE
422 *
423 * N is even and TRANSR = 'T'
424 *
425  IF( lower ) THEN
426 *
427 * N is even, TRANSR = 'T', and UPLO = 'L'
428 *
429  ij = 0
430  j = k
431  DO i = k, n - 1
432  arf( ij ) = a( i, j )
433  ij = ij + 1
434  END DO
435  DO j = 0, k - 2
436  DO i = 0, j
437  arf( ij ) = a( j, i )
438  ij = ij + 1
439  END DO
440  DO i = k + 1 + j, n - 1
441  arf( ij ) = a( i, k+1+j )
442  ij = ij + 1
443  END DO
444  END DO
445  DO j = k - 1, n - 1
446  DO i = 0, k - 1
447  arf( ij ) = a( j, i )
448  ij = ij + 1
449  END DO
450  END DO
451 *
452  ELSE
453 *
454 * N is even, TRANSR = 'T', and UPLO = 'U'
455 *
456  ij = 0
457  DO j = 0, k
458  DO i = k, n - 1
459  arf( ij ) = a( j, i )
460  ij = ij + 1
461  END DO
462  END DO
463  DO j = 0, k - 2
464  DO i = 0, j
465  arf( ij ) = a( i, j )
466  ij = ij + 1
467  END DO
468  DO l = k + 1 + j, n - 1
469  arf( ij ) = a( k+1+j, l )
470  ij = ij + 1
471  END DO
472  END DO
473 * Note that here, on exit of the loop, J = K-1
474  DO i = 0, j
475  arf( ij ) = a( i, j )
476  ij = ij + 1
477  END DO
478 *
479  END IF
480 *
481  END IF
482 *
483  END IF
484 *
485  RETURN
486 *
487 * End of DTRTTF
488 *
489  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine dtrttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
DTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
Definition: dtrttf.f:194