Routine PDGEQPF() Documented By Universal Report

Routine: PDGEQPF()

# lines:	542
# code:	542
# comment:	0
# blank:	0
# Variables:	71
# Callers:	0
# Callings:	2
# Words:	362
# Keywords:	214

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PDGEQPF computes a QR factorization with column pivoting of a
  M-by-N distributed matrix sub( A ) = A(IA:IA+M-1,JA:JA+N-1):
                         sub( A ) * P = Q * R.
  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
  =========
  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) DOUBLE PRECISION pointer into the
          local memory to an array of dimension (LLD_A, LOCc(JA+N-1)).
          On entry, the local pieces of the M-by-N distributed matrix
          sub( A ) which is to be factored. On exit, the elements on
          and above the diagonal of sub( A ) contain the min(M,N) by N
          upper trapezoidal matrix R (R is upper triangular if M >= N);
          the elements below the diagonal, with the array TAU, repre-
          sent the orthogonal matrix Q as a product of elementary
          reflectors (see Further Details).
  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    (local output) INTEGER array, dimension LOCc(JA+N-1).
          On exit, if IPIV(I) = K, the local i-th column of sub( A )*P
          was the global K-th column of sub( A ). IPIV is tied to the
          distributed matrix A.
  TAU     (local output) DOUBLE PRECISION array, dimension
          LOCc(JA+MIN(M,N)-1). This array contains the scalar factors
          TAU of the elementary reflectors. TAU is tied to the
          distributed matrix A.
  WORK    (local workspace/local output) DOUBLE PRECISION array,
                                                   dimension (LWORK)
          On exit, WORK(1) returns the minimal and optimal LWORK.
  LWORK   (local or global input) INTEGER
          The dimension of the array WORK.
          LWORK is local input and must be at least
          LWORK >= MAX(3,Mp0 + Nq0) + LOCc(JA+N-1)+Nq0.
          IROFF = MOD( IA-1, MB_A ), ICOFF = MOD( JA-1, NB_A ),
          IAROW = INDXG2P( IA, MB_A, MYROW, RSRC_A, NPROW ),
          IACOL = INDXG2P( JA, NB_A, MYCOL, CSRC_A, NPCOL ),
          Mp0   = NUMROC( M+IROFF, MB_A, MYROW, IAROW, NPROW ),
          Nq0   = NUMROC( N+ICOFF, NB_A, MYCOL, IACOL, NPCOL ),
          LOCc(JA+N-1) = NUMROC( JA+N-1, NB_A, MYCOL, CSRC_A, NPCOL )
          and NUMROC, INDXG2P are ScaLAPACK tool functions;
          MYROW, MYCOL, NPROW and NPCOL can be determined by calling
          the subroutine BLACS_GRIDINFO.
          If LWORK = -1, then LWORK is global input and a workspace
          query is assumed; the routine only calculates the minimum
          and optimal size for all work arrays. Each of these
          values is returned in the first entry of the corresponding
          work array, and no error message is issued by PXERBLA.
  INFO    (global output) INTEGER
          = 0:  successful exit
          < 0:  If the i-th argument is an array and the j-entry had
                an illegal value, then INFO = -(i*100+j), if the i-th
                argument is a scalar and had an illegal value, then
                INFO = -i.
  Further Details
  ===============
  The matrix Q is represented as a product of elementary reflectors
     Q = H(1) H(2) . . . H(n)
  Each H(i) has the form
     H = I - tau * v * v'
  where tau is a real scalar, and v is a real vector with v(1:i-1) = 0
  and v(i) = 1; v(i+1:m) is stored on exit in A(ia+i-1:ia+m-1,ja+i-1).
  The matrix P is represented in jpvt as follows: If
     jpvt(j) = i
  then the jth column of P is the ith canonical unit vector.
  =====================================================================
     .. Parameters ..

Display dynamic version

FontSize: - +

