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

◆ 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*
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: