Routine PDLACP3() Documented By Universal Report

Routine: PDLACP3()

# lines:	309
# code:	309
# comment:	0
# blank:	0
# Variables:	44
# Callers:	1
# Callings:	0
# Words:	219
# Keywords:	161

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PDLACP3 is an auxiliary routine that copies from a global parallel
    array into a local replicated array or vise versa.  Notice that
    the entire submatrix that is copied gets placed on one node or
    more.  The receiving node can be specified precisely, or all nodes
    can receive, or just one row or column of nodes.
  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
  =========
  M       (global input) INTEGER
          M is the order of the square submatrix that is copied.
          M >= 0.
          Unchanged on exit
  I       (global input) INTEGER
          A(I,I) is the global location that the copying starts from.
          Unchanged on exit.
  A       (global input/output) DOUBLE PRECISION array, dimension
          (DESCA(LLD_),*)
          On entry, the parallel matrix to be copied into or from.
          On exit, if REV=1, the copied data.
          Unchanged on exit if REV=0.
  DESCA   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix A.
  B       (local input/output) DOUBLE PRECISION array of size (LDB,M)
          If REV=0, this is the global portion of the array
             A(I:I+M-1,I:I+M-1).
          If REV=1, this is the unchanged on exit.
  LDB     (local input) INTEGER
          The leading dimension of B.
  II      (global input) INTEGER
          By using REV 0 & 1, data can be sent out and returned again.
          If REV=0, then II is destination row index for the node(s)
             receiving the replicated B.
             If II>=0,JJ>=0, then node (II,JJ) receives the data
             If II=-1,JJ>=0, then all rows in column JJ receive the
                             data
             If II>=0,JJ=-1, then all cols in row II receive the data
             If II=-1,JJ=-1, then all nodes receive the data
          If REV<>0, then II is the source row index for the node(s)
             sending the replicated B.
  JJ      (global input) INTEGER
          Similar description as II above
  REV     (global input) INTEGER
          Use REV = 0 to send global A into locally replicated B
             (on node (II,JJ)).
          Use REV <> 0 to send locally replicated B from node (II,JJ)
             to its owner (which changes depending on its location in
             A) into the global A.
  Implemented by:  G. Henry, May 1, 1997
  =====================================================================
     .. Parameters ..

Display dynamic version

FontSize: - +

