Routine PSLASRT() Documented By Universal Report

Routine: PSLASRT()

File: SRC\pslasrt.f

# lines:	254
# code:	254
# comment:	0
# blank:	0
# Variables:	59
# Callers:	1
# Callings:	1
# Words:	139
# Keywords:	92

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PSLASRT Sort the numbers in D in increasing order and the
  corresponding vectors in Q.
  Arguments
  =========
  ID      (global input) CHARACTER*1
          = 'I': sort D in increasing order;
          = 'D': sort D in decreasing order. (NOT IMPLEMENTED YET)
  N       (global input) INTEGER
          The number of columns to be operated on i.e the number of
          columns of the distributed submatrix sub( Q ). N >= 0.
  D       (global input/output) REAL array, dimmension (N)
          On exit, the number in D are sorted in increasing order.
  Q       (local input) REAL pointer into the local memory
          to an array of dimension (LLD_Q, LOCc(JQ+N-1) ). This array
          contains the local pieces of the distributed matrix sub( A )
          to be copied from.
  IQ      (global input) INTEGER
          The row index in the global array A indicating the first
          row of sub( Q ).
  JQ      (global input) INTEGER
          The column index in the global array A indicating the
          first column of sub( Q ).
  DESCQ   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix A.
  WORK    (local workspace/local output) REAL array,
                                                  dimension (LWORK)
  LWORK   (local or global input) INTEGER
          The dimension of the array WORK.
          LWORK = MAX( N, NP * ( NB + NQ ))
          where
          NP = NUMROC( N, NB, MYROW, IAROW, NPROW ),
          NQ = NUMROC( N, NB, MYCOL, DESCQ( CSRC_ ), NPCOL )
  IWORK   (local workspace/local output) INTEGER array,
                                                  dimension (LIWORK)
  LIWORK (local or global input) INTEGER
          The dimension of the array IWORK.
          LIWORK = N + 2*NB + 2*NPCOL
  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.
  =====================================================================
     .. Parameters ..

Display dynamic version

FontSize: - +

