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

◆ stfttr()

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.
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 195 of file stfttr.f.

196*
197* -- LAPACK computational routine --
198* -- LAPACK is a software package provided by Univ. of Tennessee, --
199* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
200*
201* .. Scalar Arguments ..
202 CHARACTER TRANSR, UPLO
203 INTEGER INFO, N, LDA
204* ..
205* .. Array Arguments ..
206 REAL A( 0: LDA-1, 0: * ), ARF( 0: * )
207* ..
208*
209* =====================================================================
210*
211* ..
212* .. Local Scalars ..
213 LOGICAL LOWER, NISODD, NORMALTRANSR
214 INTEGER N1, N2, K, NT, NX2, NP1X2
215 INTEGER I, J, L, IJ
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 = -6
242 END IF
243 IF( info.NE.0 ) THEN
244 CALL xerbla( 'STFTTR', -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 a( 0, 0 ) = arf( 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 a( n2+j, i ) = arf( ij )
302 ij = ij + 1
303 END DO
304 DO i = j, n - 1
305 a( i, j ) = arf( ij )
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 a( i, j ) = arf( ij )
318 ij = ij + 1
319 END DO
320 DO l = j - n1, n1 - 1
321 a( j-n1, l ) = arf( ij )
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 a( j, i ) = arf( ij )
341 ij = ij + 1
342 END DO
343 DO i = n1 + j, n - 1
344 a( i, n1+j ) = arf( ij )
345 ij = ij + 1
346 END DO
347 END DO
348 DO j = n2, n - 1
349 DO i = 0, n1 - 1
350 a( j, i ) = arf( ij )
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 a( j, i ) = arf( ij )
363 ij = ij + 1
364 END DO
365 END DO
366 DO j = 0, n1 - 1
367 DO i = 0, j
368 a( i, j ) = arf( ij )
369 ij = ij + 1
370 END DO
371 DO l = n2 + j, n - 1
372 a( n2+j, l ) = arf( ij )
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 a( k+j, i ) = arf( ij )
397 ij = ij + 1
398 END DO
399 DO i = j, n - 1
400 a( i, j ) = arf( ij )
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 a( i, j ) = arf( ij )
413 ij = ij + 1
414 END DO
415 DO l = j - k, k - 1
416 a( j-k, l ) = arf( ij )
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 a( i, j ) = arf( ij )
436 ij = ij + 1
437 END DO
438 DO j = 0, k - 2
439 DO i = 0, j
440 a( j, i ) = arf( ij )
441 ij = ij + 1
442 END DO
443 DO i = k + 1 + j, n - 1
444 a( i, k+1+j ) = arf( ij )
445 ij = ij + 1
446 END DO
447 END DO
448 DO j = k - 1, n - 1
449 DO i = 0, k - 1
450 a( j, i ) = arf( ij )
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 a( j, i ) = arf( ij )
463 ij = ij + 1
464 END DO
465 END DO
466 DO j = 0, k - 2
467 DO i = 0, j
468 a( i, j ) = arf( ij )
469 ij = ij + 1
470 END DO
471 DO l = k + 1 + j, n - 1
472 a( k+1+j, l ) = arf( ij )
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 a( i, j ) = arf( ij )
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 STFTTR
491*
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: