1 files changed, 136 insertions, 0 deletions
diff --git a/SRC/dlapmt.f b/SRC/dlapmt.f
new file mode 100644
index 00000000..325774c0
--- /dev/null
+++ b/SRC/dlapmt.f
@@ -0,0 +1,136 @@
+      SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
+*
+*  -- LAPACK auxiliary routine (version 3.1) --
+*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+*     November 2006
+*
+*     .. Scalar Arguments ..
+      LOGICAL            FORWRD
+      INTEGER            LDX, M, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            K( * )
+      DOUBLE PRECISION   X( LDX, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DLAPMT rearranges the columns of the M by N matrix X as specified
+*  by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
+*  If FORWRD = .TRUE.,  forward permutation:
+*
+*       X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
+*
+*  If FORWRD = .FALSE., backward permutation:
+*
+*       X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
+*
+*  Arguments
+*  =========
+*
+*  FORWRD  (input) LOGICAL
+*          = .TRUE., forward permutation
+*          = .FALSE., backward permutation
+*
+*  M       (input) INTEGER
+*          The number of rows of the matrix X. M >= 0.
+*
+*  N       (input) INTEGER
+*          The number of columns of the matrix X. N >= 0.
+*
+*  X       (input/output) DOUBLE PRECISION array, dimension (LDX,N)
+*          On entry, the M by N matrix X.
+*          On exit, X contains the permuted matrix X.
+*
+*  LDX     (input) INTEGER
+*          The leading dimension of the array X, LDX >= MAX(1,M).
+*
+*  K       (input/output) INTEGER array, dimension (N)
+*          On entry, K contains the permutation vector. K is used as
+*          internal workspace, but reset to its original value on
+*          output.
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER            I, II, IN, J
+      DOUBLE PRECISION   TEMP
+*     ..
+*     .. Executable Statements ..
+*
+      IF( N.LE.1 )
+     $   RETURN
+*
+      DO 10 I = 1, N
+         K( I ) = -K( I )
+   10 CONTINUE
+*
+      IF( FORWRD ) THEN
+*
+*        Forward permutation
+*
+         DO 50 I = 1, N
+*
+            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 II = 1, M
+               TEMP = X( II, J )
+               X( II, J ) = X( II, IN )
+               X( II, IN ) = 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, N
+*
+            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 II = 1, M
+               TEMP = X( II, I )
+               X( II, I ) = X( II, J )
+               X( II, J ) = TEMP
+   70       CONTINUE
+*
+            K( J ) = -K( J )
+            J = K( J )
+            GO TO 60
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+      END IF
+*
+      RETURN
+*
+*     End of DLAPMT
+*
+      END