Routine PCGEQPF() Documented By Universal Report

Routine: PCGEQPF()

# lines:	565
# code:	565
# comment:	0
# blank:	0
# Variables:	72
# Callers:	0
# Callings:	2
# Words:	392
# Keywords:	229

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PCGEQPF 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) COMPLEX 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 unitary 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) COMPLEX, 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) COMPLEX 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).
          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.
  RWORK   (local workspace/local output) REAL array,
                                                 dimension (LRWORK)
          On exit, RWORK(1) returns the minimal and optimal LRWORK.
  LRWORK  (local or global input) INTEGER
          The dimension of the array RWORK.
          LRWORK is local input and must be at least
          LRWORK >= 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 LRWORK = -1, then LRWORK 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 complex scalar, and v is a complex 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 PCGEQPF( M , N , A , IA , JA , DESCA , IPIV , TAU , WORK ,
002       $LWORK , RWORK , LRWORK , 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 , LRWORK , 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        REAL ONE , ZERO
017        PARAMETER( ONE = 1.0E + 0 , ZERO = 0.0E + 0 )
018  *     ..
019  *     .. Local Scalars ..
020        LOGICAL LQUERY
021        INTEGER I , IACOL , IAROW , ICOFF , ICTXT , ICURROW ,
022       $ICURCOL , II , IIA , IOFFA , IPCOL , IROFF , ITEMP ,
023       $J , JB , JJ , JJA , JJPVT , JN , KB , K , KK , KSTART ,
024       $KSTEP , LDA , LL , LRWMIN , LWMIN , MN , MP , MYCOL ,
025       $MYROW , NPCOL , NPROW , NQ , NQ0 , PVT
026        REAL TEMP , TEMP2
027        COMPLEX AJJ , ALPHA
028  *     ..
029  *     .. Local Arrays ..
030        INTEGER DESCN( DLEN_ ) , IDUM1( 2 ) , IDUM2( 2 )
031  *     ..
032  *     .. External Subroutines ..
033        EXTERNAL BLACS_GRIDINFO , CCOPY , CGEBR2D , CGEBS2D ,
034       $CGERV2D , CGESD2D , CHK1MAT , CLARFG ,
035       $CSWAP , DESCSET , IGERV2D , IGESD2D , INFOG1L ,
036       $INFOG2L , PCELSET , PCHK1MAT , PCLARFC ,
037       $PCLARFG , PSAMAX , PSCNRM2 , PXERBLA
038  *     ..
039  *     .. External Functions ..
040        INTEGER ICEIL , INDXG2P , NUMROC
041        EXTERNAL ICEIL , INDXG2P , NUMROC
042  *     ..
043  *     .. Intrinsic Functions ..
044        INTRINSIC ABS , CMPLX , CONJG , IFIX , 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 )
072                LRWMIN = NQ0 + NQ
073  
074                WORK( 1 ) = CMPLX( REAL( LWMIN ) )
075                RWORK( 1 ) = REAL( LRWMIN )
076                LQUERY =( LWORK.EQ. - 1 .OR. LRWORK.EQ. - 1 )
077                IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
077                       
078                    INFO = - 10
079                ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN
079                       
080                    INFO = - 12
081                END IF
082            END IF
083            IF( LWORK.EQ. - 1 ) THEN
083                   
084                IDUM1( 1 ) = - 1
085            ELSE
085                   
086                IDUM1( 1 ) = 1
087            END IF
088            IDUM2( 1 ) = 10
089            IF( LRWORK.EQ. - 1 ) THEN
089                   
090                IDUM1( 2 ) = - 1
091            ELSE
091                   
092                IDUM1( 2 ) = 1
093            END IF
094            IDUM2( 2 ) = 12
095            CALL PCHK1MAT( M , 1 , N , 2 , IA , JA , DESCA , 6 , 2 , IDUM1 , IDUM2 ,
096       $    INFO )
097        END IF
098  
099        IF( INFO.NE.0 ) THEN
099               
100            CALL PXERBLA( ICTXT , 'PCGEQPF' , - INFO )
101            RETURN
102        ELSE IF( LQUERY ) THEN
102               
103            RETURN
104        END IF
105  
106  *     Quick return if possible
107  
108        IF( M.EQ.0 .OR. N.EQ.0 )
108               
109       $    RETURN
110  
111            CALL INFOG2L( IA , JA , DESCA , NPROW , NPCOL , MYROW , MYCOL , IIA , JJA ,
112       $    IAROW , IACOL )
113            IF( MYROW.EQ.IAROW )
113                   
114       $        MP = MP - IROFF
115                IF( MYCOL.EQ.IACOL )
115                       
116       $            NQ = NQ - ICOFF
117                    MN = MIN( M , N )
118  
119  *                 Initialize the array of pivots
120  
121                    LDA = DESCA( LLD_ )
122                    JN = MIN( ICEIL( JA , DESCA( NB_ ) ) * DESCA( NB_ ) , JA + N - 1 )
123                    KSTEP = NPCOL * DESCA( NB_ )
124  
125                    IF( MYCOL.EQ.IACOL ) THEN
126  
127  *                     Handle first block separately
128  
128                           
129                        JB = JN - JA + 1
130                        DO 10 LL = JJA , JJA + JB - 1
130                               
131                            IPIV( LL ) = JA + LL - JJA
132     10                 CONTINUE
132                           
133                        KSTART = JN + KSTEP - DESCA( NB_ )
134  
135  *                     Loop over remaining block of columns
136  
137                        DO 30 KK = JJA + JB , JJA + NQ - 1 , DESCA( NB_ )
137                               
138                            KB = MIN( JJA + NQ - KK , DESCA( NB_ ) )
139                            DO 20 LL = KK , KK + KB - 1
139                                   
140                                IPIV( LL ) = KSTART + LL - KK + 1
141     20                     CONTINUE
141                               
142                            KSTART = KSTART + KSTEP
143     30                 CONTINUE
143                       
144                    ELSE
144                           
145                        KSTART = JN + ( MOD( MYCOL - IACOL + NPCOL , NPCOL ) - 1 )*
146       $                DESCA( NB_ )
147                        DO 50 KK = JJA , JJA + NQ - 1 , DESCA( NB_ )
147                               
148                            KB = MIN( JJA + NQ - KK , DESCA( NB_ ) )
149                            DO 40 LL = KK , KK + KB - 1
149                                   
150                                IPIV( LL ) = KSTART + LL - KK + 1
151     40                     CONTINUE
151                               
152                            KSTART = KSTART + KSTEP
153     50                 CONTINUE
153                       
154                    END IF
155  
156  *                 Initialize partial column norms , handle first block separately
157  
158                    CALL DESCSET( DESCN , 1 , DESCA( N_ ) , 1 , DESCA( NB_ ) , MYROW ,
159       $            DESCA( CSRC_ ) , ICTXT , 1 )
160  
161                    JJ = JJA
162                    IF( MYCOL.EQ.IACOL ) THEN
162                           
163                        DO 60 KK = 0 , JB - 1
163                               
164                            CALL PSCNRM2( M , RWORK( JJ + KK ) , A , IA , JA + KK , DESCA , 1 )
165                            RWORK( NQ + JJ + KK ) = RWORK( JJ + KK )
166     60                 CONTINUE
166                           
167                        JJ = JJ + JB
168                    END IF
169                    ICURCOL = MOD( IACOL + 1 , NPCOL )
170  
171  *                 Loop over the remaining blocks of columns
172  
173                    DO 80 J = JN + 1 , JA + N - 1 , DESCA( NB_ )
173                           
174                        JB = MIN( JA + N - J , DESCA( NB_ ) )
175  
176                        IF( MYCOL.EQ.ICURCOL ) THEN
176                               
177                            DO 70 KK = 0 , JB - 1
177                                   
178                                CALL PSCNRM2( M , RWORK( JJ + KK ) , A , IA , J + KK , DESCA , 1 )
179                                RWORK( NQ + JJ + KK ) = RWORK( JJ + KK )
180     70                     CONTINUE
180                               
181                            JJ = JJ + JB
182                        END IF
183                        ICURCOL = MOD( ICURCOL + 1 , NPCOL )
184     80             CONTINUE
185  
186  *                 Compute factorization
187  
187                       
188                    DO 120 J = JA , JA + MN - 1
188                           
189                        I = IA + J - JA
190  
191                        CALL INFOG1L( J , DESCA( NB_ ) , NPCOL , MYCOL , DESCA( CSRC_ ) ,
192       $                JJ , ICURCOL )
193                        K = JA + N - J
194                        IF( K.GT.1 ) THEN
194                               
195                            CALL PSAMAX( K , TEMP , PVT , RWORK , 1 , J , DESCN ,
196       $                    DESCN( M_ ) )
197                        ELSE
197                               
198                            PVT = J
199                        END IF
200                        IF( J.NE.PVT ) THEN
200                               
201                            CALL INFOG1L( PVT , DESCA( NB_ ) , NPCOL , MYCOL ,
202       $                    DESCA( CSRC_ ) , JJPVT , IPCOL )
203                            IF( ICURCOL.EQ.IPCOL ) THEN
203                                   
204                                IF( MYCOL.EQ.ICURCOL ) THEN
204                                       
205                                    CALL CSWAP( MP , A( IIA + (JJ - 1)*LDA ) , 1 ,
206       $                            A( IIA + (JJPVT - 1)*LDA ) , 1 )
207                                    ITEMP = IPIV( JJPVT )
208                                    IPIV( JJPVT ) = IPIV( JJ )
209                                    IPIV( JJ ) = ITEMP
210                                    RWORK( JJPVT ) = RWORK( JJ )
211                                    RWORK( NQ + JJPVT ) = RWORK( NQ + JJ )
212                                END IF
213                            ELSE
213                                   
214                                IF( MYCOL.EQ.ICURCOL ) THEN
215  
215                                       
216                                    CALL CGESD2D( ICTXT , MP , 1 , A( IIA + (JJ - 1)*LDA ) , LDA ,
217       $                            MYROW , IPCOL )
218                                    WORK( 1 ) = CMPLX( REAL( IPIV( JJ ) ) )
219                                    WORK( 2 ) = CMPLX( RWORK( JJ ) )
220                                    WORK( 3 ) = CMPLX( RWORK( JJ + NQ ) )
221                                    CALL CGESD2D( ICTXT , 3 , 1 , WORK , 3 , MYROW , IPCOL )
222  
223                                    CALL CGERV2D( ICTXT , MP , 1 , A( IIA + (JJ - 1)*LDA ) , LDA ,
224       $                            MYROW , IPCOL )
225                                    CALL IGERV2D( ICTXT , 1 , 1 , IPIV( JJ ) , 1 , MYROW ,
226       $                            IPCOL )
227  
228                                ELSE IF( MYCOL.EQ.IPCOL ) THEN
229  
229                                       
230                                    CALL CGESD2D( ICTXT , MP , 1 , A( IIA + (JJPVT - 1)*LDA ) ,
231       $                            LDA , MYROW , ICURCOL )
232                                    CALL IGESD2D( ICTXT , 1 , 1 , IPIV( JJPVT ) , 1 , MYROW ,
233       $                            ICURCOL )
234  
235                                    CALL CGERV2D( ICTXT , MP , 1 , A( IIA + (JJPVT - 1)*LDA ) ,
236       $                            LDA , MYROW , ICURCOL )
237                                    CALL CGERV2D( ICTXT , 3 , 1 , WORK , 3 , MYROW , ICURCOL )
238                                    IPIV( JJPVT ) = IFIX( REAL( WORK( 1 ) ) )
239                                    RWORK( JJPVT ) = REAL( WORK( 2 ) )
240                                    RWORK( JJPVT + NQ ) = REAL( WORK( 3 ) )
241  
242                                END IF
243  
244                            END IF
245  
246                        END IF
247  
248  *                     Generate elementary reflector H(i)
249  
250                        CALL INFOG1L( I , DESCA( MB_ ) , NPROW , MYROW , DESCA( RSRC_ ) ,
251       $                II , ICURROW )
252                        IF( DESCA( M_ ).EQ.1 ) THEN
252                               
253                            IF( MYROW.EQ.ICURROW ) THEN
253                                   
254                                IF( MYCOL.EQ.ICURCOL ) THEN
254                                       
255                                    IOFFA = II + (JJ - 1)*DESCA( LLD_ )
256                                    AJJ = A( IOFFA )
257                                    CALL CLARFG( 1 , AJJ , A( IOFFA ) , 1 , TAU( JJ ) )
258                                    IF( N.GT.1 ) THEN
258                                           
259                                        ALPHA = CMPLX( ONE ) - CONJG( TAU( JJ ) )
260                                        CALL CGEBS2D( ICTXT , 'Rowwise' , ' ' , 1 , 1 , ALPHA ,
261       $                                1 )
262                                        CALL CSCAL( NQ - JJ , ALPHA , A( IOFFA + DESCA( LLD_ ) ) ,
263       $                                DESCA( LLD_ ) )
264                                    END IF
265                                    CALL CGEBS2D( ICTXT , 'Columnwise' , ' ' , 1 , 1 ,
266       $                            TAU( JJ ) , 1 )
267                                    A( IOFFA ) = AJJ
268                                ELSE
268                                       
269                                    IF( N.GT.1 ) THEN
269                                           
270                                        CALL CGEBR2D( ICTXT , 'Rowwise' , ' ' , 1 , 1 , ALPHA ,
271       $                                1 , ICURROW , ICURCOL )
272                                        CALL CSCAL( NQ - JJ + 1 , ALPHA , A( I ) , DESCA( LLD_ ) )
273                                    END IF
274                                END IF
275                            ELSE IF( MYCOL.EQ.ICURCOL ) THEN
275                                   
276                                CALL CGEBR2D( ICTXT , 'Columnwise' , ' ' , 1 , 1 , TAU( JJ ) ,
277       $                        1 , ICURROW , ICURCOL )
278                            END IF
279  
280                        ELSE
281  
281                               
282                            CALL PCLARFG ( M - J + JA , AJJ , I , J , A , MIN( I + 1 , IA + M - 1 ) , J ,
283       $                    DESCA , 1 , TAU )
284                            IF( J.LT.JA + N - 1 ) THEN
285  
286  *                             Apply H(i) to A(ia + j - ja : ia + m - 1 , j + 1 : ja + n - 1) from the left
287  
287                                   
288                                CALL PCELSET( A , I , J , DESCA , CMPLX( ONE ) )
289                                CALL PCLARFC ( 'Left' , M - J + JA , JA + N - 1 - J , A , I , J , DESCA ,
290       $                        1 , TAU , A , I , J + 1 , DESCA , WORK )
291                            END IF
292                            CALL PCELSET( A , I , J , DESCA , AJJ )
293  
294                        END IF
295  
296  *                     Update partial columns norms
297  
298                        IF( MYCOL.EQ.ICURCOL )
298                               
299       $                    JJ = JJ + 1
300                            IF( MOD( J , DESCA( NB_ ) ).EQ.0 )
300                                   
301       $                        ICURCOL = MOD( ICURCOL + 1 , NPCOL )
302                                IF((JJA + NQ - JJ).GT.0 ) THEN
302                                       
303                                    IF( MYROW.EQ.ICURROW ) THEN
303                                           
304                                        CALL CGEBS2D( ICTXT , 'Columnwise' , ' ' , 1 , JJA + NQ - JJ ,
305       $                                A( II + ( MIN( JJA + NQ - 1 , JJ ) - 1 )*LDA ) ,
306       $                                LDA )
307                                        CALL CCOPY( JJA + NQ - JJ , A( II + ( MIN( JJA + NQ - 1 , JJ )
308       $                                - 1)*LDA ) , LDA , WORK( MIN( JJA + NQ - 1 , JJ ) ) ,
309       $                                1 )
310                                    ELSE
310                                           
311                                        CALL CGEBR2D( ICTXT , 'Columnwise' , ' ' , JJA + NQ - JJ , 1 ,
312       $                                WORK( MIN( JJA + NQ - 1 , JJ ) ) , MAX( 1 , NQ ) ,
313       $                                ICURROW , MYCOL )
314                                    END IF
315                                END IF
316  
317                                JN = MIN( ICEIL( J + 1 , DESCA( NB_ ) ) * DESCA( NB_ ) ,
318       $                        JA + N - 1 )
319                                IF( MYCOL.EQ.ICURCOL ) THEN
319                                       
320                                    DO 90 LL = JJ , JJ + JN - J - 1
320                                           
321                                        IF( RWORK( LL ).NE.ZERO ) THEN
321                                               
322                                            TEMP = ONE - ( ABS( WORK( LL ) ) / RWORK( LL ) )**2
323                                            TEMP = MAX( TEMP , ZERO )
324                                            TEMP2 = ONE + 0.05E + 0*TEMP*
325       $( RWORK( LL ) / RWORK( NQ + LL ) )**2
325                                               
326                                            IF( TEMP2.EQ.ONE ) THEN
326                                                   
327                                                IF( IA + M - 1.GT.I ) THEN
327                                                       
328                                                    CALL PSCNRM2( IA + M - I - 1 , RWORK( LL ) , A ,
329       $                                            I + 1 , J + LL - JJ , DESCA , 1 )
330                                                    RWORK( NQ + LL ) = RWORK( LL )
331                                                ELSE
331                                                       
332                                                    RWORK( LL ) = ZERO
333                                                    RWORK( NQ + LL ) = ZERO
334                                                END IF
335                                            ELSE
335                                                   
336                                                RWORK( LL ) = RWORK( LL ) * SQRT( TEMP )
337                                            END IF
338                                        END IF
339     90                             CONTINUE
339                                       
340                                    JJ = JJ + JN - J
341                                END IF
342                                ICURCOL = MOD( ICURCOL + 1 , NPCOL )
343  
344                                DO 110 K = JN + 1 , JA + N - 1 , DESCA( NB_ )
344                                       
345                                    KB = MIN( JA + N - K , DESCA( NB_ ) )
346  
347                                    IF( MYCOL.EQ.ICURCOL ) THEN
347                                           
348                                        DO 100 LL = JJ , JJ + KB - 1
348                                               
349                                            IF( RWORK(LL).NE.ZERO ) THEN
349                                                   
350                                                TEMP = ONE - ( ABS( WORK( LL ) ) / RWORK( LL ) )**2
351                                                TEMP = MAX( TEMP , ZERO )
352                                                TEMP2 = ONE + 0.05E + 0*TEMP*
353       $( RWORK( LL ) / RWORK( NQ + LL ) )**2
353                                                   
354                                                IF( TEMP2.EQ.ONE ) THEN
354                                                       
355                                                    IF( IA + M - 1.GT.I ) THEN
355                                                           
356                                                        CALL PSCNRM2( IA + M - I - 1 , RWORK( LL ) , A ,
357       $                                                I + 1 , K + LL - JJ , DESCA , 1 )
358                                                        RWORK( NQ + LL ) = RWORK( LL )
359                                                    ELSE
359                                                           
360                                                        RWORK( LL ) = ZERO
361                                                        RWORK( NQ + LL ) = ZERO
362                                                    END IF
363                                                ELSE
363                                                       
364                                                    RWORK( LL ) = RWORK( LL ) * SQRT( TEMP )
365                                                END IF
366                                            END IF
367    100                                 CONTINUE
367                                           
368                                        JJ = JJ + KB
369                                    END IF
370                                    ICURCOL = MOD( ICURCOL + 1 , NPCOL )
371  
372    110                         CONTINUE
373  
374    120             CONTINUE
375  
375                       
376                    WORK( 1 ) = CMPLX( REAL( LWMIN ) )
377                    RWORK( 1 ) = REAL( LRWMIN )
378  
379                    RETURN
380  
381  *                 End of PCGEQPF
382  
383                END3053

