Routine PSGECON() Documented By Universal Report

Routine: PSGECON()

File: SRC\psgecon.f

# lines:	413
# code:	413
# comment:	0
# blank:	0
# Variables:	74
# Callers:	1
# Callings:	4
# Words:	230
# Keywords:	146

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PSGECON estimates the reciprocal of the condition number of a general
  distributed real matrix A(IA:IA+N-1,JA:JA+N-1), in either the 1-norm
  or the infinity-norm, using the LU factorization computed by PSGETRF.
  An estimate is obtained for norm(inv(A(IA:IA+N-1,JA:JA+N-1))), and
  the reciprocal of the condition number is computed as
             RCOND = 1 / ( norm( A(IA:IA+N-1,JA:JA+N-1)      ) *
                           norm( inv(A(IA:IA+N-1,JA:JA+N-1)) ) ).
  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
  =========
  NORM    (global input) CHARACTER
          Specifies whether the 1-norm condition number or the
          infinity-norm condition number is required:
          = '1' or 'O':  1-norm
          = 'I':         Infinity-norm
  N       (global input) INTEGER
          The order of the distributed matrix A(IA:IA+N-1,JA:JA+N-1).
          N >= 0.
  A       (local input) REAL pointer into the local memory
          to an array of dimension ( LLD_A, LOCc(JA+N-1) ). On entry,
          this array contains the local pieces of the factors L and U
          from the factorization A(IA:IA+N-1,JA:JA+N-1) = P*L*U; the
          unit diagonal elements of L are not stored.
  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.
  ANORM   (global input) REAL
          If NORM = '1' or 'O', the 1-norm of the original distributed
          matrix A(IA:IA+N-1,JA:JA+N-1).
          If NORM = 'I', the infinity-norm of the original distributed
          matrix A(IA:IA+N-1,JA:JA+N-1).
  RCOND   (global output) REAL
          The reciprocal of the condition number of the distributed
          matrix A(IA:IA+N-1,JA:JA+N-1), computed as
             RCOND = 1 / ( norm( A(IA:IA+N-1,JA:JA+N-1)      ) *
                           norm( inv(A(IA:IA+N-1,JA:JA+N-1)) ) ).
  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 >= 2*LOCr(N+MOD(IA-1,MB_A)) + 2*LOCc(N+MOD(JA-1,NB_A))
          + MAX( 2, MAX( NB_A*MAX( 1, CEIL(NPROW-1,NPCOL) ),
                         LOCc(N+MOD(JA-1,NB_A)) +
                         NB_A*MAX( 1, CEIL(NPCOL-1,NPROW) ) ).
          LOCr and LOCc values can be computed using the ScaLAPACK
          tool function NUMROC; 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.
  IWORK   (local workspace/local output) INTEGER array,
                                                  dimension (LIWORK)
          On exit, IWORK(1) returns the minimal and optimal LIWORK.
  LIWORK  (local or global input) INTEGER
          The dimension of the array IWORK.
          LIWORK is local input and must be at least
          LIWORK >= LOCr(N+MOD(IA-1,MB_A)).
          If LIWORK = -1, then LIWORK 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.
  =====================================================================
     .. Parameters ..

Display dynamic version

FontSize: - +

001        SUBROUTINE PSGECON( NORM , N , A , IA , JA , DESCA , ANORM , RCOND , WORK ,
002       $LWORK , IWORK , LIWORK , INFO )
003  
004  *     -- ScaLAPACK routine(version 1.7) --
005  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
006  *     and University of California , Berkeley.
007  *     May 25 , 2001
008  
009  *     .. Scalar Arguments ..
010        CHARACTER NORM
011        INTEGER IA , INFO , JA , LIWORK , LWORK , N
012        REAL ANORM , RCOND
013        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
014       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
015        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
016       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
017       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
018        REAL ONE , ZERO
019        PARAMETER( ONE = 1.0E + 0 , ZERO = 0.0E + 0 )
020  *     ..
021  *     .. Local Scalars ..
022        LOGICAL LQUERY , ONENRM
023        CHARACTER CBTOP , COLCTOP , NORMIN , ROWCTOP
024        INTEGER IACOL , IAROW , ICOFF , ICTXT , IIA , IPNL , IPNU ,
025       $IPV , IPW , IPX , IROFF , IV , IX , IXX , JJA , JV , JX ,
026       $KASE , KASE1 , LIWMIN , LWMIN , MYCOL , MYROW , NP ,
027       $NPCOL , NPMOD , NPROW , NQ , NQMOD
028        REAL AINVNM , SCALE , SL , SMLNUM , SU , WMAX
029  *     ..
030  *     .. Local Arrays ..
031        INTEGER DESCV( DLEN_ ) , DESCX( DLEN_ ) , IDUM1( 3 ) ,
032       $IDUM2( 3 )
033  *     ..
034  *     .. External Subroutines ..
035        EXTERNAL BLACS_GRIDINFO , CHK1MAT , DESCSET , INFOG2L ,
036       $PCHK1MAT , PSAMAX , PSLATRS , PSLACON ,
037       $PSRSCL , PB_TOPGET , PB_TOPSET , PXERBLA , SGEBR2D ,
038       $SGEBS2D
039  *     ..
040  *     .. External Functions ..
041        LOGICAL LSAME
042        INTEGER ICEIL , INDXG2P , NUMROC
043        REAL PSLAMCH
044        EXTERNAL ICEIL , INDXG2P , LSAME , NUMROC , PSLAMCH
045  *     ..
046  *     .. Intrinsic Functions ..
047        INTRINSIC ABS , ICHAR , MAX , MOD , REAL
048  *     ..
049  *     .. Executable Statements ..
050  
051  *     Get grid parameters
052  
053        ICTXT = DESCA( CTXT_ )
054        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
055  
056  *     Test the input parameters
057  
058        INFO = 0
059        IF( NPROW.EQ. - 1 ) THEN
059               
060            INFO = - ( 600 + CTXT_ )
061        ELSE
061               
062            CALL CHK1MAT( N , 2 , N , 2 , IA , JA , DESCA , 6 , INFO )
063            IF( INFO.EQ.0 ) THEN
063                   
064                ONENRM = NORM.EQ.'1' .OR. LSAME( NORM , 'O' )
065                IAROW = INDXG2P( IA , DESCA( MB_ ) , MYROW , DESCA( RSRC_ ) ,
066       $        NPROW )
067                IACOL = INDXG2P( JA , DESCA( NB_ ) , MYCOL , DESCA( CSRC_ ) ,
068       $        NPCOL )
069                NPMOD = NUMROC( N + MOD( IA - 1 , DESCA( MB_ ) ) , DESCA( MB_ ) ,
070       $        MYROW , IAROW , NPROW )
071                NQMOD = NUMROC( N + MOD( JA - 1 , DESCA( NB_ ) ) , DESCA( NB_ ) ,
072       $        MYCOL , IACOL , NPCOL )
073                LWMIN = 2*NPMOD + 2*NQMOD +
074       $        MAX( 2 , MAX( DESCA( NB_ )*
075       $        MAX( 1 , ICEIL( NPROW - 1 , NPCOL ) ) , NQMOD +
076       $        DESCA( NB_ )*
077       $        MAX( 1 , ICEIL( NPCOL - 1 , NPROW ) ) ) )
078                WORK( 1 ) = REAL( LWMIN )
079                LIWMIN = NPMOD
080                IWORK( 1 ) = LIWMIN
081                LQUERY =( LWORK.EQ. - 1 .OR. LIWORK.EQ. - 1 )
082  
083                IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM , 'I' ) ) THEN
083                       
084                    INFO = - 1
085                ELSE IF( ANORM.LT.ZERO ) THEN
085                       
086                    INFO = - 7
087                ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
087                       
088                    INFO = - 10
089                ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
089                       
090                    INFO = - 12
091                END IF
092            END IF
093  
094            IF( ONENRM ) THEN
094                   
095                IDUM1( 1 ) = ICHAR( '1' )
096            ELSE
096                   
097                IDUM1( 1 ) = ICHAR( 'I' )
098            END IF
099            IDUM2( 1 ) = 1
100            IF( LWORK.EQ. - 1 ) THEN
100                   
101                IDUM1( 2 ) = - 1
102            ELSE
102                   
103                IDUM1( 2 ) = 1
104            END IF
105            IDUM2( 2 ) = 10
106            IF( LIWORK.EQ. - 1 ) THEN
106                   
107                IDUM1( 3 ) = - 1
108            ELSE
108                   
109                IDUM1( 3 ) = 1
110            END IF
111            IDUM2( 3 ) = 12
112            CALL PCHK1MAT( N , 2 , N , 2 , IA , JA , DESCA , 6 , 3 , IDUM1 , IDUM2 ,
113       $    INFO )
114        END IF
115  
116        IF( INFO.NE.0 ) THEN
116               
117            CALL PXERBLA( ICTXT , 'PSGECON' , - INFO )
118            RETURN
119        ELSE IF( LQUERY ) THEN
119               
120            RETURN
121        END IF
122  
123  *     Quick return if possible
124  
125        RCOND = ZERO
126        IF( N.EQ.0 ) THEN
126               
127            RCOND = ONE
128            RETURN
129        ELSE IF( ANORM.EQ.ZERO ) THEN
129               
130            RETURN
131        ELSE IF( N.EQ.1 ) THEN
131               
132            RCOND = ONE
133            RETURN
134        END IF
135  
136        CALL PB_TOPGET( ICTXT , 'Combine' , 'Columnwise' , COLCTOP )
137        CALL PB_TOPGET( ICTXT , 'Combine' , 'Rowwise' , ROWCTOP )
138        CALL PB_TOPSET( ICTXT , 'Combine' , 'Columnwise' , '1 - tree' )
139        CALL PB_TOPSET( ICTXT , 'Combine' , 'Rowwise' , '1 - tree' )
140  
141        SMLNUM = PSLAMCH( ICTXT , 'Safe minimum' )
142        IROFF = MOD( IA - 1 , DESCA( MB_ ) )
143        ICOFF = MOD( JA - 1 , DESCA( NB_ ) )
144        CALL INFOG2L( IA , JA , DESCA , NPROW , NPCOL , MYROW , MYCOL , IIA , JJA ,
145       $IAROW , IACOL )
146        NP = NUMROC( N + IROFF , DESCA( MB_ ) , MYROW , IAROW , NPROW )
147        NQ = NUMROC( N + ICOFF , DESCA( NB_ ) , MYCOL , IACOL , NPCOL )
148        IV = IROFF + 1
149        IX = IV
150        JV = ICOFF + 1
151        JX = JV
152  
153        IPX = 1
154        IPV = IPX + NP
155        IPNL = IPV + NP
156        IPNU = IPNL + NQ
157        IPW = IPNU + NQ
158  
159        CALL DESCSET( DESCV , N + IROFF , 1 , DESCA( MB_ ) , 1 , IAROW , MYCOL ,
160       $ICTXT , MAX( 1 , NP ) )
161        CALL DESCSET( DESCX , N + IROFF , 1 , DESCA( MB_ ) , 1 , IAROW , MYCOL ,
162       $ICTXT , MAX( 1 , NP ) )
163  
164  *     Estimate the norm of inv(A).
165  
166        AINVNM = ZERO
167        NORMIN = 'N'
168        IF( ONENRM ) THEN
168               
169            KASE1 = 1
170        ELSE
170               
171            KASE1 = 2
172        END IF
173        KASE = 0
174  
175     10 CONTINUE
176        CALL PSLACON ( N , WORK( IPV ) , IV , JV , DESCV , WORK( IPX ) , IX , JX ,
177       $DESCX , IWORK , AINVNM , KASE )
178        IF( KASE.NE.0 ) THEN
178               
179            IF( KASE.EQ.KASE1 ) THEN
180  
181  *             Multiply by inv(L).
182  
182                   
183                DESCX( CSRC_ ) = IACOL
184                CALL PSLATRS ( 'Lower' , 'No transpose' , 'Unit' , NORMIN ,
185       $        N , A , IA , JA , DESCA , WORK( IPX ) , IX , JX ,
186       $        DESCX , SL , WORK( IPNL ) , WORK( IPW ) )
187                DESCX( CSRC_ ) = MYCOL
188  
189  *             Multiply by inv(U).
190  
191                DESCX( CSRC_ ) = IACOL
192                CALL PSLATRS ( 'Upper' , 'No transpose' , 'Non - unit' , NORMIN ,
193       $        N , A , IA , JA , DESCA , WORK( IPX ) , IX , JX ,
194       $        DESCX , SU , WORK( IPNU ) , WORK( IPW ) )
195                DESCX( CSRC_ ) = MYCOL
196            ELSE
197  
198  *             Multiply by inv(U').
199  
199                   
200                DESCX( CSRC_ ) = IACOL
201                CALL PSLATRS ( 'Upper' , 'Transpose' , 'Non - unit' , NORMIN ,
202       $        N , A , IA , JA , DESCA , WORK( IPX ) , IX , JX ,
203       $        DESCX , SU , WORK( IPNU ) , WORK( IPW ) )
204                DESCX( CSRC_ ) = MYCOL
205  
206  *             Multiply by inv(L').
207  
208                DESCX( CSRC_ ) = IACOL
209                CALL PSLATRS ( 'Lower' , 'Transpose' , 'Unit' , NORMIN ,
210       $        N , A , IA , JA , DESCA , WORK( IPX ) , IX , JX ,
211       $        DESCX , SL , WORK( IPNL ) , WORK( IPW ) )
212                DESCX( CSRC_ ) = MYCOL
213            END IF
214  
215  *         Divide X by 1 / (SL*SU) if doing so will not cause overflow.
216  
217            SCALE = SL*SU
218            NORMIN = 'Y'
219            IF( SCALE.NE.ONE ) THEN
219                   
220                CALL PSAMAX( N , WMAX , IXX , WORK( IPX ) , IX , JX , DESCX , 1 )
221                IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
221                       
222                    CALL PB_TOPGET( ICTXT , 'Broadcast' , 'Columnwise' , CBTOP )
223                    IF( MYROW.EQ.IAROW ) THEN
223                           
224                        CALL SGEBS2D( ICTXT , 'Column' , CBTOP , 1 , 1 , WMAX , 1 )
225                    ELSE
225                           
226                        CALL SGEBR2D( ICTXT , 'Column' , CBTOP , 1 , 1 , WMAX , 1 ,
227       $                IAROW , MYCOL )
228                    END IF
229                END IF
230                IF( SCALE.LT.ABS( WMAX )*SMLNUM .OR. SCALE.EQ.ZERO )
230                       
231       $            GO TO 20
232                    CALL PSRSCL ( N , SCALE , WORK( IPX ) , IX , JX , DESCX , 1 )
233                END IF
234                GO TO 10
235            END IF
236  
237  *         Compute the estimate of the reciprocal condition number.
238  
239            IF( AINVNM.NE.ZERO )
239                   
240       $        RCOND =( ONE / AINVNM ) / ANORM
241  
242     20 CONTINUE
243  
244        CALL PB_TOPSET( ICTXT , 'Combine' , 'Columnwise' , COLCTOP )
245        CALL PB_TOPSET( ICTXT , 'Combine' , 'Rowwise' , ROWCTOP )
246  
247        RETURN
248  
249  *     End of PSGECON
250  
251        END2835

Variables in Routine PSGECON()

Summary Report
Data Type	Quantity	Size(byte)
CHARACTER	5	5
INTEGER	54	236
LOGICAL	3	3
REAL	12	48
TOTAL	74	292

List of Variables

CHARACTER

CBTOP COLCTOP NORM NORMIN ROWCTOP

INTEGER

BLOCK_CYCLIC_2D CSRC_ CTXT_ DESCV( DLEN_ ) DESCX( DLEN_ )
DLEN_ DTYPE_ IA IACOL IAROW
ICEIL ICOFF ICTXT IDUM1( 3 ) IDUM2( 3 )
IIA INDXG2P INFO IPNL IPNU
IPV IPW IPX IROFF IV
IWORK IX IXX JA JJA
JV JX KASE KASE1 LIWMIN
LIWORK LLD_ LWMIN LWORK M_
MB_ MYCOL MYROW N N_
NB_ NP NPCOL NPMOD NPROW
NQ NQMOD NUMROC RSRC_

LOGICAL

LQUERY LSAME ONENRM

REAL

AINVNM ANORM ONE PSLAMCH RCOND
SCALE SL SMLNUM SU WMAX
WORK ZERO

Variables Dependence Graph
Put the mouse over a right hand side variable to display the corresponding line of the dependence
-
- -
AINVNM <--- ZEROAINVNM = ZERO

DESCX <--- IACOLDESCX( CSRC_ ) = IACOL{2DESCX( CSRC_ ) = IACOL, 3DESCX( CSRC_ ) = IACOL, 4DESCX( CSRC_ ) = IACOL}, MYCOLDESCX( CSRC_ ) = MYCOL{2DESCX( CSRC_ ) = MYCOL, 3DESCX( CSRC_ ) = MYCOL, 4DESCX( CSRC_ ) = MYCOL}

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

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_ )

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

IPNL <--- IPVIPNL = IPV + NP, NPIPNL = IPV + NP

IPNU <--- IPNLIPNU = IPNL + NQ, NQIPNU = IPNL + NQ

IPV <--- IPXIPV = IPX + NP, NPIPV = IPX + NP

IPW <--- IPNUIPW = IPNU + NQ, NQIPW = IPNU + NQ

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

IV <--- IROFFIV = IROFF + 1

IWORK <--- LIWMINIWORK( 1 ) = LIWMIN

IX <--- IVIX = IV

JV <--- ICOFFJV = ICOFF + 1

JX <--- JVJX = JV

LIWMIN <--- NPMODLIWMIN = NPMOD

LWMIN <--- ICEILLWMIN = 2*NPMOD + 2*NQMOD +, NB_LWMIN = 2*NPMOD + 2*NQMOD +, NPCOLLWMIN = 2*NPMOD + 2*NQMOD +, NPMODLWMIN = 2*NPMOD + 2*NQMOD +, NPROWLWMIN = 2*NPMOD + 2*NQMOD +, NQMODLWMIN = 2*NPMOD + 2*NQMOD +

NORMIN <--- NNORMIN = 'N'

NP <--- IAROW, IROFF, MB_, MYROW, N, NPROW, NUMROC

NPMOD <--- IA, IAROW, MB_, MYROW, N, NPROW, NUMROC

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

NQMOD <--- IACOL, JA, MYCOL, N, NB_, NPCOL, NUMROC

ONENRM <--- LSAME, NORM

RCOND <--- ONERCOND = ONE{2RCOND = ONE}, ZERORCOND = ZERO

SCALE <--- SLSCALE = SL*SU, SUSCALE = SL*SU

SMLNUM <--- ICTXT, PSLAMCH

WORK <--- LWMINWORK( 1 ) = REAL( LWMIN )