Routine: PCMAX1()  File: SRC\pcmax1.f

 
 
# lines: 359
  # code: 359
  # comment: 0
  # blank:0
# Variables:44
# Callers:1
# Callings:0
# Words:175
# Keywords:111
 

 

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PCMAX1 computes the global index of the maximum element in absolute
  value of a distributed vector sub( X ). The global index is returned
  in INDX and the value is returned in AMAX,
  where sub( X ) denotes X(IX:IX+N-1,JX) if INCX = 1,
                         X(IX,JX:JX+N-1) if INCX = M_X.
  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
  Because vectors may be viewed as a subclass of matrices, a
  distributed vector is considered to be a distributed matrix.
  When the result of a vector-oriented PBLAS call is a scalar, it will
  be made available only within the scope which owns the vector(s)
  being operated on.  Let X be a generic term for the input vector(s).
  Then, the processes which receive the answer will be (note that if
  an operation involves more than one vector, the processes which re-
  ceive the result will be the union of the following calculation for
  each vector):
  If N = 1, M_X = 1 and INCX = 1, then one can't determine if a process
  row or process column owns the vector operand, therefore only the
  process of coordinate {RSRC_X, CSRC_X} receives the result;
  If INCX = M_X, then sub( X ) is a vector distributed over a process
  row. Each process part of this row receives the result;
  If INCX = 1, then sub( X ) is a vector distributed over a process
  column. Each process part of this column receives the result;
  Based on PCAMAX from Level 1 PBLAS. The change is to use the
  'genuine' absolute value.
  The serial version was contributed to LAPACK by Nick Higham for use
  with CLACON.
  Arguments
  =========
  N       (global input) pointer to INTEGER
          The number of components of the distributed vector sub( X ).
          N >= 0.
  AMAX    (global output) pointer to REAL
          The absolute value of the largest entry of the distributed
          vector sub( X ) only in the scope of sub( X ).
  INDX    (global output) pointer to INTEGER
          The global index of the element of the distributed vector
          sub( X ) whose real part has maximum absolute value.
  X       (local input) COMPLEX array containing the local
          pieces of a distributed matrix of dimension of at least
              ( (JX-1)*M_X + IX + ( N - 1 )*abs( INCX ) )
          This array contains the entries of the distributed vector
          sub( X ).
  IX      (global input) INTEGER
          The row index in the global array X indicating the first
          row of sub( X ).
  JX      (global input) INTEGER
          The column index in the global array X indicating the
          first column of sub( X ).
  DESCX   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix X.
  INCX    (global input) INTEGER
          The global increment for the elements of X. Only two values
          of INCX are supported in this version, namely 1 and M_X.
          INCX must not be zero.
  =====================================================================
     .. Parameters ..

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

 
001        SUBROUTINE PCMAX1( N , AMAX , INDX , X , IX , JX , DESCX , INCX )
002  
003  *     -- ScaLAPACK auxiliary routine(version 1.7) --
004  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
005  *     and University of California , Berkeley.
006  *     May 25 , 2001
007  
008  *     .. Scalar Arguments ..
009        INTEGER INDX , INCX , IX , JX , N
010        COMPLEX AMAX
011        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
012       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
013        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
014       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
015       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
016        COMPLEX ZERO
017        PARAMETER( ZERO =( 0.0E + 0 , 0.0E + 0 ) )
018  *     ..
019  *     .. Local Scalars ..
020        CHARACTER CBTOP , CCTOP , RBTOP , RCTOP
021        INTEGER ICOFF , ICTXT , IDUMM , IIX , IROFF , IXCOL , IXROW ,
022       $JJX , LCINDX , LDX , MAXPOS , MYCOL , MYROW , NP ,
023       $NPCOL , NPROW , NQ
024  *     ..
025  *     .. Local Arrays ..
026        COMPLEX WORK( 2 )
027  *     ..
028  *     .. External Subroutines ..
029        EXTERNAL BLACS_GRIDINFO , CCOMBAMAX1 , CGAMX2D ,
030       $IGEBR2D , IGEBS2D , INFOG2L , PCTREECOMB ,
031       $PB_TOPGET
032  *     ..
033  *     .. External Functions ..
034        LOGICAL LSAME
035        INTEGER ICMAX1 , INDXL2G , NUMROC
036        EXTERNAL ICMAX1 , INDXL2G , NUMROC
037  *     ..
038  *     .. Intrinsic Functions ..
039        INTRINSIC ABS , CMPLX , MOD , NINT , REAL
040  *     ..
041  *     .. Executable Statements ..
042  
043  *     Get grid parameters
044  
045        ICTXT = DESCX( CTXT_ )
046        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
047  
048  *     Quick return if possible.
049  
050        INDX = 0
051        AMAX = ZERO
052        IF( N.LE.0 )
053       $    RETURN
054  
055  *         Retrieve local information for vector X.
056  
057            LDX = DESCX( LLD_ )
058            CALL INFOG2L( IX , JX , DESCX , NPROW , NPCOL , MYROW , MYCOL , IIX , JJX ,
059       $    IXROW , IXCOL )
060  
061            IF( INCX.EQ.1 .AND. DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
062                INDX = JX
063                AMAX = X( IIX + (JJX - 1)*LDX )
064                RETURN
065            END IF
066  
067  *         Find the maximum value and its index
068  
069            IF( INCX.EQ.DESCX( M_ ) ) THEN
070  
071                IF( MYROW.EQ.IXROW ) THEN
072  
073                    ICOFF = MOD( JX - 1 , DESCX( NB_ ) )
074                    NQ = NUMROC( N + ICOFF , DESCX( NB_ ) , MYCOL , IXCOL , NPCOL )
075                    IF( MYCOL.EQ.IXCOL )
076       $                NQ = NQ - ICOFF
077  
078                        CALL PB_TOPGET( ICTXT , 'Broadcast' , 'Rowwise' , RBTOP )
079  
080                        IF( LSAME( RBTOP , ' ' ) ) THEN
081  
082                            IF( NQ.GT.0 ) THEN
083                                LCINDX = JJX - 1 + ICMAX1( NQ , X( IIX + (JJX - 1)*LDX ) , LDX )
084                                WORK( 1 ) = X( IIX + (LCINDX - 1)*LDX )
085                                WORK( 2 ) = CMPLX( REAL( INDXL2G( LCINDX ,
086       $                        DESCX( NB_ ) , MYCOL , DESCX( CSRC_ ) , NPCOL ) ) )
087                            ELSE
088                                WORK( 1 ) = ZERO
089                                WORK( 2 ) = ZERO
090                            END IF
091  
092                            CALL PCTREECOMB( ICTXT , 'Row' , 2 , WORK , - 1 , MYCOL ,
093       $                    CCOMBAMAX1 )
094  
095                            AMAX = WORK( 1 )
096                            IF( AMAX.EQ.ZERO ) THEN
097                                INDX = JX
098                            ELSE
099                                INDX = NINT( REAL( WORK( 2 ) ) )
100                            END IF
101  
102                        ELSE
103  
104                            CALL PB_TOPGET( ICTXT , 'Combine' , 'Rowwise' , RCTOP )
105  
106                            IF( NQ.GT.0 ) THEN
107                                LCINDX = JJX - 1 + ICMAX1( NQ , X( IIX + (JJX - 1)*LDX ) , LDX )
108                                AMAX = X( IIX + (LCINDX - 1)*LDX )
109                            ELSE
110                                AMAX = ZERO
111                            END IF
112  
113  *                         Find the maximum value
114  
115                            CALL CGAMX2D( ICTXT , 'Rowwise' , RCTOP , 1 , 1 , AMAX , 1 ,
116       $                    IDUMM , MAXPOS , 1 , - 1 , MYROW )
117  
118                            IF( AMAX.NE.ZERO ) THEN
119  
120  *                             Broadcast corresponding global index
121  
122                                IF( MYCOL.EQ.MAXPOS ) THEN
123                                    INDX = INDXL2G( LCINDX , DESCX( NB_ ) , MYCOL ,
124       $                            DESCX( CSRC_ ) , NPCOL )
125                                    CALL IGEBS2D( ICTXT , 'Rowwise' , RBTOP , 1 , 1 , INDX ,
126       $                            1 )
127                                ELSE
128                                    CALL IGEBR2D( ICTXT , 'Rowwise' , RBTOP , 1 , 1 , INDX ,
129       $                            1 , MYROW , MAXPOS )
130                                END IF
131  
132                            ELSE
133  
134                                INDX = JX
135  
136                            END IF
137  
138                        END IF
139  
140                    END IF
141  
142                ELSE
143  
144                    IF( MYCOL.EQ.IXCOL ) THEN
145  
146                        IROFF = MOD( IX - 1 , DESCX( MB_ ) )
147                        NP = NUMROC( N + IROFF , DESCX( MB_ ) , MYROW , IXROW , NPROW )
148                        IF( MYROW.EQ.IXROW )
149       $                    NP = NP - IROFF
150  
151                            CALL PB_TOPGET( ICTXT , 'Broadcast' , 'Columnwise' , CBTOP )
152  
153                            IF( LSAME( CBTOP , ' ' ) ) THEN
154  
155                                IF( NP.GT.0 ) THEN
156                                    LCINDX = IIX - 1 + ICMAX1( NP , X( IIX + (JJX - 1)*LDX ) , 1 )
157                                    WORK( 1 ) = X( LCINDX + (JJX - 1)*LDX )
158                                    WORK( 2 ) = CMPLX( REAL( INDXL2G( LCINDX ,
159       $                            DESCX( MB_ ) , MYROW , DESCX( RSRC_ ) , NPROW ) ) )
160                                ELSE
161                                    WORK( 1 ) = ZERO
162                                    WORK( 2 ) = ZERO
163                                END IF
164  
165                                CALL PCTREECOMB( ICTXT , 'Column' , 2 , WORK , - 1 , MYCOL ,
166       $                        CCOMBAMAX1 )
167  
168                                AMAX = WORK( 1 )
169                                IF( AMAX.EQ.ZERO ) THEN
170                                    INDX = IX
171                                ELSE
172                                    INDX = NINT( REAL( WORK( 2 ) ) )
173                                END IF
174  
175                            ELSE
176  
177                                CALL PB_TOPGET( ICTXT , 'Combine' , 'Columnwise' , CCTOP )
178  
179                                IF( NP.GT.0 ) THEN
180                                    LCINDX = IIX - 1 + ICMAX1( NP , X( IIX + (JJX - 1)*LDX ) , 1 )
181                                    AMAX = X( LCINDX + (JJX - 1)*LDX )
182                                ELSE
183                                    AMAX = ZERO
184                                END IF
185  
186  *                             Find the maximum value
187  
188                                CALL CGAMX2D( ICTXT , 'Columnwise' , CCTOP , 1 , 1 , AMAX , 1 ,
189       $                        MAXPOS , IDUMM , 1 , - 1 , MYCOL )
190  
191                                IF( AMAX.NE.ZERO ) THEN
192  
193  *                                 Broadcast corresponding global index
194  
195                                    IF( MYROW.EQ.MAXPOS ) THEN
196                                        INDX = INDXL2G( LCINDX , DESCX( MB_ ) , MYROW ,
197       $                                DESCX( RSRC_ ) , NPROW )
198                                        CALL IGEBS2D( ICTXT , 'Columnwise' , CBTOP , 1 , 1 ,
199       $                                INDX , 1 )
200                                    ELSE
201                                        CALL IGEBR2D( ICTXT , 'Columnwise' , CBTOP , 1 , 1 ,
202       $                                INDX , 1 , MAXPOS , MYCOL )
203                                    END IF
204  
205                                ELSE
206  
207                                    INDX = IX
208  
209                                END IF
210  
211                            END IF
212  
213                        END IF
214  
215                    END IF
216  
217                    RETURN
218  
219  *                 End of PCMAX1
220  
221                END
222