Routine PSTRTRS() Documented By Universal Report

Routine: PSTRTRS()

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

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PSTRTRS solves a triangular system of the form
     sub( A ) * X = sub( B )  or  sub( A )**T * 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 )**T * X = sub( B ) (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) REAL 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) REAL 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

FontSize: - +

001        SUBROUTINE PSTRTRS( 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        REAL ZERO , ONE
018        PARAMETER( ZERO = 0.0E + 0 , ONE = 1.0E + 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 , PSTRSM , PXERBLA
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
052               
053            INFO = - 907
054        ELSE
054               
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
061                   
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
069                       
070                    INFO = - 1
071                ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS , 'T' ) .AND.
071                       
072       $            .NOT.LSAME( TRANS , 'C' ) ) THEN
073                    INFO = - 2
074                ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG , 'U' ) ) THEN
074                       
075                    INFO = - 3
076                ELSE IF( IROFFA.NE.ICOFFA .OR. IROFFA.NE.0 ) THEN
076                       
077                    INFO = - 8
078                ELSE IF( IROFFA.NE.IROFFB .OR. IAROW.NE.IBROW ) THEN
078                       
079                    INFO = - 11
080                ELSE IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN
080                       
081                    INFO = - 904
082                ELSE IF( DESCB( MB_ ).NE.DESCA( NB_ ) ) THEN
082                       
083                    INFO = - 1304
084                END IF
085            END IF
086  
087            IF( UPPER ) THEN
087                   
088                IDUM1( 1 ) = ICHAR( 'U' )
089            ELSE
089                   
090                IDUM1( 1 ) = ICHAR( 'L' )
091            END IF
092            IDUM2( 1 ) = 1
093            IF( NOTRAN ) THEN
093                   
094                IDUM1( 2 ) = ICHAR( 'N' )
095            ELSE IF( LSAME( TRANS , 'T' ) ) THEN
095                   
096                IDUM1( 2 ) = ICHAR( 'T' )
097            ELSE IF( LSAME( TRANS , 'C' ) ) THEN
097                   
098                IDUM1( 2 ) = ICHAR( 'C' )
099            END IF
100            IDUM2( 2 ) = 2
101            IF( NOUNIT ) THEN
101                   
102                IDUM1( 3 ) = ICHAR( 'N' )
103            ELSE
103                   
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
111               
112            CALL PXERBLA( ICTXT , 'PSTRTRS' , - INFO )
113            RETURN
114        END IF
115  
116  *     Quick return if possible
117  
118        IF( N.EQ.0 .OR. NRHS.EQ.0 )
118               
119       $    RETURN
120  
121  *         Check for singularity if non - unit.
122  
123            IF( NOUNIT ) THEN
123                   
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
133                       
134                    LL = IOFFA
135                    DO 10 I = 0 , JBLK - 1
135                           
136                        IF( A( LL ).EQ.ZERO .AND. INFO.EQ.0 )
136                               
137       $                    INFO = I + 1
138                            LL = IOFFA + LDA + 1
139     10             CONTINUE
139                   
140                END IF
141                IF( MYROW.EQ.ICURROW )
141                       
142       $            IOFFA = IOFFA + JBLK
143                    IF( MYCOL.EQ.ICURCOL )
143                           
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_ )
150                               
151                            JBLK = MIN( JA + N - J , DESCA( NB_ ) )
152                            IF( MYROW.EQ.ICURROW .AND. MYCOL.EQ.ICURCOL ) THEN
152                                   
153                                LL = IOFFA
154                                DO 20 I = 0 , JBLK - 1
154                                       
155                                    IF( A( LL ).EQ.ZERO .AND. INFO.EQ.0 )
155                                           
156       $                                INFO = J + I - JA + 1
157                                        LL = IOFFA + LDA + 1
158     20                         CONTINUE
158                               
159                            END IF
160                            IF( MYROW.EQ.ICURROW )
160                                   
161       $                        IOFFA = IOFFA + JBLK
162                                IF( MYCOL.EQ.ICURCOL )
162                                       
163       $                            IOFFA = IOFFA + JBLK*LDA
164                                    ICURROW = MOD( ICURROW + 1 , NPROW )
165                                    ICURCOL = MOD( ICURCOL + 1 , NPCOL )
166     30                 CONTINUE
166                           
167                        CALL IGAMX2D( ICTXT , 'All' , ' ' , 1 , 1 , INFO , 1 , IDUM , IDUM ,
168       $                - 1 , - 1 , MYCOL )
169                        IF( INFO.NE.0 )
169                               
170       $                    RETURN
171                        END IF
172  
173  *                     Solve A * x = b or A' * x = b.
174  
175                        CALL PSTRSM( 'Left' , UPLO , TRANS , DIAG , N , NRHS , ONE , A , IA , JA ,
176       $                DESCA , B , IB , JB , DESCB )
177  
178                        RETURN
179  
180  *                     End of PSTRTRS
181  
182                    END2522