001        SUBROUTINE PSLASRT( ID , N , D , Q , IQ , JQ , DESCQ , WORK , LWORK ,
002       $IWORK , LIWORK , 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  *     February 22 , 2000
008  
009  *     .. Scalar Arguments ..
010        CHARACTER ID
011        INTEGER INFO , IQ , JQ , LIWORK , 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  *     ..
018  *     .. Local Scalars ..
019        INTEGER CL , COL , DUMMY , I , ICTXT , IID , IIQ , INDCOL ,
020       $INDX , INDXC , INDXG , IPQ , IPQ2 , IPW , IPWORK , J ,
021       $JJQ , K , L , LDQ , LEND , LIWMIN , LWMIN , MYCOL ,
022       $MYROW , NB , ND , NP , NPCOL , NPROW , NQ , PSQ , QCOL ,
023       $QTOT , SBUF
024  *     ..
025  *     .. External Functions ..
026        LOGICAL LSAME
027        INTEGER INDXG2L , INDXG2P , NUMROC
028        EXTERNAL INDXG2L , INDXG2P , LSAME , NUMROC
029  *     ..
030  *     .. External Subroutines ..
031        EXTERNAL BLACS_GRIDINFO , CHK1MAT , PXERBLA , SCOPY ,
032       $SGERV2D , SGESD2D , SLACPY , SLAPST  
033  *     ..
034  *     .. Intrinsic Functions ..
035        INTRINSIC MAX , MIN , MOD
036  *     ..
037  *     .. Executable Statements ..
038  
039  *     This is just to keep ftnchek and toolpack / 1 happy
040        IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_*
040               
041       $    RSRC_.LT.0 )RETURN
042  
043            IF( N.EQ.0 )
043                   
044       $        RETURN
045  
046                CALL BLACS_GRIDINFO( DESCQ( CTXT_ ) , NPROW , NPCOL , MYROW , MYCOL )
047  
048  *             Test the input parameters
049  
050                INFO = 0
051                IF( NPROW.EQ. - 1 ) THEN
051                       
052                    INFO = - ( 600 + CTXT_ )
053                ELSE
053                       
054                    CALL CHK1MAT( N , 1 , N , 1 , IQ , JQ , DESCQ , 6 , INFO )
055                    IF( INFO.EQ.0 ) THEN
055                           
056                        NB = DESCQ( NB_ )
057                        LDQ = DESCQ( LLD_ )
058                        NP = NUMROC( N , NB , MYROW , DESCQ( RSRC_ ) , NPROW )
059                        NQ = NUMROC( N , NB , MYCOL , DESCQ( CSRC_ ) , NPCOL )
060                        LWMIN = MAX( N , NP*( NB + NQ ) )
061                        LIWMIN = N + 2*( NB + NPCOL )
062                        IF( .NOT.LSAME( ID , 'I' ) ) THEN
062                               
063                            INFO = - 1
064                        ELSE IF( N.LT.0 ) THEN
064                               
065                            INFO = - 2
066                        ELSE IF( LWORK.LT.LWMIN ) THEN
066                               
067                            INFO = - 9
068                        ELSE IF( LIWORK.LT.LIWMIN ) THEN
068                               
069                            INFO = - 11
070                        END IF
071                    END IF
072                END IF
073  
074                IF( INFO.NE.0 ) THEN
074                       
075                    CALL PXERBLA( ICTXT , 'PSLASRT' , - INFO )
076                    RETURN
077                END IF
078  
079  *             Set Pointers
080  
081                INDXC = 1
082                INDX = INDXC + N
083                INDXG = INDX
084                INDCOL = INDXG + NB
085                QTOT = INDCOL + NB
086                PSQ = QTOT + NPCOL
087  
088                IID = 1
089                IPQ2 = 1
090                IPW = IPQ2 + NP*NQ
091  
092                DUMMY = 0
093                IIQ = INDXG2L( IQ , NB , DUMMY , DUMMY , NPROW )
094  
095  *             Sort the eigenvalues in D
096  
097                CALL SLAPST ( 'I' , N , D , IWORK( INDX ) , INFO )
098  
099                DO 10 L = 0 , N - 1
099                       
100                    WORK( IID + L ) = D( IWORK( INDX + L ) )
101                    IWORK( INDXC - 1 + IWORK( INDX + L ) ) = IID + L
102     10         CONTINUE
102                   
103                CALL SCOPY( N , WORK , 1 , D , 1 )
104  
105                ND = 0
106     20 CONTINUE
107        IF( ND.LT.N ) THEN
107               
108            LEND = MIN( NB , N - ND )
109            J = JQ + ND
110            QCOL = INDXG2P( J , NB , DUMMY , DESCQ( CSRC_ ) , NPCOL )
111            K = 0
112            DO 30 L = 0 , LEND - 1
112                   
113                I = JQ - 1 + IWORK( INDXC + ND + L )
114                CL = INDXG2P( I , NB , DUMMY , DESCQ( CSRC_ ) , NPCOL )
115                IWORK( INDCOL + L ) = CL
116                IF( MYCOL.EQ.CL ) THEN
116                       
117                    IWORK( INDXG + K ) = IWORK( INDXC + ND + L )
118                    K = K + 1
119                END IF
120     30     CONTINUE
121  
121               
122            IF( MYCOL.EQ.QCOL ) THEN
122                   
123                DO 40 CL = 0 , NPCOL - 1
123                       
124                    IWORK( QTOT + CL ) = 0
125     40         CONTINUE
125                   
126                DO 50 L = 0 , LEND - 1
126                       
127                    IWORK( QTOT + IWORK( INDCOL + L ) ) = IWORK( QTOT +
128       $            IWORK( INDCOL + L ) ) + 1
129     50         CONTINUE
129                   
130                IWORK( PSQ ) = 1
131                DO 60 CL = 1 , NPCOL - 1
131                       
132                    IWORK( PSQ + CL ) = IWORK( PSQ + CL - 1 ) + IWORK( QTOT + CL - 1 )
133     60         CONTINUE
133                   
134                DO 70 L = 0 , LEND - 1
134                       
135                    CL = IWORK( INDCOL + L )
136                    I = JQ + ND + L
137                    JJQ = INDXG2L( I , NB , DUMMY , DUMMY , NPCOL )
138                    IPQ = IIQ + ( JJQ - 1 )*LDQ
139                    IPWORK = IPW + ( IWORK( PSQ + CL ) - 1 )*NP
140                    CALL SCOPY( NP , Q( IPQ ) , 1 , WORK( IPWORK ) , 1 )
141                    IWORK( PSQ + CL ) = IWORK( PSQ + CL ) + 1
142     70         CONTINUE
142                   
143                IWORK( PSQ ) = 1
144                DO 80 CL = 1 , NPCOL - 1
144                       
145                    IWORK( PSQ + CL ) = IWORK( PSQ + CL - 1 ) + IWORK( QTOT + CL - 1 )
146     80         CONTINUE
146                   
147                DO 90 L = 0 , K - 1
147                       
148                    I = IWORK( INDXG + L )
149                    JJQ = INDXG2L( I , NB , DUMMY , DUMMY , NPCOL )
150                    IPQ = IPQ2 + ( JJQ - 1 )*NP
151                    IPWORK = IPW + ( IWORK( PSQ + MYCOL ) - 1 )*NP
152                    CALL SCOPY( NP , WORK( IPWORK ) , 1 , WORK( IPQ ) , 1 )
153                    IWORK( PSQ + MYCOL ) = IWORK( PSQ + MYCOL ) + 1
154     90         CONTINUE
154                   
155                DO 100 CL = 1 , NPCOL - 1
155                       
156                    COL = MOD( MYCOL + CL , NPCOL )
157                    SBUF = IWORK( QTOT + COL )
158                    IF( SBUF.NE.0 ) THEN
158                           
159                        IPWORK = IPW + ( IWORK( PSQ + COL ) - 1 )*NP
160                        CALL SGESD2D( DESCQ( CTXT_ ) , NP , SBUF ,
161       $                WORK( IPWORK ) , NP , MYROW , COL )
162                    END IF
163    100         CONTINUE
164  
164               
165            ELSE
166  
166                   
167                IF( K.NE.0 ) THEN
167                       
168                    CALL SGERV2D( DESCQ( CTXT_ ) , NP , K , WORK( IPW ) , NP ,
169       $            MYROW , QCOL )
170                    DO 110 L = 0 , K - 1
170                           
171                        I = JQ - 1 + IWORK( INDXG + L )
172                        JJQ = INDXG2L( I , NB , DUMMY , DUMMY , NPCOL )
173                        IPQ = 1 + ( JJQ - 1 )*NP
174                        IPWORK = IPW + L*NP
175                        CALL SCOPY( NP , WORK( IPWORK ) , 1 , WORK( IPQ ) , 1 )
176    110             CONTINUE
176                   
177                END IF
178            END IF
179            ND = ND + NB
180            GO TO 20
181        END IF
182        CALL SLACPY( 'Full' , NP , NQ , WORK , NP , Q( IIQ ) , LDQ )
183  
184  *     End of PSLASRT
185  
186        END2021

Variables in Routine PSLASRT()

Summary Report
Data Type	Quantity	Size(byte)
CHARACTER	1	1
INTEGER	56	224
LOGICAL	1	1
REAL	1	4
TOTAL	59	230

List of Variables

CHARACTER

ID

INTEGER

BLOCK_CYCLIC_2D CL COL CSRC_ CTXT_
DLEN_ DTYPE_ DUMMY I ICTXT
IID IIQ INDCOL INDX INDXC
INDXG INDXG2L INDXG2P INFO IPQ
IPQ2 IPW IPWORK IQ IWORK
J JJQ JQ K L
LDQ LEND LIWMIN LIWORK LLD_
LWMIN LWORK M_ MB_ MYCOL
MYROW N N_ NB NB_
ND NP NPCOL NPROW NQ
NUMROC PSQ QCOL QTOT RSRC_
SBUF

LOGICAL

LSAME

REAL

WORK

Variables Dependence Graph
Put the mouse over a right hand side variable to display the corresponding line of the dependence
-
- -
CL <--- INDCOLCL = IWORK( INDCOL+L ), INDXG2P, IWORKCL = IWORK( INDCOL+L ), LCL = IWORK( INDCOL+L ), CSRC_, NB, NPCOL{2DO 40 CL = 0, NPCOL - 1, 3DO 60 CL = 1, NPCOL - 1, 4DO 80 CL = 1, NPCOL - 1, 5DO 100 CL = 1, NPCOL - 1}, DUMMY, I

