LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ dtpttf()

subroutine dtpttf ( character  TRANSR,
character  UPLO,
integer  N,
double precision, dimension( 0: * )  AP,
double precision, dimension( 0: * )  ARF,
integer  INFO 
)

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

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

Purpose:
 DTPTTF copies a triangular matrix A from standard packed format (TP)
 to rectangular full packed format (TF).
Parameters
[in]TRANSR
          TRANSR is CHARACTER*1
          = 'N':  ARF in Normal format is wanted;
          = 'T':  ARF in Conjugate-transpose format is wanted.
[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 matrix A.  N >= 0.
[in]AP
          AP is DOUBLE PRECISION array, dimension ( N*(N+1)/2 ),
          On entry, the upper or lower triangular matrix A, packed
          columnwise in a linear array. The j-th column of A is stored
          in the array AP as follows:
          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
[out]ARF
          ARF is DOUBLE PRECISION array, dimension ( N*(N+1)/2 ),
          On exit, the upper or lower triangular matrix A stored in
          RFP format. For a further discussion see Notes below.
[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 185 of file dtpttf.f.

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