Variables in Routine PCGEQPF()

Summary Report
Data Type	Quantity	Size(byte)
COMPLEX	2	8
INTEGER	62	260
LOGICAL	1	1
REAL	7	28
TOTAL	72	297

List of Variables

COMPLEX

AJJ ALPHA

INTEGER

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

LOGICAL

LQUERY

REAL

A ONE RWORK TEMP TEMP2
WORK ZERO

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 <--- JJ, ONE

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 ), 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}, WORK

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 <--- JJJ = JJ + JN - J, JBJJ = JJ + JB{2JJ = JJ + JB}, JJJJ = JJ + JB{2JJ = JJ + JB, 3JJ = JJ + JN - J, 4JJ = JJ + KB}, JJAJJ = JJA, 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, JJ + JN - J - 1, JBDO 10 LL = JJA, JJA+JB-1, JJDO 90 LL = JJ, JJ + JN - J - 1{2DO 100 LL = JJ, JJ+KB-1}, JJADO 10 LL = JJA, JJA+JB-1, JNDO 90 LL = JJ, JJ + JN - J - 1, KBDO 20 LL = KK, KK+KB-1{2DO 40 LL = KK, KK+KB-1, 3DO 100 LL = JJ, JJ+KB-1}, KKDO 20 LL = KK, KK+KB-1{2DO 40 LL = KK, KK+KB-1}

