Routine: PSSYNTRD()  File: SRC\pssyntrd.f

 
 
# lines: 551
  # code: 551
  # comment: 0
  # blank:0
# Variables:70
# Callers:1
# Callings:5
# Words:247
# Keywords:135
 

 

 
..
     .. Array Arguments ..
     ..
  Bugs
  ====
  Support for UPLO='U' is limited to calling the old, slow, PSSYTRD
  code.
  Purpose
  =======
  PSSYNTRD is a prototype version of PSSYTRD which uses tailored
  codes (either the serial, SSYTRD, or the parallel code, PSSYTTRD)
  when the workspace provided by the user is adequate.
  PSSYNTRD reduces a real symmetric matrix sub( A ) to symmetric
  tridiagonal form T by an orthogonal similarity transformation:
  Q' * sub( A ) * Q = T, where sub( A ) = A(IA:IA+N-1,JA:JA+N-1).
  Features
  ========
  PSSYNTRD is faster than PSSYTRD on almost all matrices,
  particularly small ones (i.e. N < 500 * sqrt(P) ), provided that
  enough workspace is available to use the tailored codes.
  The tailored codes provide performance that is essentially
  independent of the input data layout.
  The tailored codes place no restrictions on IA, JA, MB or NB.
  At present, IA, JA, MB and NB are restricted to those values allowed
  by PSSYTRD to keep the interface simple.  These restrictions are
  documented below.  (Search for "restrictions".)
  Notes
  =====
  Each global data object is described by an associated description
  vector.  This vector stores the information required to establish
  the mapping between an object element and its corresponding process
  and memory location.
  Let A be a generic term for any 2D block cyclicly distributed array.
  Such a global array has an associated description vector DESCA.
  In the following comments, the character _ should be read as
  "of the global array".
  NOTATION        STORED IN      EXPLANATION
  --------------- -------------- --------------------------------------
  DTYPE_A(global) DESCA( DTYPE_ )The descriptor type.  In this case,
                                 DTYPE_A = 1.
  CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
                                 the BLACS process grid A is distribu-
                                 ted over. The context itself is glo-
                                 bal, but the handle (the integer
                                 value) may vary.
  M_A    (global) DESCA( M_ )    The number of rows in the global
                                 array A.
  N_A    (global) DESCA( N_ )    The number of columns in the global
                                 array A.
  MB_A   (global) DESCA( MB_ )   The blocking factor used to distribute
                                 the rows of the array.
  NB_A   (global) DESCA( NB_ )   The blocking factor used to distribute
                                 the columns of the array.
  RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
                                 row of the array A is distributed.
  CSRC_A (global) DESCA( CSRC_ ) The process column over which the
                                 first column of the array A is
                                 distributed.
  LLD_A  (local)  DESCA( LLD_ )  The leading dimension of the local
                                 array.  LLD_A >= MAX(1,LOCr(M_A)).
  Let K be the number of rows or columns of a distributed matrix,
  and assume that its process grid has dimension p x q.
  LOCr( K ) denotes the number of elements of K that a process
  would receive if K were distributed over the p processes of its
  process column.
  Similarly, LOCc( K ) denotes the number of elements of K that a
  process would receive if K were distributed over the q processes of
  its process row.
  The values of LOCr() and LOCc() may be determined via a call to the
  ScaLAPACK tool function, NUMROC:
          LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
          LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
  An upper bound for these quantities may be computed by:
          LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
          LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
  Arguments
  =========
  UPLO    (global input) CHARACTER
          Specifies whether the upper or lower triangular part of the
          symmetric matrix sub( A ) is stored:
          = 'U':  Upper triangular
          = 'L':  Lower triangular
  N       (global input) INTEGER
          The number of rows and columns to be operated on, i.e. the
          order of the distributed submatrix sub( A ). N >= 0.
  A       (local input/local output) REAL pointer into the
          local memory to an array of dimension (LLD_A,LOCc(JA+N-1)).
          On entry, this array contains the local pieces of the
          symmetric distributed matrix sub( A ).  If UPLO = 'U', the
          leading N-by-N upper triangular part of sub( A ) contains
          the upper triangular part of the matrix, and its strictly
          lower triangular part is not referenced. If UPLO = 'L', the
          leading N-by-N lower triangular part of sub( A ) contains the
          lower triangular part of the matrix, and its strictly upper
          triangular part is not referenced. On exit, if UPLO = 'U',
          the diagonal and first superdiagonal of sub( A ) are over-
          written by the corresponding elements of the tridiagonal
          matrix T, and the elements above the first superdiagonal,
          with the array TAU, represent the orthogonal matrix Q as a
          product of elementary reflectors; if UPLO = 'L', the diagonal
          and first subdiagonal of sub( A ) are overwritten by the
          corresponding elements of the tridiagonal matrix T, and the
          elements below the first subdiagonal, with the array TAU,
          represent the orthogonal matrix Q as a product of elementary
          reflectors. See Further Details.
  IA      (global input) INTEGER
          The row index in the global array A indicating the first
          row of sub( A ).
  JA      (global input) INTEGER
          The column index in the global array A indicating the
          first column of sub( A ).
  DESCA   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix A.
  D       (local output) REAL array, dimension LOCc(JA+N-1)
          The diagonal elements of the tridiagonal matrix T:
          D(i) = A(i,i). D is tied to the distributed matrix A.
  E       (local output) REAL array, dimension LOCc(JA+N-1)
          if UPLO = 'U', LOCc(JA+N-2) otherwise. The off-diagonal
          elements of the tridiagonal matrix T: E(i) = A(i,i+1) if
          UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'. E is tied to the
          distributed matrix A.
  TAU     (local output) REAL, array, dimension
          LOCc(JA+N-1). This array contains the scalar factors TAU of
          the elementary reflectors. TAU is tied to the distributed
          matrix A.
  WORK    (local workspace/local output) REAL array,
                                                  dimension (LWORK)
          On exit, WORK( 1 ) returns the optimal LWORK.
  LWORK   (local or global input) INTEGER
          The dimension of the array WORK.
          LWORK is local input and must be at least
          LWORK >= MAX( NB * ( NP +1 ), 3 * NB )
          For optimal performance, greater workspace is needed, i.e.
            LWORK >= 2*( ANB+1 )*( 4*NPS+2 ) + ( NPS + 4 ) * NPS
            ICTXT = DESCA( CTXT_ )
            ANB = PJLAENV( ICTXT, 3, 'PSSYTTRD', 'L', 0, 0, 0, 0 )
            SQNPC = INT( SQRT( REAL( NPROW * NPCOL ) ) )
            NPS = MAX( NUMROC( N, 1, 0, 0, SQNPC ), 2*ANB )
            NUMROC is a ScaLAPACK tool functions;
            PJLAENV is a ScaLAPACK envionmental inquiry function
            MYROW, MYCOL, NPROW and NPCOL can be determined by calling
            the subroutine BLACS_GRIDINFO.
  INFO    (global output) INTEGER
          = 0:  successful exit
          < 0:  If the i-th argument is an array and the j-entry had
                an illegal value, then INFO = -(i*100+j), if the i-th
                argument is a scalar and had an illegal value, then
                INFO = -i.
  Further Details
  ===============
  If UPLO = 'U', the matrix Q is represented as a product of elementary
  reflectors
     Q = H(n-1) . . . H(2) H(1).
  Each H(i) has the form
     H(i) = I - tau * v * v'
  where tau is a real scalar, and v is a real vector with
  v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
  A(ia:ia+i-2,ja+i), and tau in TAU(ja+i-1).
  If UPLO = 'L', the matrix Q is represented as a product of elementary
  reflectors
     Q = H(1) H(2) . . . H(n-1).
  Each H(i) has the form
     H(i) = I - tau * v * v'
  where tau is a real scalar, and v is a real vector with
  v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in
  A(ia+i+1:ia+n-1,ja+i-1), and tau in TAU(ja+i-1).
  The contents of sub( A ) on exit are illustrated by the following
  examples with n = 5:
  if UPLO = 'U':                       if UPLO = 'L':
    (  d   e   v2  v3  v4 )              (  d                  )
    (      d   e   v3  v4 )              (  e   d              )
    (          d   e   v4 )              (  v1  e   d          )
    (              d   e  )              (  v1  v2  e   d      )
    (                  d  )              (  v1  v2  v3  e   d  )
  where d and e denote diagonal and off-diagonal elements of T, and vi
  denotes an element of the vector defining H(i).
  Alignment requirements
  ======================
  The distributed submatrix sub( A ) must verify some alignment proper-
  ties, namely the following expression should be true:
  ( MB_A.EQ.NB_A .AND. IROFFA.EQ.ICOFFA .AND. IROFFA.EQ.0 ) with
  IROFFA = MOD( IA-1, MB_A ) and ICOFFA = MOD( JA-1, NB_A ).
  =====================================================================
     .. Parameters ..
 
