Routine: PSLAPV2()  File: SRC\pslapv2.f

 
 
# lines: 413
  # code: 413
  # comment: 0
  # blank:0
# Variables:45
# Callers:1
# Callings:0
# Words:163
# Keywords:95
 

 

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PSLAPV2 applies either P (permutation matrix indicated by IPIV)
  or inv( P ) to a M-by-N distributed matrix sub( A ) denoting
  A(IA:IA+M-1,JA:JA+N-1), resulting in row or column pivoting.  The
  pivot vector should be aligned with the distributed matrix A.  For
  pivoting the rows of sub( A ), IPIV should be distributed along a
  process column and replicated over all process rows.  Similarly,
  IPIV should be distributed along a process row and replicated over
  all process columns for column pivoting.
  Notes
  =====
  Each global data object is described by an associated description
  vector.  This vector stores the information required to establish
  the mapping between an object element and its corresponding process
  and memory location.
  Let A be a generic term for any 2D block cyclicly distributed array.
  Such a global array has an associated description vector DESCA.
  In the following comments, the character _ should be read as
  "of the global array".
  NOTATION        STORED IN      EXPLANATION
  --------------- -------------- --------------------------------------
  DTYPE_A(global) DESCA( DTYPE_ )The descriptor type.  In this case,
                                 DTYPE_A = 1.
  CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
                                 the BLACS process grid A is distribu-
                                 ted over. The context itself is glo-
                                 bal, but the handle (the integer
                                 value) may vary.
  M_A    (global) DESCA( M_ )    The number of rows in the global
                                 array A.
  N_A    (global) DESCA( N_ )    The number of columns in the global
                                 array A.
  MB_A   (global) DESCA( MB_ )   The blocking factor used to distribute
                                 the rows of the array.
  NB_A   (global) DESCA( NB_ )   The blocking factor used to distribute
                                 the columns of the array.
  RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
                                 row of the array A is distributed.
  CSRC_A (global) DESCA( CSRC_ ) The process column over which the
                                 first column of the array A is
                                 distributed.
  LLD_A  (local)  DESCA( LLD_ )  The leading dimension of the local
                                 array.  LLD_A >= MAX(1,LOCr(M_A)).
  Let K be the number of rows or columns of a distributed matrix,
  and assume that its process grid has dimension p x q.
  LOCr( K ) denotes the number of elements of K that a process
  would receive if K were distributed over the p processes of its
  process column.
  Similarly, LOCc( K ) denotes the number of elements of K that a
  process would receive if K were distributed over the q processes of
  its process row.
  The values of LOCr() and LOCc() may be determined via a call to the
  ScaLAPACK tool function, NUMROC:
          LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
          LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
  An upper bound for these quantities may be computed by:
          LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
          LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
  Arguments
  =========
  DIREC   (global input) CHARACTER
          Specifies in which order the permutation is applied:
            = 'F' (Forward) Applies pivots Forward from top of matrix.
                  Computes P * sub( A );
            = 'B' (Backward) Applies pivots Backward from bottom of
                  matrix. Computes inv( P ) * sub( A ).
  ROWCOL  (global input) CHARACTER
          Specifies if the rows or columns are to be permuted:
            = 'R' Rows will be permuted,
            = 'C' Columns will be permuted.
  M       (global input) INTEGER
          The number of rows to be operated on, i.e. the number of rows
          of the distributed submatrix sub( A ). M >= 0.
  N       (global input) INTEGER
          The number of columns to be operated on, i.e. the number of
          columns of the distributed submatrix sub( A ). N >= 0.
  A       (local input/local output) REAL pointer into the
          local memory to an array of dimension (LLD_A, LOCc(JA+N-1)).
          On entry, this local array contains the local pieces of the
          distributed matrix sub( A ) to which the row or columns
          interchanges will be applied. On exit, this array contains
          the local pieces of the permuted distributed matrix.
  IA      (global input) INTEGER
          The row index in the global array A indicating the first
          row of sub( A ).
  JA      (global input) INTEGER
          The column index in the global array A indicating the
          first column of sub( A ).
  DESCA   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix A.
  IPIV    (input) INTEGER array, dimension >= LOCr(M_A)+MB_A if
          ROWCOL = 'R', LOCc(N_A)+NB_A otherwise. It contains
          the pivoting information. IPIV(i) is the global row (column),
          local row (column) i was swapped with.  The last piece of the
          array of size MB_A (resp. NB_A) is used as workspace. IPIV is
          tied to the distributed matrix A.
  IP      (global input) INTEGER
          IPIV's global row index, which points to the beginning of the
          submatrix which is to be operated on.
  JP      (global input) INTEGER
          IPIV's global column index, which points to the beginning of
          the submatrix which is to be operated on.
  DESCIP  (global and local input) INTEGER array of dimension 8
          The array descriptor for the distributed matrix IPIV.
  =====================================================================
     .. Parameters ..

 
