PSSYTTRD(3)              MathKeisan ScaLAPACK routine              PSSYTTRD(3)



NAME
SYNOPSIS
       SUBROUTINE PSSYTTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, LWORK,
                            INFO )

           CHARACTER        UPLO

           INTEGER          IA, INFO, JA, LWORK, N

           INTEGER          DESCA( * )

           REAL             A( * ), D( * ), E( * ), TAU( * ), WORK( * )

           INTEGER          BLOCK_CYCLIC_2D, DLEN_,  DTYPE_,  CTXT_,  M_,  N_,
                            MB_, NB_, RSRC_, CSRC_, LLD_

           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.0E0 )

           REAL             Z_ONE, Z_NEGONE, Z_ZERO

           PARAMETER        ( Z_ONE = 1.0E0, Z_NEGONE = -1.0E0, Z_ZERO = 0.0E0
                            )

           REAL             ZERO

           PARAMETER        ( ZERO = 0.0E+0 )

           LOGICAL          BALANCED, INTERLEAVE, TWOGEMMS, UPPER

           INTEGER          ANB, BINDEX,  CURCOL,  CURROW,  I,  ICTXT,  INDEX,
                            INDEXA,   INDEXINH,  INDEXINV,  INH,  INHB,  INHT,
                            INHTB, INTMP, INV, INVB, INVT, INVTB, J, LDA, LDV,
                            LDZG,  LII, LIIB, LIIP1, LIJ, LIJB, LIJP1, LTLIP1,
                            LTNM1,   LWMIN,   MAXINDEX,    MININDEX,    MYCOL,
                            MYFIRSTROW, MYROW, MYSETNUM, NBZG, NP, NPB, NPCOL,
                            NPM0, NPM1, NPROW, NPS, NPSET, NQ, NQB, NQM1, NUM-
                            ROWS,  NXTCOL,  NXTROW, PBMAX, PBMIN, PBSIZE, PNB,
                            ROWSPERPROC

           REAL             ALPHA, BETA, C, NORM, ONEOVERBETA, SAFMAX, SAFMIN,
                            TOPH, TOPNV, TOPTAU, TOPV, TTOPH, TTOPV

           INTEGER          IDUM1( 1 ), IDUM2( 1 )

           REAL             CC( 3 ), DTMP( 5 )

           EXTERNAL         BLACS_GRIDINFO,   CHK1MAT,  PCHK1MAT,  PSTREECOMB,
                            PXERBLA,  SCOMBNRM2,  SGEBR2D,   SGEBS2D,   SGEMM,
                            SGEMV,  SGERV2D,  SGESD2D, SGSUM2D, SLACPY, SSCAL,
                            STRMVT

           LOGICAL          LSAME

           INTEGER          ICEIL, NUMROC, PJLAENV

           REAL             PSLAMCH, SNRM2

           EXTERNAL         LSAME, ICEIL, NUMROC, PJLAENV, PSLAMCH, SNRM2

           INTRINSIC        ICHAR, MAX, MIN, MOD, REAL, SIGN, SQRT

           IF(              BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_*
                            RSRC_.LT.0 )RETURN

           ICTXT            = DESCA( CTXT_ )

           CALL             BLACS_GRIDINFO(  ICTXT, NPROW, NPCOL, MYROW, MYCOL
                            )

           SAFMAX           = SQRT( PSLAMCH( ICTXT, 'O' ) ) / N

           SAFMIN           = SQRT( PSLAMCH( ICTXT, 'S' ) )

           INFO             = 0

           IF(              NPROW.EQ.-1 ) THEN

           INFO             = -( 600+CTXT_ )

           ELSE

           PNB              = PJLAENV( ICTXT, 2, 'PSSYTTRD', 'L', 0, 0, 0, 0 )

           ANB              = PJLAENV( ICTXT, 3, 'PSSYTTRD', 'L', 0, 0, 0, 0 )

           INTERLEAVE       = ( PJLAENV( ICTXT, 4, 'PSSYTTRD', 'L', 1, 0, 0, 0
                            ).EQ.1 )

           TWOGEMMS         = ( PJLAENV( ICTXT, 4, 'PSSYTTRD', 'L', 2, 0, 0, 0
                            ).EQ.1 )

           BALANCED         = ( PJLAENV( ICTXT, 4, 'PSSYTTRD', 'L', 3, 0, 0, 0
                            ).EQ.1 )

           CALL             CHK1MAT( N, 2, N, 2, IA, JA, DESCA, 6, INFO )

           UPPER            = LSAME( UPLO, 'U' )

           IF(              INFO.EQ.0  .AND.  DESCA( NB_ ).NE.1 ) INFO = 600 +
                            NB_

           IF(              INFO.EQ.0 ) THEN

           NPS              = MAX( NUMROC( N, 1, 0, 0, NPROW ), 2*ANB )

           LWMIN            = 2*( ANB+1 )*( 4*NPS+2 ) + NPS

           WORK(            1 ) = REAL( LWMIN )

           IF(

           INFO             = -1

           ELSE             IF( IA.NE.1 ) THEN

           INFO             = -4

           ELSE             IF( JA.NE.1 ) THEN

           INFO             = -5

           ELSE             IF( NPROW.NE.NPCOL ) THEN

           INFO             = -( 600+CTXT_ )

           ELSE             IF( DESCA( DTYPE_ ).NE.1 ) THEN

           INFO             = -( 600+DTYPE_ )

           ELSE             IF( DESCA( MB_ ).NE.1 ) THEN

           INFO             = -( 600+MB_ )

           ELSE             IF( DESCA( NB_ ).NE.1 ) THEN

           INFO             = -( 600+NB_ )

           ELSE             IF( DESCA( RSRC_ ).NE.0 ) THEN

           INFO             = -( 600+RSRC_ )

           ELSE             IF( DESCA( CSRC_ ).NE.0 ) THEN

           INFO             = -( 600+CSRC_ )

           ELSE             IF( LWORK.LT.LWMIN ) THEN

           INFO             = -11

           END              IF

           END              IF

           IF(              UPPER ) THEN

           IDUM1(           1 ) = ICHAR( 'U' )

           ELSE

           IDUM1(           1 ) = ICHAR( 'L' )

           END              IF

           IDUM2(           1 ) = 1

           CALL             PCHK1MAT( N, 2, N, 2, IA, JA, DESCA, 6, 1,  IDUM1,
                            IDUM2, INFO )

           END              IF

           IF(              INFO.NE.0 ) THEN

           CALL             PXERBLA( ICTXT, 'PSSYTTRD', -INFO )

           RETURN

           END              IF

           IF(              N.EQ.0 ) RETURN

           NP               = NUMROC( N, 1, MYROW, 0, NPROW )

           NQ               = NUMROC( N, 1, MYCOL, 0, NPCOL )

           NXTROW           = 0

           NXTCOL           = 0

           LIIP1            = 1

           LIJP1            = 1

           NPM1             = NP

           NQM1             = NQ

           LDA              = DESCA( LLD_ )

           ICTXT            = DESCA( CTXT_ )

           INH              = 1

           IF(              INTERLEAVE ) THEN

           LDV              = 4*( MAX( NPM1, NQM1 ) ) + 2

           INH              = 1

           INV              = INH + LDV / 2

           INVT             = INH + ( ANB+1 )*LDV

           INHT             = INVT + LDV / 2

           INTMP            = INVT + LDV*( ANB+1 )

           ELSE

           LDV              = MAX( NPM1, NQM1 )

           INHT             = INH + LDV*( ANB+1 )

           INV              = INHT + LDV*( ANB+1 )

           INVT             = INV + LDV*( ANB+1 ) + 1

           INTMP            = INVT + LDV*( 2*ANB )

           END              IF

           IF(              INFO.NE.0 ) THEN

           CALL             PXERBLA( ICTXT, 'PSSYTTRD', -INFO )

           WORK(            1 ) = REAL( LWMIN )

           RETURN

           END              IF

           DO               10 I = 1, NP

           WORK(            INH+I-1 ) = Z_ZERO

           WORK(            INV+I-1 ) = Z_ZERO

           10               CONTINUE

           DO               20 I = 1, NQ

           WORK(            INHT+I-1 ) = Z_ZERO

           20               CONTINUE

           TOPNV            = Z_ZERO

           LTLIP1           = LIJP1

           LTNM1            = NPM1

           IF(              MYCOL.GT.MYROW ) THEN

           LTLIP1           = LTLIP1 + 1

           LTNM1            = LTNM1 - 1

           END              IF

           DO               210 MININDEX = 1, N - 1, ANB

           MAXINDEX         = MIN( MININDEX+ANB-1, N )

           LIJB             = NUMROC( MAXINDEX, 1, MYCOL, 0, NPCOL ) + 1

           LIIB             = NUMROC( MAXINDEX, 1, MYROW, 0, NPROW ) + 1

           NQB              = NQ - LIJB + 1

           NPB              = NP - LIIB + 1

           INHTB            = INHT + LIJB - 1

           INVTB            = INVT + LIJB - 1

           INHB             = INH + LIIB - 1

           INVB             = INV + LIIB - 1

           DO               160 INDEX = MININDEX, MIN( MAXINDEX, N-1 )

           BINDEX           = INDEX - MININDEX

           CURROW           = NXTROW

           CURCOL           = NXTCOL

           NXTROW           = MOD( CURROW+1, NPROW )

           NXTCOL           = MOD( CURCOL+1, NPCOL )

           LII              = LIIP1

           LIJ              = LIJP1

           NPM0             = NPM1

           IF(              MYROW.EQ.CURROW ) THEN

           NPM1             = NPM1 - 1

           LIIP1            = LIIP1 + 1

           END              IF

           IF(              MYCOL.EQ.CURCOL ) THEN

           NQM1             = NQM1 - 1

           LIJP1            = LIJP1 + 1

           LTLIP1           = LTLIP1 + 1

           LTNM1            = LTNM1 - 1

           END              IF

           IF(              MYCOL.EQ.CURCOL ) THEN

           INDEXA           = LII + ( LIJ-1 )*LDA

           INDEXINV         = INV + LII - 1 + ( BINDEX-1 )*LDV

           INDEXINH         = INH + LII - 1 + ( BINDEX-1 )*LDV

           TTOPH            = WORK( INHT+LIJ-1+BINDEX*LDV )

           TTOPV            = TOPNV

           IF(              INDEX.GT.1 ) THEN

           DO               30 I = 0, NPM0 - 1

           A(               INDEXA+I  ) = A( INDEXA+I ) - WORK( INDEXINV+LDV+I
                            )*TTOPH - WORK( INDEXINH+LDV+I )*TTOPV

           30               CONTINUE

           END              IF

           END              IF

           IF(              MYCOL.EQ.CURCOL ) THEN

           IF(              MYROW.EQ.CURROW ) THEN

           DTMP(            2 ) = A( LII+( LIJ-1 )*LDA )

           ELSE

           DTMP(            2 ) = ZERO

           END              IF

           IF(              MYROW.EQ.NXTROW ) THEN

           DTMP(            3 ) = A( LIIP1+( LIJ-1 )*LDA )

           DTMP(            4 ) = ZERO

           ELSE

           DTMP(            3 ) = ZERO

           DTMP(            4 ) = ZERO

           END              IF

           NORM             = SNRM2( NPM1, A( LIIP1+( LIJ-1 )*LDA ), 1 )

           DTMP(            1 ) = NORM

           DTMP(            5 ) = ZERO

           IF(              DTMP( 1 ).GE.SAFMAX .OR.  DTMP(  1  ).LT.SAFMIN  )
                            THEN

           DTMP(            5 ) = ONE

           DTMP(            1 ) = ZERO

           END              IF

           DTMP(            1 ) = DTMP( 1 )*DTMP( 1 )

           CALL             SGSUM2D(  ICTXT, 'C', ' ', 5, 1, DTMP, 5, -1, CUR-
                            COL )

           IF(              DTMP( 5 ).EQ.ZERO ) THEN

           DTMP(            1 ) = SQRT( DTMP( 1 ) )

           ELSE

           DTMP(            1 ) = NORM

           CALL             PSTREECOMB( ICTXT, 'C', 1, DTMP, -1, MYCOL, SCOMB-
                            NRM2 )

           END              IF

           NORM             = DTMP( 1 )

           D(               LIJ ) = DTMP( 2 )

           IF(              MYROW.EQ.CURROW .AND. MYCOL.EQ.CURCOL ) THEN

           A(               LII+( LIJ-1 )*LDA ) = D( LIJ )

           END              IF

           ALPHA            = DTMP( 3 )

           NORM             = SIGN( NORM, ALPHA )

           IF(              NORM.EQ.ZERO ) THEN

           TOPTAU           = ZERO

           ELSE

           BETA             = NORM + ALPHA

           TOPTAU           = BETA / NORM

           ONEOVERBETA      = 1.0E0 / BETA

           CALL             SSCAL(  NPM1,  ONEOVERBETA, A( LIIP1+( LIJ-1 )*LDA
                            ), 1 )

           END              IF

           IF(              MYROW.EQ.NXTROW ) THEN

           A(               LIIP1+( LIJ-1 )*LDA ) = Z_ONE

           END              IF

           TAU(             LIJ ) = TOPTAU

           E(               LIJ ) = -NORM

           END              IF

           DO               40 I = 0, NPM1 - 1

           WORK(            INV+LIIP1-1+BINDEX*LDV+NPM1+I ) =  A(  LIIP1+I+  (
                            LIJ-1 )*LDA )

           40               CONTINUE

           IF(              MYCOL.EQ.CURCOL ) THEN

           WORK(            INV+LIIP1-1+BINDEX*LDV+NPM1+NPM1 ) = TOPTAU

           CALL             SGEBS2D(  ICTXT,  'R',  ' ', NPM1+NPM1+1, 1, WORK(
                            INV+LIIP1-1+BINDEX*LDV ), NPM1+NPM1+1 )

           ELSE

           CALL             SGEBR2D( ICTXT, 'R', ' ',  NPM1+NPM1+1,  1,  WORK(
                            INV+LIIP1-1+BINDEX*LDV ), NPM1+NPM1+1, MYROW, CUR-
                            COL )

           TOPTAU           = WORK( INV+LIIP1-1+BINDEX*LDV+NPM1+NPM1 )

           END              IF

           DO               50 I = 0, NPM1 - 1

           WORK(            INH+LIIP1-1+(   BINDEX+1   )*LDV+I   )   =   WORK(
                            INV+LIIP1- 1+BINDEX*LDV+NPM1+I )

           50               CONTINUE

           IF(              INDEX.LT.N ) THEN

           IF(              MYROW.EQ.NXTROW .AND. MYCOL.EQ.CURCOL ) A( LIIP1+(
                            LIJ-1 )*LDA ) = E( LIJ )

           END              IF

           IF(              MYROW.EQ.MYCOL ) THEN

           DO               60 I = 0, NPM1 + NPM1

           WORK(            INVT+LIJP1-1+BINDEX*LDV+I ) =  WORK(  INV+LIIP1-1+
                            BINDEX*LDV+I )

           60               CONTINUE

           ELSE

           CALL             SGESD2D(     ICTXT,     NPM1+NPM1,     1,    WORK(
                            INV+LIIP1-1+BINDEX*LDV ), NPM1+NPM1, MYCOL,  MYROW
                            )

           CALL             SGERV2D(     ICTXT,     NQM1+NQM1,     1,    WORK(
                            INVT+LIJP1-1+BINDEX*LDV ), NQM1+NQM1, MYCOL, MYROW
                            )

           END              IF

           DO               70 I = 0, NQM1 - 1

           WORK(            INHT+LIJP1-1+(  BINDEX+1  )*LDV+I  ) = WORK( INVT+
                            LIJP1-1+BINDEX*LDV+NQM1+I )

           70               CONTINUE

           IF(              INDEX.GT.1 ) THEN

           DO               90 J = LIJP1, LIJB - 1

           DO               80 I = 0, NPM1 - 1

           A(               LIIP1+I+( J-1 )*LDA ) = A( LIIP1+I+( J-1 )*LDA ) -
                            WORK(     INV+LIIP1-1+BINDEX*LDV+I     )*    WORK(
                            INHT+J-1+BINDEX*LDV        )        -        WORK(
                            INH+LIIP1-1+BINDEX*LDV+I          )*         WORK(
                            INVT+J-1+BINDEX*LDV )

           80               CONTINUE

           90               CONTINUE

           END              IF

           WORK(            INV+LIIP1-1+( BINDEX+1 )*LDV ) = Z_ZERO

           WORK(            INVT+LIJP1-1+( BINDEX+1 )*LDV+NQM1-1 ) = Z_ZERO

           IF(              MYROW.EQ.MYCOL ) THEN

           IF(              LTNM1.GT.1 ) THEN

           CALL             STRMVT( 'L', LTNM1-1, A( LTLIP1+1+( LIJP1-1  )*LDA
                            ),  LDA, WORK( INVT+LIJP1-1+( BINDEX+1 )*LDV ), 1,
                            WORK( INH+LTLIP1+1-1+( BINDEX+1 )*LDV ), 1,  WORK(
                            INV+LTLIP1+1-1+(  BINDEX+1  )*  LDV  ),  1,  WORK(
                            INHT+LIJP1-1+( BINDEX+ 1 )*LDV ), 1 )

           END              IF

           DO               100 I = 1, LTNM1

           WORK(            INVT+LIJP1+I-1-1+(  BINDEX+1  )*LDV  )   =   WORK(
                            INVT+LIJP1+I-1-1+(   BINDEX+1   )*LDV   )   +   A(
                            LTLIP1+I-1+(   LIJP1+I-1-1    )*LDA    )*    WORK(
                            INH+LTLIP1+I-1-1+( BINDEX+1 )*LDV )

           100              CONTINUE

           ELSE

           IF(              LTNM1.GT.0  ) CALL STRMVT( 'L', LTNM1, A( LTLIP1+(
                            LIJP1-1  )*LDA  ),   LDA,   WORK(   INVT+LIJP1-1+(
                            BINDEX+1 )* LDV ), 1, WORK( INH+LTLIP1-1+( BINDEX+
                            1 )*LDV ), 1, WORK( INV+LTLIP1-1+ ( BINDEX+1 )*LDV
                            ), 1, WORK( INHT+LIJP1-1+( BINDEX+1 )*LDV ), 1 )

           END              IF

           DO               110 I = 1, 2*( BINDEX+1 )

           WORK(            INTMP-1+I ) = 0

           110              CONTINUE

           IF(              BALANCED ) THEN

           NPSET            = NPROW

           MYSETNUM         = MYROW

           ROWSPERPROC      = ICEIL( NQB, NPSET )

           MYFIRSTROW       = MIN( NQB+1, 1+ROWSPERPROC*MYSETNUM )

           NUMROWS          = MIN( ROWSPERPROC, NQB-MYFIRSTROW+1 )

           CALL             SGEMV(   'C',   NUMROWS,  BINDEX+1,  Z_ONE,  WORK(
                            INHTB+MYFIRSTROW-1       ),       LDV,       WORK(
                            INHTB+MYFIRSTROW-1+(  BINDEX+1 )*LDV ), 1, Z_ZERO,
                            WORK( INTMP ), 1 )

           CALL             SGEMV(  'C',  NUMROWS,  BINDEX+1,   Z_ONE,   WORK(
                            INVTB+MYFIRSTROW-1       ),       LDV,       WORK(
                            INHTB+MYFIRSTROW-1+( BINDEX+1 )*LDV ), 1,  Z_ZERO,
                            WORK( INTMP+BINDEX+1 ), 1 )

           CALL             SGSUM2D( ICTXT, 'C', ' ', 2*( BINDEX+1 ), 1, WORK(
                            INTMP ), 2*( BINDEX+1 ), -1, -1 )

           ELSE

           CALL             SGEMV( 'C', NQB, BINDEX+1, Z_ONE, WORK(  INHTB  ),
                            LDV,  WORK(  INHTB+(  BINDEX+1 )*LDV ), 1, Z_ZERO,
                            WORK( INTMP ), 1 )

           CALL             SGEMV( 'C', NQB, BINDEX+1, Z_ONE, WORK(  INVTB  ),
                            LDV,  WORK(  INHTB+(  BINDEX+1 )*LDV ), 1, Z_ZERO,
                            WORK( INTMP+BINDEX+1 ), 1 )

           END              IF

           IF(              BALANCED ) THEN

           MYSETNUM         = MYCOL

           ROWSPERPROC      = ICEIL( NPB, NPSET )

           MYFIRSTROW       = MIN( NPB+1, 1+ROWSPERPROC*MYSETNUM )

           NUMROWS          = MIN( ROWSPERPROC, NPB-MYFIRSTROW+1 )

           CALL             SGSUM2D( ICTXT, 'R', ' ', 2*( BINDEX+1 ), 1, WORK(
                            INTMP ), 2*( BINDEX+1 ), -1, -1 )

           IF(              INDEX.GT.1. ) THEN

           CALL             SGEMV(  'N',  NUMROWS,  BINDEX+1,  Z_NEGONE, WORK(
                            INVB+MYFIRSTROW-1 ), LDV, WORK( INTMP ), 1, Z_ONE,
                            WORK( INVB+MYFIRSTROW-1+( BINDEX+1 )* LDV ), 1 )

           CALL             SGEMV(  'N',  NUMROWS,  BINDEX+1,  Z_NEGONE, WORK(
                            INHB+MYFIRSTROW-1 ), LDV, WORK( INTMP+BINDEX+1  ),
                            1,  Z_ONE,  WORK(  INVB+MYFIRSTROW-1+( BINDEX+1 )*
                            LDV ), 1 )

           END              IF

           ELSE

           CALL             SGEMV( 'N', NPB, BINDEX+1, Z_NEGONE, WORK( INVB ),
                            LDV,   WORK(  INTMP  ),  1,  Z_ONE,  WORK(  INVB+(
                            BINDEX+1 )*LDV ), 1 )

           CALL             SGEMV( 'N', NPB, BINDEX+1, Z_NEGONE, WORK( INHB ),
                            LDV,  WORK(  INTMP+BINDEX+1  ),  1,  Z_ONE,  WORK(
                            INVB+( BINDEX+1 )*LDV ), 1 )

           END              IF

           IF(              MYROW.EQ.MYCOL ) THEN

           DO               120 I = 0, NQM1 - 1

           WORK(            INTMP+I ) = WORK( INVT+LIJP1-1+( BINDEX+1 )*LDV+ I
                            )

           120              CONTINUE

           ELSE

           CALL             SGESD2D(  ICTXT,  NQM1,  1,  WORK(  INVT+LIJP1-1+(
                            BINDEX+1 )*LDV ), NQM1, MYCOL, MYROW )

           CALL             SGERV2D( ICTXT, NPM1,  1,  WORK(  INTMP  ),  NPM1,
                            MYCOL, MYROW )

           END              IF

           DO               130 I = 0, NPM1 - 1

           WORK(            INV+LIIP1-1+(   BINDEX+1   )*LDV+I   )   =   WORK(
                            INV+LIIP1- 1+( BINDEX+1 )*LDV+I ) + WORK(  INTMP+I
                            )

           130              CONTINUE

           CALL             SGSUM2D(   ICTXT,   'R',   '  ',  NPM1,  1,  WORK(
                            INV+LIIP1-1+(  BINDEX+1  )*LDV  ),  NPM1,   MYROW,
                            NXTCOL )

           IF(              MYCOL.EQ.NXTCOL ) THEN

           CC(              1 ) = Z_ZERO

           DO               140 I = 0, NPM1 - 1

           CC(              1  )  =  CC( 1 ) + WORK( INV+LIIP1-1+( BINDEX+1 )*
                            LDV+I )*WORK( INH+LIIP1-1+( BINDEX+1 )*LDV+ I )

           140              CONTINUE

           IF(              MYROW.EQ.NXTROW ) THEN

           CC(              2 ) = WORK( INV+LIIP1-1+( BINDEX+1 )*LDV )

           CC(              3 ) = WORK( INH+LIIP1-1+( BINDEX+1 )*LDV )

           ELSE

           CC(              2 ) = Z_ZERO

           CC(              3 ) = Z_ZERO

           END              IF

           CALL             SGSUM2D( ICTXT, 'C', ' ', 3, 1, CC, 3, -1,  NXTCOL
                            )

           TOPV             = CC( 2 )

           C                = CC( 1 )

           TOPH             = CC( 3 )

           TOPNV            = TOPTAU*( TOPV-C*TOPTAU / 2*TOPH )

           DO               150 I = 0, NPM1 - 1

           WORK(            INV+LIIP1-1+( BINDEX+1 )*LDV+I ) = TOPTAU* ( WORK(
                            INV+LIIP1-1+(  BINDEX+1   )*LDV+I   )-C*TOPTAU   /
                            2*WORK( INH+LIIP1-1+( BINDEX+1 )*LDV+I ) )

           150              CONTINUE

           END              IF

           160              CONTINUE

           IF(              MAXINDEX.LT.N ) THEN

           DO               170 I = 0, NPM1 - 1

           WORK(            INTMP+I ) = WORK( INH+LIIP1-1+ANB*LDV+I )

           170              CONTINUE

           IF(

           IF(              INTERLEAVE ) THEN

           LDZG             = LDV / 2

           ELSE

           CALL             SLACPY(  'A',  LTNM1,  ANB,  WORK( INHT+LIJP1-1 ),
                            LDV, WORK( INVT+LIJP1-1+ANB*LDV ), LDV )

           CALL             SLACPY( 'A', LTNM1,  ANB,  WORK(  INV+LTLIP1-1  ),
                            LDV, WORK( INH+LTLIP1-1+ANB*LDV ), LDV )

           LDZG             = LDV

           END              IF

           NBZG             = ANB*2

           ELSE

           LDZG             = LDV

           NBZG             = ANB

           END              IF

           DO               180 PBMIN = 1, LTNM1, PNB

           PBSIZE           = MIN( PNB, LTNM1-PBMIN+1 )

           PBMAX            = MIN( LTNM1, PBMIN+PNB-1 )

           CALL             SGEMM(  'N',  'C',  PBSIZE, PBMAX, NBZG, Z_NEGONE,
                            WORK(   INH+LTLIP1-1+PBMIN-1   ),   LDZG,    WORK(
                            INVT+LIJP1-1  ),  LDZG, Z_ONE, A( LTLIP1+PBMIN-1+(
                            LIJP1-1 )*LDA ), LDA )

           IF(              TWOGEMMS ) THEN

           CALL             SGEMM( 'N', 'C',  PBSIZE,  PBMAX,  ANB,  Z_NEGONE,
                            WORK(    INV+LTLIP1-1+PBMIN-1   ),   LDZG,   WORK(
                            INHT+LIJP1-1 ), LDZG, Z_ONE,  A(  LTLIP1+PBMIN-1+(
                            LIJP1-1 )*LDA ), LDA )

           END              IF

           180              CONTINUE

           DO               190 I = 0, NPM1 - 1

           WORK(            INV+LIIP1-1+I ) = WORK( INV+LIIP1-1+ANB*LDV+I )

           WORK(            INH+LIIP1-1+I ) = WORK( INTMP+I )

           190              CONTINUE

           DO               200 I = 0, NQM1 - 1

           WORK(            INHT+LIJP1-1+I ) = WORK( INHT+LIJP1-1+ANB*LDV+I )

           200              CONTINUE

           END              IF

           210              CONTINUE

           IF(              MYCOL.EQ.NXTCOL ) THEN

           IF(              MYROW.EQ.NXTROW ) THEN

           D(               NQ ) = A( NP+( NQ-1 )*LDA )

           CALL             SGEBS2D( ICTXT, 'C', ' ', 1, 1, D( NQ ), 1 )

           ELSE

           CALL             SGEBR2D(  ICTXT,  'C',  '  ',  1,  1,  D( NQ ), 1,
                            NXTROW, NXTCOL )

           END              IF

           END              IF

           WORK(            1 ) = REAL( LWMIN )

           RETURN

           END

PURPOSE
ScaLAPACK version 1.7           13 August 2001                     PSSYTTRD(3)