Routine: PZMAX1()  File: SRC\pzmax1.f

 
 
# lines: 358
  # code: 358
  # comment: 0
  # blank:0
# Variables:44
# Callers:1
# Callings:0
# Words:175
# Keywords:110
 

 

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PZMAX1 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 PZAMAX 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 ZLACON.
  Arguments
  =========
  N       (global input) pointer to INTEGER
          The number of components of the distributed vector sub( X ).
          N >= 0.
  AMAX    (global output) pointer to DOUBLE PRECISION
          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*16 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 PZMAX1( 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 1 , 1997
007  
008  *     .. Scalar Arguments ..
009        INTEGER INDX , INCX , IX , JX , N
010        COMPLEX*16 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*16 ZERO
017        PARAMETER( ZERO =( 0.0D + 0 , 0.0D + 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*16 WORK( 2 )
027  *     ..
028  *     .. External Subroutines ..
029        EXTERNAL BLACS_GRIDINFO , IGEBR2D , IGEBS2D , INFOG2L ,
030       $PB_TOPGET , PZTREECOMB , ZCOMBAMAX1 , ZGAMX2D
031  *     ..
032  *     .. External Functions ..
033        LOGICAL LSAME
034        INTEGER IZMAX1 , INDXL2G , NUMROC
035        EXTERNAL IZMAX1 , INDXL2G , NUMROC
036  *     ..
037  *     .. Intrinsic Functions ..
038        INTRINSIC ABS , DBLE , DCMPLX , MOD , NINT
039  *     ..
040  *     .. Executable Statements ..
041  
042  *     Get grid parameters
043  
044        ICTXT = DESCX( CTXT_ )
045        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
046  
047  *     Quick return if possible.
048  
049        INDX = 0
050        AMAX = ZERO
051        IF( N.LE.0 )
052       $    RETURN
053  
054  *         Retrieve local information for vector X.
055  
056            LDX = DESCX( LLD_ )
057            CALL INFOG2L( IX , JX , DESCX , NPROW , NPCOL , MYROW , MYCOL , IIX , JJX ,
058       $    IXROW , IXCOL )
059  
060            IF( INCX.EQ.1 .AND. DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
061                INDX = JX
062                AMAX = X( IIX + (JJX - 1)*LDX )
063                RETURN
064            END IF
065  
066  *         Find the maximum value and its index
067  
068            IF( INCX.EQ.DESCX( M_ ) ) THEN
069  
070                IF( MYROW.EQ.IXROW ) THEN
071  
072                    ICOFF = MOD( JX - 1 , DESCX( NB_ ) )
073                    NQ = NUMROC( N + ICOFF , DESCX( NB_ ) , MYCOL , IXCOL , NPCOL )
074                    IF( MYCOL.EQ.IXCOL )
075       $                NQ = NQ - ICOFF
076  
077                        CALL PB_TOPGET( ICTXT , 'Broadcast' , 'Rowwise' , RBTOP )
078  
079                        IF( LSAME( RBTOP , ' ' ) ) THEN
080  
081                            IF( NQ.GT.0 ) THEN
082                                LCINDX = JJX - 1 + IZMAX1( NQ , X( IIX + (JJX - 1)*LDX ) , LDX )
083                                WORK( 1 ) = X( IIX + (LCINDX - 1)*LDX )
084                                WORK( 2 ) = DCMPLX( DBLE( INDXL2G( LCINDX ,
085       $                        DESCX( NB_ ) , MYCOL , DESCX( CSRC_ ) , NPCOL ) ) )
086                            ELSE
087                                WORK( 1 ) = ZERO
088                                WORK( 2 ) = ZERO
089                            END IF
090  
091                            CALL PZTREECOMB( ICTXT , 'Row' , 2 , WORK , - 1 , MYCOL ,
092       $                    ZCOMBAMAX1 )
093  
094                            AMAX = WORK( 1 )
095                            IF( AMAX.EQ.ZERO ) THEN
096                                INDX = JX
097                            ELSE
098                                INDX = NINT( DBLE( WORK( 2 ) ) )
099                            END IF
100  
101                        ELSE
102  
103                            CALL PB_TOPGET( ICTXT , 'Combine' , 'Rowwise' , RCTOP )
104  
105                            IF( NQ.GT.0 ) THEN
106                                LCINDX = JJX - 1 + IZMAX1( NQ , X( IIX + (JJX - 1)*LDX ) , LDX )
107                                AMAX = X( IIX + (LCINDX - 1)*LDX )
108                            ELSE
109                                AMAX = ZERO
110                            END IF
111  
112  *                         Find the maximum value
113  
114                            CALL ZGAMX2D( ICTXT , 'Rowwise' , RCTOP , 1 , 1 , AMAX , 1 ,
115       $                    IDUMM , MAXPOS , 1 , - 1 , MYROW )
116  
117                            IF( AMAX.NE.ZERO ) THEN
118  
119  *                             Broadcast corresponding global index
120  
121                                IF( MYCOL.EQ.MAXPOS ) THEN
122                                    INDX = INDXL2G( LCINDX , DESCX( NB_ ) , MYCOL ,
123       $                            DESCX( CSRC_ ) , NPCOL )
124                                    CALL IGEBS2D( ICTXT , 'Rowwise' , RBTOP , 1 , 1 , INDX ,
125       $                            1 )
126                                ELSE
127                                    CALL IGEBR2D( ICTXT , 'Rowwise' , RBTOP , 1 , 1 , INDX ,
128       $                            1 , MYROW , MAXPOS )
129                                END IF
130  
131                            ELSE
132  
133                                INDX = JX
134  
135                            END IF
136  
137                        END IF
138  
139                    END IF
140  
141                ELSE
142  
143                    IF( MYCOL.EQ.IXCOL ) THEN
144  
145                        IROFF = MOD( IX - 1 , DESCX( MB_ ) )
146                        NP = NUMROC( N + IROFF , DESCX( MB_ ) , MYROW , IXROW , NPROW )
147                        IF( MYROW.EQ.IXROW )
148       $                    NP = NP - IROFF
149  
150                            CALL PB_TOPGET( ICTXT , 'Broadcast' , 'Columnwise' , CBTOP )
151  
152                            IF( LSAME( CBTOP , ' ' ) ) THEN
153  
154                                IF( NP.GT.0 ) THEN
155                                    LCINDX = IIX - 1 + IZMAX1( NP , X( IIX + (JJX - 1)*LDX ) , 1 )
156                                    WORK( 1 ) = X( LCINDX + (JJX - 1)*LDX )
157                                    WORK( 2 ) = DCMPLX( DBLE( INDXL2G( LCINDX ,
158       $                            DESCX( MB_ ) , MYROW , DESCX( RSRC_ ) , NPROW ) ) )
159                                ELSE
160                                    WORK( 1 ) = ZERO
161                                    WORK( 2 ) = ZERO
162                                END IF
163  
164                                CALL PZTREECOMB( ICTXT , 'Column' , 2 , WORK , - 1 , MYCOL ,
165       $                        ZCOMBAMAX1 )
166  
167                                AMAX = WORK( 1 )
168                                IF( AMAX.EQ.ZERO ) THEN
169                                    INDX = IX
170                                ELSE
171                                    INDX = NINT( DBLE( WORK( 2 ) ) )
172                                END IF
173  
174                            ELSE
175  
176                                CALL PB_TOPGET( ICTXT , 'Combine' , 'Columnwise' , CCTOP )
177  
178                                IF( NP.GT.0 ) THEN
179                                    LCINDX = IIX - 1 + IZMAX1( NP , X( IIX + (JJX - 1)*LDX ) , 1 )
180                                    AMAX = X( LCINDX + (JJX - 1)*LDX )
181                                ELSE
182                                    AMAX = ZERO
183                                END IF
184  
185  *                             Find the maximum value
186  
187                                CALL ZGAMX2D( ICTXT , 'Columnwise' , CCTOP , 1 , 1 , AMAX , 1 ,
188       $                        MAXPOS , IDUMM , 1 , - 1 , MYCOL )
189  
190                                IF( AMAX.NE.ZERO ) THEN
191  
192  *                                 Broadcast corresponding global index
193  
194                                    IF( MYROW.EQ.MAXPOS ) THEN
195                                        INDX = INDXL2G( LCINDX , DESCX( MB_ ) , MYROW ,
196       $                                DESCX( RSRC_ ) , NPROW )
197                                        CALL IGEBS2D( ICTXT , 'Columnwise' , CBTOP , 1 , 1 ,
198       $                                INDX , 1 )
199                                    ELSE
200                                        CALL IGEBR2D( ICTXT , 'Columnwise' , CBTOP , 1 , 1 ,
201       $                                INDX , 1 , MAXPOS , MYCOL )
202                                    END IF
203  
204                                ELSE
205  
206                                    INDX = IX
207  
208                                END IF
209  
210                            END IF
211  
212                        END IF
213  
214                    END IF
215  
216                    RETURN
217  
218  *                 End of PZMAX1
219  
220                END
221