ScaLAPACK 2.1  2.1 ScaLAPACK: Scalable Linear Algebra PACKage
pslatrs.f
Go to the documentation of this file.
1  SUBROUTINE pslatrs( UPLO, TRANS, DIAG, NORMIN, N, A, IA,
2  \$ JA, DESCA, X, IX, JX, DESCX, SCALE, CNORM,
3  \$ WORK )
4 *
5 * -- ScaLAPACK auxiliary routine (version 1.7) --
6 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
7 * and University of California, Berkeley.
8 * May 1, 1997
9 *
10 * .. Scalar Arguments ..
11  CHARACTER DIAG, NORMIN, TRANS, UPLO
12  INTEGER IA, IX, JA, JX, N
13  REAL SCALE
14 * ..
15 * .. Array Arguments ..
16  INTEGER DESCA( * ), DESCX( * )
17  REAL A( * ), CNORM( * ),
18  \$ x( * ), work( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * PSLATRS solves a triangular system. This routine in unfinished
25 * at this time, but will be part of the next release.
26 *
27 * =====================================================================
28 *
29 * .. Parameters ..
30  INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
31  \$ LLD_, MB_, M_, NB_, N_, RSRC_
32  parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
33  \$ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
34  \$ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
35  REAL ONE
36  PARAMETER ( ONE = 1.0e+0 )
37 *
38 * .. Local Scalars ..
39  INTEGER ICTXT, IIX, IROFF, JJX, MYCOL, MYROW, NP,
40  \$ NPCOL, NPROW, LDX, IXCOL, IXROW
41 * ..
42 * .. External Functions ..
43  INTEGER NUMROC
44  EXTERNAL NUMROC
45 * ..
46 * .. External Subroutines ..
47  EXTERNAL blacs_gridinfo, sgebr2d, sgebs2d, infog2l,
48  \$ pstrsv
49 * ..
50 * .. Executable Statements ..
51 *
52 * Get grid parameters
53 *
54  ictxt = desca( ctxt_ )
55  CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
56 *
57 * Quick return if possible
58 *
59  IF( n.EQ.0 )
60  \$ RETURN
61 *
62 * ***** NO SCALING ***** Call PSTRSV for all cases *****
63 *
64  scale = one
65  CALL pstrsv( uplo, trans, diag, n, a, ia, ja, desca, x, ix, jx,
66  \$ descx, 1 )
67 *
68  CALL infog2l( ix, jx, descx, nprow, npcol, myrow, mycol, iix, jjx,
69  \$ ixrow, ixcol )
70  ldx = descx( lld_ )
71  iroff = mod( ix-1, descx(mb_) )
72  np = numroc( n+iroff, descx( mb_ ), myrow, ixrow, nprow )
73  IF( myrow.EQ.ixrow )
74  \$ np = np - iroff
75  IF( mycol.EQ.ixcol ) THEN
76  CALL sgebs2d( ictxt, 'R', ' ', np, 1, x( iix+(jjx-1)*ldx ),
77  \$ ldx )
78  ELSE
79  CALL sgebr2d( ictxt, 'R', ' ', np, 1, x( iix+(jjx-1)*ldx ),
80  \$ ldx, myrow, ixcol )
81  END IF
82 *
83  RETURN
84 *
85 * End of PSLATRS
86 *
87  END
pslatrs
subroutine pslatrs(UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, DESCA, X, IX, JX, DESCX, SCALE, CNORM, WORK)
Definition: pslatrs.f:4
infog2l
subroutine infog2l(GRINDX, GCINDX, DESC, NPROW, NPCOL, MYROW, MYCOL, LRINDX, LCINDX, RSRC, CSRC)
Definition: infog2l.f:3