001        SUBROUTINE PDGEQPF( M , N , A , IA , JA , DESCA , IPIV , TAU , WORK ,
002       $LWORK , INFO )
003  
004  *     -- ScaLAPACK routine(version 1.7) --
005  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
006  *     and University of California , Berkeley.
007  *     March 14 , 2000
008  
009  *     .. Scalar Arguments ..
010        INTEGER IA , JA , INFO , LWORK , M , N
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        DOUBLE PRECISION ONE , ZERO
017        PARAMETER( ONE = 1.0D + 0 , ZERO = 0.0D + 0 )
018  *     ..
019  *     .. Local Scalars ..
020        LOGICAL LQUERY
021        INTEGER I , IACOL , IAROW , ICOFF , ICTXT , ICURROW ,
022       $ICURCOL , II , IIA , IOFFA , IPN , IPCOL , IPW ,
023       $IROFF , ITEMP , J , JB , JJ , JJA , JJPVT , JN , KB ,
024       $K , KK , KSTART , KSTEP , LDA , LL , LWMIN , MN , MP ,
025       $MYCOL , MYROW , NPCOL , NPROW , NQ , NQ0 , PVT
026        DOUBLE PRECISION AJJ , ALPHA , TEMP , TEMP2
027  *     ..
028  *     .. Local Arrays ..
029        INTEGER DESCN( DLEN_ ) , IDUM1( 1 ) , IDUM2( 1 )
030  *     ..
031  *     .. External Subroutines ..
032        EXTERNAL BLACS_GRIDINFO , CHK1MAT , DCOPY , DESCSET ,
033       $DGEBR2D , DGEBS2D , DGERV2D ,
034       $DGESD2D , DLARFG , DSWAP , IGERV2D ,
035       $IGESD2D , INFOG1L , INFOG2L , PCHK1MAT , PDAMAX ,
036       $PDELSET , PDLARF , PDLARFG , PDNRM2 ,
037       $PXERBLA
038  *     ..
039  *     .. External Functions ..
040        INTEGER ICEIL , INDXG2P , NUMROC
041        EXTERNAL ICEIL , INDXG2P , NUMROC
042  *     ..
043  *     .. Intrinsic Functions ..
044        INTRINSIC ABS , DBLE , IDINT , MAX , MIN , MOD , SQRT
045  *     ..
046  *     .. Executable Statements ..
047  
048  *     Get grid parameters
049  
050        ICTXT = DESCA( CTXT_ )
051        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
052  
053  *     Test the input parameters
054  
055        INFO = 0
056        IF( NPROW.EQ. - 1 ) THEN
056               
057            INFO = - (600 + CTXT_)
058        ELSE
058               
059            CALL CHK1MAT( M , 1 , N , 2 , IA , JA , DESCA , 6 , INFO )
060            IF( INFO.EQ.0 ) THEN
060                   
061                IROFF = MOD( IA - 1 , DESCA( MB_ ) )
062                ICOFF = MOD( JA - 1 , DESCA( NB_ ) )
063                IAROW = INDXG2P( IA , DESCA( MB_ ) , MYROW , DESCA( RSRC_ ) ,
064       $        NPROW )
065                IACOL = INDXG2P( JA , DESCA( NB_ ) , MYCOL , DESCA( CSRC_ ) ,
066       $        NPCOL )
067                MP = NUMROC( M + IROFF , DESCA( MB_ ) , MYROW , IAROW , NPROW )
068                NQ = NUMROC( N + ICOFF , DESCA( NB_ ) , MYCOL , IACOL , NPCOL )
069                NQ0 = NUMROC( JA + N - 1 , DESCA( NB_ ) , MYCOL , DESCA( CSRC_ ) ,
070       $        NPCOL )
071                LWMIN = MAX( 3 , MP + NQ ) + NQ0 + NQ
072  
073                WORK( 1 ) = DBLE( LWMIN )
074                LQUERY =( LWORK.EQ. - 1 )
075                IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
075                       
076       $            INFO = - 10
077                END IF
078                IF( LWORK.EQ. - 1 ) THEN
078                       
079                    IDUM1( 1 ) = - 1
080                ELSE
080                       
081                    IDUM1( 1 ) = 1
082                END IF
083                IDUM2( 1 ) = 10
084                CALL PCHK1MAT( M , 1 , N , 2 , IA , JA , DESCA , 6 , 1 , IDUM1 , IDUM2 ,
085       $        INFO )
086            END IF
087  
088            IF( INFO.NE.0 ) THEN
088                   
089                CALL PXERBLA( ICTXT , 'PDGEQPF' , - INFO )
090                RETURN
091            ELSE IF( LQUERY ) THEN
091                   
092                RETURN
093            END IF
094  
095  *         Quick return if possible
096  
097            IF( M.EQ.0 .OR. N.EQ.0 )
097                   
098       $        RETURN
099  
100                CALL INFOG2L( IA , JA , DESCA , NPROW , NPCOL , MYROW , MYCOL , IIA , JJA ,
101       $        IAROW , IACOL )
102                IF( MYROW.EQ.IAROW )
102                       
103       $            MP = MP - IROFF
104                    IF( MYCOL.EQ.IACOL )
104                           
105       $                NQ = NQ - ICOFF
106                        MN = MIN( M , N )
107  
108  *                     Initialize the array of pivots
109  
110                        LDA = DESCA( LLD_ )
111                        JN = MIN( ICEIL( JA , DESCA( NB_ ) ) * DESCA( NB_ ) , JA + N - 1 )
112                        KSTEP = NPCOL * DESCA( NB_ )
113  
114                        IF( MYCOL.EQ.IACOL ) THEN
115  
116  *                         Handle first block separately
117  
117                               
118                            JB = JN - JA + 1
119                            DO 10 LL = JJA , JJA + JB - 1
119                                   
120                                IPIV( LL ) = JA + LL - JJA
121     10                     CONTINUE
121                               
122                            KSTART = JN + KSTEP - DESCA( NB_ )
123  
124  *                         Loop over remaining block of columns
125  
126                            DO 30 KK = JJA + JB , JJA + NQ - 1 , DESCA( NB_ )
126                                   
127                                KB = MIN( JJA + NQ - KK , DESCA( NB_ ) )
128                                DO 20 LL = KK , KK + KB - 1
128                                       
129                                    IPIV( LL ) = KSTART + LL - KK + 1
130     20                         CONTINUE
130                                   
131                                KSTART = KSTART + KSTEP
132     30                     CONTINUE
132                           
133                        ELSE
133                               
134                            KSTART = JN + ( MOD( MYCOL - IACOL + NPCOL , NPCOL ) - 1 )*
135       $                    DESCA( NB_ )
136                            DO 50 KK = JJA , JJA + NQ - 1 , DESCA( NB_ )
136                                   
137                                KB = MIN( JJA + NQ - KK , DESCA( NB_ ) )
138                                DO 40 LL = KK , KK + KB - 1
138                                       
139                                    IPIV( LL ) = KSTART + LL - KK + 1
140     40                         CONTINUE
140                                   
141                                KSTART = KSTART + KSTEP
142     50                     CONTINUE
142                           
143                        END IF
144  
145  *                     Initialize partial column norms , handle first block separately
146  
147                        CALL DESCSET( DESCN , 1 , DESCA( N_ ) , 1 , DESCA( NB_ ) , MYROW ,
148       $                DESCA( CSRC_ ) , ICTXT , 1 )
149  
150                        IPN = 1
151                        IPW = IPN + NQ0 + NQ
152                        JJ = IPN + JJA - 1
153                        IF( MYCOL.EQ.IACOL ) THEN
153                               
154                            DO 60 KK = 0 , JB - 1
154                                   
155                                CALL PDNRM2( M , WORK( JJ + KK ) , A , IA , JA + KK , DESCA , 1 )
156                                WORK( NQ + JJ + KK ) = WORK( JJ + KK )
157     60                     CONTINUE
157                               
158                            JJ = JJ + JB
159                        END IF
160                        ICURCOL = MOD( IACOL + 1 , NPCOL )
161  
162  *                     Loop over the remaining blocks of columns
163  
164                        DO 80 J = JN + 1 , JA + N - 1 , DESCA( NB_ )
164                               
165                            JB = MIN( JA + N - J , DESCA( NB_ ) )
166  
167                            IF( MYCOL.EQ.ICURCOL ) THEN
167                                   
168                                DO 70 KK = 0 , JB - 1
168                                       
169                                    CALL PDNRM2( M , WORK( JJ + KK ) , A , IA , J + KK , DESCA , 1 )
170                                    WORK( NQ + JJ + KK ) = WORK( JJ + KK )
171     70                         CONTINUE
171                                   
172                                JJ = JJ + JB
173                            END IF
174                            ICURCOL = MOD( ICURCOL + 1 , NPCOL )
175     80                 CONTINUE
176  
177  *                     Compute factorization
178  
178                           
179                        DO 120 J = JA , JA + MN - 1
179                               
180                            I = IA + J - JA
181  
182                            CALL INFOG1L( J , DESCA( NB_ ) , NPCOL , MYCOL , DESCA( CSRC_ ) ,
183       $                    JJ , ICURCOL )
184                            K = JA + N - J
185                            IF( K.GT.1 ) THEN
185                                   
186                                CALL PDAMAX( K , TEMP , PVT , WORK( IPN ) , 1 , J , DESCN ,
187       $                        DESCN( M_ ) )
188                            ELSE
188                                   
189                                PVT = J
190                            END IF
191                            IF( J.NE.PVT ) THEN
191                                   
192                                CALL INFOG1L( PVT , DESCA( NB_ ) , NPCOL , MYCOL ,
193       $                        DESCA( CSRC_ ) , JJPVT , IPCOL )
194                                IF( ICURCOL.EQ.IPCOL ) THEN
194                                       
195                                    IF( MYCOL.EQ.ICURCOL ) THEN
195                                           
196                                        CALL DSWAP( MP , A( IIA + (JJ - 1)*LDA ) , 1 ,
197       $                                A( IIA + (JJPVT - 1)*LDA ) , 1 )
198                                        ITEMP = IPIV( JJPVT )
199                                        IPIV( JJPVT ) = IPIV( JJ )
200                                        IPIV( JJ ) = ITEMP
201                                        WORK( IPN + JJPVT - 1 ) = WORK( IPN + JJ - 1 )
202                                        WORK( IPN + NQ + JJPVT - 1 ) = WORK( IPN + NQ + JJ - 1 )
203                                    END IF
204                                ELSE
204                                       
205                                    IF( MYCOL.EQ.ICURCOL ) THEN
206  
206                                           
207                                        CALL DGESD2D( ICTXT , MP , 1 , A( IIA + (JJ - 1)*LDA ) , LDA ,
208       $                                MYROW , IPCOL )
209                                        WORK( IPW ) = DBLE( IPIV( JJ ) )
210                                        WORK( IPW + 1 ) = WORK( IPN + JJ - 1 )
211                                        WORK( IPW + 2 ) = WORK( IPN + NQ + JJ - 1 )
212                                        CALL DGESD2D( ICTXT , 3 , 1 , WORK( IPW ) , 3 , MYROW ,
213       $                                IPCOL )
214  
215                                        CALL DGERV2D( ICTXT , MP , 1 , A( IIA + (JJ - 1)*LDA ) , LDA ,
216       $                                MYROW , IPCOL )
217                                        CALL IGERV2D( ICTXT , 1 , 1 , IPIV( JJ ) , 1 , MYROW ,
218       $                                IPCOL )
219  
220                                    ELSE IF( MYCOL.EQ.IPCOL ) THEN
221  
221                                           
222                                        CALL DGESD2D( ICTXT , MP , 1 , A( IIA + (JJPVT - 1)*LDA ) ,
223       $                                LDA , MYROW , ICURCOL )
224                                        CALL IGESD2D( ICTXT , 1 , 1 , IPIV( JJPVT ) , 1 , MYROW ,
225       $                                ICURCOL )
226  
227                                        CALL DGERV2D( ICTXT , MP , 1 , A( IIA + (JJPVT - 1)*LDA ) ,
228       $                                LDA , MYROW , ICURCOL )
229                                        CALL DGERV2D( ICTXT , 3 , 1 , WORK( IPW ) , 3 , MYROW ,
230       $                                ICURCOL )
231                                        IPIV( JJPVT ) = IDINT( WORK( IPW ) )
232                                        WORK( IPN + JJPVT - 1 ) = WORK( IPW + 1 )
233                                        WORK( IPN + NQ + JJPVT - 1 ) = WORK( IPW + 2 )
234  
235                                    END IF
236  
237                                END IF
238  
239                            END IF
240  
241  *                         Generate elementary reflector H(i)
242  
243                            CALL INFOG1L( I , DESCA( MB_ ) , NPROW , MYROW , DESCA( RSRC_ ) ,
244       $                    II , ICURROW )
245                            IF( DESCA( M_ ).EQ.1 ) THEN
245                                   
246                                IF( MYROW.EQ.ICURROW ) THEN
246                                       
247                                    IF( MYCOL.EQ.ICURCOL ) THEN
247                                           
248                                        IOFFA = II + (JJ - 1)*DESCA( LLD_ )
249                                        AJJ = A( IOFFA )
250                                        CALL DLARFG( 1 , AJJ , A( IOFFA ) , 1 , TAU( JJ ) )
251                                        IF( N.GT.1 ) THEN
251                                               
252                                            ALPHA = ONE - TAU( JJ )
253                                            CALL DGEBS2D( ICTXT , 'Rowwise' , ' ' , 1 , 1 , ALPHA ,
254       $                                    1 )
255                                            CALL DSCAL( NQ - JJ , ALPHA , A( IOFFA + DESCA( LLD_ ) ) ,
256       $                                    DESCA( LLD_ ) )
257                                        END IF
258                                        CALL DGEBS2D( ICTXT , 'Columnwise' , ' ' , 1 , 1 ,
259       $                                TAU( JJ ) , 1 )
260                                        A( IOFFA ) = AJJ
261                                    ELSE
261                                           
262                                        IF( N.GT.1 ) THEN
262                                               
263                                            CALL DGEBR2D( ICTXT , 'Rowwise' , ' ' , 1 , 1 , ALPHA ,
264       $                                    1 , ICURROW , ICURCOL )
265                                            CALL DSCAL( NQ - JJ + 1 , ALPHA , A( I ) , DESCA( LLD_ ) )
266                                        END IF
267                                    END IF
268                                ELSE IF( MYCOL.EQ.ICURCOL ) THEN
268                                       
269                                    CALL DGEBR2D( ICTXT , 'Columnwise' , ' ' , 1 , 1 , TAU( JJ ) ,
270       $                            1 , ICURROW , ICURCOL )
271                                END IF
272  
273                            ELSE
274  
274                                   
275                                CALL PDLARFG ( M - J + JA , AJJ , I , J , A , MIN( I + 1 , IA + M - 1 ) , J ,
276       $                        DESCA , 1 , TAU )
277                                IF( J.LT.JA + N - 1 ) THEN
278  
279  *                                 Apply H(i) to A(ia + j - ja : ia + m - 1 , j + 1 : ja + n - 1) from the left
280  
280                                       
281                                    CALL PDELSET( A , I , J , DESCA , ONE )
282                                    CALL PDLARF ( 'Left' , M - J + JA , JA + N - 1 - J , A , I , J , DESCA ,
283       $                            1 , TAU , A , I , J + 1 , DESCA , WORK( IPW ) )
284                                END IF
285                                CALL PDELSET( A , I , J , DESCA , AJJ )
286  
287                            END IF
288  
289  *                         Update partial columns norms
290  
291                            IF( MYCOL.EQ.ICURCOL )
291                                   
292       $                        JJ = JJ + 1
293                                IF( MOD( J , DESCA( NB_ ) ).EQ.0 )
293                                       
294       $                            ICURCOL = MOD( ICURCOL + 1 , NPCOL )
295                                    IF((JJA + NQ - JJ).GT.0 ) THEN
295                                           
296                                        IF( MYROW.EQ.ICURROW ) THEN
296                                               
297                                            CALL DGEBS2D( ICTXT , 'Columnwise' , ' ' , 1 , JJA + NQ - JJ ,
298       $                                    A( II + ( MIN( JJA + NQ - 1 , JJ ) - 1 )*LDA ) ,
299       $                                    LDA )
300                                            CALL DCOPY( JJA + NQ - JJ , A( II + ( MIN( JJA + NQ - 1 , JJ )
301       $                                    - 1)*LDA ) , LDA , WORK( IPW + MIN( JJA + NQ - 1 ,
302       $                                    JJ ) - 1 ) , 1 )
303                                        ELSE
303                                               
304                                            CALL DGEBR2D( ICTXT , 'Columnwise' , ' ' , JJA + NQ - JJ , 1 ,
305       $                                    WORK( IPW + MIN( JJA + NQ - 1 , JJ ) - 1 ) ,
306       $                                    MAX( 1 , NQ ) , ICURROW , MYCOL )
307                                        END IF
308                                    END IF
309  
310                                    JN = MIN( ICEIL( J + 1 , DESCA( NB_ ) ) * DESCA( NB_ ) ,
311       $                            JA + N - 1 )
312                                    IF( MYCOL.EQ.ICURCOL ) THEN
312                                           
313                                        DO 90 LL = JJ - 1 , JJ + JN - J - 2
313                                               
314                                            IF( WORK( IPN + LL ).NE.ZERO ) THEN
314                                                   
315                                                TEMP = ONE - ( ABS( WORK( IPW + LL ) ) /
316       $                                        WORK( IPN + LL ) )**2
317                                                TEMP = MAX( TEMP , ZERO )
318                                                TEMP2 = ONE + 0.05D + 0*TEMP*
319       $( WORK( IPN + LL ) / WORK( IPN + NQ + LL ) )**2
319                                                   
320                                                IF( TEMP2.EQ.ONE ) THEN
320                                                       
321                                                    IF( IA + M - 1.GT.I ) THEN
321                                                           
322                                                        CALL PDNRM2( IA + M - I - 1 , WORK( IPN + LL ) , A , I + 1 ,
323       $                                                J + LL - JJ + 2 , DESCA , 1 )
324                                                        WORK( IPN + NQ + LL ) = WORK( IPN + LL )
325                                                    ELSE
325                                                           
326                                                        WORK( IPN + LL ) = ZERO
327                                                        WORK( IPN + NQ + LL ) = ZERO
328                                                    END IF
329                                                ELSE
329                                                       
330                                                    WORK( IPN + LL ) = WORK( IPN + LL ) * SQRT( TEMP )
331                                                END IF
332                                            END IF
333     90                                 CONTINUE
333                                           
334                                        JJ = JJ + JN - J
335                                    END IF
336                                    ICURCOL = MOD( ICURCOL + 1 , NPCOL )
337  
338                                    DO 110 K = JN + 1 , JA + N - 1 , DESCA( NB_ )
338                                           
339                                        KB = MIN( JA + N - K , DESCA( NB_ ) )
340  
341                                        IF( MYCOL.EQ.ICURCOL ) THEN
341                                               
342                                            DO 100 LL = JJ - 1 , JJ + KB - 2
342                                                   
343                                                IF( WORK( IPN + LL ).NE.ZERO ) THEN
343                                                       
344                                                    TEMP = ONE - ( ABS( WORK( IPW + LL ) ) /
345       $                                            WORK( IPN + LL ) )**2
346                                                    TEMP = MAX( TEMP , ZERO )
347                                                    TEMP2 = ONE + 0.05D + 0*TEMP*
348       $( WORK( IPN + LL ) / WORK( IPN + NQ + LL ) )**2
348                                                       
349                                                    IF( TEMP2.EQ.ONE ) THEN
349                                                           
350                                                        IF( IA + M - 1.GT.I ) THEN
350                                                               
351                                                            CALL PDNRM2( IA + M - I - 1 , WORK( IPN + LL ) , A ,
352       $                                                    I + 1 , K + LL - JJ + 1 , DESCA , 1 )
353                                                            WORK( IPN + NQ + LL ) = WORK( IPN + LL )
354                                                        ELSE
354                                                               
355                                                            WORK( IPN + LL ) = ZERO
356                                                            WORK( IPN + NQ + LL ) = ZERO
357                                                        END IF
358                                                    ELSE
358                                                           
359                                                        WORK( IPN + LL ) = WORK( IPN + LL ) * SQRT( TEMP )
360                                                    END IF
361                                                END IF
362    100                                     CONTINUE
362                                               
363                                            JJ = JJ + KB
364                                        END IF
365                                        ICURCOL = MOD( ICURCOL + 1 , NPCOL )
366  
367    110                             CONTINUE
368  
369    120                 CONTINUE
370  
370                           
371                        WORK( 1 ) = DBLE( LWMIN )
372  
373                        RETURN
374  
375  *                     End of PDGEQPF
376  
377                    END3053