Variables in Routine PSTRTRS()

Summary Report
Data Type	Quantity	Size(byte)
CHARACTER	3	3
INTEGER	44	196
LOGICAL	4	4
REAL	2	8
TOTAL	53	211

List of Variables

CHARACTER

DIAG TRANS UPLO

INTEGER

BLOCK_CYCLIC_2D CSRC_ CTXT_ DLEN_ DTYPE_
I IA IAROW IB IBROW
ICEIL ICOFFA ICTXT ICURCOL ICURROW
IDUM IDUM1( 3 ) IDUM2( 3 ) II INDXG2P
INFO IOFFA IROFFA IROFFB J
JA JB JBLK JJ JN
LDA LL LLD_ M_ MB_
MYCOL MYROW N N_ NB_
NPCOL NPROW NRHS RSRC_

LOGICAL

LSAME NOTRAN NOUNIT UPPER

REAL

ONE ZERO

Variables Dependence Graph
Put the mouse over a right hand side variable to display the corresponding line of the dependence
-
- -
I <--- JBLKDO 10 I = 0, JBLK-1{2DO 20 I = 0, JBLK-1}

IAROW <--- INDXG2P, MB_, MYROW, NPROW, RSRC_, IA

IBROW <--- IB, INDXG2P, MB_, MYROW, NPROW, RSRC_

ICOFFA <--- JAICOFFA = MOD( JA-1, DESCA( NB_ ) ), NB_ICOFFA = MOD( JA-1, DESCA( NB_ ) )

ICTXT <--- CTXT_ICTXT = DESCA( CTXT_ )

ICURCOL <--- ICURCOLICURCOL = MOD( ICURCOL+1, NPCOL ){2ICURCOL = MOD( ICURCOL+1, NPCOL )}, NPCOLICURCOL = MOD( ICURCOL+1, NPCOL ){2ICURCOL = MOD( ICURCOL+1, NPCOL )}

ICURROW <--- ICURROWICURROW = MOD( ICURROW+1, NPROW ){2ICURROW = MOD( ICURROW+1, NPROW )}, NPROWICURROW = MOD( ICURROW+1, NPROW ){2ICURROW = MOD( ICURROW+1, NPROW )}

IDUM1 <--- NIDUM1( 3 ) = ICHAR( 'N' ){2IDUM1( 2 ) = ICHAR( 'N' )}

IOFFA <--- IIIOFFA = II + ( JJ - 1 ) * LDA, JJIOFFA = II + ( JJ - 1 ) * LDA, LDAIOFFA = II + ( JJ - 1 ) * LDA

IROFFA <--- MB_IROFFA = MOD( IA-1, DESCA( MB_ ) ), IAIROFFA = MOD( IA-1, DESCA( MB_ ) )

IROFFB <--- IBIROFFB = MOD( IB-1, DESCB( MB_ ) ), MB_IROFFB = MOD( IB-1, DESCB( MB_ ) )

J <--- JADO 30 J = JN+1, JA+N-1, DESCA( NB_ ), JNDO 30 J = JN+1, JA+N-1, DESCA( NB_ ), NDO 30 J = JN+1, JA+N-1, DESCA( NB_ ), NB_DO 30 J = JN+1, JA+N-1, DESCA( NB_ )

JBLK <--- JJBLK = MIN( JA+N-J, DESCA( NB_ ) ), JAJBLK = JN-JA+1{2JBLK = MIN( JA+N-J, DESCA( NB_ ) )}, JNJBLK = JN-JA+1, NJBLK = MIN( JA+N-J, DESCA( NB_ ) ), NB_JBLK = MIN( JA+N-J, DESCA( NB_ ) )

JN <--- ICEIL, JA, N, NB_

LDA <--- LLD_LDA = DESCA( LLD_ )

LL <--- IOFFALL = IOFFA{2LL = IOFFA + LDA + 1, 3LL = IOFFA, 4LL = IOFFA + LDA + 1}, LDALL = IOFFA + LDA + 1{2LL = IOFFA + LDA + 1}

NOTRAN <--- LSAMENOTRAN = LSAME( TRANS, 'N' ), NNOTRAN = LSAME( TRANS, 'N' ), TRANSNOTRAN = LSAME( TRANS, 'N' )