001        SUBROUTINE PDLACP3( M , I , A , DESCA , B , LDB , II , JJ , REV )
002  
003  *     -- ScaLAPACK routine(version 1.7) --
004  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
005  *     and University of California , Berkeley.
006  *     May 25 , 2001
007  
008  *     .. Scalar Arguments ..
009        INTEGER I , II , JJ , LDB , M , REV
010        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
011       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
012        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
013       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
014       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
015        DOUBLE PRECISION ZERO
016        PARAMETER( ZERO = 0.0D + 0 )
017  *     ..
018  *     .. Local Scalars ..
019        INTEGER COL , CONTXT , HBL , ICOL1 , ICOL2 , IDI , IDJ , IFIN ,
020       $III , IROW1 , IROW2 , ISTOP , ISTOPI , ISTOPJ , ITMP ,
021       $JJJ , LDA , MYCOL , MYROW , NPCOL , NPROW , ROW
022  *     ..
023  *     .. External Functions ..
024        INTEGER NUMROC
025        EXTERNAL NUMROC
026  *     ..
027  *     .. External Subroutines ..
028        EXTERNAL BLACS_GRIDINFO , DGEBR2D , DGEBS2D , DGERV2D ,
029       $DGESD2D , INFOG1L
030  *     ..
031  *     .. Intrinsic Functions ..
032        INTRINSIC MIN , MOD
033  *     ..
034  *     .. Executable Statements ..
035  
036        IF( M.LE.0 )
036               
037       $    RETURN
038  
039            HBL = DESCA( MB_ )
040            CONTXT = DESCA( CTXT_ )
041            LDA = DESCA( LLD_ )
042  
043            CALL BLACS_GRIDINFO( CONTXT , NPROW , NPCOL , MYROW , MYCOL )
044  
045            IF( REV.EQ.0 ) THEN
045                   
046                DO 20 IDI = 1 , M
046                       
047                    DO 10 IDJ = 1 , M
047                           
048                        B( IDI , IDJ ) = ZERO
049     10             CONTINUE
050     20         CONTINUE
050               
051            END IF
052  
053            IFIN = I + M - 1
054  
055            IF( MOD( I + HBL , HBL ).NE.0 ) THEN
055                   
056                ISTOP = MIN( I + HBL - MOD( I + HBL , HBL ) , IFIN )
057            ELSE
057                   
058                ISTOP = I
059            END IF
060            IDJ = I
061            ISTOPJ = ISTOP
062            IF( IDJ.LE.IFIN ) THEN
063     30 CONTINUE
064        IDI = I
065        ISTOPI = ISTOP
066        IF( IDI.LE.IFIN ) THEN
067     40 CONTINUE
068        ROW = MOD(( IDI - 1 ) / HBL , NPROW )
069        COL = MOD(( IDJ - 1 ) / HBL , NPCOL )
070        CALL INFOG1L( IDI , HBL , NPROW , ROW , 0 , IROW1 , ITMP )
071        IROW2 = NUMROC( ISTOPI , HBL , ROW , 0 , NPROW )
072        CALL INFOG1L( IDJ , HBL , NPCOL , COL , 0 , ICOL1 , ITMP )
073        ICOL2 = NUMROC( ISTOPJ , HBL , COL , 0 , NPCOL )
074        IF(( MYROW.EQ.ROW ) .AND.( MYCOL.EQ.COL ) ) THEN
074               
075            IF(( II.EQ. - 1 ) .AND.( JJ.EQ. - 1 ) ) THEN
076  
077  *             Send the message to everyone
078  
078                   
079                IF( REV.EQ.0 ) THEN
079                       
080                    CALL DGEBS2D( CONTXT , 'All' , ' ' , IROW2 - IROW1 + 1 ,
081       $            ICOL2 - ICOL1 + 1 , A(( ICOL1 - 1 )*LDA +
082       $            IROW1 ) , LDA )
083                END IF
084            END IF
085            IF(( II.EQ. - 1 ) .AND.( JJ.NE. - 1 ) ) THEN
086  
087  *             Send the message to Column MYCOL which better be JJ
088  
088                   
089                IF( REV.EQ.0 ) THEN
089                       
090                    CALL DGEBS2D( CONTXT , 'Col' , ' ' , IROW2 - IROW1 + 1 ,
091       $            ICOL2 - ICOL1 + 1 , A(( ICOL1 - 1 )*LDA +
092       $            IROW1 ) , LDA )
093                END IF
094            END IF
095            IF(( II.NE. - 1 ) .AND.( JJ.EQ. - 1 ) ) THEN
096  
097  *             Send the message to Row MYROW which better be II
098  
098                   
099                IF( REV.EQ.0 ) THEN
099                       
100                    CALL DGEBS2D( CONTXT , 'Row' , ' ' , IROW2 - IROW1 + 1 ,
101       $            ICOL2 - ICOL1 + 1 , A(( ICOL1 - 1 )*LDA +
102       $            IROW1 ) , LDA )
103                END IF
104            END IF
105            IF(( II.NE. - 1 ) .AND.( JJ.NE. - 1 ) .AND.
106       $(( MYROW.NE.II ) .OR.( MYCOL.NE.JJ ) ) ) THEN
107  
108  *         Recv / Send the message to(II , JJ)
109  
109               
110            IF( REV.EQ.0 ) THEN
110                   
111                CALL DGESD2D( CONTXT , IROW2 - IROW1 + 1 , ICOL2 - ICOL1 + 1 ,
112       $        A(( ICOL1 - 1 )*LDA + IROW1 ) , LDA , II ,
113       $        JJ )
114            ELSE
114                   
115                CALL DGERV2D( CONTXT , IROW2 - IROW1 + 1 , ICOL2 - ICOL1 + 1 ,
116       $        B( IDI - I + 1 , IDJ - I + 1 ) , LDB , II , JJ )
117            END IF
118        END IF
119        IF( REV.EQ.0 ) THEN
119               
120            DO 60 JJJ = ICOL1 , ICOL2
120                   
121                DO 50 III = IROW1 , IROW2
121                       
122                    B( IDI + III - IROW1 + 1 - I , IDJ + JJJ - ICOL1 + 1 - I )
123       $            = A(( JJJ - 1 )*LDA + III )
124     50         CONTINUE
125     60     CONTINUE
126        ELSE
126               
127            DO 80 JJJ = ICOL1 , ICOL2
127                   
128                DO 70 III = IROW1 , IROW2
128                       
129                    A(( JJJ - 1 )*LDA + III ) = B( IDI + III - IROW1 + 1 - I ,
130       $            IDJ + JJJ - ICOL1 + 1 - I )
131     70         CONTINUE
132     80     CONTINUE
133        END IF
134        ELSE
134               
135            IF(( II.EQ. - 1 ) .AND.( JJ.EQ. - 1 ) ) THEN
135                   
136                IF( REV.EQ.0 ) THEN
136                       
137                    CALL DGEBR2D( CONTXT , 'All' , ' ' , IROW2 - IROW1 + 1 ,
138       $            ICOL2 - ICOL1 + 1 , B( IDI - I + 1 , IDJ - I + 1 ) ,
139       $            LDB , ROW , COL )
140                END IF
141            END IF
142            IF(( II.EQ. - 1 ) .AND.( JJ.EQ.MYCOL ) ) THEN
142                   
143                IF( REV.EQ.0 ) THEN
143                       
144                    CALL DGEBR2D( CONTXT , 'Col' , ' ' , IROW2 - IROW1 + 1 ,
145       $            ICOL2 - ICOL1 + 1 , B( IDI - I + 1 , IDJ - I + 1 ) ,
146       $            LDB , ROW , COL )
147                END IF
148            END IF
149            IF(( II.EQ.MYROW ) .AND.( JJ.EQ. - 1 ) ) THEN
149                   
150                IF( REV.EQ.0 ) THEN
150                       
151                    CALL DGEBR2D( CONTXT , 'Row' , ' ' , IROW2 - IROW1 + 1 ,
152       $            ICOL2 - ICOL1 + 1 , B( IDI - I + 1 , IDJ - I + 1 ) ,
153       $            LDB , ROW , COL )
154                END IF
155            END IF
156            IF(( II.EQ.MYROW ) .AND.( JJ.EQ.MYCOL ) ) THEN
156                   
157                IF( REV.EQ.0 ) THEN
157                       
158                    CALL DGERV2D( CONTXT , IROW2 - IROW1 + 1 , ICOL2 - ICOL1 + 1 ,
159       $            B( IDI - I + 1 , IDJ - I + 1 ) , LDB , ROW ,
160       $            COL )
161                ELSE
161                       
162                    CALL DGESD2D( CONTXT , IROW2 - IROW1 + 1 , ICOL2 - ICOL1 + 1 ,
163       $            B( IDI - I + 1 , IDJ - I + 1 ) , LDB , ROW ,
164       $            COL )
165  *                 CALL DGESD2D(CONTXT , IROW2 - IROW1 + 1 , ICOL2 - ICOL1 + 1 ,
166  *                 $                            A((ICOL1 - 1)*LDA + IROW1) , LDA , ROW , COL)
167                END IF
168            END IF
169        END IF
170        IDI = ISTOPI + 1
171        ISTOPI = MIN( ISTOPI + HBL , IFIN )
172        IF( IDI.LE.IFIN )
172               
173       $    GO TO 40
174        END IF
175        IDJ = ISTOPJ + 1
176        ISTOPJ = MIN( ISTOPJ + HBL , IFIN )
177        IF( IDJ.LE.IFIN )
177               
178       $    GO TO 30
179        END IF
180        RETURN
181  
182  *     End of PDLACP3
183  
184        END2218