Display dynamic version Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

  
001        SUBROUTINE PSSYNTRD( UPLO , N , A , IA , JA , DESCA , D , E , TAU , WORK ,
002       $LWORK , INFO )
003  
004  *     -- ScaLAPACK routine(version 1.7) --
005  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
006  *     and University of California , Berkeley.
007  *     May 25 , 2001
008  
009  *     .. Scalar Arguments ..
010        CHARACTER UPLO
011        INTEGER IA , INFO , JA , LWORK , N
012        INTEGER BLOCK_CYCLIC_2D , DLEN_ , DTYPE_ , CTXT_ , M_ , N_ ,
013       $MB_ , NB_ , RSRC_ , CSRC_ , LLD_
014        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
015       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
016       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
017        REAL ONE
018        PARAMETER( ONE = 1.0E + 0 )
019  *     ..
020  *     .. Local Scalars ..
021        LOGICAL LQUERY , UPPER
022        CHARACTER COLCTOP , ROWCTOP
023        INTEGER ANB , CTXTB , I , IACOL , IAROW , ICOFFA , ICTXT ,
024       $IINFO , INDB , INDD , INDE , INDTAU , INDW , IPW ,
025       $IROFFA , J , JB , JX , K , KK , LLWORK , LWMIN , MINSZ ,
026       $MYCOL , MYCOLB , MYROW , MYROWB , NB , NP , NPCOL ,
027       $NPCOLB , NPROW , NPROWB , NPS , NQ , ONEPMIN , SQNPC ,
028       $TTLWMIN
029  *     ..
030  *     .. Local Arrays ..
031        INTEGER DESCB( DLEN_ ) , DESCW( DLEN_ ) , IDUM1( 2 ) ,
032       $IDUM2( 2 )
033  *     ..
034  *     .. External Subroutines ..
035        EXTERNAL BLACS_GET , BLACS_GRIDEXIT , BLACS_GRIDINFO ,
036       $BLACS_GRIDINIT , CHK1MAT , DESCSET , IGAMN2D ,
037       $PCHK1MAT , PSELSET , PSLAMR1D , PSLATRD , PSSYR2K ,
038       $PSSYTD2 , PSSYTTRD , PSTRMR2D , PB_TOPGET ,
039       $PB_TOPSET , PXERBLA , SSYTRD
040  *     ..
041  *     .. External Functions ..
042        LOGICAL LSAME
043        INTEGER INDXG2L , INDXG2P , NUMROC , PJLAENV
044        EXTERNAL LSAME , INDXG2L , INDXG2P , NUMROC , PJLAENV
045  *     ..
046  *     .. Intrinsic Functions ..
047        INTRINSIC ICHAR , INT , MAX , MIN , MOD , REAL , SQRT
048  *     ..
049  *     .. Executable Statements ..
050  
051  *     This is just to keep ftnchek and toolpack / 1 happy
052        IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_*
053       $    RSRC_.LT.0 )RETURN
054  *         Get grid parameters
055  
056            ICTXT = DESCA( CTXT_ )
057            CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
058  
059  *         Test the input parameters
060  
061            INFO = 0
062            IF( NPROW.EQ. - 1 ) THEN
063                INFO = - ( 600 + CTXT_ )
064            ELSE
065                CALL CHK1MAT( N , 2 , N , 2 , IA , JA , DESCA , 6 , INFO )
066                UPPER = LSAME( UPLO , 'U' )
067                IF( INFO.EQ.0 ) THEN
068                    NB = DESCA( NB_ )
069                    IROFFA = MOD( IA - 1 , DESCA( MB_ ) )
070                    ICOFFA = MOD( JA - 1 , DESCA( NB_ ) )
071                    IAROW = INDXG2P( IA , NB , MYROW , DESCA( RSRC_ ) , NPROW )
072                    IACOL = INDXG2P( JA , NB , MYCOL , DESCA( CSRC_ ) , NPCOL )
073                    NP = NUMROC( N , NB , MYROW , IAROW , NPROW )
074                    NQ = MAX( 1 , NUMROC( N + JA - 1 , NB , MYCOL , DESCA( CSRC_ ) ,
075       $            NPCOL ) )
076                    LWMIN = MAX(( NP + 1 )*NB , 3*NB )
077                    ANB = PJLAENV( ICTXT , 3 , 'PSSYTTRD' , 'L' , 0 , 0 , 0 , 0 )
078                    MINSZ = PJLAENV( ICTXT , 5 , 'PSSYTTRD' , 'L' , 0 , 0 , 0 , 0 )
079                    SQNPC = INT( SQRT( REAL( NPROW*NPCOL ) ) )
080                    NPS = MAX( NUMROC( N , 1 , 0 , 0 , SQNPC ) , 2*ANB )
081                    TTLWMIN = 2*( ANB + 1 )*( 4*NPS + 2 ) + ( NPS + 4 )*NPS
082  
083                    WORK( 1 ) = REAL( TTLWMIN )
084                    LQUERY =( LWORK.EQ. - 1 )
085                    IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO , 'L' ) ) THEN
086                        INFO = - 1
087  
088  *                     The following two restrictions are not necessary provided
089  *                     that either of the tailored codes are used.
090  
091                    ELSE IF( IROFFA.NE.ICOFFA .OR. ICOFFA.NE.0 ) THEN
092                        INFO = - 5
093                    ELSE IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN
094                        INFO = - ( 600 + NB_ )
095                    ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
096                        INFO = - 11
097                    END IF
098                END IF
099                IF( UPPER ) THEN
100                    IDUM1( 1 ) = ICHAR( 'U' )
101                ELSE
102                    IDUM1( 1 ) = ICHAR( 'L' )
103                END IF
104                IDUM2( 1 ) = 1
105                IF( LWORK.EQ. - 1 ) THEN
106                    IDUM1( 2 ) = - 1
107                ELSE
108                    IDUM1( 2 ) = 1
109                END IF
110                IDUM2( 2 ) = 11
111                CALL PCHK1MAT( N , 2 , N , 2 , IA , JA , DESCA , 6 , 2 , IDUM1 , IDUM2 ,
112       $        INFO )
113            END IF
114  
115            IF( INFO.NE.0 ) THEN
116                CALL PXERBLA( ICTXT , 'PSSYNTRD' , - INFO )
117                RETURN
118            ELSE IF( LQUERY ) THEN
119                RETURN
120            END IF
121  
122  *         Quick return if possible
123  
124            IF( N.EQ.0 )
125       $        RETURN
126  
127                ONEPMIN = N*N + 3*N + 1
128                LLWORK = LWORK
129                CALL IGAMN2D( ICTXT , 'A' , ' ' , 1 , 1 , LLWORK , 1 , 1 , - 1 , - 1 , - 1 ,
130       $        - 1 )
131  
132  *             Use the serial , LAPACK , code : STRD on small matrices if we
133  *             we have enough space.
134  
135                NPROWB = 0
136                IF(( N.LT.MINSZ .OR. SQNPC.EQ.1 ) .AND. LLWORK.GE.ONEPMIN .AND.
137       $        .NOT.UPPER ) THEN
138                NPROWB = 1
139                NPS = N
140            ELSE
141                IF( LLWORK.GE.TTLWMIN .AND. .NOT.UPPER ) THEN
142                    NPROWB = SQNPC
143                END IF
144            END IF
145  
146            IF( NPROWB.GE.1 ) THEN
147                NPCOLB = NPROWB
148                SQNPC = NPROWB
149                INDB = 1
150                INDD = INDB + NPS*NPS
151                INDE = INDD + NPS
152                INDTAU = INDE + NPS
153                INDW = INDTAU + NPS
154                LLWORK = LLWORK - INDW + 1
155  
156                CALL BLACS_GET( ICTXT , 10 , CTXTB )
157                CALL BLACS_GRIDINIT( CTXTB , 'Row major' , SQNPC , SQNPC )
158                CALL BLACS_GRIDINFO( CTXTB , NPROWB , NPCOLB , MYROWB , MYCOLB )
159                CALL DESCSET( DESCB , N , N , 1 , 1 , 0 , 0 , CTXTB , NPS )
160  
161                CALL PSTRMR2D( UPLO , 'N' , N , N , A , IA , JA , DESCA , WORK( INDB ) ,
162       $        1 , 1 , DESCB , ICTXT )
163  
164  *             Only those processors in context CTXTB are needed for a while
165  
166                IF( NPROWB.GT.0 ) THEN
167  
168                    IF( NPROWB.EQ.1 ) THEN
169                        CALL SSYTRD( UPLO , N , WORK( INDB ) , NPS , WORK( INDD ) ,
170       $                WORK( INDE ) , WORK( INDTAU ) , WORK( INDW ) ,
171       $                LLWORK , INFO )
172                    ELSE
173  
174                        CALL PSSYTTRD ( 'L' , N , WORK( INDB ) , 1 , 1 , DESCB ,
175       $                WORK( INDD ) , WORK( INDE ) ,
176       $                WORK( INDTAU ) , WORK( INDW ) , LLWORK ,
177       $                INFO )
178  
179                    END IF
180                END IF
181  
182  *             All processors participate in moving the data back to the
183  *             way that PSSYNTRD expects it.
184  
185                CALL PSLAMR1D ( N - 1 , WORK( INDE ) , 1 , 1 , DESCB , E , 1 , JA ,
186       $        DESCA )
187  
188                CALL PSLAMR1D ( N , WORK( INDD ) , 1 , 1 , DESCB , D , 1 , JA , DESCA )
189  
190                CALL PSLAMR1D ( N , WORK( INDTAU ) , 1 , 1 , DESCB , TAU , 1 , JA ,
191       $        DESCA )
192  
193                CALL PSTRMR2D( UPLO , 'N' , N , N , WORK( INDB ) , 1 , 1 , DESCB , A ,
194       $        IA , JA , DESCA , ICTXT )
195  
196                IF( MYROWB.GE.0 )
197       $            CALL BLACS_GRIDEXIT( CTXTB )
198  
199                ELSE
200  
201                    CALL PB_TOPGET( ICTXT , 'Combine' , 'Columnwise' , COLCTOP )
202                    CALL PB_TOPGET( ICTXT , 'Combine' , 'Rowwise' , ROWCTOP )
203                    CALL PB_TOPSET( ICTXT , 'Combine' , 'Columnwise' , '1 - tree' )
204                    CALL PB_TOPSET( ICTXT , 'Combine' , 'Rowwise' , '1 - tree' )
205  
206                    IPW = NP*NB + 1
207  
208                    IF( UPPER ) THEN
209  
210  *                     Reduce the upper triangle of sub( A ).
211  
212                        KK = MOD( JA + N - 1 , NB )
213                        IF( KK.EQ.0 )
214       $                    KK = NB
215                            CALL DESCSET( DESCW , N , NB , NB , NB , IAROW ,
216       $                    INDXG2P( JA + N - KK , NB , MYCOL , DESCA( CSRC_ ) ,
217       $                    NPCOL ) , ICTXT , MAX( 1 , NP ) )
218  
219                            DO 10 K = N - KK + 1 , NB + 1 , - NB
220                                JB = MIN( N - K + 1 , NB )
221                                I = IA + K - 1
222                                J = JA + K - 1
223  
224  *                             Reduce columns I : I + NB - 1 to tridiagonal form and form
225  *                             the matrix W which is needed to update the unreduced part of
226  *                             the matrix
227  
228                                CALL PSLATRD ( UPLO , K + JB - 1 , JB , A , IA , JA , DESCA , D , E ,
229       $                        TAU , WORK , 1 , 1 , DESCW , WORK( IPW ) )
230  
231  *                             Update the unreduced submatrix A(IA : I - 1 , JA : J - 1) , using an
232  *                             update of the form :
233  *                             A(IA : I - 1 , JA : J - 1) := A(IA : I - 1 , JA : J - 1) - V*W' - W*V'
234  
235                                CALL PSSYR2K( UPLO , 'No transpose' , K - 1 , JB , - ONE , A , IA ,
236       $                        J , DESCA , WORK , 1 , 1 , DESCW , ONE , A , IA ,
237       $                        JA , DESCA )
238  
239  *                             Copy last superdiagonal element back into sub( A )
240  
241                                JX = MIN( INDXG2L( J , NB , 0 , IACOL , NPCOL ) , NQ )
242                                CALL PSELSET( A , I - 1 , J , DESCA , E( JX ) )
243  
244                                DESCW( CSRC_ ) = MOD( DESCW( CSRC_ ) + NPCOL - 1 , NPCOL )
245  
246     10                     CONTINUE
247  
248  *                         Use unblocked code to reduce the last or only block
249  
250                            CALL PSSYTD2 ( UPLO , MIN( N , NB ) , A , IA , JA , DESCA , D , E ,
251       $                    TAU , WORK , LWORK , IINFO )
252  
253                        ELSE
254  
255  *                         Reduce the lower triangle of sub( A )
256  
257                            KK = MOD( JA + N - 1 , NB )
258                            IF( KK.EQ.0 )
259       $                        KK = NB
260                                CALL DESCSET( DESCW , N , NB , NB , NB , IAROW , IACOL , ICTXT ,
261       $                        MAX( 1 , NP ) )
262  
263                                DO 20 K = 1 , N - NB , NB
264                                    I = IA + K - 1
265                                    J = JA + K - 1
266  
267  *                                 Reduce columns I : I + NB - 1 to tridiagonal form and form
268  *                                 the matrix W which is needed to update the unreduced part
269  *                                 of the matrix
270  
271                                    CALL PSLATRD ( UPLO , N - K + 1 , NB , A , I , J , DESCA , D , E , TAU ,
272       $                            WORK , K , 1 , DESCW , WORK( IPW ) )
273  
274  *                                 Update the unreduced submatrix A(I + NB : IA + N - 1 , I + NB : IA + N - 1) ,
275  *                                 using an update of the form : A(I + NB : IA + N - 1 , I + NB : IA + N - 1) :=
276  *                                 A(I + NB : IA + N - 1 , I + NB : IA + N - 1) - V*W' - W*V'
277  
278                                    CALL PSSYR2K( UPLO , 'No transpose' , N - K - NB + 1 , NB , - ONE ,
279       $                            A , I + NB , J , DESCA , WORK , K + NB , 1 , DESCW ,
280       $                            ONE , A , I + NB , J + NB , DESCA )
281  
282  *                                 Copy last subdiagonal element back into sub( A )
283  
284                                    JX = MIN( INDXG2L( J + NB - 1 , NB , 0 , IACOL , NPCOL ) , NQ )
285                                    CALL PSELSET( A , I + NB , J + NB - 1 , DESCA , E( JX ) )
286  
287                                    DESCW( CSRC_ ) = MOD( DESCW( CSRC_ ) + 1 , NPCOL )
288  
289     20                         CONTINUE
290  
291  *                             Use unblocked code to reduce the last or only block
292  
293                                CALL PSSYTD2 ( UPLO , KK , A , IA + K - 1 , JA + K - 1 , DESCA , D , E , TAU ,
294       $                        WORK , LWORK , IINFO )
295                            END IF
296  
297                            CALL PB_TOPSET( ICTXT , 'Combine' , 'Columnwise' , COLCTOP )
298                            CALL PB_TOPSET( ICTXT , 'Combine' , 'Rowwise' , ROWCTOP )
299  
300                        END IF
301  
302                        WORK( 1 ) = REAL( TTLWMIN )
303  
304                        RETURN
305  
306  *                     End of PSSYNTRD
307  
308                    END