Variables in Routine PDGEQPF()

Summary Report
Data Type	Quantity	Size(byte)
DOUBLE PRECISION	6	24
INTEGER	62	252
LOGICAL	1	1
REAL	2	8
TOTAL	71	285

List of Variables

DOUBLE PRECISION

AJJ ALPHA ONE TEMP TEMP2
ZERO

INTEGER

BLOCK_CYCLIC_2D CSRC_ CTXT_ DESCN( DLEN_ ) DLEN_
DTYPE_ I IA IACOL IAROW
ICEIL ICOFF ICTXT ICURCOL ICURROW
IDUM1( 1 ) IDUM2( 1 ) II IIA INDXG2P
INFO IOFFA IPCOL IPIV IPN
IPW IROFF ITEMP J JA
JB JJ JJA JJPVT JN
K KB KK KSTART KSTEP
LDA LL LLD_ LWMIN LWORK
M M_ MB_ MN MP
MYCOL MYROW N N_ NB_
NPCOL NPROW NQ NQ0 NUMROC
PVT RSRC_

LOGICAL

LQUERY

REAL

A WORK

Variables Dependence Graph
Put the mouse over a right hand side variable to display the corresponding line of the dependence
-
- -
A <--- AJJA( IOFFA ) = AJJ

AJJ <--- AAJJ = A( IOFFA ), IOFFAAJJ = A( IOFFA )

