LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ stpttf()

subroutine stpttf ( character  transr,
character  uplo,
integer  n,
real, dimension( 0: * )  ap,
real, dimension( 0: * )  arf,
integer  info 
)

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

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

Purpose:
 STPTTF 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 REAL 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 REAL 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 stpttf.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 REAL 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( 'STPTTF', -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 STPTTF
498*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: