pslatrs.f

Go to the documentation of this file.

      SUBROUTINE pslatrs( UPLO, TRANS, DIAG, NORMIN, N, A, IA,
     $                    JA, DESCA, X, IX, JX, DESCX, SCALE, CNORM,
     $                    WORK )
*
*  -- ScaLAPACK auxiliary routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*     .. Scalar Arguments ..
      CHARACTER          DIAG, NORMIN, TRANS, UPLO
      INTEGER            IA, IX, JA, JX, N
      REAL               SCALE
*     ..
*     .. Array Arguments ..
      INTEGER            DESCA( * ), DESCX( * )
      REAL               A( * ), CNORM( * ),
     $                   x( * ), work( * )
*     ..
*
*  Purpose
*  =======
*
*  PSLATRS solves a triangular system. This routine in unfinished
*  at this time, but will be part of the next release.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
     $                   LLD_, MB_, M_, NB_, N_, RSRC_
      parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
     $                     ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
     $                     rsrc_ = 7, csrc_ = 8, lld_ = 9 )
      REAL               ONE
      PARAMETER          ( ONE = 1.0e+0 )
*
*     .. Local Scalars ..
      INTEGER            ICTXT, IIX, IROFF, JJX, MYCOL, MYROW, NP,
     $                   NPCOL, NPROW, LDX, IXCOL, IXROW
*     ..
*     .. External Functions ..
      INTEGER            NUMROC
      EXTERNAL           NUMROC
*     ..
*     .. External Subroutines ..
      EXTERNAL           blacs_gridinfo, sgebr2d, sgebs2d, infog2l,
     $                   pstrsv
*     ..
*     .. Executable Statements ..
*
*     Get grid parameters
*
      ictxt = desca( ctxt_ )
      CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
*
*     Quick return if possible
*
      IF( n.EQ.0 )
     $   RETURN
*
*     *****  NO SCALING ***** Call PSTRSV for all cases  *****
*
      scale = one
      CALL pstrsv( uplo, trans, diag, n, a, ia, ja, desca, x, ix, jx,
     $             descx, 1 )
*
      CALL infog2l( ix, jx, descx, nprow, npcol, myrow, mycol, iix, jjx,
     $              ixrow, ixcol )
      ldx = descx( lld_ )
      iroff = mod( ix-1, descx(mb_) )
      np = numroc( n+iroff, descx( mb_ ), myrow, ixrow, nprow )
      IF( myrow.EQ.ixrow )
     $   np = np - iroff
      IF( mycol.EQ.ixcol ) THEN
         CALL sgebs2d( ictxt, 'R', ' ', np, 1, x( iix+(jjx-1)*ldx ),
     $                 ldx )
      ELSE
         CALL sgebr2d( ictxt, 'R', ' ', np, 1, x( iix+(jjx-1)*ldx ),
     $                 ldx, myrow, ixcol )
      END IF
*
      RETURN
*
*     End of PSLATRS
*
      END