LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine stfttr ( character  TRANSR,
character  UPLO,
integer  N,
real, dimension( 0: * )  ARF,
real, dimension( 0: lda-1, 0: * )  A,
integer  LDA,
integer  INFO 
)

STFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full format (TR).

Download STFTTR + dependencies [TGZ] [ZIP] [TXT]

Purpose: 
 STFTTR copies a triangular matrix A from rectangular full packed
 format (TF) to standard full format (TR).
Parameters
[in]TRANSR
          TRANSR is CHARACTER*1
          = 'N':  ARF is in Normal format;
          = 'T':  ARF is in Transpose format.
[in]UPLO
          UPLO is CHARACTER*1
          = 'U':  A is upper triangular;
          = 'L':  A is lower triangular.
[in]N
          N is INTEGER
          The order of the matrices ARF and A. N >= 0.
[in]ARF
          ARF is REAL array, dimension (N*(N+1)/2).
          On entry, the upper (if UPLO = 'U') or lower (if UPLO = 'L')
          matrix A in RFP format. See the "Notes" below for more
          details.
[out]A
          A is REAL array, dimension (LDA,N)
          On exit, the triangular matrix A.  If UPLO = 'U', the
          leading N-by-N upper triangular part of the array A contains
          the upper triangular matrix, and the strictly lower
          triangular part of A is not referenced.  If UPLO = 'L', the
          leading N-by-N lower triangular part of the array A contains
          the lower triangular matrix, and the strictly upper
          triangular part of A is not referenced.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,N).
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012
Further Details: 
  We first consider Rectangular Full Packed (RFP) Format when N is
  even. We give an example where N = 6.

      AP is Upper             AP is Lower

   00 01 02 03 04 05       00
      11 12 13 14 15       10 11
         22 23 24 25       20 21 22
            33 34 35       30 31 32 33
               44 45       40 41 42 43 44
                  55       50 51 52 53 54 55


  Let TRANSR = 'N'. RFP holds AP as follows:
  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
  three columns of AP upper. The lower triangle A(4:6,0:2) consists of
  the transpose of the first three columns of AP upper.
  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
  three columns of AP lower. The upper triangle A(0:2,0:2) consists of
  the transpose of the last three columns of AP lower.
  This covers the case N even and TRANSR = 'N'.

         RFP A                   RFP A

        03 04 05                33 43 53
        13 14 15                00 44 54
        23 24 25                10 11 55
        33 34 35                20 21 22
        00 44 45                30 31 32
        01 11 55                40 41 42
        02 12 22                50 51 52

  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
  transpose of RFP A above. One therefore gets:


           RFP A                   RFP A

     03 13 23 33 00 01 02    33 00 10 20 30 40 50
     04 14 24 34 44 11 12    43 44 11 21 31 41 51
     05 15 25 35 45 55 22    53 54 55 22 32 42 52


  We then consider Rectangular Full Packed (RFP) Format when N is
  odd. We give an example where N = 5.

     AP is Upper                 AP is Lower

   00 01 02 03 04              00
      11 12 13 14              10 11
         22 23 24              20 21 22
            33 34              30 31 32 33
               44              40 41 42 43 44


  Let TRANSR = 'N'. RFP holds AP as follows:
  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
  three columns of AP upper. The lower triangle A(3:4,0:1) consists of
  the transpose of the first two columns of AP upper.
  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
  three columns of AP lower. The upper triangle A(0:1,1:2) consists of
  the transpose of the last two columns of AP lower.
  This covers the case N odd and TRANSR = 'N'.

         RFP A                   RFP A

        02 03 04                00 33 43
        12 13 14                10 11 44
        22 23 24                20 21 22
        00 33 34                30 31 32
        01 11 44                40 41 42

  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
  transpose of RFP A above. One therefore gets:

           RFP A                   RFP A

     02 12 22 00 01             00 10 20 30 40 50
     03 13 23 33 11             33 11 21 31 41 51
     04 14 24 34 44             43 44 22 32 42 52

Definition at line 198 of file stfttr.f.

