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

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

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

Purpose: 
 STRTTF copies a triangular matrix A from standard full format (TR)
 to rectangular full packed format (TF) .
Parameters
[in]TRANSR
          TRANSR is CHARACTER*1
          = 'N':  ARF in Normal form is wanted;
          = 'T':  ARF in Transpose form is wanted.
[in]UPLO
          UPLO is CHARACTER*1
          = 'U':  Upper triangle of A is stored;
          = 'L':  Lower triangle of A is stored.
[in]N
          N is INTEGER
          The order of the matrix A. N >= 0.
[in]A
          A is REAL array, dimension (LDA,N).
          On entry, 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 matrix A. LDA >= max(1,N).
[out]ARF
          ARF is REAL array, dimension (NT).
          NT=N*(N+1)/2. On exit, the triangular matrix A in RFP format.
[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 196 of file strttf.f.

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