Display dynamic version Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

 
001        SUBROUTINE PSLAPV2( DIREC , ROWCOL , M , N , A , IA , JA , DESCA , IPIV ,
002       $IP , JP , DESCIP )
003  
004  *     -- ScaLAPACK auxiliary routine(version 1.7) --
005  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
006  *     and University of California , Berkeley.
007  *     May 1 , 1997
008  
009  *     .. Scalar Arguments ..
010        CHARACTER DIREC , ROWCOL
011        INTEGER IA , IP , JA , JP , M , N
012        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
013       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
014        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
015       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
016       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
017  *     ..
018  *     .. Local Scalars ..
019        LOGICAL FORWRD , ROWPVT
020        INTEGER I , IB , ICTXT , ICURCOL , ICURROW , IIP , IP1 , ITMP ,
021       $IPVWRK , J , JB , JJP , JP1 , K , MA , MBA , MYCOL ,
022       $MYROW , NBA , NPCOL , NPROW
023  *     ..
024  *     .. External Subroutines ..
025        EXTERNAL BLACS_GRIDINFO , IGEBS2D , IGEBR2D , INFOG2L ,
026       $PSSWAP
027  *     ..
028  *     .. External Functions ..
029        LOGICAL LSAME
030        INTEGER ICEIL , NUMROC
031        EXTERNAL ICEIL , LSAME , NUMROC
032  *     ..
033  *     .. Intrinsic Functions ..
034        INTRINSIC MIN , MOD
035  *     ..
036  *     .. Executable Statements ..
037  
038        ROWPVT = LSAME( ROWCOL , 'R' )
039        IF( ROWPVT ) THEN
040            IF( M.LE.1 .OR. N.LT.1 )
041       $        RETURN
042            ELSE
043                IF( M.LT.1 .OR. N.LE.1 )
044       $            RETURN
045                END IF
046                FORWRD = LSAME( DIREC , 'F' )
047  
048  *             Get grid and matrix parameters
049  
050                MA = DESCA( M_ )
051                MBA = DESCA( MB_ )
052                NBA = DESCA( NB_ )
053                ICTXT = DESCA( CTXT_ )
054                CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
055  
056  *             If I'm applying pivots from beginning to end(e.g. , repeating
057  *             pivoting done earlier). Thus this section computes P * sub( A ).
058  
059                IF( FORWRD ) THEN
060                    CALL INFOG2L( IP , JP , DESCIP , NPROW , NPCOL , MYROW , MYCOL ,
061       $            IIP , JJP , ICURROW , ICURCOL )
062  
063  *                 If I'm pivoting the rows of sub( A )
064  
065                    IF( ROWPVT ) THEN
066                        IPVWRK = NUMROC( DESCIP( M_ ) , DESCIP( MB_ ) , MYROW ,
067       $                DESCIP( RSRC_ ) , NPROW ) + 1 -
068       $                DESCIP( MB_ )
069  
070  *                     Loop over rows of sub( A )
071  
072                        I = IA
073                        IB = MIN( M , ICEIL( IA , MBA ) * MBA - IA + 1 )
074     10 CONTINUE
075  
076  *     Find local pointer into IPIV , and broadcast this block's
077  *     pivot information to everyone in process column
078  
079        IF( MYROW.EQ.ICURROW ) THEN
080            CALL IGEBS2D( ICTXT , 'Columnwise' , ' ' , IB , 1 ,
081       $    IPIV( IIP ) , IB )
082            ITMP = IIP
083            IIP = IIP + IB
084        ELSE
085            ITMP = IPVWRK
086            CALL IGEBR2D( ICTXT , 'Columnwise' , ' ' , IB , 1 ,
087       $    IPIV( ITMP ) , IB , ICURROW , MYCOL )
088        END IF
089  
090  *     Pivot the block of rows
091  
092        DO 20 K = I , I + IB - 1
093            IP1 = IPIV( ITMP ) - IP + IA
094            IF( IP1.NE.K )
095       $        CALL PSSWAP( N , A , K , JA , DESCA , MA , A , IP1 , JA ,
096       $        DESCA , MA )
097                ITMP = ITMP + 1
098     20 CONTINUE
099  
100  *     Go on to next row of processes , increment row counter ,
101  *     and figure number of rows to pivot next
102  
103        ICURROW = MOD( ICURROW + 1 , NPROW )
104        I = I + IB
105        IB = MIN( MBA , M - I + IA )
106        IF( IB .GT. 0 ) GOTO 10
107  
108  *     If I am pivoting the columns of sub( A )
109  
110        ELSE
111            IPVWRK = NUMROC( DESCIP( N_ ) , DESCIP( NB_ ) , MYCOL ,
112       $    DESCIP( CSRC_ ) , NPCOL ) + 1 -
113       $    DESCIP( NB_ )
114  
115  *         Loop over columns of sub( A )
116  
117            J = JA
118            JB = MIN( N , ICEIL( JA , NBA ) * NBA - JA + 1 )
119     30 CONTINUE
120  
121  *     Find local pointer into IPIV , and broadcast this block's
122  *     pivot information to everyone in process row
123  
124        IF( MYCOL.EQ.ICURCOL ) THEN
125            CALL IGEBS2D( ICTXT , 'Rowwise' , ' ' , JB , 1 ,
126       $    IPIV( JJP ) , JB )
127            ITMP = JJP
128            JJP = JJP + JB
129        ELSE
130            ITMP = IPVWRK
131            CALL IGEBR2D( ICTXT , 'Rowwise' , ' ' , JB , 1 ,
132       $    IPIV( ITMP ) , JB , MYROW , ICURCOL )
133        END IF
134  
135  *     Pivot the block of columns
136  
137        DO 40 K = J , J + JB - 1
138            JP1 = IPIV( ITMP ) - JP + JA
139            IF( JP1.NE.K )
140       $        CALL PSSWAP( M , A , IA , K , DESCA , 1 , A , IA , JP1 ,
141       $        DESCA , 1 )
142                ITMP = ITMP + 1
143     40 CONTINUE
144  
145  *     Go on to next column of processes , increment column
146  *     counter , and figure number of columns to pivot next
147  
148        ICURCOL = MOD( ICURCOL + 1 , NPCOL )
149        J = J + JB
150        JB = MIN( NBA , N - J + JA )
151        IF( JB .GT. 0 ) GOTO 30
152        END IF
153  
154  *     If I want to apply pivots in reverse order , i.e. reversing
155  *     pivoting done earlier. Thus this section computes
156  *     inv( P ) * sub( A ).
157  
158        ELSE
159  
160  *         If I'm pivoting the rows of sub( A )
161  
162            IF( ROWPVT ) THEN
163                CALL INFOG2L( IP + M - 1 , JP , DESCIP , NPROW , NPCOL , MYROW ,
164       $        MYCOL , IIP , JJP , ICURROW , ICURCOL )
165  
166                IPVWRK = NUMROC( DESCIP( M_ ) , DESCIP( MB_ ) , MYROW ,
167       $        DESCIP( RSRC_ ) , NPROW ) + 1 -
168       $        DESCIP( MB_ )
169  
170  *             If I'm not in the current process row , my IIP points out
171  *             past end of pivot vector(since I don't own a piece of the
172  *             last row). Adjust IIP so it points at last pivot entry.
173  
174                IF( MYROW.NE.ICURROW ) IIP = IIP - 1
175  
176  *             Loop over rows in reverse order , starting at last row
177  
178                I = IA + M - 1
179                IB = MOD( I , MBA )
180                IF( IB .EQ. 0 ) IB = MBA
181                IB = MIN( IB , M )
182     50 CONTINUE
183  
184  *     Find local pointer into IPIV , and broadcast this block's
185  *     pivot information to everyone in process column
186  
187        IF( MYROW.EQ.ICURROW ) THEN
188            ITMP = IIP
189            IIP = IIP - IB
190            CALL IGEBS2D( ICTXT , 'Columnwise' , ' ' , IB , 1 ,
191       $    IPIV( IIP + 1 ) , IB )
192        ELSE
193            CALL IGEBR2D( ICTXT , 'Columnwise' , ' ' , IB , 1 ,
194       $    IPIV( IPVWRK ) , IB , ICURROW , MYCOL )
195            ITMP = IPVWRK + IB - 1
196        END IF
197  
198  *     Pivot the block of rows
199  
200        DO 60 K = I , I - IB + 1 , - 1
201            IP1 = IPIV( ITMP ) - IP + IA
202            IF( IP1.NE.K )
203       $        CALL PSSWAP( N , A , K , JA , DESCA , MA , A , IP1 , JA ,
204       $        DESCA , MA )
205                ITMP = ITMP - 1
206     60 CONTINUE
207  
208  *     Go to previous row of processes , decrement row counter ,
209  *     and figure number of rows to be pivoted next
210  
211        ICURROW = MOD( NPROW + ICURROW - 1 , NPROW )
212        I = I - IB
213        IB = MIN( MBA , I - IA + 1 )
214        IF( IB .GT. 0 ) GOTO 50
215  
216  *     Otherwise , I'm pivoting the columns of sub( A )
217  
218        ELSE
219            CALL INFOG2L( IP , JP + N - 1 , DESCIP , NPROW , NPCOL , MYROW ,
220       $    MYCOL , IIP , JJP , ICURROW , ICURCOL )
221            IPVWRK = NUMROC( DESCIP( N_ ) , DESCIP( NB_ ) , MYCOL ,
222       $    DESCIP( CSRC_ ) , NPCOL ) + 1 -
223       $    DESCIP( NB_ )
224  
225  *         If I'm not in the current process column , my JJP points out
226  *         past end of pivot vector(since I don't own a piece of the
227  *         last column). Adjust JJP so it points at last pivot entry.
228  
229            IF( MYCOL.NE.ICURCOL ) JJP = JJP - 1
230  
231  *         Loop over columns in reverse order starting at last column
232  
233            J = JA + N - 1
234            JB = MOD( J , NBA )
235            IF( JB .EQ. 0 ) JB = NBA
236            JB = MIN( JB , N )
237     70 CONTINUE
238  
239  *     Find local pointer into IPIV , and broadcast this block's
240  *     pivot information to everyone in process row
241  
242        IF( MYCOL.EQ.ICURCOL ) THEN
243            ITMP = JJP
244            JJP = JJP - JB
245            CALL IGEBS2D( ICTXT , 'Rowwise' , ' ' , JB , 1 ,
246       $    IPIV( JJP + 1 ) , JB )
247        ELSE
248            CALL IGEBR2D( ICTXT , 'Rowwise' , ' ' , JB , 1 ,
249       $    IPIV( IPVWRK ) , JB , MYROW , ICURCOL )
250            ITMP = IPVWRK + JB - 1
251        END IF
252  
253  *     Pivot a block of columns
254  
255        DO 80 K = J , J - JB + 1 , - 1
256            JP1 = IPIV( ITMP ) - JP + JA
257            IF( JP1.NE.K )
258       $        CALL PSSWAP( M , A , IA , K , DESCA , 1 , A , IA , JP1 ,
259       $        DESCA , 1 )
260                ITMP = ITMP - 1
261     80 CONTINUE
262  
263  *     Go to previous row of processes , decrement row counter ,
264  *     and figure number of rows to be pivoted next
265  
266        ICURCOL = MOD( NPCOL + ICURCOL - 1 , NPCOL )
267        J = J - JB
268        JB = MIN( NBA , J - JA + 1 )
269        IF( JB .GT. 0 ) GOTO 70
270        END IF
271  
272        END IF
273  
274        RETURN
275  
276  *     End PSLAPV2
277  
278        END