ALPHA <--- JJALPHA = ONE - TAU( JJ ), ONEALPHA = ONE - TAU( JJ )

I <--- IAI = IA + J - JA, JI = IA + J - JA, JAI = IA + J - JA

IACOL <--- INDXG2P, JA, CSRC_, MYCOL, NB_, NPCOL

IAROW <--- IA, INDXG2P, MB_, MYROW, NPROW, RSRC_

ICOFF <--- JAICOFF = MOD( JA-1, DESCA( NB_ ) ), NB_ICOFF = MOD( JA-1, DESCA( NB_ ) )

ICTXT <--- CTXT_ICTXT = DESCA( CTXT_ )

ICURCOL <--- IACOLICURCOL = MOD( IACOL+1, NPCOL ), ICURCOLICURCOL = MOD( ICURCOL+1, NPCOL ){2ICURCOL = MOD( ICURCOL+1, NPCOL ), 3ICURCOL = MOD( ICURCOL+1, NPCOL )}, NPCOLICURCOL = MOD( IACOL+1, NPCOL ){2ICURCOL = MOD( ICURCOL+1, NPCOL ), 3ICURCOL = MOD( ICURCOL+1, NPCOL ), 4ICURCOL = MOD( ICURCOL+1, NPCOL )}

INFO <--- CTXT_INFO = -(600+CTXT_)