Variables in Routine PDLACP3()

Summary Report
Data Type	Quantity	Size(byte)
DOUBLE PRECISION	1	4
INTEGER	40	160
REAL	3	12
TOTAL	44	176

List of Variables

DOUBLE PRECISION

ZERO

INTEGER

BLOCK_CYCLIC_2D COL CONTXT CSRC_ CTXT_
DLEN_ DTYPE_ HBL I ICOL1
ICOL2 IDI IDJ IFIN II
III IROW1 IROW2 ISTOP ISTOPI
ISTOPJ ITMP JJ JJJ LDA
LDB LLD_ M M_ MB_
MYCOL MYROW N_ NB_ NPCOL
NPROW NUMROC REV ROW RSRC_

REAL

$ A B

Variables Dependence Graph
Put the mouse over a right hand side variable to display the corresponding line of the dependence
-
- -
A <--- I, ICOL1, IDI, IDJ, III, IROW1, JJJ, B

B <--- III, A, JJJ, LDA, ZEROB( IDI, IDJ ) = ZERO

COL <--- HBLCOL = MOD( ( IDJ-1 ) / HBL, NPCOL ), IDJCOL = MOD( ( IDJ-1 ) / HBL, NPCOL ), NPCOLCOL = MOD( ( IDJ-1 ) / HBL, NPCOL )

