Routine: PZPOTRF()  File: SRC\pzpotrf.f

 
 
# lines: 363
  # code: 363
  # comment: 0
  # blank:0
# Variables:36
# Callers:3
# Callings:1
# Words:187
# Keywords:119
 

 

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PZPOTRF computes the Cholesky factorization of an N-by-N complex
  hermitian positive definite distributed matrix sub( A ) denoting
  A(IA:IA+N-1, JA:JA+N-1).
  The factorization has the form
            sub( A ) = U' * U ,  if UPLO = 'U', or
            sub( A ) = L  * L',  if UPLO = 'L',
  where U is an upper triangular matrix and L is lower triangular.
  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
  =========
  UPLO    (global input) CHARACTER
          = 'U':  Upper triangle of sub( A ) is stored;
          = 'L':  Lower triangle of sub( A ) is stored.
  N       (global input) INTEGER
          The number of rows and columns to be operated on, i.e. the
          order 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
          N-by-N Hermitian distributed matrix sub( A ) to be factored.
          If UPLO = 'U', the leading N-by-N upper triangular part of
          sub( A ) contains the upper triangular part of the matrix,
          and its strictly lower triangular part is not referenced.
          If UPLO = 'L', the leading N-by-N lower triangular part of
          sub( A ) contains the lower triangular part of the distribu-
          ted matrix, and its strictly upper triangular part is not
          referenced. On exit, if UPLO = 'U', the upper triangular
          part of the distributed matrix contains the Cholesky factor
          U, if UPLO = 'L', the lower triangular part of the distribu-
          ted matrix contains the Cholesky factor L.
  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.
  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, the leading minor of order K,
                A(IA:IA+K-1,JA:JA+K-1) is not positive definite, and
                the factorization could not be completed.
  =====================================================================
     .. Parameters ..

 