LRWMIN <--- NQLRWMIN = NQ0 + NQ, NQ0LRWMIN = NQ0 + NQ

LWMIN <--- MPLWMIN = MAX( 3, MP + NQ ), NQLWMIN = MAX( 3, MP + 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

RWORK <--- JJRWORK( NQ+JJ+KK ) = RWORK( JJ+KK ){2RWORK( NQ+JJ+KK ) = RWORK( JJ+KK ), 3RWORK( JJPVT ) = RWORK( JJ ), 4RWORK( NQ+JJPVT ) = RWORK( NQ+JJ )}, KKRWORK( NQ+JJ+KK ) = RWORK( JJ+KK ){2RWORK( NQ+JJ+KK ) = RWORK( JJ+KK )}, LLRWORK( NQ+LL ) = RWORK( LL ){2, 3RWORK( NQ+LL ) = RWORK( LL ), 4}, LRWMINRWORK( 1 ) = REAL( LRWMIN ){2RWORK( 1 ) = REAL( LRWMIN )}, NQRWORK( NQ+JJPVT ) = RWORK( NQ+JJ ), RWORKRWORK( NQ+JJ+KK ) = RWORK( JJ+KK ){2RWORK( NQ+JJ+KK ) = RWORK( JJ+KK ), 3RWORK( JJPVT ) = RWORK( JJ ), 4RWORK( NQ+JJPVT ) = RWORK( NQ+JJ ), 5RWORK( NQ+LL ) = RWORK( LL ), 6, 7RWORK( NQ+LL ) = RWORK( LL ), 8}, TEMP{2}, WORKRWORK( JJPVT ) = REAL( WORK( 2 ) ){2RWORK( JJPVT+NQ ) = REAL( WORK( 3 ) )}, ZERORWORK( LL ) = ZERO{2RWORK( NQ+LL ) = ZERO, 3RWORK( LL ) = ZERO, 4RWORK( NQ+LL ) = ZERO}

TEMP <--- LL{2}, ONE{2}, RWORK{2}, TEMPTEMP = MAX( TEMP, ZERO ){2TEMP = MAX( TEMP, ZERO )}, WORK{2}, ZEROTEMP = MAX( TEMP, ZERO ){2TEMP = MAX( TEMP, ZERO )}

TEMP2 <--- LLTEMP2 = ONE + 0.05E+0*TEMP*{2TEMP2 = ONE + 0.05E+0*TEMP*}, NQTEMP2 = ONE + 0.05E+0*TEMP*{2TEMP2 = ONE + 0.05E+0*TEMP*}, ONETEMP2 = ONE + 0.05E+0*TEMP*{2TEMP2 = ONE + 0.05E+0*TEMP*}, RWORKTEMP2 = ONE + 0.05E+0*TEMP*{2TEMP2 = ONE + 0.05E+0*TEMP*}, TEMPTEMP2 = ONE + 0.05E+0*TEMP*{2TEMP2 = ONE + 0.05E+0*TEMP*}

WORK <--- IPIVWORK( 1 ) = CMPLX( REAL( IPIV( JJ ) ) ), JJWORK( 1 ) = CMPLX( REAL( IPIV( JJ ) ) ){2WORK( 2 ) = CMPLX( RWORK( JJ ) ), 3WORK( 3 ) = CMPLX( RWORK( JJ + NQ ) )}, LWMINWORK( 1 ) = CMPLX( REAL( LWMIN ) ){2WORK( 1 ) = CMPLX( REAL( LWMIN ) )}, NQWORK( 3 ) = CMPLX( RWORK( JJ + NQ ) ), RWORKWORK( 2 ) = CMPLX( RWORK( JJ ) ){2WORK( 3 ) = CMPLX( RWORK( JJ + NQ ) )}

Analysis elements of the routine PCGEQPF()
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 , IROFF , ITEMP , J , JB , JJ , JJPVT , JN , K , KB , KK , KSTART , KSTEP , LDA , LL , LLD_ , LQUERY , LRWMIN , LWMIN , M_ , MB_ , MN , MP , N_ , NB_ , NQ , NQ0 , ONE , PVT , RSRC_ , RWORK , 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 , IROFF , ITEMP , J , JA , JB , JJ , JJA , JJPVT , JN , K , KB , KK , KSTART , KSTEP , LDA , LL , LLD_ , LQUERY , LRWMIN , LRWORK , LWMIN , LWORK , M , M_ , MB_ , MN , MP , MYCOL , MYROW , N , N_ , NB_ , NPCOL , NPROW , NQ , NQ0 , NUMROC , ONE , PVT , RSRC_ , RWORK , 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 , 2 , 2 , 2
	IDUM2	: 1 , 2 , 2
	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
	RWORK	: 1 , 1 , JJ + NQ , JJ , JJ , JJ+KK , JJ+KK , JJ+KK , JJ+KK , JJPVT , JJPVT , JJPVT+NQ , LL , LL , LL , LL , LL , LL , LL , LL , LL , LL , LL , LL , LL , LL , NQ+JJ , NQ+JJ+KK , NQ+JJ+KK , NQ+JJPVT , NQ+LL , NQ+LL , NQ+LL , NQ+LL , NQ+LL , NQ+LL
	TAU	: JJ , JJ , JJ , JJ
	WORK	: 1 , 1 , 1 , 1 , 2 , 2 , 3 , 3 , LL , LL , MIN( JJA+NQ-1, JJ ) , MIN( JJA+NQ-1, JJ )

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 , JJ + JN - J - 1 `)` , `(` 110 K = JN + 1 , JA + N - 1 , DESCA( NB_ ) `)` , `(` 100 LL = JJ , JJ + KB - 1 `)`
	if	: `(` NPROW.EQ. - 1 `)` , `(` INFO.EQ.0 `)` , `(` LWORK.LT.LWMIN .AND. .NOT.LQUERY `)` , `(` LRWORK.LT.LRWMIN .AND. .NOT.LQUERY `)` , `(` LWORK.EQ. - 1 `)` , `(` LRWORK.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 `)` , `(` (RWORK( LL ).NE.ZERO ) `)` , `(` TEMP2.EQ.ONE `)` , `(` IA+M-1.GT.I `)` , `(` MYCOL.EQ.ICURCOL `)` , `(` (RWORK(LL).NE.ZERO ) `)` , `(` TEMP2.EQ.ONE `)` , `(` IA+M-1.GT.I `)`