Routine: PZGETRS()  File: SRC\pzgetrs.f

 
 
# lines: 291
  # code: 291
  # comment: 0
  # blank:0
# Variables:37
# Callers:3
# Callings:1
# Words:128
# Keywords:83
 

 

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PZGETRS solves a system of distributed linear equations
                   op( sub( A ) ) * X = sub( B )
  with a general N-by-N distributed matrix sub( A ) using the LU
  factorization computed by PZGETRF.
  sub( A ) denotes A(IA:IA+N-1,JA:JA+N-1), op( A ) = A, A**T or A**H
  and sub( B ) denotes B(IB:IB+N-1,JB:JB+NRHS-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
  This routine requires square block data decomposition ( MB_A=NB_A ).
  Arguments
  =========
  TRANS   (global input) CHARACTER
          Specifies the form of the system of equations:
          = 'N':  sub( A )    * X = sub( B )  (No transpose)
          = 'T':  sub( A )**T * X = sub( B )  (Transpose)
          = 'C':  sub( A )**H * X = sub( B )  (Conjugate transpose)
  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.
  NRHS    (global input) INTEGER
          The number of right hand sides, i.e., the number of columns
          of the distributed submatrix sub( B ). NRHS >= 0.
  A       (local input) 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 factors
          L and U from the factorization sub( A ) = 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.
  IPIV    (local input) 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.
  B       (local input/local output) COMPLEX*16 pointer into the
          local memory to an array of dimension
          (LLD_B,LOCc(JB+NRHS-1)).  On entry, the right hand sides
          sub( B ). On exit, sub( B ) is overwritten by the solution
          distributed matrix X.
  IB      (global input) INTEGER
          The row index in the global array B indicating the first
          row of sub( B ).
  JB      (global input) INTEGER
          The column index in the global array B indicating the
          first column of sub( B ).
  DESCB   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix B.
  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 Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

 
001        SUBROUTINE PZGETRS( TRANS , N , NRHS , A , IA , JA , DESCA , IPIV , B ,
002       $IB , JB , DESCB , 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 1 , 1997
008  
009  *     .. Scalar Arguments ..
010        CHARACTER TRANS
011        INTEGER IA , IB , INFO , JA , JB , N , NRHS
012        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
013       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
014        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
015       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
016       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
017        COMPLEX*16 ONE
018        PARAMETER( ONE = 1.0D + 0 )
019  *     ..
020  *     .. Local Scalars ..
021        LOGICAL NOTRAN
022        INTEGER IAROW , IBROW , ICOFFA , ICTXT , IROFFA , IROFFB ,
023       $MYCOL , MYROW , NPCOL , NPROW
024  *     ..
025  *     .. Local Arrays ..
026        INTEGER DESCIP( DLEN_ ) , IDUM1( 1 ) , IDUM2( 1 )
027  *     ..
028  *     .. External Subroutines ..
029        EXTERNAL BLACS_GRIDINFO , CHK1MAT , DESCSET , PCHK2MAT ,
030       $PXERBLA , PZLAPIV , PZTRSM
031  *     ..
032  *     .. External Functions ..
033        LOGICAL LSAME
034        INTEGER INDXG2P , NUMROC
035        EXTERNAL INDXG2P , LSAME , NUMROC
036  *     ..
037  *     .. Intrinsic Functions ..
038        INTRINSIC ICHAR , MOD
039  *     ..
040  *     .. Executable Statements ..
041  
042  *     Get grid parameters
043  
044        ICTXT = DESCA( CTXT_ )
045        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
046  
047  *     Test the input parameters
048  
049        INFO = 0
050        IF( NPROW.EQ. - 1 ) THEN
051            INFO = - (700 + CTXT_)
052        ELSE
053            NOTRAN = LSAME( TRANS , 'N' )
054            CALL CHK1MAT( N , 2 , N , 2 , IA , JA , DESCA , 7 , INFO )
055            CALL CHK1MAT( N , 2 , NRHS , 3 , IB , JB , DESCB , 12 , INFO )
056            IF( INFO.EQ.0 ) THEN
057                IAROW = INDXG2P( IA , DESCA( MB_ ) , MYROW , DESCA( RSRC_ ) ,
058       $        NPROW )
059                IBROW = INDXG2P( IB , DESCB( MB_ ) , MYROW , DESCB( RSRC_ ) ,
060       $        NPROW )
061                IROFFA = MOD( IA - 1 , DESCA( MB_ ) )
062                ICOFFA = MOD( JA - 1 , DESCA( NB_ ) )
063                IROFFB = MOD( IB - 1 , DESCB( MB_ ) )
064                IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS , 'T' ) .AND. .NOT.
065       $        LSAME( TRANS , 'C' ) ) THEN
066                INFO = - 1
067            ELSE IF( IROFFA.NE.0 ) THEN
068                INFO = - 5
069            ELSE IF( ICOFFA.NE.0 ) THEN
070                INFO = - 6
071            ELSE IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN
072                INFO = - (700 + NB_)
073            ELSE IF( IROFFB.NE.0 .OR. IBROW.NE.IAROW ) THEN
074                INFO = - 10
075            ELSE IF( DESCB( MB_ ).NE.DESCA( NB_ ) ) THEN
076                INFO = - (1200 + NB_)
077            ELSE IF( ICTXT.NE.DESCB( CTXT_ ) ) THEN
078                INFO = - (1200 + CTXT_)
079            END IF
080        END IF
081        IF( NOTRAN ) THEN
082            IDUM1( 1 ) = ICHAR( 'N' )
083        ELSE IF( LSAME( TRANS , 'T' ) ) THEN
084            IDUM1( 1 ) = ICHAR( 'T' )
085        ELSE
086            IDUM1( 1 ) = ICHAR( 'C' )
087        END IF
088        IDUM2( 1 ) = 1
089        CALL PCHK2MAT( N , 2 , N , 2 , IA , JA , DESCA , 7 , N , 2 , NRHS , 3 ,
090       $IB , JB , DESCB , 12 , 1 , IDUM1 , IDUM2 , INFO )
091        END IF
092  
093        IF( INFO.NE.0 ) THEN
094            CALL PXERBLA( ICTXT , 'PZGETRS' , - INFO )
095            RETURN
096        END IF
097  
098  *     Quick return if possible
099  
100        IF( N.EQ.0 .OR. NRHS.EQ.0 )
101       $    RETURN
102  
103            CALL DESCSET( DESCIP , DESCA( M_ ) + DESCA( MB_ )*NPROW , 1 ,
104       $    DESCA( MB_ ) , 1 , DESCA( RSRC_ ) , MYCOL , ICTXT ,
105       $    DESCA( MB_ ) + NUMROC( DESCA( M_ ) , DESCA( MB_ ) ,
106       $    MYROW , DESCA( RSRC_ ) , NPROW ) )
107  
108            IF( NOTRAN ) THEN
109  
110  *             Solve sub( A ) * X = sub( B ).
111  
112  *             Apply row interchanges to the right hand sides.
113  
114                CALL PZLAPIV ( 'Forward' , 'Row' , 'Col' , N , NRHS , B , IB , JB ,
115       $        DESCB , IPIV , IA , 1 , DESCIP , IDUM1 )
116  
117  *             Solve L*X = sub( B ) , overwriting sub( B ) with X.
118  
119                CALL PZTRSM( 'Left' , 'Lower' , 'No transpose' , 'Unit' , N , NRHS ,
120       $        ONE , A , IA , JA , DESCA , B , IB , JB , DESCB )
121  
122  *             Solve U*X = sub( B ) , overwriting sub( B ) with X.
123  
124                CALL PZTRSM( 'Left' , 'Upper' , 'No transpose' , 'Non - unit' , N ,
125       $        NRHS , ONE , A , IA , JA , DESCA , B , IB , JB , DESCB )
126            ELSE
127  
128  *             Solve sub( A )' * X = sub( B ).
129  
130  *             Solve U'*X = sub( B ) , overwriting sub( B ) with X.
131  
132                CALL PZTRSM( 'Left' , 'Upper' , TRANS , 'Non - unit' , N , NRHS ,
133       $        ONE , A , IA , JA , DESCA , B , IB , JB , DESCB )
134  
135  *             Solve L'*X = sub( B ) , overwriting sub( B ) with X.
136  
137                CALL PZTRSM( 'Left' , 'Lower' , TRANS , 'Unit' , N , NRHS , ONE ,
138       $        A , IA , JA , DESCA , B , IB , JB , DESCB )
139  
140  *             Apply row interchanges to the solution vectors.
141  
142                CALL PZLAPIV ( 'Backward' , 'Row' , 'Col' , N , NRHS , B , IB , JB ,
143       $        DESCB , IPIV , IA , 1 , DESCIP , IDUM1 )
144  
145            END IF
146  
147            RETURN
148  
149  *         End of PZGETRS
150  
151        END