Routine PSGEQPF() Documented By Universal Report

Routine: PSGEQPF()

# lines:	541
# code:	541
# comment:	0
# blank:	0
# Variables:	71
# Callers:	0
# Callings:	2
# Words:	360
# Keywords:	215

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

Variables in Routine PSGEQPF()

Summary Report
Data Type	Quantity	Size(byte)
INTEGER	62	252
LOGICAL	1	1
REAL	8	32
TOTAL	71	285

List of Variables

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 AJJ ALPHA ONE 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 <--- 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 ) = IFIX( 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 ) = IFIX( 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.05E+0*TEMP*{2TEMP2 = ONE + 0.05E+0*TEMP*}, 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*}, TEMPTEMP2 = ONE + 0.05E+0*TEMP*{2TEMP2 = ONE + 0.05E+0*TEMP*}, WORKTEMP2 = ONE + 0.05E+0*TEMP*{2TEMP2 = ONE + 0.05E+0*TEMP*}

WORK <--- IPIVWORK( IPW ) = REAL( 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 ) = REAL( 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 ) = REAL( LWMIN ){2WORK( 1 ) = REAL( 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 PSGEQPF()
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 `)`