IOFFA <--- IIIOFFA = II+(JJ-1)*DESCA( LLD_ ), JJIOFFA = II+(JJ-1)*DESCA( LLD_ ), LLD_IOFFA = II+(JJ-1)*DESCA( LLD_ )

IPIV <--- IPIVIPIV( JJPVT ) = IPIV( JJ ), IPWIPIV( JJPVT ) = IDINT( WORK( IPW ) ), ITEMPIPIV( JJ ) = ITEMP, JAIPIV( LL ) = JA + LL - JJA, JJIPIV( JJPVT ) = IPIV( JJ ), JJAIPIV( LL ) = JA + LL - JJA, KKIPIV( LL ) = KSTART+LL-KK+1{2IPIV( LL ) = KSTART+LL-KK+1}, KSTARTIPIV( LL ) = KSTART+LL-KK+1{2IPIV( LL ) = KSTART+LL-KK+1}, LLIPIV( LL ) = JA + LL - JJA{2IPIV( LL ) = KSTART+LL-KK+1, 3IPIV( LL ) = KSTART+LL-KK+1}, WORKIPIV( JJPVT ) = IDINT( WORK( IPW ) )

IPW <--- IPNIPW = IPN + NQ0 + NQ, NQIPW = IPN + NQ0 + NQ, NQ0IPW = IPN + NQ0 + NQ

