1 SUBROUTINE PZLASWP( 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 COMPLEX*16 A( * ) 16* .. 17* 18* Purpose: 19* ======== 20* 21* PZLASWP 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 25* already been broadcast along the process row or column. 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* PZLAPIV. 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) COMPLEX*16 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, PZSWAP 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 PZSWAP( 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 PZSWAP( 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 PZSWAP( 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 PZSWAP( 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 PZLASWP 207* 208 END 209