Display dynamic version Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

 
001        SUBROUTINE PZPOTRF( UPLO , N , A , IA , JA , DESCA , 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        CHARACTER UPLO
010        INTEGER IA , INFO , JA , N
011        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
012       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
013        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
014       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
015       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
016        DOUBLE PRECISION ONE
017        PARAMETER( ONE = 1.0D + 0 )
018        COMPLEX*16 CONE
019        PARAMETER( CONE =( 1.0D + 0 , 0.0D + 0 ) )
020  *     ..
021  *     .. Local Scalars ..
022        LOGICAL UPPER
023        CHARACTER COLBTOP , ROWBTOP
024        INTEGER I , ICOFF , ICTXT , IROFF , J , JB , JN , MYCOL ,
025       $MYROW , NPCOL , NPROW
026  *     ..
027  *     .. Local Arrays ..
028        INTEGER IDUM1( 1 ) , IDUM2( 1 )
029  *     ..
030  *     .. External Subroutines ..
031        EXTERNAL BLACS_GRIDINFO , CHK1MAT , PCHK1MAT , PB_TOPGET ,
032       $PB_TOPSET , PXERBLA , PZPOTF2 , PZHERK ,
033       $PZTRSM
034  *     ..
035  *     .. External Functions ..
036        LOGICAL LSAME
037        INTEGER ICEIL
038        EXTERNAL ICEIL , LSAME
039  *     ..
040  *     .. Intrinsic Functions ..
041        INTRINSIC ICHAR , MIN , MOD
042  *     ..
043  *     .. Executable Statements ..
044  
045  *     Get grid parameters
046  
047        ICTXT = DESCA( CTXT_ )
048        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
049  
050  *     Test the input parameters
051  
052        INFO = 0
053        IF( NPROW.EQ. - 1 ) THEN
054            INFO = - (600 + CTXT_)
055        ELSE
056            CALL CHK1MAT( N , 2 , N , 2 , IA , JA , DESCA , 6 , INFO )
057            UPPER = LSAME( UPLO , 'U' )
058            IF( INFO.EQ.0 ) THEN
059                IROFF = MOD( IA - 1 , DESCA( MB_ ) )
060                ICOFF = MOD( JA - 1 , DESCA( NB_ ) )
061                IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO , 'L' ) ) THEN
062                    INFO = - 1
063                ELSE IF( IROFF.NE.0 ) THEN
064                    INFO = - 4
065                ELSE IF( ICOFF.NE.0 ) THEN
066                    INFO = - 5
067                ELSE IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN
068                    INFO = - (600 + NB_)
069                END IF
070            END IF
071            IF( UPPER ) THEN
072                IDUM1( 1 ) = ICHAR( 'U' )
073            ELSE
074                IDUM1( 1 ) = ICHAR( 'L' )
075            END IF
076            IDUM2( 1 ) = 1
077            CALL PCHK1MAT( N , 2 , N , 2 , IA , JA , DESCA , 6 , 1 , IDUM1 , IDUM2 ,
078       $    INFO )
079        END IF
080  
081        IF( INFO.NE.0 ) THEN
082            CALL PXERBLA( ICTXT , 'PZPOTRF' , - INFO )
083            RETURN
084        END IF
085  
086  *     Quick return if possible
087  
088        IF( N.EQ.0 )
089       $    RETURN
090  
091            CALL PB_TOPGET( ICTXT , 'Broadcast' , 'Rowwise' , ROWBTOP )
092            CALL PB_TOPGET( ICTXT , 'Broadcast' , 'Columnwise' , COLBTOP )
093  
094            IF( UPPER ) THEN
095  
096  *             Split - ring topology for the communication along process
097  *             columns , 1 - tree topology along process rows.
098  
099                CALL PB_TOPSET( ICTXT , 'Broadcast' , 'Rowwise' , ' ' )
100                CALL PB_TOPSET( ICTXT , 'Broadcast' , 'Columnwise' , 'S - ring' )
101  
102  *             A is upper triangular , compute Cholesky factorization A = U'*U.
103  
104  *             Handle the first block of columns separately
105  
106                JN = MIN( ICEIL( JA , DESCA( NB_ ) )*DESCA(NB_) , JA + N - 1 )
107                JB = JN - JA + 1
108  
109  *             Perform unblocked Cholesky factorization on JB block
110  
111                CALL PZPOTF2 ( UPLO , JB , A , IA , JA , DESCA , INFO )
112                IF( INFO.NE.0 )
113       $            GO TO 30
114  
115                    IF( JB + 1.LE.N ) THEN
116  
117  *                     Form the row panel of U using the triangular solver
118  
119                        CALL PZTRSM( 'Left' , UPLO , 'Conjugate transpose' ,
120       $                'Non - Unit' , JB , N - JB , CONE , A , IA , JA , DESCA ,
121       $                A , IA , JA + JB , DESCA )
122  
123  *                     Update the trailing matrix , A = A - U'*U
124  
125                        CALL PZHERK( UPLO , 'Conjugate transpose' , N - JB , JB , - ONE , A ,
126       $                IA , JA + JB , DESCA , ONE , A , IA + JB , JA + JB , DESCA )
127                    END IF
128  
129  *                 Loop over remaining block of columns
130  
131                    DO 10 J = JN + 1 , JA + N - 1 , DESCA( NB_ )
132                        JB = MIN( N - J + JA , DESCA( NB_ ) )
133                        I = IA + J - JA
134  
135  *                     Perform unblocked Cholesky factorization on JB block
136  
137                        CALL PZPOTF2 ( UPLO , JB , A , I , J , DESCA , INFO )
138                        IF( INFO.NE.0 ) THEN
139                            INFO = INFO + J - JA
140                            GO TO 30
141                        END IF
142  
143                        IF( J - JA + JB + 1.LE.N ) THEN
144  
145  *                         Form the row panel of U using the triangular solver
146  
147                            CALL PZTRSM( 'Left' , UPLO , 'Conjugate transpose' ,
148       $                    'Non - Unit' , JB , N - J - JB + JA , CONE , A , I , J ,
149       $                    DESCA , A , I , J + JB , DESCA )
150  
151  *                         Update the trailing matrix , A = A - U'*U
152  
153                            CALL PZHERK( UPLO , 'Conjugate transpose' , N - J - JB + JA , JB ,
154       $                    - ONE , A , I , J + JB , DESCA , ONE , A , I + JB ,
155       $                    J + JB , DESCA )
156                        END IF
157     10             CONTINUE
158  
159                ELSE
160  
161  *                 1 - tree topology for the communication along process columns ,
162  *                 Split - ring topology along process rows.
163  
164                    CALL PB_TOPSET( ICTXT , 'Broadcast' , 'Rowwise' , 'S - ring' )
165                    CALL PB_TOPSET( ICTXT , 'Broadcast' , 'Columnwise' , ' ' )
166  
167  *                 A is lower triangular , compute Cholesky factorization A = L*L'
168  *                 (right - looking)
169  
170  *                 Handle the first block of columns separately
171  
172                    JN = MIN( ICEIL( JA , DESCA( NB_ ) )*DESCA( NB_ ) , JA + N - 1 )
173                    JB = JN - JA + 1
174  
175  *                 Perform unblocked Cholesky factorization on JB block
176  
177                    CALL PZPOTF2 ( UPLO , JB , A , IA , JA , DESCA , INFO )
178                    IF( INFO.NE.0 )
179       $                GO TO 30
180  
181                        IF( JB + 1.LE.N ) THEN
182  
183  *                         Form the column panel of L using the triangular solver
184  
185                            CALL PZTRSM( 'Right' , UPLO , 'Conjugate transpose' ,
186       $                    'Non - Unit' , N - JB , JB , CONE , A , IA , JA , DESCA ,
187       $                    A , IA + JB , JA , DESCA )
188  
189  *                         Update the trailing matrix , A = A - L*L'
190  
191                            CALL PZHERK( UPLO , 'No Transpose' , N - JB , JB , - ONE , A , IA + JB ,
192       $                    JA , DESCA , ONE , A , IA + JB , JA + JB , DESCA )
193  
194                        END IF
195  
196                        DO 20 J = JN + 1 , JA + N - 1 , DESCA( NB_ )
197                            JB = MIN( N - J + JA , DESCA( NB_ ) )
198                            I = IA + J - JA
199  
200  *                         Perform unblocked Cholesky factorization on JB block
201  
202                            CALL PZPOTF2 ( UPLO , JB , A , I , J , DESCA , INFO )
203                            IF( INFO.NE.0 ) THEN
204                                INFO = INFO + J - JA
205                                GO TO 30
206                            END IF
207  
208                            IF( J - JA + JB + 1.LE.N ) THEN
209  
210  *                             Form the column panel of L using the triangular solver
211  
212                                CALL PZTRSM( 'Right' , UPLO , 'Conjugate transpose' ,
213       $                        'Non - Unit' , N - J - JB + JA , JB , CONE , A , I , J ,
214       $                        DESCA , A , I + JB , J , DESCA )
215  
216  *                             Update the trailing matrix , A = A - L*L'
217  
218                                CALL PZHERK( UPLO , 'No Transpose' , N - J - JB + JA , JB , - ONE ,
219       $                        A , I + JB , J , DESCA , ONE , A , I + JB , J + JB ,
220       $                        DESCA )
221  
222                            END IF
223     20                 CONTINUE
224  
225                    END IF
226  
227     30 CONTINUE
228  
229        CALL PB_TOPSET( ICTXT , 'Broadcast' , 'Rowwise' , ROWBTOP )
230        CALL PB_TOPSET( ICTXT , 'Broadcast' , 'Columnwise' , COLBTOP )
231  
232        RETURN
233  
234  *     End of PZPOTRF
235  
236        END