IROFF <--- IAIROFF = MOD( IA-1, DESCA( MB_ ) ), MB_IROFF = MOD( IA-1, DESCA( MB_ ) )

ITEMP <--- IPIVITEMP = IPIV( JJPVT ), JJPVTITEMP = IPIV( JJPVT )

J <--- JADO 80 J = JN+1, JA+N-1, DESCA( NB_ ){2DO 120 J = JA, JA+MN-1}, JNDO 80 J = JN+1, JA+N-1, DESCA( NB_ ), MNDO 120 J = JA, JA+MN-1, NDO 80 J = JN+1, JA+N-1, DESCA( NB_ ), NB_DO 80 J = JN+1, JA+N-1, DESCA( NB_ )

JB <--- JJB = MIN( JA+N-J, DESCA( NB_ ) ), JAJB = JN - JA + 1{2JB = MIN( JA+N-J, DESCA( NB_ ) )}, JNJB = JN - JA + 1, NJB = MIN( JA+N-J, DESCA( NB_ ) ), NB_JB = MIN( JA+N-J, DESCA( NB_ ) )

JJ <--- IPNJJ = IPN + JJA - 1, JJJ = JJ + JN - J, JBJJ = JJ + JB{2JJ = JJ + JB}, JJJJ = JJ + JB{2JJ = JJ + JB, 3JJ = JJ + JN - J, 4JJ = JJ + KB}, JJAJJ = IPN + JJA - 1, JNJJ = JJ + JN - J, KBJJ = JJ + KB

JN <--- ICEIL{2}, J, JA{2}, N{2}, NB_{2}

K <--- JK = JA + N - J, JAK = JA + N - J{2DO 110 K = JN+1, JA+N-1, DESCA( NB_ )}, JNDO 110 K = JN+1, JA+N-1, DESCA( NB_ ), NK = JA + N - J{2DO 110 K = JN+1, JA+N-1, DESCA( NB_ )}, NB_DO 110 K = JN+1, JA+N-1, DESCA( NB_ )

KB <--- JAKB = MIN( JA+N-K, DESCA( NB_ ) ), JJAKB = MIN( JJA+NQ-KK, DESCA( NB_ ) ){2KB = MIN( JJA+NQ-KK, DESCA( NB_ ) )}, KKB = MIN( JA+N-K, DESCA( NB_ ) ), KKKB = MIN( JJA+NQ-KK, DESCA( NB_ ) ){2KB = MIN( JJA+NQ-KK, DESCA( NB_ ) )}, NKB = MIN( JA+N-K, DESCA( NB_ ) ), NB_KB = MIN( JJA+NQ-KK, DESCA( NB_ ) ){2KB = MIN( JJA+NQ-KK, DESCA( NB_ ) ), 3KB = MIN( JA+N-K, DESCA( NB_ ) )}, NQKB = MIN( JJA+NQ-KK, DESCA( NB_ ) ){2KB = MIN( JJA+NQ-KK, DESCA( NB_ ) )}

KK <--- JB{2DO 60 KK = 0, JB-1, 3DO 70 KK = 0, JB-1}, JJA{2DO 50 KK = JJA, JJA+NQ-1, DESCA( NB_ )}, NB_{2DO 50 KK = JJA, JJA+NQ-1, DESCA( NB_ )}, NQ{2DO 50 KK = JJA, JJA+NQ-1, DESCA( NB_ )}

KSTART <--- IACOL, JNKSTART = JN + KSTEP - DESCA( NB_ ){2}, KSTARTKSTART = KSTART + KSTEP{2KSTART = KSTART + KSTEP}, KSTEPKSTART = JN + KSTEP - DESCA( NB_ ){2KSTART = KSTART + KSTEP, 3KSTART = KSTART + KSTEP}, MYCOL, NB_KSTART = JN + KSTEP - DESCA( NB_ ){2}, NPCOL

KSTEP <--- NB_KSTEP = NPCOL * DESCA( NB_ ), NPCOLKSTEP = NPCOL * DESCA( NB_ )

LDA <--- LLD_LDA = DESCA( LLD_ )

LL <--- JDO 90 LL = JJ-1, JJ + JN - J - 2, JBDO 10 LL = JJA, JJA+JB-1, JJDO 90 LL = JJ-1, JJ + JN - J - 2{2DO 100 LL = JJ-1, JJ+KB-2}, JJADO 10 LL = JJA, JJA+JB-1, JNDO 90 LL = JJ-1, JJ + JN - J - 2, KBDO 20 LL = KK, KK+KB-1{2DO 40 LL = KK, KK+KB-1, 3DO 100 LL = JJ-1, JJ+KB-2}, KKDO 20 LL = KK, KK+KB-1{2DO 40 LL = KK, KK+KB-1}

LWMIN <--- MPLWMIN = MAX( 3, MP + NQ ) + NQ0 + NQ, NQLWMIN = MAX( 3, MP + NQ ) + NQ0 + NQ, NQ0LWMIN = MAX( 3, MP + NQ ) + NQ0 + NQ

MN <--- MMN = MIN( M, N ), NMN = MIN( M, N )

MP <--- IAROW, IROFF, M, MB_, MYROW, NPROW, NUMROC

NQ <--- IACOL, ICOFF, MYCOL, N, NB_, NPCOL, NUMROC

