01        SUBROUTINE PSLATRS( UPLO , TRANS , DIAG , NORMIN , N , A , IA ,
02       $JA , DESCA , X , IX , JX , DESCX , SCALE , CNORM ,
03       $WORK )
04  
05  *     -- ScaLAPACK auxiliary routine(version 1.7) --
06  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
07  *     and University of California , Berkeley.
08  *     May 1 , 1997
09  
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        IF( N.EQ.0 )
37               
38       $    RETURN
39  
40  *         ***** NO SCALING ***** Call PSTRSV for all cases *****
41  
42            SCALE = ONE
43            CALL PSTRSV( UPLO , TRANS , DIAG , N , A , IA , JA , DESCA , X , IX , JX ,
44       $    DESCX , 1 )
45  
46            CALL INFOG2L( IX , JX , DESCX , NPROW , NPCOL , MYROW , MYCOL , IIX , JJX ,
47       $    IXROW , IXCOL )
48            LDX = DESCX( LLD_ )
49            IROFF = MOD( IX - 1 , DESCX(MB_) )
50            NP = NUMROC( N + IROFF , DESCX( MB_ ) , MYROW , IXROW , NPROW )
51            IF( MYROW.EQ.IXROW )
51                   
52       $        NP = NP - IROFF
53                IF( MYCOL.EQ.IXCOL ) THEN
53                       
54                    CALL SGEBS2D( ICTXT , 'R' , ' ' , NP , 1 , X( IIX + (JJX - 1)*LDX ) ,
55       $            LDX )
56                ELSE
56                       
57                    CALL SGEBR2D( ICTXT , 'R' , ' ' , NP , 1 , X( IIX + (JJX - 1)*LDX ) ,
58       $            LDX , MYROW , IXCOL )
59                END IF
60  
61                RETURN
62  
63  *             End of PSLATRS
64  
65            END1612