198 *
199 * -- LAPACK computational routine (version 3.4.2) --
200 * -- LAPACK is a software package provided by Univ. of Tennessee, --
201 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
202 * September 2012
203 *
204 * .. Scalar Arguments ..
205  CHARACTER transr, uplo
206  INTEGER info, n, lda
207 * ..
208 * .. Array Arguments ..
209  REAL a( 0: lda-1, 0: * ), arf( 0: * )
210 * ..
211 *
212 * =====================================================================
213 *
214 * ..
215 * .. Local Scalars ..
216  LOGICAL lower, nisodd, normaltransr
217  INTEGER n1, n2, k, nt, nx2, np1x2
218  INTEGER i, j, l, ij
219 * ..
220 * .. External Functions ..
221  LOGICAL lsame
222  EXTERNAL lsame
223 * ..
224 * .. External Subroutines ..
225  EXTERNAL xerbla
226 * ..
227 * .. Intrinsic Functions ..
228  INTRINSIC max, mod
229 * ..
230 * .. Executable Statements ..
231 *
232 * Test the input parameters.
233 *
234  info = 0
235  normaltransr = lsame( transr, 'N' )
236  lower = lsame( uplo, 'L' )
237  IF( .NOT.normaltransr .AND. .NOT.lsame( transr, 'T' ) ) THEN
238  info = -1
239  ELSE IF( .NOT.lower .AND. .NOT.lsame( uplo, 'U' ) ) THEN
240  info = -2
241  ELSE IF( n.LT.0 ) THEN
242  info = -3
243  ELSE IF( lda.LT.max( 1, n ) ) THEN
244  info = -6
245  END IF
246  IF( info.NE.0 ) THEN
247  CALL xerbla( 'STFTTR', -info )
248  RETURN
249  END IF
250 *
251 * Quick return if possible
252 *
253  IF( n.LE.1 ) THEN
254  IF( n.EQ.1 ) THEN
255  a( 0, 0 ) = arf( 0 )
256  END IF
257  RETURN
258  END IF
259 *
260 * Size of array ARF(0:nt-1)
261 *
262  nt = n*( n+1 ) / 2
263 *
264 * set N1 and N2 depending on LOWER: for N even N1=N2=K
265 *
266  IF( lower ) THEN
267  n2 = n / 2
268  n1 = n - n2
269  ELSE
270  n1 = n / 2
271  n2 = n - n1
272  END IF
273 *
274 * If N is odd, set NISODD = .TRUE., LDA=N+1 and A is (N+1)--by--K2.
275 * If N is even, set K = N/2 and NISODD = .FALSE., LDA=N and A is
276 * N--by--(N+1)/2.
277 *
278  IF( mod( n, 2 ).EQ.0 ) THEN
279  k = n / 2
280  nisodd = .false.
281  IF( .NOT.lower )
282  $ np1x2 = n + n + 2
283  ELSE
284  nisodd = .true.
285  IF( .NOT.lower )
286  $ nx2 = n + n
287  END IF
288 *
289  IF( nisodd ) THEN
290 *
291 * N is odd
292 *
293  IF( normaltransr ) THEN
294 *
295 * N is odd and TRANSR = 'N'
296 *
297  IF( lower ) THEN
298 *
299 * N is odd, TRANSR = 'N', and UPLO = 'L'
300 *
301  ij = 0
302  DO j = 0, n2
303  DO i = n1, n2 + j
304  a( n2+j, i ) = arf( ij )
305  ij = ij + 1
306  END DO
307  DO i = j, n - 1
308  a( i, j ) = arf( ij )
309  ij = ij + 1
310  END DO
311  END DO
312 *
313  ELSE
314 *
315 * N is odd, TRANSR = 'N', and UPLO = 'U'
316 *
317  ij = nt - n
318  DO j = n - 1, n1, -1
319  DO i = 0, j
320  a( i, j ) = arf( ij )
321  ij = ij + 1
322  END DO
323  DO l = j - n1, n1 - 1
324  a( j-n1, l ) = arf( ij )
325  ij = ij + 1
326  END DO
327  ij = ij - nx2
328  END DO
329 *
330  END IF
331 *
332  ELSE
333 *
334 * N is odd and TRANSR = 'T'
335 *
336  IF( lower ) THEN
337 *
338 * N is odd, TRANSR = 'T', and UPLO = 'L'
339 *
340  ij = 0
341  DO j = 0, n2 - 1
342  DO i = 0, j
343  a( j, i ) = arf( ij )
344  ij = ij + 1
345  END DO
346  DO i = n1 + j, n - 1
347  a( i, n1+j ) = arf( ij )
348  ij = ij + 1
349  END DO
350  END DO
351  DO j = n2, n - 1
352  DO i = 0, n1 - 1
353  a( j, i ) = arf( ij )
354  ij = ij + 1
355  END DO
356  END DO
357 *
358  ELSE
359 *
360 * N is odd, TRANSR = 'T', and UPLO = 'U'
361 *
362  ij = 0
363  DO j = 0, n1
364  DO i = n1, n - 1
365  a( j, i ) = arf( ij )
366  ij = ij + 1
367  END DO
368  END DO
369  DO j = 0, n1 - 1
370  DO i = 0, j
371  a( i, j ) = arf( ij )
372  ij = ij + 1
373  END DO
374  DO l = n2 + j, n - 1
375  a( n2+j, l ) = arf( ij )
376  ij = ij + 1
377  END DO
378  END DO
379 *
380  END IF
381 *
382  END IF
383 *
384  ELSE
385 *
386 * N is even
387 *
388  IF( normaltransr ) THEN
389 *
390 * N is even and TRANSR = 'N'
391 *
392  IF( lower ) THEN
393 *
394 * N is even, TRANSR = 'N', and UPLO = 'L'
395 *
396  ij = 0
397  DO j = 0, k - 1
398  DO i = k, k + j
399  a( k+j, i ) = arf( ij )
400  ij = ij + 1
401  END DO
402  DO i = j, n - 1
403  a( i, j ) = arf( ij )
404  ij = ij + 1
405  END DO
406  END DO
407 *
408  ELSE
409 *
410 * N is even, TRANSR = 'N', and UPLO = 'U'
411 *
412  ij = nt - n - 1
413  DO j = n - 1, k, -1
414  DO i = 0, j
415  a( i, j ) = arf( ij )
416  ij = ij + 1
417  END DO
418  DO l = j - k, k - 1
419  a( j-k, l ) = arf( ij )
420  ij = ij + 1
421  END DO
422  ij = ij - np1x2
423  END DO
424 *
425  END IF
426 *
427  ELSE
428 *
429 * N is even and TRANSR = 'T'
430 *
431  IF( lower ) THEN
432 *
433 * N is even, TRANSR = 'T', and UPLO = 'L'
434 *
435  ij = 0
436  j = k
437  DO i = k, n - 1
438  a( i, j ) = arf( ij )
439  ij = ij + 1
440  END DO
441  DO j = 0, k - 2
442  DO i = 0, j
443  a( j, i ) = arf( ij )
444  ij = ij + 1
445  END DO
446  DO i = k + 1 + j, n - 1
447  a( i, k+1+j ) = arf( ij )
448  ij = ij + 1
449  END DO
450  END DO
451  DO j = k - 1, n - 1
452  DO i = 0, k - 1
453  a( j, i ) = arf( ij )
454  ij = ij + 1
455  END DO
456  END DO
457 *
458  ELSE
459 *
460 * N is even, TRANSR = 'T', and UPLO = 'U'
461 *
462  ij = 0
463  DO j = 0, k
464  DO i = k, n - 1
465  a( j, i ) = arf( ij )
466  ij = ij + 1
467  END DO
468  END DO
469  DO j = 0, k - 2
470  DO i = 0, j
471  a( i, j ) = arf( ij )
472  ij = ij + 1
473  END DO
474  DO l = k + 1 + j, n - 1
475  a( k+1+j, l ) = arf( ij )
476  ij = ij + 1
477  END DO
478  END DO
479 * Note that here, on exit of the loop, J = K-1
480  DO i = 0, j
481  a( i, j ) = arf( ij )
482  ij = ij + 1
483  END DO
484 *
485  END IF
486 *
487  END IF
488 *
489  END IF
490 *
491  RETURN
492 *
493 * End of STFTTR
494 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: