Routine PSLAED1() Documented By Universal Report

Routine: PSLAED1()

File: SRC\pslaed1.f

# lines:	271
# code:	271
# comment:	0
# blank:	0
# Variables:	69
# Callers:	1
# Callings:	4
# Words:	112
# Keywords:	62

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PSLAED1 computes the updated eigensystem of a diagonal
  matrix after modification by a rank-one symmetric matrix,
  in parallel.
    T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)
     where Z = Q'u, u is a vector of length N with ones in the
     N1 and N1 + 1 th elements and zeros elsewhere.
     The eigenvectors of the original matrix are stored in Q, and the
     eigenvalues are in D.  The algorithm consists of three stages:
        The first stage consists of deflating the size of the problem
        when there are multiple eigenvalues or if there is a zero in
        the Z vector.  For each such occurence the dimension of the
        secular equation problem is reduced by one.  This stage is
        performed by the routine PSLAED2.
        The second stage consists of calculating the updated
        eigenvalues. This is done by finding the roots of the secular
        equation via the routine SLAED4 (as called by PSLAED3).
        This routine also calculates the eigenvectors of the current
        problem.
        The final stage consists of computing the updated eigenvectors
        directly using the updated eigenvalues.  The eigenvectors for
        the current problem are multiplied with the eigenvectors from
        the overall problem.
  Arguments
  =========
  N       (global input) INTEGER
          The order of the tridiagonal matrix T.  N >= 0.
  N1      (input) INTEGER
          The location of the last eigenvalue in the leading
          sub-matrix.
          min(1,N) <= N1 <= N.
  D       (global input/output) REAL array, dimension (N)
          On entry,the eigenvalues of the rank-1-perturbed matrix.
          On exit, the eigenvalues of the repaired matrix.
  ID      (global input) INTEGER
          Q's global row/col index, which points to the beginning
          of the submatrix which is to be operated on.
  Q       (local output) REAL array,
          global dimension (N, N),
          local dimension ( LLD_Q, LOCc(JQ+N-1))
          Q  contains the orthonormal eigenvectors of the symmetric
          tridiagonal matrix.
  IQ      (global input) INTEGER
          Q's global row index, which points to the beginning of the
          submatrix which is to be operated on.
  JQ      (global input) INTEGER
          Q's global column index, which points to the beginning of
          the submatrix which is to be operated on.
  DESCQ   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix Z.
  RHO    (input) REAL
         The subdiagonal entry used to create the rank-1 modification.
  WORK    (local workspace/output) REAL array,
          dimension 6*N + 2*NP*NQ
  IWORK   (local workspace/output) INTEGER array,
          dimension 7*N + 8*NPCOL + 2
  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.
          > 0:  The algorithm failed to compute the ith eigenvalue.
  =====================================================================
     .. Parameters ..

Display dynamic version

FontSize: - +

001        SUBROUTINE PSLAED1( N , N1 , D , ID , Q , IQ , JQ , DESCQ , RHO , WORK ,
002       $IWORK , INFO )
003  
004  *     -- ScaLAPACK auxiliary routine(version 1.7) --
005  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
006  *     and University of California , Berkeley.
007  *     December 31 , 1998
008  
009  *     .. Scalar Arguments ..
010        INTEGER ID , INFO , IQ , JQ , N , N1
011        REAL RHO
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 ZERO , ONE
018        PARAMETER( ZERO = 0.0E + 0 , ONE = 1.0E + 0 )
019  *     ..
020  *     .. Local Scalars ..
021        INTEGER COL , COLTYP , IBUF , ICTOT , ICTXT , IDLMDA , IIQ ,
022       $INDCOL , INDROW , INDX , INDXC , INDXP , INDXR , INQ ,
023       $IPQ , IPQ2 , IPSM , IPU , IPWORK , IQ1 , IQ2 , IQCOL ,
024       $IQQ , IQROW , IW , IZ , J , JC , JJ2C , JJC , JJQ , JNQ ,
025       $K , LDQ , LDQ2 , LDU , MYCOL , MYROW , NB , NN , NN1 ,
026       $NN2 , NP , NPCOL , NPROW , NQ
027  *     ..
028  *     .. Local Arrays ..
029        INTEGER DESCQ2( DLEN_ ) , DESCU( DLEN_ )
030  *     ..
031  *     .. External Functions ..
032        INTEGER NUMROC
033        EXTERNAL NUMROC
034  *     ..
035  *     .. External Subroutines ..
036        EXTERNAL BLACS_GRIDINFO , DESCINIT , INFOG1L , INFOG2L ,
037       $PSGEMM , PSLAED2 , PSLAED3 , PSLAEDZ , PSLASET ,
038       $PXERBLA , SCOPY
039  *     ..
040  *     .. Intrinsic Functions ..
041        INTRINSIC MAX , MIN
042  *     ..
043  *     .. Executable Statements ..
044  
045  *     This is just to keep ftnchek and toolpack / 1 happy
046        IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_*
046               
047       $    RSRC_.LT.0 )RETURN
048  
049  *         Test the input parameters.
050  
051            CALL BLACS_GRIDINFO( DESCQ( CTXT_ ) , NPROW , NPCOL , MYROW , MYCOL )
052            INFO = 0
053            IF( NPROW.EQ. - 1 ) THEN
053                   
054                INFO = - ( 600 + CTXT_ )
055            ELSE IF( N.LT.0 ) THEN
055                   
056                INFO = - 1
057            ELSE IF( ID.GT.DESCQ( N_ ) ) THEN
057                   
058                INFO = - 4
059            ELSE IF( N1.GE.N ) THEN
059                   
060                INFO = - 2
061            END IF
062            IF( INFO.NE.0 ) THEN
062                   
063                CALL PXERBLA( DESCQ( CTXT_ ) , 'PSLAED1' , - INFO )
064                RETURN
065            END IF
066  
067  *         Quick return if possible
068  
069            IF( N.EQ.0 )
069                   
070       $        RETURN
071  
072  *             The following values are integer pointers which indicate
073  *             the portion of the workspace used by a particular array
074  *             in PSLAED2 and PSLAED3.
075  
076                ICTXT = DESCQ( CTXT_ )
077                NB = DESCQ( NB_ )
078                LDQ = DESCQ( LLD_ )
079  
080                CALL INFOG2L( IQ - 1 + ID , JQ - 1 + ID , DESCQ , NPROW , NPCOL , MYROW , MYCOL ,
081       $        IIQ , JJQ , IQROW , IQCOL )
082  
083                NP = NUMROC( N , DESCQ( MB_ ) , MYROW , IQROW , NPROW )
084                NQ = NUMROC( N , DESCQ( NB_ ) , MYCOL , IQCOL , NPCOL )
085  
086                LDQ2 = MAX( NP , 1 )
087                LDU = LDQ2
088  
089                IZ = 1
090                IDLMDA = IZ + N
091                IW = IDLMDA + N
092                IPQ2 = IW + N
093                IPU = IPQ2 + LDQ2*NQ
094                IBUF = IPU + LDU*NQ
095  *             (IBUF est de taille 3*N au maximum)
096  
097                ICTOT = 1
098                IPSM = ICTOT + NPCOL*4
099                INDX = IPSM + NPCOL*4
100                INDXC = INDX + N
101                INDXP = INDXC + N
102                INDCOL = INDXP + N
103                COLTYP = INDCOL + N
104                INDROW = COLTYP + N
105                INDXR = INDROW + N
106  
107                CALL DESCINIT( DESCQ2 , N , N , NB , NB , IQROW , IQCOL , ICTXT , LDQ2 ,
108       $        INFO )
109                CALL DESCINIT( DESCU , N , N , NB , NB , IQROW , IQCOL , ICTXT , LDU ,
110       $        INFO )
111  
112  *             Form the z - vector which consists of the last row of Q_1 and the
113  *             first row of Q_2.
114  
115                IPWORK = IDLMDA
116                CALL PSLAEDZ ( N , N1 , ID , Q , IQ , JQ , LDQ , DESCQ , WORK( IZ ) ,
117       $        WORK( IPWORK ) )
118  
119  *             Deflate eigenvalues.
120  
121                IPQ = IIQ + ( JJQ - 1 )*LDQ
122                CALL PSLAED2 ( ICTXT , K , N , N1 , NB , D , IQROW , IQCOL , Q( IPQ ) , LDQ ,
123       $        RHO , WORK( IZ ) , WORK( IW ) , WORK( IDLMDA ) ,
124       $        WORK( IPQ2 ) , LDQ2 , WORK( IBUF ) , IWORK( ICTOT ) ,
125       $        IWORK( IPSM ) , NPCOL , IWORK( INDX ) , IWORK( INDXC ) ,
126       $        IWORK( INDXP ) , IWORK( INDCOL ) , IWORK( COLTYP ) ,
127       $        NN , NN1 , NN2 , IQ1 , IQ2 )
128  
129  *             Solve Secular Equation.
130  
131                IF( K.NE.0 ) THEN
131                       
132                    CALL PSLASET ( 'A' , N , N , ZERO , ONE , WORK( IPU ) , 1 , 1 , DESCU )
133                    CALL PSLAED3 ( ICTXT , K , N , NB , D , IQROW , IQCOL , RHO ,
134       $            WORK( IDLMDA ) , WORK( IW ) , WORK( IZ ) ,
135       $            WORK( IPU ) , LDQ2 , WORK( IBUF ) , IWORK( INDX ) ,
136       $            IWORK( INDCOL ) , IWORK( INDROW ) , IWORK( INDXR ) ,
137       $            IWORK( INDXC ) , IWORK( ICTOT ) , NPCOL , INFO )
138  
139  *                 Compute the updated eigenvectors.
140  
141                    IQQ = MIN( IQ1 , IQ2 )
142                    IF( NN1.GT.0 ) THEN
142                           
143                        INQ = IQ - 1 + ID
144                        JNQ = JQ - 1 + ID + IQQ - 1
145                        CALL PSGEMM( 'N' , 'N' , N1 , NN , NN1 , ONE , WORK( IPQ2 ) , 1 ,
146       $                IQ1 , DESCQ2 , WORK( IPU ) , IQ1 , IQQ , DESCU ,
147       $                ZERO , Q , INQ , JNQ , DESCQ )
148                    END IF
149                    IF( NN2.GT.0 ) THEN
149                           
150                        INQ = IQ - 1 + ID + N1
151                        JNQ = JQ - 1 + ID + IQQ - 1
152                        CALL PSGEMM( 'N' , 'N' , N - N1 , NN , NN2 , ONE , WORK( IPQ2 ) ,
153       $                N1 + 1 , IQ2 , DESCQ2 , WORK( IPU ) , IQ2 , IQQ ,
154       $                DESCU , ZERO , Q , INQ , JNQ , DESCQ )
155                    END IF
156  
157                    DO 10 J = K + 1 , N
157                           
158                        JC = IWORK( INDX + J - 1 )
159                        CALL INFOG1L( JQ - 1 + JC , NB , NPCOL , MYCOL , IQCOL , JJC , COL )
160                        CALL INFOG1L( JC , NB , NPCOL , MYCOL , IQCOL , JJ2C , COL )
161                        IF( MYCOL.EQ.COL ) THEN
161                               
162                            IQ2 = IPQ2 + ( JJ2C - 1 )*LDQ2
163                            INQ = IPQ + ( JJC - 1 )*LDQ
164                            CALL SCOPY( NP , WORK( IQ2 ) , 1 , Q( INQ ) , 1 )
165                        END IF
166     10             CONTINUE
166                   
167                END IF
168  
169     20 CONTINUE
170        RETURN
171  
172  *     End of PSLAED1
173  
174        END3027

Variables in Routine PSLAED1()

Summary Report
Data Type	Quantity	Size(byte)
INTEGER	66	264
REAL	3	12
TOTAL	69	276

List of Variables

INTEGER

BLOCK_CYCLIC_2D COL COLTYP CSRC_ CTXT_
DESCQ2( DLEN_ ) DESCU( DLEN_ ) DLEN_ DTYPE_ IBUF
ICTOT ICTXT ID IDLMDA IIQ
INDCOL INDROW INDX INDXC INDXP
INDXR INFO INQ IPQ IPQ2
IPSM IPU IPWORK IQ IQ1
IQ2 IQCOL IQQ IQROW IW
IZ J JC JJ2C JJC
JJQ JNQ JQ K LDQ
LDQ2 LDU LLD_ M_ MB_
MYCOL MYROW N N_ N1
NB NB_ NN NN1 NN2
NP NPCOL NPROW NQ NUMROC
RSRC_

REAL

ONE RHO ZERO

Variables Dependence Graph
Put the mouse over a right hand side variable to display the corresponding line of the dependence
-
- -
COLTYP <--- INDCOLCOLTYP = INDCOL + N, NCOLTYP = INDCOL + N

IBUF <--- IPUIBUF = IPU + LDU*NQ, LDUIBUF = IPU + LDU*NQ, NQIBUF = IPU + LDU*NQ