NOUNIT <--- LSAMENOUNIT = LSAME( DIAG, 'N' ), DIAGNOUNIT = LSAME( DIAG, 'N' ), NNOUNIT = LSAME( DIAG, 'N' )

UPPER <--- LSAMEUPPER = LSAME( UPLO, 'U' ), UPLOUPPER = LSAME( UPLO, 'U' )

Analysis elements of the routine PSTRTRS()
Put the mouse over each element to display detailed matching information

Assigned variables
		BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ , I , IAROW , IBROW , ICOFFA , ICTXT , ICURCOL , ICURROW , IDUM1 , IDUM2 , INFO , IOFFA , IROFFA , IROFFB , J , JBLK , JN , LDA , LL , LLD_ , M_ , MB_ , N_ , NB_ , NOTRAN , NOUNIT , ONE , RSRC_ , UPPER , ZERO

Active variables
		A , B , BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DESCA , DESCB , DIAG , DLEN_ , DTYPE_ , I , IA , IAROW , IB , IBROW , ICEIL , ICOFFA , ICTXT , ICURCOL , ICURROW , IDUM , IDUM1 , IDUM2 , II , INDXG2P , INFO , IOFFA , IROFFA , IROFFB , J , JA , JB , JBLK , JJ , JN , LDA , LL , LLD_ , LSAME , M_ , MB_ , MYCOL , MYROW , N , N_ , NB_ , NOTRAN , NOUNIT , NPCOL , NPROW , NRHS , ONE , RSRC_ , TRANS , UPLO , UPPER , ZERO

Accessed arrays [ array name : associated index ]
	A	: LL , LL
	DESCA	: CTXT_ , LLD_ , MB_ , MB_ , MB_ , NB_ , NB_ , NB_ , NB_ , NB_ , NB_ , RSRC_
	DESCB	: MB_ , MB_ , MB_ , RSRC_
	ICEIL	: JA, DESCA( NB_ )
	IDUM1	: 1 , 1 , 2 , 2 , 2 , 3 , 3 , 3
	IDUM2	: 1 , 2 , 3 , 3
	LSAME	: DIAG, 'N' , DIAG, 'U' , TRANS, 'C' , TRANS, 'C' , TRANS, 'N' , TRANS, 'T' , TRANS, 'T' , UPLO, 'L' , UPLO, 'U'

Conditional statements [ statement : associated predicate ]
	do	: `(` 10 I = 0 , JBLK - 1 `)` , `(` 30 J = JN + 1 , JA + N - 1 , DESCA( NB_ ) `)` , `(` 20 I = 0 , JBLK - 1 `)`
	for	: `(` singularity if non - unit. `)`
	if	: `(` NPROW.EQ. - 1 `)` , `(` INFO.EQ.0 `)` , `(` (.NOT.UPPER .AND. .NOT.LSAME( UPLO , 'L' ) ) `)` , `(` (.NOT.NOTRAN .AND. .NOT.LSAME( TRANS , 'T' ) .AND. `)` , `(` (.NOT.NOUNIT .AND. .NOT.LSAME( DIAG , 'U' ) ) `)` , `(` IROFFA.NE.ICOFFA .OR. IROFFA.NE.0 `)` , `(` IROFFA.NE.IROFFB .OR. IAROW.NE.IBROW `)` , `(` (DESCA( MB_ ).NE.DESCA( NB_ ) ) `)` , `(` (DESCB( MB_ ).NE.DESCA( NB_ ) ) `)` , `(` UPPER `)` , `(` NOTRAN `)` , `(` (LSAME( TRANS , 'T' ) ) `)` , `(` (LSAME( TRANS , 'C' ) ) `)` , `(` NOUNIT `)` , `(` INFO.NE.0 `)` , `(` possible `)` , `(` N.EQ.0 .OR. NRHS.EQ.0 `)` , `(` non-unit. `)` , `(` NOUNIT `)` , `(` MYROW.EQ.ICURROW .AND. MYCOL.EQ.ICURCOL `)` , `(` (A( LL ).EQ.ZERO .AND. INFO.EQ.0 ) `)` , `(` MYROW.EQ.ICURROW `)` , `(` MYCOL.EQ.ICURCOL `)` , `(` MYROW.EQ.ICURROW .AND. MYCOL.EQ.ICURCOL `)` , `(` (A( LL ).EQ.ZERO .AND. INFO.EQ.0 ) `)` , `(` MYROW.EQ.ICURROW `)` , `(` MYCOL.EQ.ICURCOL `)` , `(` INFO.NE.0 `)`