ScaLAPACK 2.1  2.1 ScaLAPACK: Scalable Linear Algebra PACKage
pdlaswp.f
Go to the documentation of this file.
1  SUBROUTINE pdlaswp( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2,
2  \$ IPIV )
3 *
4 * -- ScaLAPACK auxiliary routine (version 1.7) --
5 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
6 * and University of California, Berkeley.
7 * May 1, 1997
8 *
9 * .. Scalar Arguments ..
10  CHARACTER DIREC, ROWCOL
11  INTEGER IA, JA, K1, K2, N
12 * ..
13 * .. Array Arguments ..
14  INTEGER DESCA( * ), IPIV( * )
15  DOUBLE PRECISION A( * )
16 * ..
17 *
18 * Purpose:
19 * ========
20 *
21 * PDLASWP performs a series of row or column interchanges on
22 * the distributed matrix sub( A ) = A(IA:IA+M-1,JA:JA+N-1). One
23 * interchange is initiated for each of rows or columns K1 trough K2 of
24 * sub( A ). This routine assumes that the pivoting information has
26 * Also note that this routine will only work for K1-K2 being in the
27 * same MB (or NB) block. If you want to pivot a full matrix, use
28 * PDLAPIV.
29 *
30 * Notes
31 * =====
32 *
33 * Each global data object is described by an associated description
34 * vector. This vector stores the information required to establish
35 * the mapping between an object element and its corresponding process
36 * and memory location.
37 *
38 * Let A be a generic term for any 2D block cyclicly distributed array.
39 * Such a global array has an associated description vector DESCA.
40 * In the following comments, the character _ should be read as
41 * "of the global array".
42 *
43 * NOTATION STORED IN EXPLANATION
44 * --------------- -------------- --------------------------------------
45 * DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case,
46 * DTYPE_A = 1.
47 * CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
48 * the BLACS process grid A is distribu-
49 * ted over. The context itself is glo-
50 * bal, but the handle (the integer
51 * value) may vary.
52 * M_A (global) DESCA( M_ ) The number of rows in the global
53 * array A.
54 * N_A (global) DESCA( N_ ) The number of columns in the global
55 * array A.
56 * MB_A (global) DESCA( MB_ ) The blocking factor used to distribute
57 * the rows of the array.
58 * NB_A (global) DESCA( NB_ ) The blocking factor used to distribute
59 * the columns of the array.
60 * RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
61 * row of the array A is distributed.
62 * CSRC_A (global) DESCA( CSRC_ ) The process column over which the
63 * first column of the array A is
64 * distributed.
65 * LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
66 * array. LLD_A >= MAX(1,LOCr(M_A)).
67 *
68 * Let K be the number of rows or columns of a distributed matrix,
69 * and assume that its process grid has dimension p x q.
70 * LOCr( K ) denotes the number of elements of K that a process
71 * would receive if K were distributed over the p processes of its
72 * process column.
73 * Similarly, LOCc( K ) denotes the number of elements of K that a
74 * process would receive if K were distributed over the q processes of
75 * its process row.
76 * The values of LOCr() and LOCc() may be determined via a call to the
77 * ScaLAPACK tool function, NUMROC:
78 * LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
79 * LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
80 * An upper bound for these quantities may be computed by:
81 * LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
82 * LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
83 *
84 * Arguments
85 * =========
86 *
87 * DIREC (global input) CHARACTER
88 * Specifies in which order the permutation is applied:
89 * = 'F' (Forward)
90 * = 'B' (Backward)
91 *
92 * ROWCOL (global input) CHARACTER
93 * Specifies if the rows or columns are permuted:
94 * = 'R' (Rows)
95 * = 'C' (Columns)
96 *
97 * N (global input) INTEGER
98 * If ROWCOL = 'R', the length of the rows of the distributed
99 * matrix A(*,JA:JA+N-1) to be permuted;
100 * If ROWCOL = 'C', the length of the columns of the distributed
101 * matrix A(IA:IA+N-1,*) to be permuted.
102 *
103 * A (local input/local output) DOUBLE PRECISION pointer into the
104 * local memory to an array of dimension (LLD_A, * ).
105 * On entry, this array contains the local pieces of the distri-
106 * buted matrix to which the row/columns interchanges will be
107 * applied. On exit the permuted distributed matrix.
108 *
109 * IA (global input) INTEGER
110 * The row index in the global array A indicating the first
111 * row of sub( A ).
112 *
113 * JA (global input) INTEGER
114 * The column index in the global array A indicating the
115 * first column of sub( A ).
116 *
117 * DESCA (global and local input) INTEGER array of dimension DLEN_.
118 * The array descriptor for the distributed matrix A.
119 *
120 * K1 (global input) INTEGER
121 * The first element of IPIV for which a row or column inter-
122 * change will be done.
123 *
124 * K2 (global input) INTEGER
125 * The last element of IPIV for which a row or column inter-
126 * change will be done.
127 *
128 * IPIV (local input) INTEGER array, dimension LOCr(M_A)+MB_A for
129 * row pivoting and LOCc(N_A)+NB_A for column pivoting. This
130 * array is tied to the matrix A, IPIV(K) = L implies rows
131 * (or columns) K and L are to be interchanged.
132 *
133 * =====================================================================
134 *
135 * .. Parameters ..
136  INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
137  \$ lld_, mb_, m_, nb_, n_, rsrc_
138  parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
139  \$ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
140  \$ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
141 * ..
142 * .. Local Scalars ..
143  INTEGER I, ICURCOL, ICURROW, IIA, IP, J, JJA, JP,
144  \$ mycol, myrow, npcol, nprow
145 * ..
146 * .. External Subroutines ..
147  EXTERNAL blacs_gridinfo, infog2l, pdswap
148 * ..
149 * .. External Functions ..
150  LOGICAL LSAME
151  EXTERNAL lsame
152 * ..
153 * .. Executable Statements ..
154 *
155 * Quick return if possible
156 *
157  IF( n.EQ.0 )
158  \$ RETURN
159 *
160  CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
161 *
162  IF( lsame( rowcol, 'R' ) ) THEN
163  IF( lsame( direc, 'F' ) ) THEN
164  CALL infog2l( k1, ja, desca, nprow, npcol, myrow, mycol,
165  \$ iia, jja, icurrow, icurcol )
166  DO 10 i = k1, k2
167  ip = ipiv( iia+i-k1 )
168  IF( ip.NE.i )
169  \$ CALL pdswap( n, a, i, ja, desca, desca( m_ ), a, ip,
170  \$ ja, desca, desca( m_ ) )
171  10 CONTINUE
172  ELSE
173  CALL infog2l( k2, ja, desca, nprow, npcol, myrow, mycol,
174  \$ iia, jja, icurrow, icurcol )
175  DO 20 i = k2, k1, -1
176  ip = ipiv( iia+i-k1 )
177  IF( ip.NE.i )
178  \$ CALL pdswap( n, a, i, ja, desca, desca( m_ ), a, ip,
179  \$ ja, desca, desca( m_ ) )
180  20 CONTINUE
181  END IF
182  ELSE
183  IF( lsame( direc, 'F' ) ) THEN
184  CALL infog2l( ia, k1, desca, nprow, npcol, myrow, mycol,
185  \$ iia, jja, icurrow, icurcol )
186  DO 30 j = k1, k2
187  jp = ipiv( jja+j-k1 )
188  IF( jp.NE.j )
189  \$ CALL pdswap( n, a, ia, j, desca, 1, a, ia, jp,
190  \$ desca, 1 )
191  30 CONTINUE
192  ELSE
193  CALL infog2l( ia, k2, desca, nprow, npcol, myrow, mycol,
194  \$ iia, jja, icurrow, icurcol )
195  DO 40 j = k2, k1, -1
196  jp = ipiv( jja+j-k1 )
197  IF( jp.NE.j )
198  \$ CALL pdswap( n, a, ia, j, desca, 1, a, ia, jp,
199  \$ desca, 1 )
200  40 CONTINUE
201  END IF
202  END IF
203 *
204  RETURN
205 *
206 * End PDLASWP
207 *
208  END
infog2l
subroutine infog2l(GRINDX, GCINDX, DESC, NPROW, NPCOL, MYROW, MYCOL, LRINDX, LCINDX, RSRC, CSRC)
Definition: infog2l.f:3
pdlaswp
subroutine pdlaswp(DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, IPIV)
Definition: pdlaswp.f:3