CONTXT <--- CTXT_CONTXT = DESCA( CTXT_ )

HBL <--- MB_HBL = DESCA( MB_ )

ICOL2 <--- HBL, ISTOPJ, NPCOL, NUMROC, COL

IDI <--- IIDI = I, ISTOPIIDI = ISTOPI + 1, MDO 20 IDI = 1, M

IDJ <--- IIDJ = I, ISTOPJIDJ = ISTOPJ + 1, MDO 10 IDJ = 1, M

IFIN <--- IIFIN = I + M - 1, MIFIN = I + M - 1

III <--- IROW1DO 50 III = IROW1, IROW2{2DO 70 III = IROW1, IROW2}, IROW2DO 50 III = IROW1, IROW2{2DO 70 III = IROW1, IROW2}

IROW2 <--- HBL, ISTOPI, NPROW, NUMROC, ROW

ISTOP <--- HBL, I{2ISTOP = I}, IFIN

ISTOPI <--- HBLISTOPI = MIN( ISTOPI+HBL, IFIN ), IFINISTOPI = MIN( ISTOPI+HBL, IFIN ), ISTOPISTOPI = ISTOP, ISTOPIISTOPI = MIN( ISTOPI+HBL, IFIN )

ISTOPJ <--- HBLISTOPJ = MIN( ISTOPJ+HBL, IFIN ), IFINISTOPJ = MIN( ISTOPJ+HBL, IFIN ), ISTOPISTOPJ = ISTOP, ISTOPJISTOPJ = MIN( ISTOPJ+HBL, IFIN )

JJJ <--- ICOL1DO 60 JJJ = ICOL1, ICOL2{2DO 80 JJJ = ICOL1, ICOL2}, ICOL2DO 60 JJJ = ICOL1, ICOL2{2DO 80 JJJ = ICOL1, ICOL2}

LDA <--- LLD_LDA = DESCA( LLD_ )

ROW <--- HBLROW = MOD( ( IDI-1 ) / HBL, NPROW ), IDIROW = MOD( ( IDI-1 ) / HBL, NPROW ), NPROWROW = MOD( ( IDI-1 ) / HBL, NPROW )

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