COL <--- CLCOL = MOD( MYCOL+CL, NPCOL ), MYCOLCOL = MOD( MYCOL+CL, NPCOL ), NPCOLCOL = MOD( MYCOL+CL, NPCOL )

I <--- INDXCI = JQ - 1 + IWORK( INDXC+ND+L ), INDXGI = IWORK( INDXG+L ){2I = JQ - 1 + IWORK( INDXG+L )}, IWORKI = JQ - 1 + IWORK( INDXC+ND+L ){2I = IWORK( INDXG+L ), 3I = JQ - 1 + IWORK( INDXG+L )}, JQI = JQ - 1 + IWORK( INDXC+ND+L ){2I = JQ + ND + L, 3I = JQ - 1 + IWORK( INDXG+L )}, LI = JQ - 1 + IWORK( INDXC+ND+L ){2I = JQ + ND + L, 3I = IWORK( INDXG+L ), 4I = JQ - 1 + IWORK( INDXG+L )}, NDI = JQ - 1 + IWORK( INDXC+ND+L ){2I = JQ + ND + L}

IIQ <--- INDXG2L, IQ, NB, NPROW, DUMMY

INDCOL <--- INDXGINDCOL = INDXG + NB, NBINDCOL = INDXG + NB

INDX <--- INDXCINDX = INDXC + N, NINDX = INDXC + N

INDXG <--- INDXINDXG = INDX

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

IPQ <--- IIQIPQ = IIQ + ( JJQ-1 )*LDQ, IPQ2IPQ = IPQ2 + ( JJQ-1 )*NP, JJQIPQ = IIQ + ( JJQ-1 )*LDQ{2IPQ = IPQ2 + ( JJQ-1 )*NP, 3IPQ = 1 + ( JJQ-1 )*NP}, LDQIPQ = IIQ + ( JJQ-1 )*LDQ, NPIPQ = IPQ2 + ( JJQ-1 )*NP{2IPQ = 1 + ( JJQ-1 )*NP}

IPW <--- IPQ2IPW = IPQ2 + NP*NQ, NPIPW = IPQ2 + NP*NQ, NQIPW = IPQ2 + NP*NQ

IPWORK <--- CLIPWORK = IPW + ( IWORK( PSQ+CL )-1 )*NP, IPWIPWORK = IPW + ( IWORK( PSQ+CL )-1 )*NP{2, 3, 4IPWORK = IPW + L*NP}, IWORKIPWORK = IPW + ( IWORK( PSQ+CL )-1 )*NP{2, 3}, COL, LIPWORK = IPW + L*NP, MYCOL, NPIPWORK = IPW + ( IWORK( PSQ+CL )-1 )*NP{2, 3, 4IPWORK = IPW + L*NP}, PSQIPWORK = IPW + ( IWORK( PSQ+CL )-1 )*NP{2, 3}

