← Back to branch summary

~ubuntu-branches/ubuntu/karmic/scilab/karmic

« back to all changes in this revision

Viewing changes to routines/lapack/dlapmt.f

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
Import upstream version 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
routines/lapack/dlapmt.f
 
1
      SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
 
2
*
 
3
*  -- LAPACK auxiliary routine (version 2.0) --
 
4
*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 
5
*     Courant Institute, Argonne National Lab, and Rice University
 
6
*     March 31, 1993
 
7
*
 
8
*     .. Scalar Arguments ..
 
9
      LOGICAL            FORWRD
 
10
      INTEGER            LDX, M, N
 
11
*     ..
 
12
*     .. Array Arguments ..
 
13
      INTEGER            K( * )
 
14
      DOUBLE PRECISION   X( LDX, * )
 
15
*     ..
 
16
*
 
17
*  Purpose
 
18
*  =======
 
19
*
 
20
*  DLAPMT rearranges the columns of the M by N matrix X as specified
 
21
*  by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
 
22
*  If FORWRD = .TRUE.,  forward permutation:
 
23
*
 
24
*       X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
 
25
*
 
26
*  If FORWRD = .FALSE., backward permutation:
 
27
*
 
28
*       X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
 
29
*
 
30
*  Arguments
 
31
*  =========
 
32
*
 
33
*  FORWRD  (input) LOGICAL
 
34
*          = .TRUE., forward permutation
 
35
*          = .FALSE., backward permutation
 
36
*
 
37
*  M       (input) INTEGER
 
38
*          The number of rows of the matrix X. M >= 0.
 
39
*
 
40
*  N       (input) INTEGER
 
41
*          The number of columns of the matrix X. N >= 0.
 
42
*
 
43
*  X       (input/output) DOUBLE PRECISION array, dimension (LDX,N)
 
44
*          On entry, the M by N matrix X.
 
45
*          On exit, X contains the permuted matrix X.
 
46
*
 
47
*  LDX     (input) INTEGER
 
48
*          The leading dimension of the array X, LDX >= MAX(1,M).
 
49
*
 
50
*  K       (input) INTEGER array, dimension (N)
 
51
*          On entry, K contains the permutation vector.
 
52
*
 
53
*  =====================================================================
 
54
*
 
55
*     .. Local Scalars ..
 
56
      INTEGER            I, II, IN, J
 
57
      DOUBLE PRECISION   TEMP
 
58
*     ..
 
59
*     .. Executable Statements ..
 
60
*
 
61
      IF( N.LE.1 )
 
62
     $   RETURN
 
63
*
 
64
      DO 10 I = 1, N
 
65
         K( I ) = -K( I )
 
66
   10 CONTINUE
 
67
*
 
68
      IF( FORWRD ) THEN
 
69
*
 
70
*        Forward permutation
 
71
*
 
72
         DO 50 I = 1, N
 
73
*
 
74
            IF( K( I ).GT.0 )
 
75
     $         GO TO 40
 
76
*
 
77
            J = I
 
78
            K( J ) = -K( J )
 
79
            IN = K( J )
 
80
*
 
81
   20       CONTINUE
 
82
            IF( K( IN ).GT.0 )
 
83
     $         GO TO 40
 
84
*
 
85
            DO 30 II = 1, M
 
86
               TEMP = X( II, J )
 
87
               X( II, J ) = X( II, IN )
 
88
               X( II, IN ) = TEMP
 
89
   30       CONTINUE
 
90
*
 
91
            K( IN ) = -K( IN )
 
92
            J = IN
 
93
            IN = K( IN )
 
94
            GO TO 20
 
95
*
 
96
   40       CONTINUE
 
97
*
 
98
   50    CONTINUE
 
99
*
 
100
      ELSE
 
101
*
 
102
*        Backward permutation
 
103
*
 
104
         DO 90 I = 1, N
 
105
*
 
106
            IF( K( I ).GT.0 )
 
107
     $         GO TO 80
 
108
*
 
109
            K( I ) = -K( I )
 
110
            J = K( I )
 
111
   60       CONTINUE
 
112
            IF( J.EQ.I )
 
113
     $         GO TO 80
 
114
*
 
115
            DO 70 II = 1, M
 
116
               TEMP = X( II, I )
 
117
               X( II, I ) = X( II, J )
 
118
               X( II, J ) = TEMP
 
119
   70       CONTINUE
 
120
*
 
121
            K( J ) = -K( J )
 
122
            J = K( J )
 
123
            GO TO 60
 
124
*
 
125
   80       CONTINUE
 
126
*
 
127
   90    CONTINUE
 
128
*
 
129
      END IF
 
130
*
 
131
      RETURN
 
132
*
 
133
*     End of DLAPMT
 
134
*
 
135
      END