NQ0 <--- JA, CSRC_, MYCOL, N, NB_, NPCOL, NUMROC

PVT <--- JPVT = J

TEMP <--- IPNTEMP = ONE-( ABS( WORK( IPW+LL ) ) /{2TEMP = ONE-( ABS( WORK( IPW+LL ) ) /}, IPWTEMP = ONE-( ABS( WORK( IPW+LL ) ) /{2TEMP = ONE-( ABS( WORK( IPW+LL ) ) /}, LLTEMP = ONE-( ABS( WORK( IPW+LL ) ) /{2TEMP = ONE-( ABS( WORK( IPW+LL ) ) /}, ONETEMP = ONE-( ABS( WORK( IPW+LL ) ) /{2TEMP = ONE-( ABS( WORK( IPW+LL ) ) /}, TEMPTEMP = MAX( TEMP, ZERO ){2TEMP = MAX( TEMP, ZERO )}, WORKTEMP = ONE-( ABS( WORK( IPW+LL ) ) /{2TEMP = ONE-( ABS( WORK( IPW+LL ) ) /}, ZEROTEMP = MAX( TEMP, ZERO ){2TEMP = MAX( TEMP, ZERO )}

TEMP2 <--- IPNTEMP2 = ONE + 0.05D+0*TEMP*{2TEMP2 = ONE + 0.05D+0*TEMP*}, LLTEMP2 = ONE + 0.05D+0*TEMP*{2TEMP2 = ONE + 0.05D+0*TEMP*}, NQTEMP2 = ONE + 0.05D+0*TEMP*{2TEMP2 = ONE + 0.05D+0*TEMP*}, ONETEMP2 = ONE + 0.05D+0*TEMP*{2TEMP2 = ONE + 0.05D+0*TEMP*}, TEMPTEMP2 = ONE + 0.05D+0*TEMP*{2TEMP2 = ONE + 0.05D+0*TEMP*}, WORKTEMP2 = ONE + 0.05D+0*TEMP*{2TEMP2 = ONE + 0.05D+0*TEMP*}

WORK <--- IPIVWORK( IPW ) = DBLE( IPIV( JJ ) ), IPNWORK( IPN+JJPVT-1 ) = WORK( IPN+JJ-1 ){2, 3WORK( IPW+1 ) = WORK( IPN + JJ - 1 ), 4, 5WORK( IPN+NQ+LL ) = WORK( IPN+LL ), 6, 7WORK( IPN+NQ+LL ) = WORK( IPN+LL ), 8}, IPWWORK( IPN+JJPVT-1 ) = WORK( IPW+1 ){2WORK( IPN+NQ+JJPVT-1 ) = WORK( IPW+2 )}, JJWORK( NQ+JJ+KK ) = WORK( JJ+KK ){2WORK( NQ+JJ+KK ) = WORK( JJ+KK ), 3WORK( IPN+JJPVT-1 ) = WORK( IPN+JJ-1 ), 4, 5WORK( IPW ) = DBLE( IPIV( JJ ) ), 6WORK( IPW+1 ) = WORK( IPN + JJ - 1 ), 7}, KKWORK( NQ+JJ+KK ) = WORK( JJ+KK ){2WORK( NQ+JJ+KK ) = WORK( JJ+KK )}, LLWORK( IPN+NQ+LL ) = WORK( IPN+LL ){2, 3WORK( IPN+NQ+LL ) = WORK( IPN+LL ), 4}, LWMINWORK( 1 ) = DBLE( LWMIN ){2WORK( 1 ) = DBLE( LWMIN )}, NQ{2}, TEMP{2}, WORKWORK( NQ+JJ+KK ) = WORK( JJ+KK ){2WORK( NQ+JJ+KK ) = WORK( JJ+KK ), 3WORK( IPN+JJPVT-1 ) = WORK( IPN+JJ-1 ), 4, 5WORK( IPW+1 ) = WORK( IPN + JJ - 1 ), 6, 7WORK( IPN+JJPVT-1 ) = WORK( IPW+1 ), 8WORK( IPN+NQ+JJPVT-1 ) = WORK( IPW+2 ), 9WORK( IPN+NQ+LL ) = WORK( IPN+LL ), 10, 11WORK( IPN+NQ+LL ) = WORK( IPN+LL ), 12}, ZEROWORK( IPN+LL ) = ZERO{2WORK( IPN+NQ+LL ) = ZERO, 3WORK( IPN+LL ) = ZERO, 4WORK( IPN+NQ+LL ) = ZERO}

Analysis elements of the routine PDGEQPF()
Put the mouse over each element to display detailed matching information

Assigned variables
		AJJ , ALPHA , BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ , I , IACOL , IAROW , ICOFF , ICTXT , ICURCOL , IDUM1 , IDUM2 , INFO , IOFFA , IPN , IPW , IROFF , ITEMP , J , JB , JJ , JJPVT , JN , K , KB , KK , KSTART , KSTEP , LDA , LL , LLD_ , LQUERY , LWMIN , M_ , MB_ , MN , MP , N_ , NB_ , NQ , NQ0 , ONE , PVT , RSRC_ , TEMP , TEMP2 , WORK , ZERO

Active variables
		A , AJJ , ALPHA , BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DESCA , DESCN , DLEN_ , DTYPE_ , I , IA , IACOL , IAROW , ICEIL , ICOFF , ICTXT , ICURCOL , ICURROW , IDUM1 , IDUM2 , II , IIA , INDXG2P , INFO , IOFFA , IPCOL , IPIV , IPN , IPW , IROFF , ITEMP , J , JA , JB , JJ , JJA , JJPVT , JN , K , KB , KK , KSTART , KSTEP , LDA , LL , LLD_ , LQUERY , LWMIN , LWORK , M , M_ , MB_ , MN , MP , MYCOL , MYROW , N , N_ , NB_ , NPCOL , NPROW , NQ , NQ0 , NUMROC , ONE , PVT , RSRC_ , TAU , TEMP , TEMP2 , WORK , ZERO

Accessed arrays [ array name : associated index ]
	A	: I , ia+j-ja:ia+m-1,j+1:ja+n-1 , II+( MIN( JJA+NQ-1, JJ )-1 )LDA , IIA+(JJ-1)LDA , IIA+(JJ-1)LDA , IIA+(JJ-1)LDA , IIA+(JJPVT-1)LDA , IIA+(JJPVT-1)LDA , IIA+(JJPVT-1)*LDA , IOFFA , IOFFA , IOFFA , IOFFA+DESCA( LLD_ )
	DESCA	: CSRC_ , CSRC_ , CSRC_ , CSRC_ , CSRC_ , CTXT_ , LLD_ , LLD_ , LLD_ , LLD_ , LLD_ , M_ , MB_ , MB_ , MB_ , MB_ , N_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , RSRC_ , RSRC_
	DESCN	: DLEN_ , M_
	ICEIL	: J+1, DESCA( NB_ ) , JA, DESCA( NB_ )
	IDUM1	: 1 , 1 , 1
	IDUM2	: 1 , 1
	IPIV	: JJ , JJ , JJ , JJ , JJPVT , JJPVT , JJPVT , JJPVT , LL , LL , LL
	NUMROC	: M+IROFF, DESCA( MB_ ), MYROW, IAROW, NPROW , N+ICOFF, DESCA( NB_ ), MYCOL, IACOL, NPCOL
	TAU	: JJ , JJ , JJ , JJ
	WORK	: 1 , 1 , IPN + JJ - 1 , IPN + NQ + JJ - 1 , IPN , IPN+JJ-1 , IPN+JJPVT-1 , IPN+JJPVT-1 , IPN+LL , IPN+LL , IPN+LL , IPN+LL , IPN+LL , IPN+LL , IPN+LL , IPN+LL , IPN+LL , IPN+LL , IPN+LL , IPN+LL , IPN+LL , IPN+LL , IPN+NQ+JJ-1 , IPN+NQ+JJPVT-1 , IPN+NQ+JJPVT-1 , IPN+NQ+LL , IPN+NQ+LL , IPN+NQ+LL , IPN+NQ+LL , IPN+NQ+LL , IPN+NQ+LL , IPW , IPW , IPW , IPW , IPW , IPW+1 , IPW+1 , IPW+2 , IPW+2 , IPW+LL , IPW+LL , IPW+MIN( JJA+NQ-1, JJ )-1 , JJ+KK , JJ+KK , JJ+KK , JJ+KK , NQ+JJ+KK , NQ+JJ+KK

Conditional statements [ statement : associated predicate ]
	do	: `(` 10 LL = JJA , JJA + JB - 1 `)` , `(` 30 KK = JJA + JB , JJA + NQ - 1 , DESCA( NB_ ) `)` , `(` 20 LL = KK , KK + KB - 1 `)` , `(` 50 KK = JJA , JJA + NQ - 1 , DESCA( NB_ ) `)` , `(` 40 LL = KK , KK + KB - 1 `)` , `(` 60 KK = 0 , JB - 1 `)` , `(` 80 J = JN + 1 , JA + N - 1 , DESCA( NB_ ) `)` , `(` 70 KK = 0 , JB - 1 `)` , `(` 120 J = JA , JA + MN - 1 `)` , `(` 90 LL = JJ - 1 , JJ + JN - J - 2 `)` , `(` 110 K = JN + 1 , JA + N - 1 , DESCA( NB_ ) `)` , `(` 100 LL = JJ - 1 , JJ + KB - 2 `)`
	if	: `(` NPROW.EQ. - 1 `)` , `(` INFO.EQ.0 `)` , `(` LWORK.LT.LWMIN .AND. .NOT.LQUERY `)` , `(` LWORK.EQ. - 1 `)` , `(` INFO.NE.0 `)` , `(` LQUERY `)` , `(` possible `)` , `(` M.EQ.0 .OR. N.EQ.0 `)` , `(` MYROW.EQ.IAROW `)` , `(` MYCOL.EQ.IACOL `)` , `(` MYCOL.EQ.IACOL `)` , `(` MYCOL.EQ.IACOL `)` , `(` MYCOL.EQ.ICURCOL `)` , `(` K.GT.1 `)` , `(` J.NE.PVT `)` , `(` ICURCOL.EQ.IPCOL `)` , `(` MYCOL.EQ.ICURCOL `)` , `(` MYCOL.EQ.ICURCOL `)` , `(` MYCOL.EQ.IPCOL `)` , `(` (DESCA( M_ ).EQ.1 ) `)` , `(` MYROW.EQ.ICURROW `)` , `(` MYCOL.EQ.ICURCOL `)` , `(` N.GT.1 `)` , `(` N.GT.1 `)` , `(` MYCOL.EQ.ICURCOL `)` , `(` J.LT.JA + N - 1 `)` , `(` MYCOL.EQ.ICURCOL `)` , `(` (MOD( J , DESCA( NB_ ) ).EQ.0 ) `)` , `(` ((JJA+NQ - JJ).GT.0 ) `)` , `(` MYROW.EQ.ICURROW `)` , `(` MYCOL.EQ.ICURCOL `)` , `(` (WORK( IPN + LL ).NE.ZERO ) `)` , `(` TEMP2.EQ.ONE `)` , `(` IA+M-1.GT.I `)` , `(` MYCOL.EQ.ICURCOL `)` , `(` (WORK( IPN + LL ).NE.ZERO ) `)` , `(` TEMP2.EQ.ONE `)` , `(` IA+M-1.GT.I `)`