IWORK <--- IID, INDCOL, INDXCIWORK( INDXG+K ) = IWORK( INDXC+ND+L ), CLIWORK( INDCOL+L ) = CL{2, 3IWORK( PSQ+CL ) = IWORK( PSQ+CL ) + 1, 4}, IWORKIWORK( INDXG+K ) = IWORK( INDXC+ND+L ){2, 3, 4IWORK( PSQ+CL ) = IWORK( PSQ+CL ) + 1, 5, 6}, L{2IWORK( INDXG+K ) = IWORK( INDXC+ND+L ), 3}, MYCOL, NDIWORK( INDXG+K ) = IWORK( INDXC+ND+L ), PSQ{2IWORK( PSQ+CL ) = IWORK( PSQ+CL ) + 1, 3, 4}, QTOT{2, 3}

J <--- JQJ = JQ + ND, NDJ = JQ + ND

JJQ <--- INDXG2L{2, 3}, NB{2, 3}, NPCOL{2, 3}, DUMMY{2, 3}, I{2, 3}

K <--- KK = K + 1

L <--- KDO 90 L = 0, K - 1{2DO 110 L = 0, K - 1}, LENDDO 30 L = 0, LEND - 1{2DO 50 L = 0, LEND - 1, 3DO 70 L = 0, LEND - 1}, NDO 10 L = 0, N - 1

LDQ <--- LLD_LDQ = DESCQ( LLD_ )

LEND <--- NLEND = MIN( NB, N-ND ), NBLEND = MIN( NB, N-ND ), NDLEND = MIN( NB, N-ND )

LIWMIN <--- NLIWMIN = N + 2*( NB+NPCOL ), NBLIWMIN = N + 2*( NB+NPCOL ), NPCOLLIWMIN = N + 2*( NB+NPCOL )

LWMIN <--- NLWMIN = MAX( N, NP*( NB+NQ ) ), NBLWMIN = MAX( N, NP*( NB+NQ ) ), NPLWMIN = MAX( N, NP*( NB+NQ ) ), NQLWMIN = MAX( N, NP*( NB+NQ ) )

NB <--- NB_NB = DESCQ( NB_ )

ND <--- NBND = ND + NB, NDND = ND + NB

NP <--- MYROW, N, NB, NPROW, NUMROC, RSRC_

NQ <--- CSRC_, MYCOL, N, NB, NPCOL, NUMROC

PSQ <--- NPCOLPSQ = QTOT + NPCOL, QTOTPSQ = QTOT + NPCOL

QCOL <--- INDXG2P, J, CSRC_, NB, NPCOL, DUMMY

QTOT <--- INDCOLQTOT = INDCOL + NB, NBQTOT = INDCOL + NB

SBUF <--- IWORKSBUF = IWORK( QTOT+COL ), COLSBUF = IWORK( QTOT+COL ), QTOTSBUF = IWORK( QTOT+COL )

WORK <--- INDXWORK( IID+L ) = D( IWORK( INDX+L ) ), IWORKWORK( IID+L ) = D( IWORK( INDX+L ) ), LWORK( IID+L ) = D( IWORK( INDX+L ) )

Analysis elements of the routine PSLASRT()
Put the mouse over each element to display detailed matching information

Assigned variables
		BLOCK_CYCLIC_2D , CL , COL , CSRC_ , CTXT_ , DLEN_ , DTYPE_ , DUMMY , I , IID , IIQ , INDCOL , INDX , INDXC , INDXG , INFO , IPQ , IPQ2 , IPW , IPWORK , J , JJQ , K , L , LDQ , LEND , LIWMIN , LLD_ , LWMIN , M_ , MB_ , MYCOL , N_ , NB , NB_ , ND , NP , NQ , PSQ , QCOL , QTOT , RSRC_ , SBUF

