LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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 trttf
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
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
dtrttf
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