Assigned variables
		BLOCK_CYCLIC_2D , COL , CONTXT , CSRC_ , CTXT_ , DLEN_ , DTYPE_ , HBL , ICOL2 , IDI , IDJ , IFIN , III , IROW2 , ISTOP , ISTOPI , ISTOPJ , JJJ , LDA , LLD_ , M_ , MB_ , N_ , NB_ , ROW , RSRC_ , ZERO

Active variables
		A , B , BLOCK_CYCLIC_2D , COL , CONTXT , CSRC_ , CTXT_ , DESCA , DLEN_ , DTYPE_ , HBL , I , ICOL1 , ICOL2 , IDI , IDJ , IFIN , II , III , IROW1 , IROW2 , ISTOP , ISTOPI , ISTOPJ , ITMP , JJ , JJJ , LDA , LDB , LLD_ , M , M_ , MB_ , MYCOL , MYROW , N_ , NB_ , NPCOL , NPROW , NUMROC , REV , ROW , RSRC_ , ZERO

Accessed arrays [ array name : associated index ]
	A	: ( ICOL1-1 )LDA+IROW1 , ( JJJ-1 )LDA+III , ( JJJ-1 )LDA+III , (ICOL1-1)LDA+IROW1
	B	: IDI, IDJ , IDI+III-IROW1+1-I, IDJ+JJJ-ICOL1+1-I , IDI-I+1, IDJ-I+1 , IDI-I+1, IDJ-I+1 , IDI-I+1, IDJ-I+1 , IDI-I+1, IDJ-I+1 , IDI-I+1, IDJ-I+1 , IDI-I+1, IDJ-I+1
	DESCA	: CTXT_ , LLD_ , MB_
	NUMROC	: ISTOPI, HBL, ROW, 0, NPROW , ISTOPJ, HBL, COL, 0, NPCOL

Conditional statements [ statement : associated predicate ]
	do	: `(` 20 IDI = 1 , M `)` , `(` 10 IDJ = 1 , M `)` , `(` 60 JJJ = ICOL1 , ICOL2 `)` , `(` 50 III = IROW1 , IROW2 `)` , `(` 80 JJJ = ICOL1 , ICOL2 `)` , `(` 70 III = IROW1 , IROW2 `)`
	if	: `(` M.LE.0 `)` , `(` REV.EQ.0 `)` , `(` (MOD( I + HBL , HBL ).NE.0 ) `)` , `(` IDJ.LE.IFIN `)` , `(` IDI.LE.IFIN `)` , `(` (( MYROW.EQ.ROW ) .AND. ( MYCOL.EQ.COL ) ) `)` , `(` (( II.EQ. - 1 ) .AND. ( JJ.EQ. - 1 ) ) `)` , `(` REV.EQ.0 `)` , `(` (( II.EQ. - 1 ) .AND. ( JJ.NE. - 1 ) ) `)` , `(` REV.EQ.0 `)` , `(` (( II.NE. - 1 ) .AND. ( JJ.EQ. - 1 ) ) `)` , `(` REV.EQ.0 `)` , `(` (( II.NE. - 1 ) .AND. ( JJ.NE. - 1 ) .AND. `)` , `(` REV.EQ.0 `)` , `(` REV.EQ.0 `)` , `(` (( II.EQ. - 1 ) .AND. ( JJ.EQ. - 1 ) ) `)` , `(` REV.EQ.0 `)` , `(` (( II.EQ. - 1 ) .AND. ( JJ.EQ.MYCOL ) ) `)` , `(` REV.EQ.0 `)` , `(` (( II.EQ.MYROW ) .AND. ( JJ.EQ. - 1 ) ) `)` , `(` REV.EQ.0 `)` , `(` (( II.EQ.MYROW ) .AND. ( JJ.EQ.MYCOL ) ) `)` , `(` REV.EQ.0 `)` , `(` IDI.LE.IFIN `)` , `(` IDJ.LE.IFIN `)`