Active variables
		BLOCK_CYCLIC_2D , CL , COL , CSRC_ , CTXT_ , D , DESCQ , DLEN_ , DTYPE_ , DUMMY , I , ICTXT , ID , IID , IIQ , INDCOL , INDX , INDXC , INDXG , INDXG2L , INDXG2P , INFO , IPQ , IPQ2 , IPW , IPWORK , IQ , IWORK , J , JJQ , JQ , K , L , LDQ , LEND , LIWMIN , LIWORK , LLD_ , LSAME , LWMIN , LWORK , M_ , MB_ , MYCOL , MYROW , N , N_ , NB , NB_ , ND , NP , NPCOL , NPROW , NQ , NUMROC , PSQ , Q , QCOL , QTOT , RSRC_ , SBUF , WORK

Accessed arrays [ array name : associated index ]
	D	: IWORK( INDX+L )
	DESCQ	: CSRC_ , CSRC_ , CSRC_ , CTXT_ , CTXT_ , CTXT_ , LLD_ , NB_ , RSRC_
	INDXG2L	: I, NB, DUMMY, DUMMY, NPCOL , I, NB, DUMMY, DUMMY, NPCOL , I, NB, DUMMY, DUMMY, NPCOL , IQ, NB, DUMMY, DUMMY, NPROW
	INDXG2P	: I, NB, DUMMY, DESCQ( CSRC_ ), NPCOL , J, NB, DUMMY, DESCQ( CSRC_ ), NPCOL
	IWORK	: INDCOL+L , INDCOL+L , INDCOL+L , INDCOL+L , INDX , INDX+L , INDX+L , INDXC+ND+L , INDXC+ND+L , INDXC-1+IWORK( INDX+L ) , INDXG+K , INDXG+L , INDXG+L , PSQ , PSQ , PSQ+CL , PSQ+CL , PSQ+CL , PSQ+CL , PSQ+CL-1 , PSQ+CL-1 , PSQ+COL , PSQ+MYCOL , PSQ+MYCOL , QTOT+CL , QTOT+CL-1 , QTOT+CL-1 , QTOT+COL , QTOT+IWORK( INDCOL+L )
	LSAME	: ID, 'I'
	NUMROC	: N, NB, MYCOL, DESCQ( CSRC_ ), NPCOL , N, NB, MYROW, DESCQ( RSRC_ ), NPROW
	Q	: IIQ , IPQ
	WORK	: IID+L , IPQ , IPQ , IPW , IPWORK , IPWORK , IPWORK , IPWORK

Conditional statements [ statement : associated predicate ]
	do	: `(` 10 L = 0 , N - 1 `)` , `(` 30 L = 0 , LEND - 1 `)` , `(` 40 CL = 0 , NPCOL - 1 `)` , `(` 50 L = 0 , LEND - 1 `)` , `(` 60 CL = 1 , NPCOL - 1 `)` , `(` 70 L = 0 , LEND - 1 `)` , `(` 80 CL = 1 , NPCOL - 1 `)` , `(` 90 L = 0 , K - 1 `)` , `(` 100 CL = 1 , NPCOL - 1 `)` , `(` 110 L = 0 , K - 1 `)`
	if	: `(` BLOCK_CYCLIC_2DCSRC_CTXT_DLEN_DTYPE_LLD_MB_M_NB_N_ `)` , `(` N.EQ.0 `)` , `(` NPROW.EQ. - 1 `)` , `(` INFO.EQ.0 `)` , `(` (.NOT.LSAME( ID , 'I' ) ) `)` , `(` N.LT.0 `)` , `(` LWORK.LT.LWMIN `)` , `(` LIWORK.LT.LIWMIN `)` , `(` INFO.NE.0 `)` , `(` ND.LT.N `)` , `(` MYCOL.EQ.CL `)` , `(` MYCOL.EQ.QCOL `)` , `(` SBUF.NE.0 `)` , `(` K.NE.0 `)`