LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
stfttr.f
Go to the documentation of this file.
1*> \brief \b STFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full format (TR).
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> Download STFTTR + dependencies
9*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stfttr.f">
10*> [TGZ]</a>
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stfttr.f">
12*> [ZIP]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stfttr.f">
14*> [TXT]</a>
15*
16* Definition:
17* ===========
18*
19* SUBROUTINE STFTTR( TRANSR, UPLO, N, ARF, A, LDA, INFO )
20*
21* .. Scalar Arguments ..
22* CHARACTER TRANSR, UPLO
23* INTEGER INFO, N, LDA
24* ..
25* .. Array Arguments ..
26* REAL A( 0: LDA-1, 0: * ), ARF( 0: * )
27* ..
28*
29*
30*> \par Purpose:
31* =============
32*>
33*> \verbatim
34*>
35*> STFTTR copies a triangular matrix A from rectangular full packed
36*> format (TF) to standard full format (TR).
37*> \endverbatim
38*
39* Arguments:
40* ==========
41*
42*> \param[in] TRANSR
43*> \verbatim
44*> TRANSR is CHARACTER*1
45*> = 'N': ARF is in Normal format;
46*> = 'T': ARF is in Transpose format.
47*> \endverbatim
48*>
49*> \param[in] UPLO
50*> \verbatim
51*> UPLO is CHARACTER*1
52*> = 'U': A is upper triangular;
53*> = 'L': A is lower triangular.
54*> \endverbatim
55*>
56*> \param[in] N
57*> \verbatim
58*> N is INTEGER
59*> The order of the matrices ARF and A. N >= 0.
60*> \endverbatim
61*>
62*> \param[in] ARF
63*> \verbatim
64*> ARF is REAL array, dimension (N*(N+1)/2).
65*> On entry, the upper (if UPLO = 'U') or lower (if UPLO = 'L')
66*> matrix A in RFP format. See the "Notes" below for more
67*> details.
68*> \endverbatim
69*>
70*> \param[out] A
71*> \verbatim
72*> A is REAL array, dimension (LDA,N)
73*> On exit, the triangular matrix A. If UPLO = 'U', the
74*> leading N-by-N upper triangular part of the array A contains
75*> the upper triangular matrix, and the strictly lower
76*> triangular part of A is not referenced. If UPLO = 'L', the
77*> leading N-by-N lower triangular part of the array A contains
78*> the lower triangular matrix, and the strictly upper
79*> triangular part of A is not referenced.
80*> \endverbatim
81*>
82*> \param[in] LDA
83*> \verbatim
84*> LDA is INTEGER
85*> The leading dimension of the array A. LDA >= max(1,N).
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 tfttr
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 stfttr( TRANSR, UPLO, N, ARF, A, LDA, 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 REAL A( 0: LDA-1, 0: * ), ARF( 0: * )
205* ..
206*
207* =====================================================================
208*
209* ..
210* .. Local Scalars ..
211 LOGICAL LOWER, NISODD, NORMALTRANSR
212 INTEGER N1, N2, K, NT, NX2, NP1X2
213 INTEGER I, J, L, IJ
214* ..
215* .. External Functions ..
216 LOGICAL LSAME
217 EXTERNAL lsame
218* ..
219* .. External Subroutines ..
220 EXTERNAL xerbla
221* ..
222* .. Intrinsic Functions ..
223 INTRINSIC max, mod
224* ..
225* .. Executable Statements ..
226*
227* Test the input parameters.
228*
229 info = 0
230 normaltransr = lsame( transr, 'N' )
231 lower = lsame( uplo, 'L' )
232 IF( .NOT.normaltransr .AND. .NOT.lsame( transr, 'T' ) ) THEN
233 info = -1
234 ELSE IF( .NOT.lower .AND. .NOT.lsame( uplo, 'U' ) ) THEN
235 info = -2
236 ELSE IF( n.LT.0 ) THEN
237 info = -3
238 ELSE IF( lda.LT.max( 1, n ) ) THEN
239 info = -6
240 END IF
241 IF( info.NE.0 ) THEN
242 CALL xerbla( 'STFTTR', -info )
243 RETURN
244 END IF
245*
246* Quick return if possible
247*
248 IF( n.LE.1 ) THEN
249 IF( n.EQ.1 ) THEN
250 a( 0, 0 ) = arf( 0 )
251 END IF
252 RETURN
253 END IF
254*
255* Size of array ARF(0:nt-1)
256*
257 nt = n*( n+1 ) / 2
258*
259* set N1 and N2 depending on LOWER: for N even N1=N2=K
260*
261 IF( lower ) THEN
262 n2 = n / 2
263 n1 = n - n2
264 ELSE
265 n1 = n / 2
266 n2 = n - n1
267 END IF
268*
269* If N is odd, set NISODD = .TRUE., LDA=N+1 and A is (N+1)--by--K2.
270* If N is even, set K = N/2 and NISODD = .FALSE., LDA=N and A is
271* N--by--(N+1)/2.
272*
273 IF( mod( n, 2 ).EQ.0 ) THEN
274 k = n / 2
275 nisodd = .false.
276 IF( .NOT.lower )
277 $ np1x2 = n + n + 2
278 ELSE
279 nisodd = .true.
280 IF( .NOT.lower )
281 $ nx2 = n + n
282 END IF
283*
284 IF( nisodd ) THEN
285*
286* N is odd
287*
288 IF( normaltransr ) THEN
289*
290* N is odd and TRANSR = 'N'
291*
292 IF( lower ) THEN
293*
294* N is odd, TRANSR = 'N', and UPLO = 'L'
295*
296 ij = 0
297 DO j = 0, n2
298 DO i = n1, n2 + j
299 a( n2+j, i ) = arf( ij )
300 ij = ij + 1
301 END DO
302 DO i = j, n - 1
303 a( i, j ) = arf( ij )
304 ij = ij + 1
305 END DO
306 END DO
307*
308 ELSE
309*
310* N is odd, TRANSR = 'N', and UPLO = 'U'
311*
312 ij = nt - n
313 DO j = n - 1, n1, -1
314 DO i = 0, j
315 a( i, j ) = arf( ij )
316 ij = ij + 1
317 END DO
318 DO l = j - n1, n1 - 1
319 a( j-n1, l ) = arf( ij )
320 ij = ij + 1
321 END DO
322 ij = ij - nx2
323 END DO
324*
325 END IF
326*
327 ELSE
328*
329* N is odd and TRANSR = 'T'
330*
331 IF( lower ) THEN
332*
333* N is odd, TRANSR = 'T', and UPLO = 'L'
334*
335 ij = 0
336 DO j = 0, n2 - 1
337 DO i = 0, j
338 a( j, i ) = arf( ij )
339 ij = ij + 1
340 END DO
341 DO i = n1 + j, n - 1
342 a( i, n1+j ) = arf( ij )
343 ij = ij + 1
344 END DO
345 END DO
346 DO j = n2, n - 1
347 DO i = 0, n1 - 1
348 a( j, i ) = arf( ij )
349 ij = ij + 1
350 END DO
351 END DO
352*
353 ELSE
354*
355* N is odd, TRANSR = 'T', and UPLO = 'U'
356*
357 ij = 0
358 DO j = 0, n1
359 DO i = n1, n - 1
360 a( j, i ) = arf( ij )
361 ij = ij + 1
362 END DO
363 END DO
364 DO j = 0, n1 - 1
365 DO i = 0, j
366 a( i, j ) = arf( ij )
367 ij = ij + 1
368 END DO
369 DO l = n2 + j, n - 1
370 a( n2+j, l ) = arf( ij )
371 ij = ij + 1
372 END DO
373 END DO
374*
375 END IF
376*
377 END IF
378*
379 ELSE
380*
381* N is even
382*
383 IF( normaltransr ) THEN
384*
385* N is even and TRANSR = 'N'
386*
387 IF( lower ) THEN
388*
389* N is even, TRANSR = 'N', and UPLO = 'L'
390*
391 ij = 0
392 DO j = 0, k - 1
393 DO i = k, k + j
394 a( k+j, i ) = arf( ij )
395 ij = ij + 1
396 END DO
397 DO i = j, n - 1
398 a( i, j ) = arf( ij )
399 ij = ij + 1
400 END DO
401 END DO
402*
403 ELSE
404*
405* N is even, TRANSR = 'N', and UPLO = 'U'
406*
407 ij = nt - n - 1
408 DO j = n - 1, k, -1
409 DO i = 0, j
410 a( i, j ) = arf( ij )
411 ij = ij + 1
412 END DO
413 DO l = j - k, k - 1
414 a( j-k, l ) = arf( ij )
415 ij = ij + 1
416 END DO
417 ij = ij - np1x2
418 END DO
419*
420 END IF
421*
422 ELSE
423*
424* N is even and TRANSR = 'T'
425*
426 IF( lower ) THEN
427*
428* N is even, TRANSR = 'T', and UPLO = 'L'
429*
430 ij = 0
431 j = k
432 DO i = k, n - 1
433 a( i, j ) = arf( ij )
434 ij = ij + 1
435 END DO
436 DO j = 0, k - 2
437 DO i = 0, j
438 a( j, i ) = arf( ij )
439 ij = ij + 1
440 END DO
441 DO i = k + 1 + j, n - 1
442 a( i, k+1+j ) = arf( ij )
443 ij = ij + 1
444 END DO
445 END DO
446 DO j = k - 1, n - 1
447 DO i = 0, k - 1
448 a( j, i ) = arf( ij )
449 ij = ij + 1
450 END DO
451 END DO
452*
453 ELSE
454*
455* N is even, TRANSR = 'T', and UPLO = 'U'
456*
457 ij = 0
458 DO j = 0, k
459 DO i = k, n - 1
460 a( j, i ) = arf( ij )
461 ij = ij + 1
462 END DO
463 END DO
464 DO j = 0, k - 2
465 DO i = 0, j
466 a( i, j ) = arf( ij )
467 ij = ij + 1
468 END DO
469 DO l = k + 1 + j, n - 1
470 a( k+1+j, l ) = arf( ij )
471 ij = ij + 1
472 END DO
473 END DO
474* Note that here, on exit of the loop, J = K-1
475 DO i = 0, j
476 a( i, j ) = arf( ij )
477 ij = ij + 1
478 END DO
479*
480 END IF
481*
482 END IF
483*
484 END IF
485*
486 RETURN
487*
488* End of STFTTR
489*
490 END
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
stfttr
subroutine stfttr(transr, uplo, n, arf, a, lda, info)
STFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
Definition stfttr.f:194