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