ICTXT <--- CTXT_ICTXT = DESCQ( CTXT_ )

IDLMDA <--- IZIDLMDA = IZ + N, NIDLMDA = IZ + N

INDCOL <--- INDXPINDCOL = INDXP + N, NINDCOL = INDXP + N

INDROW <--- COLTYPINDROW = COLTYP + N, NINDROW = COLTYP + N

INDX <--- IPSMINDX = IPSM + NPCOL*4, NPCOLINDX = IPSM + NPCOL*4

INDXC <--- INDXINDXC = INDX + N, NINDXC = INDX + N

INDXP <--- INDXCINDXP = INDXC + N, NINDXP = INDXC + N

INDXR <--- INDROWINDXR = INDROW + N, NINDXR = INDROW + N

INFO <--- CTXT_INFO = -( 600+CTXT_ )

INQ <--- IDINQ = IQ - 1 + ID{2INQ = IQ - 1 + ID + N1}, IPQINQ = IPQ + ( JJC-1 )*LDQ, IQINQ = IQ - 1 + ID{2INQ = IQ - 1 + ID + N1}, JJCINQ = IPQ + ( JJC-1 )*LDQ, LDQINQ = IPQ + ( JJC-1 )*LDQ, N1INQ = IQ - 1 + ID + N1

IPQ <--- IIQIPQ = IIQ + ( JJQ-1 )*LDQ, JJQIPQ = IIQ + ( JJQ-1 )*LDQ, LDQIPQ = IIQ + ( JJQ-1 )*LDQ

IPQ2 <--- IWIPQ2 = IW + N, NIPQ2 = IW + N

IPSM <--- ICTOTIPSM = ICTOT + NPCOL*4, NPCOLIPSM = ICTOT + NPCOL*4

IPU <--- IPQ2IPU = IPQ2 + LDQ2*NQ, LDQ2IPU = IPQ2 + LDQ2*NQ, NQIPU = IPQ2 + LDQ2*NQ

IPWORK <--- IDLMDAIPWORK = IDLMDA

IQ2 <--- IPQ2IQ2 = IPQ2 + ( JJ2C-1 )*LDQ2, JJ2CIQ2 = IPQ2 + ( JJ2C-1 )*LDQ2, LDQ2IQ2 = IPQ2 + ( JJ2C-1 )*LDQ2

IQQ <--- IQ1IQQ = MIN( IQ1, IQ2 ), IQ2IQQ = MIN( IQ1, IQ2 )

IW <--- IDLMDAIW = IDLMDA + N, NIW = IDLMDA + N

J <--- KDO 10 J = K + 1, N, NDO 10 J = K + 1, N

JC <--- INDXJC = IWORK( INDX+J-1 ), JJC = IWORK( INDX+J-1 )

JNQ <--- IDJNQ = JQ - 1 + ID + IQQ - 1{2JNQ = JQ - 1 + ID + IQQ - 1}, IQQJNQ = JQ - 1 + ID + IQQ - 1{2JNQ = JQ - 1 + ID + IQQ - 1}, JQJNQ = JQ - 1 + ID + IQQ - 1{2JNQ = JQ - 1 + ID + IQQ - 1}

LDQ <--- LLD_LDQ = DESCQ( LLD_ )

LDQ2 <--- NPLDQ2 = MAX( NP, 1 )

LDU <--- LDQ2LDU = LDQ2

NB <--- NB_NB = DESCQ( NB_ )

NP <--- IQROW, MB_, MYROW, N, NPROW, NUMROC

NQ <--- IQCOL, MYCOL, N, NB_, NPCOL, NUMROC