1 SUBROUTINE PDGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, 2 $ IB, JB, DESCB, INFO ) 3* 4* -- ScaLAPACK routine (version 1.7) -- 5* University of Tennessee, Knoxville, Oak Ridge National Laboratory, 6* and University of California, Berkeley. 7* May 1, 1997 8* 9* .. Scalar Arguments .. 10 CHARACTER TRANS 11 INTEGER IA, IB, INFO, JA, JB, N, NRHS 12* .. 13* .. Array Arguments .. 14 INTEGER DESCA( * ), DESCB( * ), IPIV( * ) 15 DOUBLE PRECISION A( * ), B( * ) 16* .. 17* 18* Purpose 19* ======= 20* 21* PDGETRS solves a system of distributed linear equations 22* 23* op( sub( A ) ) * X = sub( B ) 24* 25* with a general N-by-N distributed matrix sub( A ) using the LU 26* factorization computed by PDGETRF. 27* sub( A ) denotes A(IA:IA+N-1,JA:JA+N-1), op( A ) = A or A**T and 28* sub( B ) denotes B(IB:IB+N-1,JB:JB+NRHS-1). 29* 30* Notes 31* ===== 32* 33* Each global data object is described by an associated description 34* vector. This vector stores the information required to establish 35* the mapping between an object element and its corresponding process 36* and memory location. 37* 38* Let A be a generic term for any 2D block cyclicly distributed array. 39* Such a global array has an associated description vector DESCA. 40* In the following comments, the character _ should be read as 41* "of the global array". 42* 43* NOTATION STORED IN EXPLANATION 44* --------------- -------------- -------------------------------------- 45* DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case, 46* DTYPE_A = 1. 47* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating 48* the BLACS process grid A is distribu- 49* ted over. The context itself is glo- 50* bal, but the handle (the integer 51* value) may vary. 52* M_A (global) DESCA( M_ ) The number of rows in the global 53* array A. 54* N_A (global) DESCA( N_ ) The number of columns in the global 55* array A. 56* MB_A (global) DESCA( MB_ ) The blocking factor used to distribute 57* the rows of the array. 58* NB_A (global) DESCA( NB_ ) The blocking factor used to distribute 59* the columns of the array. 60* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first 61* row of the array A is distributed. 62* CSRC_A (global) DESCA( CSRC_ ) The process column over which the 63* first column of the array A is 64* distributed. 65* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local 66* array. LLD_A >= MAX(1,LOCr(M_A)). 67* 68* Let K be the number of rows or columns of a distributed matrix, 69* and assume that its process grid has dimension p x q. 70* LOCr( K ) denotes the number of elements of K that a process 71* would receive if K were distributed over the p processes of its 72* process column. 73* Similarly, LOCc( K ) denotes the number of elements of K that a 74* process would receive if K were distributed over the q processes of 75* its process row. 76* The values of LOCr() and LOCc() may be determined via a call to the 77* ScaLAPACK tool function, NUMROC: 78* LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ), 79* LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ). 80* An upper bound for these quantities may be computed by: 81* LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A 82* LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A 83* 84* This routine requires square block data decomposition ( MB_A=NB_A ). 85* 86* Arguments 87* ========= 88* 89* TRANS (global input) CHARACTER 90* Specifies the form of the system of equations: 91* = 'N': sub( A ) * X = sub( B ) (No transpose) 92* = 'T': sub( A )**T * X = sub( B ) (Transpose) 93* = 'C': sub( A )**T * X = sub( B ) (Transpose) 94* 95* N (global input) INTEGER 96* The number of rows and columns to be operated on, i.e. the 97* order of the distributed submatrix sub( A ). N >= 0. 98* 99* NRHS (global input) INTEGER 100* The number of right hand sides, i.e., the number of columns 101* of the distributed submatrix sub( B ). NRHS >= 0. 102* 103* A (local input) DOUBLE PRECISION pointer into the local 104* memory to an array of dimension (LLD_A, LOCc(JA+N-1)). 105* On entry, this array contains the local pieces of the factors 106* L and U from the factorization sub( A ) = P*L*U; the unit 107* diagonal elements of L are not stored. 108* 109* IA (global input) INTEGER 110* The row index in the global array A indicating the first 111* row of sub( A ). 112* 113* JA (global input) INTEGER 114* The column index in the global array A indicating the 115* first column of sub( A ). 116* 117* DESCA (global and local input) INTEGER array of dimension DLEN_. 118* The array descriptor for the distributed matrix A. 119* 120* IPIV (local input) INTEGER array, dimension ( LOCr(M_A)+MB_A ) 121* This array contains the pivoting information. 122* IPIV(i) -> The global row local row i was swapped with. 123* This array is tied to the distributed matrix A. 124* 125* B (local input/local output) DOUBLE PRECISION pointer into the 126* local memory to an array of dimension 127* (LLD_B,LOCc(JB+NRHS-1)). On entry, the right hand sides 128* sub( B ). On exit, sub( B ) is overwritten by the solution 129* distributed matrix X. 130* 131* IB (global input) INTEGER 132* The row index in the global array B indicating the first 133* row of sub( B ). 134* 135* JB (global input) INTEGER 136* The column index in the global array B indicating the 137* first column of sub( B ). 138* 139* DESCB (global and local input) INTEGER array of dimension DLEN_. 140* The array descriptor for the distributed matrix B. 141* 142* INFO (global output) INTEGER 143* = 0: successful exit 144* < 0: If the i-th argument is an array and the j-entry had 145* an illegal value, then INFO = -(i*100+j), if the i-th 146* argument is a scalar and had an illegal value, then 147* INFO = -i. 148* 149* ===================================================================== 150* 151* .. Parameters .. 152 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, 153 $ LLD_, MB_, M_, NB_, N_, RSRC_ 154 PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, 155 $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, 156 $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) 157 DOUBLE PRECISION ONE 158 PARAMETER ( ONE = 1.0D+0 ) 159* .. 160* .. Local Scalars .. 161 LOGICAL NOTRAN 162 INTEGER IAROW, IBROW, ICOFFA, ICTXT, IROFFA, IROFFB, 163 $ MYCOL, MYROW, NPCOL, NPROW 164* .. 165* .. Local Arrays .. 166 INTEGER DESCIP( DLEN_ ), IDUM1( 1 ), IDUM2( 1 ) 167* .. 168* .. External Subroutines .. 169 EXTERNAL BLACS_GRIDINFO, CHK1MAT, DESCSET, PCHK2MAT, 170 $ PDLAPIV, PDTRSM, PXERBLA 171* .. 172* .. External Functions .. 173 LOGICAL LSAME 174 INTEGER INDXG2P, NUMROC 175 EXTERNAL INDXG2P, LSAME, NUMROC 176* .. 177* .. Intrinsic Functions .. 178 INTRINSIC ICHAR, MOD 179* .. 180* .. Executable Statements .. 181* 182* Get grid parameters 183* 184 ICTXT = DESCA( CTXT_ ) 185 CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) 186* 187* Test the input parameters 188* 189 INFO = 0 190 IF( NPROW.EQ.-1 ) THEN 191 INFO = -(700+CTXT_) 192 ELSE 193 NOTRAN = LSAME( TRANS, 'N' ) 194 CALL CHK1MAT( N, 2, N, 2, IA, JA, DESCA, 7, INFO ) 195 CALL CHK1MAT( N, 2, NRHS, 3, IB, JB, DESCB, 12, INFO ) 196 IF( INFO.EQ.0 ) THEN 197 IAROW = INDXG2P( IA, DESCA( MB_ ), MYROW, DESCA( RSRC_ ), 198 $ NPROW ) 199 IBROW = INDXG2P( IB, DESCB( MB_ ), MYROW, DESCB( RSRC_ ), 200 $ NPROW ) 201 IROFFA = MOD( IA-1, DESCA( MB_ ) ) 202 ICOFFA = MOD( JA-1, DESCA( NB_ ) ) 203 IROFFB = MOD( IB-1, DESCB( MB_ ) ) 204 IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. 205 $ LSAME( TRANS, 'C' ) ) THEN 206 INFO = -1 207 ELSE IF( IROFFA.NE.0 ) THEN 208 INFO = -5 209 ELSE IF( ICOFFA.NE.0 ) THEN 210 INFO = -6 211 ELSE IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN 212 INFO = -(700+NB_) 213 ELSE IF( IROFFB.NE.0 .OR. IBROW.NE.IAROW ) THEN 214 INFO = -10 215 ELSE IF( DESCB( MB_ ).NE.DESCA( NB_ ) ) THEN 216 INFO = -(1200+NB_) 217 ELSE IF( ICTXT.NE.DESCB( CTXT_ ) ) THEN 218 INFO = -(1200+CTXT_) 219 END IF 220 END IF 221 IF( NOTRAN ) THEN 222 IDUM1( 1 ) = ICHAR( 'N' ) 223 ELSE IF( LSAME( TRANS, 'T' ) ) THEN 224 IDUM1( 1 ) = ICHAR( 'T' ) 225 ELSE 226 IDUM1( 1 ) = ICHAR( 'C' ) 227 END IF 228 IDUM2( 1 ) = 1 229 CALL PCHK2MAT( N, 2, N, 2, IA, JA, DESCA, 7, N, 2, NRHS, 3, 230 $ IB, JB, DESCB, 12, 1, IDUM1, IDUM2, INFO ) 231 END IF 232* 233 IF( INFO.NE.0 ) THEN 234 CALL PXERBLA( ICTXT, 'PDGETRS', -INFO ) 235 RETURN 236 END IF 237* 238* Quick return if possible 239* 240 IF( N.EQ.0 .OR. NRHS.EQ.0 ) 241 $ RETURN 242* 243 CALL DESCSET( DESCIP, DESCA( M_ ) + DESCA( MB_ )*NPROW, 1, 244 $ DESCA( MB_ ), 1, DESCA( RSRC_ ), MYCOL, ICTXT, 245 $ DESCA( MB_ ) + NUMROC( DESCA( M_ ), DESCA( MB_ ), 246 $ MYROW, DESCA( RSRC_ ), NPROW ) ) 247* 248 IF( NOTRAN ) THEN 249* 250* Solve sub( A ) * X = sub( B ). 251* 252* Apply row interchanges to the right hand sides. 253* 254 CALL PDLAPIV( 'Forward', 'Row', 'Col', N, NRHS, B, IB, JB, 255 $ DESCB, IPIV, IA, 1, DESCIP, IDUM1 ) 256* 257* Solve L*X = sub( B ), overwriting sub( B ) with X. 258* 259 CALL PDTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS, 260 $ ONE, A, IA, JA, DESCA, B, IB, JB, DESCB ) 261* 262* Solve U*X = sub( B ), overwriting sub( B ) with X. 263* 264 CALL PDTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N, 265 $ NRHS, ONE, A, IA, JA, DESCA, B, IB, JB, DESCB ) 266 ELSE 267* 268* Solve sub( A )' * X = sub( B ). 269* 270* Solve U'*X = sub( B ), overwriting sub( B ) with X. 271* 272 CALL PDTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS, 273 $ ONE, A, IA, JA, DESCA, B, IB, JB, DESCB ) 274* 275* Solve L'*X = sub( B ), overwriting sub( B ) with X. 276* 277 CALL PDTRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, 278 $ ONE, A, IA, JA, DESCA, B, IB, JB, DESCB ) 279* 280* Apply row interchanges to the solution vectors. 281* 282 CALL PDLAPIV( 'Backward', 'Row', 'Col', N, NRHS, B, IB, JB, 283 $ DESCB, IPIV, IA, 1, DESCIP, IDUM1 ) 284* 285 END IF 286* 287 RETURN 288* 289* End of PDGETRS 290* 291 END 292