Routine: PZTRTRS()  File: SRC\pztrtrs.f

 
 
# lines: 335
  # code: 335
  # comment: 0
  # blank:0
# Variables:53
# Callers:0
# Callings:0
# Words:187
# Keywords:123
 

 

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PZTRTRS solves a triangular system of the form
     sub( A ) * X = sub( B )  or  sub( A )**T * X = sub( B ) or
     sub( A )**H * X = sub( B ),
  where sub( A ) denotes A(IA:IA+N-1,JA:JA+N-1) and is a triangular
  distributed matrix of order N, and B(IB:IB+N-1,JB:JB+NRHS-1) is an
  N-by-NRHS distributed matrix denoted by sub( B ). A check is made
  to verify that sub( A ) is nonsingular.
  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
  =========
  UPLO    (global input) CHARACTER
          = 'U':  sub( A ) is upper triangular;
          = 'L':  sub( A ) is lower triangular.
  TRANS   (global input) CHARACTER
          Specifies the form of the system of equations:
          = 'N': Solve sub( A )    * X = sub( B ) (No transpose)
          = 'T': Solve sub( A )**T * X = sub( B ) (Transpose)
          = 'C': Solve sub( A )**H * X = sub( B ) (Conjugate transpose)
  DIAG    (global input) CHARACTER
          = 'N':  sub( A ) is non-unit triangular;
          = 'U':  sub( A ) is unit triangular.
  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 matrix 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) ). This array
          contains the local pieces of the distributed triangular
          matrix sub( A ).  If UPLO = 'U', the leading N-by-N upper
          triangular part of sub( A ) contains the upper triangular
          matrix, and the strictly lower triangular part of sub( A )
          is not referenced.  If UPLO = 'L', the leading N-by-N lower
          triangular part of sub( A ) contains the lower triangular
          matrix, and the strictly upper triangular part of sub( A )
          is not referenced.  If DIAG = 'U', the diagonal elements of
          sub( A ) are also not referenced and are assumed to be 1.
  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.
  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, this array contains the
          local pieces of the right hand side distributed matrix
          sub( B ). On exit, if INFO = 0, sub( B ) is overwritten by
          the solution 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    (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 = i, the i-th diagonal element of sub( A ) is
                zero, indicating that the submatrix is singular and the
                solutions X have not been computed.
  =====================================================================
     .. Parameters ..

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

 
001        SUBROUTINE PZTRTRS( UPLO , TRANS , DIAG , N , NRHS , A , IA , JA , DESCA ,
002       $B , IB , JB , DESCB , INFO )
003  
004  *     -- ScaLAPACK auxiliary 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 DIAG , TRANS , UPLO
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 ZERO , ONE
018        PARAMETER( ZERO = 0.0D + 0 , ONE = 1.0D + 0 )
019  *     ..
020  *     .. Local Scalars ..
021        LOGICAL NOTRAN , NOUNIT , UPPER
022        INTEGER I , IAROW , IBROW , ICOFFA , ICTXT , ICURCOL ,
023       $ICURROW , IROFFA , IROFFB , IDUM , II , IOFFA , J ,
024       $JBLK , JJ , JN , LDA , LL , MYCOL , MYROW , NPCOL ,
025       $NPROW
026  *     ..
027  *     .. Local Arrays ..
028        INTEGER IDUM1( 3 ) , IDUM2( 3 )
029  *     ..
030  *     .. External Subroutines ..
031        EXTERNAL BLACS_GRIDINFO , CHK1MAT , IGAMX2D , INFOG2L ,
032       $PCHK2MAT , PXERBLA , PZTRSM
033  *     ..
034  *     .. External Functions ..
035        LOGICAL LSAME
036        INTEGER ICEIL , INDXG2P
037        EXTERNAL ICEIL , INDXG2P , LSAME
038  *     ..
039  *     .. Intrinsic Functions ..
040        INTRINSIC ICHAR , MIN , MOD
041  *     ..
042  *     .. Executable Statements ..
043  
044  *     Get grid parameters
045  
046        ICTXT = DESCA( CTXT_ )
047        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
048  
049  *     Test input parameters
050  
051        INFO = 0
052        IF( NPROW.EQ. - 1 ) THEN
053            INFO = - 907
054        ELSE
055            UPPER = LSAME( UPLO , 'U' )
056            NOUNIT = LSAME( DIAG , 'N' )
057            NOTRAN = LSAME( TRANS , 'N' )
058  
059            CALL CHK1MAT( N , 4 , N , 4 , IA , JA , DESCA , 9 , INFO )
060            CALL CHK1MAT( N , 4 , NRHS , 5 , IB , JB , DESCB , 13 , INFO )
061            IF( INFO.EQ.0 ) THEN
062                IROFFA = MOD( IA - 1 , DESCA( MB_ ) )
063                ICOFFA = MOD( JA - 1 , DESCA( NB_ ) )
064                IROFFB = MOD( IB - 1 , DESCB( MB_ ) )
065                IAROW = INDXG2P( IA , DESCA( MB_ ) , MYROW , DESCA( RSRC_ ) ,
066       $        NPROW )
067                IBROW = INDXG2P( IB , DESCB( MB_ ) , MYROW , DESCB( RSRC_ ) ,
068       $        NPROW )
069                IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO , 'L' ) ) THEN
070                    INFO = - 1
071                ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS , 'T' ) .AND.
072       $            .NOT.LSAME( TRANS , 'C' ) ) THEN
073                    INFO = - 2
074                ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG , 'U' ) ) THEN
075                    INFO = - 3
076                ELSE IF( IROFFA.NE.ICOFFA .OR. IROFFA.NE.0 ) THEN
077                    INFO = - 8
078                ELSE IF( IROFFA.NE.IROFFB .OR. IAROW.NE.IBROW ) THEN
079                    INFO = - 11
080                ELSE IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN
081                    INFO = - 904
082                ELSE IF( DESCB( MB_ ).NE.DESCA( NB_ ) ) THEN
083                    INFO = - 1304
084                END IF
085            END IF
086  
087            IF( UPPER ) THEN
088                IDUM1( 1 ) = ICHAR( 'U' )
089            ELSE
090                IDUM1( 1 ) = ICHAR( 'L' )
091            END IF
092            IDUM2( 1 ) = 1
093            IF( NOTRAN ) THEN
094                IDUM1( 2 ) = ICHAR( 'N' )
095            ELSE IF( LSAME( TRANS , 'T' ) ) THEN
096                IDUM1( 2 ) = ICHAR( 'T' )
097            ELSE IF( LSAME( TRANS , 'C' ) ) THEN
098                IDUM1( 2 ) = ICHAR( 'C' )
099            END IF
100            IDUM2( 2 ) = 2
101            IF( NOUNIT ) THEN
102                IDUM1( 3 ) = ICHAR( 'N' )
103            ELSE
104                IDUM1( 3 ) = ICHAR( 'D' )
105            END IF
106            IDUM2( 3 ) = 3
107            CALL PCHK2MAT( N , 4 , N , 4 , IA , JA , DESCA , 9 , N , 4 , NRHS , 5 ,
108       $    IB , JB , DESCB , 13 , 3 , IDUM1 , IDUM2 , INFO )
109        END IF
110  
111        IF( INFO.NE.0 ) THEN
112            CALL PXERBLA( ICTXT , 'PZTRTRS' , - INFO )
113            RETURN
114        END IF
115  
116  *     Quick return if possible
117  
118        IF( N.EQ.0 .OR. NRHS.EQ.0 )
119       $    RETURN
120  
121  *         Check for singularity if non - unit.
122  
123            IF( NOUNIT ) THEN
124                CALL INFOG2L( IA , JA , DESCA , NPROW , NPCOL , MYROW , MYCOL ,
125       $        II , JJ , ICURROW , ICURCOL )
126                JN = MIN( ICEIL( JA , DESCA( NB_ ) ) * DESCA( NB_ ) , JA + N - 1 )
127                LDA = DESCA( LLD_ )
128                IOFFA = II + ( JJ - 1 ) * LDA
129  
130  *             Handle first block separately
131  
132                JBLK = JN - JA + 1
133                IF( MYROW.EQ.ICURROW .AND. MYCOL.EQ.ICURCOL ) THEN
134                    LL = IOFFA
135                    DO 10 I = 0 , JBLK - 1
136                        IF( A( LL ).EQ.ZERO .AND. INFO.EQ.0 )
137       $                    INFO = I + 1
138                            LL = IOFFA + LDA + 1
139     10             CONTINUE
140                END IF
141                IF( MYROW.EQ.ICURROW )
142       $            IOFFA = IOFFA + JBLK
143                    IF( MYCOL.EQ.ICURCOL )
144       $                IOFFA = IOFFA + JBLK*LDA
145                        ICURROW = MOD( ICURROW + 1 , NPROW )
146                        ICURCOL = MOD( ICURCOL + 1 , NPCOL )
147  
148  *                     Loop over remaining blocks of columns
149  
150                        DO 30 J = JN + 1 , JA + N - 1 , DESCA( NB_ )
151                            JBLK = MIN( JA + N - J , DESCA( NB_ ) )
152                            IF( MYROW.EQ.ICURROW .AND. MYCOL.EQ.ICURCOL ) THEN
153                                LL = IOFFA
154                                DO 20 I = 0 , JBLK - 1
155                                    IF( A( LL ).EQ.ZERO .AND. INFO.EQ.0 )
156       $                                INFO = J + I - JA + 1
157                                        LL = IOFFA + LDA + 1
158     20                         CONTINUE
159                            END IF
160                            IF( MYROW.EQ.ICURROW )
161       $                        IOFFA = IOFFA + JBLK
162                                IF( MYCOL.EQ.ICURCOL )
163       $                            IOFFA = IOFFA + JBLK*LDA
164                                    ICURROW = MOD( ICURROW + 1 , NPROW )
165                                    ICURCOL = MOD( ICURCOL + 1 , NPCOL )
166     30                 CONTINUE
167                        CALL IGAMX2D( ICTXT , 'All' , ' ' , 1 , 1 , INFO , 1 , IDUM , IDUM ,
168       $                - 1 , - 1 , MYCOL )
169                        IF( INFO.NE.0 )
170       $                    RETURN
171                        END IF
172  
173  *                     Solve A * x = b , A**T * x = b , or A**H * x = b.
174  
175                        CALL PZTRSM( 'Left' , UPLO , TRANS , DIAG , N , NRHS , ONE , A , IA , JA ,
176       $                DESCA , B , IB , JB , DESCB )
177  
178                        RETURN
179  
180  *                     End of PZTRTRS
181  
182                    END