Routine: PZGETRF()  File: SRC\pzgetrf.f

 
 
# lines: 311
  # code: 311
  # comment: 0
  # blank:0
# Variables:38
# Callers:2
# Callings:2
# Words:155
# Keywords:93
 

 

 
..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PZGETRF computes an LU factorization of a general M-by-N distributed
  matrix sub( A ) = (IA:IA+M-1,JA:JA+N-1) using partial pivoting with
  row interchanges.
  The factorization has the form sub( A ) = P * L * U, where P is a
  permutation matrix, L is lower triangular with unit diagonal ele-
  ments (lower trapezoidal if m > n), and U is upper triangular
  (upper trapezoidal if m < n). L and U are stored in sub( A ).
  This is the right-looking Parallel Level 3 BLAS version of the
  algorithm.
  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
  This routine requires square block decomposition ( MB_A = 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*16 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 M-by-N
          distributed matrix sub( A ) to be factored. On exit, this
          array contains the local pieces of the factors L and U from
          the factorization sub( A ) = P*L*U; the unit diagonal ele-
          ments 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.
  IPIV    (local output) INTEGER array, dimension ( LOCr(M_A)+MB_A )
          This array contains the pivoting information.
          IPIV(i) -> The global row local row i was swapped with.
          This array is tied to the distributed matrix A.
  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.
          > 0:  If INFO = K, U(IA+K-1,JA+K-1) is exactly zero.
                The factorization has been completed, but the factor U
                is exactly singular, and division by zero will occur if
                it is used to solve a system of equations.
  =====================================================================
     .. Parameters ..
 
Display dynamic version Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

  
001        SUBROUTINE PZGETRF( M , N , A , IA , JA , DESCA , IPIV , INFO )
002  
003  *     -- ScaLAPACK routine(version 1.7) --
004  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
005  *     and University of California , Berkeley.
006  *     May 25 , 2001
007  
008  *     .. Scalar Arguments ..
009        INTEGER IA , INFO , JA , M , N
010        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
011       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
012        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
013       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
014       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
015        COMPLEX*16 ONE
016        PARAMETER( ONE = 1.0D + 0 )
017  *     ..
018  *     .. Local Scalars ..
019        CHARACTER COLBTOP , COLCTOP , ROWBTOP
020        INTEGER I , ICOFF , ICTXT , IINFO , IN , IROFF , J , JB , JN ,
021       $MN , MYCOL , MYROW , NPCOL , NPROW
022  *     ..
023  *     .. Local Arrays ..
024        INTEGER IDUM1( 1 ) , IDUM2( 1 )
025  *     ..
026  *     .. External Subroutines ..
027        EXTERNAL BLACS_GRIDINFO , CHK1MAT , IGAMN2D , PCHK1MAT ,
028       $PB_TOPGET , PB_TOPSET , PXERBLA , PZGEMM , PZGETF2 ,
029       $PZLASWP , PZTRSM
030  *     ..
031  *     .. External Functions ..
032        INTEGER ICEIL
033        EXTERNAL ICEIL
034  *     ..
035  *     .. Intrinsic Functions ..
036        INTRINSIC MIN , MOD
037  *     ..
038  *     .. Executable Statements ..
039  
040  *     Get grid parameters
041  
042        ICTXT = DESCA( CTXT_ )
043        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
044  
045  *     Test the input parameters
046  
047        INFO = 0
048        IF( NPROW.EQ. - 1 ) THEN
049            INFO = - (600 + CTXT_)
050        ELSE
051            CALL CHK1MAT( M , 1 , N , 2 , IA , JA , DESCA , 6 , INFO )
052            IF( INFO.EQ.0 ) THEN
053                IROFF = MOD( IA - 1 , DESCA( MB_ ) )
054                ICOFF = MOD( JA - 1 , DESCA( NB_ ) )
055                IF( IROFF.NE.0 ) THEN
056                    INFO = - 4
057                ELSE IF( ICOFF.NE.0 ) THEN
058                    INFO = - 5
059                ELSE IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN
060                    INFO = - (600 + NB_)
061                END IF
062            END IF
063            CALL PCHK1MAT( M , 1 , N , 2 , IA , JA , DESCA , 6 , 0 , IDUM1 ,
064       $    IDUM2 , INFO )
065        END IF
066  
067        IF( INFO.NE.0 ) THEN
068            CALL PXERBLA( ICTXT , 'PZGETRF' , - INFO )
069            RETURN
070        END IF
071  
072  *     Quick return if possible
073  
074        IF( DESCA( M_ ).EQ.1 ) THEN
075            IPIV( 1 ) = 1
076            RETURN
077        ELSE IF( M.EQ.0 .OR. N.EQ.0 ) THEN
078            RETURN
079        END IF
080  
081  *     Split - ring topology for the communication along process rows
082  
083        CALL PB_TOPGET( ICTXT , 'Broadcast' , 'Rowwise' , ROWBTOP )
084        CALL PB_TOPGET( ICTXT , 'Broadcast' , 'Columnwise' , COLBTOP )
085        CALL PB_TOPGET( ICTXT , 'Combine' , 'Columnwise' , COLCTOP )
086        CALL PB_TOPSET( ICTXT , 'Broadcast' , 'Rowwise' , 'S - ring' )
087        CALL PB_TOPSET( ICTXT , 'Broadcast' , 'Columnwise' , ' ' )
088        CALL PB_TOPSET( ICTXT , 'Combine' , 'Columnwise' , ' ' )
089  
090  *     Handle the first block of columns separately
091  
092        MN = MIN( M , N )
093        IN = MIN( ICEIL( IA , DESCA( MB_ ) )*DESCA( MB_ ) , IA + M - 1 )
094        JN = MIN( ICEIL( JA , DESCA( NB_ ) )*DESCA( NB_ ) , JA + MN - 1 )
095        JB = JN - JA + 1
096  
097  *     Factor diagonal and subdiagonal blocks and test for exact
098  *     singularity.
099  
100        CALL PZGETF2 ( M , JB , A , IA , JA , DESCA , IPIV , INFO )
101  
102        IF( JB + 1.LE.N ) THEN
103  
104  *         Apply interchanges to columns JN + 1 : JA + N - 1.
105  
106            CALL PZLASWP ( 'Forward' , 'Rows' , N - JB , A , IA , JN + 1 , DESCA ,
107       $    IA , IN , IPIV )
108  
109  *         Compute block row of U.
110  
111            CALL PZTRSM( 'Left' , 'Lower' , 'No transpose' , 'Unit' , JB ,
112       $    N - JB , ONE , A , IA , JA , DESCA , A , IA , JN + 1 , DESCA )
113  
114            IF( JB + 1.LE.M ) THEN
115  
116  *             Update trailing submatrix.
117  
118                CALL PZGEMM( 'No transpose' , 'No transpose' , M - JB , N - JB , JB ,
119       $        - ONE , A , IN + 1 , JA , DESCA , A , IA , JN + 1 , DESCA ,
120       $        ONE , A , IN + 1 , JN + 1 , DESCA )
121  
122            END IF
123        END IF
124  
125  *     Loop over the remaining blocks of columns.
126  
127        DO 10 J = JN + 1 , JA + MN - 1 , DESCA( NB_ )
128            JB = MIN( MN - J + JA , DESCA( NB_ ) )
129            I = IA + J - JA
130  
131  *         Factor diagonal and subdiagonal blocks and test for exact
132  *         singularity.
133  
134            CALL PZGETF2 ( M - J + JA , JB , A , I , J , DESCA , IPIV , IINFO )
135  
136            IF( INFO.EQ.0 .AND. IINFO.GT.0 )
137       $        INFO = IINFO + J - JA
138  
139  *             Apply interchanges to columns JA : J - JA.
140  
141                CALL PZLASWP ( 'Forward' , 'Rowwise' , J - JA , A , IA , JA , DESCA ,
142       $        I , I + JB - 1 , IPIV )
143  
144                IF( J - JA + JB + 1.LE.N ) THEN
145  
146  *                 Apply interchanges to columns J + JB : JA + N - 1.
147  
148                    CALL PZLASWP ( 'Forward' , 'Rowwise' , N - J - JB + JA , A , IA , J + JB ,
149       $            DESCA , I , I + JB - 1 , IPIV )
150  
151  *                 Compute block row of U.
152  
153                    CALL PZTRSM( 'Left' , 'Lower' , 'No transpose' , 'Unit' , JB ,
154       $            N - J - JB + JA , ONE , A , I , J , DESCA , A , I , J + JB ,
155       $            DESCA )
156  
157                    IF( J - JA + JB + 1.LE.M ) THEN
158  
159  *                     Update trailing submatrix.
160  
161                        CALL PZGEMM( 'No transpose' , 'No transpose' , M - J - JB + JA ,
162       $                N - J - JB + JA , JB , - ONE , A , I + JB , J , DESCA , A ,
163       $                I , J + JB , DESCA , ONE , A , I + JB , J + JB , DESCA )
164  
165                    END IF
166                END IF
167  
168     10 CONTINUE
169  
170        IF( INFO.EQ.0 )
171       $    INFO = MN + 1
172            CALL IGAMN2D( ICTXT , 'Rowwise' , ' ' , 1 , 1 , INFO , 1 , IDUM1 , IDUM2 ,
173       $    - 1 , - 1 , MYCOL )
174            IF( INFO.EQ.MN + 1 )
175       $        INFO = 0
176  
177                CALL PB_TOPSET( ICTXT , 'Broadcast' , 'Rowwise' , ROWBTOP )
178                CALL PB_TOPSET( ICTXT , 'Broadcast' , 'Columnwise' , COLBTOP )
179                CALL PB_TOPSET( ICTXT , 'Combine' , 'Columnwise' , COLCTOP )
180  
181                RETURN
182  
183  *             End of PZGETRF
184  
185            END