LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ strttf()

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.
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 193 of file strttf.f.

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 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( 'STRTTF', -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 STRTTF
488 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
Here is the call graph for this function:
Here is the caller graph for this function: