SUBROUTINE PDGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B,
$ IB, JB, DESCB )
*
CHARACTER TRANS
INTEGER IA, IB, IDUM1, JA, JB, N, NRHS
INTEGER DESCA( * ), DESCB( * ), DESCIP( 8 ), IPIV( * )
DOUBLE PRECISION A( * ), B( * )
*
LOGICAL LSAME
INTEGER NUMROC
EXTERNAL DESCSET, LSAME, NUMROC, PDLAPIV, PDTRSM
*
IF( N.EQ.0 .OR. NRHS.EQ.0 ) RETURN
CALL DESCSET( DESCIP, DESCA( 1 ) + DESCA( 3 )*NPROW, 1, DESCA( 3 ),
$ 1, DESCA( 5 ), MYCOL, ICTXT, DESCA( 3 ) +
$ NUMROC( DESCA( 1 ), DESCA( 3 ), MYROW, DESCA( 5 ), NPROW ) )
*
IF( LSAME( TRANS, 'N' ) ) THEN
*
* Solve A * X = B. Apply row interchanges to the right hand sides.
* Solve L*X = B, overwriting B with X.
* Solve U*X = B, overwriting B with X.
*
CALL PDLAPIV( 'Forward', 'Row', 'Col', N, NRHS, B, IB, JB,
$ DESCB, IPIV, IA, 1, DESCIP, IDUM1 )
CALL PDTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
$ 1.0D+0, A, IA, JA, DESCA, B, IB, JB, DESCB )
CALL PDTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
$ NRHS, 1.0D+0, A, IA, JA, DESCA, B, IB, JB, DESCB )
ELSE
*
* Solve A' * X = B. Solve U'*X = B, overwriting B with X.
* Solve L'*X = B, overwriting B with X.
* Apply row interchanges to the solution vectors.
*
CALL PDTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
$ 1.0D+0, A, IA, JA, DESCA, B, IB, JB, DESCB )
CALL PDTRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS,
$ 1.0D+0, A, IA, JA, DESCA, B, IB, JB, DESCB )
CALL PDLAPIV( 'Backward', 'Row', 'Col', N, NRHS, B, IB, JB,
$ DESCB, IPIV, IA, 1, DESCIP, IDUM1 )
END IF
*
RETURN
*
END