slapmr()

subroutine slapmr	(	logical	forwrd,
		integer	m,
		integer	n,
		real, dimension( ldx, * )	x,
		integer	ldx,
		integer, dimension( * )	k )

SLAPMR rearranges rows of a matrix as specified by a permutation vector.

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

Purpose:

!>
!> SLAPMR rearranges the rows of the M by N matrix X as specified
!> by the permutation K(1),K(2),...,K(M) of the integers 1,...,M.
!> If FORWRD = .TRUE.,  forward permutation:
!>
!>      X(K(I),*) is moved X(I,*) for I = 1,2,...,M.
!>
!> If FORWRD = .FALSE., backward permutation:
!>
!>      X(I,*) is moved to X(K(I),*) for I = 1,2,...,M.
!> 

Parameters

[in]	FORWRD	!> FORWRD is LOGICAL !> = .TRUE., forward permutation !> = .FALSE., backward permutation !>
[in]	M	!> M is INTEGER !> The number of rows of the matrix X. M >= 0. !>
[in]	N	!> N is INTEGER !> The number of columns of the matrix X. N >= 0. !>
[in,out]	X	!> X is REAL array, dimension (LDX,N) !> On entry, the M by N matrix X. !> On exit, X contains the permuted matrix X. !>
[in]	LDX	!> LDX is INTEGER !> The leading dimension of the array X, LDX >= MAX(1,M). !>
[in,out]	K	!> K is INTEGER array, dimension (M) !> On entry, K contains the permutation vector. K is used as !> internal workspace, but reset to its original value on !> output. !>

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 101 of file slapmr.f.

*
*  -- LAPACK auxiliary routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      LOGICAL            FORWRD
      INTEGER            LDX, M, N
*     ..
*     .. Array Arguments ..
      INTEGER            K( * )
      REAL               X( LDX, * )
*     ..
*
*  =====================================================================
*
*     .. Local Scalars ..
      INTEGER            I, IN, J, JJ
      REAL               TEMP
*     ..
*     .. Executable Statements ..
*
      IF( m.LE.1 )
     $   RETURN
*
      DO 10 i = 1, m
         k( i ) = -k( i )
   10 CONTINUE
*
      IF( forwrd ) THEN
*
*        Forward permutation
*
         DO 50 i = 1, m
*
            IF( k( i ).GT.0 )
     $         GO TO 40
*
            j = i
            k( j ) = -k( j )
            in = k( j )
*
   20       CONTINUE
            IF( k( in ).GT.0 )
     $         GO TO 40
*
            DO 30 jj = 1, n
               temp = x( j, jj )
               x( j, jj ) = x( in, jj )
               x( in, jj ) = temp
   30       CONTINUE
*
            k( in ) = -k( in )
            j = in
            in = k( in )
            GO TO 20
*
   40       CONTINUE
*
   50    CONTINUE
*
      ELSE
*
*        Backward permutation
*
         DO 90 i = 1, m
*
            IF( k( i ).GT.0 )
     $         GO TO 80
*
            k( i ) = -k( i )
            j = k( i )
   60       CONTINUE
            IF( j.EQ.i )
     $         GO TO 80
*
            DO 70 jj = 1, n
               temp = x( i, jj )
               x( i, jj ) = x( j, jj )
               x( j, jj ) = temp
   70       CONTINUE
*
            k( j ) = -k( j )
            j = k( j )
            GO TO 60
*
   80       CONTINUE
*
   90    CONTINUE
*
      END IF
*
      RETURN
*
*     End of SLAPMR
*

Here is the caller graph for this function: